X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/e69e60ccf1aa77a40cd5b15c4361f378ce332a42..51cc45f7d84d0d92700b461a1296b9aa748dd88e:/src/acl.sml

diff --git a/src/acl.sml b/src/acl.sml
index 135e555..85287d9 100644
--- a/src/acl.sml
+++ b/src/acl.sml
@@ -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