Fix file paths for recursive rmdom

[hcoop/domtool2.git] / src / domain.sml

diff --git a/src/domain.sml b/src/domain.sml
index d7603b2..ca2f993 100644 (file)
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -97,6 +97,8 @@ fun yourDomainHost s =
                                (Substring.slice (suf, 1, NONE)))
     end
 
+val yourDomain = yourDomainHost
+
 fun validUser s = size s > 0 andalso size s < 20
                  andalso CharVector.all Char.isAlphaNum s
 
@@ -276,6 +278,27 @@ fun registerAfter f =
        afters := (fn x => (old x; f x))
     end
 
+val globals = ref (fn () => ())
+val locals = ref (fn () => ())
+
+fun registerResetGlobal f =
+    let
+       val old = !globals
+    in
+       globals := (fn x => (old x; f x))
+    end
+
+fun registerResetLocal f =
+    let
+       val old = !locals
+    in
+       locals := (fn x => (old x; f x))
+    end
+
+fun resetGlobal () = (!globals ();
+                     ignore (OS.Process.system (Config.rm ^ " -rf " ^ Config.resultRoot ^ "/*")))
+fun resetLocal () = !locals ()
+
 val current = ref ""
 val currentPath = ref (fn (_ : string) => "")
 
@@ -537,6 +560,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 +630,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 +654,60 @@ 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)
+
+               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
+
+               val actions = visitDom (dom, dname, [])
+           in
+               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