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