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 d0b41fe..85287d9 100644 (file)
--- a/src/acl.sml
+++ b/src/acl.sml
@@ -37,6 +37,25 @@ fun query {user, class, value} =
            NONE => false
          | SOME values => SS.member (values, value)
 
+fun queryAll user =
+    case SM.find (!acl, user) of
+       NONE => []
+      | SOME classes => SM.foldri (fn (class, values, out) =>
+                                     (class, SS.foldr (op::) [] values) :: out)
+                                 [] classes
+
+fun users () = SM.foldri (fn (user, _, ls) => user :: ls) [] (!acl)
+
+fun whoHas {class, value} =
+    SM.foldri (fn (user, classes, users) =>
+                 case SM.find (classes, class) of
+                     NONE => users
+                   | SOME values =>
+                     if SS.member (values, value) then
+                         user :: users
+                     else
+                         users) [] (!acl)
+
 fun class {user, class} =
     case SM.find (!acl, user) of
        NONE => SS.empty
@@ -45,6 +64,10 @@ fun class {user, class} =
            NONE => SS.empty
          | SOME values => values
 
+fun rmuser user =
+    (acl := #1 (SM.remove (!acl, user)))
+    handle NotFound => ()
+
 fun grant {user, class, value} =
     let
        val classes = Option.getOpt (SM.find (!acl, user), SM.empty)
@@ -64,12 +87,28 @@ 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} =
+    acl := SM.map (fn classes =>
+                     case SM.find (classes, class) of
+                         NONE => classes
+                       | SOME values =>
+                         ((SM.insert (classes, class, SS.delete (values, value)))
+                          handle NotFound => classes)) (!acl)
+
 fun read fname =
     let
        val inf = TextIO.openIn fname
@@ -108,18 +147,36 @@ fun write fname =
                                      TextIO.output (outf, value)))
 
        val writeClasses = SM.appi (fn (class, values) =>
-                                      (TextIO.output (outf, class);
-                                       writeValues values;
-                                       TextIO.output (outf, "\n")))
+                                      if SS.isEmpty values then
+                                          ()
+                                      else
+                                          (TextIO.output (outf, class);
+                                           writeValues values;
+                                           TextIO.output (outf, "\n")))
 
        val writeUsers = SM.appi (fn (user, classes) =>
-                                    (TextIO.output (outf, user);
-                                     TextIO.output (outf, "\n");
-                                     writeClasses classes;
-                                     TextIO.output (outf, "\n")))
+                                    if SM.numItems classes = 0 then
+                                        ()
+                                    else
+                                        (TextIO.output (outf, user);
+                                         TextIO.output (outf, "\n");
+                                         writeClasses classes;
+                                         TextIO.output (outf, "\n")))
     in
        writeUsers (!acl);
        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