val revoke : acl -> unit
(* Grant/ungrant the user the permission. *)
+ val revokeFromAll : {class : string, value : string} -> unit
+
+ val rmuser : string -> unit
+ (* Remove all of a user's privileges. *)
+
val read : string -> unit
val write : string -> unit
(* Read/write saved ACL state from/to a file *)
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)
values))
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
val hasPriv : string -> bool
- val rmdom : string -> unit
+ val rmdom : string list -> unit
end
orelse (hasPriv "mail"
andalso List.exists (fn x => x = node) Config.mailNodes_admin))
-fun rmdom dom =
+fun rmdom doms =
let
- val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
-
fun doNode (node, _) =
let
val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
file = node}
- val dname = OS.Path.concat (dname, domPath)
- fun visitDom (dom, dname, actions) =
+ fun doDom (dom, actions) =
let
- val dir = Posix.FileSys.opendir dname
-
- fun loop actions =
- case Posix.FileSys.readdir dir of
- NONE => actions
- | SOME fname =>
- let
- val fnameFull = OS.Path.joinDirFile {dir = dname,
- file = fname}
- in
- if Posix.FileSys.ST.isDir (Posix.FileSys.stat fnameFull) then
- loop (visitDom (fname ^ "." ^ dom,
- fnameFull,
- actions))
- else
- loop ({action = Slave.Delete,
- domain = dom,
- dir = dname,
- file = fnameFull} :: actions)
- end
+ val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
+ val dname = OS.Path.concat (dname, domPath)
+
+ fun visitDom (dom, dname, actions) =
+ let
+ val dir = Posix.FileSys.opendir dname
+
+ fun loop actions =
+ case Posix.FileSys.readdir dir of
+ NONE => actions
+ | SOME fname =>
+ let
+ val fnameFull = OS.Path.joinDirFile {dir = dname,
+ file = fname}
+ in
+ if Posix.FileSys.ST.isDir (Posix.FileSys.stat fnameFull) then
+ loop (visitDom (fname ^ "." ^ dom,
+ fnameFull,
+ actions))
+ else
+ loop ({action = Slave.Delete,
+ domain = dom,
+ dir = dname,
+ file = fnameFull} :: actions)
+ end
+ in
+ loop actions
+ before Posix.FileSys.closedir dir
+ end
+ handle OS.SysErr _ =>
+ (print ("Warning: System error deleteing domain " ^ dom ^ " on " ^ node ^ ".\n");
+ actions)
in
- loop actions
- before Posix.FileSys.closedir dir
+ visitDom (dom, dname, actions)
end
- val actions = visitDom (dom, dname, [])
+ val actions = foldl doDom [] doms
in
handleSite (node, actions)
end
- handle IO.Io _ => print ("Warning: IO error deleting domain " ^ dom ^ " on " ^ node ^ ".\n")
+ handle IO.Io _ => print ("Warning: IO error deleting domains on " ^ node ^ ".\n")
fun cleanupNode (node, _) =
let
- val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
- file = node}
- val dname = OS.Path.concat (dname, domPath)
+ fun doDom dom =
+ let
+ val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
+ val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
+ file = node}
+ val dname = OS.Path.concat (dname, domPath)
+ in
+ ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
+ end
in
- ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
+ app doDom doms
end
in
app doNode Config.nodeIps;
(print ("whohas " ^ class ^ " / " ^ value ^ ":");
app (fn user => print (" " ^ user)) users;
print "\n"))
- | ["rmdom", dom] => Main.requestRmdom dom
+ | "rmdom" :: doms => Main.requestRmdom doms
| ["regen"] => Main.requestRegen ()
| _ => print "Invalid command-line arguments\n"
val requestRevoke : Acl.acl -> unit
val requestListPerms : string -> (string * string list) list option
val requestWhoHas : {class : string, value : string} -> string list option
- val requestRmdom : string -> unit
+ val requestRmdom : string list -> unit
val requestRegen : unit -> unit
+ val requestRmuser : string -> unit
val service : unit -> unit
val slave : unit -> unit
OpenSSL.close bio
end
+fun requestRmuser user =
+ let
+ val (_, bio) = requestBio (fn () => ())
+ in
+ Msg.send (bio, MsgRmuser user);
+ case Msg.recv bio of
+ NONE => print "Server closed connection unexpectedly.\n"
+ | SOME m =>
+ case m of
+ MsgOk => print "Removal succeeded.\n"
+ | MsgError s => print ("Removal failed: " ^ s ^ "\n")
+ | _ => print "Unexpected server reply.\n";
+ OpenSSL.close bio
+ end
+
fun regenerate context =
let
val b = basis ()
Env.post ()
end
+fun rmuser user =
+ let
+ val doms = Acl.class {user = user, class = "domain"}
+ val doms = List.filter (fn dom =>
+ case Acl.whoHas {class = "domain", value = dom} of
+ [_] => true
+ | _ => false) (StringSet.listItems doms)
+ in
+ Acl.rmuser user;
+ Domain.rmdom doms
+ end
+
fun service () =
let
val () = Acl.read Config.aclFile
handle OpenSSL.OpenSSL _ => ();
loop ())
- | MsgRmdom dom =>
+ | MsgRmdom doms =>
if Acl.query {user = user, class = "priv", value = "all"}
- orelse Acl.query {user = user, class = "domain", value = dom} then
- ((Domain.rmdom dom;
+ orelse List.all (fn dom => Acl.query {user = user, class = "domain", value = dom}) doms then
+ ((Domain.rmdom doms;
+ app (fn dom =>
+ Acl.revokeFromAll {class = "domain", value = dom}) doms;
+ Acl.write Config.aclFile;
Msg.send (bio, MsgOk);
- print ("Removed domain " ^ dom ^ ".\n"))
+ print ("Removed domains" ^ foldl (fn (d, s) => s ^ " " ^ d) "" doms ^ ".\n"))
handle OpenSSL.OpenSSL s =>
(print "OpenSSL error\n";
Msg.send (bio,
ignore (OpenSSL.readChar bio);
OpenSSL.close bio)
handle OpenSSL.OpenSSL _ => ();
+ loop ())
+
+ | MsgRmuser user =>
+ if Acl.query {user = user, class = "priv", value = "all"} then
+ ((rmuser user;
+ Acl.write Config.aclFile;
+ Msg.send (bio, MsgOk);
+ print ("Removed user " ^ user ^ ".\n"))
+ handle OpenSSL.OpenSSL s =>
+ (print "OpenSSL error\n";
+ Msg.send (bio,
+ MsgError
+ ("Error during revocation: "
+ ^ s)));
+ (ignore (OpenSSL.readChar bio);
+ OpenSSL.close bio)
+ handle OpenSSL.OpenSSL _ => ();
+ loop ())
+ else
+ ((Msg.send (bio, MsgError "Not authorized to remove users");
+ print "Unauthorized user asked to remove a user!\n";
+ ignore (OpenSSL.readChar bio);
+ OpenSSL.close bio)
+ handle OpenSSL.OpenSSL _ => ();
loop ())
| _ =>
sendList OpenSSL.writeString (bio, users))
| MsgMultiConfig codes => (OpenSSL.writeInt (bio, 12);
sendList OpenSSL.writeString (bio, codes))
- | MsgRmdom dom => (OpenSSL.writeInt (bio, 13);
- OpenSSL.writeString (bio, dom))
+ | MsgRmdom doms => (OpenSSL.writeInt (bio, 13);
+ sendList OpenSSL.writeString (bio, doms))
| MsgRegenerate => OpenSSL.writeInt (bio, 14)
+ | MsgRmuser dom => (OpenSSL.writeInt (bio, 15);
+ OpenSSL.writeString (bio, dom))
fun checkIt v =
case v of
(recvList OpenSSL.readString bio)
| 12 => Option.map MsgMultiConfig
(recvList OpenSSL.readString bio)
- | 13 => Option.map MsgRmdom (OpenSSL.readString bio)
+ | 13 => Option.map MsgRmdom (recvList OpenSSL.readString bio)
| 14 => SOME MsgRegenerate
+ | 15 => Option.map MsgRmuser (OpenSSL.readString bio)
| _ => NONE)
end
(* These are the users! *)
| MsgMultiConfig of string list
(* Multiple Domtool sources in dependency order *)
- | MsgRmdom of string
- (* Remove all configuration associated with a domain and revoke rights
- * to that domain from all users. *)
+ | MsgRmdom of string list
+ (* Remove all configuration associated with some domains and revoke
+ * rights to those domains from all users. *)
| MsgRegenerate
(* Make a clean slate of it and reprocess all configuration from scratch. *)
+ | MsgRmuser of string
+ (* Remove all ACL entries for a user, and remove all domains to which
+ * that user and no one else has rights. *)
end
HCoop / hcoop / domtool2.git / commitdiff