X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/6ae327f88a6be8efd02cfe4b713444f9f3ac2672..d5772aa364d60b3a005443b07db58672d64b0432:/src/plugins/bind.sml diff --git a/src/plugins/bind.sml b/src/plugins/bind.sml index d358078..20aeb60 100644 --- a/src/plugins/bind.sml +++ b/src/plugins/bind.sml @@ -31,31 +31,60 @@ 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.conf"}) + (Domain.dnsMaster ())) val _ = Domain.registerAfter - (fn _ => TextIO.closeOut (dnsF ())) + (fn _ => (Option.app (fn files => #close files ()) (!dns); + dns := NONE)) val dl = ErrorMsg.dummyLoc +datatype host = + Literal of string + | Wildcard + | Default + datatype dns_record = - A of string * string - | CNAME of string * string + A of host * string + | CNAME of host * string | MX of int * string | NS of string + | AAAA of host * string + | TXT of host * string + | AFSDB of string + | SRV of host * int * int * int * string + +fun hostS (Literal s) = s ^ "." + | hostS Wildcard = "*." + | hostS Default = "" + +val host = fn (EApp ((EVar "literal", _), e), _) => + Option.map Literal (Env.string e) + | (EVar "wildcard", _) => + SOME Wildcard + | (EVar "default", _) => + SOME Default + | _ => NONE + +val srv_host = fn (EApp ((EVar "srv_literal", _), e), _) => + Option.map Literal (Env.string e) + | (EVar "srv_wildcard", _) => + SOME Wildcard + | (EVar "srv_default", _) => + SOME Default + | _ => NONE val record = fn (EApp ((EApp ((EVar "dnsA", _), e1), _), e2), _) => - (case (Env.string e1, Env.string e2) of + (case (host 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 + (case (host e1, Env.string e2) of (SOME v1, SOME v2) => SOME (CNAME (v1, v2)) | _ => NONE) | (EApp ((EApp ((EVar "dnsMX", _), e1), _), e2), _) => @@ -64,42 +93,97 @@ val record = fn (EApp ((EApp ((EVar "dnsA", _), e1), _), e2), _) => | _ => NONE) | (EApp ((EVar "dnsNS", _), e), _) => Option.map NS (Env.string e) + | (EApp ((EApp ((EVar "dnsAAAA", _), e1), _), e2), _) => + (case (host e1, Env.string e2) of + (SOME v1, SOME v2) => SOME (AAAA (v1, v2)) + | _ => NONE) + | (EApp ((EApp ((EVar "dnsTXT", _), e1), _), e2), _) => + (case (srv_host e1, Env.string e2) of + (SOME v1, SOME v2) => SOME (TXT (v1, v2)) + | _ => NONE) + | (EApp ((EVar "dnsAFSDB", _), e), _) => + Option.map AFSDB (Env.string e) + | (EApp ((EApp ((EApp ((EApp ((EApp ((EVar "dnsSRV", _), e1), _), e2), _), e3), _), e4), _), e5), _) => + (case (srv_host e1, Env.int e2, Env.int e3, Env.int e4, Env.string e5) of + (SOME v1, SOME v2, SOME v3, SOME v4, SOME v5) => SOME (SRV (v1, v2, v3, v4, v5)) + | _ => NONE) | _ => 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 ()); + case !dns of + NONE => () (* print ("Warning: DNS directive for " ^ Domain.currentDomain () + ^ " 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 (hostS from); + 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 "\n") + | CNAME (from, to) => (write (hostS from); + writeDom (); + write ".\t"; + write (Int.toString ttl); + write "\tIN\tCNAME\t"; + write to; + write ".\n") + | MX (num, host) => (writeDom (); + write ".\t"; + write (Int.toString ttl); + write "\tIN\tMX\t"; + write (Int.toString num); + write "\t"; + write host; + write ".\n") + | NS host => (writeDom (); + write ".\t"; + write (Int.toString ttl); + write "\tIN\tNS\t"; + write host; + write ".\n") + | AAAA (from, to) => (write (hostS from); + writeDom (); + write ".\t"; + write (Int.toString ttl); + write "\tIN\tAAAA\t"; + write to; + write "\n") + | TXT (from, to) => (write (hostS from); + writeDom (); + write ".\t"; + write (Int.toString ttl); + write "\tIN\tTXT\t\""; + write (String.translate (fn #"\"" => "\\\"" | ch => str ch) to); + write "\"\n") + | AFSDB host => (writeDom (); + write ".\t"; write (Int.toString ttl); - write "\tIN\tMX\t"; - write (Int.toString num); + write "\tIN\tAFSDB\t"; + write "1"; write "\t"; write host; write ".\n") - | NS host => (write "\t"; - write (Int.toString ttl); - write "\tIN\tNS\t"; - write host; - write ".\n") - end + | SRV (from, priority, weight, port, to) => (write (hostS from); + writeDom (); + write ".\t"; + write (Int.toString ttl); + write "\tIN\tSRV\t"; + write (Int.toString priority); + write "\t"; + write (Int.toString weight); + write "\t"; + write (Int.toString port); + write "\t"; + write to; + write ".\n") + end val () = Env.actionV_one "dns" ("record", record) @@ -112,26 +196,55 @@ 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) fun dnsChanged () = - if #domain fs = !didDomain then + if #domain fs = !didDomain orelse Slave.hostname () <> Config.masterNode then () - else if #action fs = Slave.Delete then + else if Slave.isDelete (#action fs) 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 + 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"}) + file = "soa.conf"}) val kind = readLine inf val ttl = readILine inf val ns = readLine inf @@ -144,8 +257,42 @@ 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"} + file = "dns.conf"} val fname = OS.Path.joinBaseExt {base = #domain fs, ext = SOME "zone"} @@ -161,8 +308,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,14 +320,17 @@ 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 case file of - "soa" => dnsChanged () - | "dns" => dnsChanged () + "soa.conf" => dnsChanged () + | "dns.conf" => dnsChanged () | "named.conf" => namedChanged := true | _ => () end) @@ -196,4 +346,32 @@ 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/*"))) + +val () = Domain.registerDescriber (Domain.considerAll + [Domain.Filename {filename = "named.conf", + heading = "named.conf addition:", + showEmpty = false}, + Domain.Filename {filename = "dns.conf", + heading = "DNS zonefile contents:", + showEmpty = false}]) + +fun validSrvHost s = + size s > 0 andalso size s < 20 + andalso CharVector.all (fn ch => Domain.isIdent ch orelse ch = #"-" orelse ch = #"_") s + +fun validSrvDomain s = + size s > 0 andalso size s < 100 + andalso List.all validSrvHost (String.fields (fn ch => ch = #".") s) + +val _ = Env.type_one "srv_host" + Env.string + validSrvHost + +val _ = Env.type_one "srv_domain" + Env.string + validSrvDomain + end