[Lisppaste-cvs] CVS lisppaste2

[bmastenbrook]

Update of /project/lisppaste/cvsroot/lisppaste2
In directory clnet:/tmp/cvs-serv9580

Modified Files:
	web-server.lisp 
Log Message:
Captchas should only be entered once an hour


--- /project/lisppaste/cvsroot/lisppaste2/web-server.lisp	2007/01/16 00:56:31	1.88
+++ /project/lisppaste/cvsroot/lisppaste2/web-server.lisp	2007/01/16 01:10:44	1.89
@@ -1,4 +1,4 @@
-;;;; $Id: web-server.lisp,v 1.88 2007/01/16 00:56:31 bmastenbrook Exp $
+;;;; $Id: web-server.lisp,v 1.89 2007/01/16 01:10:44 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -86,12 +86,16 @@
                (remhash host *referer-hash*)
                (incf (gethash "Google" *referer-hash* 0) count)))))
 
+(defvar *show-captcha* t)
+
 (defmethod handle-request-response :around ((handler lisppaste-basic-handler) method request)
   (with-open-file (*trace-output* (times-file-for-class handler)
                                   :direction :output
                                   :if-exists :append :if-does-not-exist :create)
+    (expire-authorization-tokens)
     (unwind-protect
-         (call-next-method)
+         (let ((*show-captcha* (not (is-authorized request))))
+           (call-next-method))
       (force-output *trace-output*))))
 
 (defun make-css ()
@@ -677,15 +681,16 @@
           (<tr>
            (<th align="left" width="0%" nowrap="nowrap"> "Enter a title:")
            (<td> <input type="text" name="title" value=?default-title />))
-          (<tr>
-           (<th align="left" width="0%" nowrap="nowrap"> "Captcha:")
-           (<td>
-            (multiple-value-bind (captcha captchaid)
-                (make-captcha 8)
-              (list
-               captcha
-               <input type="text" name="captcha" />
-               <input type="hidden" name="captchaid" value=?captchaid />))))
+          (when *show-captcha*
+            (<tr>
+             (<th align="left" width="0%" nowrap="nowrap"> "Captcha:")
+             (<td>
+              (multiple-value-bind (captcha captchaid)
+                  (make-captcha 8)
+                (list
+                 captcha
+                 <input type="text" name="captcha" />
+                 <input type="hidden" name="captchaid" value=?captchaid />)))))
           (unless annotate
             (<tr>
              (<th align="left" width="0%" nowrap="nowrap">
@@ -765,20 +770,26 @@
          (annotate-paste (if annotate-number (find annotate-number *pastes* :key #'paste-number)))
          (channel (body-param "channel" (request-body request)))
          (captcha (body-param "captcha" (request-body request)))
-         (captchaid (body-param "captchaid" (request-body request))))
-    (if (> (length channel) 1)
-	(request-send-headers request :expires 0
-				       :set-cookie (format nil "CHANNEL=~A; path=/"
-                                                           (or (and *no-channel-pastes*
-                                                                    (string-equal channel "none")
-                                                                    "None")
-                                                               (subseq channel 1))))
-        (request-send-headers request :expires 0))
+         (captchaid (body-param "captchaid" (request-body request)))
+         (correct (and captcha captchaid (captcha-entered-correctly-p captcha 8 captchaid))))
+    (let ((cookies nil))
+      (when (> (length channel) 1)
+        (push (format nil "CHANNEL=~A; path=/"
+                      (or (and *no-channel-pastes*
+                               (string-equal channel "none")
+                               "None")
+                          (subseq channel 1))) cookies))
+      (when correct
+        (push (make-authorization-token) cookies))
+      (if cookies
+          (request-send-headers request :expires 0
+                                :set-cookie cookies)
+          (request-send-headers request :expires 0))) 
     (expire-used-captchas)
     (cond
-      ((captcha-used captchaid)
+      ((and (> (length captchaid) 0) (captcha-used captchaid))
        (new-paste-form request :message "This captcha has been used already. Did you use the back button?" :default-channel channel :annotate annotate-paste :default-user username :default-title title :default-contents text))
-      ((not (captcha-entered-correctly-p captcha 8 captchaid))
+      ((and *show-captcha* (not correct))
        (new-paste-form request :message "You entered the captcha incorrectly." :default-channel channel :annotate annotate-paste :default-user username :default-title title :default-contents text))
       ((> (length text) *paste-maximum-size*)
        (new-paste-form request :message "Paste too large." :default-channel channel :annotate annotate-paste :default-user username :default-title title))