#!/usr/local/bin/newlisp
#
# Simple HTTP service for a directory tree. Start with:
#
# newlisp hobby-http.lsp -c -d $PORT -w $TREE
#

; Exit on ^C -- not cleanly
(signal 2 (fn (x) (write-line 2 "Exiting") (close 3) (exit 0)))

; Resolve the root path
(constant 'HERE (real-path ((match '(* "-w" ? *) (main-args)) 1)))

; Map absolute path
(define (actual PATH)
  (if (starts-with PATH "/") (string HERE PATH) PATH))

; Rewriting rules: add ".html" or "/index.html" to request path where
; that results in an actual file.
(define (maybe-html PATH)
  (let ((P0 (actual PATH)) (HTML nil))
    (if (find ".." PATH) PATH
      true 
      (if (file? (string P0 ".html")) (string PATH ".html")
        (file? (string P0 "/index.html"))
        (string PATH (if (ends-with PATH "/") "" "/") "index.html")
        PATH )
      PATH )))

; Apply rewriting rules for some requests
(define (tag-on-html X)
  (write-line 2 (string "> " X ))
  (let ((C (if (and (string? X) (regex "^GET ([^ ]+) (.+)" X 0))
               (format "GET %s %s\r\n" (maybe-html $1) $2) X)))
    (write-line 2 (string "< " C))
    C))

(command-event tag-on-html)