From: Adam Chlipala Date: Fri, 15 Dec 2006 22:21:39 +0000 (+0000) Subject: Be more cautious creating log directories X-Git-Tag: release_2010-11-19~299 X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/commitdiff_plain/c189cbe97d554b26ec6b203b4ce9f697947ecc38?hp=c53e82e40cef407de986aa329d31457915ad0dbe Be more cautious creating log directories --- diff --git a/src/domain.sig b/src/domain.sig index 041be2f..1d708f5 100644 --- a/src/domain.sig +++ b/src/domain.sig @@ -64,4 +64,6 @@ signature DOMAIN = sig val set_context : OpenSSL.context -> unit val hasPriv : string -> bool + + val rmdom : string -> unit end diff --git a/src/domain.sml b/src/domain.sml index d7603b2..0354944 100644 --- a/src/domain.sml +++ b/src/domain.sml @@ -537,6 +537,35 @@ val () = Env.registerPre (fn () => (ignore (Slave.shellF ([Config.rm, " -rf ", C handle OS.SysErr _ => ()) nodes)) +fun handleSite (site, files) = + let + + in + print ("New configuration for node " ^ site ^ "\n"); + if site = Config.defaultNode then + Slave.handleChanges files + else let + val bio = OpenSSL.connect (valOf (!ssl_context), + nodeIp site + ^ ":" + ^ Int.toString Config.slavePort) + in + app (fn file => Msg.send (bio, MsgFile file)) files; + Msg.send (bio, MsgDoFiles); + case Msg.recv bio of + NONE => print "Slave closed connection unexpectedly\n" + | SOME m => + case m of + MsgOk => print ("Slave " ^ site ^ " finished\n") + | MsgError s => print ("Slave " ^ site + ^ " returned error: " ^ + s ^ "\n") + | _ => print ("Slave " ^ site + ^ " returned unexpected command\n"); + OpenSSL.close bio + end + end + val () = Env.registerPost (fn () => let val diffs = findAllDiffs () @@ -578,35 +607,6 @@ val () = Env.registerPost (fn () => in SM.insert (changed, site, file :: ls) end) SM.empty diffs - - fun handleSite (site, files) = - let - - in - print ("New configuration for node " ^ site ^ "\n"); - if site = Config.defaultNode then - Slave.handleChanges files - else let - val bio = OpenSSL.connect (valOf (!ssl_context), - nodeIp site - ^ ":" - ^ Int.toString Config.slavePort) - in - app (fn file => Msg.send (bio, MsgFile file)) files; - Msg.send (bio, MsgDoFiles); - case Msg.recv bio of - NONE => print "Slave closed connection unexpectedly\n" - | SOME m => - case m of - MsgOk => print ("Slave " ^ site ^ " finished\n") - | MsgError s => print ("Slave " ^ site - ^ " returned error: " ^ - s ^ "\n") - | _ => print ("Slave " ^ site - ^ " returned unexpected command\n"); - OpenSSL.close bio - end - end in SM.appi handleSite changed end; @@ -631,4 +631,45 @@ val _ = Env.type_one "mail_node" orelse (hasPriv "mail" andalso List.exists (fn x => x = node) Config.mailNodes_admin)) +fun rmdom dom = + 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) + + val dir = Posix.FileSys.opendir dname + + fun loop actions = + case Posix.FileSys.readdir dir of + NONE => actions + | SOME fname => loop ({action = Slave.Delete, + domain = dom, + dir = dname, + file = OS.Path.joinDirFile {dir = dname, + file = fname}} :: actions) + + val actions = loop [] + in + Posix.FileSys.closedir dir; + handleSite (node, actions) + end + handle IO.Io _ => print ("Warning: IO error deleting domain " ^ dom ^ " on " ^ node ^ ".\n") + + fun cleanupNode (node, _) = + let + 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 + app doNode Config.nodeIps; + app cleanupNode Config.nodeIps + end + end diff --git a/src/main-admin.sml b/src/main-admin.sml index b318002..e0081b4 100644 --- a/src/main-admin.sml +++ b/src/main-admin.sml @@ -41,4 +41,5 @@ val _ = (print ("whohas " ^ class ^ " / " ^ value ^ ":"); app (fn user => print (" " ^ user)) users; print "\n")) + | ["rmdom", dom] => Main.requestRmdom dom | _ => print "Invalid command-line arguments\n" diff --git a/src/main.sig b/src/main.sig index ac7f9c9..941b704 100644 --- a/src/main.sig +++ b/src/main.sig @@ -38,6 +38,7 @@ 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 service : unit -> unit val slave : unit -> unit diff --git a/src/main.sml b/src/main.sml index 3c0b728..0f65362 100644 --- a/src/main.sml +++ b/src/main.sml @@ -324,6 +324,21 @@ fun requestWhoHas perm = before OpenSSL.close bio end +fun requestRmdom dom = + let + val (_, bio) = requestBio (fn () => ()) + in + Msg.send (bio, MsgRmdom dom); + 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 service () = let val () = Acl.read Config.aclFile @@ -466,6 +481,30 @@ fun service () = handle OpenSSL.OpenSSL _ => (); loop ()) + | MsgRmdom dom => + if Acl.query {user = user, class = "priv", value = "all"} + orelse Acl.query {user = user, class = "domain", value = dom} then + ((Domain.rmdom dom; + Msg.send (bio, MsgOk); + print ("Removed domain " ^ dom ^ ".\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 that domain"); + print "Unauthorized user asked to remove a domain!\n"; + ignore (OpenSSL.readChar bio); + OpenSSL.close bio) + handle OpenSSL.OpenSSL _ => (); + loop ()) + | _ => (Msg.send (bio, MsgError "Unexpected command") handle OpenSSL.OpenSSL _ => (); diff --git a/src/msg.sml b/src/msg.sml index 2de4898..aa5cf35 100644 --- a/src/msg.sml +++ b/src/msg.sml @@ -93,6 +93,8 @@ 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)) fun checkIt v = case v of @@ -140,6 +142,7 @@ fun recv bio = (recvList OpenSSL.readString bio) | 12 => Option.map MsgMultiConfig (recvList OpenSSL.readString bio) + | 13 => Option.map MsgRmdom (OpenSSL.readString bio) | _ => NONE) end diff --git a/src/msgTypes.sml b/src/msgTypes.sml index 4e0d68d..bf74086 100644 --- a/src/msgTypes.sml +++ b/src/msgTypes.sml @@ -46,5 +46,8 @@ 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. *) end diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml index 91209af..955e9d8 100644 --- a/src/plugins/apache.sml +++ b/src/plugins/apache.sml @@ -246,7 +246,10 @@ val () = Slave.registerFileHandler (fn fs => ^ #file fs ^ " " ^ realVhostFile)); - OS.FileSys.mkDir realLogDir) + if Posix.FileSys.access (realLogDir, []) then + () + else + OS.FileSys.mkDir realLogDir) | _ => ignore (OS.Process.system (Config.cp diff --git a/src/slave.sml b/src/slave.sml index b0148f1..719b417 100644 --- a/src/slave.sml +++ b/src/slave.sml @@ -56,7 +56,12 @@ fun registerPostHandler handler = end fun handleChanges fs = (!preHandler (); - app (!fileHandler) fs; + app (fn recd as {action, file, ...} => + (!fileHandler recd; + if action = Delete andalso Posix.FileSys.access (file, []) then + OS.FileSys.remove file + else + ())) fs; !postHandler ()) fun shell ss = OS.Process.isSuccess (OS.Process.system (String.concat ss))