99 lines
3.5 KiB
Racket
99 lines
3.5 KiB
Racket
#lang racket/gui
|
|
(require openssl net/url-string)
|
|
(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))])
|
|
(request-url (url-host url) (url-port url) (format-request url))))
|
|
|
|
(define (request-url host port request)
|
|
(let-values ([(in out) (ssl-connect/enable-break host port)])
|
|
(file-stream-buffer-mode out 'none)
|
|
(display request out)
|
|
(flush-output out)
|
|
|
|
(let* (
|
|
[response-head (read-line in)]
|
|
[status (string->number (substring response-head 0 2))]
|
|
[status-first (quotient status 10)]
|
|
[status-last (modulo status 10)]
|
|
[info (if (> (string-length response-head) 2)
|
|
(string-trim (substring response-head 2))
|
|
none-given)])
|
|
(case status-first
|
|
[(1) (case status-last
|
|
[(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)])]
|
|
|
|
[(3) (case status-last
|
|
[(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)])]
|
|
|
|
[(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)])]
|
|
|
|
[(6) (case status-last
|
|
[(1) (~a cert-unauthorized info)]
|
|
[(2) (~a cert-invalid info)]
|
|
[else (~a cert-required info)])]
|
|
[else (~a bad-status status)]))))
|