HCoop / hcoop / domtool2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Proper handling of vhost deletions and ownership changes
[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
3a941c29 214 end handle _ => NONE
7db53a0b 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)
3a941c29
AC		 221 orelse String.isSuffix ".vhost_ssl" (#file spl) then let
222 val realVhostFile = OS.Path.joinDirFile
223 {dir = Config.Apache.confDir,
224 file = #file spl}
225
226 val user = findVhostUser (#file fs)
227 val oldUser = findVhostUser realVhostFile
228 in
229 if (oldUser = NONE andalso #action fs <> Slave.Add)
230 orelse (user = NONE andalso #action fs <> Slave.Delete) then
231 print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "! Taking no action.\n")
232 else
233 let
234 fun realLogDir user =
235 let
236 val realLogDir = OS.Path.joinDirFile
237 {dir = Config.homeBase,
238 file = valOf user}
239 val realLogDir = OS.Path.joinDirFile
240 {dir = realLogDir,
241 file = "apache"}
242 val realLogDir = OS.Path.joinDirFile
243 {dir = realLogDir,
244 file = "log"}
245 val realLogDir = OS.Path.joinDirFile
246 {dir = realLogDir,
247 file = Slave.hostname ()}
248 val {base, ...} = OS.Path.splitBaseExt (#file spl)
249 in
250 OS.Path.joinDirFile
251 {dir = realLogDir,
252 file = base}
253 end
254 in
255 vhostsChanged := true;
256 case #action fs of
257 Slave.Delete =>
258 (if !logDeleted then
259 ()
260 else
261 (ignore (OS.Process.system Config.Apache.down);
262 logDeleted := true);
263 ignore (OS.Process.system (Config.rm
264 ^ " -rf "
265 ^ realVhostFile));
266 ignore (OS.Process.system (Config.rm
267 ^ " -rf "
268 ^ realLogDir oldUser)))
269 | Slave.Add =>
270 let
271 val rld = realLogDir user
272 in
273 ignore (OS.Process.system (Config.cp
274 ^ " "
275 ^ #file fs
276 ^ " "
277 ^ realVhostFile));
278 if Posix.FileSys.access (rld, []) then
279 ()
280 else
281 OS.FileSys.mkDir rld
282 end
283
284 | _ =>
285 (ignore (OS.Process.system (Config.cp
286 ^ " "
287 ^ #file fs
288 ^ " "
289 ^ realVhostFile));
290 if user <> oldUser then
291 let
292 val old = realLogDir oldUser
293 val rld = realLogDir user
294 in
295 if !logDeleted then
296 ()
297 else
298 (ignore (OS.Process.system Config.Apache.down);
299 logDeleted := true);
300 ignore (OS.Process.system (Config.rm
301 ^ " -rf "
302 ^ realLogDir oldUser));
303 if Posix.FileSys.access (rld, []) then
304 ()
305 else
306 OS.FileSys.mkDir rld
307 end
308 else
309 ())
310 end
311 end
7a2b27f0
AC		 312 else
313 ()
314 end)
8a7c40fa
AC		 315
316val () = Slave.registerPostHandler
317 (fn () =>
318 (if !vhostsChanged then
8e965b2d 319 Slave.shellF ([if !logDeleted then Config.Apache.undown else Config.Apache.reload],
8a7c40fa
AC		 320 fn cl => "Error reloading Apache with " ^ cl)
321 else
322 ()))
323
7a2b27f0
AC		 324val vhostFiles : (string * TextIO.outstream) list ref = ref []
325fun write' s = app (fn (node, file) => TextIO.output (file, s node)) (!vhostFiles)
326fun write s = app (fn (_, file) => TextIO.output (file, s)) (!vhostFiles)
8a7c40fa 327
f8dfbbcc 328val rewriteEnabled = ref false
ce01b51a 329val localRewriteEnabled = ref false
c98b57cf
AC		 330val currentVhost = ref ""
331val currentVhostId = ref ""
f8dfbbcc 332
7a2b27f0 333val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ())
7f75d838
AC		 334fun registerPre f =
335 let
336 val old = !pre
337 in
338 pre := (fn x => (old x; f x))
339 end
340
341val post = ref (fn () => ())
342fun registerPost f =
343 let
344 val old = !post
345 in
346 post := (fn () => (old (); f ()))
347 end
348
349val aliaser = ref (fn _ : string => ())
350fun registerAliaser f =
351 let
352 val old = !aliaser
353 in
354 aliaser := (fn x => (old x; f x))
355 end
356
00a13ad8
AC		 357fun suexec_flag (EApp ((EVar "suexec_flag", _), e), _) = Env.bool e
358 | suexec_flag _ = NONE
359
8a7c40fa
AC		 360val () = Env.containerV_one "vhost"
361 ("host", Env.string)
362 (fn (env, host) =>
363 let
364 val nodes = Env.env (Env.list Env.string) (env, "WebNodes")
365
366 val ssl = Env.env Env.bool (env, "SSL")
367 val user = Env.env Env.string (env, "User")
368 val group = Env.env Env.string (env, "Group")
369 val docroot = Env.env Env.string (env, "DocumentRoot")
370 val sadmin = Env.env Env.string (env, "ServerAdmin")
00a13ad8 371 val suexec = Env.env suexec_flag (env, "SuExec")
8a7c40fa
AC		 372
373 val fullHost = host ^ "." ^ Domain.currentDomain ()
c98b57cf 374 val vhostId = fullHost ^ (if ssl then ".ssl" else "")
8a7c40fa
AC		 375 val confFile = fullHost ^ (if ssl then ".vhost_ssl" else ".vhost")
376 in
c98b57cf
AC		 377 currentVhost := fullHost;
378 currentVhostId := vhostId;
379
f8dfbbcc 380 rewriteEnabled := false;
ce01b51a 381 localRewriteEnabled := false;
8a7c40fa
AC		 382 vhostFiles := map (fn node =>
383 let
384 val file = Domain.domainFile {node = node,
385 name = confFile}
386 in
00a13ad8
AC		 387 TextIO.output (file, "# Owner: ");
388 TextIO.output (file, user);
389 TextIO.output (file, "\n<VirtualHost ");
8a7c40fa
AC		 390 TextIO.output (file, Domain.nodeIp node);
391 TextIO.output (file, ":");
392 TextIO.output (file, if ssl then
393 "443"
394 else
395 "80");
396 TextIO.output (file, ">\n");
7a2b27f0
AC		 397 TextIO.output (file, "\tErrorLog ");
398 TextIO.output (file, Config.homeBase);
399 TextIO.output (file, "/");
400 TextIO.output (file, user);
401 TextIO.output (file, "/apache/log/");
402 TextIO.output (file, node);
403 TextIO.output (file, "/");
404 TextIO.output (file, vhostId);
405 TextIO.output (file, "/error.log\n\tCustomLog ");
406 TextIO.output (file, Config.homeBase);
407 TextIO.output (file, "/");
408 TextIO.output (file, user);
409 TextIO.output (file, "/apache/log/");
410 TextIO.output (file, node);
411 TextIO.output (file, "/");
412 TextIO.output (file, vhostId);
413 TextIO.output (file, "/access.log combined\n");
414 (Config.homeBase ^ "/" ^ user ^ "/apache/log/"
415 ^ node ^ "/" ^ vhostId, file)
8a7c40fa
AC		 416 end)
417 nodes;
edd38024
AC		 418 write "\tServerName ";
419 write fullHost;
00a13ad8
AC		 420 if suexec then
421 (write "\n\tSuexecUserGroup ";
422 write user;
423 write " ";
424 write group)
425 else
426 ();
8a7c40fa
AC		 427 write "\n\tDocumentRoot ";
428 write docroot;
429 write "\n\tServerAdmin ";
430 write sadmin;
3a941c29
AC		 431 if ssl then
432 (write "\n\tSSLEngine on")
433 else
434 ();
7a2b27f0
AC		 435 write "\n";
436 !pre {user = user, nodes = nodes, id = vhostId, hostname = fullHost}
8a7c40fa 437 end,
7f75d838
AC		 438 fn () => (!post ();
439 write "</VirtualHost>\n";
7a2b27f0 440 app (TextIO.closeOut o #2) (!vhostFiles)))
8a7c40fa 441
ce01b51a
AC		 442val inLocal = ref false
443
2882ee37
AC		 444val () = Env.container_one "location"
445 ("prefix", Env.string)
446 (fn prefix =>
447 (write "\t<Location ";
448 write prefix;
ce01b51a
AC		 449 write ">\n";
450 inLocal := true),
451 fn () => (write "\t</Location>\n";
452 inLocal := false;
453 localRewriteEnabled := false))
2882ee37
AC		 454
455val () = Env.container_one "directory"
456 ("directory", Env.string)
457 (fn directory =>
458 (write "\t<Directory ";
459 write directory;
ce01b51a
AC		 460 write ">\n";
461 inLocal := true),
462 fn () => (write "\t</Directory>\n";
463 inLocal := false;
464 localRewriteEnabled := false))
2882ee37 465
f8dfbbcc 466fun checkRewrite () =
ce01b51a
AC		 467 if !inLocal then
468 if !rewriteEnabled orelse !localRewriteEnabled then
469 ()
470 else
471 (write "\tRewriteEngine on\n";
472 localRewriteEnabled := true)
473 else if !rewriteEnabled then
f8dfbbcc
AC		 474 ()
475 else
476 (write "\tRewriteEngine on\n";
477 rewriteEnabled := true)
478
479val () = Env.action_three "localProxyRewrite"
480 ("from", Env.string, "to", Env.string, "port", Env.int)
481 (fn (from, to, port) =>
482 (checkRewrite ();
483 write "\tRewriteRule\t";
484 write from;
485 write "\thttp://localhost:";
486 write (Int.toString port);
487 write "/";
488 write to;
489 write " [P]\n"))
490
e95a129e
AC		 491val () = Env.action_two "proxyPass"
492 ("from", Env.string, "to", Env.string)
493 (fn (from, to) =>
494 (write "\tProxyPass\t";
495 write from;
496 write "\t";
497 write to;
498 write "\n"))
499
500val () = Env.action_two "proxyPassReverse"
501 ("from", Env.string, "to", Env.string)
502 (fn (from, to) =>
503 (write "\tProxyPassReverse\t";
504 write from;
505 write "\t";
506 write to;
507 write "\n"))
f8dfbbcc
AC		 508
509val () = Env.action_three "rewriteRule"
510 ("from", Env.string, "to", Env.string, "flags", Env.list flag)
511 (fn (from, to, flags) =>
512 (checkRewrite ();
513 write "\tRewriteRule\t";
514 write from;
515 write "\t";
516 write to;
517 case flags of
518 [] => ()
519 | flag::rest => (write " [";
520 write flag;
521 app (fn flag => (write ",";
522 write flag)) rest;
523 write "]");
524 write "\n"))
525
e95a129e
AC		 526val () = Env.action_three "rewriteCond"
527 ("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
528 (fn (from, to, flags) =>
529 (checkRewrite ();
530 write "\tRewriteCond\t";
531 write from;
532 write "\t";
533 write to;
534 case flags of
535 [] => ()
536 | flag::rest => (write " [";
537 write flag;
538 app (fn flag => (write ",";
539 write flag)) rest;
540 write "]");
541 write "\n"))
542
c98b57cf
AC		 543val () = Env.action_one "rewriteLogLevel"
544 ("level", Env.int)
545 (fn level =>
546 (checkRewrite ();
547 write "\tRewriteLog ";
7a2b27f0 548 write' (fn x => x);
c98b57cf
AC		 549 write "/rewrite.log\n\tRewriteLogLevel ";
550 write (Int.toString level);
551 write "\n"))
552
d5754b53
AC		 553val () = Env.action_two "alias"
554 ("from", Env.string, "to", Env.string)
555 (fn (from, to) =>
556 (write "\tAlias\t";
557 write from;
558 write " ";
559 write to;
560 write "\n"))
561
562val () = Env.action_two "scriptAlias"
563 ("from", Env.string, "to", Env.string)
564 (fn (from, to) =>
565 (write "\tScriptAlias\t";
566 write from;
567 write " ";
568 write to;
569 write "\n"))
570
571val () = Env.action_two "errorDocument"
572 ("code", Env.string, "handler", Env.string)
573 (fn (code, handler) =>
574 (write "\tErrorDocument\t";
575 write code;
576 write " ";
577 write handler;
578 write "\n"))
579
d441e69f
AC		 580val () = Env.action_one "options"
581 ("options", Env.list apache_option)
582 (fn opts =>
583 case opts of
584 [] => ()
585 | _ => (write "\tOptions";
586 app (fn opt => (write " "; write opt)) opts;
587 write "\n"))
588
589val () = Env.action_one "set_options"
590 ("options", Env.list apache_option)
591 (fn opts =>
592 case opts of
593 [] => ()
594 | _ => (write "\tOptions";
595 app (fn opt => (write " +"; write opt)) opts;
596 write "\n"))
597
598val () = Env.action_one "unset_options"
599 ("options", Env.list apache_option)
600 (fn opts =>
601 case opts of
602 [] => ()
603 | _ => (write "\tOptions";
604 app (fn opt => (write " -"; write opt)) opts;
605 write "\n"))
d5754b53 606
edd38024
AC		 607val () = Env.action_one "directoryIndex"
608 ("filenames", Env.list Env.string)
609 (fn opts =>
610 (write "\tDirectoryIndex";
611 app (fn opt => (write " "; write opt)) opts;
612 write "\n"))
613
614val () = Env.action_one "serverAlias"
615 ("host", Env.string)
616 (fn host =>
617 (write "\tServerAlias ";
618 write host;
7f75d838
AC		 619 write "\n";
620 !aliaser host))
edd38024 621
2aeb9eec
AC		 622val authType = fn (EVar "basic", _) => SOME "basic"
623 | (EVar "digest", _) => SOME "digest"
624 | _ => NONE
625
626val () = Env.action_one "authType"
627 ("type", authType)
628 (fn ty =>
629 (write "\tAuthType ";
630 write ty;
631 write "\n"))
632
633val () = Env.action_one "authName"
634 ("name", Env.string)
635 (fn name =>
636 (write "\tAuthName \"";
637 write name;
638 write "\"\n"))
639
640val () = Env.action_one "authUserFile"
641 ("file", Env.string)
642 (fn name =>
643 (write "\tAuthUserFile ";
644 write name;
645 write "\n"))
646
647val () = Env.action_none "requireValidUser"
648 (fn () => write "\tRequire valid-user\n")
649
650val () = Env.action_one "requireUser"
651 ("users", Env.list Env.string)
652 (fn names =>
653 case names of
654 [] => ()
655 | _ => (write "\tRequire user";
656 app (fn name => (write " "; write name)) names;
657 write "\n"))
658
659val () = Env.action_one "requireGroup"
660 ("groups", Env.list Env.string)
661 (fn names =>
662 case names of
663 [] => ()
664 | _ => (write "\tRequire group";
665 app (fn name => (write " "; write name)) names;
666 write "\n"))
667
668val () = Env.action_none "orderAllowDeny"
669 (fn () => write "\tOrder allow,deny\n")
670
671val () = Env.action_none "orderDenyAllow"
672 (fn () => write "\tOrder deny,allow\n")
673
674val () = Env.action_none "allowFromAll"
675 (fn () => write "\tAllow from all\n")
676
677val () = Env.action_one "allowFrom"
678 ("entries", Env.list Env.string)
679 (fn names =>
680 case names of
681 [] => ()
682 | _ => (write "\tAllow from";
683 app (fn name => (write " "; write name)) names;
684 write "\n"))
685
686val () = Env.action_none "denyFromAll"
687 (fn () => write "\tDeny from all\n")
688
689val () = Env.action_one "denyFrom"
690 ("entries", Env.list Env.string)
691 (fn names =>
692 case names of
693 [] => ()
694 | _ => (write "\tDeny from";
695 app (fn name => (write " "; write name)) names;
696 write "\n"))
697
698val () = Env.action_none "satisfyAll"
699 (fn () => write "\tSatisfy all\n")
700
701val () = Env.action_none "satisfyAny"
702 (fn () => write "\tSatisfy any\n")
703
7f012ffd
AC		 704val () = Env.action_one "forceType"
705 ("type", Env.string)
706 (fn ty => (write "\tForceType ";
707 write ty;
708 write "\n"))
709
710val () = Env.action_none "forceTypeOff"
711 (fn () => write "\tForceType None\n")
712
713val () = Env.action_two "action"
714 ("what", Env.string, "how", Env.string)
715 (fn (what, how) => (write "\tAction ";
716 write what;
717 write " ";
718 write how;
719 write "\n"))
720
721val () = Env.action_one "addDefaultCharset"
722 ("charset", Env.string)
723 (fn ty => (write "\tAddDefaultCharset ";
724 write ty;
725 write "\n"))
726
64e85bae 727(*val () = Env.action_one "davSvn"
c8505e59
AC		 728 ("path", Env.string)
729 (fn path => (write "\tDAV svn\n\tSVNPath ";
730 write path;
731 write "\n"))
732
733val () = Env.action_one "authzSvnAccessFile"
734 ("path", Env.string)
735 (fn path => (write "\tAuthzSVNAccessFile ";
736 write path;
64e85bae 737 write "\n"))*)
c8505e59 738
9d7fa346
AC		 739val () = Env.action_two "addDescription"
740 ("description", Env.string, "patterns", Env.list Env.string)
741 (fn (desc, pats) =>
742 case pats of
743 [] => ()
744 | _ => (write "\tAddDescription \"";
745 write (String.toString desc);
746 write "\"";
747 app (fn pat => (write " "; write pat)) pats;
748 write "\n"))
749
750val () = Env.action_one "indexOptions"
751 ("options", Env.list autoindex_option)
752 (fn opts =>
753 case opts of
754 [] => ()
755 | _ => (write "\tIndexOptions";
756 app (fn (opt, arg) =>
757 (write " ";
758 write opt;
759 Option.app (fn arg =>
760 (write "="; write arg)) arg)) opts;
761 write "\n"))
762
763val () = Env.action_one "set_indexOptions"
764 ("options", Env.list autoindex_option)
765 (fn opts =>
766 case opts of
767 [] => ()
768 | _ => (write "\tIndexOptions";
769 app (fn (opt, arg) =>
770 (write " +";
771 write opt;
772 Option.app (fn arg =>
773 (write "="; write arg)) arg)) opts;
774 write "\n"))
775
776val () = Env.action_one "unset_indexOptions"
777 ("options", Env.list autoindex_option)
778 (fn opts =>
779 case opts of
780 [] => ()
781 | _ => (write "\tIndexOptions";
782 app (fn (opt, _) =>
783 (write " -";
784 write opt)) opts;
785 write "\n"))
786
787val () = Env.action_one "headerName"
788 ("name", Env.string)
789 (fn name => (write "\tHeaderName ";
790 write name;
791 write "\n"))
792
793val () = Env.action_one "readmeName"
794 ("name", Env.string)
795 (fn name => (write "\tReadmeName ";
796 write name;
797 write "\n"))
798
71420f8b
AC		 799val () = Domain.registerResetLocal (fn () =>
800 ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
801
8a7c40fa 802end
Unnamed repository; edit this file to name it for gitweb.