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