November 2005 - cl-xmpp-cvs@common-lisp.net

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

18 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv32567 Modified Files: README Log Message: 0.7.0 Date: Fri Nov 18 23:35:50 2005 Author: eenge Index: cl-xmpp/README diff -u cl-xmpp/README:1.9 cl-xmpp/README:1.10 --- cl-xmpp/README:1.9 Fri Nov 18 23:01:08 2005 +++ cl-xmpp/README Fri Nov 18 23:35:50 2005 @@ -6,10 +6,17 @@ * (require :cl-xmpp) * (defvar *connection* (xmpp:connect :hostname "jabber.org")) +;; or xmpp:connect-tls if you loaded cl-xmpp-tls + +;; note that for XMPP servers which do not have the same hostname +;; as the domain-part of the user's JID you will have to pass that +;; in. eg for Google Talk: +;; (defvar *connection* (xmpp:connect-tls :hostname "talk.google.com" + :jid-domain-part "gmail.com")) * (xmpp:auth connection "password" "resource") ;; or pass :mechanism :sasl-plain, :digest-md5 or sasl-digest-md5 -;; if you loaded cl-xmpp-sasl. +;; if you loaded cl-xmpp-sasl or cl-xmpp-tls. ;; send someone a message * (xmpp:message connection "username@hostname" "what's going on?")

1 0

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

18 Nov '05

Update of /project/cl-xmpp/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv32549 Modified Files: index.html Log Message: 0.7.0 Date: Fri Nov 18 23:35:26 2005 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.23 public_html/index.html:1.24 --- public_html/index.html:1.23 Fri Nov 18 23:32:35 2005 +++ public_html/index.html Fri Nov 18 23:35:26 2005 @@ -50,8 +50,9 @@ <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> - <li><a href="http://cliki.net/cl-base64">cl-base64</a> (for cl-xmpp-sasl)</li> - <li><a href="http://cliki.net/cl-sasl">cl-sasl</a> (for cl-xmpp-sasl)</li> + <li><a href="http://cliki.net/cl-base64">cl-base64</a> (for cl-xmpp-{sasl,tls})</li> + <li><a href="http://cliki.net/cl-sasl">cl-sasl</a> (for cl-xmpp-{sasl,tls})</li> + <li><a href="http://common-lisp.net/project/cl-plus-ssl">cl+ssl</a> (for cl-xmpp-tls)</li> </ul> </div> @@ -109,10 +110,17 @@ * (require :cl-xmpp) * (defvar *connection* (xmpp:connect :hostname "jabber.org")) +;; or xmpp:connect-tls if you loaded cl-xmpp-tls + +;; note that for XMPP servers which do not have the same hostname +;; as the domain-part of the user's JID you will have to pass that +;; in. eg for Google Talk: +;; (defvar *connection* (xmpp:connect-tls :hostname "talk.google.com" + :jid-domain-part "gmail.com")) * (xmpp:auth connection "password" "resource") ;; or pass :mechanism :sasl-plain, :digest-md5 or sasl-digest-md5 -;; if you loaded cl-xmpp-sasl. +;; if you loaded cl-xmpp-sasl or cl-xmpp-tls. ;; send someone a message * (xmpp:message connection "username@hostname" "what's going on?")

1 0

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

18 Nov '05

Update of /project/cl-xmpp/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv32519 Modified Files: index.html Log Message: 0.7.0 Date: Fri Nov 18 23:32:35 2005 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.22 public_html/index.html:1.23 --- public_html/index.html:1.22 Fri Nov 18 23:10:02 2005 +++ public_html/index.html Fri Nov 18 23:32:35 2005 @@ -7,7 +7,7 @@ <body> <div class="header"> - <h1>cl-xmpp 0.6.0</h1> + <h1>cl-xmpp 0.7.0</h1> </div> <div class="body"> @@ -30,6 +30,19 @@ href="http://common-lisp.net/cgi-bin/viewcvs.cgi/cl-xmpp/LICENSE?rev=HEAD&cvsroot…">MIT-style license</a>. </p> + <h2>News</h2> + <div class="level"> + <ul> + <li>Version 0.7.0 released (TLS support)</li> + <li>Version 0.6.0 released (SASL support, tiny test suite and many small fixes and tweaks)</li> + <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> + <li>Version 0.1.0 released (Initial release)</li> + </ul> + </div> + <h2>Requirements</h2> <div class="level"> <ul> @@ -42,15 +55,12 @@ </ul> </div> - <h2>News</h2> + <h2>Tested against</h2> <div class="level"> <ul> - <li>Version 0.6.0 released (SASL support, tiny test suite and many small fixes and tweaks)</li> - <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> - <li>Version 0.1.0 released (Initial release)</li> + <li><a href="http://talk.google.com/">Google Talk</a></li> + <li><a href="http://jabberd.jabberstudio.com/">Jabberd 1.4</a> (ie not 2)</li> + <li><a href="http://ejabberd.jabber.ru/">ejabberd</a></li> </ul> </div>

1 0

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

18 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv31460 Modified Files: cl-xmpp.lisp utility.lisp Log Message: tls now works (thanks david lichteblau!) Date: Fri Nov 18 23:29:28 2005 Author: eenge Index: cl-xmpp/cl-xmpp.lisp diff -u cl-xmpp/cl-xmpp.lisp:1.20 cl-xmpp/cl-xmpp.lisp:1.21 --- cl-xmpp/cl-xmpp.lisp:1.20 Fri Nov 18 22:43:52 2005 +++ cl-xmpp/cl-xmpp.lisp Fri Nov 18 23:29:27 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cl-xmpp.lisp,v 1.20 2005/11/18 21:43:52 eenge Exp $ +;;;; $Id: cl-xmpp.lisp,v 1.21 2005/11/18 22:29:27 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -355,17 +355,22 @@ (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 (gensym "stream")) + (xml (gensym "xml"))) `(let ((,stream (server-stream ,connection))) (prog1 - (cxml:with-xml-output (make-octet+character-debug-stream-sink ,stream) - (cxml:with-element "iq" - (when ,id - (cxml:attribute "id" ,id)) - (when ,to - (cxml:attribute "to" ,to)) - (cxml:attribute "type" ,type) - ,@body)) +; (cxml:with-xml-output (make-octet+character-debug-stream-sink ,stream) + (let ((,xml (cxml:with-xml-output (cxml:make-octet-vector-sink) + (cxml:with-element "iq" + (when ,id + (cxml:attribute "id" ,id)) + (when ,to + (cxml:attribute "to" ,to)) + (cxml:attribute "type" ,type) + ,@body)))) + (write-sequence (vector-to-array ,xml) ,stream) + (when *debug-stream* + (write-sequence (map 'string #'code-char ,xml) *debug-stream*))) (force-output ,stream))))) (defmacro with-iq-query ((connection &key xmlns id to node (type "get")) &body body) Index: cl-xmpp/utility.lisp diff -u cl-xmpp/utility.lisp:1.10 cl-xmpp/utility.lisp:1.11 --- cl-xmpp/utility.lisp:1.10 Mon Nov 14 21:07:36 2005 +++ cl-xmpp/utility.lisp Fri Nov 18 23:29:27 2005 @@ -1,4 +1,4 @@ -;;;; $Id: utility.lisp,v 1.10 2005/11/14 20:07:36 eenge Exp $ +;;;; $Id: utility.lisp,v 1.11 2005/11/18 22:29:27 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/utility.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -52,4 +52,10 @@ (intern correct-case-thing :keyword))) ((typep thing 'array) (ensure-keyword (map 'string #'code-char thing))) ((eq thing nil) nil) - (t (error "Don't know how to make keyword out of: ~a (type: ~a)" thing (type-of thing))))) \ No newline at end of file + (t (error "Don't know how to make keyword out of: ~a (type: ~a)" thing (type-of thing))))) + +(defun vector-to-array (vector) + (let ((array (make-array (length vector) :element-type '(unsigned-byte 8)))) + (dotimes (position (length vector)) + (setf (aref array position) (aref vector position))) + array)) \ No newline at end of file

1 0

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

18 Nov '05

Update of /project/cl-xmpp/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv30271 Modified Files: index.html Log Message: fixed a missing paren Date: Fri Nov 18 23:10:03 2005 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.21 public_html/index.html:1.22 --- public_html/index.html:1.21 Fri Nov 18 23:03:23 2005 +++ public_html/index.html Fri Nov 18 23:10:02 2005 @@ -89,7 +89,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> (<a href="http://common-lisp.net/pipermail/cl-xmpp-devel/">archives</a>.</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: public_html/index.html
by eenge＠common-lisp.net 18 Nov '05

18 Nov '05

Update of /project/cl-xmpp/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv30172 Modified Files: index.html Log Message: *** empty log message *** Date: Fri Nov 18 23:03:24 2005 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.20 public_html/index.html:1.21 --- public_html/index.html:1.20 Fri Nov 18 23:00:44 2005 +++ public_html/index.html Fri Nov 18 23:03:23 2005 @@ -37,8 +37,8 @@ <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> - <li><a href="http://cliki.net/cl-base64">cl-base64</a> (if you are using cl-xmpp-sasl)</li> - <li><a href="http://cliki.net/cl-sasl">cl-sasl</a> (if you loaded cl-xmpp-sasl)</li> + <li><a href="http://cliki.net/cl-base64">cl-base64</a> (for cl-xmpp-sasl)</li> + <li><a href="http://cliki.net/cl-sasl">cl-sasl</a> (for cl-xmpp-sasl)</li> </ul> </div>

1 0

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

18 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv29817 Modified Files: README Log Message: Date: Fri Nov 18 23:01:09 2005 Author: eenge Index: cl-xmpp/README diff -u cl-xmpp/README:1.8 cl-xmpp/README:1.9 --- cl-xmpp/README:1.8 Sun Nov 13 03:55:46 2005 +++ cl-xmpp/README Fri Nov 18 23:01:08 2005 @@ -5,19 +5,11 @@ * (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. + * (defvar *connection* (xmpp:connect :hostname "jabber.org")) -;; 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) - * (xmpp:presence connection) +;; or pass :mechanism :sasl-plain, :digest-md5 or sasl-digest-md5 +;; if you loaded cl-xmpp-sasl. ;; send someone a message * (xmpp:message connection "username@hostname" "what's going on?")

1 0

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

18 Nov '05

Update of /project/cl-xmpp/cvsroot/public_html In directory common-lisp.net:/tmp/cvs-serv29648 Modified Files: index.html Log Message: preparing for 0.6.0 Date: Fri Nov 18 23:00:44 2005 Author: eenge Index: public_html/index.html diff -u public_html/index.html:1.19 public_html/index.html:1.20 --- public_html/index.html:1.19 Sun Nov 13 03:55:15 2005 +++ public_html/index.html Fri Nov 18 23:00:44 2005 @@ -17,15 +17,18 @@ servers use to communicate with eachother (including <a href="http://talk.google.com/">Google Talk</a>). In addition cl-xmpp implements JEPs 0078, 0086, 0030 and 0070 which are -all part of <a href="http://www.jabber.org/jeps/jep-0073.html">JEP-0073: Basic IM Protocol Suite</a>. The author considers the library feature complete but will happily accept patches for any other reasonably stable JEPs.</p> +all part of <a href="http://www.jabber.org/jeps/jep-0073.html">JEP-0073: +Basic IM Protocol Suite</a>. The author considers the library +feature complete but will happily accept patches for any other +reasonably stable JEPs.</p> <p>Currently, you can chat, manage your contacts, roster and presence information using this library. You can now also use the service discovery protocol using the <code>xmpp:discover</code> operator.</p> <p>The code is released under an <a - href="http://common-lisp.net/cgi-bin/viewcvs.cgi/cl-xmpp/LICENSE?rev=HEAD&cvsroot…">MIT-style - license</a>. </p> + href="http://common-lisp.net/cgi-bin/viewcvs.cgi/cl-xmpp/LICENSE?rev=HEAD&cvsroot…">MIT-style license</a>. + </p> <h2>Requirements</h2> <div class="level"> @@ -34,16 +37,15 @@ <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> - <li><a href="http://cliki.net/cl-base64">cl-base64</a> (if you are using cl-xmpp-{sasl|tls}.asd)</li> - <li><a href="http://cliki.net/cl-sasl">cl-sasl</a> (if you are using cl-xmpp-{sasl|tls}.asd)</li> - <li><a href="http://common-lisp.net/project/cl-plus-ssl">cl+ssl</a> (if you are using cl-xmpp-tls.asd</li> + <li><a href="http://cliki.net/cl-base64">cl-base64</a> (if you are using cl-xmpp-sasl)</li> + <li><a href="http://cliki.net/cl-sasl">cl-sasl</a> (if you loaded cl-xmpp-sasl)</li> </ul> </div> <h2>News</h2> <div class="level"> <ul> - <li>Version 0.6.0 released (SASL and TLS support, better debugability + small test suite) + <li>Version 0.6.0 released (SASL support, tiny test suite and many small fixes and tweaks)</li> <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> @@ -96,19 +98,11 @@ <pre> * (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. + * (defvar *connection* (xmpp:connect :hostname "jabber.org")) -;; 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) - * (xmpp:presence connection) +;; or pass :mechanism :sasl-plain, :digest-md5 or sasl-digest-md5 +;; if you loaded cl-xmpp-sasl. ;; send someone a message * (xmpp:message connection "username@hostname" "what's going on?") @@ -138,7 +132,8 @@ * (defmethod xmpp:handle ((connection xmpp:connection) (message xmpp:message)) (xmpp:message connection (xmpp:from message) (format nil "reply to: ~a" (xmpp:message object)))) - </pre> + + </pre> </div>

1 0

[cl-xmpp-cvs] CVS update: cl-xmpp/LICENSE cl-xmpp/TODO cl-xmpp/cl-xmpp.lisp cl-xmpp/cxml.lisp cl-xmpp/package.lisp cl-xmpp/variable.lisp
by eenge＠common-lisp.net 18 Nov '05

18 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv27903 Modified Files: LICENSE TODO cl-xmpp.lisp cxml.lisp package.lisp variable.lisp Log Message: Date: Fri Nov 18 22:43:52 2005 Author: eenge Index: cl-xmpp/LICENSE diff -u cl-xmpp/LICENSE:1.1.1.1 cl-xmpp/LICENSE:1.2 --- cl-xmpp/LICENSE:1.1.1.1 Fri Oct 28 15:16:02 2005 +++ cl-xmpp/LICENSE Fri Nov 18 22:43:51 2005 @@ -1,23 +1,23 @@ Copyright (c) 2005 Erik Enge -Redistribution and use in source and binary forms, with or without -modification, are permitted provided that the following conditions -are met: +Permission is hereby granted, free of charge, to any person obtaining +a copy of this software and associated documentation files (the +"Software"), to deal in the Software without restriction, including +without limitation the rights to use, copy, modify, merge, publish, +distribute, sublicense, and/or sell copies of the Software, and to +permit persons to whom the Software is furnished to do so, subject to +the following conditions: -1. Redistributions of source code must retain the above copyright - notice, this list of conditions and the following disclaimer. +The above copyright notice and this permission notice shall be +included in all copies or substantial portions of the Software. -2. Redistributions in binary form must reproduce the above copyright - notice, this list of conditions and the following disclaimer in the - documentation and/or other materials provided with the distribution. - -THIS SOFTWARE IS PROVIDED "AS IS" AND THERE ARE NEITHER EXPRESSED NOR -IMPLIED WARRANTIES - THIS INCLUDES, BUT IS NOT LIMITED TO, THE IMPLIED -WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE.IN -NO WAY ARE THE AUTHORS LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -SPECIAL, EXEMPLARY OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT -LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES ; LOSS OF USE, -DATA, OR PROFITS ; OR BUSINESS INTERRUPTION) +THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, +EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF +MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND +NONINFRINGEMENT. IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE +LIABLE FOR ANY CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION +OF CONTRACT, TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION +WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE. For further details contact the author of this software. Index: cl-xmpp/TODO diff -u cl-xmpp/TODO:1.10 cl-xmpp/TODO:1.11 --- cl-xmpp/TODO:1.10 Thu Nov 17 20:41:40 2005 +++ cl-xmpp/TODO Fri Nov 18 22:43:52 2005 @@ -7,3 +7,6 @@ - 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). + +- havent found a good use for IDs yet so right now they are + just what happen to be in the specs \ No newline at end of file Index: cl-xmpp/cl-xmpp.lisp diff -u cl-xmpp/cl-xmpp.lisp:1.19 cl-xmpp/cl-xmpp.lisp:1.20 --- cl-xmpp/cl-xmpp.lisp:1.19 Thu Nov 17 22:51:15 2005 +++ cl-xmpp/cl-xmpp.lisp Fri Nov 18 22:43:52 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cl-xmpp.lisp,v 1.19 2005/11/17 21:51:15 eenge Exp $ +;;;; $Id: cl-xmpp.lisp,v 1.20 2005/11/18 21:43:52 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -202,6 +202,7 @@ (:change1 :password-changed-succesfully) (:auth2 :authentication-successful) (:bind_2 :bind-successful) + (:session_1 :session-initiated) (t (cond ((member id '(info1 info2 info3)) (make-disco-info (get-element object :query))) @@ -328,7 +329,7 @@ "Write string to stream as a sequence of bytes and not characters." (let ((sequence (ironclad:ascii-string-to-byte-array string))) (write-sequence sequence stream) - (finish-output stream) + (force-output stream) (when *debug-stream* (write-string string *debug-stream*) (force-output *debug-stream*)))) @@ -356,26 +357,25 @@ "Macro to make it easier to write IQ stanzas." (let ((stream (gensym))) `(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)) - (force-output ,stream) - ,connection))) + (prog1 + (cxml:with-xml-output (make-octet+character-debug-stream-sink ,stream) + (cxml:with-element "iq" + (when ,id + (cxml:attribute "id" ,id)) + (when ,to + (cxml:attribute "to" ,to)) + (cxml:attribute "type" ,type) + ,@body)) + (force-output ,stream))))) (defmacro with-iq-query ((connection &key xmlns id to node (type "get")) &body body) "Macro to make it easier to write QUERYs." - `(progn - (with-iq (connection :id ,id :type ,type :to ,to) - (cxml:with-element "query" + `(with-iq (connection :id ,id :type ,type :to ,to) + (cxml:with-element "query" (cxml:attribute "xmlns" ,xmlns) - (when ,node - (cxml:attribute "node" ,node)) - ,@body)) - ,connection)) + (when ,node + (cxml:attribute "node" ,node)) + ,@body))) ;; ;; Discovery @@ -418,8 +418,10 @@ (with-iq-query (connection :id "auth1" :xmlns "jabber:iq:auth") (cxml:with-element "username" (cxml:text username)))) -(defmethod auth ((connection connection) username password - resource &optional (mechanism :plain) (bind-et-al t)) +(defmethod auth ((connection connection) username password resource &key + (mechanism :plain) + (bind-et-al t) + (send-presence t)) "If bind-et-al is T this operator will bind, create a session and call presence on your behalf if the authentication was successful." (setf (username connection) username) @@ -427,10 +429,14 @@ (if (and (eq result :authentication-successful) bind-et-al) (progn - (bind connection username resource) - (receive-stanza connection) - (session connection) - (receive-stanza connection)) + (when (feature-p connection :bind) + (bind connection resource) + (receive-stanza connection)) + (when (feature-p connection :session) + (session connection) + (receive-stanza connection)) + (when send-presence + (presence connection))) result))) (defmethod %plain-auth% ((connection connection) username password resource) @@ -472,7 +478,7 @@ (cxml:with-element "body" (cxml:text body)))) connection) -(defmethod bind ((connection connection) jid resource) +(defmethod bind ((connection connection) resource) (with-iq (connection :id "bind_2" :type "set") (cxml:with-element "bind" (cxml:attribute "xmlns" "urn:ietf:params:xml:ns:xmpp-bind") Index: cl-xmpp/cxml.lisp diff -u cl-xmpp/cxml.lisp:1.6 cl-xmpp/cxml.lisp:1.7 --- cl-xmpp/cxml.lisp:1.6 Mon Nov 14 20:42:29 2005 +++ cl-xmpp/cxml.lisp Fri Nov 18 22:43:52 2005 @@ -75,21 +75,21 @@ ;; 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))) +(defclass octet+character-debug-stream-sink (cxml::octet-stream-sink) ()) (defun make-octet+character-debug-stream-sink (octet-stream &rest initargs) - (apply #'make-instance 'octet+character-debug-stream-sink - :target-stream octet-stream - 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*) - (force-output *debug-stream*))) + (write-byte octet (slot-value sink 'cxml::target-stream)) + (when *debug-stream* + (write-char (code-char octet) *debug-stream*) + (force-output *debug-stream*))) + +;(defmethod write-octet-sequence (sequence (sink octet+character-debug-stream-sink)) +; (write-sequence sequence (slot-value sink 'cxml::target-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.11 cl-xmpp/package.lisp:1.12 --- cl-xmpp/package.lisp:1.11 Thu Nov 17 22:51:16 2005 +++ cl-xmpp/package.lisp Fri Nov 18 22:43:52 2005 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.11 2005/11/17 21:51:16 eenge Exp $ +;;;; $Id: package.lisp,v 1.12 2005/11/18 21:43:52 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -17,6 +17,7 @@ :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 + :server-stream ;; only available if you've loaded cl-xmpp-tls :connect-tls :connect-tls2 ;; xmpp commands @@ -52,4 +53,4 @@ ;; user-hooks for handling events :handle ;; variables - :*default-port :*default-hostname* :*errors*))) + :*default-port :*default-hostname* :*errors* :*debug-stream*))) Index: cl-xmpp/variable.lisp diff -u cl-xmpp/variable.lisp:1.4 cl-xmpp/variable.lisp:1.5 --- cl-xmpp/variable.lisp:1.4 Fri Nov 11 22:20:20 2005 +++ cl-xmpp/variable.lisp Fri Nov 18 22:43:52 2005 @@ -1,4 +1,4 @@ -;;;; $Id: variable.lisp,v 1.4 2005/11/11 21:20:20 eenge Exp $ +;;;; $Id: variable.lisp,v 1.5 2005/11/18 21:43:52 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/variable.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -12,7 +12,7 @@ (defvar *default-hostname* "localhost") (defvar *errors* - '((:bad-request :modiy 400) + '((:bad-request :modify 400) (:conflict :cancel 409) (:feature-not-implemented :cancel 501) (:forbidden :auth 403)

1 0

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

17 Nov '05

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory common-lisp.net:/tmp/cvs-serv17629 Modified Files: cl-xmpp-sasl.lisp cl-xmpp.lisp package.lisp result.lisp Log Message: some reorganisation of the auth code, google talk still not there 100% Date: Thu Nov 17 22:51:16 2005 Author: eenge Index: cl-xmpp/cl-xmpp-sasl.lisp diff -u cl-xmpp/cl-xmpp-sasl.lisp:1.10 cl-xmpp/cl-xmpp-sasl.lisp:1.11 --- cl-xmpp/cl-xmpp-sasl.lisp:1.10 Thu Nov 17 21:56:38 2005 +++ cl-xmpp/cl-xmpp-sasl.lisp Thu Nov 17 22:51:15 2005 @@ -1,10 +1,19 @@ -;;;; $Id: cl-xmpp-sasl.lisp,v 1.10 2005/11/17 20:56:38 eenge Exp $ +;;;; $Id: cl-xmpp-sasl.lisp,v 1.11 2005/11/17 21:51:15 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp-sasl.lisp,v $ ;;;; See the LICENSE file for licensing information. (in-package :xmpp) +(defmethod if-successful-restart-stream ((connection connection) reply) + (if (eq reply :authentication-successful) + (progn + (begin-xml-stream connection :xml-identifier nil) + (receive-stanza connection) ; stream + (receive-stanza connection) ; features + reply) + reply)) + (defmethod %sasl-plain% ((connection connection) username password resource) (let* ((mechanism "PLAIN") (sasl-client (make-instance (sasl:get-mechanism mechanism) @@ -14,16 +23,19 @@ :host (hostname connection)))) (format *debug-stream* "~&SASL state: ~a~&" (sasl::state sasl-client)) (initiate-sasl-authentication connection mechanism sasl-client) - (receive-stanza connection))) + (if-successful-restart-stream connection (receive-stanza connection)))) (add-auth-method :sasl-plain '%sasl-plain%) (defmethod %sasl-digest-md5% ((connection connection) username password resource) - (handle-challenge-response connection username password "DIGEST-MD5")) + (if-successful-restart-stream + connection + (handle-challenge-response connection username password resource "DIGEST-MD5"))) (add-auth-method :sasl-digest-md5 '%sasl-digest-md5%) -(defmethod handle-challenge-response ((connection connection) username password mechanism) +(defmethod handle-challenge-response ((connection connection) username password + resource 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 @@ -52,12 +64,13 @@ (force-output *debug-stream*) (send-challenge-response connection base64-response) (let ((second-challenge (receive-stanza connection))) + (format *debug-stream* "second-challenge: ~a~&" second-challenge) (if (eq (name second-challenge) :challenge) (progn (send-second-response connection) - (receive-stanza connection)) - (values :failure second-challenge)))))) - (values :failure initial-challenge))))) + (receive-stanza connection)) + second-challenge))))) + initial-challenge)))) (defmethod initiate-sasl-authentication ((connection connection) mechanism sasl-client) (with-xml-stream (stream connection) Index: cl-xmpp/cl-xmpp.lisp diff -u cl-xmpp/cl-xmpp.lisp:1.18 cl-xmpp/cl-xmpp.lisp:1.19 --- cl-xmpp/cl-xmpp.lisp:1.18 Thu Nov 17 21:56:38 2005 +++ cl-xmpp/cl-xmpp.lisp Thu Nov 17 22:51:15 2005 @@ -1,4 +1,4 @@ -;;;; $Id: cl-xmpp.lisp,v 1.18 2005/11/17 20:56:38 eenge Exp $ +;;;; $Id: cl-xmpp.lisp,v 1.19 2005/11/17 21:51:15 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -93,8 +93,8 @@ (when begin-xml-stream (begin-xml-stream connection)) (when receive-stanzas - (receive-stanza connection) - (receive-stanza connection)) + (receive-stanza connection) ; stream + (receive-stanza connection)) ; features connection)) (defmethod connectedp ((connection connection)) @@ -337,11 +337,12 @@ ;; Operators for communicating over the XML stream ;; -(defmethod begin-xml-stream ((connection connection)) +(defmethod begin-xml-stream ((connection connection) &key (xml-identifier t)) "Begin XML stream. This should be the first thing to happen on a newly connected connection." (with-xml-stream (stream connection) - (xml-output stream "<?xml version='1.0' ?>") + (when xml-identifier + (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 connection) (hostname connection)))))) (defmethod end-xml-stream ((connection connection)) @@ -418,9 +419,19 @@ (cxml:with-element "username" (cxml:text username)))) (defmethod auth ((connection connection) username password - resource &optional (mechanism :plain)) + resource &optional (mechanism :plain) (bind-et-al t)) + "If bind-et-al is T this operator will bind, create a session and +call presence on your behalf if the authentication was successful." (setf (username connection) username) - (funcall (get-auth-method mechanism) connection username password resource)) + (let ((result (funcall (get-auth-method mechanism) connection username password resource))) + (if (and (eq result :authentication-successful) + bind-et-al) + (progn + (bind connection username resource) + (receive-stanza connection) + (session connection) + (receive-stanza connection)) + result))) (defmethod %plain-auth% ((connection connection) username password resource) (with-iq-query (connection :id "auth2" :type "set" :xmlns "jabber:iq:auth") @@ -467,6 +478,11 @@ (cxml:attribute "xmlns" "urn:ietf:params:xml:ns:xmpp-bind") (cxml:with-element "resource" (cxml:text resource))))) + +(defmethod session ((connection connection)) + (with-iq (connection :id "session_1" :type "set") + (cxml:with-element "session" + (cxml:attribute "xmlns" "urn:ietf:params:xml:ns:xmpp-session")))) ;; ;; Subscription Index: cl-xmpp/package.lisp diff -u cl-xmpp/package.lisp:1.10 cl-xmpp/package.lisp:1.11 --- cl-xmpp/package.lisp:1.10 Thu Nov 17 21:56:38 2005 +++ cl-xmpp/package.lisp Thu Nov 17 22:51:16 2005 @@ -1,4 +1,4 @@ -;;;; $Id: package.lisp,v 1.10 2005/11/17 20:56:38 eenge Exp $ +;;;; $Id: package.lisp,v 1.11 2005/11/17 21:51:16 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/package.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -23,7 +23,7 @@ :discover :registration-requirements :register :auth-requirements :auth - :presence :message :bind + :presence :message :bind :session ;; subscriptions :request-subscription :approve-subscription :deny/cancel-subscription :unsubscribe Index: cl-xmpp/result.lisp diff -u cl-xmpp/result.lisp:1.11 cl-xmpp/result.lisp:1.12 --- cl-xmpp/result.lisp:1.11 Thu Nov 17 20:41:40 2005 +++ cl-xmpp/result.lisp Thu Nov 17 22:51:16 2005 @@ -1,4 +1,4 @@ -;;;; $Id: result.lisp,v 1.11 2005/11/17 19:41:40 eenge Exp $ +;;;; $Id: result.lisp,v 1.12 2005/11/17 21:51:16 eenge Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/result.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -316,9 +316,25 @@ ;;; XXX: Handle legacy errors (defmethod make-error ((object xml-element)) - (let* ((code (parse-integer (value (get-attribute object :code)))) - (data (get-error-data-code code)) - (name (first data)) - (type (second data)) - (class (map-error-type-to-class type))) + (let ((code-value (value (get-attribute object :code))) + (code) + (name) + (type) + (class)) + ; Slightly verbose but there are still cases I have not + ; addressed (and have no examples of, any more) so I'm going + ; to leave it like this for now. + (if code-value + (let* ((code-number (parse-integer code-value)) + (data (get-error-data-code code-number))) + (setq code code-number) + (setq name (first data)) + (setq type (second data)) + (setq class (map-error-type-to-class type))) + (let* ((name (name (first (elements object)))) + (data (get-error-data-name name))) + (format *debug-stream* "~&Name: ~a~&" name) + (setq code (first data)) + (setq type (second data)) + (setq class (map-error-type-to-class type)))) (make-instance class :code code :name name :xml-element object)))

1 0