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 (process-request request-line)
  11   (condition-case
  12       (let ((uri (uri-normalize-path-segments (absolute-uri request-line))))
  13         (cond
  14          ((not (eq? (uri-scheme uri) 'gemini))
  15           (fail-permanent "Unsupported scheme."))
  16          ((not (uri-host uri))
  17           (fail-permanent "URL lacks host name."))
  18          ((not (equal? (uri-host uri) SERVER-HOST))
  19           (fail-permanent "Proxy requests forbidden."))
  20          ((uri-path-relative? uri)
  21           (fail-permanent "Path must be absolute."))
  22          ((not (document-available? uri))
  23           (fail-permanent "Document not found."))
  24          (else (serve-document uri))))
  25     (o (exn)
  26        (print o)
  27        (fail-permanent "Failed to parse URL."))))
  28
  29 (define (fail-permanent reason)
  30   (print "50 " reason "\r"))
  31
  32 (define (document-available? uri)
  33   (let ((path (apply make-pathname (cons SERVER-ROOT (cdr (uri-path uri))))))
  34     (file-exists? path)))
  35
  36
  37 (define (serve-document uri)
  38   (print "20 Surprise!\r"))
  39
  40
  41 (process-request "gemini://thelambdalab.xyz/../index")