X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/6ae327f88a6be8efd02cfe4b713444f9f3ac2672..fa3b6b8704aeed09045e6e1c89c775ae2332e597:/src/plugins/bind.sml diff --git a/src/plugins/bind.sml b/src/plugins/bind.sml index d358078..5ba7fed 100644 --- a/src/plugins/bind.sml +++ b/src/plugins/bind.sml @@ -31,16 +31,16 @@ 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 dns : Domain.files option ref = ref NONE val _ = Domain.registerBefore - (fn _ => dns := SOME (Domain.domainFile "dns")) + (fn _ => dns := Option.map (fn node => Domain.domainsFile {node = node, + name = "dns"}) + (Domain.dnsMaster ())) val _ = Domain.registerAfter - (fn _ => TextIO.closeOut (dnsF ())) + (fn _ => (Option.app (fn files => #close files ()) (!dns); + dns := NONE)) val dl = ErrorMsg.dummyLoc @@ -51,7 +51,7 @@ datatype dns_record = | NS of string val record = fn (EApp ((EApp ((EVar "dnsA", _), e1), _), e2), _) => - (case (Env.string e1, Env.string e2) of + (case (Env.string e1, Domain.ip e2) of (SOME v1, SOME v2) => SOME (A (v1, v2)) | _ => NONE) | (EApp ((EApp ((EVar "dnsCNAME", _), e1), _), e2), _) => @@ -67,39 +67,44 @@ val record = fn (EApp ((EApp ((EVar "dnsA", _), e1), _), e2), _) => | _ => 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 files => + let + fun write s = #write files s + fun writeDom () = #writeDom files () + val ttl = Env.env Env.int (evs, "TTL") + in + case r of + A (from, to) => (write from; write "."; - write (Domain.currentDomain ()); + writeDom (); write ".\t"; write (Int.toString ttl); - write "\tIN\tCNAME\t"; + write "\tIN\tA\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 + write "\n") + | CNAME (from, to) => (write from; + write "."; + writeDom (); + 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) @@ -112,6 +117,34 @@ fun readLine inf = 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) @@ -126,7 +159,8 @@ val () = Slave.registerFileHandler (fn fs => val fname = OS.Path.joinDirFile {dir = Config.Bind.zonePath, file = fname} in - OS.FileSys.remove fname + Slave.shellF ([Config.rm, " -f ", fname], + fn cl => "Error deleting file: " ^ cl) end else let @@ -144,6 +178,40 @@ val () = Slave.registerFileHandler (fn fs => 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"} @@ -161,8 +229,8 @@ val () = Slave.registerFileHandler (fn fs => 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, newSerial); TextIO.output (outf, " "); TextIO.output (outf, Int.toString rf); TextIO.output (outf, " "); @@ -173,8 +241,11 @@ val () = Slave.registerFileHandler (fn fs => 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); + if Posix.FileSys.access (dns, []) then + Slave.shellF ([Config.cat, " ", dns, " >>", fname], + fn cl => "Error concatenating file: " ^ cl) + else + (); didDomain := #domain fs end in @@ -196,4 +267,8 @@ val () = Slave.registerPostHandler fn cl => "Error reloading bind with " ^ cl) else ())) + +val () = Domain.registerResetLocal (fn () => + ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/zones/*"))) + end