From: Tim Vaughan <plugd@thelambdalab.xyz>
Date: Fri, 22 May 2020 20:17:43 +0000 (+0200)
Subject: Fleshing out server.
X-Git-Url: https://thelambdalab.xyz/gitweb/index.cgi?a=commitdiff_plain;h=4a298f7242c02e226685e3c087e8aca882994cf1;p=rags.git

Fleshing out server.
---

diff --git a/gratchy.scm b/gratchy.scm
index 4edb63d..3ddb540 100644
--- a/gratchy.scm
+++ b/gratchy.scm
@@ -7,6 +7,10 @@
 (define SERVER-ROOT "public_gemini")
 (define SERVER-HOST "thelambdalab.xyz")
 
+(define file-types
+  '(("gmi" "text/gemini; charset=utf8")
+    ("txt" "text/plain; charset=utf8")))
+
 (define (process-request request-line)
   (condition-case
       (let ((uri (uri-normalize-path-segments (absolute-uri request-line))))
@@ -30,12 +34,19 @@
   (print "50 " reason "\r"))
 
 (define (document-available? uri)
-  (let ((path (apply make-pathname (cons SERVER-ROOT (cdr (uri-path uri))))))
-    (file-exists? path)))
-    
+  (print (document-path uri))
+  (file-exists? (document-path uri)))
 
+(define (document-path uri)
+  (let* ((crumbs (reverse (cons SERVER-ROOT (cdr (uri-path uri)))))
+         (path (make-pathname (reverse (cdr crumbs)) (car crumbs))))
+    (if (directory-exists? path)
+        (make-pathname path "index.gmi")
+        path)))
+    
 (define (serve-document uri)
-  (print "20 Surprise!\r"))
+  (let ((path (document-path uri)))
+    (print "20 Surprise!\r")))
 
 
-(process-request "gemini://thelambdalab.xyz/../index")
+(process-request "gemini://thelambdalab.xyz//")