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