[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
Erik Enge
eenge at common-lisp.net
Fri Nov 18 21:43:54 UTC 2005
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)
- , at 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)
+ , at 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))
- , at body))
- ,connection))
+ (when ,node
+ (cxml:attribute "node" ,node))
+ , at 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)
More information about the Cl-xmpp-cvs
mailing list