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) 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 "\" IN {\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-update { none; };\n"
 558                                                  | _ => (write "\tmasters { ";
 559                                                          write masterIp;
 560                                                          write "; };\n");
 561                                                write "};\n";
 562                                                close ()
 563                                            end
 564                                in
 565                                    case kind of
 566                                        NoDns => masterNode := NONE
 567                                      | UseDns dns =>
 568                                        let
 569                                            val masterIp =
 570                                                case #master dns of
 571                                                    InternalMaster node => valOf (SM.find (nodeMap, node))
 572                                                  | ExternalMaster ip => ip
 573                                        in
 574                                            app (saveSoa ("slave", #soa dns)) (#slaves dns);
 575                                            app (saveNamed ("slave", #soa dns, masterIp)) (#slaves dns);
 576                                            case #master dns of
 577                                                InternalMaster node =>
 578                                                (masterNode := SOME node;
 579                                                 saveSoa ("master", #soa dns) node;
 580                                                 saveNamed ("master", #soa dns, masterIp) node)
 581                                              | _ => masterNode := NONE;
 582                                            !befores dom
 583                                        end
 584                                end,
 585                             fn () => !afters (!current))
 586
 587 val () = Env.registerPre (fn () => (ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
 588                                                        fn cl => "Temp file cleanup failed: " ^ cl));
 589                                     OS.FileSys.mkDir Config.tmpDir;
 590                                     app (fn node => OS.FileSys.mkDir
 591                                                         (OS.Path.joinDirFile {dir = Config.tmpDir,
 592                                                                               file = node}))
 593                                         nodes;
 594                                     app (fn node => OS.FileSys.mkDir
 595                                                         (OS.Path.joinDirFile {dir = Config.resultRoot,
 596                                                                               file = node})
 597                                             handle OS.SysErr _ => ())
 598                                         nodes))
 599
 600 fun handleSite (site, files) =
 601     let
 602
 603     in
 604         print ("New configuration for node " ^ site ^ "\n");
 605         if site = Config.defaultNode then
 606             Slave.handleChanges files
 607         else let
 608                 val bio = OpenSSL.connect (valOf (!ssl_context),
 609                                            nodeIp site
 610                                            ^ ":"
 611                                            ^ Int.toString Config.slavePort)
 612             in
 613                 app (fn file => Msg.send (bio, MsgFile file)) files;
 614                 Msg.send (bio, MsgDoFiles);
 615                 case Msg.recv bio of
 616                     NONE => print "Slave closed connection unexpectedly\n"
 617                   | SOME m =>
 618                     case m of
 619                         MsgOk => print ("Slave " ^ site ^ " finished\n")
 620                       | MsgError s => print ("Slave " ^ site
 621                                              ^ " returned error: " ^
 622                                              s ^ "\n")
 623                       | _ => print ("Slave " ^ site
 624                                     ^ " returned unexpected command\n");
 625                 OpenSSL.close bio
 626             end
 627     end
 628
 629 val () = Env.registerPost (fn () =>
 630                               let
 631                                   val diffs = findAllDiffs ()
 632
 633                                   val diffs = map (fn (site, dom, dir, Add' {src, dst}) =>
 634                                                       (Slave.shellF ([Config.cp, " ", src, " ", dst],
 635                                                                   fn cl => "Copy failed: " ^ cl);
 636                                                        (site,
 637                                                         {action = Slave.Add,
 638                                                          domain = dom,
 639                                                          dir = dir,
 640                                                          file = dst}))
 641                                                     | (site, dom, dir, Delete' dst) =>
 642                                                       (OS.FileSys.remove dst
 643                                                        handle OS.SysErr _ =>
 644                                                               ErrorMsg.error NONE ("Delete failed for " ^ dst);
 645                                                        (site,
 646                                                         {action = Slave.Delete,
 647                                                          domain = dom,
 648                                                          dir = dir,
 649                                                          file = dst}))
 650                                                     | (site, dom, dir, Modify' {src, dst}) =>
 651                                                       (Slave.shellF ([Config.cp, " ", src, " ", dst],
 652                                                                   fn cl => "Copy failed: " ^ cl);
 653                                                        (site,
 654                                                         {action = Slave.Modify,
 655                                                          domain = dom,
 656                                                          dir = dir,
 657                                                          file = dst}))) diffs
 658                               in
 659                                   if !ErrorMsg.anyErrors then
 660                                       ()
 661                                   else let
 662                                           val changed = foldl (fn ((site, file), changed) =>
 663                                                                   let
 664                                                                       val ls = case SM.find (changed, site) of
 665                                                                                    NONE => []
 666                                                                                  | SOME ls => ls
 667                                                                   in
 668                                                                       SM.insert (changed, site, file :: ls)
 669                                                                   end) SM.empty diffs
 670                                       in
 671                                           SM.appi handleSite changed
 672                                       end;
 673                                   ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
 674                                                      fn cl => "Temp file cleanup failed: " ^ cl))
 675                               end)
 676
 677 fun hasPriv priv = Acl.query {user = getUser (), class = "priv", value = "all"}
 678                    orelse Acl.query {user = getUser (), class = "priv", value = priv}
 679
 680 val _ = Env.type_one "dns_node"
 681         Env.string
 682         (fn node =>
 683             List.exists (fn x => x = node) Config.dnsNodes_all
 684             orelse (hasPriv "dns"
 685                     andalso List.exists (fn x => x = node) Config.dnsNodes_admin))
 686
 687 val _ = Env.type_one "mail_node"
 688         Env.string
 689         (fn node =>
 690             List.exists (fn x => x = node) Config.mailNodes_all
 691             orelse (hasPriv "mail"
 692                     andalso List.exists (fn x => x = node) Config.mailNodes_admin))
 693
 694 fun rmdom doms =
 695     let
 696         fun doNode (node, _) =
 697             let
 698                 val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
 699                                                  file = node}
 700
 701                 fun doDom (dom, actions) =
 702                     let
 703                         val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
 704                         val dname = OS.Path.concat (dname, domPath)
 705
 706                         fun visitDom (dom, dname, actions) =
 707                             let
 708                                 val dir = Posix.FileSys.opendir dname
 709
 710                                 fun loop actions =
 711                                     case Posix.FileSys.readdir dir of
 712                                         NONE => actions
 713                                       | SOME fname =>
 714                                         let
 715                                             val fnameFull = OS.Path.joinDirFile {dir = dname,
 716                                                                                  file = fname}
 717                                         in
 718                                             if Posix.FileSys.ST.isDir (Posix.FileSys.stat fnameFull) then
 719                                                 loop (visitDom (fname ^ "." ^ dom,
 720                                                                 fnameFull,
 721                                                                 actions))
 722                                             else
 723                                                 loop ({action = Slave.Delete,
 724                                                        domain = dom,
 725                                                        dir = dname,
 726                                                        file = fnameFull} :: actions)
 727                                         end
 728                             in
 729                                 loop actions
 730                                 before Posix.FileSys.closedir dir
 731                             end
 732                                 handle OS.SysErr _ =>
 733                                        (print ("Warning: System error deleting domain " ^ dom ^ " on " ^ node ^ ".\n");
 734                                         actions)
 735                     in
 736                         visitDom (dom, dname, actions)
 737                     end
 738
 739                 val actions = foldl doDom [] doms
 740             in
 741                 handleSite (node, actions)
 742             end
 743                 handle IO.Io _ => print ("Warning: IO error deleting domains on " ^ node ^ ".\n")
 744
 745         fun cleanupNode (node, _) =
 746             let
 747                 fun doDom dom =
 748                     let
 749                         val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
 750                         val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
 751                                                          file = node}
 752                         val dname = OS.Path.concat (dname, domPath)
 753                     in
 754                         ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
 755                     end
 756             in
 757                 app doDom doms
 758             end
 759     in
 760         app doNode Config.nodeIps;
 761         app cleanupNode Config.nodeIps
 762     end
 763
 764 fun homedirOf uname =
 765     Posix.SysDB.Passwd.home (Posix.SysDB.getpwnam uname)
 766
 767 fun homedir () = homedirOf (getUser ())
 768
 769 end