From 51cc45f7d84d0d92700b461a1296b9aa748dd88e Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Mon, 12 May 2008 20:26:51 +0000
Subject: [PATCH] Allow rmdom on subdomains of those on the user's ACL

---
 src/acl.sig  |  2 ++
 src/acl.sml  | 12 ++++++++++++
 src/main.sml |  3 ++-
 3 files changed, 16 insertions(+), 1 deletion(-)

diff --git a/src/acl.sig b/src/acl.sig
index 846b331..a88bddd 100644
--- 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
--- 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
--- 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;
-- 
2.20.1