Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/tmp/cvs-serv12457/example

Modified Files: clhs.lisp cliki-bot.asd cliki.lisp eliza-rules.lisp Log Message: Portability fixes

Date: Tue Jun 1 06:48:12 2004 Author: bmastenbrook

Index: cl-irc/example/clhs.lisp diff -u cl-irc/example/clhs.lisp:1.4 cl-irc/example/clhs.lisp:1.5 --- cl-irc/example/clhs.lisp:1.4 Sun Feb 1 06:11:56 2004 +++ cl-irc/example/clhs.lisp Tue Jun 1 06:48:12 2004 @@ -1,4 +1,4 @@ -;;;; $Id: clhs.lisp,v 1.4 2004/02/01 14:11:56 bmastenbrook Exp $ +;;;; $Id: clhs.lisp,v 1.5 2004/06/01 13:48:12 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/clhs.lisp,v $

;;;; clhs.lisp - an example IRC bot for cl-irc @@ -20,7 +20,7 @@ (in-package :clhs)

;;; CLHS. This will be the default lookup. -(defparameter *hyperspec-pathname* #p"/home/bmastenbrook/HyperSpec/") +(defparameter *hyperspec-pathname* #p"/Users/chandler/HyperSpec/")

(defparameter *hyperspec-map-file* (merge-pathnames "Data/Map_Sym.txt" *hyperspec-pathname*))

@@ -167,8 +167,12 @@ (setf *clhs-connection* (connect :nickname *clhs-nickname* :server server)) (mapcar #'(lambda (channel) (join *clhs-connection* channel)) channels) (add-hook *clhs-connection* 'irc::irc-privmsg-message 'msg-hook) - #+sbcl (start-background-message-handler *clhs-connection*) - #-sbcl (read-message-loop *clhs-connection*)) + #+(or sbcl + openmcl) + (start-background-message-handler *clhs-connection*) + #-(or sbcl + openmcl) + (read-message-loop *clhs-connection*))

(defun shuffle-hooks () (irc::remove-hooks *clhs-connection* 'irc::irc-privmsg-message)

Index: cl-irc/example/cliki-bot.asd diff -u cl-irc/example/cliki-bot.asd:1.1 cl-irc/example/cliki-bot.asd:1.2 --- cl-irc/example/cliki-bot.asd:1.1 Sat Jan 17 11:19:55 2004 +++ cl-irc/example/cliki-bot.asd Tue Jun 1 06:48:12 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki-bot.asd,v 1.1 2004/01/17 19:19:55 bmastenbrook Exp $ +;;;; $Id: cliki-bot.asd,v 1.2 2004/06/01 13:48:12 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki-bot.asd,v $

;;;; See the LICENSE file for licensing information. @@ -17,10 +17,9 @@ :licence "MIT" :description "IRC bot for SBCL" :depends-on - #+sbcl (:cl-irc :cl-ppcre) - #-sbcl (:sbcl) + (:cl-irc :cl-ppcre) :properties ((#:author-email . "cl-irc-devel@common-lisp.net") - (#:date . "$Date: 2004/01/17 19:19:55 $") + (#:date . "$Date: 2004/06/01 13:48:12 $") ((#:albert #:output-dir) . "doc/api-doc/") ((#:albert #:formats) . ("docbook")) ((#:albert #:docbook #:template) . "book") @@ -30,4 +29,4 @@ (:file "eliza-rules" :depends-on ("mp2eliza")) (:file "cliki" - :depends-on ("mp2eliza")))) \ No newline at end of file + :depends-on ("mp2eliza"))))

Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.4 cl-irc/example/cliki.lisp:1.5 --- cl-irc/example/cliki.lisp:1.4 Sun Feb 1 06:11:56 2004 +++ cl-irc/example/cliki.lisp Tue Jun 1 06:48:12 2004 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.4 2004/02/01 14:11:56 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.5 2004/06/01 13:48:12 bmastenbrook Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $

;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -7,7 +7,7 @@ ;;; cliki.lisp, and invoke (cliki::start-cliki-bot "desirednickname" ;;; "desiredserver" "#channel1" "#channel2" "#channel3" ...)

-(defpackage :cliki (:use :common-lisp :irc :sb-bsd-sockets :cl-ppcre) +(defpackage :cliki (:use :common-lisp :irc :cl-ppcre) (:export :start-cliki-bot :*cliki-nickserv-password* :*respond-to-general-hellos*)) (in-package :cliki) @@ -50,31 +50,47 @@ (or port-start (length url))))) (subseq url 7 host-end)))

+#+(or ccl allegro) +(defun socket-connect (host port) + (#+ccl ccl:make-socket + #+allegro socket:make-socket + :connect :active + :remote-host host + :remote-port port)) + +#+sbcl +(defun socket-connect (host port) + (let ((s (make-instance 'sb-bsd-sockets:inet-socket + :type :stream + :protocol :tcp))) + (sb-bsd-sockets:socket-connect s (car (sb-bsd-sockets:host-ent-addresses + (sb-bsd-sockets:get-host-by-name host))) port) + (sb-bsd-sockets:socket-make-stream s + :element-type 'character + :input t + :output t + :buffering :none))) + (defun url-connection (url) - (let ((s (make-instance 'inet-socket :type :stream :protocol :tcp)) - (host (url-host url)) - (port (url-port url))) - (declare (ignore port)) - (socket-connect - s (car (host-ent-addresses (get-host-by-name (url-host url)))) - (url-port url)) - (let ((stream (socket-make-stream s :input t :output t :buffering :full))) - ;; we are exceedingly unportable about proper line-endings here. - ;; Anyone wishing to run this under non-SBCL should take especial care - (format stream "GET ~A HTTP/1.0~%Host: ~A~%User-Agent: CLiki Bot~%~%" url host) - (force-output stream) - (list - (let* ((l (read-line stream)) - (space (position #\Space l))) - (parse-integer l :start (1+ space) :junk-allowed t)) - (loop for line = (read-line stream nil nil) - until (or (null line) (eql (elt line 0) (code-char 13))) - collect - (let ((colon (position #: line))) - (cons (intern (string-upcase (subseq line 0 colon)) :keyword) - (string-trim (list #\Space (code-char 13)) - (subseq line (1+ colon)))))) - stream)))) + (let* ((host (url-host url)) + (port (url-port url)) + (stream (socket-connect host port))) + ;; we are exceedingly unportable about proper line-endings here. + ;; Anyone wishing to run this under non-SBCL should take especial care + (format stream "GET ~A HTTP/1.0~%Host: ~A~%User-Agent: CLiki Bot~%~%" url host) + (force-output stream) + (list + (let* ((l (read-line stream)) + (space (position #\Space l))) + (parse-integer l :start (1+ space) :junk-allowed t)) + (loop for line = (read-line stream nil nil) + until (or (null line) (eql (elt line 0) (code-char 13))) + collect + (let ((colon (position #: line))) + (cons (intern (string-upcase (subseq line 0 colon)) :keyword) + (string-trim (list #\Space (code-char 13)) + (subseq line (1+ colon)))))) + stream)))

(defun encode-for-url (str) (setf str (regex-replace-all " " str "%20")) @@ -83,13 +99,33 @@ ;(format t "hi ~A~%" str) str)

+#+sbcl +(defmacro host-with-timeout (timeout &body body) + `(sb-ext:with-timeout ,timeout ,@body)) + +#+ccl +(defmacro host-with-timeout (timeout &body body) + `(let ((interrupt-thread nil)) + (setf interrupt-thread + (ccl:process-run-function 'timeout + (let ((process ccl:*current-process*)) + (lambda () + (sleep ,timeout) + (ccl:process-interrupt process + (lambda () + (signal 'openmcl-timeout))))))) + (unwind-protect + (progn ,@body) + (if interrupt-thread + (ccl:process-kill interrupt-thread))))) + (defun cliki-first-sentence (term) (let* ((cliki-url (format nil "http://www.cliki.net/~A" (encode-for-url term))) (url (concatenate 'string cliki-url "?source"))) (block cliki-return (handler-case - (sb-ext:with-timeout 5 + (host-with-timeout 5 (destructuring-bind (response headers stream) (block got (loop @@ -138,7 +174,7 @@

(defparameter *cliki-bot-help* "The minion bot supplies small definitions and performs lookups on CLiki. To use it, try ``minion: term?''. To add a term for IRC, try saying ``minion: add "term" as: definition'' or ``minion: alias "term" as: term''; otherwise, edit the corresponding CLiki page.")

-(defun cliki-lookup (term-with-question) +(defun cliki-lookup (term-with-question &optional sender) (let ((first-pass (regex-replace-all "^(\s*)([^?]+)(\?*)$" term-with-question "\2"))) (setf first-pass (regex-replace-all "\s\s+" first-pass "")) (setf first-pass (regex-replace-all "\s*$" first-pass "")) @@ -156,9 +192,15 @@ (setf first-pass (regex-replace-all "(:|/|\\|\#)" first-pass "")) (or (if (string-equal first-pass "help") *cliki-bot-help*) - (if (scan "^(?i)hello(\s|$)" first-pass) "what's up?") - (if (scan "^(?i)hi(\s|$)" first-pass) "what's up?") - (if (scan "^(?i)yo(\s|$)" first-pass) "what's up?") + (if (scan "^(?i)hello(\s|$)*" first-pass) "what's up?") + (if (scan "^(?i)hi(\s|$)*" first-pass) "what's up?") + (if (scan "^(?i)yo(\s|$)*" first-pass) "what's up?") + (if (scan "^(?i)thank(s| you)(\s|!|\?|\.|$)*" first-pass) + (if sender + (format nil "~A: you failed the inverse turing test!" sender) + "you failed the inverse turing test!")) + (if (scan "^(?i)version(\s|!|\?|\.|$)*" first-pass) + (format nil "This is the minion bot, running on a ~A (~A) and running under ~A ~A." (machine-type) (machine-version) (lisp-implementation-type) (lisp-implementation-version))) (if (scan "^(?i)(?i)do my bidding!*$" first-pass) "Yes, my master.") (aif (or (let ((term (cdr (assoc first-pass *small-definitions* :test #'string-equal)))) (if term (if (stringp term) term (cliki-lookup (car term))))) @@ -183,7 +225,7 @@ (defun msg-hook (message) (let ((respond-to (if (string-equal (first (arguments message)) *cliki-nickname*) (source message) (first (arguments message))))) (if (valid-cliki-message message) - (privmsg *cliki-connection* respond-to (cliki-lookup (regex-replace *cliki-attention-prefix* (trailing-argument message) ""))) + (privmsg *cliki-connection* respond-to (cliki-lookup (regex-replace *cliki-attention-prefix* (trailing-argument message) "") (source message))) (if (string-equal (first (arguments message)) *cliki-nickname*) (privmsg *cliki-connection* respond-to (cliki-lookup (trailing-argument message))) (if (anybody-here (trailing-argument message)) @@ -203,8 +245,7 @@ (mapcar #'(lambda (channel) (join *cliki-connection* channel)) channels) (add-hook *cliki-connection* 'irc::irc-privmsg-message 'msg-hook) (add-hook *cliki-connection* 'irc::irc-notice-message 'notice-hook) - #+sbcl (start-background-message-handler *cliki-connection*) - #-sbcl (read-message-loop *cliki-connection*)) + (start-background-message-handler *cliki-connection*))

(defun shuffle-hooks () (irc::remove-hooks *cliki-connection* 'irc::irc-privmsg-message)

Index: cl-irc/example/eliza-rules.lisp diff -u cl-irc/example/eliza-rules.lisp:1.2 cl-irc/example/eliza-rules.lisp:1.3 --- cl-irc/example/eliza-rules.lisp:1.2 Sun Feb 1 06:11:56 2004 +++ cl-irc/example/eliza-rules.lisp Tue Jun 1 06:48:12 2004 @@ -21,6 +21,9 @@ (((?* ?x) bot (?* ?y)) (|I'm| not a |bot.| I prefer the term |``electronically composed''.|))

+ ((seen ?x) + (?x was last seen 5y6m14d32h43m10s |ago,| saying |"minion: when are you going to support seen?"|)) + (((?* ?x) did you (?* ?y)) (|no, I didn't| ?y) (|yes, I| ?y)) @@ -34,6 +37,9 @@ (Thanks!))

((bot snack) + (Thanks!)) + + ((welcome (?* ?y)) (Thanks!))

((not much) (good))