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