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)