+(* 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
HCoop / hcoop / domtool2.git / commitdiff