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