[cl-xmpp-cvs] CVS update: cl-xmpp/cl-xmpp.lisp cl-xmpp/utility.lisp

[Erik Enge]

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)
-               , at 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)
+                          , at 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