From: Ralph Ronnquist <ralph.ronnquist@gmail.com>
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)