src/domain.sml

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