wgreenhouse
/
emacs-jabber
1
0
Fork 1
Code Issues Pull Requests Projects Releases Wiki Activity

Use namespace prefixes declared on stream root element 

* jabber-core.el (jabber-namespace-prefixes): New variable.
(jabber-connection) [:connected, :bind]: Expect features instead
of stream:features.
(jabber-filter): Save namespace prefixes from stream root element.
Use saved prefixes when parsing stanzas.

* jabber-xml.el (jabber-xml-resolve-namespace-prefixes): Move the merging part...
(jabber-xml-merge-namespace-declarations): ...into this new function.
This commit is contained in:
Magnus Henoch 2011-12-21 18:38:38 +00:00
parent a034d4b330
commit 4ff9b48fbe
2 changed files with 38 additions and 20 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
jabber-core.el
View File

@ -64,6 +64,10 @@
(defvar jabber-choked-timer nil)
(defvar jabber-namespace-prefixes nil
"XML namespace prefixes used for the current connection.")
(make-variable-buffer-local 'jabber-namespace-prefixes)
(defgroup jabber-core nil "customize core functionality"
:group 'jabber)
@ -440,7 +444,7 @@ With double prefix argument, specify more connection details."
(let ((stanza (cadr event)))
(cond
;; At this stage, we only expect a stream:features stanza.
((not (eq (jabber-xml-node-name stanza) 'stream:features))
((not (eq (jabber-xml-node-name stanza) 'features))
(list nil (plist-put state-data
:disconnection-reason
(format "Unexpected stanza %s" stanza))))
@ -632,7 +636,7 @@ With double prefix argument, specify more connection details."
(:stanza
(let ((stanza (cadr event)))
(cond
((eq (jabber-xml-node-name stanza) 'stream:features)
((eq (jabber-xml-node-name stanza) 'features)
(if (and (jabber-xml-get-children stanza 'bind)
(jabber-xml-get-children stanza 'session))
(labels
@ -862,7 +866,14 @@ DATA is any sexp."
(stream-header (car (xml-parse-region (point-min) ending-at)))
(session-id (jabber-xml-get-attribute stream-header 'id))
(stream-version (jabber-xml-get-attribute stream-header 'version)))
;; Need to keep any namespace attributes on the stream
;; header, as they can affect any stanza in the
;; stream...
(setq jabber-namespace-prefixes
(jabber-xml-merge-namespace-declarations
(jabber-xml-node-attributes stream-header)
nil))
(jabber-log-xml fsm "receive" stream-header)
(fsm-send fsm (list :stream-start session-id stream-version))
(delete-region (point-min) ending-at)))
@ -898,7 +909,9 @@ DATA is any sexp."
(sit-for 2)))
(delete-region (point-min) (point))
(fsm-send fsm (list :stanza (jabber-xml-resolve-namespace-prefixes (car xml-data))))
(fsm-send fsm (list :stanza
(jabber-xml-resolve-namespace-prefixes
(car xml-data) nil jabber-namespace-prefixes)))
;; XXX: move this logic elsewhere
;; We explicitly don't catch errors in jabber-process-input,
;; to facilitate debugging.

37
jabber-xml.el
View File

@ -226,22 +226,8 @@ any string character data of this node"
(defun jabber-xml-resolve-namespace-prefixes (xml-data &optional default-ns prefixes)
(let ((node-name (jabber-xml-node-name xml-data))
(attrs (jabber-xml-node-attributes xml-data)))
;; First find any foo:xmlns attributes..
(dolist (attr attrs)
(let ((attr-name (symbol-name (car attr))))
(when (string-match "xmlns:" attr-name)
(let ((prefix (substring attr-name (match-end 0)))
(ns-uri (cdr attr)))
;; A slightly complicated dance to never change the
;; original value of prefixes (since the caller depends on
;; it), but also to avoid excessive copying (which remove
;; always does). Might need to profile and tweak this for
;; performance.
(setq prefixes
(cons (cons prefix ns-uri)
(if (assoc prefix prefixes)
(remove (assoc prefix prefixes) prefixes)
prefixes)))))))
(setq prefixes (jabber-xml-merge-namespace-declarations attrs prefixes))
;; If there is an xmlns attribute, it is the new default
;; namespace.
(let ((xmlns (jabber-xml-get-xmlns xml-data)))
@ -267,6 +253,25 @@ any string character data of this node"
(jabber-xml-node-children xml-data))
xml-data))
(defun jabber-xml-merge-namespace-declarations (attrs prefixes)
;; First find any xmlns:foo attributes..
(dolist (attr attrs)
(let ((attr-name (symbol-name (car attr))))
(when (string-match "xmlns:" attr-name)
(let ((prefix (substring attr-name (match-end 0)))
(ns-uri (cdr attr)))
;; A slightly complicated dance to never change the
;; original value of prefixes (since the caller depends on
;; it), but also to avoid excessive copying (which remove
;; always does). Might need to profile and tweak this for
;; performance.
(setq prefixes
(cons (cons prefix ns-uri)
(if (assoc prefix prefixes)
(remove (assoc prefix prefixes) prefixes)
prefixes)))))))
prefixes)
(provide 'jabber-xml)
;;; arch-tag: ca206e65-7026-4ee8-9af2-ff6a9c5af98a