Working on automatic rmdom for bad domains during regen

diff --git a/configDefault/domtool.cfg b/configDefault/domtool.cfg
index 2ecfa35..9fe0db8 100644 (file)
--- a/configDefault/domtool.cfg
+++ b/configDefault/domtool.cfg
@@ -1,6 +1,7 @@
 val libRoot = "/afs/hcoop.net/common/etc/domtool/lib"
 val resultRoot = "/afs/hcoop.net/common/etc/domtool/nodes"
 val tmpDir = "/tmp/domtool"
 val libRoot = "/afs/hcoop.net/common/etc/domtool/lib"
 val resultRoot = "/afs/hcoop.net/common/etc/domtool/nodes"
 val tmpDir = "/tmp/domtool"

+val oldResultRoot = "/afs/hcoop.net/common/etc/domtool/nodes.old"

 
 val cat = "/bin/cat"
 val cp = "/bin/cp"
 
 val cat = "/bin/cat"
 val cp = "/bin/cp"

diff --git a/configDefault/domtool.cfs b/configDefault/domtool.cfs
index cf42538..cb638c7 100644 (file)
--- a/configDefault/domtool.cfs
+++ b/configDefault/domtool.cfs
@@ -5,6 +5,9 @@ val resultRoot : string
 (* Root directory for a directory hierarchy corresponding to domain structure,
  * where each node contains Domtool-generated result files for that domain. *)
 
 (* Root directory for a directory hierarchy corresponding to domain structure,
  * where each node contains Domtool-generated result files for that domain. *)
 

+val oldResultRoot : string
+(* Save an old copy for differencing *)
+

 val tmpDir : string
 (* Filesystem location for creating temporary directories *)
 
 val tmpDir : string
 (* Filesystem location for creating temporary directories *)
 

diff --git a/src/domain.sig b/src/domain.sig
index b30f3ec..a8de0de 100644 (file)
--- a/src/domain.sig
+++ b/src/domain.sig
@@ -92,6 +92,7 @@ signature DOMAIN = sig
     val hasPriv : string -> bool
 
     val rmdom : string list -> unit
     val hasPriv : string -> bool
 
     val rmdom : string list -> unit

+    val rmdom' : string -> string list -> unit

 
     val homedirOf : string -> string
     val homedir : unit -> string
 
     val homedirOf : string -> string
     val homedir : unit -> string

diff --git a/src/domain.sml b/src/domain.sml
index 642f71c..064aa3e 100644 (file)
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -667,7 +667,7 @@ val () = Env.registerPost (fn () =>
                                                       handle OS.SysErr _ =>
                                                              ErrorMsg.error NONE ("Delete failed for " ^ dst);
                                                       (site,
                                                       handle OS.SysErr _ =>
                                                              ErrorMsg.error NONE ("Delete failed for " ^ dst);
                                                       (site,

-                                                       {action = Slave.Delete,
+                                                       {action = Slave.Delete true,

                                                         domain = dom,
                                                         dir = dir,
                                                         file = dst}))
                                                         domain = dom,
                                                         dir = dir,
                                                         file = dst}))


@@ -715,11 +715,11 @@ val _ = Env.type_one "mail_node"
            orelse (hasPriv "mail"
                    andalso List.exists (fn x => x = node) Config.mailNodes_admin))
 
            orelse (hasPriv "mail"
                    andalso List.exists (fn x => x = node) Config.mailNodes_admin))
 

-fun rmdom doms =
+fun rmdom' delete resultRoot doms =

     let
        fun doNode (node, _) =
            let
     let
        fun doNode (node, _) =
            let

-               val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
+               val dname = OS.Path.joinDirFile {dir = resultRoot,

                                                 file = node}
 
                fun doDom (dom, actions) =
                                                 file = node}
 
                fun doDom (dom, actions) =


@@ -743,18 +743,19 @@ fun rmdom doms =
                                                loop (visitDom (fname ^ "." ^ dom,
                                                                fnameFull,
                                                                actions))
                                                loop (visitDom (fname ^ "." ^ dom,
                                                                fnameFull,
                                                                actions))

-                                           else                                                        
-                                               loop ({action = Slave.Delete,
-                                                      domain = dom,
-                                                      dir = dname,
-                                                      file = fnameFull} :: actions)
+                                           else                        
+                                               (print ("Kill " ^ fnameFull ^ "\n");
+                                                loop ({action = Slave.Delete delete,
+                                                       domain = dom,
+                                                       dir = dname,
+                                                       file = fnameFull} :: actions))

                                        end
                            in
                                loop actions
                                before Posix.FileSys.closedir dir
                            end
                                        end
                            in
                                loop actions
                                before Posix.FileSys.closedir dir
                            end

-                               handle OS.SysErr _ =>
-                                      (print ("Warning: System error deleting domain " ^ dom ^ " on " ^ node ^ ".\n");
+                               handle OS.SysErr (s, _) =>
+                                      (print ("Warning: System error deleting domain " ^ dom ^ " on " ^ node ^ ": " ^ s ^ "\n");

                                        actions)
                    in
                        visitDom (dom, dname, actions)
                                        actions)
                    in
                        visitDom (dom, dname, actions)


@@ -771,11 +772,14 @@ fun rmdom doms =
                fun doDom dom =
                    let
                        val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
                fun doDom dom =
                    let
                        val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))

-                       val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
+                       val dname = OS.Path.joinDirFile {dir = resultRoot,

                                                         file = node}
                        val dname = OS.Path.concat (dname, domPath)
                    in
                                                         file = node}
                        val dname = OS.Path.concat (dname, domPath)
                    in

-                       ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
+                       if delete then
+                           ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
+                       else
+                           ()

                    end
            in
                app doDom doms
                    end
            in
                app doDom doms


@@ -785,6 +789,9 @@ fun rmdom doms =
        app cleanupNode Config.nodeIps
     end
 
        app cleanupNode Config.nodeIps
     end
 

+val rmdom = rmdom' true Config.resultRoot
+val rmdom' = rmdom' false
+

 fun homedirOf uname =
     Posix.SysDB.Passwd.home (Posix.SysDB.getpwnam uname)
 
 fun homedirOf uname =
     Posix.SysDB.Passwd.home (Posix.SysDB.getpwnam uname)
 

diff --git a/src/main.sml b/src/main.sml
index 8cc5a3a..fc8df17 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -888,8 +888,59 @@ fun requestDescribe dom =
        OpenSSL.close bio
     end
 
        OpenSSL.close bio
     end
 

+structure SS = StringSet
+
+fun domainList dname =
+    let
+       val dir = Posix.FileSys.opendir dname
+
+       fun visitNode dset =
+           case Posix.FileSys.readdir dir of
+               NONE => dset
+             | SOME node =>
+               let
+                   val path = OS.Path.joinDirFile {dir = dname,
+                                                   file = node}
+
+                   fun visitDomains (path, bfor, dset) =
+                       let
+                           val dir = Posix.FileSys.opendir path
+
+                           fun loop dset =
+                               case Posix.FileSys.readdir dir of
+                                   NONE => dset
+                                 | SOME dname =>
+                                   let
+                                       val path = OS.Path.joinDirFile {dir = path,
+                                                                       file = dname}
+                                   in
+                                       if Posix.FileSys.ST.isDir (Posix.FileSys.stat path) then
+                                           let
+                                               val bfor = dname :: bfor
+                                           in
+                                               loop (visitDomains (path, bfor,
+                                                                   SS.add (dset,
+                                                                           String.concatWith "." bfor)))
+                                           end
+                                       else
+                                           loop dset
+                                   end
+                       in
+                           loop dset
+                           before Posix.FileSys.closedir dir
+                       end
+               in
+                   visitNode (visitDomains (path, [], dset))
+               end
+    in
+       visitNode SS.empty
+       before Posix.FileSys.closedir dir
+    end
+

 fun regenerateEither tc checker context =
     let
 fun regenerateEither tc checker context =
     let

+       val domainsBefore = domainList Config.resultRoot
+

        fun ifReal f =
            if tc then
                ()
        fun ifReal f =
            if tc then
                ()


@@ -901,7 +952,11 @@ fun regenerateEither tc checker context =
        val b = basis ()
        val () = Tycheck.disallowExterns ()
 
        val b = basis ()
        val () = Tycheck.disallowExterns ()
 

-       val () = ifReal Domain.resetGlobal
+       val () = ifReal (fn () =>
+                           (ignore (OS.Process.system ("rm -rf " ^ Config.oldResultRoot ^ "/*"));
+                            ignore (OS.Process.system ("cp -r " ^ Config.resultRoot
+                                                       ^ "/* " ^ Config.oldResultRoot ^ "/"));
+                            Domain.resetGlobal ()))

 
        val ok = ref true
  
 
        val ok = ref true
  


@@ -979,7 +1034,22 @@ fun regenerateEither tc checker context =
        ifReal (fn () => (app contactNode Config.nodeIps;
                          Env.pre ()));
        app doUser (Acl.users ());
        ifReal (fn () => (app contactNode Config.nodeIps;
                          Env.pre ()));
        app doUser (Acl.users ());

-       ifReal Env.post;
+       ifReal (fn () =>
+                  let
+                      val domainsAfter = domainList Config.resultRoot
+                      val domainsGone = SS.difference (domainsBefore, domainsAfter)
+                  in
+                      if SS.isEmpty domainsGone then
+                          ()
+                      else
+                          (print "Domains to kill:";
+                           SS.app (fn s => (print " "; print s)) domainsGone;
+                           print "\n";
+
+                           Domain.rmdom' Config.oldResultRoot (SS.listItems domainsGone));
+                      
+                      Env.post ()
+                  end);

        !ok
     end
 
        !ok
     end
 

diff --git a/src/msg.sml b/src/msg.sml
index 5940bbe..a8450dd 100644 (file)
--- a/src/msg.sml
+++ b/src/msg.sml
@@ -23,12 +23,14 @@ structure Msg :> MSG = struct
 open OpenSSL MsgTypes Slave
 
 val a2i = fn Add => 0
 open OpenSSL MsgTypes Slave
 
 val a2i = fn Add => 0

-          | Delete => 1
+          | Delete true => 1

           | Modify => 2
           | Modify => 2

+          | Delete false => 3

 
 val i2a = fn 0 => Add
 
 val i2a = fn 0 => Add

-          | 1 => Delete
+          | 1 => Delete true

           | 2 => Modify
           | 2 => Modify

+          | 3 => Delete false

           | _ => raise OpenSSL.OpenSSL "Bad action number to deserialize"
 
 fun sendAcl (bio, {user, class, value}) =
           | _ => raise OpenSSL.OpenSSL "Bad action number to deserialize"
 
 fun sendAcl (bio, {user, class, value}) =

diff --git a/src/plugins/apache.sml b/src/plugins/apache.sml
index 4e07e4e..765d696 100644 (file)
--- a/src/plugins/apache.sml
+++ b/src/plugins/apache.sml
@@ -259,7 +259,7 @@ val () = Slave.registerFileHandler (fn fs =>
                                                   val oldUser = findVhostUser realVhostFile
                                               in
                                                   if (oldUser = NONE andalso #action fs <> Slave.Add)
                                                   val oldUser = findVhostUser realVhostFile
                                               in
                                                   if (oldUser = NONE andalso #action fs <> Slave.Add)

-                                                     orelse (user = NONE andalso #action fs <> Slave.Delete) then
+                                                     orelse (user = NONE andalso not (Slave.isDelete (#action fs))) then

                                                       print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "!  Taking no action.\n")
                                                   else
                                                       let
                                                       print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "!  Taking no action.\n")
                                                   else
                                                       let


@@ -281,7 +281,7 @@ val () = Slave.registerFileHandler (fn fs =>
                                                       in
                                                           vhostsChanged := true;
                                                           case #action fs of
                                                       in
                                                           vhostsChanged := true;
                                                           case #action fs of

-                                                              Slave.Delete =>
+                                                              Slave.Delete _ =>

                                                               let
                                                                   val ldir = realLogDir oldUser
                                                               in
                                                               let
                                                                   val ldir = realLogDir oldUser
                                                               in

diff --git a/src/plugins/bind.sml b/src/plugins/bind.sml
index 46ecbc3..f08367e 100644 (file)
--- a/src/plugins/bind.sml
+++ b/src/plugins/bind.sml
@@ -163,7 +163,7 @@ val () = Slave.registerFileHandler (fn fs =>
                                           fun dnsChanged () =
                                               if #domain fs = !didDomain then
                                                   ()
                                           fun dnsChanged () =
                                               if #domain fs = !didDomain then
                                                   ()

-                                              else if #action fs = Slave.Delete then
+                                              else if Slave.isDelete (#action fs) then

                                                   let
                                                       val fname = OS.Path.joinBaseExt {base = #domain fs,
                                                                                        ext = SOME "zone"}
                                                   let
                                                       val fname = OS.Path.joinBaseExt {base = #domain fs,
                                                                                        ext = SOME "zone"}

diff --git a/src/plugins/webalizer.sml b/src/plugins/webalizer.sml
index 034e043..416460d 100644 (file)
--- a/src/plugins/webalizer.sml
+++ b/src/plugins/webalizer.sml
@@ -77,7 +77,7 @@ val () = Slave.registerFileHandler (fn fs =>
                                                                           file = base}
                                               in
                                                   case #action fs of
                                                                           file = base}
                                               in
                                                   case #action fs of

-                                                      Slave.Delete =>
+                                                      Slave.Delete _ =>

                                                       (ignore (OS.Process.system (Config.rm
                                                                                   ^ " -f "
                                                                                   ^ Config.Webalizer.configDir
                                                       (ignore (OS.Process.system (Config.rm
                                                                                   ^ " -f "
                                                                                   ^ Config.Webalizer.configDir

diff --git a/src/slave.sig b/src/slave.sig
index 9ca0638..c413a07 100644 (file)
--- a/src/slave.sig
+++ b/src/slave.sig
@@ -22,9 +22,11 @@ signature SLAVE = sig
 
     datatype file_action =
             Add
 
     datatype file_action =
             Add

-          | Delete
+          | Delete of bool (* Set to true to really delete the file *)

           | Modify
 
           | Modify
 

+    val isDelete : file_action -> bool
+

     type file_status = {action : file_action,
                        domain : string,
                        dir : string,
     type file_status = {action : file_action,
                        domain : string,
                        dir : string,

diff --git a/src/slave.sml b/src/slave.sml
index 3262b52..01d872c 100644 (file)
--- a/src/slave.sml
+++ b/src/slave.sml
@@ -22,9 +22,12 @@ structure Slave :> SLAVE = struct
 
 datatype file_action =
         Add
 
 datatype file_action =
         Add

-       | Delete
+       | Delete of bool

        | Modify
 
        | Modify
 

+fun isDelete (Delete _) = true
+  | isDelete _ = false
+

 type file_status = {action : file_action,
                    domain : string,
                    dir : string,
 type file_status = {action : file_action,
                    domain : string,
                    dir : string,


@@ -58,10 +61,13 @@ fun registerPostHandler handler =
 fun handleChanges fs = (!preHandler ();
                        app (fn recd as {action, file, ...} =>
                                (!fileHandler recd;
 fun handleChanges fs = (!preHandler ();
                        app (fn recd as {action, file, ...} =>
                                (!fileHandler recd;

-                                if action = Delete andalso Posix.FileSys.access (file, []) then
-                                    OS.FileSys.remove file
-                                else
-                                    ())) fs;
+                                case action of
+                                    Delete b =>
+                                    if b 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))
                        !postHandler ())
 
 fun shell ss = OS.Process.isSuccess (OS.Process.system (String.concat ss))