[cl-xmpp-cvs] CVS update: cl-xmpp/cl-xmpp-tls.lisp 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-serv25792

Modified Files:
	cl-xmpp-tls.lisp cl-xmpp.lisp utility.lisp 
Log Message:
killing string-to-array and using ironclad:ascii-string-to-byte-array instead

Date: Mon Nov 14 16:14:08 2005
Author: eenge

Index: cl-xmpp/cl-xmpp-tls.lisp
diff -u cl-xmpp/cl-xmpp-tls.lisp:1.3 cl-xmpp/cl-xmpp-tls.lisp:1.4
--- cl-xmpp/cl-xmpp-tls.lisp:1.3	Sat Nov 12 05:30:57 2005
+++ cl-xmpp/cl-xmpp-tls.lisp	Mon Nov 14 16:14:06 2005
@@ -1,4 +1,4 @@
-;;;; $Id: cl-xmpp-tls.lisp,v 1.3 2005/11/12 04:30:57 eenge Exp $
+;;;; $Id: cl-xmpp-tls.lisp,v 1.4 2005/11/14 15:14:06 eenge Exp $
 ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp-tls.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -9,17 +9,24 @@
   "Connect to the host and start a TLS stream."
   (let ((connection (apply #'connect args)))
     (send-starttls connection)
-    (convert-to-tls-stream connection)
-    connection))
+    (let ((reply (receive-stanza connection)))
+      (case (name reply)
+	(:proceed (convert-to-tls-stream connection)
+		  (values connection :proceed reply))
+	(:failure (values connection :failure reply))
+	(t (error "Unexpected reply from TLS negotiation: ~a." reply))))))
 
 (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 convert-to-tls-stream ((connection connection))
+(defmethod convert-to-tls-stream ((connection connection) &key (begin-xml-stream t))
   "Convert the existing stream to a TLS stream and issue
-a stream:stream open tag to start the XML stream."
+a stream:stream open tag to start the XML stream.
+
+Turn off sending XML stream start with :begin-xml-stream nil."
   (setf (server-stream connection)
 	(cl+ssl:make-ssl-client-stream (server-stream connection)))
-  (begin-xml-stream connection))
+  (when begin-xml-stream
+    (begin-xml-stream connection)))


Index: cl-xmpp/cl-xmpp.lisp
diff -u cl-xmpp/cl-xmpp.lisp:1.13 cl-xmpp/cl-xmpp.lisp:1.14
--- cl-xmpp/cl-xmpp.lisp:1.13	Sat Nov 12 05:20:21 2005
+++ cl-xmpp/cl-xmpp.lisp	Mon Nov 14 16:14:06 2005
@@ -1,4 +1,4 @@
-;;;; $Id: cl-xmpp.lisp,v 1.13 2005/11/12 04:20:21 eenge Exp $
+;;;; $Id: cl-xmpp.lisp,v 1.14 2005/11/14 15:14:06 eenge Exp $
 ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -316,7 +316,7 @@
 
 (defun xml-output (stream string)
   "Write string to stream as a sequence of bytes and not characters."
-  (let ((sequence (string-to-array string :element-type '(unsigned-byte 8))))
+  (let ((sequence (ironclad:ascii-string-to-byte-array string)))
     (write-sequence sequence stream)
     (finish-output stream)
     (when *debug-stream*


Index: cl-xmpp/utility.lisp
diff -u cl-xmpp/utility.lisp:1.7 cl-xmpp/utility.lisp:1.8
--- cl-xmpp/utility.lisp:1.7	Fri Nov 11 22:20:20 2005
+++ cl-xmpp/utility.lisp	Mon Nov 14 16:14:07 2005
@@ -1,4 +1,4 @@
-;;;; $Id: utility.lisp,v 1.7 2005/11/11 21:20:20 eenge Exp $
+;;;; $Id: utility.lisp,v 1.8 2005/11/14 15:14:07 eenge Exp $
 ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/utility.lisp,v $
 
 ;;;; See the LICENSE file for licensing information.
@@ -14,12 +14,6 @@
    ((typep (car list) 'atom) (cons (car list)
 				   (flatten (cdr list))))
    ((typep (car list) 'list) (flatten (append (car list) (cdr list))))))
-
-(defun string-to-array (string &rest args)
-  (let ((array (apply #'make-array (length string) args)))
-    (dotimes (position (length string))
-      (setf (aref array position) (char-code (aref string position))))
-    array))
 
 (defun digestify-string (string)
   (ironclad:byte-array-to-hex-string