Update of /project/lisppaste/cvsroot/lisppaste2 In directory common-lisp.net:/tmp/cvs-serv24665

Modified Files: irc-notification.lisp variable.lisp Log Message: More changes for multiple server support

Date: Sun Oct 24 21:54:33 2004 Author: bmastenbrook

Index: lisppaste2/irc-notification.lisp diff -u lisppaste2/irc-notification.lisp:1.2 lisppaste2/irc-notification.lisp:1.3 --- lisppaste2/irc-notification.lisp:1.2 Wed Oct 20 22:37:50 2004 +++ lisppaste2/irc-notification.lisp Sun Oct 24 21:54:33 2004 @@ -1,18 +1,39 @@ -;;;; $Id: irc-notification.lisp,v 1.2 2004/10/20 20:37:50 bmastenbrook Exp $ +;;;; $Id: irc-notification.lisp,v 1.3 2004/10/24 19:54:33 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/irc-notification.lisp,v $

;;;; See the LICENSE file for licensing information.

(in-package :lisppaste)

+(defvar *connections* nil) +(defvar *nicknames* nil) + +(defun channel-nick (channel) + (cdr (assoc channel *nicknames* + :test #'(lambda (e s) + (member e s :test #'string=))))) + +(defun nick-connection (nick) + (cdr (assoc nick *connections* :test #'string=))) + +(defun find-connection (channel) + (nick-connection (channel-nick channel))) + (defun irc-say-help (channel) - (when (and *connection* + (when (and (find-connection channel) (find channel *channels* :test #'string=)) - (irc:privmsg *connection* + (irc:privmsg (find-connection channel) 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 excluding-trailing-digits (nick) + (coerce + (loop for i from (1- (length nick)) downto 0 + if (not (digit-char-p (elt nick i))) + return (subseq nick 0 (1+ i))) + 'string)) + (defun help-request-p (nick help text) (and (> (length text) (length nick)) @@ -21,24 +42,24 @@ :test #'char-equal))) (and url-position - (notany #'alphanumericp (subseq text (length nick) (1- url-position))) - (notany #'alphanumericp (subseq text (+ url-position (length help)))))))) + (notany #'alpha-char-p (subseq text (length nick) (1- url-position))) + (notany #'alpha-char-p (subseq text (+ url-position (length help))))))))

-(defun make-irc-msg-hook (nick) +(defun make-irc-msg-hook (connection nick) (lambda (message) (let ((text (irc:trailing-argument message))) (cond ((string= (first (irc:arguments message)) nick) - (irc:privmsg *connection* + (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)) + (help-request-p (excluding-trailing-digits nick) e text)) '("url" "help" "hello")) (irc-say-help (first (irc:arguments message))))))))

-(defun add-irc-hook (nick) - (irc:remove-hooks *connection* 'irc:irc-privmsg-message) - (irc:add-hook *connection* 'irc:irc-privmsg-message (make-irc-msg-hook nick))) +(defun add-irc-hook (connection nick) + (irc:remove-hooks connection 'irc:irc-privmsg-message) + (irc:add-hook connection 'irc:irc-privmsg-message (make-irc-msg-hook connection nick)))

(defun start-irc-notification (&key (channels (list *default-channel*)) (nickname *default-nickname*) @@ -48,36 +69,58 @@ :realname (araneida:urlstring *new-paste-url*) :server server :port port))) - (setf *connection* connection) - (setf *channels* (nconc *channels* channels)) - (setf *nickname* nickname) + (push (cons nickname connection) *connections*) + (setf *channels* (append *channels* channels)) + (push (cons (copy-list channels) nickname) *nicknames*) (mapcar #'(lambda (channel) (irc:join connection channel)) channels) - (add-irc-hook nickname) + (add-irc-hook connection nickname) (irc:start-background-message-handler connection)))

-(defun join-new-irc-channel (channel) - (setf *channels* (nconc *channels* (list channel))) - (irc:join *connection* channel)) +(defun stop-irc-notification (nickname) + (ignore-errors (irc:quit (nick-connection nickname))) + (loop for i in (car (rassoc nickname *nicknames* :test #'string=)) + do (setf *channels* (remove i *channels* :test #'string=))) + (setf *nicknames* (remove nickname *nicknames* :key #'cdr :test #'string=)) + (setf *connections* (remove nickname *connections* :key #'car :test #'string=))) + +(defun join-new-irc-channel (nickname channel) + (push channel (car (rassoc nickname *nicknames* :test #'string=))) + (irc:join (find-connection channel) channel) + (setf *channels* (nconc *channels* (list channel))))

-(defun leave-irc-channel (channel) +(defun leave-irc-channel (nickname channel) (setf *channels* (remove channel *channels* :test #'string-equal)) - (irc:part *connection* channel)) - -(defun hup-irc-connection (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-irc-hook *nickname*) - (irc:start-background-message-handler *connection*)) + (irc:part (find-connection channel) channel) + (setf (car (rassoc nickname *nicknames* :test #'string=)) + (remove channel (car (rassoc nickname *nicknames* :test #'string=)) + :test #'string=))) + +(defun hup-irc-connection (nickname &optional (server *default-irc-server*)) + (ignore-errors (irc:quit (nick-connection nickname))) + (sleep 1) + (setf + (cdr (assoc nickname *connections* :test #'string=)) + (irc:connect :nickname nickname + :realname (araneida:urlstring *new-paste-url*) + :server server + :port *default-irc-server-port*)) + (mapcar #'(lambda (channel) (irc:join (nick-connection nickname) channel)) + (car (rassoc nickname *nicknames* :test #'string=))) + (add-irc-hook (nick-connection nickname) nickname) + (irc:start-background-message-handler (nick-connection nickname))) + +(defun %shut-up (connection) + (setf (irc:client-stream connection) + (make-broadcast-stream)))

(defun shut-up () - (setf (irc:client-stream *connection*) (make-broadcast-stream))) + (mapc #'%shut-up (mapcar #'cdr *connections*))) + +(defun %un-shut-up (connection) + (setf (irc:client-stream connection) *trace-output*))

(defun un-shut-up () - (setf (irc:client-stream *connection*) *trace-output*)) + (mapc #'%un-shut-up (mapcar #'cdr *connections*)))

(defun irc-notify (channel text) - (irc:privmsg *connection* channel text)) + (irc:privmsg (find-connection channel) channel text))

Index: lisppaste2/variable.lisp diff -u lisppaste2/variable.lisp:1.34 lisppaste2/variable.lisp:1.35 --- lisppaste2/variable.lisp:1.34 Wed Oct 20 22:39:21 2004 +++ lisppaste2/variable.lisp Sun Oct 24 21:54:33 2004 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.34 2004/10/20 20:39:21 bmastenbrook Exp $ +;;;; $Id: variable.lisp,v 1.35 2004/10/24 19:54:33 bmastenbrook Exp $ ;;;; $Source: /project/lisppaste/cvsroot/lisppaste2/variable.lisp,v $

;;;; See the LICENSE file for licensing information. @@ -23,12 +23,12 @@

(in-package :lisppaste)

-(defparameter *internal-http-port* 8080 +(defparameter *internal-http-port* 8081 "Port lisppaste's araneida will listen on for requests from Apache.") -(defparameter *external-http-port* 80 +(defparameter *external-http-port* 8081 "Port lisppaste's araneida will listen on for requests from remote clients.")

-(defparameter *paste-site-name* "paste.lisp.org" +(defparameter *paste-site-name* "www.unmutual.info" "Website we are running on (used for creating links).")

(defparameter *paste-external-url* @@ -37,7 +37,7 @@ :host *paste-site-name* ;;; comment out this next line when running ;;; behind a proxying apache - #| :port *external-http-port* |# + :port *external-http-port* ) "/"))

(defparameter *old-url* (araneida:merge-url @@ -153,8 +153,7 @@

(defvar *pastes* nil) (defvar *paste-counter* 0) -(defvar *connection* nil) -(defvar *nickname*) + (defvar *channels* '("None"))

(defvar *paste-file*