From e69e60ccf1aa77a40cd5b15c4361f378ce332a42 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 16 Dec 2006 18:53:44 +0000 Subject: [PATCH] Rmuser --- src/acl.sig | 5 +++ src/acl.sml | 12 +++++++ src/domain.sig | 2 +- src/domain.sml | 80 +++++++++++++++++++++++++++------------------- src/main-admin.sml | 2 +- src/main.sig | 3 +- src/main.sml | 62 ++++++++++++++++++++++++++++++++--- src/msg.sml | 9 ++++-- src/msgTypes.sml | 9 ++++-- 9 files changed, 138 insertions(+), 46 deletions(-) diff --git a/src/acl.sig b/src/acl.sig index 10abcde..846b331 100644 --- a/src/acl.sig +++ b/src/acl.sig @@ -43,6 +43,11 @@ signature ACL = sig 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 *) diff --git a/src/acl.sml b/src/acl.sml index be30fdf..135e555 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) @@ -89,6 +93,14 @@ fun revoke {user, class, value} = 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 diff --git a/src/domain.sig b/src/domain.sig index a937624..642c0f4 100644 --- a/src/domain.sig +++ b/src/domain.sig @@ -74,5 +74,5 @@ signature DOMAIN = sig val hasPriv : string -> bool - val rmdom : string -> unit + val rmdom : string list -> unit end diff --git a/src/domain.sml b/src/domain.sml index ca2f993..04ee532 100644 --- a/src/domain.sml +++ b/src/domain.sml @@ -654,56 +654,70 @@ val _ = Env.type_one "mail_node" 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; diff --git a/src/main-admin.sml b/src/main-admin.sml index 2931ae6..7305822 100644 --- a/src/main-admin.sml +++ b/src/main-admin.sml @@ -41,6 +41,6 @@ val _ = (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" diff --git a/src/main.sig b/src/main.sig index c086bd5..791b357 100644 --- a/src/main.sig +++ b/src/main.sig @@ -38,8 +38,9 @@ signature MAIN = sig 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 diff --git a/src/main.sml b/src/main.sml index f22c430..997713d 100644 --- a/src/main.sml +++ b/src/main.sml @@ -371,6 +371,21 @@ fun requestRmdom dom = 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 () @@ -439,6 +454,18 @@ fun regenerate context = 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 @@ -583,12 +610,15 @@ fun service () = 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, @@ -629,6 +659,30 @@ fun service () = 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 ()) | _ => diff --git a/src/msg.sml b/src/msg.sml index bb6a2b1..251626a 100644 --- a/src/msg.sml +++ b/src/msg.sml @@ -93,9 +93,11 @@ fun send (bio, m) = 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 @@ -143,8 +145,9 @@ fun recv bio = (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 diff --git a/src/msgTypes.sml b/src/msgTypes.sml index 89ab255..44f4178 100644 --- a/src/msgTypes.sml +++ b/src/msgTypes.sml @@ -46,10 +46,13 @@ datatype msg = (* 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 -- 2.20.1