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