[cl-xmpp-cvs] CVS update: cl-xmpp/README cl-xmpp/cl-xmpp-sasl.lisp cl-xmpp/cl-xmpp-tls.lisp cl-xmpp/cl-xmpp.lisp cl-xmpp/cxml.lisp cl-xmpp/package.lisp
Erik Enge
eenge at common-lisp.net
Sat Nov 12 04:20:24 UTC 2005
Update of /project/cl-xmpp/cvsroot/cl-xmpp
In directory common-lisp.net:/tmp/cvs-serv27583
Modified Files:
README cl-xmpp-sasl.lisp cl-xmpp-tls.lisp cl-xmpp.lisp
cxml.lisp package.lisp
Log Message:
I think the TLS code should work now but until I get a new LW to work with
CFFI I can't test on this computer.
Date: Sat Nov 12 05:20:22 2005
Author: eenge
Index: cl-xmpp/README
diff -u cl-xmpp/README:1.5 cl-xmpp/README:1.6
--- cl-xmpp/README:1.5 Sat Nov 12 03:29:51 2005
+++ cl-xmpp/README Sat Nov 12 05:20:21 2005
@@ -9,9 +9,10 @@
;; authenticate (or use xmpp:register to make an account)
* (xmpp:auth connection "password" "resource")
+;; defaults to plain non-sasl authentication but sasl is also available
;; let the server know you want to receive/send presence information
-;; (this makes you "come online" if others have a subscription with you
+;; (this makes you "come online" if others have a subscription with you)
* (xmpp:presence connection)
;; send someone a message
@@ -21,6 +22,9 @@
* (xmpp:receive-stanza-loop connection)
<MESSAGE from=username at hostname to=me at myserver>
[....]
+;; or use xmpp:receive-stanza if you're just wanting one stanza
+;; (note it will still block until you have received a complete
+;; stanza)
;; That's it. Interrupt the loop to issue other commands, eg:
* (xmpp:get-roster connection)
@@ -30,8 +34,9 @@
;; If you wish to handle the incoming messages or other objects simply
;; specify an xmpp:handle method for the objects you are interested in
-;; or (defmethod xmpp:handle (connection object) ...) to get them all. Or alternatively
-;; specify :dom-repr t to receive-stanza-loop to get DOM-ish objects.
+;; or (defmethod xmpp:handle (connection object) ...) to get them
+;; all. Or alternatively specify :dom-repr t to receive-stanza-loop
+;; to get DOM-ish objects.
;; For example, if you wanted to create an annoying reply bot:
Index: cl-xmpp/cl-xmpp-sasl.lisp
diff -u cl-xmpp/cl-xmpp-sasl.lisp:1.5 cl-xmpp/cl-xmpp-sasl.lisp:1.6
--- cl-xmpp/cl-xmpp-sasl.lisp:1.5 Sat Nov 12 03:37:29 2005
+++ cl-xmpp/cl-xmpp-sasl.lisp Sat Nov 12 05:20:21 2005
@@ -1,4 +1,4 @@
-;;;; $Id: cl-xmpp-sasl.lisp,v 1.5 2005/11/12 02:37:29 eenge Exp $
+;;;; $Id: cl-xmpp-sasl.lisp,v 1.6 2005/11/12 04:20:21 eenge Exp $
;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp-sasl.lisp,v $
;;;; See the LICENSE file for licensing information.
@@ -21,39 +21,43 @@
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)
- (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"
- :realm (hostname connection)
- :host (hostname connection)))
- (response (sasl:client-step sasl-client (ironclad:ascii-string-to-byte-array 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)
- (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)
- (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))))
+ (let ((sasl-client (make-instance (sasl:get-mechanism mechanism)
+ :authentication-id username
+ :password password
+ :service "xmpp"
+ :host (hostname connection))))
+ (initiate-sasl-authentication connection mechanism sasl-client)
+ (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))))
+ (usb8-response (sasl:client-step
+ sasl-client
+ (ironclad:ascii-string-to-byte-array challenge-string))))
+ (format *debug-stream* "~&challenge-string: ~a~%" challenge-string)
+ (if (eq usb8-response :failure)
+ (values :failure initial-challenge)
+ (let ((base64-response (base64:usb8-array-to-base64-string usb8-response)))
+ (format *debug-stream* "response: ~a~%" (map 'string #'code-char usb8-response))
+ (force-output *debug-stream*)
+ (send-challenge-response connection base64-response)
+ (let ((second-challenge (receive-stanza connection)))
+ (if (eq (name second-challenge) :challenge)
+ (progn
+ (send-second-response connection)
+ (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)
+(defmethod initiate-sasl-authentication ((connection connection) mechanism sasl-client)
(with-xml-stream (stream connection)
(xml-output stream (fmt "<auth mechanism='~a'
-xmlns='urn:ietf:params:xml:ns:xmpp-sasl'/>" mechanism))))
+xmlns='urn:ietf:params:xml:ns:xmpp-sasl'>~a</auth>"
+ mechanism
+ (base64:usb8-array-to-base64-string
+ (sasl:client-step sasl-client nil))))))
(defmethod send-challenge-response ((connection connection) response)
(with-xml-stream (stream connection)
Index: cl-xmpp/cl-xmpp-tls.lisp
diff -u cl-xmpp/cl-xmpp-tls.lisp:1.1 cl-xmpp/cl-xmpp-tls.lisp:1.2
--- cl-xmpp/cl-xmpp-tls.lisp:1.1 Fri Nov 11 18:21:56 2005
+++ cl-xmpp/cl-xmpp-tls.lisp Sat Nov 12 05:20:21 2005
@@ -1,39 +1,25 @@
-;;;; $Id: cl-xmpp-tls.lisp,v 1.1 2005/11/11 17:21:56 eenge Exp $
+;;;; $Id: cl-xmpp-tls.lisp,v 1.2 2005/11/12 04:20:21 eenge Exp $
;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp-tls.lisp,v $
;;;; See the LICENSE file for licensing information.
(in-package :xmpp)
-(defmethod send-starttls ((connection connection))
- "Sends a request to start a TLS stream with the server.
-There are some things you as a user of this library need
-to know about this:
-
- 1) You should test for the presence of a starttls element
- in the features slot of the connection and only call this
- method if it is present.
-
- 2) Following your call to this method you should look for
- either a proceed or a failure from the server.
-
- a) If you get a proceed you may call begin-tls-stream and
- your connection is now secure (though read step 3).
+(defun connect-tls (&rest args)
+ "Connect to the host and start a TLS stream."
+ (let ((connection (apply #'connect args)))
+ (send-starttls connection)
+ (begin-tls-stream connection)
+ connection))
- b) If you get a failure your connection is automatically
- torn down by the server and you lose.
-
- 3) After begin-tls-stream you must proceed with sasl-auth
- instead of the regular auth."
+(defmethod send-starttls ((connection connection))
+ "Sends a request to start a TLS stream with the server."
(with-xml-stream (stream connection)
(xml-output stream "<starttls xmlns='urn:ietf:params:xml:ns:xmpp-tls'/>")))
-(defmethod begin-tls-stream ((connection connection))
+(defmethod convert-to-tls-stream ((connection connection))
"Convert the existing stream to a TLS stream and issue
a stream:stream open tag to start the XML stream."
(setf (server-stream connection)
(cl+ssl:make-ssl-client-stream (server-stream connection)))
(begin-xml-stream connection))
-
-(defmethod sasl-auth ((connection) username password resource)
- nil)
\ No newline at end of file
Index: cl-xmpp/cl-xmpp.lisp
diff -u cl-xmpp/cl-xmpp.lisp:1.12 cl-xmpp/cl-xmpp.lisp:1.13
--- cl-xmpp/cl-xmpp.lisp:1.12 Sat Nov 12 03:37:29 2005
+++ cl-xmpp/cl-xmpp.lisp Sat Nov 12 05:20:21 2005
@@ -1,4 +1,4 @@
-;;;; $Id: cl-xmpp.lisp,v 1.12 2005/11/12 02:37:29 eenge Exp $
+;;;; $Id: cl-xmpp.lisp,v 1.13 2005/11/12 04:20:21 eenge Exp $
;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp,v $
;;;; See the LICENSE file for licensing information.
@@ -33,6 +33,10 @@
:documentation "List of xml-element objects representing
the various mechainsms the host at the other end of the connection
will accept.")
+ (jid-domain-part
+ :accessor jid-domain-part
+ :initarg :jid-domain-part
+ :initform nil)
(username
:accessor username
:initarg :username)
@@ -58,15 +62,36 @@
(format stream " (open)")
(format stream " (closed)"))))
-(defun connect (&key (hostname *default-hostname*) (port *default-port*))
- "Open TCP connection to hostname."
+(defun connect (&key (hostname *default-hostname*) (port *default-port*)
+ (receive-stanzas t) (begin-xml-stream t) jid-domain-part)
+ "Open TCP connection to hostname.
+
+By default this will set up the complete XML stream and receive the initial
+two stanzas (which would typically be stream:stream and stream:features)
+to make sure the connection object is fully loaded with the features,
+mechanisms and stream-id. If this is causing a problem for you just
+specify :receive-stanzas nil.
+
+Using the same idea, you can disable the calling to begin-xml-stream.
+
+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 plus if you are going to
+do in-band registration (JEP0077) then you don't have a JID until
+after you've connected."
(let* ((stream (trivial-sockets:open-stream
hostname port :element-type '(unsigned-byte 8)))
(connection (make-instance 'connection
+ :jid-domain-part jid-domain-part
:server-stream stream
:hostname hostname
:port port)))
- (begin-xml-stream connection)
+ (when begin-xml-stream
+ (begin-xml-stream connection))
+ (when receive-stanzas
+ (receive-stanza connection)
+ (receive-stanza connection))
connection))
(defmethod connectedp ((connection connection))
@@ -120,6 +145,7 @@
(defmethod handle ((connection connection) object)
(format *debug-stream* "~&UNHANDLED: ~a~%" object)
+ (force-output *debug-stream*)
object)
;;
@@ -294,26 +320,22 @@
(write-sequence sequence stream)
(finish-output stream)
(when *debug-stream*
- (write-string string *debug-stream*))))
+ (write-string string *debug-stream*)
+ (force-output *debug-stream*))))
;;
;; Operators for communicating over the XML stream
;;
-(defmethod begin-xml-stream ((connection connection) &optional jid-domain-part)
+(defmethod begin-xml-stream ((connection connection))
"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."
+newly connected connection."
(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'>" (or jid-domain-part (hostname connection))))))
+version='1.0'>" (or (jid-domain-part connection) (hostname connection))))))
(defmethod end-xml-stream ((connection connection))
"Closes the XML stream. At this point you'd have to
Index: cl-xmpp/cxml.lisp
diff -u cl-xmpp/cxml.lisp:1.4 cl-xmpp/cxml.lisp:1.5
--- cl-xmpp/cxml.lisp:1.4 Fri Nov 11 18:21:56 2005
+++ cl-xmpp/cxml.lisp Sat Nov 12 05:20:21 2005
@@ -88,7 +88,8 @@
(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*)))
+ (write-char (code-char octet) *debug-stream*)
+ (force-output *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
Index: cl-xmpp/package.lisp
diff -u cl-xmpp/package.lisp:1.7 cl-xmpp/package.lisp:1.8
--- cl-xmpp/package.lisp:1.7 Fri Nov 11 22:20:20 2005
+++ cl-xmpp/package.lisp Sat Nov 12 05:20:21 2005
@@ -1,4 +1,4 @@
-;;;; $Id: package.lisp,v 1.7 2005/11/11 21:20:20 eenge Exp $
+;;;; $Id: package.lisp,v 1.8 2005/11/12 04:20:21 eenge Exp $
;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/package.lisp,v $
;;;; See the LICENSE file for licensing information.
@@ -17,6 +17,8 @@
: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
+ ;; only available if you've loaded cl-xmpp-tls
+ :connect-tls
;; xmpp commands
:discover
:registration-requirements :register
More information about the Cl-xmpp-cvs
mailing list