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
[path (url-path (path->url parent))]))))))
(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 (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)))
(get (string->url url-string)))
(get (string->url url-string)))
(displayln "go where?")))
(displayln "go where?")))
(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)))))
(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)))))
(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)))))
(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/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))))))
(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))))))
(define/private (get url)
(define (iter url depth)
(with-handlers
([exn:fail:network?
(λ (exn)
(displayln (exn-message exn)))]
(define/private (handle-gmi url c-in)
(let-values ([(doc) (gmi:parse (port->lines c-in))]
[(db-in db-out) (make-pipe #f)])
(set! document-object 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)))
(define/private (get url)
(define (iter url depth)
(with-handlers
([exn:fail:network?
(λ (exn)
(displayln (exn-message exn)))]
[net:exn:fail:response?
(λ (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
;; compliance
(cond
@@ -109,28 +126,19 @@
[(and (>= status 20)
(<= status 29))
(let-values ([(doc) (gmi:parse (port->lines c-in))]
[(db-in db-out) (make-pipe #f)])
(set! document-object 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))]
(let ([mime (car (string-split meta ";"))])
(cond
[(string=? mime "text/gemini")
(handle-gmi url c-in)]
[else
(printf "unsupported mime type: ~a~n" mime)]))]
;; 30-39 REDIRECT
[(and (>= status 30)
(<= status 39))
(if (> depth 5)
(displayln "WARNING: maximum redirection depth exceeded")
(iter (string->url header) (sub1 depth)))]
(iter (string->url meta) (sub1 depth)))]
;; 40-49 TEMPORARY FAILURE
[(and (>= status 40)