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