From 1565ce19b8b982b719a4672ce7f9023c9da55b7c Mon Sep 17 00:00:00 2001
From: haskal <haskal@awoo.systems>
Date: Mon, 17 Aug 2020 23:52:39 -0400
Subject: [PATCH] basic protocol

---
 Makefile        |  7 ++++
 gemini/main.rkt | 94 +++++++++++++++++++++++++++++++++++++++++++++++--
 2 files changed, 99 insertions(+), 2 deletions(-)
 create mode 100644 Makefile

diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..83f7f6b
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,7 @@
+.PHONY: nothing setup
+
+nothing:
+	@echo nothing to do here...
+
+setup:
+	raco pkg install gemini/
diff --git a/gemini/main.rkt b/gemini/main.rkt
index 157a494..f17aa94 100644
--- a/gemini/main.rkt
+++ b/gemini/main.rkt
@@ -1,5 +1,95 @@
 #lang racket/base
 
-(provide helloworld)
+(require racket/match racket/function racket/port racket/string
+         net/url net/url-structs net/url-string)
+
+(provide (struct-out gmi-rsp)
+         (struct-out gmi-rsp:success)
+         gemini-request-read
+         gemini-parse-success-meta
+         gemini-response-read
+         gemini-request-write
+         gemini-response-write
+         gemini-make-success-meta)
+
+;; protocol
+
+(define gmi-codes
+  (hash 'input 10
+        'sensitive-input 11
+        'success 20
+        'redirect-temp 30
+        'redirect-perm 31
+        'failure-temp 40
+        'server-unavailable 41
+        'cgi-error 42
+        'proxy-error 43
+        'slow-down 44
+        'failure-perm 50
+        'not-found 51
+        'gone 52
+        'proxy-fail 53
+        'bad-request 59
+        'cert-required 60
+        'cert-not-authorized 61
+        'cert-not-valid 62))
+(define gmi-rev-codes
+  (for/hash ([(k v) (in-hash gmi-codes)])
+    (values v k)))
+
+;; Int Str
+(struct gmi-rsp [status meta-line] #:transparent)
+;; Str Hash Port
+(struct gmi-rsp:success gmi-rsp [mime extra-fields body] #:transparent)
+
+;; port -> url
+;; reads a gemini request (returns the URL)
+(define (gemini-request-read [port (current-input-port)])
+  (let ([line (read-line port 'any)])
+    (string->url port)))
+
+;; util: parse success meta text
+;; str -> mimetype fields-hash
+(define (gemini-parse-success-meta meta)
+  (match (regexp-split #px"; *" meta)
+    [(list meta rst ...)
+     (values meta (for/hash ([item (in-list rst)])
+                  (match (regexp-match-positions "=" item)
+                    [(list (cons pos _)) (values (substring item 0 pos) (substring item (add1 pos)))]
+                    [_ (values item #t)])))]
+    ['() (raise (exn:fail:network "gmi protocol error" (current-continuation-marks)))]))
+
+;; port -> gmi-rsp
+(define (gemini-response-read [port (current-input-port)])
+  (let ([line (read-line port 'any)])
+    (match (regexp-match #px"^([0-9]{2}) (.*?)$" line)
+      [(list _ status-str meta)
+       (let ([status (string->number status-str)])
+         (match status
+           [(? (curry = (hash-ref gmi-codes 'success)))
+            (let-values ([(mime extra-fields) (gemini-parse-success-meta meta)])
+              (gmi-rsp:success status meta mime extra-fields port))]
+           [_
+            (close-input-port port)
+            (gmi-rsp status meta)]))]
+      [_ (raise (exn:fail:network "gmi protocol error" (current-continuation-marks)))])))
+
+;; url port ->
+(define (gemini-request-write req-url [port (current-output-port)])
+  (write-string (format "~a\r\n" (url->string req-url)) port))
+
+;; gmi-rsp port ->
+(define (gemini-response-write resp [port (current-output-port)])
+  (write-string (format "~a ~a\r\n" (gmi-rsp-status resp) (gmi-rsp-meta-line resp)) port))
+
+;; string hash -> string
+(define (gemini-make-success-meta mime extra-fields)
+  (string-join (cons mime (for/list ([(k v) (in-hash extra-fields)])
+                            (match v
+                              [#t k]
+                              [_ (string-append k "=" v)])))
+               "; "))
+
+(module+ test
+  (require rackunit))
 
-(define (helloworld) (displayln "hello world"))