+(: peer->str (-> Peer String))
+(define (peer->str peer)
+ (match-define (Peer n _ u c) peer)
+ (format "~a~a~a"
+ (if n (format "~a " n) "")
+ u
+ (if c (format " # ~a" c) "")))
+
+(: str->peer (-> String (Option Peer)))
+(define (str->peer str)
+ (log-debug "Parsing peer string: ~v" str)
+ (match
+ (regexp-match
+ #px"(([^\\s\t]+)[\\s\t]+)?([a-zA-Z]+://[^\\s\t]*)[\\s\t]*(#\\s*(.*))?"
+ str)
+ [(list _wholething
+ _nick-with-space
+ nick
+ url
+ _comment-with-hash
+ comment)
+ (match (str->url url)
+ [#f
+ (log-error "Invalid URL in peer string: ~v" str)
+ #f]
+ [url
+ (Peer nick url (url->string url) comment)])]
+ [_
+ (log-debug "Invalid peer string: ~v" str)
+ #f]))
+
+(module+ test
+ (check-equal?
+ (str->peer "foo http://bar/file.txt # some rando")
+ (Peer "foo" (str->url "http://bar/file.txt") "http://bar/file.txt" "some rando"))
+ (check-equal?
+ (str->peer "http://bar/file.txt # some rando")
+ (Peer #f (str->url "http://bar/file.txt") "http://bar/file.txt" "some rando"))
+ (check-equal?
+ (str->peer "http://bar/file.txt #")
+ (Peer #f (str->url "http://bar/file.txt") "http://bar/file.txt" ""))
+ (check-equal?
+ (str->peer "http://bar/file.txt#") ; XXX URLs can have #s
+ (Peer #f (str->url "http://bar/file.txt#") "http://bar/file.txt#" #f))
+ (check-equal?
+ (str->peer "http://bar/file.txt")
+ (Peer #f (str->url "http://bar/file.txt") "http://bar/file.txt" #f))
+ (check-equal?
+ (str->peer "foo http://bar/file.txt")
+ (Peer "foo" (str->url "http://bar/file.txt") "http://bar/file.txt" #f))
+ (check-equal?
+ (str->peer "foo bar # baz")
+ #f)
+ (check-equal?
+ (str->peer "foo bar://baz # quux")
+ (Peer "foo" (str->url "bar://baz") "bar://baz" "quux"))
+ (check-equal?
+ (str->peer "foo bar//baz # quux")
+ #f))
+
+(: filter-comments (-> (Listof String) (Listof String)))
+(define (filter-comments lines)
+ (filter-not (λ (line) (string-prefix? line "#")) lines))
+
+(: str->peers (-> String (Listof Peer)))
+(define (str->peers str)
+ (filter-map str->peer (filter-comments (str->lines str))))
+
+(: peers->file (-> (Listof Peers) Path-String Void))
+(define (peers->file peers path)
+ (make-parent-directory* path)
+ (display-lines-to-file
+ (map peer->str
+ (sort peers
+ (match-lambda**
+ [((Peer n1 _ _ _) (Peer n2 _ _ _))
+ (string<? (if n1 n1 "")
+ (if n2 n2 ""))])))
+ path
+ #:exists 'replace))
+
+(: file->peers (-> Path-String (Listof Peer)))
+(define (file->peers file-path)
+ (if (file-exists? file-path)
+ (str->peers (file->string file-path))
+ (begin
+ (log-warning "File does not exist: ~v" (path->string file-path))
+ '())))
+
+(define re-rfc2822
+ #px"^(Mon|Tue|Wed|Thu|Fri|Sat|Sun), ([0-9]{2}) (Jan|Feb|Mar|Apr|May|Jun|Jul|Aug|Sep|Oct|Nov|Dec) ([0-9]{4}) ([0-2][0-9]):([0-6][0-9]):([0-6][0-9]) GMT")
+
+(: b->n (-> Bytes (Option Number)))
+(define (b->n b)
+ (string->number (bytes->string/utf-8 b)))
+
+(: mon->num (-> Bytes Natural))
+(define/match (mon->num mon)
+ [(#"Jan") 1]
+ [(#"Feb") 2]
+ [(#"Mar") 3]
+ [(#"Apr") 4]
+ [(#"May") 5]
+ [(#"Jun") 6]
+ [(#"Jul") 7]
+ [(#"Aug") 8]
+ [(#"Sep") 9]
+ [(#"Oct") 10]
+ [(#"Nov") 11]
+ [(#"Dec") 12])
+
+(: rfc2822->epoch (-> Bytes (Option Nonnegative-Integer)))
+(define (rfc2822->epoch timestamp)
+ (match (regexp-match re-rfc2822 timestamp)
+ [(list _ _ dd mo yyyy HH MM SS)
+ #:when (and dd mo yyyy HH MM SS)
+ (find-seconds (b->n SS)
+ (b->n MM)
+ (b->n HH)
+ (b->n dd)
+ (mon->num mo)
+ (b->n yyyy)
+ #f)]
+ [_
+ #f]))
+
+(: header-get (-> (Listof Bytes) Bytes (Option Bytes)))
+(define (header-get headers name)
+ (match (filter-map (curry extract-field name) headers)
+ [(list val) val]
+ [_ #f]))
+
+(: url-download-http-from-port
+ (-> Url (Listof (U Bytes String)) Input-Port
+ (U 'skipped-cached 'downloaded-new))) ; TODO 'ok|'error ?
+(define (url-download-http-from-port u headers body-input)
+ ; TODO Update message db from here? or where?
+ ; - 1st try can just be an in-memory set that gets written-to
+ ; and read-from disk as a whole.
+ (define u-str (url->string u))
+ (log-debug "url-download-http-from-port ~v into ~v" u-str cached-object-path)
+ (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))
+ (define etag (header-get headers #"ETag"))
+ (define lmod (header-get headers #"Last-Modified"))
+ (define lmod-curr (if lmod (rfc2822->epoch lmod) #f))
+ (define 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)
+ (define cached?
+ (or (and etag
+ (file-exists? cached-etag-path)
+ (bytes=? etag (file->bytes cached-etag-path))
+ (begin
+ (log-debug "ETags match, skipping the rest of ~v" u-str)
+ #t))
+ (and lmod-curr
+ lmod-prev
+ (<= lmod-curr lmod-prev)
+ (begin
+ (log-debug "Last-Modified <= current skipping the rest of ~v" u-str)
+ #t))))
+ (if (not cached?)
+ (begin
+ (log-debug
+ "Downloading the rest of ~v. ETag: ~a, Last-Modified: ~v"
+ u-str 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))
+ 'downloaded-new)
+ 'skipped-cached))
+
+(: url-download-http (-> Positive-Float Url Download-Result))
+(define (url-download-http timeout u)
+ (define u-str (url->string u))
+ (define timeout-chan (make-channel))
+ (define result-chan (make-channel))
+ (define timeout-thread
+ (thread (λ ()
+ ; Doing this instead of sync/timeout to distinguish error values,
+ ; rather than just have #f to work with.
+ (sleep timeout)
+ (channel-put timeout-chan '(error . timeout)))))
+ (define result-thread
+ (thread (λ ()
+ (define result
+ (with-handlers
+ ; TODO Maybe name each known errno? (exn:fail:network:errno-errno e)
+ ([exn:fail:network?
+ (λ (e) `(error . (net-error . ,e)))]
+ [exn?
+ (λ (e) `(error . (other . ,e)))])
+ (define-values (status-line headers body-input)
+ (http-sendrecv/url
+ u
+ #:headers (list (format "User-Agent: ~a" user-agent-str))))
+ (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)
+ (let ([result
+ ; TODO Handle redirects.
+ ; TODO Should a redirect update a peer URL?
+ (match status
+ [200
+ `(ok . ,(url-download-http-from-port u headers body-input))]
+ [_
+ `(error . (http-not-ok . ,status))])])
+ (close-input-port body-input)
+ result)))
+ (channel-put result-chan result))))
+ (define result (sync timeout-chan result-chan))
+ (kill-thread result-thread)
+ (kill-thread timeout-thread)
+ result)
+
+(: url-download (-> Positive-Float Url Download-Result))
+(define (url-download timeout u)
+ (match (url-scheme u)
+ ; TODO Support Gopher.
+ [(or "http" "https")
+ (url-download-http timeout u)]
+ [scheme
+ `(error . (unsupported-url-scheme . ,scheme))]))
+
+(: timeline-print (-> Out-Format (Listof Msg) Void))