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

set the scene for mime handling. however, some changes to how internal state is handled will need to be made before adding plaintext rendering.

Browse Source
This commit is contained in:
w6vvn
2025-09-06 17:27:09 -07:00
parent 7e1e21439d
commit f5d70e7488
1 changed files with 57 additions and 49 deletions
Download Patch File Download Diff File Expand all files Collapse all files

106
client.rkt
View File

@@ -48,49 +48,66 @@
(get (struct-copy url current-url (get (struct-copy url current-url
[path (url-path (path->url parent))])))))) [path (url-path (path->url parent))]))))))
(define/public (go-cmd url-string) (define/public (go-cmd url-string)
(if (non-empty-string? url-string) (if (non-empty-string? url-string)
(let () (let ()
(when (not (string-contains? url-string "://")) (when (not (string-contains? url-string "://"))
(set! url-string (string-append "gemini://" url-string))) (set! url-string (string-append "gemini://" url-string)))
(get (string->url url-string))) (get (string->url url-string)))
(displayln "go where?"))) (displayln "go where?")))
(define/public (next-cmd) (define/public (next-cmd)
(define (iter depth) (define (iter depth)
(when (and (> depth 0) (when (and (> depth 0)
(> (pipe-content-length document-buffer) 0)) (> (pipe-content-length document-buffer) 0))
(let () (let ()
(displayln (read-line document-buffer)) (displayln (read-line document-buffer))
(iter (sub1 depth))))) (iter (sub1 depth)))))
(if (null? document-buffer) (if (null? document-buffer)
(displayln "you need to 'go' somewhere first!") (displayln "you need to 'go' somewhere first!")
(let () (let ()
(iter 10) (iter 10)
(newline) (newline)
(let ([remaining (pipe-content-length document-buffer)]) (let ([remaining (pipe-content-length document-buffer)])
(printf "~a bytes remaining\n" remaining))))) (printf "~a bytes remaining\n" remaining)))))
(define/public (visit-cmd line) (define/public (visit-cmd line)
(if (null? document-object) (if (null? document-object)
(displayln "you need to 'go' somewhere first!") (displayln "you need to 'go' somewhere first!")
(let ([url (gmi:match-link document-object line)]) (let ([url (gmi:match-link document-object line)])
(get (combine-url/relative current-url (url->string url)))))) (get (combine-url/relative current-url (url->string url))))))
(define/private (get url) (define/private (handle-gmi url c-in)
(define (iter url depth) (let-values ([(doc) (gmi:parse (port->lines c-in))]
(with-handlers [(db-in db-out) (make-pipe #f)])
([exn:fail:network?
(λ (exn) (set! document-object doc)
(displayln (exn-message exn)))]
(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)))
(define/private (get url)
(define (iter url depth)
(with-handlers
([exn:fail:network?
(λ (exn)
(displayln (exn-message exn)))]
[net:exn:fail:response? [net:exn:fail:response?
(λ (exn) (λ (exn)
(displayln (exn-message exn)))]) (displayln (exn-message exn)))])
(let-values ([(status header c-in) (net:request url)]) (let-values ([(status meta c-in) (net:request url)])
;; TODO there are bunch of other status codes to deal with for ;; TODO there are bunch of other status codes to deal with for
;; compliance ;; compliance
(cond (cond
@@ -109,28 +126,19 @@
[(and (>= status 20) [(and (>= status 20)
(<= status 29)) (<= status 29))
(let-values ([(doc) (gmi:parse (port->lines c-in))] (let ([mime (car (string-split meta ";"))])
[(db-in db-out) (make-pipe #f)]) (cond
[(string=? mime "text/gemini")
(set! document-object doc) (handle-gmi url c-in)]
[else
(set! document-buffer db-in) (printf "unsupported mime type: ~a~n" mime)]))]
(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))]
;; 30-39 REDIRECT ;; 30-39 REDIRECT
[(and (>= status 30) [(and (>= status 30)
(<= status 39)) (<= status 39))
(if (> depth 5) (if (> depth 5)
(displayln "WARNING: maximum redirection depth exceeded") (displayln "WARNING: maximum redirection depth exceeded")
(iter (string->url header) (sub1 depth)))] (iter (string->url meta) (sub1 depth)))]
;; 40-49 TEMPORARY FAILURE ;; 40-49 TEMPORARY FAILURE
[(and (>= status 40) [(and (>= status 40)