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 ("Mailbox",
 195                                   (TBase "email", dl),
 196                                   (fn () => (EString (getUser ()), dl)))
 197
 198 val _ = Defaults.registerDefault ("DNS",
 199                                   (TBase "dnsKind", dl),
 200                                   (fn () => multiApp ((EVar "useDns", dl),
 201                                                       dl,
 202                                                       [soaD, masterD, slavesD])))
 203
 204 val _ = Defaults.registerDefault ("TTL",
 205                                   (TBase "int", dl),
 206                                   (fn () => (EInt Config.Bind.defaultTTL, dl)))
 207
 208 type soa = {ns : string,
 209             serial : int option,
 210             ref : int,
 211             ret : int,
 212             exp : int,
 213             min : int}
 214
 215 val serial = fn (EVar "serialAuto", _) => SOME NONE
 216               | (EApp ((EVar "serialConst", _), n), _) => Option.map SOME (Env.int n)
 217               | _ => NONE
 218
 219 val soa = fn (EApp ((EApp ((EApp ((EApp ((EApp ((EApp
 220                                                      ((EVar "soa", _), ns), _),
 221                                                 sl), _),
 222                                          rf), _),
 223                                   ret), _),
 224                            exp), _),
 225                     min), _) =>
 226              (case (Env.string ns, serial sl, Env.int rf,
 227                     Env.int ret, Env.int exp, Env.int min) of
 228                   (SOME ns, SOME sl, SOME rf,
 229                    SOME ret, SOME exp, SOME min) =>
 230                   SOME {ns = ns,
 231                         serial = sl,
 232                         ref = rf,
 233                         ret = ret,
 234                         exp = exp,
 235                         min = min}
 236                 | _ => NONE)
 237            | _ => NONE
 238
 239 datatype master =
 240          ExternalMaster of string
 241        | InternalMaster of string
 242
 243 val ip = Env.string
 244
 245 val _ = Env.registerFunction ("ip_of_node",
 246                               fn [(EString node, _)] => SOME (EString (nodeIp node), dl)
 247                                | _ => NONE)
 248
 249 val master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (ip e)
 250               | (EApp ((EVar "internalMaster", _), e), _) => Option.map InternalMaster (Env.string e)
 251               | _ => NONE
 252
 253 datatype dnsKind =
 254          UseDns of {soa : soa,
 255                     master : master,
 256                     slaves : string list}
 257        | NoDns
 258
 259 val dnsKind = fn (EApp ((EApp ((EApp
 260                                     ((EVar "useDns", _), sa), _),
 261                                mstr), _),
 262                         slaves), _) =>
 263                  (case (soa sa, master mstr, Env.list Env.string slaves) of
 264                       (SOME sa, SOME mstr, SOME slaves) =>
 265                       SOME (UseDns {soa = sa,
 266                                     master = mstr,
 267                                     slaves = slaves})
 268                     | _ => NONE)
 269                | (EVar "noDns", _) => SOME NoDns
 270                | _ => NONE
 271
 272 val befores = ref (fn (_ : string) => ())
 273 val afters = ref (fn (_ : string) => ())
 274
 275 fun registerBefore f =
 276     let
 277         val old = !befores
 278     in
 279         befores := (fn x => (old x; f x))
 280     end
 281
 282 fun registerAfter f =
 283     let
 284         val old = !afters
 285     in
 286         afters := (fn x => (old x; f x))
 287     end
 288
 289 val globals = ref (fn () => ())
 290 val locals = ref (fn () => ())
 291
 292 fun registerResetGlobal f =
 293     let
 294         val old = !globals
 295     in
 296         globals := (fn x => (old x; f x))
 297     end
 298
 299 fun registerResetLocal f =
 300     let
 301         val old = !locals
 302     in
 303         locals := (fn x => (old x; f x))
 304     end
 305
 306 fun resetGlobal () = (!globals ();
 307                       ignore (OS.Process.system (Config.rm ^ " -rf " ^ Config.resultRoot ^ "/*")))
 308 fun resetLocal () = !locals ()
 309
 310 val current = ref ""
 311 val currentPath = ref (fn (_ : string) => "")
 312
 313 val scratch = ref ""
 314
 315 fun currentDomain () = !current
 316
 317 fun domainFile {node, name} = ((*print ("Opening " ^ !currentPath node ^ name ^ "\n");*)
 318                                TextIO.openOut (!currentPath node ^ name))
 319
 320 fun getPath domain =
 321     let
 322         val toks = String.fields (fn ch => ch = #".") domain
 323
 324         val elems = foldr (fn (piece, elems) =>
 325                               let
 326                                   val elems = piece :: elems
 327
 328                                   fun doNode node =
 329                                       let
 330                                           val path = String.concatWith "/"
 331                                                                        (Config.resultRoot :: node :: rev elems)
 332                                           val tmpPath = String.concatWith "/"
 333                                                                           (Config.tmpDir :: node :: rev elems)
 334                                       in
 335                                           (if Posix.FileSys.ST.isDir
 336                                                   (Posix.FileSys.stat path) then
 337                                                ()
 338                                            else
 339                                                (OS.FileSys.remove path;
 340                                                 OS.FileSys.mkDir path))
 341                                           handle OS.SysErr _ => OS.FileSys.mkDir path;
 342
 343                                           (if Posix.FileSys.ST.isDir
 344                                                   (Posix.FileSys.stat tmpPath) then
 345                                                ()
 346                                            else
 347                                                (OS.FileSys.remove tmpPath;
 348                                                 OS.FileSys.mkDir tmpPath))
 349                                           handle OS.SysErr _ => OS.FileSys.mkDir tmpPath
 350                                       end
 351                               in
 352                                   app doNode nodes;
 353                                   elems
 354                               end) [] toks
 355     in
 356         fn (root, site) => String.concatWith "/" (root :: site :: rev ("" :: elems))
 357     end
 358
 359 datatype file_action' =
 360          Add' of {src : string, dst : string}
 361        | Delete' of string
 362        | Modify' of {src : string, dst : string}
 363
 364 fun findDiffs (site, dom, acts) =
 365     let
 366         val gp = getPath dom
 367         val realPath = gp (Config.resultRoot, site)
 368         val tmpPath = gp (Config.tmpDir, site)
 369
 370         (*val _ = print ("getDiffs(" ^ site ^ ", " ^ dom ^ ")... " ^ realPath ^ "; " ^ tmpPath ^ "\n")*)
 371
 372         val dir = Posix.FileSys.opendir realPath
 373
 374         fun loopReal acts =
 375             case Posix.FileSys.readdir dir of
 376                 NONE => (Posix.FileSys.closedir dir;
 377                          acts)
 378               | SOME fname =>
 379                 let
 380                     val real = OS.Path.joinDirFile {dir = realPath,
 381                                                     file = fname}
 382                     val tmp = OS.Path.joinDirFile {dir = tmpPath,
 383                                                    file = fname}
 384                 in
 385                     if Posix.FileSys.ST.isDir (Posix.FileSys.stat real) then
 386                         loopReal acts
 387                     else if Posix.FileSys.access (tmp, []) then
 388                         if Slave.shell [Config.diff, " ", real, " ",  tmp] then
 389                             loopReal acts
 390                         else
 391                             loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)
 392                     else
 393                         loopReal ((site, dom, realPath, Delete' real) :: acts)
 394                 end
 395
 396         val acts = loopReal acts
 397
 398         val dir = Posix.FileSys.opendir tmpPath
 399
 400         fun loopTmp acts =
 401             case Posix.FileSys.readdir dir of
 402                 NONE => (Posix.FileSys.closedir dir;
 403                          acts)
 404               | SOME fname =>
 405                 let
 406                     val real = OS.Path.joinDirFile {dir = realPath,
 407                                                     file = fname}
 408                     val tmp = OS.Path.joinDirFile {dir = tmpPath,
 409                                                    file = fname}
 410                 in
 411                     if Posix.FileSys.ST.isDir (Posix.FileSys.stat tmp) then
 412                         loopTmp acts
 413                     else if Posix.FileSys.access (real, []) then
 414                         loopTmp acts
 415                     else
 416                         loopTmp ((site, dom, realPath, Add' {src = tmp, dst = real}) :: acts)
 417                 end
 418
 419         val acts = loopTmp acts
 420     in
 421         acts
 422     end
 423
 424 fun findAllDiffs () =
 425     let
 426         val dir = Posix.FileSys.opendir Config.tmpDir
 427         val len = length (String.fields (fn ch => ch = #"/") Config.tmpDir) + 1
 428
 429         fun exploreSites diffs =
 430             case Posix.FileSys.readdir dir of
 431                 NONE => diffs
 432               | SOME site =>
 433                 let
 434                     fun explore (dname, diffs) =
 435                         let
 436                             val dir = Posix.FileSys.opendir dname
 437
 438                             fun loop diffs =
 439                                 case Posix.FileSys.readdir dir of
 440                                     NONE => diffs
 441                                   | SOME name =>
 442                                     let
 443                                         val fname = OS.Path.joinDirFile {dir = dname,
 444                                                                          file = name}
 445                                     in
 446                                         loop (if Posix.FileSys.ST.isDir (Posix.FileSys.stat fname) then
 447                                                   let
 448                                                       val dom = String.fields (fn ch => ch = #"/") fname
 449                                                       val dom = List.drop (dom, len)
 450                                                       val dom = String.concatWith "." (rev dom)
 451
 452                                                       val dname' = OS.Path.joinDirFile {dir = dname,
 453                                                                                         file = name}
 454                                                   in
 455                                                       explore (dname',
 456                                                                findDiffs (site, dom, diffs))
 457                                                   end
 458                                               else
 459                                                   diffs)
 460                                     end
 461                         in
 462                             loop diffs
 463                             before Posix.FileSys.closedir dir
 464                         end
 465                 in
 466                     exploreSites (explore (OS.Path.joinDirFile {dir = Config.tmpDir,
 467                                                                 file = site}, diffs))
 468                 end
 469     in
 470         exploreSites []
 471         before Posix.FileSys.closedir dir
 472     end
 473
 474 val masterNode : string option ref = ref NONE
 475 fun dnsMaster () = !masterNode
 476
 477 val _ = Env.containerV_one "domain"
 478                            ("domain", Env.string)
 479                            (fn (evs, dom) =>
 480                                let
 481                                    val kind = Env.env dnsKind (evs, "DNS")
 482                                    val ttl = Env.env Env.int (evs, "TTL")
 483
 484                                    val path = getPath dom
 485
 486                                    val () = (current := dom;
 487                                              currentPath := (fn site => path (Config.tmpDir, site)))
 488
 489                                    fun saveSoa (kind, soa : soa) node =
 490                                        if dom = "localhost" then
 491                                            ()
 492                                        else let
 493                                                val outf = domainFile {node = node, name = "soa"}
 494                                            in
 495                                                TextIO.output (outf, kind);
 496                                                TextIO.output (outf, "\n");
 497                                                TextIO.output (outf, Int.toString ttl);
 498                                                TextIO.output (outf, "\n");
 499                                                TextIO.output (outf, #ns soa);
 500                                                TextIO.output (outf, "\n");
 501                                                case #serial soa of
 502                                                    NONE => ()
 503                                                  | SOME n => TextIO.output (outf, Int.toString n);
 504                                                TextIO.output (outf, "\n");
 505                                                TextIO.output (outf, Int.toString (#ref soa));
 506                                                TextIO.output (outf, "\n");
 507                                                TextIO.output (outf, Int.toString (#ret soa));
 508                                                TextIO.output (outf, "\n");
 509                                                TextIO.output (outf, Int.toString (#exp soa));
 510                                                TextIO.output (outf, "\n");
 511                                                TextIO.output (outf, Int.toString (#min soa));
 512                                                TextIO.output (outf, "\n");
 513                                                TextIO.closeOut outf
 514                                            end
 515
 516                                    fun saveNamed (kind, soa : soa, masterIp) node =
 517                                        if dom = "localhost" then
 518                                            ()
 519                                        else let
 520                                                val outf = domainFile {node = node, name = "named.conf"}
 521                                            in
 522                                                TextIO.output (outf, "\nzone \"");
 523                                                TextIO.output (outf, dom);
 524                                                TextIO.output (outf, "\" IN {\n\ttype ");
 525                                                TextIO.output (outf, kind);
 526                                                TextIO.output (outf, ";\n\tfile \"");
 527                                                TextIO.output (outf, Config.Bind.zonePath_real);
 528                                                TextIO.output (outf, "/");
 529                                                TextIO.output (outf, dom);
 530                                                TextIO.output (outf, ".zone\";\n");
 531                                                case kind of
 532                                                    "master" => TextIO.output (outf, "\tallow-update { none; };\n")
 533                                                  | _ => (TextIO.output (outf, "\tmasters { ");
 534                                                          TextIO.output (outf, masterIp);
 535                                                          TextIO.output (outf, "; };\n"));
 536                                                TextIO.output (outf, "};\n");
 537                                                TextIO.closeOut outf
 538                                            end
 539                                in
 540                                    case kind of
 541                                        NoDns => masterNode := NONE
 542                                      | UseDns dns =>
 543                                        let
 544                                            val masterIp =
 545                                                case #master dns of
 546                                                    InternalMaster node => valOf (SM.find (nodeMap, node))
 547                                                  | ExternalMaster ip => ip
 548                                        in
 549                                            app (saveSoa ("slave", #soa dns)) (#slaves dns);
 550                                            app (saveNamed ("slave", #soa dns, masterIp)) (#slaves dns);
 551                                            case #master dns of
 552                                                InternalMaster node =>
 553                                                (masterNode := SOME node;
 554                                                 saveSoa ("master", #soa dns) node;
 555                                                 saveNamed ("master", #soa dns, masterIp) node)
 556                                              | _ => masterNode := NONE;
 557                                            !befores dom
 558                                        end
 559                                end,
 560                             fn () => !afters (!current))
 561
 562 val () = Env.registerPre (fn () => (ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
 563                                                        fn cl => "Temp file cleanup failed: " ^ cl));
 564                                     OS.FileSys.mkDir Config.tmpDir;
 565                                     app (fn node => OS.FileSys.mkDir
 566                                                         (OS.Path.joinDirFile {dir = Config.tmpDir,
 567                                                                               file = node}))
 568                                         nodes;
 569                                     app (fn node => OS.FileSys.mkDir
 570                                                         (OS.Path.joinDirFile {dir = Config.resultRoot,
 571                                                                               file = node})
 572                                             handle OS.SysErr _ => ())
 573                                         nodes))
 574
 575 fun handleSite (site, files) =
 576     let
 577
 578     in
 579         print ("New configuration for node " ^ site ^ "\n");
 580         if site = Config.defaultNode then
 581             Slave.handleChanges files
 582         else let
 583                 val bio = OpenSSL.connect (valOf (!ssl_context),
 584                                            nodeIp site
 585                                            ^ ":"
 586                                            ^ Int.toString Config.slavePort)
 587             in
 588                 app (fn file => Msg.send (bio, MsgFile file)) files;
 589                 Msg.send (bio, MsgDoFiles);
 590                 case Msg.recv bio of
 591                     NONE => print "Slave closed connection unexpectedly\n"
 592                   | SOME m =>
 593                     case m of
 594                         MsgOk => print ("Slave " ^ site ^ " finished\n")
 595                       | MsgError s => print ("Slave " ^ site
 596                                              ^ " returned error: " ^
 597                                              s ^ "\n")
 598                       | _ => print ("Slave " ^ site
 599                                     ^ " returned unexpected command\n");
 600                 OpenSSL.close bio
 601             end
 602     end
 603
 604 val () = Env.registerPost (fn () =>
 605                               let
 606                                   val diffs = findAllDiffs ()
 607
 608                                   val diffs = map (fn (site, dom, dir, Add' {src, dst}) =>
 609                                                       (Slave.shellF ([Config.cp, " ", src, " ", dst],
 610                                                                   fn cl => "Copy failed: " ^ cl);
 611                                                        (site,
 612                                                         {action = Slave.Add,
 613                                                          domain = dom,
 614                                                          dir = dir,
 615                                                          file = dst}))
 616                                                     | (site, dom, dir, Delete' dst) =>
 617                                                       (OS.FileSys.remove dst
 618                                                        handle OS.SysErr _ =>
 619                                                               ErrorMsg.error NONE ("Delete failed for " ^ dst);
 620                                                        (site,
 621                                                         {action = Slave.Delete,
 622                                                          domain = dom,
 623                                                          dir = dir,
 624                                                          file = dst}))
 625                                                     | (site, dom, dir, Modify' {src, dst}) =>
 626                                                       (Slave.shellF ([Config.cp, " ", src, " ", dst],
 627                                                                   fn cl => "Copy failed: " ^ cl);
 628                                                        (site,
 629                                                         {action = Slave.Modify,
 630                                                          domain = dom,
 631                                                          dir = dir,
 632                                                          file = dst}))) diffs
 633                               in
 634                                   if !ErrorMsg.anyErrors then
 635                                       ()
 636                                   else let
 637                                           val changed = foldl (fn ((site, file), changed) =>
 638                                                                   let
 639                                                                       val ls = case SM.find (changed, site) of
 640                                                                                    NONE => []
 641                                                                                  | SOME ls => ls
 642                                                                   in
 643                                                                       SM.insert (changed, site, file :: ls)
 644                                                                   end) SM.empty diffs
 645                                       in
 646                                           SM.appi handleSite changed
 647                                       end;
 648                                   ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
 649                                                      fn cl => "Temp file cleanup failed: " ^ cl))
 650                               end)
 651
 652 fun hasPriv priv = Acl.query {user = getUser (), class = "priv", value = "all"}
 653                    orelse Acl.query {user = getUser (), class = "priv", value = priv}
 654
 655 val _ = Env.type_one "dns_node"
 656         Env.string
 657         (fn node =>
 658             List.exists (fn x => x = node) Config.dnsNodes_all
 659             orelse (hasPriv "dns"
 660                     andalso List.exists (fn x => x = node) Config.dnsNodes_admin))
 661
 662 val _ = Env.type_one "mail_node"
 663         Env.string
 664         (fn node =>
 665             List.exists (fn x => x = node) Config.mailNodes_all
 666             orelse (hasPriv "mail"
 667                     andalso List.exists (fn x => x = node) Config.mailNodes_admin))
 668
 669 fun rmdom doms =
 670     let
 671         fun doNode (node, _) =
 672             let
 673                 val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
 674                                                  file = node}
 675
 676                 fun doDom (dom, actions) =
 677                     let
 678                         val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
 679                         val dname = OS.Path.concat (dname, domPath)
 680
 681                         fun visitDom (dom, dname, actions) =
 682                             let
 683                                 val dir = Posix.FileSys.opendir dname
 684
 685                                 fun loop actions =
 686                                     case Posix.FileSys.readdir dir of
 687                                         NONE => actions
 688                                       | SOME fname =>
 689                                         let
 690                                             val fnameFull = OS.Path.joinDirFile {dir = dname,
 691                                                                                  file = fname}
 692                                         in
 693                                             if Posix.FileSys.ST.isDir (Posix.FileSys.stat fnameFull) then
 694                                                 loop (visitDom (fname ^ "." ^ dom,
 695                                                                 fnameFull,
 696                                                                 actions))
 697                                             else
 698                                                 loop ({action = Slave.Delete,
 699                                                        domain = dom,
 700                                                        dir = dname,
 701                                                        file = fnameFull} :: actions)
 702                                         end
 703                             in
 704                                 loop actions
 705                                 before Posix.FileSys.closedir dir
 706                             end
 707                                 handle OS.SysErr _ =>
 708                                        (print ("Warning: System error deleting domain " ^ dom ^ " on " ^ node ^ ".\n");
 709                                         actions)
 710                     in
 711                         visitDom (dom, dname, actions)
 712                     end
 713
 714                 val actions = foldl doDom [] doms
 715             in
 716                 handleSite (node, actions)
 717             end
 718                 handle IO.Io _ => print ("Warning: IO error deleting domains on " ^ node ^ ".\n")
 719
 720         fun cleanupNode (node, _) =
 721             let
 722                 fun doDom dom =
 723                     let
 724                         val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
 725                         val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
 726                                                          file = node}
 727                         val dname = OS.Path.concat (dname, domPath)
 728                     in
 729                         ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
 730                     end
 731             in
 732                 app doDom doms
 733             end
 734     in
 735         app doNode Config.nodeIps;
 736         app cleanupNode Config.nodeIps
 737     end
 738
 739 end