[cl-xmpp-cvs] CVS update: cl-xmpp/README cl-xmpp/cl-xmpp-sasl.lisp cl-xmpp/cl-xmpp.lisp

[Erik Enge]

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