From 1d39d886d8185117ae0312c9780557f2b5cd9b8e Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Fri, 22 May 2020 21:54:03 +0200 Subject: [PATCH] Initialized repository. --- gratchy.scm | 41 +++++++++++++++++++++++++++++++++++++++++ 1 file changed, 41 insertions(+) create mode 100644 gratchy.scm 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") -- 2.20.1