cl-xmpp-cvs

cl-xmpp-cvs@common-lisp.net

104 discussions

[cl-xmpp-cvs] CVS update: cl-xmpp/cl-xmpp-sasl.lisp
by eenge＠common-lisp.net 11 Nov '05

11 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv1234 Modified Files: cl-xmpp-sasl.lisp Log Message: Date: Fri Nov 11 23:31:38 2005 Author: eenge Index: cl-xmpp/cl-xmpp-sasl.lisp diff -u cl-xmpp/cl-xmpp-sasl.lisp:1.2 cl-xmpp/cl-xmpp-sasl.lisp:1.3 --- cl-xmpp/cl-xmpp-sasl.lisp:1.2 Fri Nov 11 22:20:20 2005 +++ cl-xmpp/cl-xmpp-sasl.lisp Fri Nov 11 23:31:38 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cl-xmpp-sasl.lisp,v 1.2 2005/11/11 21:20:20 eenge Exp $ +;;;; $Id: cl-xmpp-sasl.lisp,v 1.3 2005/11/11 22:31:38 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp-sasl.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -26,6 +26,7 @@ :authentication-id username :password password :service "xmpp" + :realm (hostname connection) :host (hostname connection))) (response (sasl:client-step sasl-client challenge-string)) (base64-response (base64:string-to-base64-string response)))

1 0

[cl-xmpp-cvs] CVS update: cl-xmpp/README cl-xmpp/TODO cl-xmpp/cl-xmpp-sasl.asd cl-xmpp/cl-xmpp-sasl.lisp cl-xmpp/cl-xmpp-tls.asd cl-xmpp/cl-xmpp.lisp cl-xmpp/package.lisp cl-xmpp/utility.lisp cl-xmpp/variable.lisp
by eenge＠common-lisp.net 11 Nov '05

11 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv28289 Modified Files: README TODO cl-xmpp-sasl.asd cl-xmpp-sasl.lisp cl-xmpp-tls.asd cl-xmpp.lisp package.lisp utility.lisp variable.lisp Log Message: near-complete sasl support Date: Fri Nov 11 22:20:20 2005 Author: eenge Index: cl-xmpp/README diff -u cl-xmpp/README:1.3 cl-xmpp/README:1.4 --- cl-xmpp/README:1.3 Mon Oct 31 18:03:30 2005 +++ cl-xmpp/README Fri Nov 11 22:20:20 2005 @@ -5,13 +5,13 @@ * (require :cl-xmpp) - * (defvar connection (xmpp:connect :hostname "jabber.org")) + * (defvar connection (xmpp:connect "username" :hostname "jabber.org")) ;; initiate XML stream with server * (xmpp:begin-xml-stream connection) ;; authenticate (or use xmpp:register to make an account) - * (xmpp:auth connection "username" "password" "resource") + * (xmpp:auth connection "password" "resource") ;; let the server know you want to receive/send presence information ;; (this makes you "come online" if others have a subscription with you Index: cl-xmpp/TODO diff -u cl-xmpp/TODO:1.6 cl-xmpp/TODO:1.7 --- cl-xmpp/TODO:1.6 Fri Nov 11 18:21:56 2005 +++ cl-xmpp/TODO Fri Nov 11 22:20:20 2005 @@ -4,3 +4,5 @@ - also, i'm interning things which may screw up lisps with up/down case different. + +- i hate that xmlns's are as strings and never validated \ No newline at end of file Index: cl-xmpp/cl-xmpp-sasl.asd diff -u cl-xmpp/cl-xmpp-sasl.asd:1.1 cl-xmpp/cl-xmpp-sasl.asd:1.2 --- cl-xmpp/cl-xmpp-sasl.asd:1.1 Fri Nov 11 18:21:56 2005 +++ cl-xmpp/cl-xmpp-sasl.asd Fri Nov 11 22:20:20 2005 @@ -1,5 +1,5 @@ ;;;; -*- mode: lisp -*- -;;;; $Id: cl-xmpp-sasl.asd,v 1.1 2005/11/11 17:21:56 eenge Exp $ +;;;; $Id: cl-xmpp-sasl.asd,v 1.2 2005/11/11 21:20:20 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp-sasl.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -17,7 +17,7 @@ :version "0.0.1" :licence "MIT" :description "Common Lisp XMPP client implementation with SASL support" - :depends-on (#+sbcl :sb-bsd-sockets :trivial-sockets :cxml :ironclad :sasl) + :depends-on (#+sbcl :sb-bsd-sockets :trivial-sockets :cxml :ironclad :sasl :cl-base64) :components ((:file "package") (:file "variable" :depends-on ("package")) Index: cl-xmpp/cl-xmpp-sasl.lisp diff -u cl-xmpp/cl-xmpp-sasl.lisp:1.1 cl-xmpp/cl-xmpp-sasl.lisp:1.2 --- cl-xmpp/cl-xmpp-sasl.lisp:1.1 Fri Nov 11 18:21:56 2005 +++ cl-xmpp/cl-xmpp-sasl.lisp Fri Nov 11 22:20:20 2005 @@ -1,7 +1,60 @@ -;;;; $Id: cl-xmpp-sasl.lisp,v 1.1 2005/11/11 17:21:56 eenge Exp $ +;;;; $Id: cl-xmpp-sasl.lisp,v 1.2 2005/11/11 21:20:20 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp-sasl.lisp,v $ ;;;; See the LICENSE file for licensing information. (in-package :xmpp) + +;;; XXX: Remember to BIND after these, I think. +(defmethod %sasl-plain% ((connection connection) username password resource) + (handle-challenge-response connection username password "PLAIN")) + +(add-auth-method :sasl-plain #'%sasl-plain%) + +(defmethod %sasl-digest-md5% ((connection connection) username password resource) + (handle-challenge-response connection username (digestify-string password) "DIGEST-MD5")) + +(add-auth-method :sasl-digest-md5 #'%sasl-digest-md5%) + +(defmethod handle-challenge-response ((connection connection) username password mechanism) + (initiate-sasl-authentication connection mechanism) + (let ((initial-challenge (receive-stanza connection))) + (if (eq (name initial-challenge) :challenge) + (let* ((challenge-string (base64:base64-string-to-string + (data (get-element initial-challenge :\#text)))) + (sasl-client (make-instance (sasl:get-mechanism mechanism) + :authentication-id username + :password password + :service "xmpp" + :host (hostname connection))) + (response (sasl:client-step sasl-client challenge-string)) + (base64-response (base64:string-to-base64-string response))) + (format *debug-stream* "~&challenge-string: ~a~%" challenge-string) + (format *debug-stream* "response: ~a~%" response) + (if (eq response :failure) + (error "SASL failure: ~a." challenge-string) + (progn + (send-challenge-response connection base64-response) + (let ((second-challenge (receive-stanza connection))) + (if (eq (name second-challenge) :challenge) + (progn + (send-second-response connection) + ; This should return either :success or :failure. + (name (receive-stanza connection))) + (error "Expected second challenge, got: ~a." second-challenge)))))) + (error "Expected initial challenge, got: ~a." initial-challenge)))) + +(defmethod initiate-sasl-authentication ((connection connection) mechanism) + (with-xml-stream (stream connection) + (xml-output stream (fmt "<auth mechanism='~a' +xmlns='urn:ietf:params:xml:ns:xmpp-sasl'/>" mechanism)))) + +(defmethod send-challenge-response ((connection connection) response) + (with-xml-stream (stream connection) + (xml-output stream + (fmt "<response xmlns='urn:ietf:params:xml:ns:xmpp-sasl'>~a</response>" response)))) + +(defmethod send-second-response ((connection connection)) + (with-xml-stream (stream connection) + (xml-output stream "<response xmlns='urn:ietf:params:xml:ns:xmpp-sasl'/>"))) Index: cl-xmpp/cl-xmpp-tls.asd diff -u cl-xmpp/cl-xmpp-tls.asd:1.1 cl-xmpp/cl-xmpp-tls.asd:1.2 --- cl-xmpp/cl-xmpp-tls.asd:1.1 Fri Nov 11 18:21:56 2005 +++ cl-xmpp/cl-xmpp-tls.asd Fri Nov 11 22:20:20 2005 @@ -1,5 +1,5 @@ ;;;; -*- mode: lisp -*- -;;;; $Id: cl-xmpp-tls.asd,v 1.1 2005/11/11 17:21:56 eenge Exp $ +;;;; $Id: cl-xmpp-tls.asd,v 1.2 2005/11/11 21:20:20 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp-tls.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -17,7 +17,8 @@ :version "0.0.1" :licence "MIT" :description "Common Lisp XMPP client implementation with TLS+SASL support" - :depends-on (#+sbcl :sb-bsd-sockets :trivial-sockets :cxml :ironclad :cl+ssl :sasl) + :depends-on (#+sbcl :sb-bsd-sockets :trivial-sockets :cxml + :ironclad :cl+ssl :sasl :cl-base64) :components ((:file "package") (:file "variable" :depends-on ("package")) Index: cl-xmpp/cl-xmpp.lisp diff -u cl-xmpp/cl-xmpp.lisp:1.9 cl-xmpp/cl-xmpp.lisp:1.10 --- cl-xmpp/cl-xmpp.lisp:1.9 Fri Nov 11 18:21:56 2005 +++ cl-xmpp/cl-xmpp.lisp Fri Nov 11 22:20:20 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cl-xmpp.lisp,v 1.9 2005/11/11 17:21:56 eenge Exp $ +;;;; $Id: cl-xmpp.lisp,v 1.10 2005/11/11 21:20:20 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -58,15 +58,14 @@ (format stream " (open)") (format stream " (closed)")))) -;;; XXX: "not-a-pathname"? Need it because CXML wants to call -;;; pathname on the stream and without one it returns NIL which -;;; CXML breaks on. -(defun connect (&key (hostname *default-hostname*) (port *default-port*)) +(defun connect (username &key (hostname *default-hostname*) (port *default-port*)) "Open TCP connection to hostname." (let ((stream (trivial-sockets:open-stream hostname port :element-type '(unsigned-byte 8)))) - (make-instance 'connection :server-stream stream - :hostname hostname :port port))) + (make-instance 'connection + :server-stream stream + :hostname hostname + :port port))) (defmethod connectedp ((connection connection)) "Returns t if `connection' is connected to a server and is ready for @@ -80,6 +79,36 @@ (close (server-stream connection)) connection) +(defmethod feature-p ((connection connection) feature-name) + "See if connection has a specific feature. + +Eg. (has-feature *my-connection* :starttls) + +Returns the xml-element representing the feature if it +is present, nil otherwise." + (dolist (feature (features connection)) + (when (eq (name feature) feature-name) + (return-from feature-p feature)))) + +(defmethod feature-required-p ((connection connection) feature-name) + "Checks if feature is required. Three possible outcomes + +t - feature is supported and required +nil - feature is support but not required +:not-supported - feature is not supported" + (let ((feature (feature-p connection feature-name))) + (if feature + (if (get-element feature :required) + t + nil) + :not-supported))) + +(defmethod mechanism-p ((connection connection) mechanism-name) + (dolist (mechanism (mechanisms connection)) + (let ((name (intern (data (get-element mechanism :\#text)) :keyword))) + (when (eq name mechanism-name) + (return-from mechanism-p mechanism))))) + ;; ;; Handle ;; @@ -215,17 +244,24 @@ on-the-go. As soon as it has a complete element it calls the stanza-callback (which by default eventually dispatches to HANDLE)." - (loop - (let* ((stanza (read-stanza connection)) - (tagname (dom:tag-name (dom:document-element stanza)))) - (cond - ((equal tagname "stream:error") - (when stanza-callback - (funcall stanza-callback stanza connection :dom-repr dom-repr)) - (error "Received error.")) - (t - (when stanza-callback - (funcall stanza-callback stanza connection :dom-repr dom-repr))))))) + (loop (receive-stanza connection + :stanza-callback stanza-callback + :dom-repr dom-repr))) + +(defmethod receive-stanza ((connection connection) &key + (stanza-callback 'default-stanza-callback) + dom-repr) + "Returns one stanza. Hangs until one is received." + (let* ((stanza (read-stanza connection)) + (tagname (dom:tag-name (dom:document-element stanza)))) + (cond + ((equal tagname "stream:error") + (when stanza-callback + (car (funcall stanza-callback stanza connection :dom-repr dom-repr))) + (error "Received error.")) + (t + (when stanza-callback + (car (funcall stanza-callback stanza connection :dom-repr dom-repr))))))) (defun read-stanza (connection) (unless (server-xstream connection) @@ -246,7 +282,9 @@ to the debug stream. It's not strictly /with/ xml-stream so it should probably be renamed." `(let ((,stream (server-stream ,connection))) - ,@body)) + (progn + ,@body + ,connection))) (defun xml-output (stream string) "Write string to stream as a sequence of bytes and not characters." @@ -256,24 +294,31 @@ (when *debug-stream* (write-string string *debug-stream*)))) -(defmethod begin-xml-stream ((connection connection)) - "Begin XML stream. This should be the first thing to -happen on a newly connected connection." +;; +;; Operators for communicating over the XML stream +;; + +(defmethod begin-xml-stream ((connection connection) &optional jid-domain-part) + "Begin XML stream. This should be the first thing to happen on a +newly connected connection. + +Some XMPP server's addresses are not the same as the domain part of +the JID (eg. talk.google.com vs gmail.com) so we provide the option of +passing that in here. Could perhaps be taken care of by the library +but I'm trying not to optimize too early." (with-xml-stream (stream connection) (xml-output stream "<?xml version='1.0'?>") (xml-output stream (fmt "<stream:stream to='~a' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.org/streams' -version='1.0'>" (hostname connection)))) - connection) +version='1.0'>" (or jid-domain-part (hostname connection)))))) (defmethod end-xml-stream ((connection connection)) "Closes the XML stream. At this point you'd have to call BEGIN-XML-STREAM if you wished to communicate with the server again." (with-xml-stream (stream connection) - (xml-output stream "</stream:stream>")) - connection) + (xml-output stream "</stream:stream>"))) (defmacro with-iq ((connection &key id to (type "get")) &body body) "Macro to make it easier to write IQ stanzas." @@ -305,10 +350,11 @@ ;; (defmethod discover ((connection connection) &key (type :info) to node) - (let ((xmlns (case type - (:info "http://jabber.org/protocol/disco#info") - (:items "http://jabber.org/protocol/disco#items") - (t (error "Unknown type: ~a (Please choose between :info and :items)" type))))) + (let ((xmlns + (case type + (:info "http://jabber.org/protocol/disco#info") + (:items "http://jabber.org/protocol/disco#items") + (t (error "Unknown type: ~a (Please choose between :info and :items)" type))))) (with-iq-query (connection :id "info1" :xmlns xmlns :to to :node node)))) ;; @@ -340,19 +386,29 @@ (with-iq-query (connection :id "auth1" :xmlns "jabber:iq:auth") (cxml:with-element "username" (cxml:text username)))) -(defmethod auth ((connection connection) username password resource &key digestp) +(defmethod auth ((connection connection) username password + resource &key (mechanism :plain)) (setf (username connection) username) + (funcall (get-auth-method mechanism) connection username password resource)) + +(defmethod %plain-auth% ((connection connection) username password resource) + (with-iq-query (connection :id "auth2" :type "set" :xmlns "jabber:iq:auth") + (cxml:with-element "username" (cxml:text username)) + (cxml:with-element "password" (cxml:text password)) + (cxml:with-element "resource" (cxml:text resource)))) + +(add-auth-method :plain #'%plain-auth%) + +(defmethod %digest-md5-auth% ((connection connection) username password resource) (with-iq-query (connection :id "auth2" :type "set" :xmlns "jabber:iq:auth") (cxml:with-element "username" (cxml:text username)) - (if digestp - (if (stream-id connection) - (cxml:with-element "digest" (cxml:text - (make-digest-password - (stream-id connection) - password))) - (error "stream-id on ~a not set, cannot make digest password" connection)) - (cxml:with-element "password" (cxml:text password))) + (if (stream-id connection) + (cxml:with-element "digest" + (cxml:text (make-digest-password (stream-id connection) password))) + (error "stream-id on ~a not set, cannot make digest password" connection)) (cxml:with-element "resource" (cxml:text resource)))) + +(add-auth-method :digest-md5 #'%digest-md5-auth%) (defmethod presence ((connection connection) &key type to) (cxml:with-xml-output (make-octet+character-debug-stream-sink Index: cl-xmpp/package.lisp diff -u cl-xmpp/package.lisp:1.6 cl-xmpp/package.lisp:1.7 --- cl-xmpp/package.lisp:1.6 Fri Nov 11 18:21:56 2005 +++ cl-xmpp/package.lisp Fri Nov 11 22:20:20 2005 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.6 2005/11/11 17:21:56 eenge Exp $ +;;;; $Id: package.lisp,v 1.7 2005/11/11 21:20:20 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -16,6 +16,7 @@ :connect :disconnect :stream- :hostname :port :connectedp :receive-stanza-loop :begin-xml-stream :end-xml-stream :with-iq :with-iq-query :connection :username :mechanisms :features + :feature-p :feature-required-p :mechanism-p :receive-stanza ;; xmpp commands :discover :registration-requirements :register Index: cl-xmpp/utility.lisp diff -u cl-xmpp/utility.lisp:1.6 cl-xmpp/utility.lisp:1.7 --- cl-xmpp/utility.lisp:1.6 Thu Nov 10 21:41:28 2005 +++ cl-xmpp/utility.lisp Fri Nov 11 22:20:20 2005 @@ -1,4 +1,4 @@ -;;;; $Id: utility.lisp,v 1.6 2005/11/10 20:41:28 eenge Exp $ +;;;; $Id: utility.lisp,v 1.7 2005/11/11 21:20:20 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/utility.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -35,4 +35,15 @@ (handle connection result) (handle connection (dom-to-event connection result))))) +(defun list-auth-method-names () + (mapcar #'car *auth-methods*)) +(defun get-auth-method (name) + (let ((auth-method (second (assoc name *auth-methods*)))) + (if auth-method + (return-from get-auth-method auth-method) + (error "Unknown mechanism name: ~s. Please choose between: ~s." + name (list-auth-method-names))))) + +(defun add-auth-method (name operator) + (push (list name operator) *auth-methods*)) Index: cl-xmpp/variable.lisp diff -u cl-xmpp/variable.lisp:1.3 cl-xmpp/variable.lisp:1.4 --- cl-xmpp/variable.lisp:1.3 Fri Nov 11 18:21:56 2005 +++ cl-xmpp/variable.lisp Fri Nov 11 22:20:20 2005 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.3 2005/11/11 17:21:56 eenge Exp $ +;;;; $Id: variable.lisp,v 1.4 2005/11/11 21:20:20 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -35,3 +35,9 @@ (:undefined-condition :any 500) (:unexpected-request :wait 400))) +(defvar *auth-methods* nil + "Alist of method name to operator. + +Operators must accept the following operands: + + connection username password resource")

1 0

[cl-xmpp-cvs] CVS update: cl-xmpp/cl-xmpp-sasl.asd cl-xmpp/cl-xmpp-sasl.lisp cl-xmpp/cl-xmpp-tls.asd cl-xmpp/cl-xmpp-tls.lisp cl-xmpp/CREDITS cl-xmpp/TODO cl-xmpp/cl-xmpp.asd cl-xmpp/cl-xmpp.lisp cl-xmpp/cxml.lisp cl-xmpp/package.lisp cl-xmpp/variable.lisp
by eenge＠common-lisp.net 11 Nov '05

11 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv10698 Modified Files: CREDITS TODO cl-xmpp.asd cl-xmpp.lisp cxml.lisp package.lisp variable.lisp Added Files: cl-xmpp-sasl.asd cl-xmpp-sasl.lisp cl-xmpp-tls.asd cl-xmpp-tls.lisp Log Message: adding much better printing of what's happening on the stream (thanks david lichteblau) cleaning up some minor stuff adding beginnings of sasl and tls support Date: Fri Nov 11 18:21:57 2005 Author: eenge Index: cl-xmpp/CREDITS diff -u cl-xmpp/CREDITS:1.1 cl-xmpp/CREDITS:1.2 --- cl-xmpp/CREDITS:1.1 Mon Oct 31 18:02:03 2005 +++ cl-xmpp/CREDITS Fri Nov 11 18:21:56 2005 @@ -1,2 +1,4 @@ Erik Enge David Lichteblau for helping with CXML issues and testing +John Wiseman for OpenMCL support +Richard Krueter for Clisp support \ No newline at end of file Index: cl-xmpp/TODO diff -u cl-xmpp/TODO:1.5 cl-xmpp/TODO:1.6 --- cl-xmpp/TODO:1.5 Sat Oct 29 19:25:04 2005 +++ cl-xmpp/TODO Fri Nov 11 18:21:56 2005 @@ -2,6 +2,5 @@ - sasl/tls -- also, i'm interning things which will screw up lisps with up/down +- also, i'm interning things which may screw up lisps with up/down case different. - Index: cl-xmpp/cl-xmpp.asd diff -u cl-xmpp/cl-xmpp.asd:1.4 cl-xmpp/cl-xmpp.asd:1.5 --- cl-xmpp/cl-xmpp.asd:1.4 Mon Oct 31 22:07:14 2005 +++ cl-xmpp/cl-xmpp.asd Fri Nov 11 18:21:56 2005 @@ -1,5 +1,5 @@ ;;;; -*- mode: lisp -*- -;;;; $Id: cl-xmpp.asd,v 1.4 2005/10/31 21:07:14 eenge Exp $ +;;;; $Id: cl-xmpp.asd,v 1.5 2005/11/11 17:21:56 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -17,7 +17,7 @@ :version "0.0.1" :licence "MIT" :description "Common Lisp XMPP client implementation" - :depends-on (#+sbcl :sb-bsd-sockets :cxml :ironclad) + :depends-on (#+sbcl :sb-bsd-sockets :trivial-sockets :cxml :ironclad) :components ((:file "package") (:file "variable" :depends-on ("package")) Index: cl-xmpp/cl-xmpp.lisp diff -u cl-xmpp/cl-xmpp.lisp:1.8 cl-xmpp/cl-xmpp.lisp:1.9 --- cl-xmpp/cl-xmpp.lisp:1.8 Thu Nov 3 21:55:10 2005 +++ cl-xmpp/cl-xmpp.lisp Fri Nov 11 18:21:56 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cl-xmpp.lisp,v 1.8 2005/11/03 20:55:10 eenge Exp $ +;;;; $Id: cl-xmpp.lisp,v 1.9 2005/11/11 17:21:56 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -10,10 +10,6 @@ :accessor server-stream :initarg :server-stream :initform nil) - (socket - :accessor socket - :initarg :socket - :initform nil) (server-xstream :accessor server-xstream :initform nil) @@ -23,6 +19,23 @@ :initform nil :documentation "Stream ID attribute of the <stream> element as gotten when we call BEGIN-XML-STREAM.") + (features + :accessor features + :initarg :features + :initform nil + :documentation "List of xml-element objects representing +the various features the host at the other end of the connection +supports.") + (mechanisms + :accessor mechanisms + :initarg :mechanisms + :initform nil + :documentation "List of xml-element objects representing +the various mechainsms the host at the other end of the connection +will accept.") + (username + :accessor username + :initarg :username) (hostname :accessor hostname :initarg :hostname @@ -50,41 +63,10 @@ ;;; CXML breaks on. (defun connect (&key (hostname *default-hostname*) (port *default-port*)) "Open TCP connection to hostname." - #+sbcl (let ((socket (sb-bsd-sockets:make-inet-socket :stream :tcp)) - (ip-address (car (sb-bsd-sockets:host-ent-addresses - (sb-bsd-sockets:get-host-by-name hostname))))) - (sb-bsd-sockets:socket-connect socket ip-address port) - (setf (sb-bsd-sockets:non-blocking-mode socket) t) - (make-instance 'connection - :server-stream (sb-bsd-sockets:socket-make-stream - socket :input t :output t :buffering :none - :element-type '(unsigned-byte 8) - :pathname #p"/tmp/not-a-pathname") - :socket socket - :hostname hostname - :port port)) - #+(or allegro openmcl) - (let ((socket (socket:make-socket :remote-host hostname :remote-port port))) - ;; fixme: (setf (sb-bsd-sockets:non-blocking-mode socket) t) - (make-instance 'connection - :server-stream socket - :socket socket - :hostname hostname - :port port)) - #+lispworks (let ((socket (comm:open-tcp-stream hostname port - :element-type '(unsigned-byte 8)))) - (make-instance 'connection - :server-stream socket - :socket socket - :hostname hostname - :port port))) - -(defmethod make-connection-and-debug-stream ((connection connection)) - "Helper function to make a broadcast stream for this connection's -server-stream and the *debug-stream*." - ;;; Hook onto this if you want the output written by CXML to be - ;;; sent to one of your streams for debugging or whatever. - (server-stream connection)) + (let ((stream (trivial-sockets:open-stream + hostname port :element-type '(unsigned-byte 8)))) + (make-instance 'connection :server-stream stream + :hostname hostname :port port))) (defmethod connectedp ((connection connection)) "Returns t if `connection' is connected to a server and is ready for @@ -95,8 +77,7 @@ (defmethod disconnect ((connection connection)) "Disconnect TCP connection." - #+sbcl (sb-bsd-sockets:socket-close (socket connection)) - #+(or allegro openmcl lispworks) (close (socket connection)) + (close (server-stream connection)) connection) ;; @@ -104,19 +85,18 @@ ;; (defmethod handle ((connection connection) (list list)) - (dolist (object list) - (handle connection object))) + (map 'list #'(lambda (x) (handle connection x)) list)) (defmethod handle ((connection connection) object) - (format t "~&Received: ~a~%" object)) + (format t "~&UNHANDLED: ~a~%" object) + object) ;; ;; Produce DOM-ish structure from the XML DOM returned by cxml. ;; (defmethod parse-result ((connection connection) (objects list)) - (dolist (object objects) - (parse-result connection object))) + (map 'list #'(lambda (x) (parse-result connection x)) objects)) (defmethod parse-result ((connection connection) (document dom-impl::document)) (let (objects) @@ -180,15 +160,20 @@ (setf (stream-id connection) (value (get-attribute object :id))) object) +(defmethod xml-element-to-event ((connection connection) + (object xml-element) (name (eql :stream\:features))) + (dolist (element (elements object)) + (if (eq (name element) :mechanisms) + (setf (mechanisms connection) (elements element)) + (push element (features connection)))) + object) + (defmethod xml-element-to-event ((connection connection) (object xml-element) name) (declare (ignore name)) object) (defmethod dom-to-event ((connection connection) (objects list)) - (let (list) - (dolist (object objects) - (push (dom-to-event connection object) list)) - list)) + (map 'list #'(lambda (x) (dom-to-event connection x)) objects)) (defmethod dom-to-event ((connection connection) (object xml-element)) (xml-element-to-event @@ -226,6 +211,10 @@ (defmethod receive-stanza-loop ((connection connection) &key (stanza-callback 'default-stanza-callback) dom-repr) + "Reads from connection's stream and parses the XML received +on-the-go. As soon as it has a complete element it calls +the stanza-callback (which by default eventually dispatches +to HANDLE)." (loop (let* ((stanza (read-stanza connection)) (tagname (dom:tag-name (dom:document-element stanza)))) @@ -249,21 +238,23 @@ "http://etherx.jabber.org/streams" cxml::*default-namespace-bindings*))) (cxml::parse-xstream (server-xstream connection) - (make-instance 'stanza-handler))))) - + (make-instance 'stanza-handler)) + (runes::write-xstream-buffer (server-xstream connection))))) + (defmacro with-xml-stream ((stream connection) &body body) "Helper macro to make it easy to control outputting XML to the debug stream. It's not strictly /with/ xml-stream so it should probably be renamed." - `(let ((,stream (make-connection-and-debug-stream ,connection))) + `(let ((,stream (server-stream ,connection))) ,@body)) (defun xml-output (stream string) - "Write string to stream as a sequence of bytes and not -characters." - (write-sequence (string-to-array string) stream) - (finish-output stream) - string) + "Write string to stream as a sequence of bytes and not characters." + (let ((sequence (string-to-array string :element-type '(unsigned-byte 8)))) + (write-sequence sequence stream) + (finish-output stream) + (when *debug-stream* + (write-string string *debug-stream*)))) (defmethod begin-xml-stream ((connection connection)) "Begin XML stream. This should be the first thing to @@ -273,27 +264,29 @@ (xml-output stream (fmt "<stream:stream to='~a' xmlns='jabber:client' xmlns:stream='http://etherx.jabber.org/streams' -version='1.0'>" (hostname connection))))) +version='1.0'>" (hostname connection)))) + connection) (defmethod end-xml-stream ((connection connection)) "Closes the XML stream. At this point you'd have to call BEGIN-XML-STREAM if you wished to communicate with the server again." (with-xml-stream (stream connection) - (xml-output stream "</stream:stream>"))) + (xml-output stream "</stream:stream>")) + connection) (defmacro with-iq ((connection &key id to (type "get")) &body body) "Macro to make it easier to write IQ stanzas." (let ((stream (gensym))) - `(let ((,stream (make-connection-and-debug-stream ,connection))) - (cxml:with-xml-output (cxml:make-octet-stream-sink ,stream) + `(let ((,stream (server-stream ,connection))) + (cxml:with-xml-output (make-octet+character-debug-stream-sink ,stream) (cxml:with-element "iq" (cxml:attribute "id" ,id) (when ,to (cxml:attribute "to" ,to)) (cxml:attribute "type" ,type) ,@body)) - (finish-output ,stream) + (force-output ,stream) ,connection))) (defmacro with-iq-query ((connection &key xmlns id to node (type "get")) &body body) @@ -336,11 +329,10 @@ (with-iq-query (connection :id "unreg1" :type "set" :xmlns "jabber:iq:register") (cxml:with-element "remove"))) -;;; XXX: connection should know about username? -(defmethod change-password ((connection connection) username new-password) +(defmethod change-password ((connection connection) new-password) (with-iq-query (connection :id "change1" :type "set" :xmlns "jabber:iq:register") (cxml:with-element "username" - (cxml:text username)) + (cxml:text (username connection))) (cxml:with-element "password" (cxml:text new-password)))) @@ -349,6 +341,7 @@ (cxml:with-element "username" (cxml:text username)))) (defmethod auth ((connection connection) username password resource &key digestp) + (setf (username connection) username) (with-iq-query (connection :id "auth2" :type "set" :xmlns "jabber:iq:auth") (cxml:with-element "username" (cxml:text username)) (if digestp @@ -362,8 +355,8 @@ (cxml:with-element "resource" (cxml:text resource)))) (defmethod presence ((connection connection) &key type to) - (cxml:with-xml-output (cxml:make-octet-stream-sink - (make-connection-and-debug-stream connection)) + (cxml:with-xml-output (make-octet+character-debug-stream-sink + (server-stream connection)) (cxml:with-element "presence" (when type (cxml:attribute "type" type)) @@ -372,8 +365,8 @@ connection) (defmethod message ((connection connection) to body) - (cxml:with-xml-output (cxml:make-octet-stream-sink - (make-connection-and-debug-stream connection)) + (cxml:with-xml-output (make-octet+character-debug-stream-sink + (server-stream connection)) (cxml:with-element "message" (cxml:attribute "to" to) (cxml:with-element "body" (cxml:text body)))) Index: cl-xmpp/cxml.lisp diff -u cl-xmpp/cxml.lisp:1.3 cl-xmpp/cxml.lisp:1.4 --- cl-xmpp/cxml.lisp:1.3 Sat Oct 29 05:58:04 2005 +++ cl-xmpp/cxml.lisp Fri Nov 11 18:21:56 2005 @@ -1,5 +1,4 @@ ;;;; cxml-stanza.lisp -- parser helper for RFC 3920 XML streams -;;;; Copyright (c) 2004 David Lichteblau, BSD-style license ;;; These are modifications to CXML which helps us deal with the ;;; incremental-style parsing required for the XML stanzas. @@ -72,3 +71,82 @@ (defun cxml::set-full-speed (input) (declare (ignore input)) nil) + +;; To facilitate writing to both an octet and a character stream +;; using CXML. + +(defclass octet+character-debug-stream-sink (cxml::octet-stream-sink) + ((target-stream + :accessor target-stream + :initarg :target-stream))) + +(defun make-octet+character-debug-stream-sink (octet-stream &rest initargs) + (apply #'make-instance 'octet+character-debug-stream-sink + :target-stream octet-stream + initargs)) + +(defmethod cxml::write-octet (octet (sink octet+character-debug-stream-sink)) + (write-byte octet (target-stream sink)) + (when *debug-stream* + (write-char (code-char octet) *debug-stream*))) + +;; I'd like to see what CXML is reading from the stream +;; and this code helps us in that regard by printing it +;; to the *debug-stream* + +(defun runes::write-xstream-buffer (xstream &optional (stream *debug-stream*)) + (when stream + (write-string (map 'string + #'code-char + (remove runes::+end+ + (subseq (runes::xstream-buffer xstream) 0 + (runes::xstream-read-ptr xstream)))) + stream) + (force-output stream))) + +(defun runes::xstream-underflow (input) + (declare (type runes::xstream input)) + ;; we are about to fill new data into the buffer, so we need to + ;; adjust buffer-start. + (runes::write-xstream-buffer input) + (incf (runes::xstream-buffer-start input) + (- (runes::xstream-fill-ptr input) 0)) + (let (n m) + ;; when there is something left in the os-buffer, we move it to + ;; the start of the buffer. + (setf m (- (runes::xstream-os-left-end input) (runes::xstream-os-left-start input))) + (unless (zerop m) + (replace (runes::xstream-os-buffer input) (runes::xstream-os-buffer input) + :start1 0 :end1 m + :start2 (runes::xstream-os-left-start input) + :end2 (runes::xstream-os-left-end input)) + ;; then we take care that the buffer is large enough to carry at + ;; least 100 bytes (a random number) + (unless (>= (length (runes::xstream-os-buffer input)) 100) + (error "You lost") + ;; todo: enlarge buffer + )) + (setf n + (runes::read-octets (runes::xstream-os-buffer input) (runes::xstream-os-stream input) + m (min (1- (length (runes::xstream-os-buffer input))) + (+ m (runes::xstream-speed input))))) + (cond ((runes::%= n 0) + (setf (runes::xstream-read-ptr input) 0 + (runes::xstream-fill-ptr input) n) + (setf (aref (runes::xstream-buffer input) + (runes::xstream-fill-ptr input)) runes::+end+) + :eof) + (t + (multiple-value-bind (fnw fnr) + (encoding:decode-sequence + (runes::xstream-encoding input) + (runes::xstream-os-buffer input) 0 n + (runes::xstream-buffer input) 0 (1- (length (runes::xstream-buffer input))) + (= n m)) + (setf (runes::xstream-os-left-start input) fnr + (runes::xstream-os-left-end input) n + (runes::xstream-read-ptr input) 0 + (runes::xstream-fill-ptr input) fnw) + (setf (aref (runes::xstream-buffer input) + (runes::xstream-fill-ptr input)) runes::+end+) + (runes:read-rune input)))))) Index: cl-xmpp/package.lisp diff -u cl-xmpp/package.lisp:1.5 cl-xmpp/package.lisp:1.6 --- cl-xmpp/package.lisp:1.5 Mon Nov 7 20:15:51 2005 +++ cl-xmpp/package.lisp Fri Nov 11 18:21:56 2005 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.5 2005/11/07 19:15:51 eenge Exp $ +;;;; $Id: package.lisp,v 1.6 2005/11/11 17:21:56 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -13,9 +13,9 @@ (:nicknames :xmpp) (:export ;; connection-related - :connect :disconnect :socket :stream- :hostname :port :connectedp + :connect :disconnect :stream- :hostname :port :connectedp :receive-stanza-loop :begin-xml-stream :end-xml-stream :with-iq - :with-iq-query :connection + :with-iq-query :connection :username :mechanisms :features ;; xmpp commands :discover :registration-requirements :register Index: cl-xmpp/variable.lisp diff -u cl-xmpp/variable.lisp:1.2 cl-xmpp/variable.lisp:1.3 --- cl-xmpp/variable.lisp:1.2 Fri Oct 28 23:04:12 2005 +++ cl-xmpp/variable.lisp Fri Nov 11 18:21:56 2005 @@ -1,36 +1,37 @@ -;;;; $Id: variable.lisp,v 1.2 2005/10/28 21:04:12 eenge Exp $ +;;;; $Id: variable.lisp,v 1.3 2005/11/11 17:21:56 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. (in-package :xmpp) -(defvar *debug-stream* *standard-output*) +(defvar *debug-stream* *debug-io* + "A character stream, or nil") (defvar *default-port* 5222) (defvar *default-hostname* "localhost") (defvar *errors* - '((:bad-request 'modiy 400) - (:conflict 'cancel 409) - (:feature-not-implemented 'cancel 501) - (:forbidden 'auth 403) - (:gone 'modify 302) - (:internal-server-error 'wait 500) - (:item-not-found 'cancel 404) - (:jid-malformed 'modify 400) - (:not-acceptable 'modify 406) - (:not-allowed 'cancel 405) - (:not-authorized 'auth 401) - (:payment-required 'auth 402) - (:recipient-unavailable 'wait 404) - (:redirect 'modify 302) - (:registration-required 'auth 407) - (:remote-server-not-found 'cancel 404) - (:remote-server-timeout 'wait 504) - (:resource-constraint 'wait 500) - (:service-unavailable 'cancel 503) - (:subscription-required 'auth 407) - (:undefined-condition 'any 500) - (:unexpected-request 'wait 400))) + '((:bad-request :modiy 400) + (:conflict :cancel 409) + (:feature-not-implemented :cancel 501) + (:forbidden :auth 403) + (:gone :modify 302) + (:internal-server-error :wait 500) + (:item-not-found :cancel 404) + (:jid-malformed :modify 400) + (:not-acceptable :modify 406) + (:not-allowed :cancel 405) + (:not-authorized :auth 401) + (:payment-required :auth 402) + (:recipient-unavailable :wait 404) + (:redirect :modify 302) + (:registration-required :auth 407) + (:remote-server-not-found :cancel 404) + (:remote-server-timeout :wait 504) + (:resource-constraint :wait 500) + (:service-unavailable :cancel 503) + (:subscription-required :auth 407) + (:undefined-condition :any 500) + (:unexpected-request :wait 400)))

1 0

[cl-xmpp-cvs] CVS update: public_html/index.html
by eenge＠common-lisp.net 11 Nov '05

11 Nov '05

Update of /project/cl-xmpp/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv30363 Modified Files: index.html Log Message: adding comment about needing trivial-sockets Date: Fri Nov 11 15:38:10 2005 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.17 public_html/index.html:1.18 --- public_html/index.html:1.17 Thu Nov 10 22:17:59 2005 +++ public_html/index.html Fri Nov 11 15:38:09 2005 @@ -30,7 +30,8 @@ <h2>Requirements</h2> <div class="level"> <ul> - <li>SBCL, LispWorks, OpenMCL and Allegro (patches welcome for others)</li> + <li>Any implementation which can run the dependencies</li> + <li><a href="http://cliki.net/trivial-sockets">trivial-sockets</a></li> <li><a href="http://common-lisp.net/project/cxml">cxml</a></li> <li><a href="http://cliki.net/ironclad">Ironclad</a></li> </ul>

1 0

[cl-xmpp-cvs] CVS update: public_html/index.html
by eenge＠common-lisp.net 10 Nov '05

10 Nov '05

Update of /project/cl-xmpp/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv19731 Modified Files: index.html Log Message: note about support for OpenMCL Date: Thu Nov 10 22:17:59 2005 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.16 public_html/index.html:1.17 --- public_html/index.html:1.16 Thu Nov 10 22:17:13 2005 +++ public_html/index.html Thu Nov 10 22:17:59 2005 @@ -30,7 +30,7 @@ <h2>Requirements</h2> <div class="level"> <ul> - <li>A recent SBCL (need 16bit wide characters), LispWorks or Allegro (patches welcome for others)</li> + <li>SBCL, LispWorks, OpenMCL and Allegro (patches welcome for others)</li> <li><a href="http://common-lisp.net/project/cxml">cxml</a></li> <li><a href="http://cliki.net/ironclad">Ironclad</a></li> </ul>

1 0

[cl-xmpp-cvs] CVS update: public_html/index.html
by eenge＠common-lisp.net 10 Nov '05

10 Nov '05

Update of /project/cl-xmpp/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv19710 Modified Files: index.html Log Message: adding link to mailinglist archives Date: Thu Nov 10 22:17:14 2005 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.15 public_html/index.html:1.16 --- public_html/index.html:1.15 Mon Oct 31 22:10:34 2005 +++ public_html/index.html Thu Nov 10 22:17:13 2005 @@ -82,7 +82,7 @@ <div class="level"> <p>Questions, feature requests, and bug-reports are welcome on <tt><a href="mailto:cl-xmpp-devel@common-lisp.net"> - cl-xmpp-devel(a)common-lisp.net</a></tt>.</p> + cl-xmpp-devel(a)common-lisp.net</a></tt> (<a href="http://common-lisp.net/pipermail/cl-xmpp-devel/">archives</a>.</p> </div>

1 0

[cl-xmpp-cvs] CVS update: cl-xmpp/utility.lisp
by eenge＠common-lisp.net 10 Nov '05

10 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv16485 Modified Files: utility.lisp Log Message: deleted some functions from utility.lisp which are now in ironclad 0.10 Date: Thu Nov 10 21:41:28 2005 Author: eenge Index: cl-xmpp/utility.lisp diff -u cl-xmpp/utility.lisp:1.5 cl-xmpp/utility.lisp:1.6 --- cl-xmpp/utility.lisp:1.5 Mon Oct 31 22:07:15 2005 +++ cl-xmpp/utility.lisp Thu Nov 10 21:41:28 2005 @@ -1,4 +1,4 @@ -;;;; $Id: utility.lisp,v 1.5 2005/10/31 21:07:15 eenge Exp $ +;;;; $Id: utility.lisp,v 1.6 2005/11/10 20:41:28 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/utility.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -21,26 +21,10 @@ (setf (aref array position) (char-code (aref string position)))) array)) -(defun hex-array-to-ascii-string (array) - (let ((string (make-string 0))) - (dotimes (position (length array)) - (let ((element (aref array position)) - (*print-base* 16)) - (setq string (fmt "~a~a" string element)))) ; probably inefficient - string)) - -;;; borrowed from ironclad, so Copyright (C) 2004 Nathan Froyd -(defun ascii-string-to-byte-array (string) - (let ((vec (make-array (length string) :element-type '(unsigned-byte 8)))) - (dotimes (i (length string) vec) - (let ((byte (char-code (char string i)))) - (assert (< byte 256)) - (setf (aref vec i) byte))))) - (defun digestify-string (string) - (hex-array-to-ascii-string + (ironclad:byte-array-to-hex-string (ironclad:digest-sequence - :sha1 (ascii-string-to-byte-array string)))) + :sha1 (ironclad:ascii-string-to-byte-array string)))) (defun make-digest-password (stream-id password) (string-downcase (digestify-string (fmt "~a~a" stream-id password))))

1 0

[cl-xmpp-cvs] CVS update: cl-xmpp/package.lisp
by eenge＠common-lisp.net 07 Nov '05

07 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv19888 Modified Files: package.lisp Log Message: nickname xmpp had gone missing, readded Date: Mon Nov 7 20:15:51 2005 Author: eenge Index: cl-xmpp/package.lisp diff -u cl-xmpp/package.lisp:1.4 cl-xmpp/package.lisp:1.5 --- cl-xmpp/package.lisp:1.4 Thu Nov 3 21:55:11 2005 +++ cl-xmpp/package.lisp Mon Nov 7 20:15:51 2005 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.4 2005/11/03 20:55:11 eenge Exp $ +;;;; $Id: package.lisp,v 1.5 2005/11/07 19:15:51 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -10,6 +10,7 @@ (:use :cl #+allegro :socket #+openmcl :ccl) + (:nicknames :xmpp) (:export ;; connection-related :connect :disconnect :socket :stream- :hostname :port :connectedp

1 0

[cl-xmpp-cvs] CVS update: cl-xmpp/cl-xmpp.lisp cl-xmpp/package.lisp
by eenge＠common-lisp.net 03 Nov '05

03 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv2289 Modified Files: cl-xmpp.lisp package.lisp Log Message: adding openmcl support from lemonodor Date: Thu Nov 3 21:55:11 2005 Author: eenge Index: cl-xmpp/cl-xmpp.lisp diff -u cl-xmpp/cl-xmpp.lisp:1.7 cl-xmpp/cl-xmpp.lisp:1.8 --- cl-xmpp/cl-xmpp.lisp:1.7 Mon Oct 31 22:07:15 2005 +++ cl-xmpp/cl-xmpp.lisp Thu Nov 3 21:55:10 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cl-xmpp.lisp,v 1.7 2005/10/31 21:07:15 eenge Exp $ +;;;; $Id: cl-xmpp.lisp,v 1.8 2005/11/03 20:55:10 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -63,7 +63,8 @@ :socket socket :hostname hostname :port port)) - #+allegro (let ((socket (socket:make-socket :remote-host hostname :remote-port port))) + #+(or allegro openmcl) + (let ((socket (socket:make-socket :remote-host hostname :remote-port port))) ;; fixme: (setf (sb-bsd-sockets:non-blocking-mode socket) t) (make-instance 'connection :server-stream socket @@ -95,7 +96,7 @@ (defmethod disconnect ((connection connection)) "Disconnect TCP connection." #+sbcl (sb-bsd-sockets:socket-close (socket connection)) - #+(or allegro lispworks) (close (socket connection)) + #+(or allegro openmcl lispworks) (close (socket connection)) connection) ;; Index: cl-xmpp/package.lisp diff -u cl-xmpp/package.lisp:1.3 cl-xmpp/package.lisp:1.4 --- cl-xmpp/package.lisp:1.3 Sat Oct 29 19:25:04 2005 +++ cl-xmpp/package.lisp Thu Nov 3 21:55:11 2005 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.3 2005/10/29 17:25:04 eenge Exp $ +;;;; $Id: package.lisp,v 1.4 2005/11/03 20:55:11 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -7,8 +7,9 @@ (eval-when (:execute :load-toplevel :compile-toplevel) (defpackage :cl-xmpp - (:use :cl) - (:nicknames :xmpp) + (:use :cl + #+allegro :socket + #+openmcl :ccl) (:export ;; connection-related :connect :disconnect :socket :stream- :hostname :port :connectedp

1 0

[cl-xmpp-cvs] CVS update: public_html/index.html
by eenge＠common-lisp.net 31 Oct '05

31 Oct '05

Update of /project/cl-xmpp/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv15264 Modified Files: index.html Log Message: up'ing to 0.5.0 Date: Mon Oct 31 22:10:34 2005 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.14 public_html/index.html:1.15 --- public_html/index.html:1.14 Mon Oct 31 18:08:33 2005 +++ public_html/index.html Mon Oct 31 22:10:34 2005 @@ -7,7 +7,7 @@ <body> <div class="header"> - <h1>cl-xmpp 0.4.0</h1> + <h1>cl-xmpp 0.5.0</h1> </div> <div class="body"> @@ -32,12 +32,14 @@ <ul> <li>A recent SBCL (need 16bit wide characters), LispWorks or Allegro (patches welcome for others)</li> <li><a href="http://common-lisp.net/project/cxml">cxml</a></li> + <li><a href="http://cliki.net/ironclad">Ironclad</a></li> </ul> </div> <h2>News</h2> <div class="level"> <ul> + <li>Version 0.5.0 released (Now depending on <a href="http://cliki.net/ironclad">Ironclad</a> for digest authentication)</li> <li>Version 0.4.0 released (Better support for JEP0030 (service discovery) and more exported symbols)</li> <li>Version 0.3.0 released (Added Allegro and LispWorks support)</li> <li>Version 0.2.0 released (JEP 0073 support)</li>

1 0

← Newer
1
...
5
6
7
8
9
10
11
Older →

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

cl-xmpp-cvs