src/plugins/apache.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 (* Apache HTTPD handling *)
  20
  21 structure Apache :> APACHE = struct
  22
  23 open Ast
  24
  25 val _ = Env.type_one "web_node"
  26         Env.string
  27         (fn node =>
  28             List.exists (fn x => x = node) Config.Apache.webNodes_all
  29             orelse (Domain.hasPriv "www"
  30                     andalso List.exists (fn x => x = node) Config.Apache.webNodes_admin))
  31
  32 val _ = Env.registerFunction ("web_node_to_node",
  33                               fn [e] => SOME e
  34                                | _ => NONE)
  35
  36 val _ = Env.type_one "proxy_port"
  37         Env.int
  38         (fn n => n > 1024)
  39
  40 val _ = Env.type_one "proxy_target"
  41         Env.string
  42         (fn s =>
  43             let
  44                 fun default () = List.exists (fn s' => s = s') Config.Apache.proxyTargets
  45             in
  46                 case String.fields (fn ch => ch = #":") s of
  47                     ["http", "//localhost", rest] =>
  48                     (case String.fields (fn ch => ch = #"/") rest of
  49                          port :: _ =>
  50                          (case Int.fromString port of
  51                               NONE => default ()
  52                             | SOME n => n > 1024 orelse default ())
  53                        | _ => default ())
  54                   | _ => default ()
  55             end)
  56
  57 val _ = Env.type_one "rewrite_arg"
  58         Env.string
  59         (CharVector.all Char.isAlphaNum)
  60
  61 val _ = Env.type_one "suexec_flag"
  62         Env.bool
  63         (fn b => b orelse Domain.hasPriv "www")
  64
  65 fun validLocation s =
  66     size s > 0 andalso size s < 1000 andalso CharVector.all
  67                                                  (fn ch => Char.isAlphaNum ch
  68                                                            orelse ch = #"-"
  69                                                            orelse ch = #"_"
  70                                                            orelse ch = #"."
  71                                                            orelse ch = #"/") s
  72
  73 val _ = Env.type_one "location"
  74         Env.string
  75         validLocation
  76
  77 fun validCert s = Acl.query {user = Domain.getUser (),
  78                              class = "cert",
  79                              value = s}
  80
  81 val _ = Env.type_one "ssl_cert_path"
  82         Env.string
  83         validCert
  84
  85 fun ssl e = case e of
  86                 (EVar "no_ssl", _) => SOME NONE
  87               | (EApp ((EVar "use_cert", _), s), _) => Option.map SOME (Env.string s)
  88               | _ => NONE
  89
  90 val dl = ErrorMsg.dummyLoc
  91
  92 val _ = Defaults.registerDefault ("WebNodes",
  93                                   (TList (TBase "web_node", dl), dl),
  94                                   (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl)))
  95
  96 val _ = Defaults.registerDefault ("SSL",
  97                                   (TBase "ssl", dl),
  98                                   (fn () => (EVar "no_ssl", dl)))
  99
 100 val _ = Defaults.registerDefault ("User",
 101                                   (TBase "your_user", dl),
 102                                   (fn () => (EString (Domain.getUser ()), dl)))
 103
 104 val _ = Defaults.registerDefault ("Group",
 105                                   (TBase "your_group", dl),
 106                                   (fn () => (EString (Domain.getUser ()), dl)))
 107
 108 val _ = Defaults.registerDefault ("DocumentRoot",
 109                                   (TBase "your_path", dl),
 110                                   (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl)))
 111
 112 val _ = Defaults.registerDefault ("ServerAdmin",
 113                                   (TBase "email", dl),
 114                                   (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
 115
 116 val _ = Defaults.registerDefault ("SuExec",
 117                                   (TBase "suexec_flag", dl),
 118                                   (fn () => (EVar "true", dl)))
 119
 120 val redirect_code = fn (EVar "temp", _) => SOME "temp"
 121                      | (EVar "permanent", _) => SOME "permanent"
 122                      | (EVar "seeother", _) => SOME "seeother"
 123                      | (EVar "redir300", _) => SOME "300"
 124                      | (EVar "redir301", _) => SOME "301"
 125                      | (EVar "redir302", _) => SOME "302"
 126                      | (EVar "redir303", _) => SOME "303"
 127                      | (EVar "redir304", _) => SOME "304"
 128                      | (EVar "redir305", _) => SOME "305"
 129                      | (EVar "redir307", _) => SOME "307"
 130                      | _ => NONE
 131
 132 val flag = fn (EVar "redirect", _) => SOME "R"
 133             | (EVar "forbidden", _) => SOME "F"
 134             | (EVar "gone", _) => SOME "G"
 135             | (EVar "last", _) => SOME "L"
 136             | (EVar "chain", _) => SOME "C"
 137             | (EVar "nosubreq", _) => SOME "NS"
 138             | (EVar "nocase", _) => SOME "NC"
 139             | (EVar "qsappend", _) => SOME "QSA"
 140             | (EVar "noescape", _) => SOME "NE"
 141             | (EVar "passthrough", _) => SOME "PT"
 142             | (EApp ((EVar "mimeType", _), e), _) =>
 143               Option.map (fn s => "T=" ^ s) (Env.string e)
 144             | (EApp ((EVar "redirectWith", _), e), _) =>
 145               Option.map (fn s => "R=" ^ s) (redirect_code e)
 146             | (EApp ((EVar "skip", _), e), _) =>
 147               Option.map (fn n => "S=" ^ Int.toString n) (Env.int e)
 148             | (EApp ((EApp ((EVar "env", _), e1), _), e2), _) =>
 149               (case Env.string e1 of
 150                    NONE => NONE
 151                  | SOME s1 => Option.map (fn s2 => "E=" ^ s1 ^ ":" ^ s2)
 152                                          (Env.string e2))
 153
 154             | _ => NONE
 155
 156 val cond_flag = fn (EVar "cond_nocase", _) => SOME "NC"
 157             | (EVar "ornext", _) => SOME "OR"
 158             | _ => NONE
 159
 160 val apache_option = fn (EVar "execCGI", _) => SOME "ExecCGI"
 161                      | (EVar "includesNOEXEC", _) => SOME "IncludesNOEXEC"
 162                      | (EVar "indexes", _) => SOME "Indexes"
 163                      | _ => NONE
 164
 165 val autoindex_width = fn (EVar "autofit", _) => SOME "*"
 166                        | (EApp ((EVar "characters", _), n), _) =>
 167                          Option.map Int.toString (Env.int n)
 168                        | _ => NONE
 169
 170 val autoindex_option = fn (EApp ((EVar "descriptionWidth", _), w), _) =>
 171                           Option.map (fn w => ("DescriptionWidth", SOME w))
 172                           (autoindex_width w)
 173                         | (EVar "fancyIndexing", _) => SOME ("FancyIndexing", NONE)
 174                         | (EVar "foldersFirst", _) => SOME ("FoldersFirst", NONE)
 175                         | (EVar "htmlTable", _) => SOME ("HTMLTable", NONE)
 176                         | (EVar "iconsAreLinks", _) => SOME ("IconsAreLinks", NONE)
 177                         | (EApp ((EVar "iconHeight", _), n), _) =>
 178                           Option.map (fn w => ("IconHeight", SOME (Int.toString w)))
 179                                      (Env.int n)
 180                         | (EApp ((EVar "iconWidth", _), n), _) =>
 181                           Option.map (fn w => ("IconWidth", SOME (Int.toString w)))
 182                                      (Env.int n)
 183                         | (EVar "ignoreCase", _) => SOME ("IgnoreCase", NONE)
 184                         | (EVar "ignoreClient", _) => SOME ("IgnoreClient", NONE)
 185                         | (EApp ((EVar "nameWidth", _), w), _) =>
 186                           Option.map (fn w => ("NameWidth", SOME w))
 187                                      (autoindex_width w)
 188                         | (EVar "scanHtmlTitles", _) => SOME ("ScanHTMLTitles", NONE)
 189                         | (EVar "suppressColumnSorting", _) => SOME ("SuppressColumnSorting", NONE)
 190                         | (EVar "suppressDescription", _) => SOME ("SuppressDescription", NONE)
 191                         | (EVar "suppressHtmlPreamble", _) => SOME ("SuppressHTMLPreamble", NONE)
 192                         | (EVar "suppressIcon", _) => SOME ("SuppressIcon", NONE)
 193                         | (EVar "suppressLastModified", _) => SOME ("SuppressLastModified", NONE)
 194                         | (EVar "suppressRules", _) => SOME ("SuppressRules", NONE)
 195                         | (EVar "suppressSize", _) => SOME ("SuppressSize", NONE)
 196                         | (EVar "trackModified", _) => SOME ("TrackModified", NONE)
 197                         | (EVar "versionSort", _) => SOME ("VersionSort", NONE)
 198                         | (EVar "xhtml", _) => SOME ("XHTML", NONE)
 199
 200                         | _ => NONE
 201
 202 val vhostsChanged = ref false
 203 val logDeleted = ref false
 204
 205 val () = Slave.registerPreHandler
 206              (fn () => (vhostsChanged := false;
 207                         logDeleted := false))
 208
 209 fun findVhostUser fname =
 210     let
 211         val inf = TextIO.openIn fname
 212
 213         fun loop () =
 214             case TextIO.inputLine inf of
 215                 NONE => NONE
 216               | SOME line =>
 217                 if String.isPrefix "# Owner: " line then
 218                     case String.tokens Char.isSpace line of
 219                         [_, _, user] => SOME user
 220                       | _ => NONE
 221                 else
 222                     loop ()
 223     in
 224         loop ()
 225         before TextIO.closeIn inf
 226     end handle _ => NONE
 227
 228 val () = Slave.registerFileHandler (fn fs =>
 229                                        let
 230                                            val spl = OS.Path.splitDirFile (#file fs)
 231                                        in
 232                                            if String.isSuffix ".vhost" (#file spl)
 233                                               orelse String.isSuffix ".vhost_ssl" (#file spl) then let
 234                                                    val realVhostFile = OS.Path.joinDirFile
 235                                                                            {dir = Config.Apache.confDir,
 236                                                                             file = #file spl}
 237
 238                                                    val user = findVhostUser (#file fs)
 239                                                    val oldUser = findVhostUser realVhostFile
 240                                                in
 241                                                    if (oldUser = NONE andalso #action fs <> Slave.Add)
 242                                                       orelse (user = NONE andalso #action fs <> Slave.Delete) then
 243                                                        print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "!  Taking no action.\n")
 244                                                    else
 245                                                        let
 246                                                            fun realLogDir user =
 247                                                                let
 248                                                                    val realLogDir = Domain.homedirOf (valOf user)
 249                                                                    val realLogDir = OS.Path.joinDirFile
 250                                                                                         {dir = realLogDir,
 251                                                                                          file = "apache"}
 252                                                                    val realLogDir = OS.Path.joinDirFile
 253                                                                                         {dir = realLogDir,
 254                                                                                          file = "log"}
 255                                                                    val realLogDir = OS.Path.joinDirFile
 256                                                                                         {dir = realLogDir,
 257                                                                                          file = Slave.hostname ()}
 258                                                                    val {base, ...} = OS.Path.splitBaseExt (#file spl)
 259
 260                                                                    val realLogDir = OS.Path.joinDirFile
 261                                                                                         {dir = realLogDir,
 262                                                                                          file = base}
 263                                                                in
 264                                                                    if String.isSuffix ".vhost_ssl" (#file spl) then
 265                                                                        realLogDir ^ ".ssl"
 266                                                                    else
 267                                                                        realLogDir
 268                                                                end
 269                                                        in
 270                                                            vhostsChanged := true;
 271                                                            case #action fs of
 272                                                                Slave.Delete =>
 273                                                                (if !logDeleted then
 274                                                                     ()
 275                                                                 else
 276                                                                     (ignore (OS.Process.system Config.Apache.down);
 277                                                                      logDeleted := true);
 278                                                                 ignore (OS.Process.system (Config.rm
 279                                                                                            ^ " -rf "
 280                                                                                            ^ realVhostFile));
 281                                                                 ignore (OS.Process.system (Config.rm
 282                                                                                            ^ " -rf "
 283                                                                                            ^ realLogDir oldUser)))
 284                                                              | Slave.Add =>
 285                                                                let
 286                                                                    val rld = realLogDir user
 287                                                                in
 288                                                                    ignore (OS.Process.system (Config.cp
 289                                                                                               ^ " "
 290                                                                                               ^ #file fs
 291                                                                                               ^ " "
 292                                                                                               ^ realVhostFile));
 293                                                                    if Posix.FileSys.access (rld, []) then
 294                                                                        ()
 295                                                                    else
 296                                                                        OS.FileSys.mkDir rld
 297                                                                end
 298
 299                                                              | _ =>
 300                                                                (ignore (OS.Process.system (Config.cp
 301                                                                                            ^ " "
 302                                                                                            ^ #file fs
 303                                                                                            ^ " "
 304                                                                                            ^ realVhostFile));
 305                                                                 if user <> oldUser then
 306                                                                     let
 307                                                                         val old = realLogDir oldUser
 308                                                                         val rld = realLogDir user
 309                                                                     in
 310                                                                         if !logDeleted then
 311                                                                             ()
 312                                                                         else
 313                                                                             (ignore (OS.Process.system Config.Apache.down);
 314                                                                              logDeleted := true);
 315                                                                         ignore (OS.Process.system (Config.rm
 316                                                                                                    ^ " -rf "
 317                                                                                                    ^ realLogDir oldUser));
 318                                                                         if Posix.FileSys.access (rld, []) then
 319                                                                             ()
 320                                                                         else
 321                                                                             OS.FileSys.mkDir rld
 322                                                                     end
 323                                                                 else
 324                                                                     ())
 325                                                        end
 326                                                end
 327                                            else
 328                                                ()
 329                                        end)
 330
 331 val () = Slave.registerPostHandler
 332          (fn () =>
 333              (if !vhostsChanged then
 334                   Slave.shellF ([if !logDeleted then Config.Apache.undown else Config.Apache.reload],
 335                                 fn cl => "Error reloading Apache with " ^ cl)
 336               else
 337                   ()))
 338
 339 val vhostFiles : (string * TextIO.outstream) list ref = ref []
 340 fun write' s = app (fn (node, file) => TextIO.output (file, s node)) (!vhostFiles)
 341 fun write s = app (fn (_, file) => TextIO.output (file, s)) (!vhostFiles)
 342
 343 val rewriteEnabled = ref false
 344 val localRewriteEnabled = ref false
 345 val currentVhost = ref ""
 346 val currentVhostId = ref ""
 347
 348 val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ())
 349 fun registerPre f =
 350     let
 351         val old = !pre
 352     in
 353         pre := (fn x => (old x; f x))
 354     end
 355
 356 val post = ref (fn () => ())
 357 fun registerPost f =
 358     let
 359         val old = !post
 360     in
 361         post := (fn () => (old (); f ()))
 362     end
 363
 364 val aliaser = ref (fn _ : string => ())
 365 fun registerAliaser f =
 366     let
 367         val old = !aliaser
 368     in
 369         aliaser := (fn x => (old x; f x))
 370     end
 371
 372 val () = Env.containerV_one "vhost"
 373          ("host", Env.string)
 374          (fn (env, host) =>
 375              let
 376                  val nodes = Env.env (Env.list Env.string) (env, "WebNodes")
 377
 378                  val ssl = Env.env ssl (env, "SSL")
 379                  val user = Env.env Env.string (env, "User")
 380                  val group = Env.env Env.string (env, "Group")
 381                  val docroot = Env.env Env.string (env, "DocumentRoot")
 382                  val sadmin = Env.env Env.string (env, "ServerAdmin")
 383                  val suexec = Env.env Env.bool (env, "SuExec")
 384
 385                  val fullHost = host ^ "." ^ Domain.currentDomain ()
 386                  val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
 387                  val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
 388              in
 389                  currentVhost := fullHost;
 390                  currentVhostId := vhostId;
 391
 392                  rewriteEnabled := false;
 393                  localRewriteEnabled := false;
 394                  vhostFiles := map (fn node =>
 395                                        let
 396                                            val file = Domain.domainFile {node = node,
 397                                                                          name = confFile}
 398                                        in
 399                                            TextIO.output (file, "# Owner: ");
 400                                            TextIO.output (file, user);
 401                                            TextIO.output (file, "\n<VirtualHost ");
 402                                            TextIO.output (file, Domain.nodeIp node);
 403                                            TextIO.output (file, ":");
 404                                            TextIO.output (file, case ssl of
 405                                                                     SOME _ => "443"
 406                                                                   | NONE => "80");
 407                                            TextIO.output (file, ">\n");
 408                                            TextIO.output (file, "\tErrorLog ");
 409                                            TextIO.output (file, Domain.homedirOf user);
 410                                            TextIO.output (file, "/apache/log/");
 411                                            TextIO.output (file, node);
 412                                            TextIO.output (file, "/");
 413                                            TextIO.output (file, vhostId);
 414                                            TextIO.output (file, "/error.log\n\tCustomLog ");
 415                                            TextIO.output (file, Domain.homedirOf user);
 416                                            TextIO.output (file, "/apache/log/");
 417                                            TextIO.output (file, node);
 418                                            TextIO.output (file, "/");
 419                                            TextIO.output (file, vhostId);
 420                                            TextIO.output (file, "/access.log combined\n");
 421                                            (Domain.homedirOf user ^ "/apache/log/"
 422                                             ^ node ^ "/" ^ vhostId, file)
 423                                        end)
 424                                    nodes;
 425                  write "\tServerName ";
 426                  write fullHost;
 427                  if suexec then
 428                      (write "\n\tSuexecUserGroup ";
 429                       write user;
 430                       write " ";
 431                       write group)
 432                  else
 433                      ();
 434                  write "\n\tDocumentRoot ";
 435                  write docroot;
 436                  write "\n\tServerAdmin ";
 437                  write sadmin;
 438                  case ssl of
 439                      SOME cert =>
 440                      (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
 441                       write cert)
 442                    | NONE => ();
 443                  write "\n";
 444                  !pre {user = user, nodes = nodes, id = vhostId, hostname = fullHost}
 445              end,
 446           fn () => (!post ();
 447                     write "</VirtualHost>\n";
 448                     app (TextIO.closeOut o #2) (!vhostFiles)))
 449
 450 val inLocal = ref false
 451
 452 val () = Env.container_one "location"
 453          ("prefix", Env.string)
 454          (fn prefix =>
 455              (write "\t<Location ";
 456               write prefix;
 457               write ">\n";
 458               inLocal := true),
 459           fn () => (write "\t</Location>\n";
 460                     inLocal := false;
 461                     localRewriteEnabled := false))
 462
 463 val () = Env.container_one "directory"
 464          ("directory", Env.string)
 465          (fn directory =>
 466              (write "\t<Directory ";
 467               write directory;
 468               write ">\n";
 469               inLocal := true),
 470           fn () => (write "\t</Directory>\n";
 471                     inLocal := false;
 472                     localRewriteEnabled := false))
 473
 474 fun checkRewrite () =
 475     if !inLocal then
 476         if !rewriteEnabled orelse !localRewriteEnabled then
 477             ()
 478         else
 479             (write "\tRewriteEngine on\n";
 480              localRewriteEnabled := true)
 481     else if !rewriteEnabled then
 482         ()
 483     else
 484         (write "\tRewriteEngine on\n";
 485          rewriteEnabled := true)
 486
 487 val () = Env.action_three "localProxyRewrite"
 488          ("from", Env.string, "to", Env.string, "port", Env.int)
 489          (fn (from, to, port) =>
 490              (checkRewrite ();
 491               write "\tRewriteRule\t";
 492               write from;
 493               write "\thttp://localhost:";
 494               write (Int.toString port);
 495               write "/";
 496               write to;
 497               write " [P]\n"))
 498
 499 val () = Env.action_two "proxyPass"
 500          ("from", Env.string, "to", Env.string)
 501          (fn (from, to) =>
 502                  (write "\tProxyPass\t";
 503                   write from;
 504                   write "\t";
 505                   write to;
 506                   write "\n"))
 507
 508 val () = Env.action_two "proxyPassReverse"
 509          ("from", Env.string, "to", Env.string)
 510          (fn (from, to) =>
 511                  (write "\tProxyPassReverse\t";
 512                   write from;
 513                   write "\t";
 514                   write to;
 515                   write "\n"))
 516
 517 val () = Env.action_three "rewriteRule"
 518          ("from", Env.string, "to", Env.string, "flags", Env.list flag)
 519          (fn (from, to, flags) =>
 520              (checkRewrite ();
 521               write "\tRewriteRule\t";
 522               write from;
 523               write "\t";
 524               write to;
 525               case flags of
 526                   [] => ()
 527                 | flag::rest => (write " [";
 528                                  write flag;
 529                                  app (fn flag => (write ",";
 530                                                   write flag)) rest;
 531                                  write "]");
 532               write "\n"))
 533
 534 val () = Env.action_three "rewriteCond"
 535          ("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
 536          (fn (from, to, flags) =>
 537              (checkRewrite ();
 538               write "\tRewriteCond\t";
 539               write from;
 540               write "\t";
 541               write to;
 542               case flags of
 543                   [] => ()
 544                 | flag::rest => (write " [";
 545                                  write flag;
 546                                  app (fn flag => (write ",";
 547                                                   write flag)) rest;
 548                                  write "]");
 549               write "\n"))
 550
 551 val () = Env.action_one "rewriteLogLevel"
 552          ("level", Env.int)
 553          (fn level =>
 554              (checkRewrite ();
 555               write "\tRewriteLog ";
 556               write' (fn x => x);
 557               write "/rewrite.log\n\tRewriteLogLevel ";
 558               write (Int.toString level);
 559               write "\n"))
 560
 561 val () = Env.action_two "alias"
 562          ("from", Env.string, "to", Env.string)
 563          (fn (from, to) =>
 564              (write "\tAlias\t";
 565               write from;
 566               write " ";
 567               write to;
 568               write "\n"))
 569
 570 val () = Env.action_two "scriptAlias"
 571          ("from", Env.string, "to", Env.string)
 572          (fn (from, to) =>
 573              (write "\tScriptAlias\t";
 574               write from;
 575               write " ";
 576               write to;
 577               write "\n"))
 578
 579 val () = Env.action_two "errorDocument"
 580          ("code", Env.string, "handler", Env.string)
 581          (fn (code, handler) =>
 582              (write "\tErrorDocument\t";
 583               write code;
 584               write " ";
 585               write handler;
 586               write "\n"))
 587
 588 val () = Env.action_one "options"
 589          ("options", Env.list apache_option)
 590          (fn opts =>
 591              case opts of
 592                  [] => ()
 593                | _ => (write "\tOptions";
 594                        app (fn opt => (write " "; write opt)) opts;
 595                        write "\n"))
 596
 597 val () = Env.action_one "set_options"
 598          ("options", Env.list apache_option)
 599          (fn opts =>
 600              case opts of
 601                  [] => ()
 602                | _ => (write "\tOptions";
 603                        app (fn opt => (write " +"; write opt)) opts;
 604                        write "\n"))
 605
 606 val () = Env.action_one "unset_options"
 607          ("options", Env.list apache_option)
 608          (fn opts =>
 609              case opts of
 610                  [] => ()
 611                | _ => (write "\tOptions";
 612                        app (fn opt => (write " -"; write opt)) opts;
 613                        write "\n"))
 614
 615 val () = Env.action_one "directoryIndex"
 616          ("filenames", Env.list Env.string)
 617          (fn opts =>
 618              (write "\tDirectoryIndex";
 619               app (fn opt => (write " "; write opt)) opts;
 620               write "\n"))
 621
 622 val () = Env.action_one "serverAlias"
 623          ("host", Env.string)
 624          (fn host =>
 625              (write "\tServerAlias ";
 626               write host;
 627               write "\n";
 628               !aliaser host))
 629
 630 val authType = fn (EVar "basic", _) => SOME "basic"
 631                 | (EVar "digest", _) => SOME "digest"
 632                 | _ => NONE
 633
 634 val () = Env.action_one "authType"
 635          ("type", authType)
 636          (fn ty =>
 637              (write "\tAuthType ";
 638               write ty;
 639               write "\n"))
 640
 641 val () = Env.action_one "authName"
 642          ("name", Env.string)
 643          (fn name =>
 644              (write "\tAuthName \"";
 645               write name;
 646               write "\"\n"))
 647
 648 val () = Env.action_one "authUserFile"
 649          ("file", Env.string)
 650          (fn name =>
 651              (write "\tAuthUserFile ";
 652               write name;
 653               write "\n"))
 654
 655 val () = Env.action_none "requireValidUser"
 656          (fn () => write "\tRequire valid-user\n")
 657
 658 val () = Env.action_one "requireUser"
 659          ("users", Env.list Env.string)
 660          (fn names =>
 661              case names of
 662                  [] => ()
 663                | _ => (write "\tRequire user";
 664                        app (fn name => (write " "; write name)) names;
 665                        write "\n"))
 666
 667 val () = Env.action_one "requireGroup"
 668          ("groups", Env.list Env.string)
 669          (fn names =>
 670              case names of
 671                  [] => ()
 672                | _ => (write "\tRequire group";
 673                        app (fn name => (write " "; write name)) names;
 674                        write "\n"))
 675
 676 val () = Env.action_none "orderAllowDeny"
 677          (fn () => write "\tOrder allow,deny\n")
 678
 679 val () = Env.action_none "orderDenyAllow"
 680          (fn () => write "\tOrder deny,allow\n")
 681
 682 val () = Env.action_none "allowFromAll"
 683          (fn () => write "\tAllow from all\n")
 684
 685 val () = Env.action_one "allowFrom"
 686          ("entries", Env.list Env.string)
 687          (fn names =>
 688              case names of
 689                  [] => ()
 690                | _ => (write "\tAllow from";
 691                        app (fn name => (write " "; write name)) names;
 692                        write "\n"))
 693
 694 val () = Env.action_none "denyFromAll"
 695          (fn () => write "\tDeny from all\n")
 696
 697 val () = Env.action_one "denyFrom"
 698          ("entries", Env.list Env.string)
 699          (fn names =>
 700              case names of
 701                  [] => ()
 702                | _ => (write "\tDeny from";
 703                        app (fn name => (write " "; write name)) names;
 704                        write "\n"))
 705
 706 val () = Env.action_none "satisfyAll"
 707          (fn () => write "\tSatisfy all\n")
 708
 709 val () = Env.action_none "satisfyAny"
 710          (fn () => write "\tSatisfy any\n")
 711
 712 val () = Env.action_one "forceType"
 713          ("type", Env.string)
 714          (fn ty => (write "\tForceType ";
 715                     write ty;
 716                     write "\n"))
 717
 718 val () = Env.action_none "forceTypeOff"
 719          (fn () => write "\tForceType None\n")
 720
 721 val () = Env.action_two "action"
 722          ("what", Env.string, "how", Env.string)
 723          (fn (what, how) => (write "\tAction ";
 724                              write what;
 725                              write " ";
 726                              write how;
 727                              write "\n"))
 728
 729 val () = Env.action_one "addDefaultCharset"
 730          ("charset", Env.string)
 731          (fn ty => (write "\tAddDefaultCharset ";
 732                     write ty;
 733                     write "\n"))
 734
 735 (*val () = Env.action_one "davSvn"
 736          ("path", Env.string)
 737          (fn path => (write "\tDAV svn\n\tSVNPath ";
 738                       write path;
 739                       write "\n"))
 740
 741 val () = Env.action_one "authzSvnAccessFile"
 742          ("path", Env.string)
 743          (fn path => (write "\tAuthzSVNAccessFile ";
 744                       write path;
 745                       write "\n"))*)
 746
 747 val () = Env.action_two "addDescription"
 748          ("description", Env.string, "patterns", Env.list Env.string)
 749          (fn (desc, pats) =>
 750              case pats of
 751                  [] => ()
 752                | _ => (write "\tAddDescription \"";
 753                        write (String.toString desc);
 754                        write "\"";
 755                        app (fn pat => (write " "; write pat)) pats;
 756                        write "\n"))
 757
 758 val () = Env.action_one "indexOptions"
 759          ("options", Env.list autoindex_option)
 760          (fn opts =>
 761              case opts of
 762                  [] => ()
 763                | _ => (write "\tIndexOptions";
 764                        app (fn (opt, arg) =>
 765                                (write " ";
 766                                 write opt;
 767                                 Option.app (fn arg =>
 768                                                (write "="; write arg)) arg)) opts;
 769                        write "\n"))
 770
 771 val () = Env.action_one "set_indexOptions"
 772          ("options", Env.list autoindex_option)
 773          (fn opts =>
 774              case opts of
 775                  [] => ()
 776                | _ => (write "\tIndexOptions";
 777                        app (fn (opt, arg) =>
 778                                (write " +";
 779                                 write opt;
 780                                 Option.app (fn arg =>
 781                                                (write "="; write arg)) arg)) opts;
 782                        write "\n"))
 783
 784 val () = Env.action_one "unset_indexOptions"
 785          ("options", Env.list autoindex_option)
 786          (fn opts =>
 787              case opts of
 788                  [] => ()
 789                | _ => (write "\tIndexOptions";
 790                        app (fn (opt, _) =>
 791                                (write " -";
 792                                 write opt)) opts;
 793                        write "\n"))
 794
 795 val () = Env.action_one "headerName"
 796          ("name", Env.string)
 797          (fn name => (write "\tHeaderName ";
 798                       write name;
 799                       write "\n"))
 800
 801 val () = Env.action_one "readmeName"
 802          ("name", Env.string)
 803          (fn name => (write "\tReadmeName ";
 804                       write name;
 805                       write "\n"))
 806
 807 val () = Domain.registerResetLocal (fn () =>
 808                                        ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
 809
 810 end