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                                        let
 491                                            val outf = domainFile {node = node, name = "soa"}
 492                                        in
 493                                            TextIO.output (outf, kind);
 494                                            TextIO.output (outf, "\n");
 495                                            TextIO.output (outf, Int.toString ttl);
 496                                            TextIO.output (outf, "\n");
 497                                            TextIO.output (outf, #ns soa);
 498                                            TextIO.output (outf, "\n");
 499                                            case #serial soa of
 500                                                NONE => ()
 501                                              | SOME n => TextIO.output (outf, Int.toString n);
 502                                            TextIO.output (outf, "\n");
 503                                            TextIO.output (outf, Int.toString (#ref soa));
 504                                            TextIO.output (outf, "\n");
 505                                            TextIO.output (outf, Int.toString (#ret soa));
 506                                            TextIO.output (outf, "\n");
 507                                            TextIO.output (outf, Int.toString (#exp soa));
 508                                            TextIO.output (outf, "\n");
 509                                            TextIO.output (outf, Int.toString (#min soa));
 510                                            TextIO.output (outf, "\n");
 511                                            TextIO.closeOut outf
 512                                        end
 513
 514                                    fun saveNamed (kind, soa : soa, masterIp) node =
 515                                        if dom = "localhost" then
 516                                            ()
 517                                        else let
 518                                                val outf = domainFile {node = node, name = "named.conf"}
 519                                            in
 520                                                TextIO.output (outf, "\nzone \"");
 521                                                TextIO.output (outf, dom);
 522                                                TextIO.output (outf, "\" IN {\n\ttype ");
 523                                                TextIO.output (outf, kind);
 524                                                TextIO.output (outf, ";\n\tfile \"");
 525                                                TextIO.output (outf, Config.Bind.zonePath_real);
 526                                                TextIO.output (outf, "/");
 527                                                TextIO.output (outf, dom);
 528                                                TextIO.output (outf, ".zone\";\n");
 529                                                case kind of
 530                                                    "master" => TextIO.output (outf, "\tallow-update { none; };\n")
 531                                                  | _ => (TextIO.output (outf, "\tmasters { ");
 532                                                          TextIO.output (outf, masterIp);
 533                                                          TextIO.output (outf, "; };\n"));
 534                                                TextIO.output (outf, "};\n");
 535                                                TextIO.closeOut outf
 536                                            end
 537                                in
 538                                    case kind of
 539                                        NoDns => masterNode := NONE
 540                                      | UseDns dns =>
 541                                        let
 542                                            val masterIp =
 543                                                case #master dns of
 544                                                    InternalMaster node => valOf (SM.find (nodeMap, node))
 545                                                  | ExternalMaster ip => ip
 546                                        in
 547                                            app (saveSoa ("slave", #soa dns)) (#slaves dns);
 548                                            app (saveNamed ("slave", #soa dns, masterIp)) (#slaves dns);
 549                                            case #master dns of
 550                                                InternalMaster node =>
 551                                                (masterNode := SOME node;
 552                                                 saveSoa ("master", #soa dns) node;
 553                                                 saveNamed ("master", #soa dns, masterIp) node)
 554                                              | _ => masterNode := NONE;
 555                                            !befores dom
 556                                        end
 557                                end,
 558                             fn () => !afters (!current))
 559
 560 val () = Env.registerPre (fn () => (ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
 561                                                        fn cl => "Temp file cleanup failed: " ^ cl));
 562                                     OS.FileSys.mkDir Config.tmpDir;
 563                                     app (fn node => OS.FileSys.mkDir
 564                                                         (OS.Path.joinDirFile {dir = Config.tmpDir,
 565                                                                               file = node}))
 566                                         nodes;
 567                                     app (fn node => OS.FileSys.mkDir
 568                                                         (OS.Path.joinDirFile {dir = Config.resultRoot,
 569                                                                               file = node})
 570                                             handle OS.SysErr _ => ())
 571                                         nodes))
 572
 573 fun handleSite (site, files) =
 574     let
 575
 576     in
 577         print ("New configuration for node " ^ site ^ "\n");
 578         if site = Config.defaultNode then
 579             Slave.handleChanges files
 580         else let
 581                 val bio = OpenSSL.connect (valOf (!ssl_context),
 582                                            nodeIp site
 583                                            ^ ":"
 584                                            ^ Int.toString Config.slavePort)
 585             in
 586                 app (fn file => Msg.send (bio, MsgFile file)) files;
 587                 Msg.send (bio, MsgDoFiles);
 588                 case Msg.recv bio of
 589                     NONE => print "Slave closed connection unexpectedly\n"
 590                   | SOME m =>
 591                     case m of
 592                         MsgOk => print ("Slave " ^ site ^ " finished\n")
 593                       | MsgError s => print ("Slave " ^ site
 594                                              ^ " returned error: " ^
 595                                              s ^ "\n")
 596                       | _ => print ("Slave " ^ site
 597                                     ^ " returned unexpected command\n");
 598                 OpenSSL.close bio
 599             end
 600     end
 601
 602 val () = Env.registerPost (fn () =>
 603                               let
 604                                   val diffs = findAllDiffs ()
 605
 606                                   val diffs = map (fn (site, dom, dir, Add' {src, dst}) =>
 607                                                       (Slave.shellF ([Config.cp, " ", src, " ", dst],
 608                                                                   fn cl => "Copy failed: " ^ cl);
 609                                                        (site,
 610                                                         {action = Slave.Add,
 611                                                          domain = dom,
 612                                                          dir = dir,
 613                                                          file = dst}))
 614                                                     | (site, dom, dir, Delete' dst) =>
 615                                                       (OS.FileSys.remove dst
 616                                                        handle OS.SysErr _ =>
 617                                                               ErrorMsg.error NONE ("Delete failed for " ^ dst);
 618                                                        (site,
 619                                                         {action = Slave.Delete,
 620                                                          domain = dom,
 621                                                          dir = dir,
 622                                                          file = dst}))
 623                                                     | (site, dom, dir, Modify' {src, dst}) =>
 624                                                       (Slave.shellF ([Config.cp, " ", src, " ", dst],
 625                                                                   fn cl => "Copy failed: " ^ cl);
 626                                                        (site,
 627                                                         {action = Slave.Modify,
 628                                                          domain = dom,
 629                                                          dir = dir,
 630                                                          file = dst}))) diffs
 631                               in
 632                                   if !ErrorMsg.anyErrors then
 633                                       ()
 634                                   else let
 635                                           val changed = foldl (fn ((site, file), changed) =>
 636                                                                   let
 637                                                                       val ls = case SM.find (changed, site) of
 638                                                                                    NONE => []
 639                                                                                  | SOME ls => ls
 640                                                                   in
 641                                                                       SM.insert (changed, site, file :: ls)
 642                                                                   end) SM.empty diffs
 643                                       in
 644                                           SM.appi handleSite changed
 645                                       end;
 646                                   ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
 647                                                      fn cl => "Temp file cleanup failed: " ^ cl))
 648                               end)
 649
 650 fun hasPriv priv = Acl.query {user = getUser (), class = "priv", value = "all"}
 651                    orelse Acl.query {user = getUser (), class = "priv", value = priv}
 652
 653 val _ = Env.type_one "dns_node"
 654         Env.string
 655         (fn node =>
 656             List.exists (fn x => x = node) Config.dnsNodes_all
 657             orelse (hasPriv "dns"
 658                     andalso List.exists (fn x => x = node) Config.dnsNodes_admin))
 659
 660 val _ = Env.type_one "mail_node"
 661         Env.string
 662         (fn node =>
 663             List.exists (fn x => x = node) Config.mailNodes_all
 664             orelse (hasPriv "mail"
 665                     andalso List.exists (fn x => x = node) Config.mailNodes_admin))
 666
 667 fun rmdom doms =
 668     let
 669         fun doNode (node, _) =
 670             let
 671                 val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
 672                                                  file = node}
 673
 674                 fun doDom (dom, actions) =
 675                     let
 676                         val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
 677                         val dname = OS.Path.concat (dname, domPath)
 678
 679                         fun visitDom (dom, dname, actions) =
 680                             let
 681                                 val dir = Posix.FileSys.opendir dname
 682
 683                                 fun loop actions =
 684                                     case Posix.FileSys.readdir dir of
 685                                         NONE => actions
 686                                       | SOME fname =>
 687                                         let
 688                                             val fnameFull = OS.Path.joinDirFile {dir = dname,
 689                                                                                  file = fname}
 690                                         in
 691                                             if Posix.FileSys.ST.isDir (Posix.FileSys.stat fnameFull) then
 692                                                 loop (visitDom (fname ^ "." ^ dom,
 693                                                                 fnameFull,
 694                                                                 actions))
 695                                             else
 696                                                 loop ({action = Slave.Delete,
 697                                                        domain = dom,
 698                                                        dir = dname,
 699                                                        file = fnameFull} :: actions)
 700                                         end
 701                             in
 702                                 loop actions
 703                                 before Posix.FileSys.closedir dir
 704                             end
 705                                 handle OS.SysErr _ =>
 706                                        (print ("Warning: System error deleting domain " ^ dom ^ " on " ^ node ^ ".\n");
 707                                         actions)
 708                     in
 709                         visitDom (dom, dname, actions)
 710                     end
 711
 712                 val actions = foldl doDom [] doms
 713             in
 714                 handleSite (node, actions)
 715             end
 716                 handle IO.Io _ => print ("Warning: IO error deleting domains on " ^ node ^ ".\n")
 717
 718         fun cleanupNode (node, _) =
 719             let
 720                 fun doDom dom =
 721                     let
 722                         val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
 723                         val dname = OS.Path.joinDirFile {dir = Config.resultRoot,
 724                                                          file = node}
 725                         val dname = OS.Path.concat (dname, domPath)
 726                     in
 727                         ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
 728                     end
 729             in
 730                 app doDom doms
 731             end
 732     in
 733         app doNode Config.nodeIps;
 734         app cleanupNode Config.nodeIps
 735     end
 736
 737 fun homedirOf uname =
 738     Posix.SysDB.Passwd.home (Posix.SysDB.getpwnam uname)
 739
 740 fun homedir () = homedirOf (getUser ())
 741
 742 end