Don't break on nodes with whitespace/text in between
- The child nodes of a given node can include both text nodes and actual XML element nodes. Trying to pass a text node to something like DOM:TAG-NAME signals an error condition. - To avoid this, use DOM:ELEMENT-P and the CHILD-ELEMENTS helper function to filter lists of nodes down to elements where elements are expected.
This commit is contained in:
parent
1e59c2a6c7
commit
e4e9aa0ec1
|
@ -269,7 +269,7 @@
|
|||
(progn
|
||||
(format t "~&IQ ~A from ~A for ~A~%" type from id)
|
||||
(cond
|
||||
((equal type "result") (finish promise (dom:child-nodes stanza)))
|
||||
((equal type "result") (finish promise (child-elements stanza)))
|
||||
((equal type "error") (signal-error promise (extract-stanza-error stanza)))
|
||||
(t (warn "Invalid IQ stanza type: ~A" type)))
|
||||
(setf promise nil))
|
||||
|
@ -293,7 +293,7 @@
|
|||
(let* ((from (dom:get-attribute stanza "from"))
|
||||
(to (dom:get-attribute stanza "to"))
|
||||
(id (dom:get-attribute stanza "id"))
|
||||
(children (dom:child-nodes stanza))
|
||||
(children (child-elements stanza))
|
||||
(body (get-node-named children "body"))
|
||||
(marker (get-node-with-xmlns children +chat-markers-ns+))
|
||||
(chat-state (get-node-with-xmlns children +chat-states-ns+)))
|
||||
|
|
10
xmpp.lisp
10
xmpp.lisp
|
@ -55,12 +55,12 @@
|
|||
|
||||
(defun get-node-named (nodes name)
|
||||
"Finds the node with tag name NAME in NODES, returning NIL if none was found."
|
||||
(flet ((is-the-node (node) (equal (dom:tag-name node) name)))
|
||||
(flet ((is-the-node (node) (and (dom:element-p node) (equal (dom:tag-name node) name))))
|
||||
(find-if #'is-the-node nodes)))
|
||||
|
||||
(defun get-node-with-xmlns (nodes xmlns)
|
||||
"Finds the node with XML namespace XMLNS in NODES, returning NIL if none was found."
|
||||
(flet ((is-the-node (node) (equal (dom:get-attribute node "xmlns") xmlns)))
|
||||
(flet ((is-the-node (node) (and (dom:element-p node) (equal (dom:get-attribute node "xmlns") xmlns))))
|
||||
(find-if #'is-the-node nodes)))
|
||||
|
||||
(defun handle-stream-error (comp stanza)
|
||||
|
@ -68,7 +68,7 @@
|
|||
(equal (dom:namespace-uri node) +streams-ns+))
|
||||
(is-text-node (node)
|
||||
(equal (dom:tag-name node) "text")))
|
||||
(let* ((children (dom:child-nodes stanza))
|
||||
(let* ((children (child-elements stanza))
|
||||
(error-node (find-if #'is-error-node children))
|
||||
(error-text-node (find-if #'is-text-node children))
|
||||
(error-name (dom:tag-name error-node))
|
||||
|
@ -104,8 +104,8 @@
|
|||
(equal (dom:tag-name node) "error"))
|
||||
(is-text-node (node)
|
||||
(and (equal (dom:namespace-uri node) +stanzas-ns+) (equal (dom:tag-name node) "text"))))
|
||||
(let* ((error-node (find-if #'is-error-node (dom:child-nodes stanza)))
|
||||
(error-children (dom:child-nodes error-node))
|
||||
(let* ((error-node (find-if #'is-error-node (child-elements stanza)))
|
||||
(error-children (child-elements error-node))
|
||||
(type (dom:get-attribute error-node "type"))
|
||||
(condition-node (find-if #'is-error-condition-node error-children))
|
||||
(condition-name (dom:tag-name condition-node))
|
||||
|
|
Loading…
Reference in a new issue