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 < 20
 117     andalso CharVector.all (fn ch => isIdent ch orelse ch = #"-") s
 118
 119 fun validDomain s =
 120     size s > 0 andalso size s < 100
 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 "};\n";
 650                                                close ()
 651                                            end
 652                                in
 653                                    case kind of
 654                                        NoDns => masterNode := NONE
 655                                      | UseDns dns =>
 656                                        let
 657                                            val masterIp =
 658                                                case #master dns of
 659                                                    InternalMaster node => nodeIp node
 660                                                  | ExternalMaster ip => ip
 661
 662                                            val slaveIps = map nodeIp (#slaves dns)
 663                                        in
 664                                            app (saveSoa ("slave", #soa dns)) (#slaves dns);
 665                                            app (saveNamed ("slave", #soa dns, masterIp, slaveIps)) (#slaves dns);
 666                                            case #master dns of
 667                                                InternalMaster node =>
 668                                                (masterNode := SOME node;
 669                                                 saveSoa ("master", #soa dns) node;
 670                                                 saveNamed ("master", #soa dns, masterIp, slaveIps) node)
 671                                              | _ => masterNode := NONE
 672                                        end;
 673                                    !befores dom
 674                                end,
 675                             fn () => !afters (!current))
 676
 677 val () = Env.registerPre (fn () => (seenDomains := [];
 678                                     ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
 679                                                        fn cl => "Temp file cleanup failed: " ^ cl));
 680                                     OS.FileSys.mkDir Config.tmpDir;
 681                                     app (fn node => OS.FileSys.mkDir
 682                                                         (OS.Path.joinDirFile {dir = Config.tmpDir,
 683                                                                               file = node}))
 684                                         nodes;
 685                                     app (fn node => OS.FileSys.mkDir
 686                                                         (OS.Path.joinDirFile {dir = Config.resultRoot,
 687                                                                               file = node})
 688                                             handle OS.SysErr _ => ())
 689                                         nodes))
 690
 691 fun handleSite (site, files) =
 692     let
 693
 694     in
 695         print ("New configuration for node " ^ site ^ "\n");
 696         if site = Config.defaultNode then
 697             Slave.handleChanges files
 698         else let
 699                 val bio = OpenSSL.connect (valOf (!ssl_context),
 700                                            nodeIp site
 701                                            ^ ":"
 702                                            ^ Int.toString Config.slavePort)
 703             in
 704                 app (fn file => Msg.send (bio, MsgFile file)) files;
 705                 Msg.send (bio, MsgDoFiles);
 706                 case Msg.recv bio of
 707                     NONE => print "Slave closed connection unexpectedly\n"
 708                   | SOME m =>
 709                     case m of
 710                         MsgOk => print ("Slave " ^ site ^ " finished\n")
 711                       | MsgError s => print ("Slave " ^ site
 712                                              ^ " returned error: " ^
 713                                              s ^ "\n")
 714                       | _ => print ("Slave " ^ site
 715                                     ^ " returned unexpected command\n");
 716                 OpenSSL.close bio
 717             end
 718     end
 719
 720 val () = Env.registerPost (fn () =>
 721                               let
 722                                   val prefixes = List.concat
 723                                                      (List.map (fn dom =>
 724                                                                    let
 725                                                                        val pieces = String.tokens (fn ch => ch = #".") dom
 726                                                                        val path = String.concatWith "/" (rev pieces)
 727                                                                    in
 728                                                                        List.map (fn node =>
 729                                                                                     Config.resultRoot ^ "/" ^ node ^ "/" ^ path ^ "/")
 730                                                                                 nodes
 731                                                                    end) (!seenDomains))
 732
 733                                   val diffs = findAllDiffs prefixes
 734
 735                                   val diffs = map (fn (site, dom, dir, Add' {src, dst}) =>
 736                                                       (Slave.shellF ([Config.cp, " ", src, " ", dst],
 737                                                                   fn cl => "Copy failed: " ^ cl);
 738                                                        (site,
 739                                                         {action = Slave.Add,
 740                                                          domain = dom,
 741                                                          dir = dir,
 742                                                          file = dst}))
 743                                                     | (site, dom, dir, Delete' dst) =>
 744                                                       (OS.FileSys.remove dst
 745                                                        handle OS.SysErr _ =>
 746                                                               ErrorMsg.error NONE ("Delete failed for " ^ dst);
 747                                                        (site,
 748                                                         {action = Slave.Delete true,
 749                                                          domain = dom,
 750                                                          dir = dir,
 751                                                          file = dst}))
 752                                                     | (site, dom, dir, Modify' {src, dst}) =>
 753                                                       (Slave.shellF ([Config.cp, " ", src, " ", dst],
 754                                                                   fn cl => "Copy failed: " ^ cl);
 755                                                        (site,
 756                                                         {action = Slave.Modify,
 757                                                          domain = dom,
 758                                                          dir = dir,
 759                                                          file = dst}))) diffs
 760                               in
 761                                   if !ErrorMsg.anyErrors then
 762                                       ()
 763                                   else let
 764                                           val changed = foldl (fn ((site, file), changed) =>
 765                                                                   let
 766                                                                       val ls = case SM.find (changed, site) of
 767                                                                                    NONE => []
 768                                                                                  | SOME ls => ls
 769                                                                   in
 770                                                                       SM.insert (changed, site, file :: ls)
 771                                                                   end) SM.empty diffs
 772                                       in
 773                                           SM.appi handleSite changed
 774                                       end;
 775                                   ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
 776                                                      fn cl => "Temp file cleanup failed: " ^ cl))
 777                               end)
 778
 779 fun hasPriv priv = Acl.query {user = getUser (), class = "priv", value = "all"}
 780                    orelse Acl.query {user = getUser (), class = "priv", value = priv}
 781
 782 val _ = Env.type_one "dns_node"
 783         Env.string
 784         (fn node =>
 785             List.exists (fn x => x = node) Config.dnsNodes_all
 786             orelse (hasPriv "dns"
 787                     andalso List.exists (fn x => x = node) Config.dnsNodes_admin))
 788
 789 val _ = Env.type_one "mail_node"
 790         Env.string
 791         (fn node =>
 792             List.exists (fn x => x = node) Config.mailNodes_all
 793             orelse (hasPriv "mail"
 794                     andalso List.exists (fn x => x = node) Config.mailNodes_admin))
 795
 796 fun rmdom' delete resultRoot doms =
 797     let
 798         fun doNode (node, _) =
 799             let
 800                 val dname = OS.Path.joinDirFile {dir = resultRoot,
 801                                                  file = node}
 802
 803                 fun doDom (dom, actions) =
 804                     let
 805                         val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
 806                         val dname = OS.Path.concat (dname, domPath)
 807
 808                         fun visitDom (dom, dname, actions) =
 809                             let
 810                                 val dir = Posix.FileSys.opendir dname
 811
 812                                 fun loop actions =
 813                                     case Posix.FileSys.readdir dir of
 814                                         NONE => actions
 815                                       | SOME fname =>
 816                                         let
 817                                             val fnameFull = OS.Path.joinDirFile {dir = dname,
 818                                                                                  file = fname}
 819                                         in
 820                                             if Posix.FileSys.ST.isDir (Posix.FileSys.stat fnameFull) then
 821                                                 loop (visitDom (fname ^ "." ^ dom,
 822                                                                 fnameFull,
 823                                                                 actions))
 824                                             else
 825                                                  loop ({action = Slave.Delete delete,
 826                                                         domain = dom,
 827                                                         dir = dname,
 828                                                         file = fnameFull} :: actions)
 829                                         end
 830                             in
 831                                 loop actions
 832                                 before Posix.FileSys.closedir dir
 833                             end
 834                                 handle OS.SysErr (s, _) =>
 835                                        (print ("Warning: System error deleting domain " ^ dom ^ " on " ^ node ^ ": " ^ s ^ "\n");
 836                                         actions)
 837                     in
 838                         visitDom (dom, dname, actions)
 839                     end
 840
 841                 val actions = foldl doDom [] doms
 842             in
 843                 handleSite (node, actions)
 844             end
 845                 handle IO.Io _ => print ("Warning: IO error deleting domains on " ^ node ^ ".\n")
 846
 847         fun cleanupNode (node, _) =
 848             let
 849                 fun doDom dom =
 850                     let
 851                         val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
 852                         val dname = OS.Path.joinDirFile {dir = resultRoot,
 853                                                          file = node}
 854                         val dname = OS.Path.concat (dname, domPath)
 855                     in
 856                         if delete then
 857                             ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
 858                         else
 859                             ()
 860                     end
 861             in
 862                 app doDom doms
 863             end
 864     in
 865         app doNode Config.nodeIps;
 866         app cleanupNode Config.nodeIps
 867     end
 868
 869 val rmdom = rmdom' true Config.resultRoot
 870 val rmdom' = rmdom' false
 871
 872 fun homedirOf uname =
 873     Posix.SysDB.Passwd.home (Posix.SysDB.getpwnam uname)
 874
 875 fun homedir () = homedirOf (getUser ())
 876
 877 type subject = {node : string, domain : string}
 878
 879 val describers : (subject -> string) list ref = ref []
 880
 881 fun registerDescriber f = describers := f :: !describers
 882
 883 fun describeOne arg = String.concat (map (fn f => f arg) (rev (!describers)))
 884
 885 val line = "--------------------------------------------------------------\n"
 886 val dline = "==============================================================\n"
 887
 888 fun describe dom =
 889     String.concat (List.mapPartial
 890                        (fn node =>
 891                            case describeOne {node = node, domain = dom} of
 892                                "" => NONE
 893                              | s =>
 894                                SOME (String.concat [dline, "Node ", node, "\n", dline, "\n", s]))
 895                        nodes)
 896
 897 datatype description =
 898          Filename of { filename : string, heading : string, showEmpty : bool }
 899        | Extension of { extension : string, heading : string -> string }
 900
 901 fun considerAll ds {node, domain} =
 902     let
 903         val ds = map (fn d => (d, ref [])) ds
 904
 905         val path = Config.resultRoot
 906         val jdf = OS.Path.joinDirFile
 907         val path = jdf {dir = path, file = node}
 908         val path = foldr (fn (more, path) => jdf {dir = path, file = more})
 909                          path (String.tokens (fn ch => ch = #".") domain)
 910     in
 911         if Posix.FileSys.access (path, []) then
 912             let
 913                 val dir = Posix.FileSys.opendir path
 914
 915                 fun loop () =
 916                     case Posix.FileSys.readdir dir of
 917                         NONE => ()
 918                       | SOME fname =>
 919                         (app (fn (d, entries) =>
 920                                  let
 921                                      fun readFile showEmpty entries' =
 922                                          let
 923                                              val fname = OS.Path.joinDirFile {dir = path,
 924                                                                               file = fname}
 925
 926                                              val inf = TextIO.openIn fname
 927
 928                                              fun loop (seenOne, entries') =
 929                                                  case TextIO.inputLine inf of
 930                                                      NONE => if seenOne orelse showEmpty then
 931                                                                  "\n" :: entries'
 932                                                              else
 933                                                                  !entries
 934                                                    | SOME line => loop (true, line :: entries')
 935                                          in
 936                                              loop (false, entries')
 937                                              before TextIO.closeIn inf
 938                                          end
 939                                  in
 940                                      case d of
 941                                          Filename {filename, heading, showEmpty} =>
 942                                          if fname = filename then
 943                                              entries := readFile showEmpty ("\n" :: line :: "\n" :: heading :: line :: !entries)
 944                                          else
 945                                              ()
 946                                        | Extension {extension, heading} =>
 947                                          let
 948                                              val {base, ext} = OS.Path.splitBaseExt fname
 949                                          in
 950                                              case ext of
 951                                                  NONE => ()
 952                                                | SOME extension' =>
 953                                                  if extension' = extension then
 954                                                      entries := readFile true ("\n" :: line :: "\n" :: heading base :: line :: !entries)
 955                                                  else
 956                                                      ()
 957                                          end
 958                                  end) ds;
 959                          loop ())
 960             in
 961                 loop ();
 962                 Posix.FileSys.closedir dir;
 963                 String.concat (List.concat (map (fn (_, entries) => rev (!entries)) ds))
 964             end
 965         else
 966             ""
 967     end
 968
 969 val () = registerDescriber (considerAll [Filename {filename = "soa",
 970                                                    heading = "DNS SOA:",
 971                                                    showEmpty = false}])
 972
 973 val () = Env.registerAction ("domainHost",
 974                              fn (env, [(EString host, _)]) =>
 975                                 SM.insert (env, "Hostname",
 976                                            (EString (host ^ "." ^ currentDomain ()), dl))
 977                               | (_, args) => Env.badArgs ("domainHost", args))
 978
 979 end