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