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 fun get_context () = valOf (!ssl_context)
  31
  32 val nodes = map #1 Config.nodeIps
  33 val nodeMap = foldl (fn ((node, ip, ipv6), mp) => SM.insert (mp, node, (ip, ipv6)))
  34                     SM.empty Config.nodeIps
  35 fun nodeIp node = #1 (valOf (SM.find (nodeMap, node)))
  36 fun nodeIpv6 node = #2 (valOf (SM.find (nodeMap, node)))
  37
  38 val usr = ref ""
  39 fun getUser () = !usr
  40 val fakePrivs = ref false
  41 val isClient = ref false
  42
  43 val your_doms = ref SS.empty
  44 fun your_domains () = !your_doms
  45
  46 val your_usrs = ref SS.empty
  47 fun your_users () = !your_usrs
  48
  49 val your_grps = ref SS.empty
  50 fun your_groups () = !your_grps
  51
  52 val your_pths = ref SS.empty
  53 fun your_paths () = !your_pths
  54
  55 val your_ipss = ref SS.empty
  56 fun your_ips () = !your_ipss
  57
  58 val your_ipv6ss = ref SS.empty
  59 fun your_ipv6s () = !your_ipv6ss
  60
  61 val world_readable = SS.addList (SS.empty, Config.worldReadable)
  62 val readable_pths = ref world_readable
  63 fun readable_paths () = !readable_pths
  64
  65 fun setUser user =
  66     let
  67         val () = usr := user
  68
  69         val your_paths = Acl.class {user = getUser (),
  70                                     class = "path"}
  71     in
  72         fakePrivs := false;
  73         your_doms := Acl.class {user = getUser (),
  74                                 class = "domain"};
  75         your_usrs := Acl.class {user = getUser (),
  76                                 class = "user"};
  77         your_grps := SS.add (Acl.class {user = getUser (),
  78                                         class = "group"},
  79                              "nogroup");
  80         your_pths := your_paths;
  81         readable_pths := SS.union (your_paths, world_readable);
  82         your_ipss := Acl.class {user = getUser (),
  83                                 class = "ip"};
  84         your_ipv6ss := Acl.class {user = getUser (),
  85                                 class = "ipv6"}
  86     end
  87
  88 fun declareClient () = isClient := true
  89 fun fakePrivileges () = if !isClient then
  90                             fakePrivs := true
  91                         else
  92                             raise Fail "Tried to fake privileges as non-client"
  93
  94 fun validIp s =
  95     case map Int.fromString (String.fields (fn ch => ch = #".") s) of
  96         [SOME n1, SOME n2, SOME n3, SOME n4] =>
  97         n1 >= 0 andalso n1 < 256 andalso n2 >= 0 andalso n2 < 256 andalso n3 >= 0 andalso n3 < 256 andalso n4 >= 0 andalso n4 < 256
  98       | _ => false
  99
 100 fun isHexDigit ch = Char.isDigit ch orelse (ord ch >= ord #"a" andalso ord ch <= ord #"f")
 101
 102 fun validIpv6 s =
 103     let
 104         val fields = String.fields (fn ch => ch = #":") s
 105
 106         val empties = foldl (fn ("", n) => n + 1
 107                               | (_, n) => n) 0 fields
 108
 109         fun noIpv4 maxLen =
 110             length fields >= 2
 111             andalso length fields <= maxLen
 112             andalso empties <= 1
 113             andalso List.all (fn "" => true
 114                                | s => size s <= 4
 115                                       andalso CharVector.all isHexDigit s) fields
 116
 117         fun hasIpv4 () =
 118             length fields > 0
 119             andalso
 120             let
 121                 val maybeIpv4 = List.last fields
 122                 val theRest = List.take (fields, length fields - 1)
 123             in
 124                 validIp maybeIpv4 andalso noIpv4 6
 125             end
 126     in
 127         noIpv4 8 orelse hasIpv4 ()
 128     end
 129
 130 fun isIdent ch = Char.isLower ch orelse Char.isDigit ch
 131
 132 fun validHost s =
 133     size s > 0 andalso size s < 50
 134     andalso CharVector.all (fn ch => isIdent ch orelse ch = #"-") s
 135
 136 fun validDomain s =
 137     size s > 0 andalso size s < 200
 138     andalso List.all validHost (String.fields (fn ch => ch = #".") s)
 139
 140 fun validNode s = List.exists (fn s' => s = s') nodes
 141
 142 fun yourDomain s = !fakePrivs orelse SS.member (your_domains (), s)
 143 fun yourUser s = !fakePrivs orelse SS.member (your_users (), s)
 144 fun yourGroup s = !fakePrivs orelse SS.member (your_groups (), s)
 145
 146 fun checkPath paths path =
 147     !fakePrivs orelse
 148     (List.all (fn s => s <> "..") (String.fields (fn ch => ch = #"/") path)
 149      andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"/"
 150                                       orelse ch = #"-" orelse ch = #"_") path
 151      andalso SS.exists (fn s' => path = s' orelse String.isPrefix (s' ^ "/") path) (paths ()))
 152 val yourPath = checkPath your_paths
 153 val readablePath = checkPath readable_paths
 154
 155 fun yourIp s = !fakePrivs orelse SS.member (your_ips (), s)
 156 fun yourIpv6 s = !fakePrivs orelse SS.member (your_ipv6s (), s)
 157
 158 fun yourDomainHost s =
 159     !fakePrivs
 160     orelse yourDomain s
 161     orelse let
 162         val (pref, suf) = Substring.splitl (fn ch => ch <> #".") (Substring.full s)
 163     in
 164         Substring.size suf > 0
 165         andalso validHost (Substring.string pref)
 166         andalso yourDomain (Substring.string
 167                                 (Substring.slice (suf, 1, NONE)))
 168     end
 169
 170 val yourDomain = yourDomainHost
 171
 172 fun validUser s = size s > 0 andalso size s < 20
 173                   andalso CharVector.all Char.isAlphaNum s
 174
 175 fun validEmailUser s =
 176     size s > 0 andalso size s < 50
 177     andalso CharVector.all (fn ch => Char.isAlphaNum ch
 178                                      orelse ch = #"."
 179                                      orelse ch = #"_"
 180                                      orelse ch = #"-"
 181                                      orelse ch = #"+") s
 182
 183 val validGroup = validUser
 184
 185 val _ = Env.type_one "no_spaces"
 186                      Env.string
 187                      (CharVector.all (fn ch => Char.isPrint ch andalso not (Char.isSpace ch)
 188                                                andalso ch <> #"\"" andalso ch <> #"'"))
 189 val _ = Env.type_one "no_newlines"
 190                      Env.string
 191                      (CharVector.all (fn ch => Char.isPrint ch andalso ch <> #"\n" andalso ch <> #"\r"
 192                                                andalso ch <> #"\""))
 193
 194 val _ = Env.type_one "ip"
 195         Env.string
 196         validIp
 197
 198 val _ = Env.type_one "ipv6"
 199         Env.string
 200         validIpv6
 201
 202 val _ = Env.type_one "host"
 203         Env.string
 204         validHost
 205
 206 val _ = Env.type_one "domain"
 207         Env.string
 208         validDomain
 209
 210 val _ = Env.type_one "your_domain"
 211         Env.string
 212         yourDomain
 213
 214 val _ = Env.type_one "your_domain_host"
 215         Env.string
 216         yourDomainHost
 217
 218 val _ = Env.type_one "user"
 219         Env.string
 220         validUser
 221
 222 val _ = Env.type_one "group"
 223         Env.string
 224         validGroup
 225
 226 val _ = Env.type_one "your_user"
 227         Env.string
 228         yourUser
 229
 230 val _ = Env.type_one "your_group"
 231         Env.string
 232         yourGroup
 233
 234 val _ = Env.type_one "your_path"
 235         Env.string
 236         yourPath
 237
 238 val _ = Env.type_one "readable_path"
 239         Env.string
 240         readablePath
 241
 242 val _ = Env.type_one "your_ip"
 243         Env.string
 244         yourIp
 245
 246 val _ = Env.type_one "your_ipv6"
 247         Env.string
 248         yourIpv6
 249
 250 val _ = Env.type_one "node"
 251         Env.string
 252         validNode
 253
 254 val _ = Env.type_one "mime_type"
 255         Env.string
 256         (CharVector.exists (fn ch => ch = #"/"))
 257
 258 val _ = Env.registerFunction ("your_ip_to_ip",
 259                               fn [e] => SOME e
 260                                | _ => NONE)
 261
 262 val _ = Env.registerFunction ("your_ipv6_to_ipv6",
 263                               fn [e] => SOME e
 264                                | _ => NONE)
 265
 266 val _ = Env.registerFunction ("dns_node_to_node",
 267                               fn [e] => SOME e
 268                                | _ => NONE)
 269
 270 val _ = Env.registerFunction ("mail_node_to_node",
 271                               fn [e] => SOME e
 272                                | _ => NONE)
 273
 274
 275 open Ast
 276
 277 val dl = ErrorMsg.dummyLoc
 278
 279 val _ = Env.registerFunction ("end_in_slash",
 280                               fn [(EString "", _)] => SOME (EString "/", dl)
 281                                | [(EString s, _)] =>
 282                                  SOME (EString (if String.sub (s, size s - 1) = #"/" then
 283                                                     s
 284                                                 else
 285                                                     s ^ "/"), dl)
 286                                | _ => NONE)
 287
 288
 289 val _ = Env.registerFunction ("you",
 290                               fn [] => SOME (EString (getUser ()), dl)
 291                               | _ => NONE)
 292
 293 val _  = Env.registerFunction ("defaultMailbox",
 294                                fn [] => SOME (EString (getUser ()), dl)
 295                                | _ => NONE)
 296
 297 val _  = Env.registerFunction ("defaultMailUser",
 298                                fn [] => SOME (EString (getUser ()), dl)
 299                                | _ => NONE)
 300
 301
 302 type soa = {ns : string,
 303             serial : int option,
 304             ref : int,
 305             ret : int,
 306             exp : int,
 307             min : int}
 308
 309 val serial = fn (EVar "serialAuto", _) => SOME NONE
 310               | (EApp ((EVar "serialConst", _), n), _) => Option.map SOME (Env.int n)
 311               | _ => NONE
 312
 313 val soa = fn (EApp ((EApp ((EApp ((EApp ((EApp ((EApp
 314                                                      ((EVar "soa", _), ns), _),
 315                                                 sl), _),
 316                                          rf), _),
 317                                   ret), _),
 318                            exp), _),
 319                     min), _) =>
 320              (case (Env.string ns, serial sl, Env.int rf,
 321                     Env.int ret, Env.int exp, Env.int min) of
 322                   (SOME ns, SOME sl, SOME rf,
 323                    SOME ret, SOME exp, SOME min) =>
 324                   SOME {ns = ns,
 325                         serial = sl,
 326                         ref = rf,
 327                         ret = ret,
 328                         exp = exp,
 329                         min = min}
 330                 | _ => NONE)
 331            | _ => NONE
 332
 333 datatype master =
 334          ExternalMaster of string
 335        | InternalMaster of string
 336
 337 val ip = Env.string
 338
 339 val _ = Env.registerFunction ("ip_of_node",
 340                               fn [(EString node, _)] => SOME (EString (nodeIp node), dl)
 341                                | _ => NONE)
 342
 343 val _ = Env.registerFunction ("ipv6_of_node",
 344                               fn [(EString node, _)] => SOME (EString (nodeIpv6 node), dl)
 345                                | _ => NONE)
 346
 347 val master = fn (EApp ((EVar "externalMaster", _), e), _) => Option.map ExternalMaster (ip e)
 348               | (EApp ((EVar "internalMaster", _), e), _) => Option.map InternalMaster (Env.string e)
 349               | _ => NONE
 350
 351 datatype dnsKind =
 352          UseDns of {soa : soa,
 353                     master : master,
 354                     slaves : string list}
 355        | NoDns
 356
 357 val dnsKind = fn (EApp ((EApp ((EApp
 358                                     ((EVar "useDns", _), sa), _),
 359                                mstr), _),
 360                         slaves), _) =>
 361                  (case (soa sa, master mstr, Env.list Env.string slaves) of
 362                       (SOME sa, SOME mstr, SOME slaves) =>
 363                       SOME (UseDns {soa = sa,
 364                                     master = mstr,
 365                                     slaves = slaves})
 366                     | _ => NONE)
 367                | (EVar "noDns", _) => SOME NoDns
 368                | _ => NONE
 369
 370 val befores = ref (fn (_ : string) => ())
 371 val afters = ref (fn (_ : string) => ())
 372
 373 fun registerBefore f =
 374     let
 375         val old = !befores
 376     in
 377         befores := (fn x => (old x; f x))
 378     end
 379
 380 fun registerAfter f =
 381     let
 382         val old = !afters
 383     in
 384         afters := (fn x => (old x; f x))
 385     end
 386
 387 val globals = ref (fn () => ())
 388 val locals = ref (fn () => ())
 389
 390 fun registerResetGlobal f =
 391     let
 392         val old = !globals
 393     in
 394         globals := (fn x => (old x; f x))
 395     end
 396
 397 fun registerResetLocal f =
 398     let
 399         val old = !locals
 400     in
 401         locals := (fn x => (old x; f x))
 402     end
 403
 404 fun resetGlobal () = (!globals ();
 405                       ignore (OS.Process.system (Config.rm ^ " -rf " ^ Config.resultRoot ^ "/*")))
 406 fun resetLocal () = !locals ()
 407
 408 val current = ref ""
 409 val currentPath = ref (fn (_ : string) => "")
 410 val currentPathAli = ref (fn (_ : string, _ : string) => "")
 411
 412 val scratch = ref ""
 413
 414 fun currentDomain () = !current
 415
 416 val currentsAli = ref ([] : string list)
 417
 418 fun currentAliasDomains () = !currentsAli
 419 fun currentDomains () = currentDomain () :: currentAliasDomains ()
 420
 421 fun domainFile {node, name} = ((*print ("Opening " ^ !currentPath node ^ name ^ "\n");*)
 422                                TextIO.openOut (!currentPath node ^ name))
 423
 424 type files = {write : string -> unit,
 425               writeDom : unit -> unit,
 426               close : unit -> unit}
 427
 428 fun domainsFile {node, name} =
 429     let
 430         val doms = currentDomains ()
 431         val files = map (fn dom => (dom, TextIO.openOut (!currentPathAli (dom, node) ^ name))) doms
 432     in
 433         {write = fn s => app (fn (_, outf) => TextIO.output (outf, s)) files,
 434          writeDom = fn () => app (fn (dom, outf) => TextIO.output (outf, dom)) files,
 435          close = fn () => app (fn (_, outf) => TextIO.closeOut outf) files}
 436     end
 437
 438 fun getPath domain =
 439     let
 440         val toks = String.fields (fn ch => ch = #".") domain
 441
 442         val elems = foldr (fn (piece, elems) =>
 443                               let
 444                                   val elems = piece :: elems
 445
 446                                   fun doNode node =
 447                                       let
 448                                           val path = String.concatWith "/"
 449                                                                        (Config.resultRoot :: node :: rev elems)
 450                                           val tmpPath = String.concatWith "/"
 451                                                                           (Config.tmpDir :: node :: rev elems)
 452                                       in
 453                                           (if Posix.FileSys.ST.isDir
 454                                                   (Posix.FileSys.stat path) then
 455                                                ()
 456                                            else
 457                                                (OS.FileSys.remove path;
 458                                                 OS.FileSys.mkDir path))
 459                                           handle OS.SysErr _ => OS.FileSys.mkDir path;
 460
 461                                           (if Posix.FileSys.ST.isDir
 462                                                   (Posix.FileSys.stat tmpPath) then
 463                                                ()
 464                                            else
 465                                                (OS.FileSys.remove tmpPath;
 466                                                 OS.FileSys.mkDir tmpPath))
 467                                           handle OS.SysErr _ => OS.FileSys.mkDir tmpPath
 468                                       end
 469                               in
 470                                   app doNode nodes;
 471                                   elems
 472                               end) [] toks
 473     in
 474         fn (root, site) => String.concatWith "/" (root :: site :: rev ("" :: elems))
 475     end
 476
 477 datatype file_action' =
 478          Add' of {src : string, dst : string}
 479        | Delete' of string
 480        | Modify' of {src : string, dst : string}
 481
 482 fun findDiffs (prefixes, site, dom, acts) =
 483     let
 484         val gp = getPath dom
 485         val realPath = gp (Config.resultRoot, site)
 486         val tmpPath = gp (Config.tmpDir, site)
 487
 488         (*val _ = print ("getDiffs(" ^ site ^ ", " ^ dom ^ ")... " ^ realPath ^ "; " ^ tmpPath ^ "\n")*)
 489
 490         val dir = Posix.FileSys.opendir realPath
 491
 492         fun loopReal acts =
 493             case Posix.FileSys.readdir dir of
 494                 NONE => (Posix.FileSys.closedir dir;
 495                          acts)
 496               | SOME fname =>
 497                 let
 498                     val real = OS.Path.joinDirFile {dir = realPath,
 499                                                     file = fname}
 500                     val tmp = OS.Path.joinDirFile {dir = tmpPath,
 501                                                    file = fname}
 502                 in
 503                     if Posix.FileSys.ST.isDir (Posix.FileSys.stat real) then
 504                         loopReal acts
 505                     else if Posix.FileSys.access (tmp, []) then
 506                         if Slave.shell [Config.diff, " ", real, " ",  tmp] then
 507                             loopReal acts
 508                         else
 509                             loopReal ((site, dom, realPath, Modify' {src = tmp, dst = real}) :: acts)
 510                     else if List.exists (fn prefix => String.isPrefix prefix real) prefixes then
 511                         loopReal ((site, dom, realPath, Delete' real) :: acts)
 512                     else
 513                         loopReal acts
 514                 end
 515
 516         val acts = loopReal acts
 517
 518         val dir = Posix.FileSys.opendir tmpPath
 519
 520         fun loopTmp acts =
 521             case Posix.FileSys.readdir dir of
 522                 NONE => (Posix.FileSys.closedir dir;
 523                          acts)
 524               | SOME fname =>
 525                 let
 526                     val real = OS.Path.joinDirFile {dir = realPath,
 527                                                     file = fname}
 528                     val tmp = OS.Path.joinDirFile {dir = tmpPath,
 529                                                    file = fname}
 530                 in
 531                     if Posix.FileSys.ST.isDir (Posix.FileSys.stat tmp) then
 532                         loopTmp acts
 533                     else if Posix.FileSys.access (real, []) then
 534                         loopTmp acts
 535                     else
 536                         loopTmp ((site, dom, realPath, Add' {src = tmp, dst = real}) :: acts)
 537                 end
 538
 539         val acts = loopTmp acts
 540     in
 541         acts
 542     end
 543
 544 fun findAllDiffs prefixes =
 545     let
 546         val dir = Posix.FileSys.opendir Config.tmpDir
 547         val len = length (String.fields (fn ch => ch = #"/") Config.tmpDir) + 1
 548
 549         fun exploreSites diffs =
 550             case Posix.FileSys.readdir dir of
 551                 NONE => diffs
 552               | SOME site =>
 553                 let
 554                     fun explore (dname, diffs) =
 555                         let
 556                             val dir = Posix.FileSys.opendir dname
 557
 558                             fun loop diffs =
 559                                 case Posix.FileSys.readdir dir of
 560                                     NONE => diffs
 561                                   | SOME name =>
 562                                     let
 563                                         val fname = OS.Path.joinDirFile {dir = dname,
 564                                                                          file = name}
 565                                     in
 566                                         loop (if Posix.FileSys.ST.isDir (Posix.FileSys.stat fname) then
 567                                                   let
 568                                                       val dom = String.fields (fn ch => ch = #"/") fname
 569                                                       val dom = List.drop (dom, len)
 570                                                       val dom = String.concatWith "." (rev dom)
 571
 572                                                       val dname' = OS.Path.joinDirFile {dir = dname,
 573                                                                                         file = name}
 574                                                   in
 575                                                       explore (dname',
 576                                                                findDiffs (prefixes, site, dom, diffs))
 577                                                   end
 578                                               else
 579                                                   diffs)
 580                                     end
 581                         in
 582                             loop diffs
 583                             before Posix.FileSys.closedir dir
 584                         end
 585                 in
 586                     exploreSites (explore (OS.Path.joinDirFile {dir = Config.tmpDir,
 587                                                                 file = site}, diffs))
 588                 end
 589     in
 590         exploreSites []
 591         before Posix.FileSys.closedir dir
 592     end
 593
 594 val masterNode : string option ref = ref NONE
 595 fun dnsMaster () = !masterNode
 596
 597 val seenDomains : string list ref = ref []
 598
 599 val _ = Env.containerV_one "domain"
 600                            ("domain", Env.string)
 601                            (fn (evs, dom) =>
 602                                let
 603                                    val () = seenDomains := dom :: !seenDomains
 604
 605                                    val kind = Env.env dnsKind (evs, "DNS")
 606                                    val ttl = Env.env Env.int (evs, "TTL")
 607                                    val aliases = Env.env (Env.list Env.string) (evs, "Aliases")
 608
 609                                    val path = getPath dom
 610
 611                                    val () = (current := dom;
 612                                              currentsAli := Slave.remove (Slave.removeDups aliases, dom);
 613                                              currentPath := (fn site => path (Config.tmpDir, site));
 614                                              currentPathAli := (fn (dom, site) => getPath dom (Config.tmpDir, site)))
 615
 616                                    fun saveSoa (kind, soa : soa) node =
 617                                        let
 618                                            val {write, writeDom, close} = domainsFile {node = node, name = "soa.conf"}
 619                                        in
 620                                            write kind;
 621                                            write "\n";
 622                                            write (Int.toString ttl);
 623                                            write "\n";
 624                                            write (#ns soa);
 625                                            write "\n";
 626                                            case #serial soa of
 627                                                NONE => ()
 628                                              | SOME n => write (Int.toString n);
 629                                            write "\n";
 630                                            write (Int.toString (#ref soa));
 631                                            write "\n";
 632                                            write (Int.toString (#ret soa));
 633                                            write "\n";
 634                                            write (Int.toString (#exp soa));
 635                                            write "\n";
 636                                            write (Int.toString (#min soa));
 637                                            write "\n";
 638                                            close ()
 639                                        end
 640
 641                                    fun saveNamed (kind, soa : soa, masterIp, slaveIps) node =
 642                                        if dom = "localhost" then
 643                                            ()
 644                                        else let
 645                                                val {write, writeDom, close} = domainsFile {node = node, name = "named.conf"}
 646                                            in
 647                                                write "\nzone \"";
 648                                                writeDom ();
 649                                                write "\" {\n\ttype ";
 650                                                write kind;
 651                                                write ";\n\tfile \"";
 652                                                write Config.Bind.zonePath_real;
 653                                                write "/";
 654                                                writeDom ();
 655                                                write ".zone\";\n";
 656                                                case kind of
 657                                                    "master" => (write "\tallow-transfer {\n";
 658                                                                 app (fn ip => (write "\t\t";
 659                                                                                write ip;
 660                                                                                write ";\n")) slaveIps;
 661                                                                 write "\t};\n")
 662                                                  | _ => (write "\tmasters { ";
 663                                                          write masterIp;
 664                                                          write "; };\n";
 665                                                          write "// Updated: ";
 666                                                          write (Time.toString (Time.now ()));
 667                                                          write "\n");
 668                                                write "};\n";
 669                                                close ()
 670                                            end
 671                                in
 672                                    case kind of
 673                                        NoDns => masterNode := NONE
 674                                      | UseDns dns =>
 675                                        let
 676                                            val masterIp =
 677                                                case #master dns of
 678                                                    InternalMaster node => nodeIp node
 679                                                  | ExternalMaster ip => ip
 680
 681                                            val slaveIps = map nodeIp (#slaves dns)
 682                                        in
 683                                            app (saveNamed ("slave", #soa dns, masterIp, slaveIps)) (#slaves dns);
 684                                            case #master dns of
 685                                                InternalMaster node =>
 686                                                (masterNode := SOME node;
 687                                                 saveSoa ("master", #soa dns) node;
 688                                                 saveNamed ("master", #soa dns, masterIp, slaveIps) node)
 689                                              | _ => masterNode := NONE
 690                                        end;
 691                                    !befores dom
 692                                end,
 693                             fn () => !afters (!current))
 694
 695 val () = Env.registerPre (fn () => (seenDomains := [];
 696                                     ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
 697                                                        fn cl => "Temp file cleanup failed: " ^ cl));
 698                                     OS.FileSys.mkDir Config.tmpDir;
 699                                     app (fn node => OS.FileSys.mkDir
 700                                                         (OS.Path.joinDirFile {dir = Config.tmpDir,
 701                                                                               file = node}))
 702                                         nodes;
 703                                     app (fn node => OS.FileSys.mkDir
 704                                                         (OS.Path.joinDirFile {dir = Config.resultRoot,
 705                                                                               file = node})
 706                                             handle OS.SysErr _ => ())
 707                                         nodes))
 708
 709 fun handleSite (site, files) =
 710     let
 711
 712     in
 713         print ("New configuration for node " ^ site ^ "\n");
 714         if site = Config.dispatcherName then
 715             Slave.handleChanges files
 716         else let
 717                 val bio = OpenSSL.connect true (valOf (!ssl_context),
 718                                                 nodeIp site
 719                                                 ^ ":"
 720                                                 ^ Int.toString Config.slavePort)
 721             in
 722                 app (fn file => Msg.send (bio, MsgFile file)) files;
 723                 Msg.send (bio, MsgDoFiles);
 724                 case Msg.recv bio of
 725                     NONE => print "Slave closed connection unexpectedly\n"
 726                   | SOME m =>
 727                     case m of
 728                         MsgOk => print ("Slave " ^ site ^ " finished\n")
 729                       | MsgError s => print ("Slave " ^ site
 730                                              ^ " returned error: " ^
 731                                              s ^ "\n")
 732                       | _ => print ("Slave " ^ site
 733                                     ^ " returned unexpected command\n");
 734                 OpenSSL.close bio
 735             end
 736     end
 737
 738 val () = Env.registerPost (fn () =>
 739                               let
 740                                   val prefixes = List.concat
 741                                                      (List.map (fn dom =>
 742                                                                    let
 743                                                                        val pieces = String.tokens (fn ch => ch = #".") dom
 744                                                                        val path = String.concatWith "/" (rev pieces)
 745                                                                    in
 746                                                                        List.map (fn node =>
 747                                                                                     Config.resultRoot ^ "/" ^ node ^ "/" ^ path ^ "/")
 748                                                                                 nodes
 749                                                                    end) (!seenDomains))
 750
 751                                   val diffs = findAllDiffs prefixes
 752
 753                                   val diffs = map (fn (site, dom, dir, Add' {src, dst}) =>
 754                                                       (Slave.shellF ([Config.cp, " ", src, " ", dst],
 755                                                                   fn cl => "Copy failed: " ^ cl);
 756                                                        (site,
 757                                                         {action = Slave.Add,
 758                                                          domain = dom,
 759                                                          dir = dir,
 760                                                          file = dst}))
 761                                                     | (site, dom, dir, Delete' dst) =>
 762                                                       (OS.FileSys.remove dst
 763                                                        handle OS.SysErr _ =>
 764                                                               ErrorMsg.error NONE ("Delete failed for " ^ dst);
 765                                                        (site,
 766                                                         {action = Slave.Delete true,
 767                                                          domain = dom,
 768                                                          dir = dir,
 769                                                          file = dst}))
 770                                                     | (site, dom, dir, Modify' {src, dst}) =>
 771                                                       (Slave.shellF ([Config.cp, " ", src, " ", dst],
 772                                                                   fn cl => "Copy failed: " ^ cl);
 773                                                        (site,
 774                                                         {action = Slave.Modify,
 775                                                          domain = dom,
 776                                                          dir = dir,
 777                                                          file = dst}))) diffs
 778                               in
 779                                   if !ErrorMsg.anyErrors then
 780                                       ()
 781                                   else let
 782                                           val changed = foldl (fn ((site, file), changed) =>
 783                                                                   let
 784                                                                       val ls = case SM.find (changed, site) of
 785                                                                                    NONE => []
 786                                                                                  | SOME ls => ls
 787                                                                   in
 788                                                                       SM.insert (changed, site, file :: ls)
 789                                                                   end) SM.empty diffs
 790                                       in
 791                                           SM.appi handleSite changed
 792                                       end;
 793                                   ignore (Slave.shellF ([Config.rm, " -rf ", Config.tmpDir, ""],
 794                                                      fn cl => "Temp file cleanup failed: " ^ cl))
 795                               end)
 796
 797 fun hasPriv priv = Acl.query {user = getUser (), class = "priv", value = "all"}
 798                    orelse Acl.query {user = getUser (), class = "priv", value = priv}
 799
 800 val _ = Env.type_one "dns_node"
 801         Env.string
 802         (fn node =>
 803             List.exists (fn x => x = node) Config.dnsNodes_all
 804             orelse (hasPriv "dns"
 805                     andalso List.exists (fn x => x = node) Config.dnsNodes_admin))
 806
 807 val _ = Env.type_one "mail_node"
 808         Env.string
 809         (fn node =>
 810             List.exists (fn x => x = node) Config.mailNodes_all
 811             orelse (hasPriv "mail"
 812                     andalso List.exists (fn x => x = node) Config.mailNodes_admin))
 813
 814 fun rmdom' delete resultRoot doms =
 815     let
 816         fun doNode (node, _, _) =
 817             let
 818                 val dname = OS.Path.joinDirFile {dir = resultRoot,
 819                                                  file = node}
 820
 821                 fun doDom (dom, actions) =
 822                     let
 823                         val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
 824                         val dname = OS.Path.concat (dname, domPath)
 825
 826                         fun visitDom (dom, dname, actions) =
 827                             let
 828                                 val dir = Posix.FileSys.opendir dname
 829
 830                                 fun loop actions =
 831                                     case Posix.FileSys.readdir dir of
 832                                         NONE => actions
 833                                       | SOME fname =>
 834                                         let
 835                                             val fnameFull = OS.Path.joinDirFile {dir = dname,
 836                                                                                  file = fname}
 837                                         in
 838                                             if Posix.FileSys.ST.isDir (Posix.FileSys.stat fnameFull) then
 839                                                 loop (visitDom (fname ^ "." ^ dom,
 840                                                                 fnameFull,
 841                                                                 actions))
 842                                             else
 843                                                  loop ({action = Slave.Delete delete,
 844                                                         domain = dom,
 845                                                         dir = dname,
 846                                                         file = fnameFull} :: actions)
 847                                         end
 848                             in
 849                                 loop actions
 850                                 before Posix.FileSys.closedir dir
 851                             end
 852                                 handle OS.SysErr (s, _) =>
 853                                        (print ("Warning: System error deleting domain " ^ dom ^ " on " ^ node ^ ": " ^ s ^ "\n");
 854                                         actions)
 855                     in
 856                         visitDom (dom, dname, actions)
 857                     end
 858
 859                 val actions = foldl doDom [] doms
 860             in
 861                 handleSite (node, actions)
 862             end
 863                 handle IO.Io _ => print ("Warning: IO error deleting domains on " ^ node ^ ".\n")
 864
 865         fun cleanupNode (node, _, _) =
 866             let
 867                 fun doDom dom =
 868                     let
 869                         val domPath = String.concatWith "/" (rev (String.fields (fn ch => ch = #".") dom))
 870                         val dname = OS.Path.joinDirFile {dir = resultRoot,
 871                                                          file = node}
 872                         val dname = OS.Path.concat (dname, domPath)
 873                     in
 874                         if delete then
 875                             ignore (OS.Process.system (Config.rm ^ " -rf " ^ dname))
 876                         else
 877                             ()
 878                     end
 879             in
 880                 app doDom doms
 881             end
 882     in
 883         app doNode Config.nodeIps;
 884         app cleanupNode Config.nodeIps
 885     end
 886
 887 val rmdom = rmdom' true Config.resultRoot
 888 val rmdom' = rmdom' false
 889
 890 fun homedirOf uname =
 891     Posix.SysDB.Passwd.home (Posix.SysDB.getpwnam uname)
 892
 893 fun homedir () = homedirOf (getUser ())
 894                  handle e => if !fakePrivs then "/tmp" else raise e
 895
 896 type subject = {node : string, domain : string}
 897
 898 val describers : (subject -> string) list ref = ref []
 899
 900 fun registerDescriber f = describers := f :: !describers
 901
 902 fun describeOne arg = String.concat (map (fn f => f arg) (rev (!describers)))
 903
 904 val line = "--------------------------------------------------------------\n"
 905 val dline = "==============================================================\n"
 906
 907 fun describe dom =
 908     String.concat (List.mapPartial
 909                        (fn node =>
 910                            case describeOne {node = node, domain = dom} of
 911                                "" => NONE
 912                              | s =>
 913                                SOME (String.concat [dline, "Node ", node, "\n", dline, "\n", s]))
 914                        nodes)
 915
 916 datatype description =
 917          Filename of { filename : string, heading : string, showEmpty : bool }
 918        | Extension of { extension : string, heading : string -> string }
 919
 920 fun considerAll ds {node, domain} =
 921     let
 922         val ds = map (fn d => (d, ref [])) ds
 923
 924         val path = Config.resultRoot
 925         val jdf = OS.Path.joinDirFile
 926         val path = jdf {dir = path, file = node}
 927         val path = foldr (fn (more, path) => jdf {dir = path, file = more})
 928                          path (String.tokens (fn ch => ch = #".") domain)
 929     in
 930         if Posix.FileSys.access (path, []) then
 931             let
 932                 val dir = Posix.FileSys.opendir path
 933
 934                 fun loop () =
 935                     case Posix.FileSys.readdir dir of
 936                         NONE => ()
 937                       | SOME fname =>
 938                         (app (fn (d, entries) =>
 939                                  let
 940                                      fun readFile showEmpty entries' =
 941                                          let
 942                                              val fname = OS.Path.joinDirFile {dir = path,
 943                                                                               file = fname}
 944
 945                                              val inf = TextIO.openIn fname
 946
 947                                              fun loop (seenOne, entries') =
 948                                                  case TextIO.inputLine inf of
 949                                                      NONE => if seenOne orelse showEmpty then
 950                                                                  "\n" :: entries'
 951                                                              else
 952                                                                  !entries
 953                                                    | SOME line => loop (true, line :: entries')
 954                                          in
 955                                              loop (false, entries')
 956                                              before TextIO.closeIn inf
 957                                          end
 958                                  in
 959                                      case d of
 960                                          Filename {filename, heading, showEmpty} =>
 961                                          if fname = filename then
 962                                              entries := readFile showEmpty ("\n" :: line :: "\n" :: heading :: line :: !entries)
 963                                          else
 964                                              ()
 965                                        | Extension {extension, heading} =>
 966                                          let
 967                                              val {base, ext} = OS.Path.splitBaseExt fname
 968                                          in
 969                                              case ext of
 970                                                  NONE => ()
 971                                                | SOME extension' =>
 972                                                  if extension' = extension then
 973                                                      entries := readFile true ("\n" :: line :: "\n" :: heading base :: line :: !entries)
 974                                                  else
 975                                                      ()
 976                                          end
 977                                  end) ds;
 978                          loop ())
 979             in
 980                 loop ();
 981                 Posix.FileSys.closedir dir;
 982                 String.concat (List.concat (map (fn (_, entries) => rev (!entries)) ds))
 983             end
 984         else
 985             ""
 986     end
 987
 988 val () = registerDescriber (considerAll [Filename {filename = "soa.conf",
 989                                                    heading = "DNS SOA:",
 990                                                    showEmpty = false}])
 991
 992 val () = Env.registerAction ("domainHost",
 993                              fn (env, [(EString host, _)]) =>
 994                                 SM.insert (env, "Hostname",
 995                                            (EString (host ^ "." ^ currentDomain ()), dl))
 996                               | (_, args) => Env.badArgs ("domainHost", args))
 997
 998 val ouc = ref (fn () => ())
 999
1000 fun registerOnUsersChange f =
1001     let
1002         val f' = !ouc
1003     in
1004         ouc := (fn () => (f' (); f ()))
1005     end
1006
1007 fun onUsersChange () = !ouc ()
1008
1009 end