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

diff --git a/src/acl.sig b/src/acl.sig
index 846b331..a88bddd 100644 (file)
--- a/src/acl.sig
+++ b/src/acl.sig
@@ -52,4 +52,6 @@ signature ACL = sig
     val write : string -> unit
     (* Read/write saved ACL state from/to a file *)
 
+    val queryDomain : {user : string, domain : string} -> bool
+    (* Like a call to [query] for class 'domain', but considers subdomains, too *)
 end

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
 
+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

diff --git a/src/main.sml b/src/main.sml
index 67e8dc0..02bb485 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -1283,7 +1283,8 @@ fun service () =
                               | MsgRmdom doms =>
                                 doIt (fn () =>
                                          if Acl.query {user = user, class = "priv", value = "all"}
-                                            orelse List.all (fn dom => Acl.query {user = user, class = "domain", value = dom}) doms then
+                                            orelse List.all (fn dom => Domain.validDomain dom
+                                                                       andalso Acl.queryDomain {user = user, domain = dom}) doms then
                                              (Domain.rmdom doms;
                                               (*app (fn dom =>
                                                       Acl.revokeFromAll {class = "domain", value = dom}) doms;