Catch-all aliases working again
[hcoop/domtool2.git] / src / domain.sml
index 064aa3e..94eb077 100644 (file)
@@ -48,8 +48,11 @@ fun your_groups () = !your_grps
 val your_pths = ref SS.empty
 fun your_paths () = !your_pths
 
+val your_ipss = ref SS.empty
+fun your_ips () = !your_ipss
+
 val world_readable = SS.addList (SS.empty, Config.worldReadable)
-val readable_pths = ref SS.empty
+val readable_pths = ref world_readable
 fun readable_paths () = !readable_pths
 
 fun setUser user =
@@ -66,7 +69,9 @@ fun setUser user =
        your_grps := Acl.class {user = getUser (),
                                class = "group"};
        your_pths := your_paths;
-       readable_pths := SS.union (your_paths, world_readable)
+       readable_pths := SS.union (your_paths, world_readable);
+       your_ipss := Acl.class {user = getUser (),
+                               class = "ip"}
     end
 
 fun validIp s =
@@ -97,6 +102,7 @@ fun checkPath paths path =
     andalso SS.exists (fn s' => path = s' orelse String.isPrefix (s' ^ "/") path) (paths ())
 val yourPath = checkPath your_paths
 val readablePath = checkPath readable_paths
+fun yourIp s = SS.member (your_ips (), s)
 
 fun yourDomainHost s =
     yourDomain s
@@ -131,7 +137,7 @@ val _ = Env.type_one "no_spaces"
 val _ = Env.type_one "no_newlines"
                     Env.string
                     (CharVector.all (fn ch => Char.isPrint ch andalso ch <> #"\n" andalso ch <> #"\r"
-                                              andalso ch <> #"\"" andalso ch <> #"'"))
+                                              andalso ch <> #"\""))
 
 val _ = Env.type_one "ip"
        Env.string
@@ -177,10 +183,18 @@ val _ = Env.type_one "readable_path"
        Env.string
        readablePath
 
+val _ = Env.type_one "your_ip"
+       Env.string
+       yourIp
+
 val _ = Env.type_one "node"
        Env.string
        validNode
 
+val _ = Env.registerFunction ("your_ip_to_ip",
+                             fn [e] => SOME e
+                              | _ => NONE)
+
 val _ = Env.registerFunction ("dns_node_to_node",
                              fn [e] => SOME e
                               | _ => NONE)
@@ -188,10 +202,22 @@ val _ = Env.registerFunction ("dns_node_to_node",
 val _ = Env.registerFunction ("mail_node_to_node",
                              fn [e] => SOME e
                               | _ => NONE)
+
+
 open Ast
 
 val dl = ErrorMsg.dummyLoc
 
+val _ = Env.registerFunction ("end_in_slash",
+                             fn [(EString "", _)] => SOME (EString "/", dl)
+                              | [(EString s, _)] =>
+                                SOME (EString (if String.sub (s, size s - 1) = #"/" then
+                                                   s
+                                               else
+                                                   s ^ "/"), dl)
+                              | _ => NONE)
+
+
 val nsD = (EString Config.defaultNs, dl)
 val serialD = (EVar "serialAuto", dl)
 val refD = (EInt Config.defaultRefresh, dl)
@@ -403,7 +429,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 +457,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 real) prefixes then
                        loopReal ((site, dom, realPath, Delete' real) :: acts)
+                   else
+                       loopReal acts
                end
 
        val acts = loopReal acts
@@ -463,7 +491,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 +523,7 @@ fun findAllDiffs () =
                                                                                        file = name}
                                                  in
                                                      explore (dname',
-                                                              findDiffs (site, dom, diffs))
+                                                              findDiffs (prefixes, site, dom, diffs))
                                                  end
                                              else
                                                  diffs)
@@ -516,10 +544,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 +640,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 +685,18 @@ fun handleSite (site, files) =
 
 val () = Env.registerPost (fn () =>
                              let
-                                 val diffs = findAllDiffs ()
+                                 val prefixes = List.concat
+                                                    (List.map (fn dom =>
+                                                                  let
+                                                                      val pieces = String.tokens (fn ch => ch = #".") dom
+                                                                      val path = String.concatWith "/" (rev pieces)
+                                                                  in
+                                                                      List.map (fn node =>
+                                                                                   Config.resultRoot ^ "/" ^ node ^ "/" ^ path ^ "/")
+                                                                               nodes
+                                                                  end) (!seenDomains))
+                                                                 
+                                 val diffs = findAllDiffs prefixes
 
                                  val diffs = map (fn (site, dom, dir, Add' {src, dst}) =>
                                                      (Slave.shellF ([Config.cp, " ", src, " ", dst],
@@ -744,11 +788,10 @@ fun rmdom' delete resultRoot doms =
                                                                fnameFull,
                                                                actions))
                                            else                        
-                                               (print ("Kill " ^ fnameFull ^ "\n");
                                                 loop ({action = Slave.Delete delete,
                                                        domain = dom,
                                                        dir = dname,
-                                                       file = fnameFull} :: actions))
+                                                       file = fnameFull} :: actions)
                                        end
                            in
                                loop actions
@@ -863,7 +906,7 @@ fun considerAll ds {node, domain} =
                                     case d of
                                         Filename {filename, heading, showEmpty} =>
                                         if fname = filename then
-                                            entries := readFile showEmpty ("\n" :: line :: ":\n" :: heading :: line :: !entries)
+                                            entries := readFile showEmpty ("\n" :: line :: "\n" :: heading :: line :: !entries)
                                         else
                                             ()
                                       | Extension {extension, heading} =>
@@ -874,7 +917,7 @@ fun considerAll ds {node, domain} =
                                                 NONE => ()
                                               | SOME extension' =>
                                                 if extension' = extension then
-                                                    entries := readFile true ("\n" :: line :: ":\n" :: heading base :: line :: !entries)
+                                                    entries := readFile true ("\n" :: line :: "\n" :: heading base :: line :: !entries)
                                                 else
                                                     ()
                                         end
@@ -890,7 +933,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