diff --git a/rebound.rkt b/rebound.rkt index 133c5ab..1e5fa62 100644 --- a/rebound.rkt +++ b/rebound.rkt @@ -1,8 +1,4 @@ #lang racket/gui (require "request-page.rkt") -(define port 1965) -(define target "geminiprotocol.net") -(define request "gemini://geminiprotocol.net/\r\n") - -(displayln (request-uri target port request)) +(displayln (request-url-str "gemini://geminiprotocol.net/")) diff --git a/request-page.rkt b/request-page.rkt index 276be5f..8708695 100644 --- a/request-page.rkt +++ b/request-page.rkt @@ -1,10 +1,55 @@ #lang racket/gui -(require openssl) +(require openssl net/url-string) (require "strings.rkt") -(provide request-uri) +(provide request-url request-url-str) -(define (request-uri target port request) - (let-values ([(in out) (ssl-connect/enable-break target port)]) +(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) @@ -28,8 +73,9 @@ [else (~a unhandled-mimetype info)])] [(3) (case status-last - [(1) (~a permanently-redirecting info)] - [else (~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)]