src/domain.sml

   1 (* HCoop Domtool (http://hcoop.sourceforge.net/)
   2  * Copyright (c) 2006-2007, 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 (* Domain-related primitive actions *)
  20
  21 structure Domain :> DOMAIN = struct
  22
  23 open MsgTypes
  24
  25 structure SM = DataStructures.StringMap
  26 structure SS = DataStructures.StringSet
  27
  28 val ssl_context = ref (NONE : OpenSSL.context option)
  29 fun set_context ctx = ssl_context := SOME ctx
  30
  31 val nodes = map #1 Config.nodeIps
  32 val nodeMap = foldl (fn ((node, ip), mp) => SM.insert (mp, node, ip))
  33                     SM.empty Config.nodeIps
  34 fun nodeIp node = valOf (SM.find (nodeMap, node))
  35
  36 val usr = ref ""
  37 fun getUser () = !usr
  38
  39 val your_doms = ref SS.empty
  40 fun your_domains () = !your_doms
  41
  42 val your_usrs = ref SS.empty
  43 fun your_users () = !your_usrs
  44
  45 val your_grps = ref SS.empty
  46 fun your_groups () = !your_grps
  47
  48 val your_pths = ref SS.empty
  49 fun your_paths () = !your_pths
  50
  51 val your_ipss = ref SS.empty
  52 fun your_ips () = !your_ipss
  53
  54 val world_readable = SS.addList (SS.empty, Config.worldReadable)
  55 val readable_pths = ref world_readable
  56 fun readable_paths () = !readable_pths
  57
  58 fun setUser user =
  59     let
  60         val () = usr := user
  61
  62         val your_paths = Acl.class {user = getUser (),
  63                                     class = "path"}
  64     in
  65         your_doms := Acl.class {user = getUser (),
  66                                 class = "domain"};
  67         your_usrs := Acl.class {user = getUser (),
  68                                 class = "user"};
  69         your_grps := Acl.class {user = getUser (),
  70                                 class = "group"};
  71         your_pths := your_paths;
  72         readable_pths := SS.union (your_paths, world_readable);
  73         your_ipss := Acl.class {user = getUser (),
  74                                 class = "ip"}
  75     end
  76
  77 fun validIp s =
  78     case map Int.fromString (String.fields (fn ch => ch = #".") s) of
  79         [SOME n1, SOME n2, SOME n3, SOME n4] =>
  80         n1 >= 0 andalso n1 < 256 andalso n2 >= 0 andalso n2 < 256 andalso n3 >= 0 andalso n3 < 256 andalso n4 >= 0 andalso n4 < 256
  81       | _ => false
  82
  83 fun isHexDigit ch = Char.isDigit ch orelse (ord ch >= ord #"a" andalso ord ch <= ord #"f")
  84
  85 fun validIpv6 s =
  86     let
  87         val fields = String.fields (fn ch => ch = #":") s
  88
  89         val empties = foldl (fn ("", n) => n + 1
  90                               | (_, n) => n) 0 fields
  91
  92         fun noIpv4 maxLen =
  93             length fields >= 2
  94             andalso length fields <= maxLen
  95             andalso empties <= 1
  96             andalso List.all (fn "" => true
  97                                | s => size s <= 4
  98                                       andalso CharVector.all isHexDigit s) fields
  99
 100         fun hasIpv4 () =
 101             length fields > 0
 102             andalso
 103             let
 104                 val maybeIpv4 = List.last fields
 105                 val theRest = List.take (fields, length fields - 1)
 106             in
 107                 validIp maybeIpv4 andalso noIpv4 6
 108             end
 109     in
 110         noIpv4 8 orelse hasIpv4 ()
 111     end
 112
 113 fun isIdent ch = Char.isLower ch orelse Char.isDigit ch
 114
 115 fun validHost s =
 116     size s > 0 andalso size s < 50
 117     andalso CharVector.all (fn ch => isIdent ch orelse ch = #"-") s
 118
 119 fun validDomain s =
 120     size s > 0 andalso size s < 200
 121     andalso List.all validHost (String.fields (fn ch => ch = #".") s)
 122
 123 fun validNode s = List.exists (fn s' => s = s') nodes
 124
 125 fun yourDomain s = SS.member (your_domains (), s)
 126 fun yourUser s = SS.member (your_users (), s)
 127 fun yourGroup s = SS.member (your_groups (), s)
 128 fun checkPath paths path =
 129     List.all (fn s => s <> "..") (String.fields (fn ch => ch = #"/") path)
 130     andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"/"
 131                                      orelse ch = #"-" orelse ch = #"_") path
 132     andalso SS.exists (fn s' => path = s' orelse String.isPrefix (s' ^ "/") path) (paths ())
 133 val yourPath = checkPath your_paths
 134 val readablePath = checkPath readable_paths
 135 fun yourIp s = SS.member (your_ips (), s)
 136
 137 fun yourDomainHost s =
 138     yourDomain s
 139     orelse let
 140         val (pref, suf) = Substring.splitl (fn ch => ch <> #".") (Substring.full s)
 141     in
 142         Substring.size suf > 0
 143         andalso validHost (Substring.string pref)
 144         andalso yourDomain (Substring.string
 145                                 (Substring.slice (suf, 1, NONE)))
 146     end
 147
 148 val yourDomain = yourDomainHost
 149
 150 fun validUser s = size s > 0 andalso size s < 20
 151                   andalso CharVector.all Char.isAlphaNum s
 152
 153 fun validEmailUser s =
 154     size s > 0 andalso size s < 50
 155     andalso CharVector.all (fn ch => Char.isAlphaNum ch
 156                                      orelse ch = #"."
 157                                      orelse ch = #"_"
 158                                      orelse ch = #"-"
 159                                      orelse ch = #"+") s
 160
 161 val validGroup = validUser
 162
 163 val _ = Env.type_one "no_spaces"
 164                      Env.string
 165                      (CharVector.all (fn ch => Char.isPrint ch andalso not (Char.isSpace ch)
 166                                                andalso ch <> #"\"" andalso ch <> #"'"))
 167 val _ = Env.type_one "no_newlines"
 168                      Env.string
 169                      (CharVector.all (fn ch => Char.isPrint ch andalso ch <> #"\n" andalso ch <> #"\r"
 170                                                andalso ch <> #"\""))
 171
 172 val _ = Env.type_one "ip"
 173         Env.string
 174         validIp
 175
 176 val _ = Env.type_one "ipv6"
 177         Env.string
 178         validIpv6
 179
 180 val _ = Env.type_one "host"
 181         Env.string
 182         validHost
 183
 184 val _ = Env.type_one "domain"
 185         Env.string
 186         validDomain
 187
 188 val _ = Env.type_one "your_domain"
 189         Env.string
 190         yourDomain
 191
 192 val _ = Env.type_one "your_domain_host"
 193         Env.string
 194         yourDomainHost
 195
 196 val _ = Env.type_one "user"
 197         Env.string
 198         validUser
 199
 200 val _ = Env.type_one "group"
 201         Env.string
 202         validGroup
 203
 204 val _ = Env.type_one "your_user"
 205         Env.string
 206         yourUser
 207
 208 val _ = Env.type_one "your_group"
 209         Env.string
 210         yourGroup
 211
 212 val _ = Env.type_one "your_path"
 213         Env.string
 214         yourPath
 215
 216 val _ = Env.type_one "readable_path"
 217         Env.string
 218         readablePath
 219
 220 val _ = Env.type_one "your_ip"
 221         Env.string
 222         yourIp
 223
 224 val _ = Env.type_one "node"
 225         Env.string
 226         validNode
 227
 228 val _ = Env.registerFunction ("your_ip_to_ip",
 229                               fn [e] => SOME e
 230                                | _ => NONE)
 231
 232 val _ = Env.registerFunction ("dns_node_to_node",
 233                               fn [e] => SOME e
 234                                | _ => NONE)
 235
 236 val _ = Env.registerFunction ("mail_node_to_node",
 237                               fn [e] => SOME e
 238                                | _ => NONE)
 239
 240
 241 open Ast
 242
 243 val dl = ErrorMsg.dummyLoc
 244
 245 val _ = Env.registerFunction ("end_in_slash",
 246                               fn [(EString "", _)] => SOME (EString "/", dl)
 247                                | [(EString s, _)] =>
 248                                  SOME (EString (if String.sub (s, size s - 1) = #"/" then
 249                                                     s
 250                                                 else
 251                                                     s ^ "/"), dl)
 252                                | _ => NONE)
 253
 254
 255 val nsD = (EString Config.defaultNs, dl)
 256 val serialD = (EVar "serialAuto", dl)
 257 val refD = (EInt Config.defaultRefresh, dl)
 258 val retD = (EInt Config.defaultRetry, dl)
 259 val expD = (EInt Config.defaultExpiry, dl)
 260 val minD = (EInt Config.defaultMinimum, dl)
 261
 262 val soaD = multiApp ((EVar "soa", dl),
 263                      dl,
 264                      [nsD, serialD, refD, retD, expD, minD])
 265
 266 val masterD = (EApp ((EVar "internalMaster", dl),
 267                      (EString Config.masterNode, dl)),
 268                dl)
 269
 270 val slavesD = (EList (map (fn s => (EString s, dl)) Config.slaveNodes), dl)
 271
 272 val _ = Defaults.registerDefault ("Aliases",
 273                                   (TList (TBase "your_domain", dl), dl),
 274                                   (fn () => (EList [], dl)))
 275
 276 val _ = Defaults.registerDefault ("Mailbox",
 277                                   (TBase "email", dl),
 278                                   (fn () => (EString (getUser ()), dl)))
 279
 280 val _ = Defaults.registerDefault ("DNS",
 281                                   (TBase "dnsKind", dl),
 282                                   (fn () => multiApp ((EVar "useDns", dl),
 283                                                       dl,
 284                                                       [soaD, masterD, slavesD])))
 285
 286 val _ = Defaults.registerDefault ("TTL",
 287                                   (TBase "int", dl),
 288                                   (fn () => (EInt Config.Bind.defaultTTL, dl)))
 289
 290 type soa = {ns : string,
 291             serial : int option,
 292             ref : int,
 293             ret : int,
 294             exp : int,
 295             min : int}
 296
 297 val serial = fn (EVar "serialAuto", _) => SOME NONE
 298               | (EApp ((EVar "serialConst", _), n), _) => Option.map SOME (Env.int n)
 299               | _ => NONE
 300
 301 val soa = fn (EApp ((EApp ((EApp ((EApp ((EApp ((EApp
 302                                                      ((EVar "soa", _), ns), _),
 303                                                 sl), _),
 304                                          rf), _),
 305                                   ret), _),
 306                            exp), _),
 307                     min), _) =>
 308              (case (Env.string ns, serial sl, Env.int rf,
 309                     Env.int ret, Env.int exp, Env.int min) of
 310                   (SOME ns, SOME sl, SOME rf,
 311                    SOME ret, SOME exp, SOME min) =>
 312                   SOME {ns = ns,
 313                         serial = sl,
 314                         ref = rf,
 315                         ret = ret,
 316                         exp = exp,
 317                         min = min}
 318                 | _ => NONE)
 319            | _ => NONE
 320
 321 datatype master =
 322          ExternalMaster of string
 323        | InternalMaster of string
 324
 325 val ip = Env.string
 326
 327 val _ = Env.registerFunction ("ip_of_node",
 328                               fn [(EString node, _)] => SOME (EString (nodeIp node), dl)
 329                                | _ => NONE)
 330
 331 val master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (ip e)
 332               | (EApp ((EVar "internalMaster", _), e), _) => Option.map InternalMaster (Env.string e)
 333               | _ => NONE
 334
 335 datatype dnsKind =
 336          UseDns of {soa : soa,
 337                     master : master,
 338                     slaves : string list}
 339        | NoDns
 340
 341 val dnsKind = fn (EApp ((EApp ((EApp
 342                                     ((EVar "useDns", _), sa), _),
 343                                mstr), _),
 344                         slaves), _) =>
 345                  (case (soa sa, master mstr, Env.list Env.string slaves) of
 346                       (SOME sa, SOME mstr, SOME slaves) =>
 347                       SOME (UseDns {soa = sa,
 348                                     master = mstr,
 349                                     slaves = slaves})
 350                     | _ => NONE)
 351                | (EVar "noDns", _) => SOME NoDns
 352                | _ => NONE
 353
 354 val befores = ref (fn (_ : string) => ())
 355 val afters = ref (fn (_ : string) => ())
 356
 357 fun registerBefore f =
 358     let
 359         val old = !befores
 360     in
 361         befores := (fn x => (old x; f x))
 362     end
 363
 364 fun registerAfter f =
 365     let
 366         val old = !afters
 367     in
 368         afters := (fn x => (old x; f x))
 369     end
 370
 371 val globals = ref (fn () => ())
 372 val locals = ref (fn () => ())
 373
 374 fun registerResetGlobal f =
 375     let
 376         val old = !globals
 377     in
 378         globals := (fn x => (old x; f x))
 379     end
 380
 381 fun registerResetLocal f =
 382     let
 383         val old = !locals
 384     in
 385         locals := (fn x => (old x; f x))
 386     end
 387
 388 fun resetGlobal () = (!globals ();
 389                       ignore (OS.Process.system (Config.rm ^ " -rf " ^ Config.resultRoot ^ "/*")))
 390 fun resetLocal () = !locals ()
 391
 392 val current = ref ""
 393 val currentPath = ref (fn (_ : string) => "")
 394 val currentPathAli = ref (fn (_ : string, _ : string) => "")
 395
 396 val scratch = ref ""
 397
 398 fun currentDomain () = !current
 399
 400 val currentsAli = ref ([] : string list)
 401
 402 fun currentAliasDomains () = !currentsAli
 403 fun currentDomains () = currentDomain () :: currentAliasDomains ()
 404
 405 fun domainFile {node, name} = ((*print ("Opening " ^ !currentPath node ^ name ^ "\n");*)
 406                                TextIO.openOut (!currentPath node ^ name))
 407
 408 type files = {write : string -> unit,
 409               writeDom : unit -> unit,
 410               close : unit -> unit}
 411
 412 fun domainsFile {node, name} =
 413     let
 414         val doms = currentDomains ()
 415         val files = map (fn dom => (dom, TextIO.openOut (!currentPathAli (dom, node) ^ name))) doms
 416     in
 417         {write = fn s => app (fn (_, outf) => TextIO.output (outf, s)) files,
 418          writeDom = fn () => app (fn (dom, outf) => TextIO.output (outf, dom)) files,
 419          close = fn () => app (fn (_, outf) => TextIO.closeOut outf) files}
 420     end
 421
 422 fun getPath domain =
 423     let
 424         val toks = String.fields (fn ch => ch = #".") domain
 425
 426         val elems = foldr (fn (piece, elems) =>
 427                               let
 428                                   val elems = piece :: elems
 429
 430                                   fun doNode node =
 431                                       let
 432                                           val path = String.concatWith "/"
 433                                                                        (Config.resultRoot :: node :: rev elems)
 434                                           val tmpPath = String.concatWith "/"
 435                                                                           (Config.tmpDir :: node :: rev elems)
 436                                       in
 437                                           (if Posix.FileSys.ST.isDir
 438                                                   (Posix.FileSys.stat path) then
 439                                                ()
 440                                            else
 441                                                (OS.FileSys.remove path;
 442                                                 OS.FileSys.mkDir path))
 443                                           handle OS.SysErr _ => OS.FileSys.mkDir path;
 444
 445                                           (if Posix.FileSys.ST.isDir
 446                                                   (Posix.FileSys.stat tmpPath) then
 447                                                ()
 448                                            else
 449                                                (OS.FileSys.remove tmpPath;
 450                                                 OS.FileSys.mkDir tmpPath))
 451                                           handle OS.SysErr _ => OS.FileSys.mkDir tmpPath
 452                                       end
 453                               in
 454                                   app doNode nodes;
 455                                   elems
 456                               end) [] toks
 457     in
 458         fn (root, site) => String.concatWith "/" (root :: site :: rev ("" :: elems))
 459     end
 460
 461 datatype file_action' =
 462          Add' of {src : string, dst : string}
 463        | Delete' of string
 464        | Modify' of {src : string, dst : string}
 465
 466 fun findDiffs (prefixes, site, dom, acts) =
 467     let
 468         val gp = getPath dom
 469         val realPath = gp (Config.resultRoot, site)
 470         val tmpPath = gp (Config.tmpDir, site)
 471
 472         (*val _ = print ("getDiffs(" ^ site ^ ", " ^ dom ^ ")... " ^ realPath ^ "; " ^ tmpPath ^ "\n")*)
 473
 474         val dir = Posix.FileSys.opendir realPath
 475
 476         fun loopReal acts =
 477             case Posix.FileSys.readdir dir of
 478                 NONE => (Posix.FileSys.closedir dir;
 479                          acts)
 480               | SOME fname =>
 481                 let
 482                     val real = OS.Path.joinDirFile {dir = realPath,
 483                                                     file = fname}
 484                     val tmp = OS.Path.joinDirFile {dir = tmpPath,
 485                                                    file = fname}
 486                 in
 487                     if Posix.FileSys.ST.isDir (Posix.FileSys.stat real) then
 488                         loopReal acts
 489                     else if Posix.FileSys.access (tmp, []) then
 490                         if Slave.shell [Config.diff, " ", real, " ",  tmp] then
 491                             loopReal acts
 492                         else
 493                             loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)
 494                     else if List.exists (fn prefix => String.isPrefix prefix real) prefixes then
 495                         loopReal ((site, dom, realPath, Delete' real) :: acts)
 496                     else
 497                         loopReal acts
 498                 end
 499
 500         val acts = loopReal acts
 501
 502         val dir = Posix.FileSys.opendir tmpPath
 503
 504         fun loopTmp acts =
 505             case Posix.FileSys.readdir dir of
 506                 NONE => (Posix.FileSys.closedir dir;
 507                          acts)
 508               | SOME fname =>
 509                 let
 510                     val real = OS.Path.joinDirFile {dir = realPath,
 511                                                     file = fname}
 512                     val tmp = OS.Path.joinDirFile {dir = tmpPath,
 513                                                    file = fname}
 514                 in
 515                     if Posix.FileSys.ST.isDir (Posix.FileSys.stat tmp) then
 516                         loopTmp acts
 517                     else if Posix.FileSys.access (real, []) then
 518                         loopTmp acts
 519                     else
 520                         loopTmp ((site, dom, realPath, Add' {src = tmp, dst = real}) :: acts)
 521                 end
 522
 523         val acts = loopTmp acts
 524     in
 525         acts
 526     end
 527
 528 fun findAllDiffs prefixes =
 529     let
 530         val dir = Posix.FileSys.opendir Config.tmpDir
 531         val len = length (String.fields (fn ch => ch = #"/") Config.tmpDir) + 1
 532
 533         fun exploreSites diffs =
 534             case Posix.FileSys.readdir dir of
 535                 NONE => diffs
 536               | SOME site =>
 537                 let
 538                     fun explore (dname, diffs) =
 539                         let
 540                             val dir = Posix.FileSys.opendir dname
 541
 542                             fun loop diffs =
 543                                 case Posix.FileSys.readdir dir of
 544                                     NONE => diffs
 545                                   | SOME name =>
 546                                     let
 547                                         val fname = OS.Path.joinDirFile {dir = dname,
 548                                                                          file = name}
 549                                     in
 550                                         loop (if Posix.FileSys.ST.isDir (Posix.FileSys.stat fname) then
 551                                                   let
 552                                                       val dom = String.fields (fn ch => ch = #"/") fname
 553                                                       val dom = List.drop (dom, len)
 554                                                       val dom = String.concatWith "." (rev dom)
 555
 556                                                       val dname' = OS.Path.joinDirFile {dir = dname,
 557                                                                                         file = name}
 558                                                   in
 559                                                       explore (dname',
 560                                                                findDiffs (prefixes, site, dom, diffs))
 561                                                   end
 562                                               else
 563                                                   diffs)
 564                                     end
 565                         in
 566                             loop diffs
 567                             before Posix.FileSys.closedir dir
 568                         end
 569                 in
 570                     exploreSites (explore (OS.Path.joinDirFile {dir = Config.tmpDir,
 571                                                                 file = site}, diffs))
 572                 end
 573     in
 574         exploreSites []
 575         before Posix.FileSys.closedir dir
 576     end
 577
 578 val masterNode : string option ref = ref NONE
 579 fun dnsMaster () = !masterNode
 580
 581 val seenDomains : string list ref = ref []
 582
 583 val _ = Env.containerV_one "domain"
 584                            ("domain", Env.string)
 585                            (fn (evs, dom) =>
 586                                let
 587                                    val () = seenDomains := dom :: !seenDomains
 588
 589                                    val kind = Env.env dnsKind (evs, "DNS")
 590                                    val ttl = Env.env Env.int (evs, "TTL")
 591                                    val aliases = Env.env (Env.list Env.string) (evs, "Aliases")
 592
 593                                    val path = getPath dom
 594
 595                                    val () = (current := dom;
 596                                              currentsAli := Slave.remove (Slave.removeDups aliases, dom);
 597                                              currentPath := (fn site => path (Config.tmpDir, site));
 598                                              currentPathAli := (fn (dom, site) => getPath dom (Config.tmpDir, site)))
 599
 600                                    fun saveSoa (kind, soa : soa) node =
 601                                        let
 602                                            val {write, writeDom, close} = domainsFile {node = node, name = "soa"}
 603                                        in
 604                                            write kind;
 605                                            write "\n";
 606                                            write (Int.toString ttl);
 607                                            write "\n";
 608                                            write (#ns soa);
 609                                            write "\n";
 610                                            case #serial soa of
 611                                                NONE => ()
 612                                              | SOME n => write (Int.toString n);
 613                                            write "\n";
 614                                            write (Int.toString (#ref soa));
 615                                            write "\n";
 616                                            write (Int.toString (#ret soa));
 617                                            write "\n";
 618                                            write (Int.toString (#exp soa));
 619                                            write "\n";
 620                                            write (Int.toString (#min soa));
 621                                            write "\n";
 622                                            close ()
 623                                        end
 624
 625                                    fun saveNamed (kind, soa : soa, masterIp, slaveIps) node =
 626                                        if dom = "localhost" then
 627                                            ()
 628                                        else let
 629                                                val {write, writeDom, close} = domainsFile {node = node, name = "named.conf"}
 630                                            in
 631                                                write "\nzone \"";
 632                                                writeDom ();
 633                                                write "\" {\n\ttype ";
 634                                                write kind;
 635                                                write ";\n\tfile \"";
 636                                                write Config.Bind.zonePath_real;
 637                                                write "/";
 638                                                writeDom ();
 639                                                write ".zone\";\n";
 640                                                case kind of
 641                                                    "master" => (write "\tallow-transfer {\n";
 642                                                                 app (fn ip => (write "\t\t";
 643                                                                                write ip;
 644                                                                                write ";\n")) slaveIps;
 645                                                                 write "\t};\n")
 646                                                  | _ => (write "\tmasters { ";
 647                                                          write masterIp;
 648                                                          write "; };\n";
 649                                                          write "// Updated: ";
 650                                                          write (Time.toString (Time.now ()));
 651                                                          write "\n");
 652                                                write "};\n";
 653                                                close ()
 654                                            end
 655                                in
 656                                    case kind of
 657                                        NoDns => masterNode := NONE
 658                                      | UseDns dns =>
 659                                        let
 660                                            val masterIp =
 661                                                case #master dns of
 662                                                    InternalMaster node => nodeIp node
 663                                                  | ExternalMaster ip => ip
 664
 665                                            val slaveIps = map nodeIp (#slaves dns)
 666                                        in
 667                                            app (saveSoa ("slave", #soa dns)) (#slaves dns);
 668                                            app (saveNamed ("slave", #soa dns, masterIp, slaveIps)) (#slaves dns);
 669                                            case #master dns of
 670                                                InternalMaster node =>
 671                                                (masterNode := SOME node;
 672                                                 saveSoa ("master", #soa dns) node;
 673                                                 saveNamed ("master", #soa dns, masterIp, slaveIps) node)
 674                                              | _ => masterNode := NONE
 675                                        end;
 676                                    !befores dom
 677                                end,
 678                             fn () => !afters (!current))
 679
 680 val () = Env.registerPre (fn () => (seenDomains := [];
 681                                     ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
 682                                                        fn cl => "Temp file cleanup failed: " ^ cl));
 683                                     OS.FileSys.mkDir Config.tmpDir;
 684                                     app (fn node => OS.FileSys.mkDir
 685                                                         (OS.Path.joinDirFile {dir = Config.tmpDir,
 686                                                                               file = node}))
 687                                         nodes;
 688                                     app (fn node => OS.FileSys.mkDir
 689                                                         (OS.Path.joinDirFile {dir = Config.resultRoot,
 690                                                                               file = node})
 691                                             handle OS.SysErr _ => ())
 692                                         nodes))
 693
 694 fun handleSite (site, files) =
 695     let
 696
 697     in
 698         print ("New configuration for node " ^ site ^ "\n");
 699         if site = Config.defaultNode then
 700             Slave.handleChanges files
 701         else let
 702                 val bio = OpenSSL.connect (valOf (!ssl_context),
 703                                            nodeIp site
 704                                            ^ ":"
 705                                            ^ Int.toString Config.slavePort)
 706             in
 707                 app (fn file => Msg.send (bio, MsgFile file)) files;
 708                 Msg.send (bio, MsgDoFiles);
 709                 case Msg.recv bio of
 710                     NONE => print "Slave closed connection unexpectedly\n"
 711                   | SOME m =>
 712                     case m of
 713                         MsgOk => print ("Slave " ^ site ^ " finished\n")
 714                       | MsgError s => print ("Slave " ^ site
 715                                              ^ " returned error: " ^
 716                                              s ^ "\n")
 717                       | _ => print ("Slave " ^ site
 718                                     ^ " returned unexpected command\n");
 719                 OpenSSL.close bio
 720             end
 721     end
 722
 723 val () = Env.registerPost (fn () =>
 724                               let
 725                                   val prefixes = List.concat
 726                                                      (List.map (fn dom =>
 727                                                                    let
 728                                                                        val pieces = String.tokens (fn ch => ch = #".") dom
 729                                                                        val path = String.concatWith "/" (rev pieces)
 730                                                                    in
 731                                                                        List.map (fn node =>
 732                                                                                     Config.resultRoot ^ "/" ^ node ^ "/" ^ path ^ "/")
 733                                                                                 nodes
 734                                                                    end) (!seenDomains))
 735
 736                                   val diffs = findAllDiffs prefixes
 737
 738                                   val diffs = map (fn (site, dom, dir, Add' {src, dst}) =>
 739                                                       (Slave.shellF ([Config.cp, " ", src, " ", dst],
 740                                                                   fn cl => "Copy failed: " ^ cl);
 741                                                        (site,
 742                                                         {action = Slave.Add,
 743                                                          domain = dom,
 744                                                          dir = dir,
 745                                                          file = dst}))
 746                                                     | (site, dom, dir, Delete' dst) =>
 747                                                       (OS.FileSys.remove dst
 748                                                        handle OS.SysErr _ =>
 749                                                               ErrorMsg.error NONE ("Delete failed for " ^ dst);
 750                                                        (site,
 751                                                         {action = Slave.Delete true,
 752                                                          domain = dom,
 753                                                          dir = dir,
 754                                                          file = dst}))
 755                                                     | (site, dom, dir, Modify' {src, dst}) =>
 756                                                       (Slave.shellF ([Config.cp, " ", src, " ", dst],
 757                                                                   fn cl => "Copy failed: " ^ cl);
 758                                                        (site,
 759                                                         {action = Slave.Modify,
 760                                                          domain = dom,
 761                                                          dir = dir,
 762                                                          file = dst}))) diffs
 763                               in
 764                                   if !ErrorMsg.anyErrors then
 765                                       ()
 766                                   else let
 767                                           val changed = foldl (fn ((site, file), changed) =>
 768                                                                   let
 769                                                                       val ls = case SM.find (changed, site) of
 770                                                                                    NONE => []
 771                                                                                  | SOME ls => ls
 772                                                                   in
 773                                                                       SM.insert (changed, site, file :: ls)
 774                                                                   end) SM.empty diffs
 775                                       in
 776                                           SM.appi handleSite changed
 777                                       end;
 778                                   ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
 779                                                      fn cl => "Temp file cleanup failed: " ^ cl))
 780                               end)
 781
 782 fun hasPriv priv = Acl.query {user = getUser (), class = "priv", value = "all"}
 783                    orelse Acl.query {user = getUser (), class = "priv", value = priv}
 784
 785 val _ = Env.type_one "dns_node"
 786         Env.string
 787         (fn node =>
 788             List.exists (fn x => x = node) Config.dnsNodes_all
 789             orelse (hasPriv "dns"
 790                     andalso List.exists (fn x => x = node) Config.dnsNodes_admin))
 791
 792 val _ = Env.type_one "mail_node"
 793         Env.string
 794         (fn node =>
 795             List.exists (fn x => x = node) Config.mailNodes_all
 796             orelse (hasPriv "mail"
 797                     andalso List.exists (fn x => x = node) Config.mailNodes_admin))
 798
 799 fun rmdom' delete resultRoot doms =
 800     let
 801         fun doNode (node, _) =
 802             let
 803                 val dname = OS.Path.joinDirFile {dir = resultRoot,
 804                                                  file = node}
 805
 806                 fun doDom (dom, actions) =
 807                     let
 808                         val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
 809                         val dname = OS.Path.concat (dname, domPath)
 810
 811                         fun visitDom (dom, dname, actions) =
 812                             let
 813                                 val dir = Posix.FileSys.opendir dname
 814
 815                                 fun loop actions =
 816                                     case Posix.FileSys.readdir dir of
 817                                         NONE => actions
 818                                       | SOME fname =>
 819                                         let
 820                                             val fnameFull = OS.Path.joinDirFile {dir = dname,
 821                                                                                  file = fname}
 822                                         in
 823                                             if Posix.FileSys.ST.isDir (Posix.FileSys.stat fnameFull) then
 824                                                 loop (visitDom (fname ^ "." ^ dom,
 825                                                                 fnameFull,
 826                                                                 actions))
 827                                             else
 828                                                  loop ({action = Slave.Delete delete,
 829                                                         domain = dom,
 830                                                         dir = dname,
 831                                                         file = fnameFull} :: actions)
 832                                         end
 833                             in
 834                                 loop actions
 835                                 before Posix.FileSys.closedir dir
 836                             end
 837                                 handle OS.SysErr (s, _) =>
 838                                        (print ("Warning: System error deleting domain " ^ dom ^ " on " ^ node ^ ": " ^ s ^ "\n");
 839                                         actions)
 840                     in
 841                         visitDom (dom, dname, actions)
 842                     end
 843
 844                 val actions = foldl doDom [] doms
 845             in
 846                 handleSite (node, actions)
 847             end
 848                 handle IO.Io _ => print ("Warning: IO error deleting domains on " ^ node ^ ".\n")
 849
 850         fun cleanupNode (node, _) =
 851             let
 852                 fun doDom dom =
 853                     let
 854                         val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
 855                         val dname = OS.Path.joinDirFile {dir = resultRoot,
 856                                                          file = node}
 857                         val dname = OS.Path.concat (dname, domPath)
 858                     in
 859                         if delete then
 860                             ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
 861                         else
 862                             ()
 863                     end
 864             in
 865                 app doDom doms
 866             end
 867     in
 868         app doNode Config.nodeIps;
 869         app cleanupNode Config.nodeIps
 870     end
 871
 872 val rmdom = rmdom' true Config.resultRoot
 873 val rmdom' = rmdom' false
 874
 875 fun homedirOf uname =
 876     Posix.SysDB.Passwd.home (Posix.SysDB.getpwnam uname)
 877
 878 fun homedir () = homedirOf (getUser ())
 879
 880 type subject = {node : string, domain : string}
 881
 882 val describers : (subject -> string) list ref = ref []
 883
 884 fun registerDescriber f = describers := f :: !describers
 885
 886 fun describeOne arg = String.concat (map (fn f => f arg) (rev (!describers)))
 887
 888 val line = "--------------------------------------------------------------\n"
 889 val dline = "==============================================================\n"
 890
 891 fun describe dom =
 892     String.concat (List.mapPartial
 893                        (fn node =>
 894                            case describeOne {node = node, domain = dom} of
 895                                "" => NONE
 896                              | s =>
 897                                SOME (String.concat [dline, "Node ", node, "\n", dline, "\n", s]))
 898                        nodes)
 899
 900 datatype description =
 901          Filename of { filename : string, heading : string, showEmpty : bool }
 902        | Extension of { extension : string, heading : string -> string }
 903
 904 fun considerAll ds {node, domain} =
 905     let
 906         val ds = map (fn d => (d, ref [])) ds
 907
 908         val path = Config.resultRoot
 909         val jdf = OS.Path.joinDirFile
 910         val path = jdf {dir = path, file = node}
 911         val path = foldr (fn (more, path) => jdf {dir = path, file = more})
 912                          path (String.tokens (fn ch => ch = #".") domain)
 913     in
 914         if Posix.FileSys.access (path, []) then
 915             let
 916                 val dir = Posix.FileSys.opendir path
 917
 918                 fun loop () =
 919                     case Posix.FileSys.readdir dir of
 920                         NONE => ()
 921                       | SOME fname =>
 922                         (app (fn (d, entries) =>
 923                                  let
 924                                      fun readFile showEmpty entries' =
 925                                          let
 926                                              val fname = OS.Path.joinDirFile {dir = path,
 927                                                                               file = fname}
 928
 929                                              val inf = TextIO.openIn fname
 930
 931                                              fun loop (seenOne, entries') =
 932                                                  case TextIO.inputLine inf of
 933                                                      NONE => if seenOne orelse showEmpty then
 934                                                                  "\n" :: entries'
 935                                                              else
 936                                                                  !entries
 937                                                    | SOME line => loop (true, line :: entries')
 938                                          in
 939                                              loop (false, entries')
 940                                              before TextIO.closeIn inf
 941                                          end
 942                                  in
 943                                      case d of
 944                                          Filename {filename, heading, showEmpty} =>
 945                                          if fname = filename then
 946                                              entries := readFile showEmpty ("\n" :: line :: "\n" :: heading :: line :: !entries)
 947                                          else
 948                                              ()
 949                                        | Extension {extension, heading} =>
 950                                          let
 951                                              val {base, ext} = OS.Path.splitBaseExt fname
 952                                          in
 953                                              case ext of
 954                                                  NONE => ()
 955                                                | SOME extension' =>
 956                                                  if extension' = extension then
 957                                                      entries := readFile true ("\n" :: line :: "\n" :: heading base :: line :: !entries)
 958                                                  else
 959                                                      ()
 960                                          end
 961                                  end) ds;
 962                          loop ())
 963             in
 964                 loop ();
 965                 Posix.FileSys.closedir dir;
 966                 String.concat (List.concat (map (fn (_, entries) => rev (!entries)) ds))
 967             end
 968         else
 969             ""
 970     end
 971
 972 val () = registerDescriber (considerAll [Filename {filename = "soa",
 973                                                    heading = "DNS SOA:",
 974                                                    showEmpty = false}])
 975
 976 val () = Env.registerAction ("domainHost",
 977                              fn (env, [(EString host, _)]) =>
 978                                 SM.insert (env, "Hostname",
 979                                            (EString (host ^ "." ^ currentDomain ()), dl))
 980                               | (_, args) => Env.badArgs ("domainHost", args))
 981
 982 end