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