From e4e9aa0ec1a5fb3a533856754f6912b177632dd0 Mon Sep 17 00:00:00 2001 From: eta Date: Fri, 31 Jul 2020 15:45:07 +0100 Subject: [PATCH] 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. --- component.lisp | 4 ++-- xmpp.lisp | 10 +++++----- 2 files changed, 7 insertions(+), 7 deletions(-) diff --git a/component.lisp b/component.lisp index 2a9ac39..d058709 100644 --- a/component.lisp +++ b/component.lisp @@ -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+))) diff --git a/xmpp.lisp b/xmpp.lisp index 21cfd9b..3fd224d 100644 --- a/xmpp.lisp +++ b/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))