diff --git a/client.rkt b/client.rkt index 1e0c3a9..2283500 100644 --- a/client.rkt +++ b/client.rkt @@ -30,107 +30,116 @@ (super-new) (define/public (up-cmd) - (if (string=? (path->string - (simplify-path - (url->path current-url))) - "/") + (if (null? current-url) - (displayln "already at root!") + (displayln "you need to 'go' somewhere first!") - (let ([parent - (simplify-path - (build-path (url->path current-url) 'up) - #f)]) - (get (struct-copy url current-url - [path (url-path (path->url parent))]))))) + (if (string=? (path->string + (simplify-path + (url->path current-url))) + "/") - (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))) + (displayln "already at root!") - (get (string->url url-string))) + (let ([parent + (simplify-path + (build-path (url->path current-url) 'up) + #f)]) + (get (struct-copy url current-url + [path (url-path (path->url parent))])))))) - (displayln "go where?"))) + (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))) - (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))))) + (get (string->url url-string))) - (iter 10) - (newline) - (let ([remaining (pipe-content-length document-buffer)]) - (printf "~a bytes remaining\n" remaining))) + (displayln "go where?"))) - (define/public (visit-cmd line) - (define url (gmi:match-link document-object line)) + (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))))) - (get (combine-url/relative current-url (url->string url)))) + (if (null? document-buffer) + (displayln "you need to 'go' somewhere first!") + (let () + (iter 10) + (newline) + (let ([remaining (pipe-content-length document-buffer)]) + (printf "~a bytes remaining\n" remaining))))) - (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")] + (define/public (visit-cmd line) + (if (null? document-object) + (displayln "you need to 'go' somewhere first!") + (let ([url (gmi:match-link document-object line)]) + (get (combine-url/relative current-url (url->string url)))))) - ;; 10-19 INPUT REQUIRED - [(and (>= status 10) - (<= status 19)) - (display "input requested > ") - (get (string-append url "?" (read-line)))] + (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")] - ;; 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)))] - (let-values ([(doc) (gmi:parse (port->lines c-in))] - [(db-in db-out) (make-pipe #f)]) + ;; 20-29 SUCCESS + [(and (>= status 20) + (<= status 29)) - (set! document-object doc) - (set! document-buffer db-in) - (parameterize ([current-output-port db-out]) - (gmi:render doc)) + (let-values ([(doc) (gmi:parse (port->lines c-in))] + [(db-in db-out) (make-pipe #f)]) - (set! current-url url) + (set! document-object doc) - (let ([remaining (pipe-content-length db-in)]) - (printf "document retrieved. ~a bytes\n" remaining)) + (set! document-buffer db-in) + (parameterize ([current-output-port db-out]) + (gmi:render doc)) - (next-cmd))] + (set! current-url url) - ;; 30-39 REDIRECT - [(and (>= status 30) - (<= status 39)) - (if (> depth 5) - (displayln "WARNING: maximum redirection depth exceeded") - (iter (string->url header) (sub1 depth)))] + (let ([remaining (pipe-content-length db-in)]) + (printf "document retrieved. ~a bytes\n" remaining)) - ;; 40-49 TEMPORARY FAILURE - [(and (>= status 40) - (<= status 49)) - (printf "status ~a: ~a\n" status - (dict-ref temporary-failures status "temporary failure"))] + (next-cmd))] - ;; 50-59 PERMANENT FAILURE - [(and (>= status 50) - (<= status 59)) - (printf "status ~a: ~a\n" status - (dict-ref permanent-failures status "permanent failure"))] + ;; 30-39 REDIRECT + [(and (>= status 30) + (<= status 39)) + (if (> depth 5) + (displayln "WARNING: maximum redirection depth exceeded") + (iter (string->url header) (sub1 depth)))] - ;; 60-69 CERTIFICATE REQUIRED - [(and (>= status 60) - (<= status 69)) - (displayln "certificate handling not yet implemented")]))) + ;; 40-49 TEMPORARY FAILURE + [(and (>= status 40) + (<= status 49)) + (printf "status ~a: ~a\n" status + (dict-ref temporary-failures status "temporary failure"))] - (iter url 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 5))))