src/domain.sml

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