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