src/plugins/bind.sml

   1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
   2  * Copyright (c) 2006, Adam Chlipala
   3  *
   4  * This program is free software; you can redistribute it and/or
   5  * modify it under the terms of the GNU General Public License
   6  * as published by the Free Software Foundation; either version 2
   7  * of the License, or (at your option) any later version.
   8  *
   9  * This program is distributed in the hope that it will be useful,
  10  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  11  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12  * GNU General Public License for more details.
  13  *
  14  * You should have received a copy of the GNU General Public License
  15  * along with this program; if not, write to the Free Software
  16  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA  02110-1301, USA.
  17  *)
  18
  19 (* BIND DNS *)
  20
  21 structure Bind :> BIND = struct
  22
  23 open Ast
  24
  25 val namedChanged = ref false
  26 val zoneChanged = ref false
  27
  28 val didDomain = ref ""
  29
  30 val () = Slave.registerPreHandler (fn () => (namedChanged := false;
  31                                              zoneChanged := false;
  32                                              didDomain := ""))
  33
  34 val dns : Domain.files option ref = ref NONE
  35
  36 val _ = Domain.registerBefore
  37             (fn _ => dns := Option.map (fn node => Domain.domainsFile {node = node,
  38                                                                        name = "dns"})
  39                                        (Domain.dnsMaster ()))
  40
  41 val _ = Domain.registerAfter
  42             (fn _ => (Option.app (fn files => #close files ()) (!dns);
  43                       dns := NONE))
  44
  45 val dl = ErrorMsg.dummyLoc
  46
  47 datatype dns_record =
  48          A of string * string
  49        | CNAME of string * string
  50        | MX of int * string
  51        | NS of string
  52        | DefaultA of string
  53        | AAAA of string * string
  54        | DefaultAAAA of string
  55        | TXT of string * string
  56
  57 val record = fn (EApp ((EApp ((EVar "dnsA", _), e1), _), e2), _) =>
  58                 (case (Env.string e1, Domain.ip e2) of
  59                      (SOME v1, SOME v2) => SOME (A (v1, v2))
  60                    | _ => NONE)
  61               | (EApp ((EApp ((EVar "dnsCNAME", _), e1), _), e2), _) =>
  62                 (case (Env.string e1, Env.string e2) of
  63                      (SOME v1, SOME v2) => SOME (CNAME (v1, v2))
  64                    | _ => NONE)
  65               | (EApp ((EApp ((EVar "dnsMX", _), e1), _), e2), _) =>
  66                 (case (Env.int e1, Env.string e2) of
  67                      (SOME v1, SOME v2) => SOME (MX (v1, v2))
  68                    | _ => NONE)
  69               | (EApp ((EVar "dnsNS", _), e), _) =>
  70                 Option.map NS (Env.string e)
  71               | (EApp ((EVar "dnsDefaultA", _), e), _) =>
  72                 Option.map DefaultA (Domain.ip e)
  73               | (EApp ((EApp ((EVar "dnsAAAA", _), e1), _), e2), _) =>
  74                 (case (Env.string e1, Env.string e2) of
  75                      (SOME v1, SOME v2) => SOME (AAAA (v1, v2))
  76                    | _ => NONE)
  77               | (EApp ((EVar "dnsDefaultAAAA", _), e), _) =>
  78                 Option.map DefaultAAAA (Env.string e)
  79               | (EApp ((EApp ((EVar "dnsTXT", _), e1), _), e2), _) =>
  80                 (case (Env.string e1, Env.string e2) of
  81                      (SOME v1, SOME v2) => SOME (TXT (v1, v2))
  82                    | _ => NONE)
  83               | _ => NONE
  84
  85 fun writeRecord (evs, r) =
  86     case !dns of
  87         NONE => print ("Warning: DNS directive for " ^ Domain.currentDomain ()
  88                        ^ " ignored because no master DNS server is configured for this domain\n")
  89       | SOME files =>
  90         let
  91             fun write s = #write files s
  92             fun writeDom () = #writeDom files ()
  93             val ttl = Env.env Env.int (evs, "TTL")
  94         in
  95             case r of
  96                 A (from, to) => (write from;
  97                                  write ".";
  98                                  writeDom ();
  99                                  write ".\t";
 100                                  write (Int.toString ttl);
 101                                  write "\tIN\tA\t";
 102                                  write to;
 103                                  write "\n")
 104               | DefaultA to => (writeDom ();
 105                                 write ".\t";
 106                                 write (Int.toString ttl);
 107                                 write "\tIN\tA\t";
 108                                 write to;
 109                                 write "\n")
 110               | CNAME (from, to) => (write from;
 111                                      write ".";
 112                                      writeDom ();
 113                                      write ".\t";
 114                                      write (Int.toString ttl);
 115                                      write "\tIN\tCNAME\t";
 116                                      write to;
 117                                      write ".\n")
 118               | MX (num, host) => (writeDom ();
 119                                    write ".\t";
 120                                    write (Int.toString ttl);
 121                                    write "\tIN\tMX\t";
 122                                    write (Int.toString num);
 123                                    write "\t";
 124                                    write host;
 125                                    write ".\n")
 126               | NS host => (writeDom ();
 127                             write ".\t";
 128                             write (Int.toString ttl);
 129                             write "\tIN\tNS\t";
 130                             write host;
 131                             write ".\n")
 132               | AAAA (from, to) => (write from;
 133                                     write ".";
 134                                     writeDom ();
 135                                     write ".\t";
 136                                     write (Int.toString ttl);
 137                                     write "\tIN\tAAAA\t";
 138                                     write to;
 139                                     write "\n")
 140               | DefaultAAAA to => (writeDom ();
 141                                    write ".\t";
 142                                    write (Int.toString ttl);
 143                                    write "\tIN\tAAAA\t";
 144                                    write to;
 145                                    write "\n")
 146               | TXT (from, to) => (write from;
 147                                    write ".";
 148                                    writeDom ();
 149                                    write ".\t";
 150                                    write (Int.toString ttl);
 151                                    write "\tIN\tTXT\t\"";
 152                                    write (String.translate (fn #"\"" => "\\\"" | ch => str ch) to);
 153                                    write "\"\n")
 154         end
 155
 156 val () = Env.actionV_one "dns"
 157                          ("record", record)
 158                          writeRecord
 159
 160 fun readLine inf =
 161     case TextIO.inputLine inf of
 162         NONE => raise Fail "Expected a line for BIND"
 163       | SOME s => String.substring (s, 0, size s - 1)
 164
 165 fun readILine inf = valOf (Int.fromString (readLine inf))
 166
 167 val monthToInt = fn Date.Jan => 1
 168                   | Date.Feb => 2
 169                   | Date.Mar => 3
 170                   | Date.Apr => 4
 171                   | Date.May => 5
 172                   | Date.Jun => 6
 173                   | Date.Jul => 7
 174                   | Date.Aug => 8
 175                   | Date.Sep => 9
 176                   | Date.Oct => 10
 177                   | Date.Nov => 11
 178                   | Date.Dec => 12
 179
 180 fun padBy ch amt s =
 181     if size s < amt then
 182         CharVector.tabulate (amt - size s, fn _ => ch) ^ s
 183     else
 184         s
 185
 186 fun dateString () =
 187     let
 188         val date = Date.fromTimeUniv (Time.now ())
 189     in
 190         padBy #"0" 4 (Int.toString (Date.year date))
 191         ^ padBy #"0" 2 (Int.toString (monthToInt (Date.month date)))
 192         ^ padBy #"0" 2 (Int.toString (Date.day date))
 193     end
 194
 195 val () = Slave.registerFileHandler (fn fs =>
 196                                        let
 197                                            val {dir, file} = OS.Path.splitDirFile (#file fs)
 198
 199                                            fun dnsChanged () =
 200                                                if #domain fs = !didDomain then
 201                                                    ()
 202                                                else if Slave.isDelete (#action fs) then
 203                                                    let
 204                                                        val fname = OS.Path.joinBaseExt {base = #domain fs,
 205                                                                                         ext = SOME "zone"}
 206                                                        val fname = OS.Path.joinDirFile {dir = Config.Bind.zonePath,
 207                                                                                         file = fname}
 208                                                    in
 209                                                        Slave.shellF ([Config.rm, " -f ", fname],
 210                                                                   fn cl => "Error deleting file: " ^ cl)
 211                                                    end
 212                                                else
 213                                                    let
 214                                                        val inf = TextIO.openIn (OS.Path.joinDirFile {dir = #dir fs,
 215                                                                                                      file = "soa"})
 216                                                        val kind = readLine inf
 217                                                        val ttl = readILine inf
 218                                                        val ns = readLine inf
 219                                                        val serial = case readLine inf of
 220                                                                         "" => NONE
 221                                                                       | s => Int.fromString s
 222                                                        val rf = readILine inf
 223                                                        val ret = readILine inf
 224                                                        val exp = readILine inf
 225                                                        val min = readILine inf
 226                                                        val () = TextIO.closeIn inf
 227
 228                                                        val serialPath = OS.Path.joinDirFile {dir = Config.serialDir,
 229                                                                                              file = #domain fs}
 230
 231                                                        val oldSerial = let
 232                                                            val inf = TextIO.openIn serialPath
 233                                                        in
 234                                                            SOME (readLine inf)
 235                                                            before TextIO.closeIn inf
 236                                                        end handle IO.Io {name, ...} => NONE
 237
 238                                                        val newSerial =
 239                                                            case serial of
 240                                                                SOME n => Int.toString n
 241                                                              | NONE =>
 242                                                                let
 243                                                                    val prefix = dateString ()
 244                                                                in
 245                                                                    prefix
 246                                                                    ^ (case oldSerial of
 247                                                                           NONE => "00"
 248                                                                         | SOME old =>
 249                                                                           if size old >= 8 andalso
 250                                                                              String.substring (old, 0, 8) = prefix then
 251                                                                               case Int.fromString (String.extract (old, 8, NONE)) of
 252                                                                                   NONE => "00"
 253                                                                                 | SOME old => padBy #"0" 2 (Int.toString (old+1))
 254                                                                           else
 255                                                                               "00")
 256                                                                end
 257
 258                                                        val outf = TextIO.openOut serialPath
 259                                                        val _ = TextIO.output (outf, newSerial)
 260                                                        val _ = TextIO.closeOut outf
 261
 262                                                        val dns = OS.Path.joinDirFile {dir = #dir fs,
 263                                                                                       file = "dns"}
 264
 265                                                        val fname = OS.Path.joinBaseExt {base = #domain fs,
 266                                                                                         ext = SOME "zone"}
 267                                                        val fname = OS.Path.joinDirFile {dir = Config.Bind.zonePath,
 268                                                                                         file = fname}
 269
 270                                                        val outf = TextIO.openOut fname
 271                                                    in
 272                                                        zoneChanged := true;
 273                                                        TextIO.output (outf, "$TTL ");
 274                                                        TextIO.output (outf, Int.toString ttl);
 275                                                        TextIO.output (outf, "\n\n@\tIN\tSOA\t");
 276                                                        TextIO.output (outf, ns);
 277                                                        TextIO.output (outf, ".\thostmaster.");
 278                                                        TextIO.output (outf, #domain fs);
 279                                                        TextIO.output (outf, ". ( ");
 280                                                        TextIO.output (outf, newSerial);
 281                                                        TextIO.output (outf, " ");
 282                                                        TextIO.output (outf, Int.toString rf);
 283                                                        TextIO.output (outf, " ");
 284                                                        TextIO.output (outf, Int.toString ret);
 285                                                        TextIO.output (outf, " ");
 286                                                        TextIO.output (outf, Int.toString exp);
 287                                                        TextIO.output (outf, " ");
 288                                                        TextIO.output (outf, Int.toString min);
 289                                                        TextIO.output (outf, " )\n\n");
 290                                                        TextIO.closeOut outf;
 291                                                        if Posix.FileSys.access (dns, []) then
 292                                                            Slave.shellF ([Config.cat, " ", dns, " >>", fname],
 293                                                                       fn cl => "Error concatenating file: " ^ cl)
 294                                                        else
 295                                                            ();
 296                                                        didDomain := #domain fs
 297                                                    end
 298                                        in
 299                                            case file of
 300                                                "soa" => dnsChanged ()
 301                                              | "dns" => dnsChanged ()
 302                                              | "named.conf" => namedChanged := true
 303                                              | _ => ()
 304                                        end)
 305
 306 val () = Slave.registerPostHandler
 307              (fn () =>
 308                  (if !namedChanged then
 309                       Slave.concatTo (fn s => s = "named.conf") Config.Bind.namedConf
 310                   else
 311                      ();
 312                   if !namedChanged orelse !zoneChanged then
 313                       Slave.shellF ([Config.Bind.reload],
 314                                  fn cl => "Error reloading bind with " ^ cl)
 315                   else
 316                       ()))
 317
 318 val () = Domain.registerResetLocal (fn () =>
 319                                        ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/zones/*")))
 320
 321 val () = Domain.registerDescriber (Domain.considerAll
 322                                    [Domain.Filename {filename = "named.conf",
 323                                                      heading = "named.conf addition:",
 324                                                      showEmpty = false},
 325                                     Domain.Filename {filename = "dns",
 326                                                      heading = "DNS zonefile contents:",
 327                                                      showEmpty = false}])
 328
 329 end