w6vvn/gem300
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

add proper handling of exceptions raised by network procedures

Browse Source
This commit is contained in:
w6vvn
2025-09-06 16:41:42 -07:00
parent dbaa44190f
commit dbe6bbf43b
2 changed files with 84 additions and 51 deletions
Download Patch File Download Diff File Expand all files Collapse all files

102
client.rkt
View File

@@ -82,64 +82,72 @@
(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")]
(with-handlers
([exn:fail:network?
(λ (exn)
(displayln (exn-message exn)))]
[net:exn:fail:response?
(λ (exn)
(displayln (exn-message exn)))])
;; 10-19 INPUT REQUIRED
[(and (>= status 10)
(<= status 19))
(display "input requested > ")
(get (string-append url "?" (read-line)))]
(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")]
;; 20-29 SUCCESS
[(and (>= status 20)
(<= status 29))
;; 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)])
(let-values ([(doc) (gmi:parse (port->lines c-in))]
[(db-in db-out) (make-pipe #f)])
(set! document-object doc)
(set! document-object doc)
(set! document-buffer db-in)
(parameterize ([current-output-port db-out])
(gmi:render doc))
(set! document-buffer db-in)
(parameterize ([current-output-port db-out])
(gmi:render doc))
(set! current-url url)
(set! current-url url)
(let ([remaining (pipe-content-length db-in)])
(printf "document retrieved. ~a bytes\n" remaining))
(let ([remaining (pipe-content-length db-in)])
(printf "document retrieved. ~a bytes\n" remaining))
(next-cmd))]
(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)))]
;; 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"))]
;; 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"))]
;; 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")])))
;; 60-69 CERTIFICATE REQUIRED
[(and (>= status 60)
(<= status 69))
(displayln "certificate handling not yet implemented")]))))
(iter url 5))))
(iter url 5))))