missed client.rkt in last few commits, oops.

client.rkt

@@ -0,0 +1,121 @@
+#lang racket
+
+(provide client%)
+
+(require (prefix-in net: "net.rkt")
+         (prefix-in gmi: "gmi.rkt"))
+
+(require net/url-string)
+
+(define temporary-failures
+  '((40 . "temporary failure")
+    (41 . "server unavailable")
+    (42 . "CGI error")
+    (43 . "proxy error")
+    (44 . "slow down")))
+
+(define permanent-failures
+  '((50 . "permanent failure")
+    (51 . "not found")
+    (52 . "gone")
+    (53 . "proxy request refused")
+    (59 . "bad request")))
+
+(define client%
+  (class object%
+    (define document-object '())
+    (define document-buffer '())
+    (define current-url '())
+
+    (super-new)
+
+    (define/public (go-cmd url-string)
+      (if (non-empty-string? url-string)
+          (let ()
+            (when (not (string-contains? url-string "://"))
+              (set! url-string (string-append "gemini://" url-string)))
+
+            (get (string->url url-string)))
+
+          (displayln "go where?")))
+
+    (define/public (next-cmd)
+      (define (iter depth)
+        (when (and (> depth 0)
+                   (> (pipe-content-length document-buffer) 0))
+          (let ()
+            (displayln (read-line document-buffer))
+            (iter (sub1 depth)))))
+
+      (iter 10)
+      (newline)
+      (let ([remaining (pipe-content-length document-buffer)])
+        (printf "~a bytes remaining\n" remaining)))
+
+    (define/public (visit-cmd line)
+      (define url (gmi:match-link document-object line))
+
+      (get (combine-url/relative current-url (url->string url))))
+
+    (define/private (get url)
+      (define (iter url depth)
+        (let-values ([(status header c-in) (net:request url)])
+          ;; TODO there are bunch of other status codes to deal with for
+          ;; compliance
+          (cond
+            ;; clients MUST reject status codes outside of the 10-69 range
+            [(or (< status 10)
+                 (> status 69))
+             (displayln "WARNING: server returned invalid status code")]
+
+            ;; 10-19 INPUT REQUIRED
+            [(and (>= status 10)
+                  (<= status 19))
+             (display "input requested > ")
+             (get (string-append url "?" (read-line)))]
+
+            ;; 20-29 SUCCESS
+            [(and (>= status 20)
+                  (<= status 29))
+
+             (let-values ([(doc) (gmi:parse (port->lines c-in))]
+                          [(db-in db-out) (make-pipe #f)])
+
+               (set! document-object doc)
+
+               (set! document-buffer db-in)
+               (parameterize ([current-output-port db-out])
+                 (gmi:render doc))
+
+               (set! current-url url)
+
+               (let ([remaining (pipe-content-length db-in)])
+                 (printf "document retrieved. ~a bytes\n" remaining))
+
+               (next-cmd))]
+
+            ;; 30-39 REDIRECT
+            [(and (>= status 30)
+                  (<= status 39))
+             (if (> depth 5)
+                 (displayln "WARNING: maximum redirection depth exceeded")
+                 (iter (string->url header) (sub1 depth)))]
+
+            ;; 40-49 TEMPORARY FAILURE
+            [(and (>= status 40)
+                  (<= status 49))
+             (printf "status ~a: ~a\n" status
+                     (dict-ref temporary-failures status "temporary failure"))]
+
+            ;; 50-59 PERMANENT FAILURE
+            [(and (>= status 50)
+                  (<= status 59))
+             (printf "status ~a: ~a\n" status
+                     (dict-ref permanent-failures status "permanent failure"))]
+
+            ;; 60-69 CERTIFICATE REQUIRED
+            [(and (>= status 60)
+                  (<= status 69))
+             (displayln "certificate handling not yet implemented")])))
+
+      (iter url 5))))

gmi.rkt

@@ -3,9 +3,11 @@
 (provide (contract-out
           [render (-> document? void?)]
           [parse (-> (listof string?) document?)]
-          [match-link (-> document? integer? (or/c string? #f))]
+          [match-link (-> document? integer? (or/c url? #f))]
           [struct document ((items (listof (or/c text? link? pre?))))]))
 
+(require net/url-string)
+
 ;; a gemtext document is represented as a list of structs, a struct
 ;; for each type of item in a document.
 (struct document (items))
@@ -22,7 +24,7 @@
   (let ([split (string-split (substring line 2))])
     (if (empty? split)
         (text line)
-        (link (car split)
+        (link (string->url (car split))
               (if (>= (length split) 2)
                   (string-join (cdr split))
                   (car split))

net.rkt

@@ -1,21 +1,17 @@
 #lang racket
 
-(provide request)
+(provide (contract-out
+          [request (-> url? (values integer? string? input-port?))]))
 
 (require openssl)
 (require net/url-string)
 
-;; sends a request to a gemini server, and returns the status, header,
+(define (request url)
-;; and the input port for the rest of the body.
-;; this procedure will fail if the response is malformed, however, it
-;; is not up to it to validate the contents of the response.
-(define (request url-str)
-  (define url (string->url url-str))
   (define-values (c-in c-out)
     (ssl-connect (url-host url)
                  (or (url-port url) 1965)))
 
-  (write-string url-str c-out)
+  (write-string (url->string url) c-out)
   (write-string "\r\n" c-out)
 
   (define-values (status header)