X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/1824f573f7f8720514af1dc94d7cfb1de5b15fef..cd04086681583dd3fcc95b6e12ba312054dc590e:/src/acl.sml

diff --git a/src/acl.sml b/src/acl.sml
index be30fdf..f7307b0 100644
--- a/src/acl.sml
+++ b/src/acl.sml
@@ -64,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)
@@ -83,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