Allow rmdom on subdomains of those on the user's ACL
[hcoop/domtool2.git] / src / acl.sml
index 135e555..85287d9 100644 (file)
@@ -87,10 +87,18 @@ fun revoke {user, class, value} =
                         SS.delete (values, value)
                     else
                         values
+
+       val classes = if SS.isEmpty values then
+                         (#1 (SM.remove (classes, class)))
+                         handle NotFound => classes
+                     else
+                         SM.insert (classes, class, values)
     in
-       acl := SM.insert (!acl, user,
-                         SM.insert (classes, class,
-                                    values))
+       if SM.numItems classes = 0 then
+           (acl := #1 (SM.remove (!acl, user)))
+           handle NotFound => ()
+       else
+           acl := SM.insert (!acl, user, classes)
     end
 
 fun revokeFromAll {class, value} =
@@ -159,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