(* 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 val _ = Domain.registerBefore (fn _ => dns := Option.map (fn node => Domain.domainFile {node = node, name = "dns"}) (Domain.dnsMaster ())) val _ = Domain.registerAfter (fn _ => (Option.app TextIO.closeOut (!dns); dns := NONE)) 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, Domain.ip 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) = 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 "\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 monthToInt = fn Date.Jan => 1 | Date.Feb => 2 | Date.Mar => 3 | Date.Apr => 4 | Date.May => 5 | Date.Jun => 6 | Date.Jul => 7 | Date.Aug => 8 | Date.Sep => 9 | Date.Oct => 10 | Date.Nov => 11 | Date.Dec => 12 fun padBy ch amt s = if size s < amt then CharVector.tabulate (amt - size s, fn _ => ch) ^ s else s fun dateString () = let val date = Date.fromTimeUniv (Time.now ()) in padBy #"0" 4 (Int.toString (Date.year date)) ^ padBy #"0" 2 (Int.toString (monthToInt (Date.month date))) ^ padBy #"0" 2 (Int.toString (Date.day date)) end 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 Slave.shellF ([Config.rm, " -f ", fname], fn cl => "Error deleting file: " ^ cl) 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 serialPath = OS.Path.joinDirFile {dir = Config.serialDir, file = #domain fs} val oldSerial = let val inf = TextIO.openIn serialPath in SOME (readLine inf) before TextIO.closeIn inf end handle IO.Io {name, ...} => NONE val newSerial = case serial of SOME n => Int.toString n | NONE => let val prefix = dateString () in prefix ^ (case oldSerial of NONE => "00" | SOME old => if size old >= 8 andalso String.substring (old, 0, 8) = prefix then case Int.fromString (String.extract (old, 8, NONE)) of NONE => "00" | SOME old => padBy #"0" 2 (Int.toString (old+1)) else "00") end val outf = TextIO.openOut serialPath val _ = TextIO.output (outf, newSerial) val _ = TextIO.closeOut outf 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, ". ( "); TextIO.output (outf, newSerial); 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; if Posix.FileSys.access (dns, []) then Slave.shellF ([Config.cat, " ", dns, " >>", fname], fn cl => "Error concatenating file: " ^ cl) else (); 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 ())) val () = Domain.registerResetLocal (fn () => ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/zones/*"))) end