1 #!/usr/local/bin/newlisp
3 # Simple HTTP service for a directory tree. Start with:
5 # newlisp hobby-http.lsp -c -d $PORT -w $TREE
8 ; Exit on ^C -- not cleanly
9 (signal 2 (fn (x) (write-line 2 "Exiting") (close 3) (exit 0)))
11 ; Resolve the root path
12 (constant 'HERE (real-path ((match '(* "-w" ? *) (main-args)) 1)))
16 (if (starts-with PATH "/") (string HERE PATH) PATH))
18 ; Rewriting rules: add ".html" or "/index.html" to request path where
19 ; that results in an actual file.
20 (define (maybe-html PATH)
21 (let ((P0 (actual PATH)) (HTML nil))
22 (if (find ".." PATH) PATH
24 (if (file? (string P0 ".html")) (string PATH ".html")
25 (file? (string P0 "/index.html"))
26 (string PATH (if (ends-with PATH "/") "" "/") "index.html")
30 ; Apply rewriting rules for some requests
31 (define (tag-on-html X)
32 (write-line 2 (string "> " X ))
33 (let ((C (if (and (string? X) (regex "^GET ([^ ]+) (.+)" X 0))
34 (format "GET %s %s\r\n" (maybe-html $1) $2) X)))
35 (write-line 2 (string "< " C))
38 (command-event tag-on-html)