From: Tim Vaughan <plugd@thelambdalab.xyz>
Date: Fri, 22 May 2020 19:54:03 +0000 (+0200)
Subject: Initialized repository.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?p=rags.git;a=commitdiff_plain;h=1d39d886d8185117ae0312c9780557f2b5cd9b8e

Initialized repository.
---

1d39d886d8185117ae0312c9780557f2b5cd9b8e
diff --git a/gratchy.scm b/gratchy.scm
new file mode 100644
index 0000000..4edb63d
--- /dev/null
+++ b/gratchy.scm
@@ -0,0 +1,41 @@
+(import (chicken io)
+        (chicken file)
+        (chicken pathname)
+        (chicken condition)
+        uri-common)
+
+(define SERVER-ROOT "public_gemini")
+(define SERVER-HOST "thelambdalab.xyz")
+
+(define (process-request request-line)
+  (condition-case
+      (let ((uri (uri-normalize-path-segments (absolute-uri request-line))))
+        (cond
+         ((not (eq? (uri-scheme uri) 'gemini))
+          (fail-permanent "Unsupported scheme."))
+         ((not (uri-host uri))
+          (fail-permanent "URL lacks host name."))
+         ((not (equal? (uri-host uri) SERVER-HOST))
+          (fail-permanent "Proxy requests forbidden."))
+         ((uri-path-relative? uri)
+          (fail-permanent "Path must be absolute."))
+         ((not (document-available? uri))
+          (fail-permanent "Document not found."))
+         (else (serve-document uri))))
+    (o (exn)
+       (print o)
+       (fail-permanent "Failed to parse URL."))))
+
+(define (fail-permanent reason)
+  (print "50 " reason "\r"))
+
+(define (document-available? uri)
+  (let ((path (apply make-pathname (cons SERVER-ROOT (cdr (uri-path uri))))))
+    (file-exists? path)))
+    
+
+(define (serve-document uri)
+  (print "20 Surprise!\r"))
+
+
+(process-request "gemini://thelambdalab.xyz/../index")