Rework the "/test" page
[mmondor.git] / mmsoftware / cl / server / httpd.lisp
index e5748fc..5292d0a 100644 (file)
@@ -1,4 +1,4 @@
-;;;; $Id: httpd.lisp,v 1.8 2012/09/03 12:42:57 mmondor Exp $
+;;;; $Id: httpd.lisp,v 1.9 2012/09/03 16:49:45 mmondor Exp $
 
 #|
 
@@ -115,7 +115,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 (in-package :httpd)
 
 (defparameter *rcsid*
-  "$Id: httpd.lisp,v 1.8 2012/09/03 12:42:57 mmondor Exp $")
+  "$Id: httpd.lisp,v 1.9 2012/09/03 16:49:45 mmondor Exp $")
 
 (defparameter *server-version*
   (let ((parts (string-split *rcsid*
@@ -1120,13 +1120,14 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
       req)))
 
 
-;;; Currently used by the test code.
+;;; HTTP variable access for user code
+
 (defun req-var (req type &optional name default)
   "Queries the request environment REQ for a variable of TYPE :GET, :POST
 or :COOKIE, named NAME \(may be a symbol or a string\).  DEFAULT is
 returned if no such binding exists \(which defaults to NIL\).  If NAME is
 omited, a list is returned of all variable bindings of the specified TYPE."
-  (let ((ht (cond ((eq :get type)
+  (let ((ht (cond ((eq :get type)              ; CASE might not use EQ
                   (http-request-vars-get req))
                  ((eq :post type)
                   (http-request-vars-post req))
@@ -1193,9 +1194,17 @@ REQ is bound to VAR."
            (:body
             (:h1 "Interactively developed test server")
             (:p "This page, forms and server code may change anytime "
-                "without interruption; a live SWANK connection is "
-                "maintained from Emacs and SLIME, and the system is "
-                "developed interactively on spare time.")
+                "without interruption; a live SWANK connection can "
+                "be maintained from Emacs and SLIME to the server, and "
+                "the system is developed interactively as spare time "
+                "permits.  A particularity of Lisp is that it can be "
+                "used as a scripting language interactively, with wanted "
+                "modified clode blocks reapplied in the live image. "
+                "These code blocks maybe reapplied as compiled bytecode "
+                "for interpretation (or in this case, using ECL, be "
+                "recompiled efficiently to C and linked as a dynamic "
+                "loadable module, and reloaded immediately when typing "
+                "C-c C-c on a code block in Emacs).")
             (:p
              "Follow " (:a :href "/" "this link") " to proceed to a "
              "mirror of my site hosted on this test server.")
@@ -1210,21 +1219,6 @@ REQ is bound to VAR."
              "accumulate name suggestions for this server "
              (:a :href "/names" "here") ".")
 
-            (:h2 "WITH-HTTP-LET Test")
-            (:p (with-http-let req
-                  ((id :get :id -1)
-                   (first-name :post :last-name "first-name")
-                   (last-name :post :first-name "last-name")
-                   (foo :get :foo)
-                   (get :get))
-                  (html-escape
-                   (format nil "id=~S, name=\"~A ~A\", foo=~S, get=~S."
-                           id first-name last-name foo get))))
-
-            (:h2 "Location")
-            (:p "IP address/port: "
-                (connection-address-string connection) ":"
-                (connection-port connection))
             (:h2 "Test form")
             (:form :action (html-escape
                             (format nil
@@ -1271,8 +1265,9 @@ REQ is bound to VAR."
                                (req-var req :post :message
                                         "Message text.")))
                    (:/br)
-                   (:/input :type "submit" :value "Post"))
-            (:h2 "Test form 2 (multipart)")
+                   (:/input :type "submit" :value "Post message"))
+            (:h2 "Test form 2 (multipart/form-data)")
+            (:p (:em "This test is expected to fail for now."))
             (:form :action "/test"
                    :method "post"
                    :enctype "multipart/form-data"
@@ -1282,7 +1277,7 @@ REQ is bound to VAR."
                             :maxlength "64"
                             :value (html-escape
                                     (req-var req :post :description
-                                             "Description")))
+                                             "File description")))
                    (:/br)
                    (:/input :name "file"
                             :type "file"
@@ -1291,25 +1286,32 @@ REQ is bound to VAR."
                             :value "File to send")
                    (:/br)
                    (:/input :type "submit"
-                            :value "Send"))
-            (:h2 "Browser request")
+                            :value "Upload file"))
+
+            (:h2 "Client information")
+            (:h3 "Originator")
+            (:p (connection-address-string connection) ":"
+                (connection-port connection))
+            (:h3 "Browser request")
             (:pre
              (do-html-loop (for line in (http-request-raw req))
                (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)))
+
+            (:h2 "Request state information")
+            (:h3 "Path and VHost")
+            (:p (html-escape (format nil "~S on ~S"
+                                     (http-request-path req)
+                                     (vhost-hostname
+                                      (http-request-vhost req)))))
             (do-html-when (http-request-query req)
-              (:h2 "GET data")
+              (:h3 "GET variables")
               (:pre
                (html-escape (format nil "~A~%"
                                     (http-request-query req))))
               (:pre
                (html-escape (dump-vars (http-request-vars-get req)))))
             (do-html-when (http-request-post req)
-              (:h2 "POST data")
+              (:h3 "POST variables")
               (:pre
                (html-escape (format nil "~A~%"
                                     (http-request-post req))))
@@ -1318,10 +1320,11 @@ REQ is bound to VAR."
                              (http-request-vars-post req)))))
             (do-html-when (> (hash-table-count
                               (http-request-vars-cookie req)) 0)
-              (:h2 "COOKIE data")
+              (:h3 "COOKIE variables")
               (:pre
                (html-escape (dump-vars
                              (http-request-vars-cookie req)))))
+
             (:h2 "Server information")
             (:p *server-version* " "
                 (:a :href "http://cvs.pulsar-zone.net/cgi-bin/cvsweb.cgi/mmondor/mmsoftware/cl/server/"