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