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