src/djbdns/djbdns.sml

   1 (*
   2 Domtool (http://hcoop.sf.net/)
   3 Copyright (C) 2004  Adam Chlipala
   4
   5 This program is free software; you can redistribute it and/or
   6 modify it under the terms of the GNU General Public License
   7 as published by the Free Software Foundation; either version 2
   8 of the License, or (at your option) any later version.
   9
  10 This program is distributed in the hope that it will be useful,
  11 but WITHOUT ANY WARRANTY; without even the implied warranty of
  12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  13 GNU General Public License for more details.
  14
  15 You should have received a copy of the GNU General Public License
  16 along with this program; if not, write to the Free Software
  17 Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
  18 *)
  19
  20 (* Djbdns DNS mapping config *)
  21
  22 structure Djbdns :> DJBDNS =
  23 struct
  24     open Config DjbdnsConfig Util
  25
  26     val ldHandler = ref (fn _ : string => ())
  27     fun setLocalDomainHandler f = ldHandler := f
  28
  29     val dns = ref (NONE : TextIO.outstream option)
  30
  31     fun init () = dns := SOME (TextIO.openOut (scratchDir ^ "/data.shared"))
  32     fun finish () = (TextIO.closeOut (valOf (!dns));
  33                      dns := NONE)
  34
  35     fun handler {path, domain, parent, vars, paths, users, groups} =
  36         let
  37             val _ = Domtool.dprint ("Reading dns " ^ path ^ " for " ^ parent ^ "....")
  38
  39             val dns = valOf (!dns)
  40
  41             val al = TextIO.openIn path
  42
  43             val hasEmail = ref false
  44
  45             fun loop (line, mxnum) =
  46                 let
  47                     fun err () = (Domtool.error (path, "Invalid entry: " ^ trimLast line);
  48                                   mxnum)
  49                 in
  50                     case String.tokens Char.isSpace line of
  51                         [] => mxnum
  52                       | ["Default", addr] =>
  53                         (case resolveAddr (vars, addr) of
  54                              "" => err ()
  55                            | addr => (TextIO.output (dns, "=" ^ parent ^ ":" ^ addr ^ "\n");
  56                                       mxnum))
  57                       | [ty, host, addr] =>
  58                         let
  59                             val pre =
  60                                 (case ty of
  61                                      "Primary" => "."
  62                                    | "Secondary" => "&"
  63                                    | "Host" => "="
  64                                    | "Alias" => "+"
  65                                    | "Mail" => "@"
  66                                    | "Redir" => "C"
  67                                    | _ => "")
  68                         in
  69                             if pre = "C" then
  70                                 (case resolveDomain (vars, addr) of
  71                                      "" =>  err ()
  72                                    | host' =>
  73                                      if validHost host then
  74                                          (TextIO.output (dns, pre ^ host ^ "." ^ parent ^ ":" ^ addr ^ "\n");
  75                                           mxnum)
  76                                      else
  77                                          err ())
  78                             else case (resolveAddr (vars, addr), pre) of
  79                                      ("", _) => err ()
  80                                    | (addr, ".") =>
  81                                      if validHost host then
  82                                          (TextIO.output (dns, pre ^ parent ^ ":" ^ addr ^ ":" ^ host ^ "." ^ parent ^ "\n");
  83                                           mxnum)
  84                                      else
  85                                          err ()
  86                                    | (addr, "&") =>
  87                                      if validHost host then
  88                                          (TextIO.output (dns, pre ^ parent ^ ":" ^ addr ^ ":" ^ host ^ "." ^ parent ^ "\n");
  89                                           mxnum)
  90                                      else
  91                                          err ()
  92                                    | (addr, "@") =>
  93                                      (if not (!hasEmail) then
  94                                           (hasEmail := true;
  95                                            !ldHandler parent)
  96                                       else
  97                                           ();
  98                                           if validHost host then
  99                                               (TextIO.output (dns, pre ^ parent ^ ":" ^ addr ^ ":" ^ host ^ "." ^ parent ^ ":" ^ Int.toString mxnum ^ "\n");
 100                                                mxnum+1)
 101                                           else
 102                                               err ())
 103                                    | (addr, "=") =>
 104                                      if validHost host then
 105                                          (TextIO.output (dns, pre ^ host ^ "." ^ parent ^ ":" ^ addr ^ "\n");
 106                                           mxnum)
 107                                      else
 108                                          err ()
 109                                    | (addr, "+") =>
 110                                      if validHost host then
 111                                          (TextIO.output (dns, pre ^ host ^ "." ^ parent ^ ":" ^ addr ^ "\n");
 112                                           mxnum)
 113                                      else
 114                                          err ()
 115                                    | _ => err ()
 116                         end
 117                       | _ => err ()
 118                 end
 119         in
 120             ioLoop (fn () => Domtool.inputLine al) loop 0;
 121             TextIO.closeIn al
 122         end handle Io => Domtool.error (path, "IO error")
 123
 124     fun publish () =
 125         if OS.Process.isSuccess (OS.Process.system
 126                (diff ^ " " ^ scratchDir ^ "/data.shared " ^ dataFile)) then
 127             OS.Process.success
 128         else if not (OS.Process.isSuccess (OS.Process.system
 129                (cp ^ " " ^ scratchDir ^ "/data.shared " ^ dataFile))) then
 130             (print "Error copying data.shared\n";
 131              OS.Process.failure)
 132         else if OS.Process.isSuccess (OS.Process.system pubCommand) then
 133             OS.Process.success
 134         else
 135             (print "Error publishing data.shared\n";
 136              OS.Process.failure)
 137
 138     fun mkdom {path, ...} = OS.Process.system (cp ^ " " ^ defaultFile ^ " " ^ path ^ "/.dns")
 139
 140     val _ = Domtool.setHandler (".dns", {init = init,
 141                                          file = handler,
 142                                          finish = finish,
 143                                          publish = publish,
 144                                          mkdom = mkdom})
 145 end