a3x/whatsxmpp
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Don't break on nodes with whitespace/text in between

Browse source 
- 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:
eta 2020-07-31 15:45:07 +01:00
parent 1e59c2a6c7
commit e4e9aa0ec1
2 changed files with 7 additions and 7 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

4
component.lisp
View file

@ -269,7 +269,7 @@
(progn (progn
(format t "~&IQ ~A from ~A for ~A~%" type from id) (format t "~&IQ ~A from ~A for ~A~%" type from id)
(cond (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))) ((equal type "error") (signal-error promise (extract-stanza-error stanza)))
(t (warn "Invalid IQ stanza type: ~A" type))) (t (warn "Invalid IQ stanza type: ~A" type)))
(setf promise nil)) (setf promise nil))
@ -293,7 +293,7 @@
(let* ((from (dom:get-attribute stanza "from")) (let* ((from (dom:get-attribute stanza "from"))
(to (dom:get-attribute stanza "to")) (to (dom:get-attribute stanza "to"))
(id (dom:get-attribute stanza "id")) (id (dom:get-attribute stanza "id"))
(children (dom:child-nodes stanza)) (children (child-elements stanza))
(body (get-node-named children "body")) (body (get-node-named children "body"))
(marker (get-node-with-xmlns children +chat-markers-ns+)) (marker (get-node-with-xmlns children +chat-markers-ns+))
(chat-state (get-node-with-xmlns children +chat-states-ns+))) (chat-state (get-node-with-xmlns children +chat-states-ns+)))

10
xmpp.lisp
View file

@ -55,12 +55,12 @@
(defun get-node-named (nodes name) (defun get-node-named (nodes name)
"Finds the node with tag name NAME in NODES, returning NIL if none was found." "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))) (find-if #'is-the-node nodes)))
(defun get-node-with-xmlns (nodes xmlns) (defun get-node-with-xmlns (nodes xmlns)
"Finds the node with XML namespace XMLNS in NODES, returning NIL if none was found." "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))) (find-if #'is-the-node nodes)))
(defun handle-stream-error (comp stanza) (defun handle-stream-error (comp stanza)
@ -68,7 +68,7 @@
(equal (dom:namespace-uri node) +streams-ns+)) (equal (dom:namespace-uri node) +streams-ns+))
(is-text-node (node) (is-text-node (node)
(equal (dom:tag-name node) "text"))) (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-node (find-if #'is-error-node children))
(error-text-node (find-if #'is-text-node children)) (error-text-node (find-if #'is-text-node children))
(error-name (dom:tag-name error-node)) (error-name (dom:tag-name error-node))
@ -104,8 +104,8 @@
(equal (dom:tag-name node) "error")) (equal (dom:tag-name node) "error"))
(is-text-node (node) (is-text-node (node)
(and (equal (dom:namespace-uri node) +stanzas-ns+) (equal (dom:tag-name node) "text")))) (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))) (let* ((error-node (find-if #'is-error-node (child-elements stanza)))
(error-children (dom:child-nodes error-node)) (error-children (child-elements error-node))
(type (dom:get-attribute error-node "type")) (type (dom:get-attribute error-node "type"))
(condition-node (find-if #'is-error-condition-node error-children)) (condition-node (find-if #'is-error-condition-node error-children))
(condition-name (dom:tag-name condition-node)) (condition-name (dom:tag-name condition-node))