Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv18563
Modified Files: README cl-xmpp-sasl.lisp cl-xmpp.lisp Log Message: fixing a minor bug and making connect do begin-xml-stream for convenience's sake
Date: Sat Nov 12 03:29:51 2005 Author: eenge
Index: cl-xmpp/README diff -u cl-xmpp/README:1.4 cl-xmpp/README:1.5 --- cl-xmpp/README:1.4 Fri Nov 11 22:20:20 2005 +++ cl-xmpp/README Sat Nov 12 03:29:51 2005 @@ -7,9 +7,6 @@
* (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 "password" "resource")
Index: cl-xmpp/cl-xmpp-sasl.lisp diff -u cl-xmpp/cl-xmpp-sasl.lisp:1.3 cl-xmpp/cl-xmpp-sasl.lisp:1.4 --- cl-xmpp/cl-xmpp-sasl.lisp:1.3 Fri Nov 11 23:31:38 2005 +++ cl-xmpp/cl-xmpp-sasl.lisp Sat Nov 12 03:29:51 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cl-xmpp-sasl.lisp,v 1.3 2005/11/11 22:31:38 eenge Exp $ +;;;; $Id: cl-xmpp-sasl.lisp,v 1.4 2005/11/12 02:29:51 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp-sasl.lisp,v $
;;;; See the LICENSE file for licensing information. @@ -17,6 +17,10 @@ (add-auth-method :sasl-digest-md5 #'%sasl-digest-md5%)
(defmethod handle-challenge-response ((connection connection) username password mechanism) + "Helper method to the sasl authentication methods. Goes through the +entire SASL challenge/response chain. Returns two values, the first +is a keyword symbol (:success or :failure) and the second is the last +stanza received from the server." (initiate-sasl-authentication connection mechanism) (let ((initial-challenge (receive-stanza connection))) (if (eq (name initial-challenge) :challenge) @@ -33,17 +37,18 @@ (format *debug-stream* "~&challenge-string: ~a~%" challenge-string) (format *debug-stream* "response: ~a~%" response) (if (eq response :failure) - (error "SASL failure: ~a." challenge-string) + (values :failure initial-challenge) (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)))) + (let ((final-reply (receive-stanza connection))) + ; This should return either :success or :failure. + (values (name final-reply) final-reply))) + (values :failure second-challenge)))))) + (values :failure initial-challenge))))
(defmethod initiate-sasl-authentication ((connection connection) mechanism) (with-xml-stream (stream connection)
Index: cl-xmpp/cl-xmpp.lisp diff -u cl-xmpp/cl-xmpp.lisp:1.10 cl-xmpp/cl-xmpp.lisp:1.11 --- cl-xmpp/cl-xmpp.lisp:1.10 Fri Nov 11 22:20:20 2005 +++ cl-xmpp/cl-xmpp.lisp Sat Nov 12 03:29:51 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cl-xmpp.lisp,v 1.10 2005/11/11 21:20:20 eenge Exp $ +;;;; $Id: cl-xmpp.lisp,v 1.11 2005/11/12 02:29:51 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp,v $
;;;; See the LICENSE file for licensing information. @@ -58,14 +58,16 @@ (format stream " (open)") (format stream " (closed)"))))
-(defun connect (username &key (hostname *default-hostname*) (port *default-port*)) +(defun connect (&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))) + (let* ((stream (trivial-sockets:open-stream + hostname port :element-type '(unsigned-byte 8))) + (connection (make-instance 'connection + :server-stream stream + :hostname hostname + :port port))) + (begin-xml-stream connection) + connection))
(defmethod connectedp ((connection connection)) "Returns t if `connection' is connected to a server and is ready for