Added concept of multiple nodes

diff --git a/configDefault/domtool.cfg b/configDefault/domtool.cfg
index 4ea0478..20e133f 100644 (file)
--- a/configDefault/domtool.cfg
+++ b/configDefault/domtool.cfg
@@ -1,6 +1,6 @@
 val libRoot = "/home/adamc/cvs/domtool2/lib"
 val resultRoot = "/home/adamc/domtool"
 val libRoot = "/home/adamc/cvs/domtool2/lib"
 val resultRoot = "/home/adamc/domtool"

-val tmpDir = "/tmp"
+val tmpDir = "/tmp/domtool"

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


@@ -13,3 +13,6 @@ val defaultRefresh = 172800
 val defaultRetry = 900
 val defaultExpiry = 1209600
 val defaultMinimum = 3600
 val defaultRetry = 900
 val defaultExpiry = 1209600
 val defaultMinimum = 3600

+
+val nodes = ["this"]
+val defaultNode = "this"

diff --git a/configDefault/domtool.cfs b/configDefault/domtool.cfs
index 87c679e..e7f04aa 100644 (file)
--- a/configDefault/domtool.cfs
+++ b/configDefault/domtool.cfs
@@ -20,3 +20,7 @@ val defaultRefresh : int
 val defaultRetry : int
 val defaultExpiry : int
 val defaultMinimum : int
 val defaultRetry : int
 val defaultExpiry : int
 val defaultMinimum : int

+
+(* Names of machines who will receive configuration *)
+val nodes : string list
+val defaultNode : string

diff --git a/configDefault/exim.cfg b/configDefault/exim.cfg
index 2a537be..26939fd 100644 (file)
--- a/configDefault/exim.cfg
+++ b/configDefault/exim.cfg
@@ -8,4 +8,6 @@ val reload = "echo \"I would reload exim now.\""
 
 val handleDomains = "/home/adamc/fake/mail"
 
 
 val handleDomains = "/home/adamc/fake/mail"
 

+val aliasTo = ["this"]
+

 end
 end

diff --git a/configDefault/exim.csg b/configDefault/exim.csg
index 20c0e44..e666016 100644 (file)
--- a/configDefault/exim.csg
+++ b/configDefault/exim.csg
@@ -11,4 +11,7 @@ val reload : string
 val handleDomains : string
 (* File to which to write a comma-separate list of domains to handle mail for *)
 
 val handleDomains : string
 (* File to which to write a comma-separate list of domains to handle mail for *)
 

+val aliasTo : string list
+(* Default nodes to which alias directives are applied *)
+

 end
 end

diff --git a/lib/alias.dtl b/lib/alias.dtl
index c591aaf..b7ccae4 100644 (file)
--- a/lib/alias.dtl
+++ b/lib/alias.dtl
@@ -28,8 +28,9 @@ extern val addressesTarget : [email] -> aliasTarget;
 extern val dropTarget : aliasTarget;
 {{Silently delete all mail to the associated source.}}
 
 extern val dropTarget : aliasTarget;
 {{Silently delete all mail to the associated source.}}
 

-extern val aliasPrim : aliasSource -> aliasTarget -> [Domain];
-{{Request redirection of all mail from the source to the target.}}
+extern val aliasPrim : aliasSource -> aliasTarget -> [Domain] {MailNodes: [node]};
+{{Request redirection of all mail from the source to the target, specifying on
+  which nodes this redirection should be applied.}}

 
 val alias = \user -> \email -> aliasPrim (userSource user) (addressTarget email);
 {{Redirect mail for the user at the current domain to the e-mail address.}}
 
 val alias = \user -> \email -> aliasPrim (userSource user) (addressTarget email);
 {{Redirect mail for the user at the current domain to the e-mail address.}}

diff --git a/lib/domain.dtl b/lib/domain.dtl
index 8edfa72..0f2b1fa 100644 (file)
--- a/lib/domain.dtl
+++ b/lib/domain.dtl
@@ -9,6 +9,9 @@ extern type host;
 extern type domain;
 {{An Internet domain name}}
 
 extern type domain;
 {{An Internet domain name}}
 

+extern type node;
+{{The name of a server controlled by domtool}}
+

 context Domain;
 {{Configuration directives specific to an Internet domain}}
 
 context Domain;
 {{Configuration directives specific to an Internet domain}}
 


@@ -23,11 +26,20 @@ extern type soa;
 {{DNS start-of-authority record}}
 extern val soa : domain -> serial -> int -> int -> int -> int -> soa;
 
 {{DNS start-of-authority record}}
 extern val soa : domain -> serial -> int -> int -> int -> int -> soa;
 

+extern type master;
+{{Information on the master DNS server for a domain}}
+extern val externalMaster : ip -> master;
+{{A server not controlled by domtool will serve as master.}}
+extern val internalMaster : node -> master;
+{{A server controlled by domtool will serve as master.}}
+

 extern type dnsKind;
 {{How should DNS for this domain be handled?}}
 extern type dnsKind;
 {{How should DNS for this domain be handled?}}

-extern val master : soa -> dnsKind;
-extern val slave : soa -> dnsKind;
+extern val useDns : soa -> master -> [node] -> dnsKind;
+{{We do want DNS services for this domain. Specify the SOA record, information
+  on the server in charge of zone data, and a list of slave servers.}}

 extern val noDns : dnsKind;
 extern val noDns : dnsKind;

+{{No DNS services for this domain.}}

 
 extern val domain : domain -> Domain => [Root] {DNS : dnsKind, TTL : int};
 {{Configure a domain to which you have access rights.}}
 
 extern val domain : domain -> Domain => [Root] {DNS : dnsKind, TTL : int};
 {{Configure a domain to which you have access rights.}}

diff --git a/lib/exim.dtl b/lib/exim.dtl
index 1152aef..feb320e 100644 (file)
--- a/lib/exim.dtl
+++ b/lib/exim.dtl
@@ -1,4 +1,4 @@
 {{Exim MTA configuration}}
 
 {{Exim MTA configuration}}
 

-extern val handleMail : [Domain];
-{{The local server should handle mail for this domain.}}
+extern val handleMail : [Domain] {MailNodes: [node]};
+{{The specified nodes should handle mail for this domain.}}

diff --git a/src/domain.sig b/src/domain.sig
index 8c79274..c2ebb95 100644 (file)
--- a/src/domain.sig
+++ b/src/domain.sig
@@ -31,7 +31,11 @@ signature DOMAIN = sig
 
     val currentDomain : unit -> string
 
 
     val currentDomain : unit -> string
 

-    val domainFile : string -> TextIO.outstream
-    (* Open one of the current domain's configuration files. *)
+    val domainFile : {node : string, name : string} -> TextIO.outstream
+    (* Open one of the current domain's configuration files for a particular
+     * node. *)

 
 

+    val dnsMaster : unit -> string option
+    (* Name of the node that is the DNS master for the current domain, if there
+     * is one *)

 end
 end

diff --git a/src/domain.sml b/src/domain.sml
index 6b645cb..d2dfbde 100644 (file)
--- a/src/domain.sml
+++ b/src/domain.sml
@@ -36,6 +36,8 @@ fun validDomain s =
     size s > 0 andalso size s < 100
     andalso List.all validHost (String.fields (fn ch => ch = #".") s)
 
     size s > 0 andalso size s < 100
     andalso List.all validHost (String.fields (fn ch => ch = #".") s)
 

+fun validNode s = List.exists (fn s' => s = s') Config.nodes
+

 val _ = Env.type_one "ip"
        Env.string
        validIp
 val _ = Env.type_one "ip"
        Env.string
        validIp


@@ -48,6 +50,10 @@ val _ = Env.type_one "domain"
        Env.string
        validDomain
 
        Env.string
        validDomain
 

+val _ = Env.type_one "node"
+       Env.string
+       validNode
+

 open Ast
 
 val dl = ErrorMsg.dummyLoc
 open Ast
 
 val dl = ErrorMsg.dummyLoc


@@ -63,10 +69,15 @@ val soaD = multiApp ((EVar "soa", dl),
                     dl,
                     [nsD, serialD, refD, retD, expD, minD])
 
                     dl,
                     [nsD, serialD, refD, retD, expD, minD])
 

+val masterD = (EApp ((EVar "internalMaster", dl),
+                    (EString Config.defaultNode, dl)),
+              dl)
+

 val _ = Main.registerDefault ("DNS",
                              (TBase "dnsKind", dl),
 val _ = Main.registerDefault ("DNS",
                              (TBase "dnsKind", dl),

-                             (EApp ((EVar "master", dl),
-                                    soaD), dl))
+                             (multiApp ((EVar "useDns", dl),
+                                        dl,
+                                        [soaD, masterD, (EList [], dl)])))

 
 val _ = Main.registerDefault ("TTL",
                              (TBase "int", dl),
 
 val _ = Main.registerDefault ("TTL",
                              (TBase "int", dl),


@@ -103,14 +114,30 @@ val soa = fn (EApp ((EApp ((EApp ((EApp ((EApp ((EApp
                | _ => NONE)
           | _ => NONE
 
                | _ => NONE)
           | _ => NONE
 

+datatype master =
+        ExternalMaster of string
+       | InternalMaster of string
+
+val master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (Env.string e)
+             | (EApp ((EVar "internalMaster", _), e), _) => Option.map InternalMaster (Env.string e)
+             | _ => NONE
+

 datatype dnsKind =
 datatype dnsKind =

-        Master of soa
-       | Slave of soa
+        UseDns of {soa : soa,
+                   master : master,
+                   slaves : string list}

        | NoDns
 
        | NoDns
 

-val dnsKind = fn (EApp ((EVar "master", _), e), _) => Option.map Master (soa e)
-              | (EApp ((EVar "slave", _), e), _) => Option.map Slave (soa e)
-              | (EVar "noDns", _) => SOME NoDns
+val dnsKind = fn (EApp ((EApp ((EApp 
+                                   ((EVar "useDns", _), sa), _),
+                              mstr), _),
+                       slaves), _) =>
+                (case (soa sa, master mstr, Env.list Env.string slaves) of
+                     (SOME sa, SOME mstr, SOME slaves) =>
+                     SOME (UseDns {soa = sa,
+                                   master = mstr,
+                                   slaves = slaves})
+                   | _ => NONE)

               | _ => NONE
 
 val befores = ref (fn (_ : string) => ())
               | _ => NONE
 
 val befores = ref (fn (_ : string) => ())


@@ -131,13 +158,14 @@ fun registerAfter f =
     end
 
 val current = ref ""
     end
 
 val current = ref ""

-val currentPath = ref ""
+val currentPath = ref (fn (_ : string) => "")

 
 val scratch = ref ""
 
 fun currentDomain () = !current
 
 
 val scratch = ref ""
 
 fun currentDomain () = !current
 

-fun domainFile name = TextIO.openOut (!currentPath ^ name)
+fun domainFile {node, name} = ((*print ("Opening " ^ !currentPath node ^ name ^ "\n");*)
+                              TextIO.openOut (!currentPath node ^ name))

 
 fun getPath domain =
     let
 
 fun getPath domain =
     let


@@ -146,29 +174,36 @@ fun getPath domain =
        val elems = foldr (fn (piece, elems) =>
                              let
                                  val elems = piece :: elems
        val elems = foldr (fn (piece, elems) =>
                              let
                                  val elems = piece :: elems

-                                 val path = String.concatWith "/" (Config.resultRoot :: rev elems)
-                                 val tmpPath = String.concatWith "/" (Config.tmpDir :: rev elems)
-                             in
-                                 (if Posix.FileSys.ST.isDir
-                                         (Posix.FileSys.stat path) then
-                                      ()
-                                  else
-                                      (OS.FileSys.remove path;
-                                       OS.FileSys.mkDir path))
-                                 handle OS.SysErr _ => OS.FileSys.mkDir path;
-
-                                 (if Posix.FileSys.ST.isDir
-                                         (Posix.FileSys.stat tmpPath) then
-                                      ()
-                                  else
-                                      (OS.FileSys.remove tmpPath;
-                                       OS.FileSys.mkDir tmpPath))
-                                 handle OS.SysErr _ => OS.FileSys.mkDir tmpPath;

 
 

+                                 fun doNode node =
+                                     let
+                                         val path = String.concatWith "/"
+                                                                      (Config.resultRoot :: node :: rev elems)
+                                         val tmpPath = String.concatWith "/"
+                                                                         (Config.tmpDir :: node :: rev elems)
+                                     in
+                                         (if Posix.FileSys.ST.isDir
+                                                 (Posix.FileSys.stat path) then
+                                              ()
+                                          else
+                                              (OS.FileSys.remove path;
+                                               OS.FileSys.mkDir path))
+                                         handle OS.SysErr _ => OS.FileSys.mkDir path;
+
+                                         (if Posix.FileSys.ST.isDir
+                                                 (Posix.FileSys.stat tmpPath) then
+                                              ()
+                                          else
+                                              (OS.FileSys.remove tmpPath;
+                                               OS.FileSys.mkDir tmpPath))
+                                         handle OS.SysErr _ => OS.FileSys.mkDir tmpPath
+                                     end
+                             in
+                                 app doNode Config.nodes;

                                  elems
                              end) [] toks
     in
                                  elems
                              end) [] toks
     in

-       fn root => String.concatWith "/" (root :: rev ("" :: elems))
+       fn (root, site) => String.concatWith "/" (root :: site :: rev ("" :: elems))

     end
 
 datatype file_action' =
     end
 
 datatype file_action' =


@@ -176,10 +211,13 @@ datatype file_action' =
        | Delete' of string
        | Modify' of {src : string, dst : string}
 
        | Delete' of string
        | Modify' of {src : string, dst : string}
 

-fun findDiffs dom =
+fun findDiffs (site, dom, acts) =

     let
     let

-       val realPath = getPath dom Config.resultRoot
-       val tmpPath = !currentPath
+       val gp = getPath dom
+       val realPath = gp (Config.resultRoot, site)
+       val tmpPath = gp (Config.tmpDir, site)
+
+       (*val _ = print ("getDiffs(" ^ site ^ ", " ^ dom ^ ")... " ^ realPath ^ "; " ^ tmpPath ^ "\n")*)

 
        val dir = Posix.FileSys.opendir realPath
 
 
        val dir = Posix.FileSys.opendir realPath
 


@@ -200,12 +238,12 @@ fun findDiffs dom =
                        if Slave.shell [Config.diff, " ", real, " ",  tmp] then
                            loopReal acts
                        else
                        if Slave.shell [Config.diff, " ", real, " ",  tmp] then
                            loopReal acts
                        else

-                           loopReal (Modify' {src = tmp, dst = real} :: acts)
+                           loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)

                    else
                    else

-                       loopReal (Delete' real :: acts)
+                       loopReal ((site, dom, realPath, Delete' real) :: acts)

                end
 
                end
 

-       val acts = loopReal []
+       val acts = loopReal acts

 
        val dir = Posix.FileSys.opendir tmpPath
 
 
        val dir = Posix.FileSys.opendir tmpPath
 


@@ -225,7 +263,7 @@ fun findDiffs dom =
                    else if Posix.FileSys.access (real, []) then
                        loopTmp acts
                    else
                    else if Posix.FileSys.access (real, []) then
                        loopTmp acts
                    else

-                       loopTmp (Add' {src = tmp, dst = real} :: acts)
+                       loopTmp ((site, dom, realPath, Add' {src = tmp, dst = real}) :: acts)

                end
 
        val acts = loopTmp acts
                end
 
        val acts = loopTmp acts


@@ -233,6 +271,59 @@ fun findDiffs dom =
        acts
     end
 
        acts
     end
 

+fun findAllDiffs () =
+    let
+       val dir = Posix.FileSys.opendir Config.tmpDir
+       val len = length (String.fields (fn ch => ch = #"/") Config.tmpDir) + 1
+
+       fun exploreSites diffs =
+           case Posix.FileSys.readdir dir of
+               NONE => diffs
+             | SOME site =>
+               let
+                   fun explore (dname, diffs) =
+                       let
+                           val dir = Posix.FileSys.opendir dname
+
+                           fun loop diffs =
+                               case Posix.FileSys.readdir dir of
+                                   NONE => diffs
+                                 | SOME name =>
+                                   let
+                                       val fname = OS.Path.joinDirFile {dir = dname,
+                                                                        file = name}
+                                   in
+                                       loop (if Posix.FileSys.ST.isDir (Posix.FileSys.stat fname) then
+                                                 let
+                                                     val dom = String.fields (fn ch => ch = #"/") fname
+                                                     val dom = List.drop (dom, len)
+                                                     val dom = String.concatWith "." (rev dom)
+
+                                                     val dname' = OS.Path.joinDirFile {dir = dname,
+                                                                                       file = name}
+                                                 in
+                                                     explore (dname',
+                                                              findDiffs (site, dom, diffs))
+                                                 end
+                                             else
+                                                 diffs)
+                                   end
+                       in
+                           loop diffs
+                           before Posix.FileSys.closedir dir
+                       end
+               in
+                   explore (OS.Path.joinDirFile {dir = Config.tmpDir,
+                                                 file = site}, diffs)
+               end
+    in
+       exploreSites []
+       before Posix.FileSys.closedir dir
+    end
+
+val masterNode : string option ref = ref NONE
+fun dnsMaster () = !masterNode
+

 val _ = Env.containerV_one "domain"
                           ("domain", Env.string)
                           (fn (evs, dom) =>
 val _ = Env.containerV_one "domain"
                           ("domain", Env.string)
                           (fn (evs, dom) =>


@@ -240,15 +331,14 @@ val _ = Env.containerV_one "domain"
                                   val kind = Env.env dnsKind (evs, "DNS")
                                   val ttl = Env.env Env.int (evs, "TTL")
 
                                   val kind = Env.env dnsKind (evs, "DNS")
                                   val ttl = Env.env Env.int (evs, "TTL")
 

-                                  val path = getPath dom Config.tmpDir
+                                  val path = getPath dom

 
                                   val () = (current := dom;
 
                                   val () = (current := dom;

-                                            currentPath := path;
-                                            !befores dom)
+                                            currentPath := (fn site => path (Config.tmpDir, site)))

 
 

-                                  fun saveSoa (kind, soa : soa) =
+                                  fun saveSoa (kind, soa : soa) node =

                                       let
                                       let

-                                          val outf = domainFile "soa"
+                                          val outf = domainFile {node = node, name = "soa"}

                                       in
                                           TextIO.output (outf, kind);
                                           TextIO.output (outf, "\n");
                                       in
                                           TextIO.output (outf, kind);
                                           TextIO.output (outf, "\n");


@@ -271,9 +361,9 @@ val _ = Env.containerV_one "domain"
                                           TextIO.closeOut outf
                                       end
 
                                           TextIO.closeOut outf
                                       end
 

-                                  fun saveNamed (kind, soa : soa) =
+                                  fun saveNamed (kind, soa : soa) node =

                                       let
                                       let

-                                          val outf = domainFile "named.conf"
+                                          val outf = domainFile {node = node, name = "named.conf"}

                                       in
                                           TextIO.output (outf, "\nzone \"");
                                           TextIO.output (outf, dom);
                                       in
                                           TextIO.output (outf, "\nzone \"");
                                           TextIO.output (outf, dom);


@@ -294,49 +384,70 @@ val _ = Env.containerV_one "domain"
                                   fun saveBoth ks = (saveSoa ks; saveNamed ks)
                               in
                                   case kind of
                                   fun saveBoth ks = (saveSoa ks; saveNamed ks)
                               in
                                   case kind of

-                                      NoDns => ()
-                                    | Master soa => saveBoth ("master", soa)
-                                    | Slave soa => saveBoth ("slave", soa)
+                                      NoDns => masterNode := NONE
+                                    | UseDns dns =>
+                                      (app (saveSoa ("slave", #soa dns)) (#slaves dns);
+                                       app (saveNamed ("slave", #soa dns)) (#slaves dns);
+                                       case #master dns of
+                                           InternalMaster node =>
+                                           (masterNode := SOME node;
+                                            saveSoa ("master", #soa dns) node;
+                                            saveNamed ("master", #soa dns) node)
+                                         | _ => masterNode := NONE);
+                                  !befores dom

                               end,
                               end,

-                           fn () =>
-                              let
-                                  val dom = !current
-                                  val () = !afters dom
-
-                                  val diffs = findDiffs dom
-
-                                  val dir = getPath dom Config.resultRoot
+                           fn () => !afters (!current))
+
+val () = Env.registerPre (fn () => (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
+                                                       (OS.Path.joinDirFile {dir = Config.tmpDir,
+                                                                             file = node}))
+                                       Config.nodes;
+                                   app (fn node => OS.FileSys.mkDir
+                                                       (OS.Path.joinDirFile {dir = Config.resultRoot,
+                                                                             file = node})
+                                           handle OS.SysErr _ => ())
+                                       Config.nodes))
+
+val () = Env.registerPost (fn () =>
+                             let
+                                 val diffs = findAllDiffs ()

 
 

-                                  val diffs = map (fn Add' {src, dst} =>
-                                                      (Slave.shellF ([Config.cp, " ", src, " ", dst],
-                                                                  fn cl => "Copy failed: " ^ cl);
+                                 val diffs = map (fn (site, dom, dir, Add' {src, dst}) =>
+                                                     (Slave.shellF ([Config.cp, " ", src, " ", dst],
+                                                                 fn cl => "Copy failed: " ^ cl);
+                                                      (site,

                                                        {action = Slave.Add,
                                                         domain = dom,
                                                         dir = dir,
                                                        {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);
+                                                        file = dst}))
+                                                   | (site, dom, dir, Delete' dst) =>
+                                                     (OS.FileSys.remove dst
+                                                      handle OS.SysErr _ =>
+                                                             ErrorMsg.error NONE ("Delete failed for " ^ dst);
+                                                      (site,

                                                        {action = Slave.Delete,
                                                         domain = dom,
                                                         dir = dir,
                                                        {action = Slave.Delete,
                                                         domain = dom,
                                                         dir = dir,

-                                                        file = dst})
-                                                    | Modify' {src, dst} =>
-                                                      (Slave.shellF ([Config.cp, " ", src, " ", dst],
-                                                                  fn cl => "Copy failed: " ^ cl);
+                                                        file = dst}))
+                                                   | (site, dom, dir, Modify' {src, dst}) =>
+                                                     (Slave.shellF ([Config.cp, " ", src, " ", dst],
+                                                                 fn cl => "Copy failed: " ^ cl);
+                                                      (site,

                                                        {action = Slave.Modify,
                                                         domain = dom,
                                                         dir = dir,
                                                        {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)
+                                                        file = dst}))) diffs
+                             in
+                                 if !ErrorMsg.anyErrors then
+                                     ()
+                                 else
+                                     Slave.handleChanges (map #2 diffs);
+                                 ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
+                                                    fn cl => "Temp file cleanup failed: " ^ cl))
+                             end)

 
 
 
 
 
 

diff --git a/src/env.sig b/src/env.sig
index c196158..477af94 100644 (file)
--- a/src/env.sig
+++ b/src/env.sig
@@ -32,6 +32,12 @@ signature ENV = sig
     val registerContainer : string * action * (unit -> unit) -> unit
     val container : string -> (action * (unit -> unit)) option
 
     val registerContainer : string * action * (unit -> unit) -> unit
     val container : string -> (action * (unit -> unit)) option
 

+    (* Actions to take before and after evaluating a file *)
+    val registerPre : (unit -> unit) -> unit
+    val pre : unit -> unit
+    val registerPost : (unit -> unit) -> unit
+    val post : unit -> unit
+

     val badArgs : string * Ast.exp list -> 'a
     val badArg : string * string * Ast.exp -> 'a
 
     val badArgs : string * Ast.exp list -> 'a
     val badArg : string * string * Ast.exp -> 'a
 


@@ -46,6 +52,7 @@ signature ENV = sig
     val two : string -> string * 'a arg * string * 'b arg -> ('a * 'b -> unit) -> action
 
     val oneV : string -> string * 'a arg -> (env_vars * 'a -> unit) -> action
     val two : string -> string * 'a arg * string * 'b arg -> ('a * 'b -> unit) -> action
 
     val oneV : string -> string * 'a arg -> (env_vars * 'a -> unit) -> action

+    val twoV : string -> string * 'a arg * string * 'b arg -> (env_vars * 'a * 'b -> unit) -> action

 
     val env : 'a arg -> env_vars * string -> 'a
 
 
     val env : 'a arg -> env_vars * string -> 'a
 


@@ -55,7 +62,9 @@ signature ENV = sig
     val action_one : string -> string * 'a arg -> ('a -> unit) -> unit
     val action_two : string -> string * 'a arg * string * 'b arg -> ('a * 'b -> unit) -> unit
 
     val action_one : string -> string * 'a arg -> ('a -> unit) -> unit
     val action_two : string -> string * 'a arg * string * 'b arg -> ('a * 'b -> unit) -> unit
 

+    val actionV_none : string -> (env_vars -> unit) -> unit

     val actionV_one : string -> string * 'a arg -> (env_vars * 'a -> unit) -> unit
     val actionV_one : string -> string * 'a arg -> (env_vars * 'a -> unit) -> unit

+    val actionV_two : string -> string * 'a arg * string * 'b arg -> (env_vars * 'a * 'b -> unit) -> unit

 
     val container_none : string -> (unit -> unit) * (unit -> unit) -> unit
     val container_one : string -> string * 'a arg -> ('a -> unit) * (unit -> unit) -> unit
 
     val container_none : string -> (unit -> unit) * (unit -> unit) -> unit
     val container_one : string -> string * 'a arg -> ('a -> unit) * (unit -> unit) -> unit

diff --git a/src/env.sml b/src/env.sml
index 91fb69d..167adce 100644 (file)
--- a/src/env.sml
+++ b/src/env.sml
@@ -41,6 +41,34 @@ fun registerContainer (name, befor, after) =
     containers := SM.insert (!containers, name, (befor, after))
 fun container name = SM.find (!containers, name)
 
     containers := SM.insert (!containers, name, (befor, after))
 fun container name = SM.find (!containers, name)
 

+local
+    val pr = ref (fn () => ())
+in
+
+fun registerPre f =
+    let
+       val old = !pr
+    in
+       pr := (fn () => (old (); f ()))
+    end
+fun pre () = !pr ()
+
+end
+
+local
+    val pst = ref (fn () => ())
+in
+
+fun registerPost f =
+    let
+       val old = !pst
+    in
+       pst := (fn () => (old (); f ()))
+    end
+fun post () = !pst ()
+
+end
+

 fun badArgs (name, args) =
     (print ("Invalid arguments to " ^ name ^ "\n");
      app (fn arg => Print.preface ("Argument: ", Print.p_exp arg)) args;
 fun badArgs (name, args) =
     (print ("Invalid arguments to " ^ name ^ "\n");
      app (fn arg => Print.preface ("Argument: ", Print.p_exp arg)) args;


@@ -97,6 +125,14 @@ fun oneV func (name, arg) f (evs, [e]) =
                    SM.empty))
   | oneV func _ _ (_, es) = badArgs (func, es)
 
                    SM.empty))
   | oneV func _ _ (_, es) = badArgs (func, es)
 

+fun twoV func (name1, arg1, name2, arg2) f (evs, [e1, e2]) =
+    (case (arg1 e1, arg2 e2) of
+        (NONE, _) => badArg (func, name1, e1)
+       | (_, NONE) => badArg (func, name2, e2)
+       | (SOME v1, SOME v2) => (f (evs, v1, v2);
+                               SM.empty))
+  | twoV func _ _ (_, es) = badArgs (func, es)
+

 
 fun env arg (evs, name) =
     case SM.find (evs, name) of
 
 fun env arg (evs, name) =
     case SM.find (evs, name) of


@@ -116,7 +152,9 @@ fun action_none name f = registerAction (name, none name f)
 fun action_one name args f = registerAction (name, one name args f)
 fun action_two name args f = registerAction (name, two name args f)
 
 fun action_one name args f = registerAction (name, one name args f)
 fun action_two name args f = registerAction (name, two name args f)
 

+fun actionV_none name f = registerAction (name, fn (env, _) => (f env; env))

 fun actionV_one name args f = registerAction (name, oneV name args f)
 fun actionV_one name args f = registerAction (name, oneV name args f)

+fun actionV_two name args f = registerAction (name, twoV name args f)

 
 fun container_none name (f, g) = registerContainer (name, none name f, g)
 fun container_one name args (f, g) = registerContainer (name, one name args f, g)
 
 fun container_none name (f, g) = registerContainer (name, none name f, g)
 fun container_one name args (f, g) = registerContainer (name, one name args f, g)

diff --git a/src/eval.sml b/src/eval.sml
index 37a5d63..232a8aa 100644 (file)
--- a/src/eval.sml
+++ b/src/eval.sml
@@ -103,9 +103,10 @@ fun exec evs e =
                      | SOME action => action (evs, args)
                end
 
                      | SOME action => action (evs, args)
                end
 

+       val _ = Env.pre ()

        val evs' = exec' evs e
     in
        val evs' = exec' evs e
     in

-       ()
+       Env.post ()

     end
 
 end
     end
 
 end

diff --git a/src/plugins/alias.sml b/src/plugins/alias.sml
index 9449f2b..6d6ab43 100644 (file)
--- a/src/plugins/alias.sml
+++ b/src/plugins/alias.sml
@@ -22,22 +22,41 @@ structure Alias :> ALIAS = struct
 
 open Ast
 
 
 open Ast
 

-val aliases : TextIO.outstream option ref = ref NONE
-fun aliasesF () = valOf (!aliases)
+structure SM = DataStructures.StringMap

 
 

-val aliasesD : TextIO.outstream option ref = ref NONE
-fun aliasesDF () = valOf (!aliasesD)
+val aliases : TextIO.outstream SM.map ref = ref SM.empty
+fun aliasesF node = valOf (SM.find (!aliases, node))

 
 

-fun write s = TextIO.output (aliasesF (), s)
-fun writeD s = TextIO.output (aliasesDF (), s)
+val aliasesD : TextIO.outstream SM.map ref = ref SM.empty
+fun aliasesDF node = valOf (SM.find (!aliasesD, node))
+
+fun write nodes =
+    let
+       val files = map (fn node => aliasesF node) nodes
+    in
+       fn s => app (fn file => TextIO.output (file, s)) files
+    end
+
+fun writeD nodes =
+    let
+       val files = map (fn node => aliasesDF node) nodes
+    in
+       fn s => app (fn file => TextIO.output (file, s)) files
+    end
+
+fun openInAll base = foldl (fn (node, r) =>
+                              SM.insert (r,
+                                         node,
+                                         Domain.domainFile {node = node, name = base}))
+                          SM.empty Config.nodes

 
 val _ = Domain.registerBefore
 
 val _ = Domain.registerBefore

-           (fn _ => (aliases := SOME (Domain.domainFile "aliases");
-                     aliasesD := SOME (Domain.domainFile "aliases.default")))
+           (fn _ => (aliases := openInAll "aliases";
+                     aliasesD := openInAll "aliases.default"))

        
 val _ = Domain.registerAfter
        
 val _ = Domain.registerAfter

-       (fn _ => (TextIO.closeOut (aliasesF ());
-                 TextIO.closeOut (aliasesDF ())))
+       (fn _ => (SM.app TextIO.closeOut (!aliases);
+                 SM.app TextIO.closeOut (!aliasesD)))

 
 fun validEmailUser s =
     size s > 0 andalso size s < 50
 
 fun validEmailUser s =
     size s > 0 andalso size s < 50


@@ -94,34 +113,41 @@ fun localhostify s =
            s
     end
 
            s
     end
 

-fun writeTarget (outf, t) =
-    case t of
-       Address s => TextIO.output (outf, localhostify s)
-      | Addresses [] => TextIO.output (outf, "!")
-      | Addresses ss => TextIO.output (outf, String.concatWith "," (map localhostify ss))
-      | Drop => TextIO.output (outf, "!")
-
-fun writeSource (s, t) =
-    case s of
-       User s => (write s;
-                  write "@";
-                  write (Domain.currentDomain ());
-                  write ": ";
-                  writeTarget (aliasesF (), t);
-                  write "\n")
-      | Default => (write "*@";
-                   write (Domain.currentDomain ());
-                   write ": ";
-                   writeTarget (aliasesF (), t);
-                   write "\n")
-      | CatchAll => (writeD "*@";
-                    writeD (Domain.currentDomain ());
-                    writeD ": ";
-                    writeTarget (aliasesDF (), t);
-                    writeD "\n")
-
-val _ = Env.action_two "aliasPrim"
-                      ("from", source, "to", target)
-                      writeSource
+fun writeSource (env, s, t) =
+    let
+       val nodes = Env.env (Env.list Env.string) (env, "MailNodes")
+
+       val write = write nodes
+       val writeD = writeD nodes
+
+       fun writeTarget (writer, t) =
+           case t of
+               Address s => writer (localhostify s)
+             | Addresses [] => writer "!"
+             | Addresses ss => writer (String.concatWith "," (map localhostify ss))
+             | Drop => writer "!"
+    in
+       case s of
+           User s => (write s;
+                      write "@";
+                      write (Domain.currentDomain ());
+                      write ": ";
+                      writeTarget (write, t);
+                      write "\n")
+         | Default => (write "*@";
+                       write (Domain.currentDomain ());
+                       write ": ";
+                       writeTarget (write, t);
+                       write "\n")
+         | CatchAll => (writeD "*@";
+                        writeD (Domain.currentDomain ());
+                        writeD ": ";
+                        writeTarget (writeD, t);
+                        writeD "\n")
+    end
+                       
+val _ = Env.actionV_two "aliasPrim"
+                       ("from", source, "to", target)
+                       writeSource

 
 end
 
 end

diff --git a/src/plugins/bind.sml b/src/plugins/bind.sml
index d358078..4b09b45 100644 (file)
--- a/src/plugins/bind.sml
+++ b/src/plugins/bind.sml
@@ -32,15 +32,14 @@ val () = Slave.registerPreHandler (fn () => (namedChanged := false;
                                             didDomain := ""))
 
 val dns : TextIO.outstream option ref = ref NONE
                                             didDomain := ""))
 
 val dns : TextIO.outstream option ref = ref NONE

-fun dnsF () = valOf (!dns)
-
-fun write s = TextIO.output (dnsF (), s)

 
 val _ = Domain.registerBefore
 
 val _ = Domain.registerBefore

-           (fn _ => dns := SOME (Domain.domainFile "dns"))
+           (fn _ => dns := Option.map (fn node => Domain.domainFile {node = node,
+                                                                     name = "dns"})
+                                      (Domain.dnsMaster ()))

        
 val _ = Domain.registerAfter
        
 val _ = Domain.registerAfter

-           (fn _ => TextIO.closeOut (dnsF ()))
+           (fn _ => Option.app TextIO.closeOut (!dns))

 
 val dl = ErrorMsg.dummyLoc
 
 
 val dl = ErrorMsg.dummyLoc
 


@@ -67,39 +66,43 @@ val record = fn (EApp ((EApp ((EVar "dnsA", _), e1), _), e2), _) =>
              | _ => NONE
 
 fun writeRecord (evs, r) =
              | _ => NONE
 
 fun writeRecord (evs, r) =

-    let
-       val ttl = Env.env Env.int (evs, "TTL")
-    in
-       case r of
-           A (from, to) => (write from;
-                            write ".";
-                            write (Domain.currentDomain ());
-                            write ".\t";
-                            write (Int.toString ttl);
-                            write "\tIN\tA\t";
-                            write to;
-                            write "\n")
-         | CNAME (from, to) => (write from;
+    case !dns of
+       NONE => print "Warning: DNS directive ignored because no master DNS server is configured for this domain\n"
+      | SOME file =>
+       let
+           fun write s = TextIO.output (file, s)
+           val ttl = Env.env Env.int (evs, "TTL")
+       in
+           case r of
+               A (from, to) => (write from;

                                 write ".";
                                 write (Domain.currentDomain ());
                                 write ".\t";
                                 write (Int.toString ttl);
                                 write ".";
                                 write (Domain.currentDomain ());
                                 write ".\t";
                                 write (Int.toString ttl);

-                                write "\tIN\tCNAME\t";
+                                write "\tIN\tA\t";

                                 write to;
                                 write to;

-                                write ".\n")
-         | MX (num, host) => (write "\t";
-                              write (Int.toString ttl);
-                              write "\tIN\tMX\t";
-                              write (Int.toString num);
-                              write "\t";
-                              write host;
-                              write ".\n")
-         | NS host => (write "\t";
-                       write (Int.toString ttl);
-                       write "\tIN\tNS\t";
-                       write host;
-                       write ".\n")
-    end
+                                write "\n")
+             | CNAME (from, to) => (write from;
+                                    write ".";
+                                    write (Domain.currentDomain ());
+                                    write ".\t";
+                                    write (Int.toString ttl);
+                                    write "\tIN\tCNAME\t";
+                                    write to;
+                                    write ".\n")
+             | MX (num, host) => (write "\t";
+                                  write (Int.toString ttl);
+                                  write "\tIN\tMX\t";
+                                  write (Int.toString num);
+                                  write "\t";
+                                  write host;
+                                  write ".\n")
+             | NS host => (write "\t";
+                           write (Int.toString ttl);
+                           write "\tIN\tNS\t";
+                           write host;
+                           write ".\n")
+       end

 
 val () = Env.actionV_one "dns"
                         ("record", record)
 
 val () = Env.actionV_one "dns"
                         ("record", record)

diff --git a/src/plugins/exim.sml b/src/plugins/exim.sml
index ee4cf80..a93b732 100644 (file)
--- a/src/plugins/exim.sml
+++ b/src/plugins/exim.sml
@@ -20,6 +20,14 @@
 
 structure Exim :> EXIM = struct
 
 
 structure Exim :> EXIM = struct
 

+open Ast
+
+val dl = ErrorMsg.dummyLoc
+
+val _ = Main.registerDefault ("MailNodes",
+                             (TList (TBase "node", dl), dl),
+                             (EList (map (fn s => (EString s, dl)) Config.Exim.aliasTo), dl))
+

 val aliasesChanged = ref false
 val aliasesDefaultChanged = ref false
 val hostsChanged = ref false
 val aliasesChanged = ref false
 val aliasesDefaultChanged = ref false
 val hostsChanged = ref false


@@ -65,7 +73,14 @@ val () = Slave.registerPostHandler
                  ()))
 
 
                  ()))
 
 

-val () = Env.action_none "handleMail"
-        (fn () => TextIO.closeOut (Domain.domainFile "mail"))
+val () = Env.actionV_none "handleMail"
+        (fn env =>
+            let
+                val nodes = Env.env (Env.list Env.string) (env, "MailNodes")
+            in
+                app (fn node => TextIO.closeOut
+                                    (Domain.domainFile {node = node,
+                                                        name = "mail"})) nodes
+            end)

 
 end
 
 end

diff --git a/src/slave.sml b/src/slave.sml
index 144a167..4e44a8b 100644 (file)
--- a/src/slave.sml
+++ b/src/slave.sml
@@ -106,7 +106,7 @@ fun enumerateTo p sep fname =
        val outf = TextIO.openOut fname
 
        val first = ref true
        val outf = TextIO.openOut fname
 
        val first = ref true

-       val baseLen = length (String.fields (fn ch => ch = #"/") Config.resultRoot)
+       val baseLen = length (String.fields (fn ch => ch = #"/") Config.resultRoot) + 1

 
        fun visitDir dname =
            let
 
        fun visitDir dname =
            let

diff --git a/tests/testAlias.dtl b/tests/testAlias.dtl
index 75ffec8..1f7230c 100644 (file)
--- a/tests/testAlias.dtl
+++ b/tests/testAlias.dtl
@@ -4,5 +4,5 @@ domain "hcoop.net" with
        aliasDrop "yippo";
 
        defaultAlias "billy";
        aliasDrop "yippo";
 
        defaultAlias "billy";

-       catchAllAlias "bonkers"
+       catchAllAlias "bonkerso"

 end
 end