Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/home/bmastenbrook/lisppaste2 Modified Files: README.lisp lisppaste.asd lisppaste.lisp package.lisp variable.lisp Added Files: irc-notification.lisp Log Message: Support for running without IRC notification: cleanup pending; for now, take a hacksaw and separate the parts Date: Wed Oct 20 22:22:13 2004 Author: bmastenbrook Index: lisppaste2/README.lisp diff -u lisppaste2/README.lisp:1.13 lisppaste2/README.lisp:1.14 --- lisppaste2/README.lisp:1.13 Fri Oct 15 20:23:15 2004 +++ lisppaste2/README.lisp Wed Oct 20 22:22:13 2004 @@ -1,4 +1,4 @@ -;;;; $Id: README.lisp,v 1.13 2004/10/15 18:23:15 bmastenbrook Exp $ +;;;; $Id: README.lisp,v 1.14 2004/10/20 20:22:13 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/README.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -22,13 +22,24 @@ ;;; httpd.conf. Then, run SBCL and invoke the magical invocation as ;;; follows, or simply (load "README"). +;;; If you wish to run without an IRC server, uncomment the following +;;; line: +;; (pushnew :lisppaste-no-irc *features*) + (require :asdf) (asdf:operate 'asdf:load-op :lisppaste) (load (compile-file "redirect-handler")) (s-xml-rpc:start-xml-rpc-server :port 8185) -(lisppaste:start-lisppaste :channels '("#lisp" "#scheme" "#opendarwin" "#macdev" "#fink" "#jedit" "#dylan" "#emacs" "#xemacs" "#colloquy" "#adium" "#growl" "#chicken" "#quicksilver" "#svn" "#slate" "#squeak" "#wiki" "#nebula" "#imgames") - :nickname "lisppaste" - :server "orwell.freenode.net" - :port 6667) +(lisppaste:start-lisppaste) + +#-lisppaste-no-irc +(lisppaste:start-irc-notification) + :channels '("#lisp" "#scheme" "#opendarwin" "#macdev" "#fink" + "#jedit" "#dylan" "#emacs" "#xemacs" "#colloquy" "#adium" + "#growl" "#chicken" "#quicksilver" "#svn" "#slate" + "#squeak" "#wiki" "#nebula" "#imgames") + :nickname "lisppaste" + :server "orwell.freenode.net" + :port 6667) Index: lisppaste2/lisppaste.asd diff -u lisppaste2/lisppaste.asd:1.17 lisppaste2/lisppaste.asd:1.18 --- lisppaste2/lisppaste.asd:1.17 Tue Jul 27 20:47:10 2004 +++ lisppaste2/lisppaste.asd Wed Oct 20 22:22:13 2004 @@ -1,5 +1,5 @@ ;;;; Silly emacs, this is -*- Lisp -*- -;;;; $Id: lisppaste.asd,v 1.17 2004/07/27 18:47:10 bmastenbrook Exp $ +;;;; $Id: lisppaste.asd,v 1.18 2004/10/20 20:22:13 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -21,7 +21,8 @@ paste text into it. Once pasted, lisppaste will notify a pre-configured IRC channel about the paste and where it can be located." - :depends-on (:araneida :cl-irc :split-sequence :s-xml :s-xml-rpc) + :depends-on (:araneida #-lisppaste-no-irc :cl-irc + :split-sequence :s-xml :s-xml-rpc) :components ((:file "encode-for-pre") (:file "package" :depends-on ("encode-for-pre")) (:file "variable" @@ -33,10 +34,13 @@ (:file "clhs-lookup" :depends-on ("encode-for-pre" "abbrev")) (:file "r5rs-lookup" :depends-on ("encode-for-pre")) (:file "elisp-lookup" :depends-on ("encode-for-pre")) + #-lisppaste-no-irc (:file "irc-notification" :depends-on ("variable" "package")) (:file "lisppaste" :depends-on ("variable" "clhs-lookup" "r5rs-lookup" - "elisp-lookup")) + "elisp-lookup" + #-lisppaste-no-irc + "irc-notification")) (:file "coloring-types" :depends-on ("colorize" "clhs-lookup")) (:file "web-server" Index: lisppaste2/lisppaste.lisp diff -u lisppaste2/lisppaste.lisp:1.24 lisppaste2/lisppaste.lisp:1.25 --- lisppaste2/lisppaste.lisp:1.24 Tue Jul 27 20:47:10 2004 +++ lisppaste2/lisppaste.lisp Wed Oct 20 22:22:13 2004 @@ -1,107 +1,38 @@ -;;;; $Id: lisppaste.lisp,v 1.24 2004/07/27 18:47:10 bmastenbrook Exp $ +;;;; $Id: lisppaste.lisp,v 1.25 2004/10/20 20:22:13 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/lisppaste.lisp,v $ ;;;; See the LICENSE file for licensing information. (in-package :lisppaste) -(defun say-help (channel) - (when (and *connection* - (find channel *channels* :test #'string=)) - (irc:privmsg *connection* - channel - (format nil "To use the lisppaste bot, visit ~A/~A and enter your paste." (araneida:urlstring *new-paste-url*) (subseq channel 1))) - t)) - -(defun help-request-p (nick help text) - (and (> (length text) - (length nick)) - (search nick text :start2 0 :end2 (length nick) :test #'char-equal) - (let ((url-position (search help text :start2 (length nick) - :test #'char-equal))) - (and - url-position - (notany #'alphanumericp (subseq text (length nick) (1- url-position))) - (notany #'alphanumericp (subseq text (+ url-position (length help)))))))) - -(defun make-msg-hook (nick) - (lambda (message) - (let ((text (irc:trailing-argument message))) - (cond ((string= (first (irc:arguments message)) nick) - (irc:privmsg *connection* - (irc:source message) - (format nil "To use the lisppaste bot, visit ~A and enter your paste. Be sure to select the right channel!" (araneida:urlstring *new-paste-url*)))) - ((some #'(lambda (e) - (help-request-p nick e text)) - '("url" "help" "hello")) - (say-help (first (irc:arguments message)))))))) - - -(defun add-hook (nick) - (irc:remove-hooks *connection* 'irc:irc-privmsg-message) - (irc:add-hook *connection* 'irc:irc-privmsg-message (make-msg-hook nick))) - -(defun start-lisppaste (&key (channels (list *default-channel*)) - (nickname *default-nickname*) - (server *default-irc-server*) - (port *default-irc-server-port*)) - "Connect to specified server, join specified channel and start -accepting requests through the web." - (let ((connection (irc:connect :nickname nickname - :realname (araneida:urlstring *new-paste-url*) - :server server - :port port))) - (setf *connection* connection) - (setf *channels* channels) - (if *no-channel-pastes* - (pushnew "None" *channels* :test #'string-equal)) - (read-xml-pastes) - (format t "Populating lookup table...~%") - (clhs-lookup:populate-table) - (r5rs-lookup:populate-table) - (elisp-lookup:populate-table) - (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) - (araneida:start-listening *paste-listener*))) - -(defun join-new-channel (channel) - (setf *channels* (nconc *channels* (list channel))) - (irc:join *connection* channel)) - -(defun hup-connection (nickname server) - (ignore-errors (irc:quit *connection*)) - (setf *connection* (irc:connect :nickname nickname - :realname (araneida:urlstring *new-paste-url*) - :server server - :port *default-irc-server-port*)) - (mapcar #'(lambda (channel) (irc:join *connection* channel)) *channels*) - (add-hook nickname) - (irc:start-background-message-handler *connection*)) +(defun start-lisppaste () + "Start accepting web requests." + (if *no-channel-pastes* + (pushnew "None" *channels* :test #'string-equal)) + (read-xml-pastes) + (format t "Populating lookup table...~%") + (clhs-lookup:populate-table) + (r5rs-lookup:populate-table) + (elisp-lookup:populate-table) + (format t "Done!~%") + (setf *boot-time* (get-universal-time)) + (araneida:start-listening *paste-listener*)) (defmacro make-new-paste (paste-list (&optional annotate real-number annotate-list) url &rest keys &key channel user title &allow-other-keys) (let ((paste-name (gensym))) `(let ((,paste-name (make-paste ,@keys))) (if (not (string-equal ,channel "None")) - (irc:privmsg *connection* ,channel - (if ,annotate - (format nil "~A annotated #~A with \"~A\" at ~A" ,user ,real-number ,title ,url) - (format nil "~A pasted \"~A\" at ~A" ,user ,title ,url)))) + (irc-notify ,channel + (if ,annotate + (format nil "~A annotated #~A with \"~A\" at ~A" ,user ,real-number ,title ,url) + (format nil "~A pasted \"~A\" at ~A" ,user ,title ,url)))) ,(if annotate `(if ,annotate (push ,paste-name ,annotate-list) (push ,paste-name ,paste-list)) `(push ,paste-name ,paste-list)) (serialize-transaction ,paste-name (if ,annotate ,real-number))))) - -(defun shut-up () - (setf (irc:client-stream *connection*) (make-broadcast-stream))) - -(defun un-shut-up () - (setf (irc:client-stream *connection*) *trace-output*)) (defun kill-paste (number) (let ((paste (find-paste number))) Index: lisppaste2/package.lisp diff -u lisppaste2/package.lisp:1.8 lisppaste2/package.lisp:1.9 --- lisppaste2/package.lisp:1.8 Tue Jul 6 18:34:24 2004 +++ lisppaste2/package.lisp Wed Oct 20 22:22:13 2004 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.8 2004/07/06 16:34:24 bmastenbrook Exp $ +;;;; $Id: package.lisp,v 1.9 2004/10/20 20:22:13 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -8,7 +8,9 @@ (eval-when (:execute :load-toplevel :compile-toplevel) (defpackage :lisppaste (:use :cl #+sbcl :sb-bsd-sockets :html-encode) - (:export :start-lisppaste :join-new-channel :shut-up :un-shut-up :say-help + (:export :start-lisppaste :join-new-irc-channel + :start-irc-notification :hup-irc-connection + :shut-up :un-shut-up :irc-say-help :kill-paste :kill-paste-annotations :kill-paste-annotation :display-paste-url :find-paste))) Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.31 lisppaste2/variable.lisp:1.32 --- lisppaste2/variable.lisp:1.31 Fri Oct 15 20:23:15 2004 +++ lisppaste2/variable.lisp Wed Oct 20 22:22:13 2004 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.31 2004/10/15 18:23:15 bmastenbrook Exp $ +;;;; $Id: variable.lisp,v 1.32 2004/10/20 20:22:13 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -48,6 +48,11 @@ (defvar *meme-links* t) ; whether to link to meme IRC logs, probably ; only useful for freenode's lisppaste +(defvar *irc-network-name* "Freenode") ; the name of the IRC network + ; lisppaste is running on; can + ; be ignored when not running + ; with an IRC connection + (defvar *paste-maximum-size* 51200) ; in bytes (defvar *pastes-per-page* 50) ; for the paste list @@ -149,6 +154,7 @@ (defvar *pastes* nil) (defvar *paste-counter* 0) (defvar *connection* nil) +(defvar *nickname*) (defvar *channels* '("None")) (defvar *paste-file*