Update of /project/cl-irc/cvsroot/cl-irc/example In directory common-lisp.net:/home/lisppaste/cl-irc/example

Modified Files: cliki-bot.asd cliki.lisp specbot.lisp Log Message: Whee! leak fewer fds by using trivial-http

Date: Tue May 10 02:36:26 2005 Author: lisppaste

Index: cl-irc/example/cliki-bot.asd diff -u cl-irc/example/cliki-bot.asd:1.3 cl-irc/example/cliki-bot.asd:1.4 --- cl-irc/example/cliki-bot.asd:1.3 Tue Jul 27 22:39:42 2004 +++ cl-irc/example/cliki-bot.asd Tue May 10 02:36:26 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cliki-bot.asd,v 1.3 2004/07/27 20:39:42 bmastenbrook Exp $ +;;;; $Id: cliki-bot.asd,v 1.4 2005/05/10 00:36:26 lisppaste Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki-bot.asd,v $

;;;; See the LICENSE file for licensing information. @@ -17,9 +17,9 @@ :licence "MIT" :description "IRC bot for SBCL" :depends-on - (:cl-irc :cl-ppcre :split-sequence) + (:cl-irc :cl-ppcre :split-sequence :trivial-http) :properties ((#:author-email . "cl-irc-devel@common-lisp.net") - (#:date . "$Date: 2004/07/27 20:39:42 $") + (#:date . "$Date: 2005/05/10 00:36:26 $") ((#:albert #:output-dir) . "doc/api-doc/") ((#:albert #:formats) . ("docbook")) ((#:albert #:docbook #:template) . "book")

Index: cl-irc/example/cliki.lisp diff -u cl-irc/example/cliki.lisp:1.28 cl-irc/example/cliki.lisp:1.29 --- cl-irc/example/cliki.lisp:1.28 Tue Nov 23 03:54:08 2004 +++ cl-irc/example/cliki.lisp Tue May 10 02:36:26 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cliki.lisp,v 1.28 2004/11/23 02:54:08 bmastenbrook Exp $ +;;;; $Id: cliki.lisp,v 1.29 2005/05/10 00:36:26 lisppaste Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/cliki.lisp,v $

;;;; cliki.lisp - CLiki as an infobot; only works on SBCL. @@ -239,41 +239,6 @@ (funcall (intern "PASTE-CHANNEL" :lisppaste) paste) (funcall (intern "PASTE-DISPLAY-URL" :lisppaste) paste))))))

-(defun url-port (url) - (assert (string-equal url "http://" :end1 7)) - (let ((path-start (position #/ url :start 7))) - (let ((port-start (position #: url :start 7 :end path-start))) - (if port-start (parse-integer url :start (1+ port-start) :junk-allowed t) 80)))) - -(defun url-host (url) - (assert (string-equal url "http://" :end1 7)) - (let* ((port-start (position #: url :start 7)) - (host-end (min (or (position #/ url :start 7) (length url)) - (or port-start (length url))))) - (subseq url 7 host-end))) - -(defun url-connection (url) - (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")) (setf str (regex-replace-all "," str "%2C")) @@ -306,35 +271,21 @@ (if interrupt-thread (ccl:process-kill interrupt-thread)))))

-(defun http-get (url) +(defun cliki-first-sentence (term) (host-with-timeout 5 - (destructuring-bind (response headers stream) - (block got - (loop - (destructuring-bind (response headers stream) (url-connection url) - (unless (member response '(301 302)) - (return-from got (list response headers stream))) - (close stream) - (setf stream nil) - (setf url (cdr (assoc :location headers)))))) - (if (not (eql response 200)) - nil - stream)))) - -(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 - (let ((stream (http-get url))) - (unwind-protect - (if (not stream) - nil - ;;(format nil "The term ~A was not found in CLiki." term) - (let ((first-line "")) - (loop for i from 1 to 5 do ;; scan the first 5 lines + (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 + (let ((stream (third (trivial-http:http-get url)))) + (unwind-protect + (if (not stream) + nil + ;;(format nil "The term ~A was not found in CLiki." term) + (let ((first-line "")) + (loop for i from 1 to 5 do ;; scan the first 5 lines (progn (multiple-value-bind (next-line missing-newline-p) (read-line stream nil) @@ -353,10 +304,10 @@ (when (scan "^([^.]|\.\S)+[.?!]$" first-line) (setf first-line (concatenate 'string first-line " " cliki-url)) (return-from cliki-return first-line)))) - (format nil "No definition was found in the first 5 lines of ~A" cliki-url))) - (if stream (close stream)))) - (condition (c &rest whatever) (return-from cliki-return (regex-replace-all "\n" (format nil "An error was encountered in lookup: ~A." c) " "))))) - )) + (format nil "No definition was found in the first 5 lines of ~A" cliki-url))) + (if stream (close stream)))) + (condition (c &rest whatever) (return-from cliki-return (regex-replace-all "\n" (format nil "An error was encountered in lookup: ~A." c) " "))))) + )))

(defun shorten (url) (handler-case @@ -529,7 +480,7 @@ (defun cliki-lookup (term-with-question &key sender channel) (let ((first-pass (regex-replace-all "^(\s*)([^?]+)(\?*)$" term-with-question "\2")) (should-send-cant-find t)) - (setf first-pass (regex-replace-all "\s\s+" first-pass "")) + (setf first-pass (regex-replace-all "\s\s+" first-pass " ")) (setf first-pass (regex-replace-all "\s*$" first-pass "")) (let ((scanned (or (nth-value 1 (scan-to-strings "^add\s+"([^"]+)"\s+as:*\s+(.+)$" first-pass)) (nth-value 1 (scan-to-strings "^add\s+(.+)\s+as:*\s+(.+)$" first-pass)))))

Index: cl-irc/example/specbot.lisp diff -u cl-irc/example/specbot.lisp:1.12 cl-irc/example/specbot.lisp:1.13 --- cl-irc/example/specbot.lisp:1.12 Tue Nov 23 03:54:08 2004 +++ cl-irc/example/specbot.lisp Tue May 10 02:36:26 2005 @@ -1,4 +1,4 @@ -;;;; $Id: specbot.lisp,v 1.12 2004/11/23 02:54:08 bmastenbrook Exp $ +;;;; $Id: specbot.lisp,v 1.13 2005/05/10 00:36:26 lisppaste Exp $ ;;;; $Source: /project/cl-irc/cvsroot/cl-irc/example/specbot.lisp,v $

;;;; specbot.lisp - an example IRC bot for cl-irc @@ -160,10 +160,19 @@ (or *load-truename* *default-pathname-defaults*)))))

+(defparameter *man-file* + (merge-pathnames "man.lisp-expr" + (make-pathname + :directory + (pathname-directory + (or *load-truename* + *default-pathname-defaults*))))) + (defun start-specbot (nick server &rest channels) (add-simple-alist-lookup *754-file* 'ieee754 "ieee754" "Section numbers of IEEE 754") (add-simple-alist-lookup *ppc-file* 'ppc "ppc" "PowerPC assembly mnemonics") (add-simple-alist-lookup *sus-file* 'sus "posix" "Single UNIX Specification") + (add-simple-alist-lookup *man-file* 'man "man" "Mac OS X Man Pages") (setf *nickname* nick) (setf *connection* (connect :nickname *nickname* :server server)) (mapcar #'(lambda (channel) (join *connection* channel)) channels)