gratchy.scm

   1 (import (chicken io)
   2         (chicken file)
   3         (chicken pathname)
   4         (chicken condition)
   5         uri-common)
   6
   7 (define SERVER-ROOT "public_gemini")
   8 (define SERVER-HOST "thelambdalab.xyz")
   9
  10 (define file-types
  11   '(("gmi" "text/gemini; charset=utf8")
  12     ("txt" "text/plain; charset=utf8")))
  13
  14 (define (process-request request-line)
  15   (condition-case
  16       (let ((uri (uri-normalize-path-segments (absolute-uri request-line))))
  17         (cond
  18          ((not (eq? (uri-scheme uri) 'gemini))
  19           (fail-permanent "Unsupported scheme."))
  20          ((not (uri-host uri))
  21           (fail-permanent "URL lacks host name."))
  22          ((not (equal? (uri-host uri) SERVER-HOST))
  23           (fail-permanent "Proxy requests forbidden."))
  24          ((uri-path-relative? uri)
  25           (fail-permanent "Path must be absolute."))
  26          ((not (document-available? uri))
  27           (fail-permanent "Document not found."))
  28          (else (serve-document uri))))
  29     (o (exn)
  30        (print o)
  31        (fail-permanent "Failed to parse URL."))))
  32
  33 (define (fail-permanent reason)
  34   (print "50 " reason "\r"))
  35
  36 (define (document-available? uri)
  37   (print (document-path uri))
  38   (file-exists? (document-path uri)))
  39
  40 (define (document-path uri)
  41   (let* ((crumbs (reverse (cons SERVER-ROOT (cdr (uri-path uri)))))
  42          (path (make-pathname (reverse (cdr crumbs)) (car crumbs))))
  43     (if (directory-exists? path)
  44         (make-pathname path "index.gmi")
  45         path)))
  46
  47 (define (serve-document uri)
  48   (let ((path (document-path uri)))
  49     (print "20 Surprise!\r")))
  50
  51
  52 (process-request "gemini://thelambdalab.xyz//")