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