From: Ralph Ronnquist <ralph.ronnquist@gmail.com>
Date: Wed, 3 Jun 2020 04:37:19 +0000 (+1000)
Subject: added initial request filtering
X-Git-Url: https://git.rrq.au/?a=commitdiff_plain;h=6e0f79f889997bdd9720e9fcaf0393e1d748aad0;hp=1bfe55c2b7110a32570de79e9cdcfb3093c7fbb4;p=rrq%2Fnewlisp-ftw.git

added initial request filtering
---

diff --git a/hobby-http.lsp b/hobby-http.lsp
index f2ba831..33b8da7 100755
--- a/hobby-http.lsp
+++ b/hobby-http.lsp
@@ -37,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)