| 1 | #! /usr/bin/env racket |
| 2 | ; vim: filetype=racket |
| 3 | |
| 4 | #lang racket |
| 5 | |
| 6 | (require racket/date) |
| 7 | |
| 8 | (require http-client) |
| 9 | (require rfc3339-old) |
| 10 | |
| 11 | (struct msg (tm_epoch tm_rfc3339 nick text)) |
| 12 | (struct feed (nick uri)) |
| 13 | |
| 14 | (define (msg<-toks nick toks) |
| 15 | (define tm_rfc3339 (list-ref toks 0)) |
| 16 | (define tok_text (list-ref toks 1)) |
| 17 | (define t (string->rfc3339-record tm_rfc3339)) |
| 18 | ; TODO handle tz offset |
| 19 | (define tm_epoch (find-seconds [rfc3339-record:second t] |
| 20 | [rfc3339-record:minute t] |
| 21 | [rfc3339-record:hour t] |
| 22 | [rfc3339-record:mday t] |
| 23 | [rfc3339-record:month t] |
| 24 | [rfc3339-record:year t])) |
| 25 | (msg tm_epoch tm_rfc3339 nick tok_text)) |
| 26 | |
| 27 | (define (uri-fetch uri) |
| 28 | (log-info "GET ~a" uri) |
| 29 | (define resp (http-get uri)) |
| 30 | (define status (http-response-code resp)) |
| 31 | (define body (http-response-body resp)) |
| 32 | (log-debug "finished GET ~a status:~a body length:~a" |
| 33 | uri status (string-length body)) |
| 34 | ; TODO Handle redirects |
| 35 | (if (= status 200) body (raise status))) |
| 36 | |
| 37 | (define re-msg-begin |
| 38 | ; TODO Zulu offset. Maybe in several formats. Which ones? |
| 39 | (let ([timestamp "[0-9]{4}-[0-9]{2}-[0-9]{2}T[0-9]{2}:[0-9]{2}:[0-9]{2}"]) |
| 40 | (pregexp (string-append "^" timestamp)))) |
| 41 | |
| 42 | (define (msg-print odd m) |
| 43 | (printf "~a \033[1;37m<~a>\033[0m \033[0;~am~a\033[0m~n" |
| 44 | (date->string (seconds->date [msg-tm_epoch m]) #t) |
| 45 | [msg-nick m] |
| 46 | [if odd 36 33] |
| 47 | [msg-text m])) |
| 48 | |
| 49 | (define (timeline-print timeline) |
| 50 | (for ([msg timeline] |
| 51 | [i (in-naturals)]) |
| 52 | (msg-print (odd? i) msg))) |
| 53 | |
| 54 | (define (str->lines str) |
| 55 | (string-split str (regexp "[\r\n]+"))) |
| 56 | |
| 57 | (define (str->msgs nick str) |
| 58 | (let* ([lines |
| 59 | (str->lines str)] |
| 60 | [msg_lines |
| 61 | (filter (λ (l) (regexp-match? re-msg-begin l)) lines)] |
| 62 | [msgs |
| 63 | (begin |
| 64 | (log-debug "nick:~a lines:~a msg_lines:~a" |
| 65 | nick |
| 66 | (length lines) |
| 67 | (length msg_lines)) |
| 68 | (filter-map |
| 69 | (λ (line) |
| 70 | (define toks (string-split line (regexp "\t+"))) |
| 71 | (if (= 2 (length toks)) |
| 72 | (msg<-toks nick toks) |
| 73 | #f) |
| 74 | ) |
| 75 | msg_lines))]) |
| 76 | msgs)) |
| 77 | |
| 78 | (define (timeline feeds) |
| 79 | (let* ([timelines |
| 80 | (filter-map |
| 81 | (λ (feed) |
| 82 | (log-info "processing feed nick:~a uri:~a" |
| 83 | (feed-nick feed) |
| 84 | (feed-uri feed)) |
| 85 | (with-handlers |
| 86 | ([exn:fail:network? |
| 87 | (λ (e) |
| 88 | (log-error "network error nick:~a uri:~a exn:~a" |
| 89 | (feed-nick feed) |
| 90 | (feed-uri feed) |
| 91 | e) |
| 92 | #f)] |
| 93 | [integer? |
| 94 | (λ (status) |
| 95 | (log-error "http error nick:~a uri:~a status:~a" |
| 96 | (feed-nick feed) |
| 97 | (feed-uri feed) |
| 98 | status) |
| 99 | #f)]) |
| 100 | (str->msgs [feed-nick feed] [uri-fetch (feed-uri feed)]))) |
| 101 | feeds)] |
| 102 | [timeline |
| 103 | (append* timelines)] |
| 104 | [timeline |
| 105 | (sort timeline (λ (a b) [< (msg-tm_epoch a) (msg-tm_epoch b)]))]) |
| 106 | timeline)) |
| 107 | |
| 108 | (define (we-are-twtxt) |
| 109 | (let* ([uri |
| 110 | "https://raw.githubusercontent.com/mdom/we-are-twtxt/master/we-are-twtxt.txt"] |
| 111 | [payload |
| 112 | (uri-fetch uri)] |
| 113 | [lines |
| 114 | (str->lines payload)] |
| 115 | [feeds |
| 116 | (map (λ (line) |
| 117 | (define toks (string-split line)) |
| 118 | (feed |
| 119 | [list-ref toks 0] |
| 120 | [list-ref toks 1])) |
| 121 | lines)]) |
| 122 | feeds)) |
| 123 | |
| 124 | (define (logging) |
| 125 | (define logger (make-logger #f #f 'debug #f)) |
| 126 | (define log-chan (make-log-receiver logger 'debug)) |
| 127 | (void (thread (λ () |
| 128 | [date-display-format 'iso-8601] |
| 129 | [let loop () |
| 130 | (define data (sync log-chan)) |
| 131 | (define level (vector-ref data 0)) |
| 132 | (define msg (vector-ref data 1)) |
| 133 | (define ts (date->string (current-date) #t)) |
| 134 | (eprintf "~a [~a] ~a~n" ts level msg) |
| 135 | (loop)]))) |
| 136 | (current-logger logger)) |
| 137 | |
| 138 | (define (main) |
| 139 | (logging) |
| 140 | (define feeds (we-are-twtxt)) |
| 141 | (current-http-response-auto #f) |
| 142 | (current-http-user-agent "tt 0.0.0") |
| 143 | (date-display-format 'rfc2822) |
| 144 | (timeline-print (timeline feeds))) |
| 145 | |
| 146 | (main) |