accept strings directly, fix incomplete urls (without scheme, port, etc)

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/"))

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)]