cl-xmpp-cvs

cl-xmpp-cvs@common-lisp.net

104 discussions

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

13 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv28518 Modified Files: Makefile Log Message: more tests Date: Sun Nov 13 03:45:41 2005 Author: eenge Index: cl-xmpp/Makefile diff -u cl-xmpp/Makefile:1.3 cl-xmpp/Makefile:1.4 --- cl-xmpp/Makefile:1.3 Sun Nov 13 03:36:09 2005 +++ cl-xmpp/Makefile Sun Nov 13 03:45:41 2005 @@ -1,4 +1,8 @@ clean: - find ./ -name *.fasl -exec rm \{\} \; - find ./ -name *.nfasl -exec rm \{\} \; - find ./ -name *~ -exec rm \{\} \; + find ./ -name "*.fasl" \ + -o -name "*.faslmt" \ + -o -name "*~" \ + -o -name "*.err" \ + -o -name "*.x86f" \ + -o -name "*.nfasl" \ + | xargs rm

1 0

[cl-xmpp-cvs] CVS update: cl-xmpp/test/cl-xmpp-test.asd cl-xmpp/test/package.lisp cl-xmpp/test/result-test.lisp cl-xmpp/test/utility-test.lisp
by eenge＠common-lisp.net 13 Nov '05

13 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp/test In directory common-lisp.net:/tmp/cvs-serv27919/test Added Files: cl-xmpp-test.asd package.lisp result-test.lisp utility-test.lisp Log Message: beginnings of test suite cleaned up .asd's a little Date: Sun Nov 13 03:36:11 2005 Author: eenge

1 0

[cl-xmpp-cvs] CVS update: cl-xmpp/Makefile cl-xmpp/cl-xmpp-sasl.asd cl-xmpp/cl-xmpp-tls.asd cl-xmpp/cl-xmpp.asd cl-xmpp/package.lisp
by eenge＠common-lisp.net 13 Nov '05

13 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv27919 Modified Files: Makefile cl-xmpp-sasl.asd cl-xmpp-tls.asd cl-xmpp.asd package.lisp Log Message: beginnings of test suite cleaned up .asd's a little Date: Sun Nov 13 03:36:10 2005 Author: eenge Index: cl-xmpp/Makefile diff -u cl-xmpp/Makefile:1.2 cl-xmpp/Makefile:1.3 --- cl-xmpp/Makefile:1.2 Sat Oct 29 19:25:04 2005 +++ cl-xmpp/Makefile Sun Nov 13 03:36:09 2005 @@ -1,2 +1,4 @@ clean: - rm *~ *.fasl *.nfasl + find ./ -name *.fasl -exec rm \{\} \; + find ./ -name *.nfasl -exec rm \{\} \; + find ./ -name *~ -exec rm \{\} \; Index: cl-xmpp/cl-xmpp-sasl.asd diff -u cl-xmpp/cl-xmpp-sasl.asd:1.2 cl-xmpp/cl-xmpp-sasl.asd:1.3 --- cl-xmpp/cl-xmpp-sasl.asd:1.2 Fri Nov 11 22:20:20 2005 +++ cl-xmpp/cl-xmpp-sasl.asd Sun Nov 13 03:36:10 2005 @@ -1,5 +1,5 @@ ;;;; -*- mode: lisp -*- -;;;; $Id: cl-xmpp-sasl.asd,v 1.2 2005/11/11 21:20:20 eenge Exp $ +;;;; $Id: cl-xmpp-sasl.asd,v 1.3 2005/11/13 02:36:10 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp-sasl.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -14,21 +14,8 @@ (defsystem cl-xmpp-sasl :name "cl-xmpp-sasl" :author "Erik Enge" - :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 :cl-base64) - :components ((:file "package") - (:file "variable" - :depends-on ("package")) - (:file "utility" - :depends-on ("variable")) - (:file "cxml" - :depends-on ("utility")) - (:file "result" - :depends-on ("cxml")) - (:file "cl-xmpp" - :depends-on ("result")) - (:file "cl-xmpp-sasl" - :depends-on ("cl-xmpp")))) + :depends-on (:cl-xmpp :cl-base64 :sasl) + :components ((:file "cl-xmpp-sasl"))) Index: cl-xmpp/cl-xmpp-tls.asd diff -u cl-xmpp/cl-xmpp-tls.asd:1.2 cl-xmpp/cl-xmpp-tls.asd:1.3 --- cl-xmpp/cl-xmpp-tls.asd:1.2 Fri Nov 11 22:20:20 2005 +++ cl-xmpp/cl-xmpp-tls.asd Sun Nov 13 03:36:10 2005 @@ -1,5 +1,5 @@ ;;;; -*- mode: lisp -*- -;;;; $Id: cl-xmpp-tls.asd,v 1.2 2005/11/11 21:20:20 eenge Exp $ +;;;; $Id: cl-xmpp-tls.asd,v 1.3 2005/11/13 02:36:10 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp-tls.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -14,24 +14,8 @@ (defsystem cl-xmpp-tls :name "cl-xmpp-tls" :author "Erik Enge" - :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 :cl-base64) - :components ((:file "package") - (:file "variable" - :depends-on ("package")) - (:file "utility" - :depends-on ("variable")) - (:file "cxml" - :depends-on ("utility")) - (:file "result" - :depends-on ("cxml")) - (:file "cl-xmpp" - :depends-on ("result")) - (:file "cl-xmpp-sasl" - :depends-on ("cl-xmpp")) - (:file "cl-xmpp-tls" - :depends-on ("cl-xmpp-sasl")))) + :depends-on (:cl-xmpp-sasl :cl+ssl) + :components ((:file "cl-xmpp-sasl"))) Index: cl-xmpp/cl-xmpp.asd diff -u cl-xmpp/cl-xmpp.asd:1.5 cl-xmpp/cl-xmpp.asd:1.6 --- cl-xmpp/cl-xmpp.asd:1.5 Fri Nov 11 18:21:56 2005 +++ cl-xmpp/cl-xmpp.asd Sun Nov 13 03:36:10 2005 @@ -1,5 +1,5 @@ ;;;; -*- mode: lisp -*- -;;;; $Id: cl-xmpp.asd,v 1.5 2005/11/11 17:21:56 eenge Exp $ +;;;; $Id: cl-xmpp.asd,v 1.6 2005/11/13 02:36:10 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.asd,v $ ;;;; See the LICENSE file for licensing information. @@ -14,7 +14,6 @@ (defsystem cl-xmpp :name "cl-xmpp" :author "Erik Enge" - :version "0.0.1" :licence "MIT" :description "Common Lisp XMPP client implementation" :depends-on (#+sbcl :sb-bsd-sockets :trivial-sockets :cxml :ironclad) Index: cl-xmpp/package.lisp diff -u cl-xmpp/package.lisp:1.8 cl-xmpp/package.lisp:1.9 --- cl-xmpp/package.lisp:1.8 Sat Nov 12 05:20:21 2005 +++ cl-xmpp/package.lisp Sun Nov 13 03:36:10 2005 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.8 2005/11/12 04:20:21 eenge Exp $ +;;;; $Id: package.lisp,v 1.9 2005/11/13 02:36:10 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -33,7 +33,7 @@ :get-privacy-lists :get-privacy-list ;; dom-ish interface :xml-element :name :elements :attributes :node :data - :xml-attribute :value + :xml-attribute :value :get-element :get-attribute ;; event interface :event :presence

1 0

[cl-xmpp-cvs] CVS update: Directory change: cl-xmpp/test
by eenge＠common-lisp.net 13 Nov '05

13 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp/test In directory common-lisp.net:/tmp/cvs-serv25800/test Log Message: Directory /project/cl-xmpp/cvsroot/cl-xmpp/test added to the repository Date: Sun Nov 13 03:08:13 2005 Author: eenge New directory cl-xmpp/test added

1 0

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

12 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv2934 Modified Files: TODO Log Message: comment about testing Date: Sat Nov 12 21:53:17 2005 Author: eenge Index: cl-xmpp/TODO diff -u cl-xmpp/TODO:1.7 cl-xmpp/TODO:1.8 --- cl-xmpp/TODO:1.7 Fri Nov 11 22:20:20 2005 +++ cl-xmpp/TODO Sat Nov 12 21:53:17 2005 @@ -1,8 +1,10 @@ - respect stringprep/nodeprep - jid validator -- sasl/tls - - 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 +- i hate that xmlns's are as strings and never validated + +- create a connect-test which makes a "fake" connection but + still writes into a stream. prerequisite for writing a test + suite (which i should do).

1 0

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

12 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv28229 Modified Files: cl-xmpp-tls.lisp Log Message: begin-tls-stream -> convert-to-tls-stream Date: Sat Nov 12 05:30:57 2005 Author: eenge Index: cl-xmpp/cl-xmpp-tls.lisp diff -u cl-xmpp/cl-xmpp-tls.lisp:1.2 cl-xmpp/cl-xmpp-tls.lisp:1.3 --- cl-xmpp/cl-xmpp-tls.lisp:1.2 Sat Nov 12 05:20:21 2005 +++ cl-xmpp/cl-xmpp-tls.lisp Sat Nov 12 05:30:57 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cl-xmpp-tls.lisp,v 1.2 2005/11/12 04:20:21 eenge Exp $ +;;;; $Id: cl-xmpp-tls.lisp,v 1.3 2005/11/12 04:30:57 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp-tls.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -9,7 +9,7 @@ "Connect to the host and start a TLS stream." (let ((connection (apply #'connect args))) (send-starttls connection) - (begin-tls-stream connection) + (convert-to-tls-stream connection) connection)) (defmethod send-starttls ((connection connection))

1 0

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

12 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv27623 Modified Files: README Log Message: note about connect-tls Date: Sat Nov 12 05:22:03 2005 Author: eenge Index: cl-xmpp/README diff -u cl-xmpp/README:1.6 cl-xmpp/README:1.7 --- cl-xmpp/README:1.6 Sat Nov 12 05:20:21 2005 +++ cl-xmpp/README Sat Nov 12 05:22:03 2005 @@ -6,6 +6,10 @@ * (require :cl-xmpp) * (defvar connection (xmpp:connect "username" :hostname "jabber.org")) +;; or use xmpp:connect-tls with the exact same arguments to initiate +;; a TLS connection. there are operators in cl-xmpp-tls.lisp you +;; can use manually if you want to check that this host supports +;; TLS connections, first. ;; authenticate (or use xmpp:register to make an account) * (xmpp:auth connection "password" "resource")

1 0

[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
by eenge＠common-lisp.net 12 Nov '05

12 Nov '05

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@hostname to=me@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

1 0

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

12 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv19607 Modified Files: cl-xmpp-sasl.lisp cl-xmpp.lisp Log Message: making handle write to *debug-stream* and now using cl-sasl 0.2 so passing it a byte-array, not a string of characters Date: Sat Nov 12 03:37:29 2005 Author: eenge Index: cl-xmpp/cl-xmpp-sasl.lisp diff -u cl-xmpp/cl-xmpp-sasl.lisp:1.4 cl-xmpp/cl-xmpp-sasl.lisp:1.5 --- cl-xmpp/cl-xmpp-sasl.lisp:1.4 Sat Nov 12 03:29:51 2005 +++ cl-xmpp/cl-xmpp-sasl.lisp Sat Nov 12 03:37:29 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cl-xmpp-sasl.lisp,v 1.4 2005/11/12 02:29:51 eenge Exp $ +;;;; $Id: cl-xmpp-sasl.lisp,v 1.5 2005/11/12 02:37:29 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp-sasl.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -32,7 +32,7 @@ :service "xmpp" :realm (hostname connection) :host (hostname connection))) - (response (sasl:client-step sasl-client challenge-string)) + (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) Index: cl-xmpp/cl-xmpp.lisp diff -u cl-xmpp/cl-xmpp.lisp:1.11 cl-xmpp/cl-xmpp.lisp:1.12 --- cl-xmpp/cl-xmpp.lisp:1.11 Sat Nov 12 03:29:51 2005 +++ cl-xmpp/cl-xmpp.lisp Sat Nov 12 03:37:29 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cl-xmpp.lisp,v 1.11 2005/11/12 02:29:51 eenge Exp $ +;;;; $Id: cl-xmpp.lisp,v 1.12 2005/11/12 02:37:29 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -119,7 +119,7 @@ (map 'list #'(lambda (x) (handle connection x)) list)) (defmethod handle ((connection connection) object) - (format t "~&UNHANDLED: ~a~%" object) + (format *debug-stream* "~&UNHANDLED: ~a~%" object) object) ;; @@ -389,7 +389,7 @@ (cxml:with-element "username" (cxml:text username)))) (defmethod auth ((connection connection) username password - resource &key (mechanism :plain)) + resource &optional (mechanism :plain)) (setf (username connection) username) (funcall (get-auth-method mechanism) connection username password resource))

1 0

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

12 Nov '05

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

1 0

← Newer
1
...
4
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