Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv6177 Modified Files: lisppaste.lisp web-server.lisp persistent-pastes.lisp Log Message: Event log, update read-pastes-from-file Date: Wed Jun 9 12:46:35 2004 Author: bmastenbrook Index: lisppaste2/lisppaste.lisp diff -u lisppaste2/lisppaste.lisp:1.19 lisppaste2/lisppaste.lisp:1.20 --- lisppaste2/lisppaste.lisp:1.19 Tue Jun 8 08:21:30 2004 +++ lisppaste2/lisppaste.lisp Wed Jun 9 12:46:35 2004 @@ -1,4 +1,4 @@ -;;;; $Id: lisppaste.lisp,v 1.19 2004/06/08 15:21:30 bmastenbrook Exp $ +;;;; $Id: lisppaste.lisp,v 1.20 2004/06/09 19:46:35 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -54,14 +54,16 @@ (setf *connection* connection) (setf *channels* channels) (read-pastes-from-file *paste-file*) - (mapcar #'(lambda (channel) (irc:join connection channel)) channels) + (format t "Populating lookup table...~%") (clhs-lookup:populate-table) (r5rs-lookup:populate-table) (elisp-lookup:populate-table) - (araneida:start-listening *paste-listener*) + (format t "Done!~%") + (mapcar #'(lambda (channel) (irc:join connection channel)) channels) (add-hook nickname) (setf *boot-time* (get-universal-time)) - (irc:start-background-message-handler connection))) + (irc:start-background-message-handler connection) + (araneida:start-listening *paste-listener*))) (defun join-new-channel (channel) (setf *channels* (nconc *channels* (list channel))) @@ -114,3 +116,10 @@ (setf (paste-annotations paste) (remove ann (paste-annotations paste) :key #'paste-number)) (serialize-to-file *paste-file* `(kill-paste-annotation ,number ,ann)))) + +(defun log-event (text) + (with-open-file (s *event-log-file* :direction :output :if-exists :append + :if-does-not-exist :create) + (write-string text *trace-output*) + (write-string text s) + (finish-output s))) \ No newline at end of file Index: lisppaste2/web-server.lisp diff -u lisppaste2/web-server.lisp:1.52 lisppaste2/web-server.lisp:1.53 --- lisppaste2/web-server.lisp:1.52 Tue Jun 8 08:20:40 2004 +++ lisppaste2/web-server.lisp Wed Jun 9 12:46:35 2004 @@ -1,4 +1,4 @@ -;;;; $Id: web-server.lisp,v 1.52 2004/06/08 15:20:40 bmastenbrook Exp $ +;;;; $Id: web-server.lisp,v 1.53 2004/06/09 19:46:35 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/web-server.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -43,7 +43,7 @@ (member forwarded-for *banned-ips* :test #'string-equal)) (progn - (with-open-file (s "ban-log" :direction :output :if-exists :append + (with-open-file (s *ban-log-file* :direction :output :if-exists :append :if-does-not-exist :create) (format s "Logged attempt by ~S to submit a paste.~%" forwarded-for) @@ -585,6 +585,12 @@ "#" (prin1-to-string annotation-number)) (prin1-to-string paste-number)))))) + (log-event + (format nil "New paste from IP ~A: number ~A, annotation of ~A, title ~S.~%" + (car (araneida:request-header request :x-forwarded-for)) + paste-number + annotation-number + title)) (make-new-paste *pastes* (annotate paste-number (paste-annotations paste-to-annotate)) @@ -688,9 +694,10 @@ (colorize:autodetect-coloring-type (paste-channel paste))))) (colorize:*css-background-class* "paste")) (and paste - (format t "Serving paste number ~S to ~S.~%" - (paste-number paste) - (car (araneida:request-header request :x-forwarded-for)))) + (log-event + (format nil "Serving paste number ~S to ~S.~%" + (paste-number paste) + (car (araneida:request-header request :x-forwarded-for))))) (if paste (if raw (let ((p (position #\, (araneida::request-unhandled-part request) :test #'char=))) Index: lisppaste2/persistent-pastes.lisp diff -u lisppaste2/persistent-pastes.lisp:1.10 lisppaste2/persistent-pastes.lisp:1.11 --- lisppaste2/persistent-pastes.lisp:1.10 Tue Jun 8 08:21:30 2004 +++ lisppaste2/persistent-pastes.lisp Wed Jun 9 12:46:35 2004 @@ -51,7 +51,7 @@ ,@body)) (defun make-paste-from-alist (e &optional annotate) - (with-assoc-vals (number user title contents universal-time channel) e + (with-assoc-vals (number user title contents universal-time channel colorization-mode) e (if annotate (setf (paste-annotation-counter annotate) (max (paste-annotation-counter annotate) number)) (setf *paste-counter* (max *paste-counter* number))) @@ -61,6 +61,7 @@ :contents (remove #\return contents) :universal-time universal-time :channel channel + :colorization-mode colorization-mode :annotations nil))) (defun deserialize (expr) @@ -75,6 +76,7 @@ (defun read-pastes-from-file (file-name) (let ((*in-operation* t)) (setf *pastes* nil) + (setf *paste-counter* 0) (let ((*package* (find-package :lisppaste))) (with-open-file (file file-name :direction :input :if-does-not-exist nil) (if file