commit a2a8a2ee6fdcd1c70dcb076452c5083cbbac3858 parent e7a4fab339e728c1153c16c420e01e0c71bdcafb Author: Tomas Hlavaty <tom@logand.com> Date: Wed, 9 Dec 2015 22:59:15 +0100 strip query after the first questionmark serving git clone needs this, e.g. info/refs?service=git-upload-pack Diffstat:
| M | demo-webserver.lisp | | | 27 | ++++++++++++++------------- |
1 file changed, 14 insertions(+), 13 deletions(-)
diff --git a/demo-webserver.lisp b/demo-webserver.lisp @@ -50,19 +50,20 @@ (pathname-type head))) *root*))) -(defun query-file (query) ;; TODO strip ?... - (when (every (lambda (c) - (or (char<= #\A c #\Z) - (char<= #\a c #\z) - (char<= #\0 c #\9) - (member c '(#\/ #\. #\- #\_)))) - query) - (let ((f (probe-file (query-pathname query)))) - (when f - (ignore-errors - (with-open-file (s f :if-does-not-exist nil) - (listen s) - f)))))) +(defun query-file (query) + (let ((q (rw:till (rw:peek-reader (rw:reader query)) '(#\?)))) + (when (every (lambda (c) + (or (char<= #\A c #\Z) + (char<= #\a c #\z) + (char<= #\0 c #\9) + (member c '(#\/ #\. #\- #\_)))) + q) + (let ((f (probe-file (query-pathname q)))) + (when f + (ignore-errors + (with-open-file (s f :if-does-not-exist nil) + (listen s) ;; dir throws + f))))))) (defun content-type (pathname) (or (cdr (assoc (pathname-type pathname) rw.http:*mime-types* :test #'equalp))