Mailman shortcut working
[hcoop/domtool2.git] / src / domain.sml
index 67ff449..ebd7a2b 100644 (file)
@@ -403,7 +403,7 @@ datatype file_action' =
        | Delete' of string
        | Modify' of {src : string, dst : string}
 
-fun findDiffs (site, dom, acts) =
+fun findDiffs (prefixes, site, dom, acts) =
     let
        val gp = getPath dom
        val realPath = gp (Config.resultRoot, site)
@@ -431,8 +431,10 @@ fun findDiffs (site, dom, acts) =
                            loopReal acts
                        else
                            loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)
-                   else
+                   else if List.exists (fn prefix => String.isPrefix prefix realPath) prefixes then
                        loopReal ((site, dom, realPath, Delete' real) :: acts)
+                   else
+                       loopReal acts
                end
 
        val acts = loopReal acts
@@ -463,7 +465,7 @@ fun findDiffs (site, dom, acts) =
        acts
     end
 
-fun findAllDiffs () =
+fun findAllDiffs prefixes =
     let
        val dir = Posix.FileSys.opendir Config.tmpDir
        val len = length (String.fields (fn ch => ch = #"/") Config.tmpDir) + 1
@@ -495,7 +497,7 @@ fun findAllDiffs () =
                                                                                        file = name}
                                                  in
                                                      explore (dname',
-                                                              findDiffs (site, dom, diffs))
+                                                              findDiffs (prefixes, site, dom, diffs))
                                                  end
                                              else
                                                  diffs)
@@ -516,10 +518,14 @@ fun findAllDiffs () =
 val masterNode : string option ref = ref NONE
 fun dnsMaster () = !masterNode
 
+val seenDomains : string list ref = ref []
+
 val _ = Env.containerV_one "domain"
                           ("domain", Env.string)
                           (fn (evs, dom) =>
                               let
+                                  val () = seenDomains := dom :: !seenDomains
+
                                   val kind = Env.env dnsKind (evs, "DNS")
                                   val ttl = Env.env Env.int (evs, "TTL")
                                   val aliases = Env.env (Env.list Env.string) (evs, "Aliases")
@@ -608,7 +614,8 @@ val _ = Env.containerV_one "domain"
                               end,
                            fn () => !afters (!current))
 
-val () = Env.registerPre (fn () => (ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
+val () = Env.registerPre (fn () => (seenDomains := [];
+                                   ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
                                                       fn cl => "Temp file cleanup failed: " ^ cl));
                                    OS.FileSys.mkDir Config.tmpDir;
                                    app (fn node => OS.FileSys.mkDir
@@ -652,7 +659,15 @@ fun handleSite (site, files) =
 
 val () = Env.registerPost (fn () =>
                              let
-                                 val diffs = findAllDiffs ()
+                                 val prefixes = List.map (fn dom =>
+                                                             let
+                                                                 val pieces = String.tokens (fn ch => ch = #".") dom
+                                                                 val path = String.concatWith "/" (rev pieces)
+                                                             in
+                                                                 Config.resultRoot ^ "/" ^ path ^ "/"
+                                                             end) (!seenDomains)
+                                                                 
+                                 val diffs = findAllDiffs prefixes
 
                                  val diffs = map (fn (site, dom, dir, Add' {src, dst}) =>
                                                      (Slave.shellF ([Config.cp, " ", src, " ", dst],
@@ -667,7 +682,7 @@ val () = Env.registerPost (fn () =>
                                                       handle OS.SysErr _ =>
                                                              ErrorMsg.error NONE ("Delete failed for " ^ dst);
                                                       (site,
-                                                       {action = Slave.Delete,
+                                                       {action = Slave.Delete true,
                                                         domain = dom,
                                                         dir = dir,
                                                         file = dst}))
@@ -715,11 +730,11 @@ val _ = Env.type_one "mail_node"
            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
-               val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
+               val dname = OS.Path.joinDirFile {dir = resultRoot,
                                                 file = node}
 
                fun doDom (dom, actions) =
@@ -743,18 +758,18 @@ fun rmdom doms =
                                                loop (visitDom (fname ^ "." ^ dom,
                                                                fnameFull,
                                                                actions))
-                                           else                                                        
-                                               loop ({action = Slave.Delete,
-                                                      domain = dom,
-                                                      dir = dname,
-                                                      file = fnameFull} :: actions)
+                                           else                        
+                                                loop ({action = Slave.Delete 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 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)
@@ -771,11 +786,14 @@ fun rmdom doms =
                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
-                       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
@@ -785,6 +803,9 @@ fun rmdom doms =
        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)
 
@@ -796,10 +817,10 @@ val describers : (subject -> string) list ref = ref []
 
 fun registerDescriber f = describers := f :: !describers
 
-fun describeOne arg = String.concat (map (fn f => f arg) (!describers))
+fun describeOne arg = String.concat (map (fn f => f arg) (rev (!describers)))
 
-val line = "-------------------------------\n"
-val dline = "===============================\n"
+val line = "--------------------------------------------------------------\n"
+val dline = "==============================================================\n"
 
 fun describe dom =
     String.concat (List.mapPartial
@@ -811,7 +832,7 @@ fun describe dom =
                       nodes)
 
 datatype description =
-        Filename of { filename : string, heading : string}
+        Filename of { filename : string, heading : string, showEmpty : bool }
        | Extension of { extension : string, heading : string -> string }
                        
 fun considerAll ds {node, domain} =
@@ -832,44 +853,47 @@ fun considerAll ds {node, domain} =
                    case Posix.FileSys.readdir dir of
                        NONE => ()
                      | SOME fname =>
-                       let
-                           fun readFile entries =
-                               let
-                                   val fname = OS.Path.joinDirFile {dir = path,
-                                                                    file = fname}
-
-                                   val inf = TextIO.openIn fname
-
-                                   fun loop entries =
-                                       case TextIO.inputLine inf of
-                                           NONE => entries
-                                         | SOME line => loop (line :: entries)
-                               in
-                                   loop entries
-                                   before TextIO.closeIn inf
-                               end
-                       in
-                           app (fn (d, entries) =>
-                                   case d of
-                                       Filename {filename, heading} =>
-                                       if fname = filename then
-                                           entries := "\n" :: readFile ("\n" :: line :: ":\n" :: heading :: line :: !entries)
-                                       else
-                                           ()
-                                     | Extension {extension, heading} =>
-                                       let
-                                           val {base, ext} = OS.Path.splitBaseExt fname
-                                       in
-                                           case ext of
-                                               NONE => ()
-                                             | SOME extension' =>
-                                               if extension' = extension then
-                                                   entries := "\n" :: readFile ("\n" :: line :: ":\n" :: heading base :: line :: !entries)
-                                               else
-                                                   ()
-                                       end) ds;
-                           loop ()
-                       end
+                       (app (fn (d, entries) =>
+                                let
+                                    fun readFile showEmpty entries' =
+                                        let
+                                            val fname = OS.Path.joinDirFile {dir = path,
+                                                                             file = fname}
+
+                                            val inf = TextIO.openIn fname
+
+                                            fun loop (seenOne, entries') =
+                                                case TextIO.inputLine inf of
+                                                    NONE => if seenOne orelse showEmpty then
+                                                                "\n" :: entries'
+                                                            else
+                                                                !entries
+                                                  | SOME line => loop (true, line :: entries')
+                                        in
+                                            loop (false, entries')
+                                            before TextIO.closeIn inf
+                                        end
+                                in
+                                    case d of
+                                        Filename {filename, heading, showEmpty} =>
+                                        if fname = filename then
+                                            entries := readFile showEmpty ("\n" :: line :: ":\n" :: heading :: line :: !entries)
+                                        else
+                                            ()
+                                      | Extension {extension, heading} =>
+                                        let
+                                            val {base, ext} = OS.Path.splitBaseExt fname
+                                        in
+                                            case ext of
+                                                NONE => ()
+                                              | SOME extension' =>
+                                                if extension' = extension then
+                                                    entries := readFile true ("\n" :: line :: ":\n" :: heading base :: line :: !entries)
+                                                else
+                                                    ()
+                                        end
+                                end) ds;
+                        loop ())
            in
                loop ();
                Posix.FileSys.closedir dir;
@@ -880,6 +904,13 @@ fun considerAll ds {node, domain} =
     end
 
 val () = registerDescriber (considerAll [Filename {filename = "soa",
-                                                  heading = "DNS SOA"}])
+                                                  heading = "DNS SOA",
+                                                  showEmpty = false}])
+
+val () = Env.registerAction ("domainHost",
+                            fn (env, [(EString host, _)]) =>
+                               SM.insert (env, "Hostname",
+                                          (EString (host ^ "." ^ currentDomain ()), dl))
+                             | (_, args) => Env.badArgs ("domainHost", args))
 
 end