X-Git-Url: https://git.rrq.au/?a=blobdiff_plain;f=hobby-http.lsp;h=33b8da7287a7e7bc8cd86b8895065799fe338ac0;hb=3ca0fb04b17c5361c5396b58013a5622a6a52df4;hp=3b6be62a354f573a07cb21794e654d79a06d6ba1;hpb=a904a9831583a57edf8cb233e4f7d653816f2fde;p=rrq%2Fnewlisp-ftw.git

diff --git a/hobby-http.lsp b/hobby-http.lsp
index 3b6be62..33b8da7 100755
--- a/hobby-http.lsp
+++ b/hobby-http.lsp
@@ -1,9 +1,16 @@
-#!/usr/local/bin/newlisp
+#!/usr/bin/newlisp
 #
 # Simple HTTP service for a directory tree. Start with:
 #
-# newlisp hobby-http.lsp -c -d $PORT -w $TREE
+# 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)))
@@ -30,9 +37,14 @@
 ; Apply rewriting rules for some requests
 (define (tag-on-html X)
   (write-line 2 (string "> " X ))
-  (let ((C (if (and (string? X) (regex "^GET ([^ ]+) (.+)" X 0))
-               (format "GET %s %s\r\n" (maybe-html $1) $2) X)))
-    (write-line 2 (string "< " C))
-    C))
+  (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)
 
-(command-event tag-on-html)
+(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)