- Make form data values persistent when resubmitting
authorMatthew Mondor <mmondor@pulsar-zone.net>
Sat, 27 Aug 2011 02:34:28 +0000 (02:34 +0000)
committerMatthew Mondor <mmondor@pulsar-zone.net>
Sat, 27 Aug 2011 02:34:28 +0000 (02:34 +0000)
- Strip port number from Host: header before matching registered vhosts

mmsoftware/cl/server/test-httpd.lisp

index 88b84ee..48a6dff 100644 (file)
@@ -1,4 +1,4 @@
-;;;; $Id: test-httpd.lisp,v 1.7 2011/08/27 00:52:50 mmondor Exp $
+;;;; $Id: test-httpd.lisp,v 1.8 2011/08/27 02:34:28 mmondor Exp $
 ;;;;
 ;;;; Test/exemple minimal HTTP server
 ;;;;
@@ -18,7 +18,7 @@
 (in-package :httpd)
 
 (defparameter *rcsid*
-  "$Id: test-httpd.lisp,v 1.7 2011/08/27 00:52:50 mmondor Exp $")
+  "$Id: test-httpd.lisp,v 1.8 2011/08/27 02:34:28 mmondor Exp $")
 
 
 (defparameter *request-timeout* 60)
@@ -290,6 +290,9 @@ code message #\Return
 (defparameter *header-table*
   `(("host"
      ,#'(lambda (o v)
+         (let ((pos (position #\: v :from-end t)))
+           (when pos
+             (setf v (subseq v 0 pos))))
          (setf (http-request-host o) v
                (http-request-vhost o) (vhost-query v :default t))))
     ("user-agent"
@@ -485,6 +488,18 @@ code message #\Return
     (maphash #'(lambda (k v)
                 (format out "~A = ~S~%" k v))
             ht)))
+(defun req-var (req type var)
+  (let ((ht (cond ((eq :get type)
+                  (http-request-vars-get req))
+                 ((eq :post type)
+                  (http-request-vars-post req))
+                 ((eq :cookie type)
+                  (http-request-vars-cookie req)))))
+    (multiple-value-bind (val exists-p)
+       (gethash (string-downcase (symbol-name var)) ht)
+      (if exists-p
+         val
+         ""))))
 
 ;;; XXX Should dispatch requests to known resources as needed
 ;;; XXX Should probably display HTTP errors for unhandled Lisp conditions
@@ -521,33 +536,47 @@ code message #\Return
                                :type "text"
                                :size "32"
                                :maxlength "64"
-                               :value "")
+                               :value (html-escape
+                                       (req-var req :post :first-name)))
                       (:/br)
                       "Last name: "
                       (:/input :name "last-name"
                                :type "text"
                                :size "32"
                                :maxlength "64"
-                               :value "")
+                               :value (html-escape
+                                       (req-var req :post :last-name)))
                       (:/br)
-                      (do-html-loop (repeat 10
-                                     for i = (random 9999)
-                                     for s = (format nil "~4,'0D" i))
+                      (do-html-loop (for i from 1 to 10
+                                     for s = (format nil "~2,'0D" i)
+                                     for v = (format nil "box-~2,'0D" i))
                         "Box " s
-                        (:/input :name "box[]"
-                                 :type "checkbox"
-                                 :value (format nil "box-~4,'0X" i)))
+                        ;; XXX If we allowed user code for the tag name,
+                        ;; this would have been smaller.
+                        (let* ((a (req-var req :post :box[]))
+                               (c (if a (find v a :test #'string=) nil)))
+                          (do-html-if c
+                            (:/input :name "box[]"
+                                     :type "checkbox"
+                                     :value v
+                                     :/checked)
+                            (:/input :name "box[]"
+                                     :type "checkbox"
+                                     :value v))))
                       (:/br)
                       (:textarea :name "message"
                                  :rows 10
                                  :cols 60
-                                 "A Message")
+                                 (html-escape
+                                  (req-var req :post :message)))
                       (:/br)
                       (:/input :type "submit" :value "Post"))
                (:h2 "Browser request")
                (:pre
                 (do-html-loop (for line in lines)
                   (html-escape (format nil "~A~%" line))))
+               (:p (:code
+                    (html-escape (format nil "~S~%" req))))
                (:h2 "Path")
                (html-escape (format nil "~A~%"
                                     (http-request-path req)))