hobby-http.lsp

   1 #!/usr/local/bin/newlisp
   2 #
   3 # Simple HTTP service for a directory tree. Start with:
   4 #
   5 # newlisp hobby-http.lsp -c -d $PORT -w $TREE
   6 #
   7
   8 ; Exit on ^C -- not cleanly
   9 (signal 2 (fn (x) (write-line 2 "Exiting") (close 3) (exit 0)))
  10
  11 ; Resolve the root path
  12 (constant 'HERE (real-path ((match '(* "-w" ? *) (main-args)) 1)))
  13
  14 ; Map absolute path
  15 (define (actual PATH)
  16   (if (starts-with PATH "/") (string HERE PATH) PATH))
  17
  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
  23       true
  24       (if (file? (string P0 ".html")) (string PATH ".html")
  25         (file? (string P0 "/index.html"))
  26         (string PATH (if (ends-with PATH "/") "" "/") "index.html")
  27         PATH )
  28       PATH )))
  29
  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))
  36     C))
  37
  38 (command-event tag-on-html)