/[cl-xmpp]/cl-xmpp/cl-xmpp-tls.lisp
ViewVC logotype

Contents of /cl-xmpp/cl-xmpp-tls.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.9 - (show annotations)
Mon Mar 5 17:38:35 2007 UTC (7 years, 1 month ago) by jstecklina
Branch: MAIN
CVS Tags: cl_xmpp_0_8_0, HEAD
Changes since 1.8: +3 -3 lines
Removed stanza-handler. (Patch by David Lichteblau)
1 ;;;; $Id: cl-xmpp-tls.lisp,v 1.9 2007/03/05 17:38:35 jstecklina Exp $
2 ;;;; $Source: /tiger/var/lib/cvsroots/cl-xmpp/cl-xmpp/cl-xmpp-tls.lisp,v $
3
4 ;;;; See the LICENSE file for licensing information.
5
6 (in-package :xmpp)
7
8 (defun connect-tls (&rest args)
9 "Connect to the host and start a TLS stream."
10 (let ((begin-xml-stream (if (member :begin-xml-stream args)
11 (getf args :begin-xml-stream)
12 t))
13 (receive-stanzas (if (member :begin-xml-stream args)
14 (getf args :begin-xml-stream)
15 t)))
16 (connect-tls2 (apply #'connect args)
17 :begin-xml-stream begin-xml-stream
18 :receive-stanzas receive-stanzas)))
19
20 (defmethod connect-tls2 ((connection connection) &key
21 (receive-stanzas t)
22 (begin-xml-stream t))
23 "This one does all the work so if you need to use the
24 regular CONNECT followed by something followed by converting
25 your stream to TLS you could use this function."
26 (send-starttls connection)
27 (let ((reply (receive-stanza connection)))
28 (case (name reply)
29 (:proceed (convert-to-tls-stream connection
30 :begin-xml-stream begin-xml-stream
31 :receive-stanzas receive-stanzas)
32 (values connection :proceed reply))
33 (:failure (values connection :failure reply))
34 (t (error "Unexpected reply from TLS negotiation: ~a." reply)))))
35
36 (defmethod send-starttls ((connection connection))
37 "Sends a request to start a TLS stream with the server."
38 (with-xml-stream (stream connection)
39 (xml-output stream "<starttls xmlns='urn:ietf:params:xml:ns:xmpp-tls'/>")))
40
41 (defmethod convert-to-tls-stream ((connection connection) &key
42 (begin-xml-stream t)
43 (receive-stanzas t))
44 "Convert the existing stream to a TLS stream and issue
45 a stream:stream open tag to start the XML stream.
46
47 Turn off sending XML stream start with :begin-xml-stream nil."
48 (setf (server-stream connection)
49 (cl+ssl:make-ssl-client-stream (server-stream connection)
50 :external-format :iso-8859-1))
51 (setf (server-source connection) nil)
52 (when begin-xml-stream
53 (begin-xml-stream connection))
54 (when receive-stanzas
55 (receive-stanza connection)
56 (receive-stanza connection)))

  ViewVC Help
Powered by ViewVC 1.1.5