- Reworked *DEBUG* logging features
authorMatthew Mondor <mmondor@pulsar-zone.net>
Tue, 7 Feb 2012 09:53:05 +0000 (09:53 +0000)
committerMatthew Mondor <mmondor@pulsar-zone.net>
Tue, 7 Feb 2012 09:53:05 +0000 (09:53 +0000)
- Made normal logging optional

mmsoftware/cl/server/html.lisp
mmsoftware/cl/server/test-httpd.lisp

index b285455..471a000 100644 (file)
@@ -1,4 +1,4 @@
-;;;; $Id: html.lisp,v 1.9 2011/09/11 01:59:08 mmondor Exp $
+;;;; $Id: html.lisp,v 1.10 2012/02/07 09:53:05 mmondor Exp $
 
 #|
 
@@ -51,7 +51,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 (in-package :html)
 
 (defparameter *rcsid*
-  "$Id: html.lisp,v 1.9 2011/09/11 01:59:08 mmondor Exp $")
+  "$Id: html.lisp,v 1.10 2012/02/07 09:53:05 mmondor Exp $")
 
 
 (defparameter *html-mode* :xhtml
@@ -211,6 +211,25 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
      list)
     (reverse out)))
 
+;00:46 <ASau`> phadthai: (let ((s-stream (gensym)) (if stream (let ((s-stream 
+;              stream)) ... )))) is wrong.
+;00:46 <MTecknology> we'd have to hire someone to manage just that..
+;00:46 <ASau`> phadthai: what if you supply something that generates stream?
+;00:46 <ASau`> phadthai: it will be calculated twice.
+;00:52 <ASau`> phadthai: actually, no, that construct is right.
+;00:54 <ASau`> phadthai: still the code wouldn't pass my review :)
+;00:54 <phadthai> ASau`: I still consider myself a lisp newbie :)
+;00:55 <ASau`> In particular (lambda (i) (if (stringp i) ...)) is repetitious,
+;00:55 <ASau`> it should be function.
+;00:56 <phadthai> current code is 
+;http://cvs.pulsar-zone.net/cgi-bin/cvsweb.cgi/mmondor/mmsoftware/cl/server/
+;00:56 <ASau`> I doubt that mapcar's value is used, perhaps it should be just 
+;              dolist.
+;00:58 <ASau`> It's not lisp-specific.
+;01:01 <ASau`> phadthai: There're more or less general approaches to visible 
+;              factors, it doesn't depend on whether it is Lisp or not.
+
+
 (defmacro do-html (stream &body tree)
   "Utility macro to generate HTML easily from Common Lisp code.
 At compile time, the supplied TREE template is converted to a list
index 3dbe033..aef72e6 100644 (file)
@@ -1,4 +1,4 @@
-;;;; $Id: test-httpd.lisp,v 1.41 2012/02/02 15:45:50 mmondor Exp $
+;;;; $Id: test-httpd.lisp,v 1.42 2012/02/07 09:53:05 mmondor Exp $
 
 #|
 
@@ -70,7 +70,7 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 (in-package :httpd)
 
 (defparameter *rcsid*
-  "$Id: test-httpd.lisp,v 1.41 2012/02/02 15:45:50 mmondor Exp $")
+  "$Id: test-httpd.lisp,v 1.42 2012/02/07 09:53:05 mmondor Exp $")
 
 (defparameter *server-version*
   (let ((parts (string-split *rcsid*
@@ -82,12 +82,13 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 ;;; Parameters XXX To move into a structure when we become a library
 
 ;;; Supported *DEBUG* features:
-;;; :log-req :log-connections :log-timeouts :test :beep
-(defvar *debug* '(:test :log-timeouts))
+;;; :log-requests :log-connections :log-errors :test :beep
+(defvar *debug* '(:log :log-errors :test))
 (defparameter *request-timeout* 60)
 (defparameter *request-max-size* 4096)
 (defparameter *request-keepalive-timeout* 20)
 (defparameter *request-keepalive-max* 100)
+(defparameter *request-log* t)
 
 
 ;;; Paths
@@ -426,16 +427,17 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
                        ,(if (eq type :string)
                             `(if %f %f "-")
                             `(if (zerop %f) "-" %f)))))
-         (log-line-nostamp "~X ~A - - ~A ~A ~S ~A ~A \"~A\" \"~A\""
-                           (connection-session connection)
-                           (connection-address-string connection)
-                           (http-reply-log-time)
-                           (vhost-hostname (http-request-vhost request))
-                           (first (http-request-raw request))
-                           (http-reply-code reply)
-                           (field content-len :integer)
-                           (field (http-request-referer request))
-                           (field (http-request-agent request))))))
+         (when *request-log*
+           (log-line-nostamp "~X ~A - - ~A ~A ~S ~A ~A \"~A\" \"~A\""
+                             (connection-session connection)
+                             (connection-address-string connection)
+                             (http-reply-log-time)
+                             (vhost-hostname (http-request-vhost request))
+                             (first (http-request-raw request))
+                             (http-reply-code reply)
+                             (field content-len :integer)
+                             (field (http-request-referer request))
+                             (field (http-request-agent request)))))))
 
     (when (> (http-reply-protocol reply) 0.9)
       (with-accessors ((headers http-reply-headers)) reply
@@ -1436,7 +1438,8 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 
               (when (eq :no-request status)
                 (unless keep-alive
-                  (log-line "~X No request" session))
+                  (when (debug-feature :log-errors)
+                    (log-line "~X No request" session)))
                 (return-from http-serve nil))
 
               (let* ((req (http-request-parse lines stream))
@@ -1447,20 +1450,21 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
                 (unless keep-alive
                   (setf keep-alive (http-request-keep-alive req)))
 
-                (when (debug-feature :log-req)
+                (when (debug-feature :log-requests)
                   (let ((*print-pretty* nil))
                     (log-line "~X ~S" session req)))
 
                 (cond ((eq :success status))
                       ((eq :request-size-exceeded status)
-                       (log-line "~X Query length exceeds ~A bytes"
-                                 session *request-max-size*)
+                       (when (debug-feature :log-errors)
+                         (log-line "~X Query length exceeds ~A bytes"
+                                   session *request-max-size*))
                        (http-error stream 413 "Request Entity Too Large"
                                    "Query length exceeds ~A bytes."
                                    *request-max-size*))
                       ((eq :request-timeout status)
                        (unless keep-alive
-                         (when (debug-feature :log-timeouts)
+                         (when (debug-feature :log-errors)
                            (log-line "~X Request Timeout" session))
                          (http-error stream 408 "Request Timeout"))
                        (return-from http-serve nil)))
@@ -1472,8 +1476,9 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
                 (let ((protocol (http-request-protocol req)))
                   (when (or (null protocol)
                             (>= protocol 2.0))
-                    (log-line "~X Unsupported protocol version ~A"
-                              session protocol)
+                    (when (debug-feature :log-errors)
+                      (log-line "~X Unsupported protocol version ~A"
+                                session protocol))
                     (http-error stream 505 "Version Not Supported"
                         "This server supports HTTP versions <= 2.0.")))
 
@@ -1490,7 +1495,8 @@ THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
           t)
         (end-of-file ()
           (unless keep-alive
-            (log-line "~X End of file" (connection-session connection)))
+            (when (debug-feature :log-errors)
+              (log-line "~X End of file" (connection-session connection))))
           (loop-finish)))
      while keep-alive)
   nil)