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