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 : TextIO.outstream option ref = ref NONE
  35
  36 val _ = Domain.registerBefore
  37             (fn _ => dns := Option.map (fn node => Domain.domainFile {node = node,
  38                                                                       name = "dns"})
  39                                        (Domain.dnsMaster ()))
  40
  41 val _ = Domain.registerAfter
  42             (fn _ => Option.app TextIO.closeOut (!dns))
  43
  44 val dl = ErrorMsg.dummyLoc
  45
  46 datatype dns_record =
  47          A of string * string
  48        | CNAME of string * string
  49        | MX of int * string
  50        | NS of string
  51
  52 val record = fn (EApp ((EApp ((EVar "dnsA", _), e1), _), e2), _) =>
  53                 (case (Env.string e1, Env.string e2) of
  54                      (SOME v1, SOME v2) => SOME (A (v1, v2))
  55                    | _ => NONE)
  56               | (EApp ((EApp ((EVar "dnsCNAME", _), e1), _), e2), _) =>
  57                 (case (Env.string e1, Env.string e2) of
  58                      (SOME v1, SOME v2) => SOME (CNAME (v1, v2))
  59                    | _ => NONE)
  60               | (EApp ((EApp ((EVar "dnsMX", _), e1), _), e2), _) =>
  61                 (case (Env.int e1, Env.string e2) of
  62                      (SOME v1, SOME v2) => SOME (MX (v1, v2))
  63                    | _ => NONE)
  64               | (EApp ((EVar "dnsNS", _), e), _) =>
  65                 Option.map NS (Env.string e)
  66               | _ => NONE
  67
  68 fun writeRecord (evs, r) =
  69     case !dns of
  70         NONE => print "Warning: DNS directive ignored because no master DNS server is configured for this domain\n"
  71       | SOME file =>
  72         let
  73             fun write s = TextIO.output (file, s)
  74             val ttl = Env.env Env.int (evs, "TTL")
  75         in
  76             case r of
  77                 A (from, to) => (write from;
  78                                  write ".";
  79                                  write (Domain.currentDomain ());
  80                                  write ".\t";
  81                                  write (Int.toString ttl);
  82                                  write "\tIN\tA\t";
  83                                  write to;
  84                                  write "\n")
  85               | CNAME (from, to) => (write from;
  86                                      write ".";
  87                                      write (Domain.currentDomain ());
  88                                      write ".\t";
  89                                      write (Int.toString ttl);
  90                                      write "\tIN\tCNAME\t";
  91                                      write to;
  92                                      write ".\n")
  93               | MX (num, host) => (write "\t";
  94                                    write (Int.toString ttl);
  95                                    write "\tIN\tMX\t";
  96                                    write (Int.toString num);
  97                                    write "\t";
  98                                    write host;
  99                                    write ".\n")
 100               | NS host => (write "\t";
 101                             write (Int.toString ttl);
 102                             write "\tIN\tNS\t";
 103                             write host;
 104                             write ".\n")
 105         end
 106
 107 val () = Env.actionV_one "dns"
 108                          ("record", record)
 109                          writeRecord
 110
 111 fun readLine inf =
 112     case TextIO.inputLine inf of
 113         NONE => raise Fail "Expected a line for BIND"
 114       | SOME s => String.substring (s, 0, size s - 1)
 115
 116 fun readILine inf = valOf (Int.fromString (readLine inf))
 117
 118 val () = Slave.registerFileHandler (fn fs =>
 119                                        let
 120                                            val {dir, file} = OS.Path.splitDirFile (#file fs)
 121
 122                                            fun dnsChanged () =
 123                                                if #domain fs = !didDomain then
 124                                                    ()
 125                                                else if #action fs = Slave.Delete then
 126                                                    let
 127                                                        val fname = OS.Path.joinBaseExt {base = #domain fs,
 128                                                                                         ext = SOME "zone"}
 129                                                        val fname = OS.Path.joinDirFile {dir = Config.Bind.zonePath,
 130                                                                                         file = fname}
 131                                                    in
 132                                                        OS.FileSys.remove fname
 133                                                    end
 134                                                else
 135                                                    let
 136                                                        val inf = TextIO.openIn (OS.Path.joinDirFile {dir = #dir fs,
 137                                                                                                      file = "soa"})
 138                                                        val kind = readLine inf
 139                                                        val ttl = readILine inf
 140                                                        val ns = readLine inf
 141                                                        val serial = case readLine inf of
 142                                                                         "" => NONE
 143                                                                       | s => Int.fromString s
 144                                                        val rf = readILine inf
 145                                                        val ret = readILine inf
 146                                                        val exp = readILine inf
 147                                                        val min = readILine inf
 148                                                        val () = TextIO.closeIn inf
 149
 150                                                        val dns = OS.Path.joinDirFile {dir = #dir fs,
 151                                                                                       file = "dns"}
 152
 153                                                        val fname = OS.Path.joinBaseExt {base = #domain fs,
 154                                                                                         ext = SOME "zone"}
 155                                                        val fname = OS.Path.joinDirFile {dir = Config.Bind.zonePath,
 156                                                                                         file = fname}
 157
 158                                                        val outf = TextIO.openOut fname
 159                                                    in
 160                                                        zoneChanged := true;
 161                                                        TextIO.output (outf, "$TTL ");
 162                                                        TextIO.output (outf, Int.toString ttl);
 163                                                        TextIO.output (outf, "\n\n@\tIN\tSOA\t");
 164                                                        TextIO.output (outf, ns);
 165                                                        TextIO.output (outf, ".\thostmaster.");
 166                                                        TextIO.output (outf, #domain fs);
 167                                                        TextIO.output (outf, ".\n( ");
 168                                                        TextIO.output (outf, Int.toString 123456789);
 169                                                        TextIO.output (outf, " ");
 170                                                        TextIO.output (outf, Int.toString rf);
 171                                                        TextIO.output (outf, " ");
 172                                                        TextIO.output (outf, Int.toString ret);
 173                                                        TextIO.output (outf, " ");
 174                                                        TextIO.output (outf, Int.toString exp);
 175                                                        TextIO.output (outf, " ");
 176                                                        TextIO.output (outf, Int.toString min);
 177                                                        TextIO.output (outf, " )\n\n");
 178                                                        TextIO.closeOut outf;
 179                                                        Slave.shellF ([Config.cat, " ", dns, " >>", fname],
 180                                                                   fn cl => "Error concatenating file: " ^ cl);
 181                                                        didDomain := #domain fs
 182                                                    end
 183                                        in
 184                                            case file of
 185                                                "soa" => dnsChanged ()
 186                                              | "dns" => dnsChanged ()
 187                                              | "named.conf" => namedChanged := true
 188                                              | _ => ()
 189                                        end)
 190
 191 val () = Slave.registerPostHandler
 192              (fn () =>
 193                  (if !namedChanged then
 194                       Slave.concatTo (fn s => s = "named.conf") Config.Bind.namedConf
 195                   else
 196                      ();
 197                   if !namedChanged orelse !zoneChanged then
 198                       Slave.shellF ([Config.Bind.reload],
 199                                  fn cl => "Error reloading bind with " ^ cl)
 200                   else
 201                       ()))
 202 end