HCoop / hcoop / domtool2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Initial mod_waklog support
[hcoop/domtool2.git] / src / plugins / apache.sml
CommitLineData
8a7c40fa
AC		 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
21structure Apache :> APACHE = struct
22
23open Ast
24
60695e99
AC		 25val _ = Env.type_one "web_node"
26 Env.string
27 (fn node =>
55d4a268 28 List.exists (fn (x, _) => x = node) Config.Apache.webNodes_all
be1bea4c 29 orelse (Domain.hasPriv "www"
55d4a268 30 andalso List.exists (fn (x, _) => x = node) Config.Apache.webNodes_admin))
60695e99 31
ce01b51a
AC		 32val _ = Env.registerFunction ("web_node_to_node",
33 fn [e] => SOME e
34 | _ => NONE)
35
f8dfbbcc
AC		 36val _ = Env.type_one "proxy_port"
37 Env.int
e95a129e
AC		 38 (fn n => n > 1024)
39
40val _ = 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)
f8dfbbcc
AC		 56
57val _ = Env.type_one "rewrite_arg"
58 Env.string
59 (CharVector.all Char.isAlphaNum)
60
00a13ad8
AC		 61val _ = Env.type_one "suexec_flag"
62 Env.bool
63 (fn b => b orelse Domain.hasPriv "www")
64
2882ee37
AC		 65fun 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
73val _ = Env.type_one "location"
74 Env.string
75 validLocation
76
434a7b1f
AC		 77fun validCert s = Acl.query {user = Domain.getUser (),
78 class = "cert",
79 value = s}
80
81val _ = Env.type_one "ssl_cert_path"
82 Env.string
83 validCert
84
85fun 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
8a7c40fa
AC		 90val dl = ErrorMsg.dummyLoc
91
aa56e112 92val _ = Defaults.registerDefault ("WebNodes",
60695e99
AC		 93 (TList (TBase "web_node", dl), dl),
94 (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl)))
8a7c40fa 95
aa56e112 96val _ = Defaults.registerDefault ("SSL",
7045a499 97 (TBase "ssl", dl),
47163553 98 (fn () => (EVar "no_ssl", dl)))
8a7c40fa 99
aa56e112
AC		 100val _ = Defaults.registerDefault ("User",
101 (TBase "your_user", dl),
102 (fn () => (EString (Domain.getUser ()), dl)))
8a7c40fa 103
aa56e112
AC		 104val _ = Defaults.registerDefault ("Group",
105 (TBase "your_group", dl),
106 (fn () => (EString (Domain.getUser ()), dl)))
8a7c40fa 107
aa56e112
AC		 108val _ = Defaults.registerDefault ("DocumentRoot",
109 (TBase "your_path", dl),
0da1c677 110 (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl)))
8a7c40fa 111
aa56e112
AC		 112val _ = Defaults.registerDefault ("ServerAdmin",
113 (TBase "email", dl),
114 (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
8a7c40fa 115
00a13ad8
AC		 116val _ = Defaults.registerDefault ("SuExec",
117 (TBase "suexec_flag", dl),
434a7b1f 118 (fn () => (EVar "true", dl)))
f8dfbbcc
AC		 119
120val 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
132val 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
e95a129e
AC		 156val cond_flag = fn (EVar "cond_nocase", _) => SOME "NC"
157 | (EVar "ornext", _) => SOME "OR"
158 | _ => NONE
159
d441e69f
AC		 160val apache_option = fn (EVar "execCGI", _) => SOME "ExecCGI"
161 | (EVar "includesNOEXEC", _) => SOME "IncludesNOEXEC"
162 | (EVar "indexes", _) => SOME "Indexes"
163 | _ => NONE
164
9d7fa346
AC		 165val autoindex_width = fn (EVar "autofit", _) => SOME "*"
166 | (EApp ((EVar "characters", _), n), _) =>
167 Option.map Int.toString (Env.int n)
168 | _ => NONE
169
170val 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
f8dfbbcc 201
8a7c40fa 202val vhostsChanged = ref false
8e965b2d 203val logDeleted = ref false
8a7c40fa
AC		 204
205val () = Slave.registerPreHandler
8e965b2d
AC		 206 (fn () => (vhostsChanged := false;
207 logDeleted := false))
8a7c40fa 208
7db53a0b
AC		 209fun 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 =>
00a13ad8
AC		 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 ()
7db53a0b
AC		 223 in
224 loop ()
225 before TextIO.closeIn inf
3a941c29 226 end handle _ => NONE
7db53a0b 227
55d4a268
AC		 228val webNodes_full = Config.Apache.webNodes_all @ Config.Apache.webNodes_admin
229
230fun isVersion1 node =
f8ef6c20
AC		 231 List.exists (fn (n, {version = ConfigTypes.APACHE_1_3, ...}) => n = node
232 | _ => false) webNodes_full
55d4a268
AC		 233
234fun imVersion1 () = isVersion1 (Slave.hostname ())
235
f8ef6c20
AC		 236fun isWaklog node =
237 List.exists (fn (n, {auth = ConfigTypes.MOD_WAKLOG, ...}) => n = node
238 | _ => false) webNodes_full
239
55d4a268
AC		 240fun down () = if imVersion1 () then Config.Apache.down1 else Config.Apache.down
241fun undown () = if imVersion1 () then Config.Apache.undown1 else Config.Apache.undown
242fun reload () = if imVersion1 () then Config.Apache.reload1 else Config.Apache.reload
243
8a7c40fa 244val () = Slave.registerFileHandler (fn fs =>
7a2b27f0
AC		 245 let
246 val spl = OS.Path.splitDirFile (#file fs)
247 in
248 if String.isSuffix ".vhost" (#file spl)
3a941c29
AC		 249 orelse String.isSuffix ".vhost_ssl" (#file spl) then let
250 val realVhostFile = OS.Path.joinDirFile
251 {dir = Config.Apache.confDir,
252 file = #file spl}
253
254 val user = findVhostUser (#file fs)
255 val oldUser = findVhostUser realVhostFile
256 in
257 if (oldUser = NONE andalso #action fs <> Slave.Add)
258 orelse (user = NONE andalso #action fs <> Slave.Delete) then
259 print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "! Taking no action.\n")
260 else
261 let
262 fun realLogDir user =
263 let
0da1c677 264 val realLogDir = Domain.homedirOf (valOf user)
3a941c29
AC		 265 val realLogDir = OS.Path.joinDirFile
266 {dir = realLogDir,
267 file = "apache"}
268 val realLogDir = OS.Path.joinDirFile
269 {dir = realLogDir,
270 file = "log"}
271 val realLogDir = OS.Path.joinDirFile
272 {dir = realLogDir,
273 file = Slave.hostname ()}
274 val {base, ...} = OS.Path.splitBaseExt (#file spl)
434a7b1f 275
4cbaa5a7 276 val realLogDir = OS.Path.concat (realLogDir, base)
3a941c29 277 in
434a7b1f
AC		 278 if String.isSuffix ".vhost_ssl" (#file spl) then
279 realLogDir ^ ".ssl"
280 else
281 realLogDir
3a941c29
AC		 282 end
283 in
284 vhostsChanged := true;
285 case #action fs of
286 Slave.Delete =>
287 (if !logDeleted then
288 ()
289 else
55d4a268 290 (ignore (OS.Process.system (down ()));
3a941c29
AC		 291 logDeleted := true);
292 ignore (OS.Process.system (Config.rm
293 ^ " -rf "
294 ^ realVhostFile));
295 ignore (OS.Process.system (Config.rm
296 ^ " -rf "
297 ^ realLogDir oldUser)))
298 | Slave.Add =>
299 let
300 val rld = realLogDir user
301 in
302 ignore (OS.Process.system (Config.cp
303 ^ " "
304 ^ #file fs
305 ^ " "
306 ^ realVhostFile));
307 if Posix.FileSys.access (rld, []) then
308 ()
309 else
310 OS.FileSys.mkDir rld
311 end
312
313 | _ =>
314 (ignore (OS.Process.system (Config.cp
315 ^ " "
316 ^ #file fs
317 ^ " "
318 ^ realVhostFile));
319 if user <> oldUser then
320 let
321 val old = realLogDir oldUser
322 val rld = realLogDir user
323 in
324 if !logDeleted then
325 ()
326 else
55d4a268 327 (ignore (OS.Process.system (down ()));
3a941c29
AC		 328 logDeleted := true);
329 ignore (OS.Process.system (Config.rm
330 ^ " -rf "
331 ^ realLogDir oldUser));
332 if Posix.FileSys.access (rld, []) then
333 ()
334 else
335 OS.FileSys.mkDir rld
336 end
337 else
338 ())
339 end
340 end
7a2b27f0
AC		 341 else
342 ()
343 end)
8a7c40fa
AC		 344
345val () = Slave.registerPostHandler
346 (fn () =>
347 (if !vhostsChanged then
55d4a268 348 Slave.shellF ([if !logDeleted then undown () else reload ()],
8a7c40fa
AC		 349 fn cl => "Error reloading Apache with " ^ cl)
350 else
351 ()))
352
7a2b27f0
AC		 353val vhostFiles : (string * TextIO.outstream) list ref = ref []
354fun write' s = app (fn (node, file) => TextIO.output (file, s node)) (!vhostFiles)
355fun write s = app (fn (_, file) => TextIO.output (file, s)) (!vhostFiles)
8a7c40fa 356
f8dfbbcc 357val rewriteEnabled = ref false
ce01b51a 358val localRewriteEnabled = ref false
c98b57cf
AC		 359val currentVhost = ref ""
360val currentVhostId = ref ""
f8dfbbcc 361
7a2b27f0 362val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ())
7f75d838
AC		 363fun registerPre f =
364 let
365 val old = !pre
366 in
367 pre := (fn x => (old x; f x))
368 end
369
370val post = ref (fn () => ())
371fun registerPost f =
372 let
373 val old = !post
374 in
375 post := (fn () => (old (); f ()))
376 end
377
378val aliaser = ref (fn _ : string => ())
379fun registerAliaser f =
380 let
381 val old = !aliaser
382 in
383 aliaser := (fn x => (old x; f x))
384 end
385
8a7c40fa
AC		 386val () = Env.containerV_one "vhost"
387 ("host", Env.string)
388 (fn (env, host) =>
389 let
390 val nodes = Env.env (Env.list Env.string) (env, "WebNodes")
391
434a7b1f 392 val ssl = Env.env ssl (env, "SSL")
8a7c40fa
AC		 393 val user = Env.env Env.string (env, "User")
394 val group = Env.env Env.string (env, "Group")
395 val docroot = Env.env Env.string (env, "DocumentRoot")
396 val sadmin = Env.env Env.string (env, "ServerAdmin")
434a7b1f 397 val suexec = Env.env Env.bool (env, "SuExec")
8a7c40fa
AC		 398
399 val fullHost = host ^ "." ^ Domain.currentDomain ()
434a7b1f
AC		 400 val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
401 val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
8a7c40fa 402 in
c98b57cf
AC		 403 currentVhost := fullHost;
404 currentVhostId := vhostId;
405
f8dfbbcc 406 rewriteEnabled := false;
ce01b51a 407 localRewriteEnabled := false;
8a7c40fa
AC		 408 vhostFiles := map (fn node =>
409 let
410 val file = Domain.domainFile {node = node,
411 name = confFile}
412 in
00a13ad8
AC		 413 TextIO.output (file, "# Owner: ");
414 TextIO.output (file, user);
415 TextIO.output (file, "\n<VirtualHost ");
8a7c40fa
AC		 416 TextIO.output (file, Domain.nodeIp node);
417 TextIO.output (file, ":");
434a7b1f
AC		 418 TextIO.output (file, case ssl of
419 SOME _ => "443"
420 | NONE => "80");
8a7c40fa 421 TextIO.output (file, ">\n");
7a2b27f0 422 TextIO.output (file, "\tErrorLog ");
0da1c677 423 TextIO.output (file, Domain.homedirOf user);
7a2b27f0
AC		 424 TextIO.output (file, "/apache/log/");
425 TextIO.output (file, node);
426 TextIO.output (file, "/");
427 TextIO.output (file, vhostId);
428 TextIO.output (file, "/error.log\n\tCustomLog ");
0da1c677 429 TextIO.output (file, Domain.homedirOf user);
7a2b27f0
AC		 430 TextIO.output (file, "/apache/log/");
431 TextIO.output (file, node);
432 TextIO.output (file, "/");
433 TextIO.output (file, vhostId);
434 TextIO.output (file, "/access.log combined\n");
55d4a268
AC		 435 TextIO.output (file, "\tServerName ");
436 TextIO.output (file, fullHost);
437 if suexec then
438 if isVersion1 node then
439 (TextIO.output (file, "\n\tUser ");
440 TextIO.output (file, user);
441 TextIO.output (file, "\n\tGroup ");
442 TextIO.output (file, group))
443 else
444 (TextIO.output (file, "\n\tSuexecUserGroup ");
445 TextIO.output (file, user);
446 TextIO.output (file, " ");
447 TextIO.output (file, group))
448 else
449 ();
f8ef6c20
AC		 450 if isWaklog node then
451 (TextIO.output (file, "\n\tWaklogProtected on\n\tWaklogPrincipal ");
452 TextIO.output (file, user);
453 TextIO.output (file, "/cgi@HCOOP.NET /etc/keytabs/cgi/");
454 TextIO.output (file, user))
455 else
456 ();
0da1c677 457 (Domain.homedirOf user ^ "/apache/log/"
7a2b27f0 458 ^ node ^ "/" ^ vhostId, file)
8a7c40fa
AC		 459 end)
460 nodes;
8a7c40fa
AC		 461 write "\n\tDocumentRoot ";
462 write docroot;
463 write "\n\tServerAdmin ";
464 write sadmin;
434a7b1f
AC		 465 case ssl of
466 SOME cert =>
467 (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
468 write cert)
469 | NONE => ();
7a2b27f0
AC		 470 write "\n";
471 !pre {user = user, nodes = nodes, id = vhostId, hostname = fullHost}
8a7c40fa 472 end,
7f75d838
AC		 473 fn () => (!post ();
474 write "</VirtualHost>\n";
7a2b27f0 475 app (TextIO.closeOut o #2) (!vhostFiles)))
8a7c40fa 476
ce01b51a
AC		 477val inLocal = ref false
478
2882ee37
AC		 479val () = Env.container_one "location"
480 ("prefix", Env.string)
481 (fn prefix =>
482 (write "\t<Location ";
483 write prefix;
ce01b51a
AC		 484 write ">\n";
485 inLocal := true),
486 fn () => (write "\t</Location>\n";
487 inLocal := false;
488 localRewriteEnabled := false))
2882ee37
AC		 489
490val () = Env.container_one "directory"
491 ("directory", Env.string)
492 (fn directory =>
493 (write "\t<Directory ";
494 write directory;
ce01b51a
AC		 495 write ">\n";
496 inLocal := true),
497 fn () => (write "\t</Directory>\n";
498 inLocal := false;
499 localRewriteEnabled := false))
2882ee37 500
f8dfbbcc 501fun checkRewrite () =
ce01b51a
AC		 502 if !inLocal then
503 if !rewriteEnabled orelse !localRewriteEnabled then
504 ()
505 else
506 (write "\tRewriteEngine on\n";
507 localRewriteEnabled := true)
508 else if !rewriteEnabled then
f8dfbbcc
AC		 509 ()
510 else
511 (write "\tRewriteEngine on\n";
512 rewriteEnabled := true)
513
514val () = Env.action_three "localProxyRewrite"
515 ("from", Env.string, "to", Env.string, "port", Env.int)
516 (fn (from, to, port) =>
517 (checkRewrite ();
518 write "\tRewriteRule\t";
519 write from;
520 write "\thttp://localhost:";
521 write (Int.toString port);
522 write "/";
523 write to;
524 write " [P]\n"))
525
e95a129e
AC		 526val () = Env.action_two "proxyPass"
527 ("from", Env.string, "to", Env.string)
528 (fn (from, to) =>
529 (write "\tProxyPass\t";
530 write from;
531 write "\t";
532 write to;
533 write "\n"))
534
535val () = Env.action_two "proxyPassReverse"
536 ("from", Env.string, "to", Env.string)
537 (fn (from, to) =>
538 (write "\tProxyPassReverse\t";
539 write from;
540 write "\t";
541 write to;
542 write "\n"))
f8dfbbcc
AC		 543
544val () = Env.action_three "rewriteRule"
545 ("from", Env.string, "to", Env.string, "flags", Env.list flag)
546 (fn (from, to, flags) =>
547 (checkRewrite ();
548 write "\tRewriteRule\t";
549 write from;
550 write "\t";
551 write to;
552 case flags of
553 [] => ()
554 | flag::rest => (write " [";
555 write flag;
556 app (fn flag => (write ",";
557 write flag)) rest;
558 write "]");
559 write "\n"))
560
e95a129e
AC		 561val () = Env.action_three "rewriteCond"
562 ("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
563 (fn (from, to, flags) =>
564 (checkRewrite ();
565 write "\tRewriteCond\t";
566 write from;
567 write "\t";
568 write to;
569 case flags of
570 [] => ()
571 | flag::rest => (write " [";
572 write flag;
573 app (fn flag => (write ",";
574 write flag)) rest;
575 write "]");
576 write "\n"))
577
c98b57cf
AC		 578val () = Env.action_one "rewriteLogLevel"
579 ("level", Env.int)
580 (fn level =>
581 (checkRewrite ();
582 write "\tRewriteLog ";
7a2b27f0 583 write' (fn x => x);
c98b57cf
AC		 584 write "/rewrite.log\n\tRewriteLogLevel ";
585 write (Int.toString level);
586 write "\n"))
587
d5754b53
AC		 588val () = Env.action_two "alias"
589 ("from", Env.string, "to", Env.string)
590 (fn (from, to) =>
591 (write "\tAlias\t";
592 write from;
593 write " ";
594 write to;
595 write "\n"))
596
597val () = Env.action_two "scriptAlias"
598 ("from", Env.string, "to", Env.string)
599 (fn (from, to) =>
600 (write "\tScriptAlias\t";
601 write from;
602 write " ";
603 write to;
604 write "\n"))
605
606val () = Env.action_two "errorDocument"
607 ("code", Env.string, "handler", Env.string)
608 (fn (code, handler) =>
609 (write "\tErrorDocument\t";
610 write code;
611 write " ";
612 write handler;
613 write "\n"))
614
d441e69f
AC		 615val () = Env.action_one "options"
616 ("options", Env.list apache_option)
617 (fn opts =>
618 case opts of
619 [] => ()
620 | _ => (write "\tOptions";
621 app (fn opt => (write " "; write opt)) opts;
622 write "\n"))
623
624val () = Env.action_one "set_options"
625 ("options", Env.list apache_option)
626 (fn opts =>
627 case opts of
628 [] => ()
629 | _ => (write "\tOptions";
630 app (fn opt => (write " +"; write opt)) opts;
631 write "\n"))
632
633val () = Env.action_one "unset_options"
634 ("options", Env.list apache_option)
635 (fn opts =>
636 case opts of
637 [] => ()
638 | _ => (write "\tOptions";
639 app (fn opt => (write " -"; write opt)) opts;
640 write "\n"))
d5754b53 641
edd38024
AC		 642val () = Env.action_one "directoryIndex"
643 ("filenames", Env.list Env.string)
644 (fn opts =>
645 (write "\tDirectoryIndex";
646 app (fn opt => (write " "; write opt)) opts;
647 write "\n"))
648
649val () = Env.action_one "serverAlias"
650 ("host", Env.string)
651 (fn host =>
652 (write "\tServerAlias ";
653 write host;
7f75d838
AC		 654 write "\n";
655 !aliaser host))
edd38024 656
2aeb9eec
AC		 657val authType = fn (EVar "basic", _) => SOME "basic"
658 | (EVar "digest", _) => SOME "digest"
659 | _ => NONE
660
661val () = Env.action_one "authType"
662 ("type", authType)
663 (fn ty =>
664 (write "\tAuthType ";
665 write ty;
666 write "\n"))
667
668val () = Env.action_one "authName"
669 ("name", Env.string)
670 (fn name =>
671 (write "\tAuthName \"";
672 write name;
673 write "\"\n"))
674
675val () = Env.action_one "authUserFile"
676 ("file", Env.string)
677 (fn name =>
678 (write "\tAuthUserFile ";
679 write name;
680 write "\n"))
681
682val () = Env.action_none "requireValidUser"
683 (fn () => write "\tRequire valid-user\n")
684
685val () = Env.action_one "requireUser"
686 ("users", Env.list Env.string)
687 (fn names =>
688 case names of
689 [] => ()
690 | _ => (write "\tRequire user";
691 app (fn name => (write " "; write name)) names;
692 write "\n"))
693
694val () = Env.action_one "requireGroup"
695 ("groups", Env.list Env.string)
696 (fn names =>
697 case names of
698 [] => ()
699 | _ => (write "\tRequire group";
700 app (fn name => (write " "; write name)) names;
701 write "\n"))
702
703val () = Env.action_none "orderAllowDeny"
704 (fn () => write "\tOrder allow,deny\n")
705
706val () = Env.action_none "orderDenyAllow"
707 (fn () => write "\tOrder deny,allow\n")
708
709val () = Env.action_none "allowFromAll"
710 (fn () => write "\tAllow from all\n")
711
712val () = Env.action_one "allowFrom"
713 ("entries", Env.list Env.string)
714 (fn names =>
715 case names of
716 [] => ()
717 | _ => (write "\tAllow from";
718 app (fn name => (write " "; write name)) names;
719 write "\n"))
720
721val () = Env.action_none "denyFromAll"
722 (fn () => write "\tDeny from all\n")
723
724val () = Env.action_one "denyFrom"
725 ("entries", Env.list Env.string)
726 (fn names =>
727 case names of
728 [] => ()
729 | _ => (write "\tDeny from";
730 app (fn name => (write " "; write name)) names;
731 write "\n"))
732
733val () = Env.action_none "satisfyAll"
734 (fn () => write "\tSatisfy all\n")
735
736val () = Env.action_none "satisfyAny"
737 (fn () => write "\tSatisfy any\n")
738
7f012ffd
AC		 739val () = Env.action_one "forceType"
740 ("type", Env.string)
741 (fn ty => (write "\tForceType ";
742 write ty;
743 write "\n"))
744
745val () = Env.action_none "forceTypeOff"
746 (fn () => write "\tForceType None\n")
747
748val () = Env.action_two "action"
749 ("what", Env.string, "how", Env.string)
750 (fn (what, how) => (write "\tAction ";
751 write what;
752 write " ";
753 write how;
754 write "\n"))
755
756val () = Env.action_one "addDefaultCharset"
757 ("charset", Env.string)
758 (fn ty => (write "\tAddDefaultCharset ";
759 write ty;
760 write "\n"))
761
64e85bae 762(*val () = Env.action_one "davSvn"
c8505e59
AC		 763 ("path", Env.string)
764 (fn path => (write "\tDAV svn\n\tSVNPath ";
765 write path;
766 write "\n"))
767
768val () = Env.action_one "authzSvnAccessFile"
769 ("path", Env.string)
770 (fn path => (write "\tAuthzSVNAccessFile ";
771 write path;
64e85bae 772 write "\n"))*)
c8505e59 773
9d7fa346
AC		 774val () = Env.action_two "addDescription"
775 ("description", Env.string, "patterns", Env.list Env.string)
776 (fn (desc, pats) =>
777 case pats of
778 [] => ()
779 | _ => (write "\tAddDescription \"";
780 write (String.toString desc);
781 write "\"";
782 app (fn pat => (write " "; write pat)) pats;
783 write "\n"))
784
785val () = Env.action_one "indexOptions"
786 ("options", Env.list autoindex_option)
787 (fn opts =>
788 case opts of
789 [] => ()
790 | _ => (write "\tIndexOptions";
791 app (fn (opt, arg) =>
792 (write " ";
793 write opt;
794 Option.app (fn arg =>
795 (write "="; write arg)) arg)) opts;
796 write "\n"))
797
798val () = Env.action_one "set_indexOptions"
799 ("options", Env.list autoindex_option)
800 (fn opts =>
801 case opts of
802 [] => ()
803 | _ => (write "\tIndexOptions";
804 app (fn (opt, arg) =>
805 (write " +";
806 write opt;
807 Option.app (fn arg =>
808 (write "="; write arg)) arg)) opts;
809 write "\n"))
810
811val () = Env.action_one "unset_indexOptions"
812 ("options", Env.list autoindex_option)
813 (fn opts =>
814 case opts of
815 [] => ()
816 | _ => (write "\tIndexOptions";
817 app (fn (opt, _) =>
818 (write " -";
819 write opt)) opts;
820 write "\n"))
821
822val () = Env.action_one "headerName"
823 ("name", Env.string)
824 (fn name => (write "\tHeaderName ";
825 write name;
826 write "\n"))
827
828val () = Env.action_one "readmeName"
829 ("name", Env.string)
830 (fn name => (write "\tReadmeName ";
831 write name;
832 write "\n"))
833
71420f8b
AC		 834val () = Domain.registerResetLocal (fn () =>
835 ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
836
8a7c40fa 837end
Unnamed repository; edit this file to name it for gitweb.