cl-xmpp-cvs March 2007

cl-xmpp-cvs@common-lisp.net

1 participants
3 discussions

[cl-xmpp-cvs] CVS cl-xmpp
by jstecklina 05 Mar '07

05 Mar '07

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

1 0

[cl-xmpp-cvs] CVS cl-xmpp
by jstecklina 04 Mar '07

04 Mar '07

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory clnet:/tmp/cvs-serv29735 Modified Files: cl-xmpp.lisp Log Message: Replaced fix to namespace problem by suggestion of David Lichteblau --- /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp 2007/03/03 18:42:08 1.29 +++ /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp 2007/03/04 04:26:23 1.30 @@ -1,4 +1,4 @@ -;;;; $Id: cl-xmpp.lisp,v 1.29 2007/03/03 18:42:08 jstecklina Exp $ +;;;; $Id: cl-xmpp.lisp,v 1.30 2007/03/04 04:26:23 jstecklina Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -316,16 +316,6 @@ (when stanza-callback (car (funcall stanza-callback stanza connection :dom-repr dom-repr))))))) -;;; XXX: Kludge. Newer versions of CXML rebind *namespace-bindings* -;;; inside of parse-xstream, so the old method of augmenting -;;; *namespace-bindings* inside of read-stanza does not work any -;;; longer. - Julian Stecklina (Mar 03, 2007) - -(unless (assoc #"stream" cxml::*initial-namespace-bindings* - :test #'runes:rod=) - (push (cons #"stream" #"http://etherx.jabber.org/streams") - cxml::*initial-namespace-bindings*)) - (defun read-stanza (connection) (unless (server-xstream connection) (setf (server-xstream connection) @@ -337,9 +327,13 @@ :uri nil)))) (force-output (server-stream connection)) (catch 'stanza - (cxml::parse-xstream (server-xstream connection) - (make-instance 'stanza-handler)) - (runes::write-xstream-buffer (server-xstream connection)))) + (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))))) (defmacro with-xml-stream ((stream connection) &body body) "Helper macro to make it easy to control outputting XML

1 0

[cl-xmpp-cvs] CVS cl-xmpp
by jstecklina 03 Mar '07

03 Mar '07

Update of /project/cl-xmpp/cvsroot/cl-xmpp In directory clnet:/tmp/cvs-serv3081 Modified Files: cl-xmpp.lisp Log Message: Fixed READ-STANZA for recent CXML versions. Kludge. Please improve. --- /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp 2006/08/28 21:17:08 1.28 +++ /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp 2007/03/03 18:42:08 1.29 @@ -1,4 +1,4 @@ -;;;; $Id: cl-xmpp.lisp,v 1.28 2006/08/28 21:17:08 jstecklina Exp $ +;;;; $Id: cl-xmpp.lisp,v 1.29 2007/03/03 18:42:08 jstecklina Exp $ ;;;; $Source: /project/cl-xmpp/cvsroot/cl-xmpp/cl-xmpp.lisp,v $ ;;;; See the LICENSE file for licensing information. @@ -316,6 +316,16 @@ (when stanza-callback (car (funcall stanza-callback stanza connection :dom-repr dom-repr))))))) +;;; XXX: Kludge. Newer versions of CXML rebind *namespace-bindings* +;;; inside of parse-xstream, so the old method of augmenting +;;; *namespace-bindings* inside of read-stanza does not work any +;;; longer. - Julian Stecklina (Mar 03, 2007) + +(unless (assoc #"stream" cxml::*initial-namespace-bindings* + :test #'runes:rod=) + (push (cons #"stream" #"http://etherx.jabber.org/streams") + cxml::*initial-namespace-bindings*)) + (defun read-stanza (connection) (unless (server-xstream connection) (setf (server-xstream connection) @@ -327,13 +337,9 @@ :uri nil)))) (force-output (server-stream connection)) (catch 'stanza - (let ((cxml::*namespace-bindings* - (acons #"stream" - #"http://etherx.jabber.org/streams" - cxml::*namespace-bindings*))) - (cxml::parse-xstream (server-xstream connection) - (make-instance 'stanza-handler)) - (runes::write-xstream-buffer (server-xstream connection))))) + (cxml::parse-xstream (server-xstream connection) + (make-instance 'stanza-handler)) + (runes::write-xstream-buffer (server-xstream connection)))) (defmacro with-xml-stream ((stream connection) &body body) "Helper macro to make it easy to control outputting XML

1 0

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

cl-xmpp-cvs March 2007