[cl-xmpp-devel] Support for XEP-0114 (Component Protocol)

[Stephan Maka]

Hello

I'm missing component support in cl-xmpp, the attached chunk adds it.
Unfortunately, I'm still a very beginner with Lisp, so this can't be
taken as a serious implementation. The code is mostly copied from client
and it doesn't test the handshake response for failure.

In XMPP4R[0] we have a stream class for sending and receiving stanzas.
It is superclass to connection, where we handle TCP setup and
sending/receiving data. Derived from connection are client and component
which do stuff like specifying <stream:stream> attributes.

I don't know what the right way for a Lisp library would be, but a
component has slightly different conventions than a client, i.e. it
shouldn't send a plain <presence/> after auth, or any
stanza-constructing method must posses a way for specifying the from
attribute.

Stephan

[0] http://home.gna.org/xmpp4r/
-------------- next part --------------
(require 'cl-xmpp)

(in-package :xmpp)

(defclass component (connection) ())

(defun connect-component (&key (hostname *default-hostname*) (port 5347) 
                     (receive-stanzas t) (begin-xml-stream t) jid-domain-part
                     (class 'component))
  (let* ((stream (trivial-sockets:open-stream
                  hostname port :element-type '(unsigned-byte 8)))
         (connection (make-instance class
                                    :jid-domain-part jid-domain-part
                                    :server-stream stream
                                    :hostname hostname
                                    :port port)))
    (when begin-xml-stream
      (begin-xml-stream connection))
    (when receive-stanzas
      (receive-stanza connection))  ; stream
    connection))

(defmethod begin-xml-stream ((connection component) &key (xml-identifier t))
  "Begin XML stream.  This should be the first thing to happen on a
newly connected connection."
  (with-xml-stream (stream connection)
   (when xml-identifier
     (xml-output stream "<?xml version='1.0' ?>"))
   (xml-output stream (fmt "<stream:stream to='~a' xmlns='jabber:component:accept' xmlns:stream='http://etherx.jabber.org/streams' version='1.0'>" (or (jid-domain-part connection) (hostname connection))))))

(defmethod auth-component ((connection component) password)
  (with-xml-output (connection)
   (if (stream-id connection)
       (cxml:with-element "handshake"
	(cxml:text (make-digest-password (stream-id connection) password)))
     (error "stream-id on ~a not set, cannot make digest password" connection)))
  (receive-stanza connection))
-------------- next part --------------
A non-text attachment was scrubbed...
Name: not available
Type: application/pgp-signature
Size: 189 bytes
Desc: not available
URL: <https://mailman.common-lisp.net/pipermail/cl-xmpp-devel/attachments/20070429/2bbabead/attachment.sig>