From 6ae327f88a6be8efd02cfe4b713444f9f3ac2672 Mon Sep 17 00:00:00 2001 From: Adam Chlipala Date: Sat, 5 Aug 2006 21:07:53 +0000 Subject: [PATCH] BIND --- configDefault/bind.cfg | 12 ++ configDefault/bind.cfs | 1 + configDefault/bind.csg | 11 ++ configDefault/domtool.cfg | 7 ++ configDefault/domtool.cfs | 7 ++ lib/bind.dtl | 10 ++ lib/domain.dtl | 25 ++++- src/ast.sml | 3 + src/domain.sml | 223 ++++++++++++++++++++++++++++++-------- src/domtool.cm | 3 + src/domtool.grm | 7 +- src/env.sig | 9 ++ src/env.sml | 22 ++++ src/main.sig | 3 +- src/main.sml | 30 +++-- src/parse.sml | 2 +- src/plugins/bind.sig | 23 ++++ src/plugins/bind.sml | 199 ++++++++++++++++++++++++++++++++++ src/slave.sig | 1 + src/slave.sml | 5 +- tests/testBind.dtl | 22 ++++ 21 files changed, 562 insertions(+), 63 deletions(-) create mode 100644 configDefault/bind.cfg create mode 100644 configDefault/bind.cfs create mode 100644 configDefault/bind.csg create mode 100644 lib/bind.dtl create mode 100644 src/plugins/bind.sig create mode 100644 src/plugins/bind.sml create mode 100644 tests/testBind.dtl diff --git a/configDefault/bind.cfg b/configDefault/bind.cfg new file mode 100644 index 0000000..5526042 --- /dev/null +++ b/configDefault/bind.cfg @@ -0,0 +1,12 @@ +structure Bind :> BIND_CONFIG = struct + +val defaultTTL = 172800 + +val zonePath = "/home/adamc/fake" + +val namedConf = "/home/adamc/fake/named.conf" + +val reload = "echo \"I would reload bind now.\"" +(*"/etc/init.d/bind9 reload"*) + +end diff --git a/configDefault/bind.cfs b/configDefault/bind.cfs new file mode 100644 index 0000000..024ace4 --- /dev/null +++ b/configDefault/bind.cfs @@ -0,0 +1 @@ +structure Bind : BIND_CONFIG diff --git a/configDefault/bind.csg b/configDefault/bind.csg new file mode 100644 index 0000000..31760e1 --- /dev/null +++ b/configDefault/bind.csg @@ -0,0 +1,11 @@ +signature BIND_CONFIG = sig + + val defaultTTL : int + + val zonePath : string + + val namedConf : string + + val reload : string + +end diff --git a/configDefault/domtool.cfg b/configDefault/domtool.cfg index 34d07ee..4ea0478 100644 --- a/configDefault/domtool.cfg +++ b/configDefault/domtool.cfg @@ -6,3 +6,10 @@ val cat = "/bin/cat" val cp = "/bin/cp" val diff = "/usr/bin/diff" val rm = "/bin/rm" + +val defaultNs = "ns.hcoop.net" + +val defaultRefresh = 172800 +val defaultRetry = 900 +val defaultExpiry = 1209600 +val defaultMinimum = 3600 diff --git a/configDefault/domtool.cfs b/configDefault/domtool.cfs index d72df6f..87c679e 100644 --- a/configDefault/domtool.cfs +++ b/configDefault/domtool.cfs @@ -13,3 +13,10 @@ val cat : string val cp : string val diff : string val rm : string + +(* DNS SOA parameter defaults *) +val defaultNs : string +val defaultRefresh : int +val defaultRetry : int +val defaultExpiry : int +val defaultMinimum : int diff --git a/lib/bind.dtl b/lib/bind.dtl new file mode 100644 index 0000000..69612d0 --- /dev/null +++ b/lib/bind.dtl @@ -0,0 +1,10 @@ +{{DNS configuration for BIND}} + +extern type dnsRecord; + +extern val dnsA : host -> ip -> dnsRecord; +extern val dnsCNAME : host -> domain -> dnsRecord; +extern val dnsMX : int -> domain -> dnsRecord; +extern val dnsNS : domain -> dnsRecord; + +extern val dns : dnsRecord -> [Domain] {TTL : int}; diff --git a/lib/domain.dtl b/lib/domain.dtl index 8bf46fd..8edfa72 100644 --- a/lib/domain.dtl +++ b/lib/domain.dtl @@ -1,10 +1,33 @@ {{Configuring shared daemons with respect to a particular Internet domain name}} +extern type ip; +{{An IP address}} + +extern type host; +{{A hostname; that is, (more or less) an alphanumeric string}} + extern type domain; {{An Internet domain name}} context Domain; {{Configuration directives specific to an Internet domain}} -extern val domain : domain -> Domain => [Root]; +extern type serial; +{{Domain zone serial numbers}} +extern val serialAuto : serial; +{{Whenever DNS data changes, choose a sensible serial number automatically.} +extern val serialConst : int -> serial; +{{Use this particular serial number.}} + +extern type soa; +{{DNS start-of-authority record}} +extern val soa : domain -> serial -> int -> int -> int -> int -> soa; + +extern type dnsKind; +{{How should DNS for this domain be handled?}} +extern val master : soa -> dnsKind; +extern val slave : soa -> dnsKind; +extern val noDns : dnsKind; + +extern val domain : domain -> Domain => [Root] {DNS : dnsKind, TTL : int}; {{Configure a domain to which you have access rights.}} diff --git a/src/ast.sml b/src/ast.sml index 29d7cb2..667a26c 100644 --- a/src/ast.sml +++ b/src/ast.sml @@ -100,4 +100,7 @@ type decl = decl' * string option * position type file = string option * decl list * exp option +fun multiApp (f, loc, args) = + foldl (fn (arg, e) => (EApp (e, arg), loc)) f args + end diff --git a/src/domain.sml b/src/domain.sml index 534e440..6b645cb 100644 --- a/src/domain.sml +++ b/src/domain.sml @@ -20,6 +20,12 @@ structure Domain :> DOMAIN = struct +fun validIp s = + case map Int.fromString (String.fields (fn ch => ch = #".") s) of + [SOME n1, SOME n2, SOME n3, SOME n4] => + n1 >= 0 andalso n1 < 256 andalso n2 >= 0 andalso n2 < 256 andalso n3 >= 0 andalso n3 < 256 andalso n4 >= 0 andalso n4 < 256 + | _ => false + fun isIdent ch = Char.isLower ch orelse Char.isDigit ch fun validHost s = @@ -30,6 +36,10 @@ fun validDomain s = size s > 0 andalso size s < 100 andalso List.all validHost (String.fields (fn ch => ch = #".") s) +val _ = Env.type_one "ip" + Env.string + validIp + val _ = Env.type_one "host" Env.string validHost @@ -40,6 +50,69 @@ val _ = Env.type_one "domain" open Ast +val dl = ErrorMsg.dummyLoc + +val nsD = (EString Config.defaultNs, dl) +val serialD = (EVar "serialAuto", dl) +val refD = (EInt Config.defaultRefresh, dl) +val retD = (EInt Config.defaultRetry, dl) +val expD = (EInt Config.defaultExpiry, dl) +val minD = (EInt Config.defaultMinimum, dl) + +val soaD = multiApp ((EVar "soa", dl), + dl, + [nsD, serialD, refD, retD, expD, minD]) + +val _ = Main.registerDefault ("DNS", + (TBase "dnsKind", dl), + (EApp ((EVar "master", dl), + soaD), dl)) + +val _ = Main.registerDefault ("TTL", + (TBase "int", dl), + (EInt Config.Bind.defaultTTL, dl)) + +type soa = {ns : string, + serial : int option, + ref : int, + ret : int, + exp : int, + min : int} + +val serial = fn (EVar "serialAuto", _) => SOME NONE + | (EApp ((EVar "serialConst", _), n), _) => Option.map SOME (Env.int n) + | _ => NONE + +val soa = fn (EApp ((EApp ((EApp ((EApp ((EApp ((EApp + ((EVar "soa", _), ns), _), + sl), _), + rf), _), + ret), _), + exp), _), + min), _) => + (case (Env.string ns, serial sl, Env.int rf, + Env.int ret, Env.int exp, Env.int min) of + (SOME ns, SOME sl, SOME rf, + SOME ret, SOME exp, SOME min) => + SOME {ns = ns, + serial = sl, + ref = rf, + ret = ret, + exp = exp, + min = min} + | _ => NONE) + | _ => NONE + +datatype dnsKind = + Master of soa + | Slave of soa + | 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 + | _ => NONE + val befores = ref (fn (_ : string) => ()) val afters = ref (fn (_ : string) => ()) @@ -160,49 +233,111 @@ fun findDiffs dom = acts end -val _ = Env.container_one "domain" - ("domain", Env.string) - (fn dom => - let - val path = getPath dom Config.tmpDir - in - current := dom; - currentPath := path; - !befores dom - end, - fn () => - let - val dom = !current - val () = !afters dom - - val diffs = findDiffs dom - - val diffs = map (fn Add' {src, dst} => - (Slave.shellF ([Config.cp, " ", src, " ", dst], - fn cl => "Copy failed: " ^ cl); - {action = Slave.Add, - domain = dom, - file = dst}) - | Delete' dst => - (OS.FileSys.remove dst - handle OS.SysErr _ => - ErrorMsg.error NONE ("Delete failed for " ^ dst); - {action = Slave.Delete, - domain = dom, - file = dst}) - | Modify' {src, dst} => - (Slave.shellF ([Config.cp, " ", src, " ", dst], - fn cl => "Copy failed: " ^ cl); - {action = Slave.Modify, - domain = dom, - 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) +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) + + end diff --git a/src/domtool.cm b/src/domtool.cm index 29b39c0..f7f6551 100644 --- a/src/domtool.cm +++ b/src/domtool.cm @@ -53,6 +53,9 @@ plugins/alias.sml plugins/exim.sig plugins/exim.sml +plugins/bind.sig +plugins/bind.sml + order.sig order.sml diff --git a/src/domtool.grm b/src/domtool.grm index e7ce9ea..549a183 100644 --- a/src/domtool.grm +++ b/src/domtool.grm @@ -122,13 +122,8 @@ exp : apps (apps) in (ESeq ls, (exp1left, exp2right)) end) + | exp SEMI (exp) | SYMBOL LARROW CSYMBOL SEMI exp (EGet (SYMBOL, CSYMBOL, exp), (SYMBOLleft, expright)) - (*| exp WHERE exp END (ELocal (exp1, exp2), (exp1left, ENDright)) - | exp WHERE exp WITH END (EWith ((ELocal (exp1, exp2), (exp1left, ENDright)), - (ESkip, (WITHleft, ENDright))), - (exp1left, ENDright)) - | exp WITH END (EWith (exp, (ESkip, (WITHleft, ENDright))), (expleft, ENDright)) - | exp WITH exp END (EWith (exp1, exp2), (exp1left, ENDright))*) apps : term (term) | apps term (EApp (apps, term), (appsleft, termright)) diff --git a/src/env.sig b/src/env.sig index 9c26f00..c196158 100644 --- a/src/env.sig +++ b/src/env.sig @@ -45,14 +45,23 @@ signature ENV = sig val one : string -> string * 'a arg -> ('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 env : 'a arg -> env_vars * string -> 'a + val type_one : string -> 'a arg -> ('a -> bool) -> unit val action_none : string -> (unit -> 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_one : string -> string * 'a arg -> (env_vars * 'a -> unit) -> unit + + val container_none : string -> (unit -> unit) * (unit -> unit) -> unit val container_one : string -> string * 'a arg -> ('a -> unit) * (unit -> unit) -> unit + val containerV_one : string -> string * 'a arg -> (env_vars * 'a -> unit) * (unit -> unit) -> unit + type env val empty : env diff --git a/src/env.sml b/src/env.sml index 85c29c9..91fb69d 100644 --- a/src/env.sml +++ b/src/env.sml @@ -89,6 +89,23 @@ fun two func (name1, arg1, name2, arg2) f (_, [e1, e2]) = SM.empty)) | two func _ _ (_, es) = badArgs (func, es) + +fun oneV func (name, arg) f (evs, [e]) = + (case arg e of + NONE => badArg (func, name, e) + | SOME v => (f (evs, v); + SM.empty)) + | oneV func _ _ (_, es) = badArgs (func, es) + + +fun env arg (evs, name) = + case SM.find (evs, name) of + NONE => raise Fail ("Unavailable environment variable " ^ name) + | SOME e => + case arg e of + NONE => raise Fail ("Bad format for environment variable " ^ name) + | SOME v => v + fun type_one func arg f = registerType (func, fn e => case arg e of @@ -99,8 +116,13 @@ 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 actionV_one name args f = registerAction (name, oneV 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 containerV_one name args (f, g) = registerContainer (name, oneV name args f, g) + type env = SS.set * (typ * exp option) SM.map * SS.set val empty : env = (SS.empty, SM.empty, SS.empty) diff --git a/src/main.sig b/src/main.sig index 45510b7..7197f36 100644 --- a/src/main.sig +++ b/src/main.sig @@ -20,7 +20,8 @@ signature MAIN = sig - val tInit : Ast.typ + val tInit : unit -> Ast.typ + val registerDefault : string * Ast.typ * Ast.exp -> unit val check : string -> Env.env * Ast.exp option val check' : Env.env -> string -> Env.env diff --git a/src/main.sml b/src/main.sml index 415d9c2..59a76d5 100644 --- a/src/main.sml +++ b/src/main.sml @@ -22,12 +22,23 @@ structure Main :> MAIN = struct open Ast Print +structure SM = StringMap + val dmy = ErrorMsg.dummyLoc -val tInit = (TAction ((CRoot, dmy), - StringMap.empty, - StringMap.empty), - dmy) +val defaultT : record ref = ref SM.empty +val defaultV : exp SM.map ref = ref SM.empty + +fun registerDefault (name, t, v) = + case SM.find (!defaultT, name) of + NONE => (defaultT := SM.insert (!defaultT, name, t); + defaultV := SM.insert (!defaultV, name, v)) + | SOME _ => raise Fail "Duplicate default environment variable" + +fun tInit () = (TAction ((CRoot, dmy), + !defaultT, + StringMap.empty), + dmy) @@ -39,7 +50,7 @@ fun check' G fname = if !ErrorMsg.anyErrors then G else - Tycheck.checkFile G tInit prog + Tycheck.checkFile G (tInit ()) prog end fun basis () = @@ -61,7 +72,10 @@ fun basis () = val files = loop [] val files = Order.order files in - foldl (fn (fname, G) => check' G fname) Env.empty files + if !ErrorMsg.anyErrors then + Env.empty + else + foldl (fn (fname, G) => check' G fname) Env.empty files end fun check fname = @@ -80,7 +94,7 @@ fun check fname = (Env.empty, NONE) else let - val G' = Tycheck.checkFile b tInit prog + val G' = Tycheck.checkFile b (tInit ()) prog in (G', #3 prog) end @@ -114,7 +128,7 @@ fun eval fname = if !ErrorMsg.anyErrors then () else - Eval.exec StringMap.empty body' + Eval.exec (!defaultV) body' | NONE => () end diff --git a/src/parse.sml b/src/parse.sml index d8dc9b9..90cf07c 100644 --- a/src/parse.sml +++ b/src/parse.sml @@ -29,7 +29,7 @@ structure Parse :> PARSE = (* The main parsing routine *) fun parse filename = - let val _ = (ErrorMsg.reset(); ErrorMsg.fileName := filename) + let val _ = ErrorMsg.fileName := filename val file = TextIO.openIn filename fun get _ = TextIO.input file fun parseerror(s,p1,p2) = ErrorMsg.error (SOME (p1,p2)) s diff --git a/src/plugins/bind.sig b/src/plugins/bind.sig new file mode 100644 index 0000000..2042c2d --- /dev/null +++ b/src/plugins/bind.sig @@ -0,0 +1,23 @@ +(* HCoop Domtool (http://hcoop.sourceforge.net/) + * Copyright (c) 2006, Adam Chlipala + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + *) + +(* BIND DNS *) + +signature BIND = sig + +end diff --git a/src/plugins/bind.sml b/src/plugins/bind.sml new file mode 100644 index 0000000..d358078 --- /dev/null +++ b/src/plugins/bind.sml @@ -0,0 +1,199 @@ +(* HCoop Domtool (http://hcoop.sourceforge.net/) + * Copyright (c) 2006, Adam Chlipala + * + * This program is free software; you can redistribute it and/or + * modify it under the terms of the GNU General Public License + * as published by the Free Software Foundation; either version 2 + * of the License, or (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program; if not, write to the Free Software + * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. + *) + +(* BIND DNS *) + +structure Bind :> BIND = struct + +open Ast + +val namedChanged = ref false +val zoneChanged = ref false + +val didDomain = ref "" + +val () = Slave.registerPreHandler (fn () => (namedChanged := false; + zoneChanged := false; + didDomain := "")) + +val dns : TextIO.outstream option ref = ref NONE +fun dnsF () = valOf (!dns) + +fun write s = TextIO.output (dnsF (), s) + +val _ = Domain.registerBefore + (fn _ => dns := SOME (Domain.domainFile "dns")) + +val _ = Domain.registerAfter + (fn _ => TextIO.closeOut (dnsF ())) + +val dl = ErrorMsg.dummyLoc + +datatype dns_record = + A of string * string + | CNAME of string * string + | MX of int * string + | NS of string + +val record = fn (EApp ((EApp ((EVar "dnsA", _), e1), _), e2), _) => + (case (Env.string e1, Env.string e2) of + (SOME v1, SOME v2) => SOME (A (v1, v2)) + | _ => NONE) + | (EApp ((EApp ((EVar "dnsCNAME", _), e1), _), e2), _) => + (case (Env.string e1, Env.string e2) of + (SOME v1, SOME v2) => SOME (CNAME (v1, v2)) + | _ => NONE) + | (EApp ((EApp ((EVar "dnsMX", _), e1), _), e2), _) => + (case (Env.int e1, Env.string e2) of + (SOME v1, SOME v2) => SOME (MX (v1, v2)) + | _ => NONE) + | (EApp ((EVar "dnsNS", _), e), _) => + Option.map NS (Env.string e) + | _ => 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; + 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) + writeRecord + +fun readLine inf = + case TextIO.inputLine inf of + NONE => raise Fail "Expected a line for BIND" + | SOME s => String.substring (s, 0, size s - 1) + +fun readILine inf = valOf (Int.fromString (readLine inf)) + +val () = Slave.registerFileHandler (fn fs => + let + val {dir, file} = OS.Path.splitDirFile (#file fs) + + fun dnsChanged () = + if #domain fs = !didDomain then + () + else if #action fs = Slave.Delete then + let + val fname = OS.Path.joinBaseExt {base = #domain fs, + ext = SOME "zone"} + val fname = OS.Path.joinDirFile {dir = Config.Bind.zonePath, + file = fname} + in + OS.FileSys.remove fname + end + else + let + val inf = TextIO.openIn (OS.Path.joinDirFile {dir = #dir fs, + file = "soa"}) + val kind = readLine inf + val ttl = readILine inf + val ns = readLine inf + val serial = case readLine inf of + "" => NONE + | s => Int.fromString s + val rf = readILine inf + val ret = readILine inf + val exp = readILine inf + val min = readILine inf + val () = TextIO.closeIn inf + + val dns = OS.Path.joinDirFile {dir = #dir fs, + file = "dns"} + + val fname = OS.Path.joinBaseExt {base = #domain fs, + ext = SOME "zone"} + val fname = OS.Path.joinDirFile {dir = Config.Bind.zonePath, + file = fname} + + val outf = TextIO.openOut fname + in + zoneChanged := true; + TextIO.output (outf, "$TTL "); + TextIO.output (outf, Int.toString ttl); + TextIO.output (outf, "\n\n@\tIN\tSOA\t"); + TextIO.output (outf, ns); + TextIO.output (outf, ".\thostmaster."); + TextIO.output (outf, #domain fs); + TextIO.output (outf, ".\n( "); + TextIO.output (outf, Int.toString 123456789); + TextIO.output (outf, " "); + TextIO.output (outf, Int.toString rf); + TextIO.output (outf, " "); + TextIO.output (outf, Int.toString ret); + TextIO.output (outf, " "); + TextIO.output (outf, Int.toString exp); + TextIO.output (outf, " "); + TextIO.output (outf, Int.toString min); + TextIO.output (outf, " )\n\n"); + TextIO.closeOut outf; + Slave.shellF ([Config.cat, " ", dns, " >>", fname], + fn cl => "Error concatenating file: " ^ cl); + didDomain := #domain fs + end + in + case file of + "soa" => dnsChanged () + | "dns" => dnsChanged () + | "named.conf" => namedChanged := true + | _ => () + end) + +val () = Slave.registerPostHandler + (fn () => + (if !namedChanged then + Slave.concatTo (fn s => s = "named.conf") Config.Bind.namedConf + else + (); + if !namedChanged orelse !zoneChanged then + Slave.shellF ([Config.Bind.reload], + fn cl => "Error reloading bind with " ^ cl) + else + ())) +end diff --git a/src/slave.sig b/src/slave.sig index 52c9381..10d2071 100644 --- a/src/slave.sig +++ b/src/slave.sig @@ -27,6 +27,7 @@ signature SLAVE = sig type file_status = {action : file_action, domain : string, + dir : string, file : string} val registerFileHandler : (file_status -> unit) -> unit diff --git a/src/slave.sml b/src/slave.sml index d43a8fa..144a167 100644 --- a/src/slave.sml +++ b/src/slave.sml @@ -27,6 +27,7 @@ datatype file_action = type file_status = {action : file_action, domain : string, + dir : string, file : string} val fileHandler = ref (fn _ : file_status => ()) @@ -87,16 +88,16 @@ fun concatTo p fname = visitDir path else if p fname' then shellF ([Config.cat, " ", path, " >>", fname], - fn cl => "Error concatenating: " ^ cl) + fn cl => "Error concatenating: " ^ cl) else (); loop () end in - TextIO.closeOut (TextIO.openOut fname); loop () end in + TextIO.closeOut (TextIO.openOut fname); visitDir Config.resultRoot end diff --git a/tests/testBind.dtl b/tests/testBind.dtl new file mode 100644 index 0000000..8dc781b --- /dev/null +++ b/tests/testBind.dtl @@ -0,0 +1,22 @@ +domain "hcoop.net" with + + dns (dnsA "moocow" "1.2.3.4"); + dns (dnsCNAME "poocow" "moocow.hcoop.net"); + dns (dnsMX 13 "mail.nowhere.eu"); + dns (dnsNS "spanky.the.monkey"); + +end; + +domain "tpu.org" with + + dns (dnsNS "my.nso"); + dns (dnsMX 14 "mail.nowhere.eu"); + +end; + +domain "schizomaniac.net" with + + dns (dnsCNAME "a" "b.com"); + +end; + -- 2.20.1