Various newlisp scripts.
You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.
 
 

50 lines
1.7 KiB

#!/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)