From: Ralph Ronnquist Date: Mon, 8 May 2023 01:03:18 +0000 (+1000) Subject: initial X-Git-Url: https://git.rrq.au/?a=commitdiff_plain;p=rrq%2Fnewlisp%2Fhobby-http.git initial --- 7f114263cec492c198b8ecc0b1b02e5666e86531 diff --git a/.gitweb b/.gitweb new file mode 100644 index 0000000..7c11d3b --- /dev/null +++ b/.gitweb @@ -0,0 +1,2 @@ +description = Simple HTTP service for serving a directory tree. +category = newlisp diff --git a/hobby-http.adoc b/hobby-http.adoc new file mode 100644 index 0000000..b476ecf --- /dev/null +++ b/hobby-http.adoc @@ -0,0 +1,13 @@ +hobby-http.lsp +============== + +This script utilizes newlisp's built-in HTTP service for serving a +directory tree. Run as + + $ newlisp hobby-http.lsp -c -http -d $PORT -w $ROOT + +It limits to handling GET and HEAD requests. + +See http://www.newlisp.org/downloads/manual_frame.html for details on +newlisp. + diff --git a/hobby-http.lsp b/hobby-http.lsp new file mode 100755 index 0000000..33b8da7 --- /dev/null +++ b/hobby-http.lsp @@ -0,0 +1,50 @@ +#!/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)