Mailman shortcut working

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

diff --git a/src/domain.sml b/src/domain.sml
index 8df5413..ebd7a2b 100644 (file)
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -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],
@@ -892,4 +907,10 @@ val () = registerDescriber (considerAll [Filename {filename = "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