[cl-xmpp-cvs] CVS cl-xmpp
jstecklina
jstecklina at common-lisp.net
Mon Mar 5 17:38:35 UTC 2007
Update of /project/cl-xmpp/cvsroot/cl-xmpp
In directory clnet:/tmp/cvs-serv497
Modified Files:
cl-xmpp-tls.lisp cl-xmpp.lisp cxml.lisp
Log Message:
Removed stanza-handler. (Patch by David Lichteblau)
--- /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp-tls.lisp 2005/11/28 15:15:46 1.8
+++ /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp-tls.lisp 2007/03/05 17:38:35 1.9
@@ -1,4 +1,4 @@
-;;;; $Id: cl-xmpp-tls.lisp,v 1.8 2005/11/28 15:15:46 eenge Exp $
+;;;; $Id: cl-xmpp-tls.lisp,v 1.9 2007/03/05 17:38:35 jstecklina Exp $
;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp-tls.lisp,v $
;;;; See the LICENSE file for licensing information.
@@ -48,9 +48,9 @@
(setf (server-stream connection)
(cl+ssl:make-ssl-client-stream (server-stream connection)
:external-format :iso-8859-1))
- (setf (server-xstream connection) nil)
+ (setf (server-source connection) nil)
(when begin-xml-stream
(begin-xml-stream connection))
(when receive-stanzas
(receive-stanza connection)
- (receive-stanza connection)))
\ No newline at end of file
+ (receive-stanza connection)))
--- /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp 2007/03/04 04:26:23 1.30
+++ /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp 2007/03/05 17:38:35 1.31
@@ -1,4 +1,4 @@
-;;;; $Id: cl-xmpp.lisp,v 1.30 2007/03/04 04:26:23 jstecklina Exp $
+;;;; $Id: cl-xmpp.lisp,v 1.31 2007/03/05 17:38:35 jstecklina Exp $
;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp,v $
;;;; See the LICENSE file for licensing information.
@@ -10,8 +10,8 @@
:accessor server-stream
:initarg :server-stream
:initform nil)
- (server-xstream
- :accessor server-xstream
+ (server-source
+ :accessor server-source
:initform nil)
(stream-id
:accessor stream-id
@@ -317,23 +317,37 @@
(car (funcall stanza-callback stanza connection :dom-repr dom-repr)))))))
(defun read-stanza (connection)
- (unless (server-xstream connection)
- (setf (server-xstream connection)
- (cxml:make-xstream (make-slow-stream (server-stream connection))
- :name
- (cxml::make-stream-name
- :entity-name "stanza"
- :entity-kind :main
- :uri nil))))
+ (unless (server-source connection)
+ (setf (server-source connection)
+ (cxml:make-source
+ (cxml:make-xstream (make-slow-stream (server-stream connection))
+ :name
+ (cxml::make-stream-name
+ :entity-name "stanza"
+ :entity-kind :main
+ :uri nil))
+ :buffering nil)))
(force-output (server-stream connection))
- (catch 'stanza
- (let ((cxml::*initial-namespace-bindings*
- (acons #"stream"
- #"http://etherx.jabber.org/streams"
- cxml::*initial-namespace-bindings*)))
- (cxml::parse-xstream (server-xstream connection)
- (make-instance 'stanza-handler))
- (runes::write-xstream-buffer (server-xstream connection)))))
+ (let ((source (server-source connection)))
+ (loop
+ (multiple-value-bind (key uri lname qname)
+ (klacks:peek-next source)
+ (when (eq key :start-element)
+ (return
+ (if (and (equal uri "http://etherx.jabber.org/streams")
+ (equal lname "stream"))
+ ;; Create an element for DOM-TO-EVENT so we don't have to have
+ ;; any specialized code just to handle stream:stream.
+ (let* ((document (cxml-dom:create-document))
+ (element (dom:create-element document qname)))
+ (dom:append-child document element)
+ (dolist (attribute (klacks:list-attributes source))
+ (let ((name (sax::attribute-qname attribute))
+ (value (sax::attribute-value attribute)))
+ (dom:set-attribute element name value)))
+ document)
+ (klacks:serialize-element source
+ (cxml-dom:make-dom-builder)))))))))
(defmacro with-xml-stream ((stream connection) &body body)
"Helper macro to make it easy to control outputting XML
--- /project/cl-xmpp/cvsroot/cl-xmpp/cxml.lisp 2005/12/31 20:15:06 1.10
+++ /project/cl-xmpp/cvsroot/cl-xmpp/cxml.lisp 2007/03/05 17:38:35 1.11
@@ -1,53 +1,17 @@
-;;;; $Id: cxml.lisp,v 1.10 2005/12/31 20:15:06 eenge Exp $
+;;;; $Id: cxml.lisp,v 1.11 2007/03/05 17:38:35 jstecklina Exp $
;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cxml.lisp,v $
;;;; See the LICENSE file for licensing information.
(in-package :xmpp)
-(defclass stanza-handler (cxml:sax-proxy)
- ((depth
- :initform 0
- :accessor depth)))
-
-(defun start-sax-document (handler)
- (let ((dom-builder (cxml-dom:make-dom-builder)))
- (setf (cxml:proxy-chained-handler handler) dom-builder)
- (sax:start-document dom-builder)
- dom-builder))
-
-(defmethod sax:start-element ((handler stanza-handler) uri lname qname attrs)
- (declare (ignore uri lname))
- (when (eql (depth handler) 0)
- (if (eq :stream\:stream (ensure-keyword qname))
- ;; Create an element for DOM-TO-EVENT so we don't have to have
- ;; any specialized code just to handle stream:stream.
- (let* ((document (cxml-dom:create-document))
- (element (dom:create-element document qname)))
- (dom:append-child document element)
- (dolist (attribute attrs)
- (let ((name (sax::attribute-qname attribute))
- (value (sax::attribute-value attribute)))
- (dom:set-attribute element name value)))
- (throw 'stanza document))
- (start-sax-document handler)))
- (incf (depth handler))
- (call-next-method))
-
-;;; END-ELEMENT will try and call the stanza-callback at every time
-;;; it sees depth reach 0 and there is a callback to be called.
-;;; This means that we can keep reading from the stream and as we
-;;; close out elements we parse them and return them to users
-;;; using callbacks (the one supplied to RECEIVE-STANZA-LOOP).
-(defmethod sax:end-element ((handler stanza-handler) uri lname qname)
- (declare (ignore uri lname qname))
- (decf (depth handler))
- (call-next-method)
- (when (eql (depth handler) 0)
- (throw 'stanza
- (cxml-dom::document (cxml:proxy-chained-handler handler)))))
-
;;; Perform single-byte reads to avoid blocking on the socket.
+;;; Also print all data read to *DEBUG-STREAM*.
+;;;
+;;; FIXME: Is this still needed, now that cxml supports :BUFFERING NIL?
+;;; The debugging output could be done using a special gray stream that
+;;; dribbles input, instead of a special xstream. --david
+
(defstruct (slow-stream (:constructor make-slow-stream (target)))
(target nil :type stream))
@@ -58,22 +22,13 @@
(when (< start end)
(let ((byte (read-byte (slow-stream-target stream) nil)))
(when byte
+ (when *debug-stream*
+ ;; Original comment:
+ ;; I'd like to see what CXML is reading from the stream
+ ;; and this code helps us in that regard by printing it
+ ;; to the *debug-stream*
+ (write-char (code-char byte) *debug-stream*))
(setf (elt seq start) byte)
(incf start))))
start)
-;; I'd like to see what CXML is reading from the stream
-;; and this code helps us in that regard by printing it
-;; to the *debug-stream*
-(defun runes::write-xstream-buffer (xstream &optional (stream *debug-stream*))
- (when stream
- (write-string (map 'string
- #'code-char
- (remove runes::+end+
- (subseq (runes::xstream-buffer xstream) 0
- (runes::xstream-read-ptr xstream))))
- stream)
- (force-output stream)))
-
-(defmethod runes::xstream-underflow :before ((input runes:xstream))
- (runes::write-xstream-buffer input))
\ No newline at end of file
More information about the Cl-xmpp-cvs
mailing list