+(: header-get (-> (Listof Bytes) Bytes (Option Bytes)))
+(define (header-get headers name)
+ (match (filter-map (curry extract-field name) headers)
+ [(list val) val]
+ [_ #f]))
+
+(: uri-download (-> Url Void))
+(define (uri-download u)
+ (define cached-object-path (url->cache-object-path u))
+ (define cached-etag-path (url->cache-etag-path u))
+ (define cached-lmod-path (url->cache-lmod-path u))
+ (log-debug "uri-download ~v into ~v" u cached-object-path)
+ (define-values (status-line headers body-input)
+ ; TODO Timeout. Currently hangs on slow connections.
+ (http-sendrecv/url u #:headers (list (format "User-Agent: ~a" user-agent))))
+ (log-debug "headers: ~v" headers)
+ (log-debug "status-line: ~v" status-line)
+ (define status
+ (string->number (second (string-split (bytes->string/utf-8 status-line)))))
+ (log-debug "status: ~v" status)
+ ; TODO Handle redirects
+ (match status
+ [200
+ (let* ([etag (header-get headers #"ETag")]
+ [lmod (header-get headers #"Last-Modified")]
+ [lmod-curr (if lmod (rfc2822->epoch lmod) #f)]
+ [lmod-prev (if (file-exists? cached-lmod-path)
+ (rfc2822->epoch (file->bytes cached-lmod-path))
+ #f)])
+ (log-debug "lmod-curr:~v lmod-prev:~v" lmod-curr lmod-prev)
+ (unless (or (and etag
+ (file-exists? cached-etag-path)
+ (bytes=? etag (file->bytes cached-etag-path))
+ (begin
+ (log-info "ETags match, skipping the rest of ~v" (url->string u))
+ #t))
+ (and lmod-curr
+ lmod-prev
+ (<= lmod-curr lmod-prev)
+ (begin
+ (log-info "Last-Modified <= current skipping the rest of ~v" (url->string u))
+ #t)))
+ (begin
+ (log-info
+ "Downloading the rest of ~v. ETag: ~a, Last-Modified: ~v"
+ (url->string u) etag lmod)
+ (make-parent-directory* cached-object-path)
+ (make-parent-directory* cached-etag-path)
+ (make-parent-directory* cached-lmod-path)
+ (call-with-output-file cached-object-path
+ (curry copy-port body-input)
+ #:exists 'replace)
+ (when etag
+ (display-to-file etag cached-etag-path #:exists 'replace))
+ (when lmod
+ (display-to-file lmod cached-lmod-path #:exists 'replace))))
+ (close-input-port body-input))]
+ [_
+ (raise status)]))
+
+(: timeline-print (-> Out-Format (Listof Msg) Void))
+(define (timeline-print out-format timeline)
+ (void (foldl (match-lambda**
+ [((and m (Msg _ _ nick _ _ _)) (cons prev-nick i))
+ (let ([i (if (equal? prev-nick nick) i (+ 1 i))])
+ (msg-print out-format i m)
+ (cons nick i))])
+ (cons "" 0)
+ timeline)))
+
+(: peer->msgs (-> Peer (Listof Msg)))
+(define (peer->msgs f)
+ (match-define (Peer nick uri) f)
+ (log-info "Reading peer nick:~v uri:~v" nick (url->string uri))
+ (str->msgs nick uri (uri-read-cached uri)))
+
+(: peer-download (-> Peer Void))
+(define (peer-download f)
+ (match-define (Peer nick uri) f)
+ (define u (url->string uri))
+ (log-info "Downloading peer uri:~a" u)
+ (with-handlers
+ ([exn:fail?
+ (λ (e)
+ (log-error "Network error nick:~v uri:~v exn:~v" nick u e)
+ #f)]
+ [integer?
+ (λ (status)
+ (log-error "HTTP error nick:~v uri:~a status:~a" nick u status)
+ #f)])
+ (define-values (_result _tm-cpu-ms tm-real-ms _tm-gc-ms)
+ (time-apply uri-download (list uri)))
+ (log-info "Peer downloaded in ~a seconds, uri: ~a" (/ tm-real-ms 1000.0) u)))
+
+(: timeline-download (-> Integer (Listof Peer) Void))
+(define (timeline-download num-workers peers)
+ ; TODO No need for map - can just iter
+ (void (concurrent-filter-map num-workers peer-download peers)))
+
+(define (uniq xs)
+ (set->list (list->set xs)))
+
+(: peers->timeline (-> (listof Peer) (listof Msg)))
+(define (peers->timeline peers)
+ (append* (filter-map peer->msgs peers)))
+
+(: timeline-sort (-> (listof Msg) timeline-order (Listof Msgs)))
+(define (timeline-sort msgs order)
+ (define cmp (match order
+ ['old->new <]
+ ['new->old >]))
+ (sort msgs (λ (a b) (cmp (Msg-ts-epoch a)
+ (Msg-ts-epoch b)))))
+
+(: paths->peers (-> (Listof String) (Listof Peer)))
+(define (paths->peers paths)
+ (let* ([paths (match paths
+ ['()
+ (let ([peer-refs-file (build-path tt-home-dir "peers")])
+ (log-debug
+ "No peer ref file paths provided, defaulting to ~v"
+ (path->string peer-refs-file))
+ (list peer-refs-file))]
+ [paths
+ (log-debug "Peer ref file paths provided: ~v" paths)
+ (map string->path paths)])]
+ [peers (append* (map file->peers paths))])
+ (log-info "Read-in ~a peers." (length peers))
+ peers))
+
+(: log-writer-stop (-> Thread Void))
+(define (log-writer-stop log-writer)
+ (log-message (current-logger) 'fatal 'stop "Exiting." #f)
+ (thread-wait log-writer))
+
+(: log-writer-start (-> Log-Level Thread))
+(define (log-writer-start level)
+ (let* ([logger
+ (make-logger #f #f level #f)]
+ [log-receiver
+ (make-log-receiver logger level)]
+ [log-writer
+ (thread
+ (λ ()
+ (parameterize
+ ([date-display-format 'iso-8601])
+ (let loop ()
+ (match-define (vector level msg _ topic) (sync log-receiver))
+ (unless (equal? topic 'stop)
+ (eprintf "~a [~a] ~a~n" (date->string (current-date) #t) level msg)
+ (loop))))))])
+ (current-logger logger)
+ log-writer))
+