val set_context : OpenSSL.context -> unit
val hasPriv : string -> bool
+
+ val rmdom : string -> unit
end
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 ()
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;
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
(print ("whohas " ^ class ^ " / " ^ value ^ ":");
app (fn user => print (" " ^ user)) users;
print "\n"))
+ | ["rmdom", dom] => Main.requestRmdom dom
| _ => 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 service : unit -> unit
val slave : unit -> unit
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
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 _ => ();
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
(recvList OpenSSL.readString bio)
| 12 => Option.map MsgMultiConfig
(recvList OpenSSL.readString bio)
+ | 13 => Option.map MsgRmdom (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. *)
end
^ #file fs
^ " "
^ realVhostFile));
- OS.FileSys.mkDir realLogDir)
+ if Posix.FileSys.access (realLogDir, []) then
+ ()
+ else
+ OS.FileSys.mkDir realLogDir)
| _ =>
ignore (OS.Process.system (Config.cp
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))
HCoop / hcoop / domtool2.git / commitdiff