#!/usr/bin/newlisp
#
# Simple HTTP service for a directory tree. Start with:
#
# newlisp hobby-http.lsp -c -http -d $PORT -w $TREE
#
# Note that it does not make automatic file indexes of directories,
# and it only shows the files that are there. Some files are handled
# by their file extension, such as: .avi, .cgi, .css, .gif, .htm,
# .html, .jpg, .js, .mov, .mp3,.mpg, .pdf, .png, .wav, .zip. Those
# files are served with appropriate mime types, except .cgi which if
# executable will be executed as a near CGI 1.1 script. Other files
# are served with type "text/plain".

; 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 ))
  (setf X (if (and (string? X) (regex "^([^\\s]+) ([^ ]+) (.+)" X 0))
              (let ((A $1) (B $2) (C $3))
                (format "%s %s %s\r\n" A (maybe-html B) C) X)))
  (write-line 2 (string "< " X))
  X)

(define (filter-request X)
  (if (starts-with X "(GET|HEAD)" 0) (tag-on-html X)
    "GET /403.html HTTP/1.1"))

(command-event filter-request)