add proper handling of exceptions raised by network procedures

client.rkt

@@ -82,6 +82,14 @@
 
       (define/private (get url)
         (define (iter url depth)
+          (with-handlers
+            ([exn:fail:network?
+              (λ (exn)
+                (displayln (exn-message exn)))]
+             [net:exn:fail:response?
+              (λ (exn)
+                (displayln (exn-message exn)))])
+
             (let-values ([(status header c-in) (net:request url)])
               ;; TODO there are bunch of other status codes to deal with for
               ;; compliance
@@ -140,6 +148,6 @@
                 ;; 60-69 CERTIFICATE REQUIRED
                 [(and (>= status 60)
                       (<= status 69))
-               (displayln "certificate handling not yet implemented")])))
+                 (displayln "certificate handling not yet implemented")]))))
 
           (iter url 5))))

net.rkt

@@ -1,11 +1,14 @@
 #lang racket
 
 (provide (contract-out
-          [request (-> url? (values integer? string? input-port?))]))
+          [request (-> url? (values integer? string? input-port?))])
+         (struct-out exn:fail:response))
 
 (require openssl)
 (require net/url-string)
 
+;; ssl-connect may raise (by way of tcp-connect) exn:fail:network
+;; read-response may raise exn:fail:network:gemini
 (define (request url)
   (define-values (c-in c-out)
     (ssl-connect (url-host url)
@@ -19,13 +22,30 @@
 
   (values status header c-in))
 
+(struct exn:fail:response exn:fail ()
+  #:extra-constructor-name make-exn:fail:response
+  #:transparent)
+
+(define (raise-response-error name message response)
+  (raise (make-exn:fail:response
+          (format (string-append "~a: ~a~n"
+                                 "  response: ~a")
+                  (symbol->string name)
+                  message
+                  (if (> (string-length response) 20)
+                      (format "~a... (truncated)" (substring response 0 20))
+                      response))
+          (current-continuation-marks))))
+
 (define (read-response (c-in (current-input-port)))
   (define maxlen 1027)
 
   (let ([header (peek-string maxlen 0 c-in)])
 
     (if (not (string-contains? header "\r\n"))
-        (error "header exceeds maximum length")
+        (raise-response-error 'read-response
+                              "header exceeds maximum length"
+                              header)
 
         (let ([header (read-line c-in 'return-linefeed)])
           (define-values (status meta)
@@ -35,10 +55,15 @@
 
           (cond
             [(> (string-length status) 2)
-             (error "status code exceeds maximum length")]
+             (raise-response-error 'read-response
+                                   "status code exceeds maximum length"
+                                   header)]
+
 
             [(andmap (compose not char-numeric?) (string->list status))
-             (error "status code is not numeric")]
+             (raise-response-error 'read-response
+                                   "status code not numeric"
+                                   header)]
 
             [else
              (values (string->number status) meta)])))))