[Lisppaste-cvs] CVS update: lisppaste2/web-server.lisp

[Brian Mastenbrook]

Update of /project/lisppaste/cvsroot/lisppaste2
In directory common-lisp.net:/home/bmastenbrook/lisppaste2

Modified Files:
	web-server.lisp 
Log Message:
IP banning (web-server.lisp part)

Date: Thu Jun  3 15:12:14 2004
Author: bmastenbrook

Index: lisppaste2/web-server.lisp
diff -u lisppaste2/web-server.lisp:1.49 lisppaste2/web-server.lisp:1.50
--- lisppaste2/web-server.lisp:1.49	Thu Jun  3 07:16:35 2004
+++ lisppaste2/web-server.lisp	Thu Jun  3 15:12:14 2004
@@ -1,4 +1,4 @@
-;;;; $Id: web-server.lisp,v 1.49 2004/06/03 14:16:35 bmastenbrook Exp $
+;;;; $Id: web-server.lisp,v 1.50 2004/06/03 22:12:14 bmastenbrook Exp $
 ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -35,6 +35,31 @@
 (defclass syndication-handler (araneida:handler) ())
 
 (defclass stats-handler (araneida:handler) ())
+
+(defmethod araneida:handle-request-response :around
+    ((handler submit-paste-handler) method request)
+  (let ((forwarded-for (car (araneida:request-header request :x-forwarded-for))))
+    (if (and forwarded-for
+                 (member forwarded-for
+                         *banned-ips* :test #'string-equal))
+        (progn
+          (with-open-file (s "ban-log" :direction :output :if-exists :append
+                             :if-does-not-exist :create)
+            (format s "Logged attempt by ~S to submit a paste.~%"
+                    forwarded-for)
+            (format s "Request headers are: ~S.~%"
+                    (araneida:request-headers request))
+            (format s "Request body is: ~S.~%"
+                    (araneida:request-body request)))
+          (araneida:request-send-headers request :expires 0)
+          (araneida:html-stream
+           (araneida:request-stream request)
+           `(html
+             (head
+              (title "No cookie for you!"))
+             (body (h1 ((font :color "red") "Naughty boy!"))))))
+        (call-next-method))))
+
 
 (defmethod araneida:handle-request-response ((handler new-paste-handler) method request)
   (let* ((annotate-string (araneida:body-param "annotate" (araneida:request-body request)))