A trivial gemini server in 100 lines of racket

gemini-server.rkt

#lang racket
;; Limit our memory usage
(custodian-limit-memory (current-custodian) (* 16 1024 1024))

;; Load libraries
(require openssl)
(require racket/date)
(require net/url-string)

;; Define the folders we are going to use
(define gemini-dir (reroot-path "/public_gemini" (find-system-path 'home-dir)))
(define private-dir (reroot-path "/.config/gemini" (find-system-path 'home-dir)))
(define test-key "/usr/share/racket/collects/openssl/test.pem")

;; Define how to display dates
(date-display-format 'iso-8601)

;; Define an SSL listener, immediately load certificates from `private-dir`
(define listener (ssl-listen 1965 5 #t))  
(ssl-load-certificate-chain! listener (reroot-path "/localhost.crt" private-dir))
(ssl-load-private-key! listener (reroot-path "/localhost.key" private-dir))

;; cleanse-path PATH -- returns a cleaned-up version of PATH
;;   Basically works the same as `(simplify-path PATH #f)`, but it also
;;   removes `.` and `..` from the beginning of the path.
(define (cleanse-path path)
  (apply build-path
         (filter (lambda (x) (not (or (equal? x 'up) (equal? x 'same))))
                 (explode-path (simplify-path path #f)))))

;; localize-path PATH [BASE] -- relocates PATH under BASE
(define (localize-path path [base (find-system-path 'home-dir)])
  (reroot-path (path->complete-path (cleanse-path path) "/") base))

;; path-exists? PATH -- checks if PATH exists and is either a file or a directory
(define (path-exists? path)
  (or (file-exists? path) (directory-exists? path)))

;; get-perms PATH -- returns the permission bits for PATH
(define (get-perms path)
  (file-or-directory-permissions path 'bits))

;; world-readable? PATH -- checks if the file at PATH is world-readable
(define (world-readable? path)
  (= (bitwise-and (get-perms path) #o444) #o444))

;; file-listing PATH -- creates a text/gemini-formatted file listing for PATH
(define (file-listing path)
  (for/list ([f (in-directory path)] #:unless (not (world-readable? f)))
    (if (file-exists? f)
        (format "=> ~a ~a [~aB]" (find-relative-path gemini-dir f) (file-name-from-path f) (file-size f))
        (format "=> ~a ~a" (find-relative-path gemini-dir f) (file-name-from-path f)))))

;; gemini-serve REQUEST OUTPORT -- serves the response to REQUEST to OUTPORT
;;   Checks if the file specified by REQUEST exists under `gemini-dir`, and
;;   if it is world readable.  If it does, it is served as text/gemini.  If
;;   it is a folder, and its `index.gmi` exists and is world-readable, it is
;;   served instead; if it doesn't exist, then a simple directory listing is
;;   created.
;;
;;   If the file requested does not exist at all, or if it is not world-
;;   readable, then replies with `51 Not Found`.
(define (gemini-serve request outport)
  (define (outline string . pieces) (fprintf outport "~a~c~n" (apply format string pieces) #\return))
  (define (log string) (display (current-memory-use)) (display (format "~a~n" string)))
  (log request)
  (let* ([path (url->path (string->url request))]
         [file (localize-path path gemini-dir)]
         [ok (and (path-exists? file) (world-readable? file))])
    (log file)
    (cond
      [(and ok (directory-exists? file) (file-exists? (localize-path "index.gmi" file)))
       (outline "~a ~a" 20 "text/gemini")
       (call-with-input-file (localize-path "index.gmi" file)
         (lambda (in) (copy-port in outport)))]
      [(and ok (directory-exists? file))
       (outline "~a ~a" 20 "text/gemini")
       (outline "# ~a:" (find-relative-path gemini-dir file #:more-than-same? #f))
       (outline (string-join (file-listing file) "\n"))
       (outline "---~nGenerated by UNNAMED-GEMINI-SERVER on ~a" (date->string (current-date) #t))]
      [ok
       (outline "~a ~a" 20 "text/gemini")
       (call-with-input-file file
         (lambda (in) (copy-port in outport)))]
      [else
       (outline "~a ~a" 51 "Not found")])))

;; Main server loop: accepts an SSL connection, reads a single line from the
;; client, and invokes `(gemini-serve)` to handle it.  Handles exceptions by
;; printing them out and ignoring them.
(let gemini-server ()
  (with-handlers ([exn:fail:network?
                   (lambda (e) (displayln (exn-message e)))])
    (define-values [inport outport] (ssl-accept listener))
    (thread (lambda ()
              (let ((request (read-line inport 'return-linefeed)))
                (close-input-port inport)
                (gemini-serve request outport)
                (close-output-port outport)))))
  (gemini-server))