Allow rmdom on subdomains of those on the user's ACL

[hcoop/domtool2.git] / src / acl.sml

diff --git a/src/acl.sml b/src/acl.sml
index f7307b0..85287d9 100644 (file)
--- a/src/acl.sml
+++ b/src/acl.sml
@@ -167,4 +167,16 @@ fun write fname =
        TextIO.closeOut outf
     end
 
        TextIO.closeOut outf
     end
 

+fun queryDomain {user, domain} =
+    let
+       fun trySuffix parts =
+           case parts of
+               [] => false
+             | first :: rest =>
+               query {user = user, class = "domain", value = String.concatWith "." parts}
+               orelse trySuffix rest
+    in
+       trySuffix (String.fields (fn ch => ch = #".") domain)
+    end
+

 end
 end