kiefac/rebound
1
0
Fork 0
Code Issues Pull requests Actions Packages Projects Releases Wiki Activity

much cleaner url fixup; forgot to mention redirect support last commit

Browse source
This commit is contained in:
kiefac 2024-09-26 22:19:01 -04:00
parent a8114b6512
commit 7c06255781
2 changed files with 28 additions and 59 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

2
rebound.rkt
View file

@ -1,4 +1,4 @@
#lang racket/gui
(require "request-page.rkt")
(displayln (request-url-str "gemini://geminiprotocol.net/"))
(displayln (request-url-str "geminiprotocol.net"))

85
request-page.rkt
View file

@ -3,49 +3,15 @@
(require "strings.rkt")
(provide request-url request-url-str)
(define (path/params->str list)
(let ([result ""])
(for ([i list])
(set! result (~a result "/" (path/param-path i))))
result))
(define (queries->str list)
(let ([result ""]
[sep "?"])
(for ([i list])
(set! result (~a result sep (car i)))
(when (cdr i)
(set! result (~a result "=" (cdr i))))
(set! sep "&"))
result))
(define (fix-url url)
(if (url-scheme url)
(if (url-port url)
url
((λ () (set-url-port! url 1965)
url)))
(let* ([path-first (first (url-path url))]
[path-rest (if (empty? (url-path url))
#f
(rest (url-path url)))]
[query (queries->str (url-query url))]
[fragment (url-fragment url)]
[url-str (~a "gemini://"
(path/param-path path-first)
":1965")])
(when path-rest
(set! url-str (~a url-str (path/params->str path-rest))))
(when query
(set! url-str (~a url-str query)))
(when fragment
(set! url-str (~a url-str "#" fragment)))
(string->url url-str))))
(define (format-request url)
(~a (url->string url) "\r\n"))
(define (request-url-str url-str)
(let ([url (fix-url (string->url url-str))])
(let ([url (string->url (if (equal? "gemini://" (substring url-str 0 9))
url-str
(~a "gemini://" url-str)))])
(unless (url-port url)
(set-url-port! url 1965))
(request-url (url-host url) (url-port url) (format-request url))))
(define (request-url host port request)
@ -64,35 +30,38 @@
none-given)])
(case status-first
[(1) (case status-last
[(1) (~a sensitive-input info)]
[else (~a normal-input info)])]
[(1) (~a sensitive-input info)]
[else (~a normal-input info)])]
[(2) (case info
[("text/gemini" "text/plain")
(port->string in)]
[else (~a unhandled-mimetype info)])]
[else (~a unhandled-mimetype info)])]
[(3) (case status-last
[(1) (displayln (~a permanently-redirecting info))]
[else (displayln (~a temporarily-redirecting info))])
[(1) (displayln
(~a permanently-redirecting info))]
[else (displayln
(~a temporarily-redirecting info))])
(request-url-str info)]
[(4) (case status-last
[(1) (~a server-unavailable info)]
[(2) (~a cgi-error info)]
[(3) (~a proxy-error info)]
[(4) (~a slow-down info)]
[else (~a temporary-unspecified info)])]
[(1) (~a server-unavailable info)]
[(2) (~a cgi-error info)]
[(3) (~a proxy-error info)]
[(4) (~a slow-down info)]
[else (~a temporary-unspecified info)])]
[(5) (case status-last
[(1) (~a file-not-found info)]
[(2) (~a file-gone info)]
[(3) (~a proxy-refused info)]
[(9) (~a bad-request info)]
[else (~a permanent-unspecified info)])]
[(1) (~a file-not-found info)]
[(2) (~a file-gone info)]
[(3) (~a proxy-refused info)]
[(9) (~a bad-request info)]
[else (~a permanent-unspecified info)])]
[(6) (case status-last
[(1) (~a cert-unauthorized info)]
[(2) (~a cert-invalid info)]
[else (~a cert-required info)])]
[else (~a bad-status status)]))))
[(1) (~a cert-unauthorized info)]
[(2) (~a cert-invalid info)]
[else (~a cert-required info)])]
[else (~a bad-status status)]))))