+datatype file_action' =
+ Add' of {src : string, dst : string}
+ | Delete' of string
+ | Modify' of {src : string, dst : string}
+
+fun findDiffs dom =
+ let
+ val realPath = getPath dom Config.resultRoot
+ val tmpPath = !currentPath
+
+ val dir = Posix.FileSys.opendir realPath
+
+ fun loopReal acts =
+ case Posix.FileSys.readdir dir of
+ NONE => (Posix.FileSys.closedir dir;
+ acts)
+ | SOME fname =>
+ let
+ val real = OS.Path.joinDirFile {dir = realPath,
+ file = fname}
+ val tmp = OS.Path.joinDirFile {dir = tmpPath,
+ file = fname}
+ in
+ if Posix.FileSys.ST.isDir (Posix.FileSys.stat real) then
+ loopReal acts
+ else if Posix.FileSys.access (tmp, []) then
+ if Slave.shell [Config.diff, " ", real, " ", tmp] then
+ loopReal acts
+ else
+ loopReal (Modify' {src = tmp, dst = real} :: acts)
+ else
+ loopReal (Delete' real :: acts)
+ end
+
+ val acts = loopReal []
+
+ val dir = Posix.FileSys.opendir tmpPath
+
+ fun loopTmp acts =
+ case Posix.FileSys.readdir dir of
+ NONE => (Posix.FileSys.closedir dir;
+ acts)
+ | SOME fname =>
+ let
+ val real = OS.Path.joinDirFile {dir = realPath,
+ file = fname}
+ val tmp = OS.Path.joinDirFile {dir = tmpPath,
+ file = fname}
+ in
+ if Posix.FileSys.ST.isDir (Posix.FileSys.stat tmp) then
+ loopTmp acts
+ else if Posix.FileSys.access (real, []) then
+ loopTmp acts
+ else
+ loopTmp (Add' {src = tmp, dst = real} :: acts)
+ end
+
+ val acts = loopTmp acts
+ in
+ acts
+ end
+
+val _ = Env.containerV_one "domain"
+ ("domain", Env.string)
+ (fn (evs, dom) =>
+ let
+ val kind = Env.env dnsKind (evs, "DNS")
+ val ttl = Env.env Env.int (evs, "TTL")
+
+ val path = getPath dom Config.tmpDir
+
+ val () = (current := dom;
+ currentPath := path;
+ !befores dom)
+
+ fun saveSoa (kind, soa : soa) =
+ let
+ val outf = domainFile "soa"
+ in
+ TextIO.output (outf, kind);
+ TextIO.output (outf, "\n");
+ TextIO.output (outf, Int.toString ttl);
+ TextIO.output (outf, "\n");
+ TextIO.output (outf, #ns soa);
+ TextIO.output (outf, "\n");
+ case #serial soa of
+ NONE => ()
+ | SOME n => TextIO.output (outf, Int.toString n);
+ TextIO.output (outf, "\n");
+ TextIO.output (outf, Int.toString (#ref soa));
+ TextIO.output (outf, "\n");
+ TextIO.output (outf, Int.toString (#ret soa));
+ TextIO.output (outf, "\n");
+ TextIO.output (outf, Int.toString (#exp soa));
+ TextIO.output (outf, "\n");
+ TextIO.output (outf, Int.toString (#min soa));
+ TextIO.output (outf, "\n");
+ TextIO.closeOut outf
+ end
+
+ fun saveNamed (kind, soa : soa) =
+ let
+ val outf = domainFile "named.conf"
+ in
+ TextIO.output (outf, "\nzone \"");
+ TextIO.output (outf, dom);
+ TextIO.output (outf, "\" IN {\n\ttype ");
+ TextIO.output (outf, kind);
+ TextIO.output (outf, ";\n\tfile \"");
+ TextIO.output (outf, Config.Bind.zonePath);
+ TextIO.output (outf, "/");
+ TextIO.output (outf, dom);
+ TextIO.output (outf, ".zone\";\n");
+ case kind of
+ "master" => TextIO.output (outf, "\tallow-update { none; };\n")
+ | _ => TextIO.output (outf, "\tmasters { 1.2.3.4; };\n");
+ TextIO.output (outf, "}\n");
+ TextIO.closeOut outf
+ end
+
+ fun saveBoth ks = (saveSoa ks; saveNamed ks)
+ in
+ case kind of
+ NoDns => ()
+ | Master soa => saveBoth ("master", soa)
+ | Slave soa => saveBoth ("slave", soa)
+ end,
+ fn () =>
+ let
+ val dom = !current
+ val () = !afters dom
+
+ val diffs = findDiffs dom
+
+ val dir = getPath dom Config.resultRoot
+
+ val diffs = map (fn Add' {src, dst} =>
+ (Slave.shellF ([Config.cp, " ", src, " ", dst],
+ fn cl => "Copy failed: " ^ cl);
+ {action = Slave.Add,
+ domain = dom,
+ dir = dir,
+ file = dst})
+ | Delete' dst =>
+ (OS.FileSys.remove dst
+ handle OS.SysErr _ =>
+ ErrorMsg.error NONE ("Delete failed for " ^ dst);
+ {action = Slave.Delete,
+ domain = dom,
+ dir = dir,
+ file = dst})
+ | Modify' {src, dst} =>
+ (Slave.shellF ([Config.cp, " ", src, " ", dst],
+ fn cl => "Copy failed: " ^ cl);
+ {action = Slave.Modify,
+ domain = dom,
+ dir = dir,
+ file = dst})) diffs
+ in
+ if !ErrorMsg.anyErrors then
+ ()
+ else
+ Slave.handleChanges diffs;
+ ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, "/*"],
+ fn cl => "Temp file cleanup failed: " ^ cl))
+ end)
+
+