From 4a298f7242c02e226685e3c087e8aca882994cf1 Mon Sep 17 00:00:00 2001 From: Tim Vaughan Date: Fri, 22 May 2020 22:17:43 +0200 Subject: [PATCH] Fleshing out server. --- gratchy.scm | 21 ++++++++++++++++----- 1 file changed, 16 insertions(+), 5 deletions(-) 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//") -- 2.20.1