implement some guards on the client. definitely need to relearn how to do syntax macros now...

This commit is contained in:
2025-09-06 12:29:36 -07:00
parent e081ec9edf
commit dbaa44190f

View File

@@ -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))))