[xen staging] tools/ocaml/xenstored: do permission checks on xenstore root

[patchbot@xxxxxxx]

commit feeafa007b804cdf2406c50a6515ee0a217d3438
Author:     Edwin Török <edvin.torok@xxxxxxxxxx>
AuthorDate: Tue Dec 15 13:33:43 2020 +0100
Commit:     Jan Beulich <jbeulich@xxxxxxxx>
CommitDate: Tue Dec 15 13:33:43 2020 +0100

    tools/ocaml/xenstored: do permission checks on xenstore root
    
    This was lacking in a disappointing number of places.
    
    The xenstore root node is treated differently from all other nodes, because 
it
    doesn't have a parent, and mutation requires changing the parent.
    
    Unfortunately this lead to open-coding the special case for root into every
    single xenstore operation, and out of all the xenstore operations only read
    did a permission check when handling the root node.
    
    This means that an unprivileged guest can:
    
     * xenstore-chmod / to its liking and subsequently write new arbitrary nodes
       there (subject to quota)
     * xenstore-rm -r / deletes almost the entire xenstore tree (xenopsd quickly
       refills some, but you are left with a broken system)
     * DIRECTORY on / lists all children when called through python
       bindings (xenstore-ls stops at /local because it tries to list 
recursively)
     * get-perms on / works too, but that is just a minor information leak
    
    Add the missing permission checks, but this should really be refactored to 
do
    the root handling and permission checks on the node only once from a single
    function, instead of getting it wrong nearly everywhere.
    
    This is XSA-353.
    
    Signed-off-by: Edwin Török <edvin.torok@xxxxxxxxxx>
    Acked-by: Christian Lindig <christian.lindig@xxxxxxxxxx>
    Reviewed-by: Andrew Cooper <andrew.cooper3@xxxxxxxxxx>
---
 tools/ocaml/xenstored/store.ml | 24 ++++++++++++++----------
 1 file changed, 14 insertions(+), 10 deletions(-)

diff --git a/tools/ocaml/xenstored/store.ml b/tools/ocaml/xenstored/store.ml
index f299ec6461..92b6289b5e 100644
--- a/tools/ocaml/xenstored/store.ml
+++ b/tools/ocaml/xenstored/store.ml
@@ -273,15 +273,17 @@ let path_rm store perm path =
                        Node.del_childname node name
                with Not_found ->
                        raise Define.Doesnt_exist in
-       if path = [] then
+       if path = [] then (
+               Node.check_perm store.root perm Perms.WRITE;
                Node.del_all_children store.root
-       else
+       ) else
                Path.apply_modify store.root path do_rm
 
 let path_setperms store perm path perms =
-       if path = [] then
+       if path = [] then (
+               Node.check_perm store.root perm Perms.WRITE;
                Node.set_perms store.root perms
-       else
+       ) else
                let do_setperms node name =
                        let c = Node.find node name in
                        Node.check_owner c perm;
@@ -313,9 +315,10 @@ let read store perm path =
 
 let ls store perm path =
        let children =
-               if path = [] then
-                       (Node.get_children store.root)
-               else
+               if path = [] then (
+                       Node.check_perm store.root perm Perms.READ;
+                       Node.get_children store.root
+               ) else
                        let do_ls node name =
                                let cnode = Node.find node name in
                                Node.check_perm cnode perm Perms.READ;
@@ -324,9 +327,10 @@ let ls store perm path =
        List.rev (List.map (fun n -> Symbol.to_string n.Node.name) children)
 
 let getperms store perm path =
-       if path = [] then
-               (Node.get_perms store.root)
-       else
+       if path = [] then (
+               Node.check_perm store.root perm Perms.READ;
+               Node.get_perms store.root
+       ) else
                let fct n name =
                        let c = Node.find n name in
                        Node.check_perm c perm Perms.READ;
--
generated by git-patchbot for /home/xen/git/xen.git#staging