complete response handling
This commit is contained in:
85
gem300.rkt
85
gem300.rkt
@@ -15,6 +15,20 @@
|
|||||||
;; global state for the url of the currently visited document
|
;; global state for the url of the currently visited document
|
||||||
(define current-url null)
|
(define current-url null)
|
||||||
|
|
||||||
|
(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 (get url-str)
|
(define (get url-str)
|
||||||
(define (iter url-str depth)
|
(define (iter url-str depth)
|
||||||
(let-values ([(status header c-in) (net:request url-str)])
|
(let-values ([(status header c-in) (net:request url-str)])
|
||||||
@@ -24,19 +38,59 @@
|
|||||||
;; clients MUST reject status codes outside of the 10-69 range
|
;; clients MUST reject status codes outside of the 10-69 range
|
||||||
[(or (< status 10)
|
[(or (< status 10)
|
||||||
(> status 69))
|
(> status 69))
|
||||||
(error "server returned invalid status code")]
|
(displayln "WARNING: server returned invalid status code")]
|
||||||
|
|
||||||
;; 30-39 redirection
|
;; 10-19 INPUT REQUIRED
|
||||||
|
[(and (>= status 10)
|
||||||
|
(<= status 19))
|
||||||
|
(display "input requested > ")
|
||||||
|
(get (string-append url-str "?" (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 doc)
|
||||||
|
|
||||||
|
(set! document-buffer db-in)
|
||||||
|
(parameterize ([current-output-port db-out])
|
||||||
|
(gmi:render doc))
|
||||||
|
|
||||||
|
(set! current-url url-str)
|
||||||
|
|
||||||
|
(let ([remaining (pipe-content-length db-in)])
|
||||||
|
(printf "document retrieved. ~a bytes\n" remaining))
|
||||||
|
|
||||||
|
(next-cmd))]
|
||||||
|
|
||||||
|
;; 30-39 REDIRECT
|
||||||
[(and (>= status 30)
|
[(and (>= status 30)
|
||||||
(<= status 39))
|
(<= status 39))
|
||||||
(if (> depth 5)
|
(if (> depth 5)
|
||||||
(error "maximum redirection depth exceeded")
|
(displayln "WARNING: maximum redirection depth exceeded")
|
||||||
(iter header (sub1 depth)))]
|
(iter header (sub1 depth)))]
|
||||||
|
|
||||||
[else
|
;; 40-49 TEMPORARY FAILURE
|
||||||
(values status header c-in)])))
|
[(and (>= status 40)
|
||||||
|
(<= status 49))
|
||||||
|
(printf "status ~a: ~a\n" status
|
||||||
|
(dict-ref temporary-failures status "temporary failure"))]
|
||||||
|
|
||||||
(iter url-str 5))
|
;; 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-str 5))
|
||||||
|
|
||||||
(define (go-cmd url)
|
(define (go-cmd url)
|
||||||
(if (non-empty-string? url)
|
(if (non-empty-string? url)
|
||||||
@@ -44,22 +98,7 @@
|
|||||||
(when (not (string-contains? url "://"))
|
(when (not (string-contains? url "://"))
|
||||||
(set! url (string-append "gemini://" url)))
|
(set! url (string-append "gemini://" url)))
|
||||||
|
|
||||||
(let-values ([(status meta c-in) (get url)])
|
(get url))
|
||||||
(let-values ([(doc) (gmi:parse (port->lines c-in))]
|
|
||||||
[(db-in db-out) (make-pipe #f)])
|
|
||||||
|
|
||||||
(set! document 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))))
|
|
||||||
|
|
||||||
(displayln "go where?")))
|
(displayln "go where?")))
|
||||||
|
|
||||||
@@ -81,7 +120,7 @@
|
|||||||
(set! url
|
(set! url
|
||||||
(url->string (combine-url/relative (string->url current-url)
|
(url->string (combine-url/relative (string->url current-url)
|
||||||
url)))
|
url)))
|
||||||
(go-cmd url))
|
(get url))
|
||||||
|
|
||||||
(define (repl)
|
(define (repl)
|
||||||
(display "G-300 > ")
|
(display "G-300 > ")
|
||||||
|
Reference in New Issue
Block a user