HCoop / hcoop / zz_old / domtool2-proto.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Run 'domain' initialization even with 'noDns' is selected.
[hcoop/zz_old/domtool2-proto.git] / src / plugins / apache.sml
CommitLineData
d68ab27c 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
4cb2e7e7 25val _ = Env.type_one "web_node"
26 Env.string
27 (fn node =>
c829302a 28 List.exists (fn (x, _) => x = node) Config.Apache.webNodes_all
1bb29dea 29 orelse (Domain.hasPriv "www"
c829302a 30 andalso List.exists (fn (x, _) => x = node) Config.Apache.webNodes_admin))
4cb2e7e7 31
19bdfddd 32val _ = Env.registerFunction ("web_node_to_node",
33 fn [e] => SOME e
34 | _ => NONE)
35
697d1a52 36val _ = Env.type_one "proxy_port"
37 Env.int
169731e9 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)
697d1a52 56
57val _ = Env.type_one "rewrite_arg"
58 Env.string
59 (CharVector.all Char.isAlphaNum)
60
25c7a818 61val _ = Env.type_one "suexec_flag"
62 Env.bool
63 (fn b => b orelse Domain.hasPriv "www")
64
ff2a424a 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
d858369d 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
d68ab27c 90val dl = ErrorMsg.dummyLoc
91
53d222a3 92val _ = Defaults.registerDefault ("WebNodes",
4cb2e7e7 93 (TList (TBase "web_node", dl), dl),
94 (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl)))
d68ab27c 95
53d222a3 96val _ = Defaults.registerDefault ("SSL",
5d5309ef 97 (TBase "ssl", dl),
3d8d63c2 98 (fn () => (EVar "no_ssl", dl)))
d68ab27c 99
53d222a3 100val _ = Defaults.registerDefault ("User",
101 (TBase "your_user", dl),
102 (fn () => (EString (Domain.getUser ()), dl)))
d68ab27c 103
53d222a3 104val _ = Defaults.registerDefault ("Group",
105 (TBase "your_group", dl),
fdd6551b 106 (fn () => (EString "nogroup", dl)))
d68ab27c 107
53d222a3 108val _ = Defaults.registerDefault ("DocumentRoot",
109 (TBase "your_path", dl),
73e665f1 110 (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl)))
d68ab27c 111
53d222a3 112val _ = Defaults.registerDefault ("ServerAdmin",
113 (TBase "email", dl),
114 (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl)))
d68ab27c 115
25c7a818 116val _ = Defaults.registerDefault ("SuExec",
117 (TBase "suexec_flag", dl),
d858369d 118 (fn () => (EVar "true", dl)))
697d1a52 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
169731e9 156val cond_flag = fn (EVar "cond_nocase", _) => SOME "NC"
157 | (EVar "ornext", _) => SOME "OR"
158 | _ => NONE
159
ff8db773 160val apache_option = fn (EVar "execCGI", _) => SOME "ExecCGI"
161 | (EVar "includesNOEXEC", _) => SOME "IncludesNOEXEC"
162 | (EVar "indexes", _) => SOME "Indexes"
163 | _ => NONE
164
db9c7cb7 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
697d1a52 201
d68ab27c 202val vhostsChanged = ref false
8bd6a399 203val logDeleted = ref false
d68ab27c 204
205val () = Slave.registerPreHandler
8bd6a399 206 (fn () => (vhostsChanged := false;
207 logDeleted := false))
d68ab27c 208
acb4199f 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 =>
25c7a818 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 ()
acb4199f 223 in
224 loop ()
225 before TextIO.closeIn inf
2ec5502f 226 end handle _ => NONE
acb4199f 227
c829302a 228val webNodes_full = Config.Apache.webNodes_all @ Config.Apache.webNodes_admin
229
230fun isVersion1 node =
3410e495 231 List.exists (fn (n, {version = ConfigTypes.APACHE_1_3, ...}) => n = node
232 | _ => false) webNodes_full
c829302a 233
234fun imVersion1 () = isVersion1 (Slave.hostname ())
235
3410e495 236fun isWaklog node =
237 List.exists (fn (n, {auth = ConfigTypes.MOD_WAKLOG, ...}) => n = node
238 | _ => false) webNodes_full
239
c829302a 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
ef021e72 244fun logDir {user, node, vhostId} =
dc99a551 245 String.concat [Config.Apache.logDirOf (isVersion1 node) user,
244a93c6 246 "/",
ef021e72 247 node,
248 "/",
249 vhostId]
250
d68ab27c 251val () = Slave.registerFileHandler (fn fs =>
037af74e 252 let
253 val spl = OS.Path.splitDirFile (#file fs)
254 in
255 if String.isSuffix ".vhost" (#file spl)
2ec5502f 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
3cac59ff 269 val vhostId = if OS.Path.ext (#file spl) = SOME "vhost_ssl" then
ef021e72 270 OS.Path.base (#file spl) ^ ".ssl"
271 else
272 OS.Path.base (#file spl)
273
2ec5502f 274 fun realLogDir user =
ef021e72 275 logDir {user = valOf user,
276 node = Slave.hostname (),
277 vhostId = vhostId}
2ec5502f 278 in
279 vhostsChanged := true;
280 case #action fs of
281 Slave.Delete =>
282 (if !logDeleted then
283 ()
284 else
c829302a 285 (ignore (OS.Process.system (down ()));
2ec5502f 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
244a93c6 305 Slave.mkDirAll rld
2ec5502f 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
c829302a 322 (ignore (OS.Process.system (down ()));
2ec5502f 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
244a93c6 330 Slave.mkDirAll rld
2ec5502f 331 end
332 else
333 ())
334 end
335 end
037af74e 336 else
337 ()
338 end)
d68ab27c 339
340val () = Slave.registerPostHandler
341 (fn () =>
342 (if !vhostsChanged then
c829302a 343 Slave.shellF ([if !logDeleted then undown () else reload ()],
d68ab27c 344 fn cl => "Error reloading Apache with " ^ cl)
345 else
346 ()))
347
037af74e 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)
d68ab27c 351
697d1a52 352val rewriteEnabled = ref false
19bdfddd 353val localRewriteEnabled = ref false
3d3acca9 354val currentVhost = ref ""
355val currentVhostId = ref ""
697d1a52 356
037af74e 357val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ())
e1cb845e 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
d68ab27c 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
d858369d 387 val ssl = Env.env ssl (env, "SSL")
d68ab27c 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")
d858369d 392 val suexec = Env.env Env.bool (env, "SuExec")
d68ab27c 393
394 val fullHost = host ^ "." ^ Domain.currentDomain ()
d858369d 395 val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
396 val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
d68ab27c 397 in
3d3acca9 398 currentVhost := fullHost;
399 currentVhostId := vhostId;
400
697d1a52 401 rewriteEnabled := false;
19bdfddd 402 localRewriteEnabled := false;
d68ab27c 403 vhostFiles := map (fn node =>
404 let
405 val file = Domain.domainFile {node = node,
406 name = confFile}
dc99a551 407
408 val ld = logDir {user = user, node = node, vhostId = vhostId}
d68ab27c 409 in
25c7a818 410 TextIO.output (file, "# Owner: ");
411 TextIO.output (file, user);
412 TextIO.output (file, "\n<VirtualHost ");
d68ab27c 413 TextIO.output (file, Domain.nodeIp node);
414 TextIO.output (file, ":");
d858369d 415 TextIO.output (file, case ssl of
416 SOME _ => "443"
417 | NONE => "80");
d68ab27c 418 TextIO.output (file, ">\n");
037af74e 419 TextIO.output (file, "\tErrorLog ");
dc99a551 420 TextIO.output (file, ld);
037af74e 421 TextIO.output (file, "/error.log\n\tCustomLog ");
dc99a551 422 TextIO.output (file, ld);
037af74e 423 TextIO.output (file, "/access.log combined\n");
c829302a 424 TextIO.output (file, "\tServerName ");
425 TextIO.output (file, fullHost);
d3c9f0c6 426 app
427 (fn dom => (TextIO.output (file, "\n\tServerAlias ");
428 TextIO.output (file, host);
429 TextIO.output (file, ".");
430 TextIO.output (file, dom)))
431 (Domain.currentAliasDomains ());
c829302a 432 if suexec then
433 if isVersion1 node then
434 (TextIO.output (file, "\n\tUser ");
435 TextIO.output (file, user);
436 TextIO.output (file, "\n\tGroup ");
437 TextIO.output (file, group))
438 else
439 (TextIO.output (file, "\n\tSuexecUserGroup ");
440 TextIO.output (file, user);
441 TextIO.output (file, " ");
442 TextIO.output (file, group))
443 else
444 ();
3410e495 445 if isWaklog node then
d29832ae 446 (TextIO.output (file, "\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
3410e495 447 TextIO.output (file, user);
c56e702d 448 TextIO.output (file, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
3410e495 449 TextIO.output (file, user))
450 else
451 ();
dc99a551 452 (ld, file)
d68ab27c 453 end)
454 nodes;
d68ab27c 455 write "\n\tDocumentRoot ";
456 write docroot;
457 write "\n\tServerAdmin ";
458 write sadmin;
d858369d 459 case ssl of
460 SOME cert =>
461 (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
462 write cert)
463 | NONE => ();
037af74e 464 write "\n";
8a2bb410 465 !pre {user = user, nodes = nodes, id = vhostId, hostname = fullHost};
466 app (fn dom => !aliaser (host ^ "." ^ dom)) (Domain.currentAliasDomains ())
d68ab27c 467 end,
e1cb845e 468 fn () => (!post ();
469 write "</VirtualHost>\n";
037af74e 470 app (TextIO.closeOut o #2) (!vhostFiles)))
d68ab27c 471
19bdfddd 472val inLocal = ref false
473
ff2a424a 474val () = Env.container_one "location"
475 ("prefix", Env.string)
476 (fn prefix =>
477 (write "\t<Location ";
478 write prefix;
19bdfddd 479 write ">\n";
480 inLocal := true),
481 fn () => (write "\t</Location>\n";
482 inLocal := false;
483 localRewriteEnabled := false))
ff2a424a 484
485val () = Env.container_one "directory"
486 ("directory", Env.string)
487 (fn directory =>
488 (write "\t<Directory ";
489 write directory;
19bdfddd 490 write ">\n";
491 inLocal := true),
492 fn () => (write "\t</Directory>\n";
493 inLocal := false;
494 localRewriteEnabled := false))
ff2a424a 495
697d1a52 496fun checkRewrite () =
19bdfddd 497 if !inLocal then
498 if !rewriteEnabled orelse !localRewriteEnabled then
499 ()
500 else
501 (write "\tRewriteEngine on\n";
502 localRewriteEnabled := true)
503 else if !rewriteEnabled then
697d1a52 504 ()
505 else
506 (write "\tRewriteEngine on\n";
507 rewriteEnabled := true)
508
509val () = Env.action_three "localProxyRewrite"
510 ("from", Env.string, "to", Env.string, "port", Env.int)
511 (fn (from, to, port) =>
512 (checkRewrite ();
513 write "\tRewriteRule\t";
514 write from;
515 write "\thttp://localhost:";
516 write (Int.toString port);
517 write "/";
518 write to;
519 write " [P]\n"))
520
169731e9 521val () = Env.action_two "proxyPass"
522 ("from", Env.string, "to", Env.string)
523 (fn (from, to) =>
524 (write "\tProxyPass\t";
525 write from;
526 write "\t";
527 write to;
528 write "\n"))
529
530val () = Env.action_two "proxyPassReverse"
531 ("from", Env.string, "to", Env.string)
532 (fn (from, to) =>
533 (write "\tProxyPassReverse\t";
534 write from;
535 write "\t";
536 write to;
537 write "\n"))
697d1a52 538
539val () = Env.action_three "rewriteRule"
540 ("from", Env.string, "to", Env.string, "flags", Env.list flag)
541 (fn (from, to, flags) =>
542 (checkRewrite ();
543 write "\tRewriteRule\t";
544 write from;
545 write "\t";
546 write to;
547 case flags of
548 [] => ()
549 | flag::rest => (write " [";
550 write flag;
551 app (fn flag => (write ",";
552 write flag)) rest;
553 write "]");
554 write "\n"))
555
169731e9 556val () = Env.action_three "rewriteCond"
557 ("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
558 (fn (from, to, flags) =>
559 (checkRewrite ();
560 write "\tRewriteCond\t";
561 write from;
562 write "\t";
563 write to;
564 case flags of
565 [] => ()
566 | flag::rest => (write " [";
567 write flag;
568 app (fn flag => (write ",";
569 write flag)) rest;
570 write "]");
571 write "\n"))
572
e28c342c 573val () = Env.action_one "rewriteBase"
574 ("prefix", Env.string)
575 (fn prefix =>
576 (checkRewrite ();
577 write "\tRewriteBase\t";
578 write prefix;
579 write "\n"))
580
3d3acca9 581val () = Env.action_one "rewriteLogLevel"
582 ("level", Env.int)
583 (fn level =>
584 (checkRewrite ();
585 write "\tRewriteLog ";
037af74e 586 write' (fn x => x);
3d3acca9 587 write "/rewrite.log\n\tRewriteLogLevel ";
588 write (Int.toString level);
589 write "\n"))
590
0279185b 591val () = Env.action_two "alias"
592 ("from", Env.string, "to", Env.string)
593 (fn (from, to) =>
594 (write "\tAlias\t";
595 write from;
596 write " ";
597 write to;
598 write "\n"))
599
600val () = Env.action_two "scriptAlias"
601 ("from", Env.string, "to", Env.string)
602 (fn (from, to) =>
603 (write "\tScriptAlias\t";
604 write from;
605 write " ";
606 write to;
607 write "\n"))
608
609val () = Env.action_two "errorDocument"
610 ("code", Env.string, "handler", Env.string)
611 (fn (code, handler) =>
612 (write "\tErrorDocument\t";
613 write code;
614 write " ";
615 write handler;
616 write "\n"))
617
ff8db773 618val () = Env.action_one "options"
619 ("options", Env.list apache_option)
620 (fn opts =>
621 case opts of
622 [] => ()
623 | _ => (write "\tOptions";
624 app (fn opt => (write " "; write opt)) opts;
625 write "\n"))
626
627val () = Env.action_one "set_options"
628 ("options", Env.list apache_option)
629 (fn opts =>
630 case opts of
631 [] => ()
632 | _ => (write "\tOptions";
633 app (fn opt => (write " +"; write opt)) opts;
634 write "\n"))
635
636val () = Env.action_one "unset_options"
637 ("options", Env.list apache_option)
638 (fn opts =>
639 case opts of
640 [] => ()
641 | _ => (write "\tOptions";
642 app (fn opt => (write " -"; write opt)) opts;
643 write "\n"))
0279185b 644
69d98465 645val () = Env.action_one "directoryIndex"
646 ("filenames", Env.list Env.string)
647 (fn opts =>
648 (write "\tDirectoryIndex";
649 app (fn opt => (write " "; write opt)) opts;
650 write "\n"))
651
d3c9f0c6 652val () = Env.action_one "serverAliasHost"
69d98465 653 ("host", Env.string)
654 (fn host =>
655 (write "\tServerAlias ";
656 write host;
e1cb845e 657 write "\n";
658 !aliaser host))
69d98465 659
d3c9f0c6 660val () = Env.action_one "serverAlias"
661 ("host", Env.string)
662 (fn host =>
663 (app
664 (fn dom =>
665 let
666 val full = host ^ "." ^ dom
667 in
668 write "\tServerAlias ";
669 write full;
670 write "\n";
671 !aliaser full
672 end)
673 (Domain.currentDomains ())))
674
675val () = Env.action_none "serverAliasDefault"
676 (fn () =>
677 (app
678 (fn dom =>
679 (write "\tServerAlias ";
680 write dom;
681 write "\n";
682 !aliaser dom))
683 (Domain.currentDomains ())))
684
00e4345d 685val authType = fn (EVar "basic", _) => SOME "basic"
686 | (EVar "digest", _) => SOME "digest"
7fb3d705 687 | (EVar "kerberos", _) => SOME "kerberos"
00e4345d 688 | _ => NONE
689
690val () = Env.action_one "authType"
691 ("type", authType)
692 (fn ty =>
693 (write "\tAuthType ";
694 write ty;
7fb3d705 695 write "\n";
696 case ty of
697 "kerberos" =>
698 write "\tKrbMethodNegotiate off\n\tKrbMethodK5Passwd on\n\tKrbVerifyKDC off\n\tKrbAuthRealms HCOOP.NET\n\tKrbSaveCredentials on\n"
699 | _ => ()))
00e4345d 700
701val () = Env.action_one "authName"
702 ("name", Env.string)
703 (fn name =>
704 (write "\tAuthName \"";
705 write name;
706 write "\"\n"))
707
708val () = Env.action_one "authUserFile"
709 ("file", Env.string)
710 (fn name =>
711 (write "\tAuthUserFile ";
712 write name;
713 write "\n"))
714
715val () = Env.action_none "requireValidUser"
716 (fn () => write "\tRequire valid-user\n")
717
718val () = Env.action_one "requireUser"
719 ("users", Env.list Env.string)
720 (fn names =>
721 case names of
722 [] => ()
723 | _ => (write "\tRequire user";
724 app (fn name => (write " "; write name)) names;
725 write "\n"))
726
727val () = Env.action_one "requireGroup"
728 ("groups", Env.list Env.string)
729 (fn names =>
730 case names of
731 [] => ()
732 | _ => (write "\tRequire group";
733 app (fn name => (write " "; write name)) names;
734 write "\n"))
735
736val () = Env.action_none "orderAllowDeny"
737 (fn () => write "\tOrder allow,deny\n")
738
739val () = Env.action_none "orderDenyAllow"
740 (fn () => write "\tOrder deny,allow\n")
741
742val () = Env.action_none "allowFromAll"
743 (fn () => write "\tAllow from all\n")
744
745val () = Env.action_one "allowFrom"
746 ("entries", Env.list Env.string)
747 (fn names =>
748 case names of
749 [] => ()
750 | _ => (write "\tAllow from";
751 app (fn name => (write " "; write name)) names;
752 write "\n"))
753
754val () = Env.action_none "denyFromAll"
755 (fn () => write "\tDeny from all\n")
756
757val () = Env.action_one "denyFrom"
758 ("entries", Env.list Env.string)
759 (fn names =>
760 case names of
761 [] => ()
762 | _ => (write "\tDeny from";
763 app (fn name => (write " "; write name)) names;
764 write "\n"))
765
766val () = Env.action_none "satisfyAll"
767 (fn () => write "\tSatisfy all\n")
768
769val () = Env.action_none "satisfyAny"
770 (fn () => write "\tSatisfy any\n")
771
4cc63b03 772val () = Env.action_one "forceType"
773 ("type", Env.string)
774 (fn ty => (write "\tForceType ";
775 write ty;
776 write "\n"))
777
778val () = Env.action_none "forceTypeOff"
779 (fn () => write "\tForceType None\n")
780
781val () = Env.action_two "action"
782 ("what", Env.string, "how", Env.string)
783 (fn (what, how) => (write "\tAction ";
784 write what;
785 write " ";
786 write how;
787 write "\n"))
788
789val () = Env.action_one "addDefaultCharset"
790 ("charset", Env.string)
791 (fn ty => (write "\tAddDefaultCharset ";
792 write ty;
793 write "\n"))
794
26716b02 795(*val () = Env.action_one "davSvn"
efffba2a 796 ("path", Env.string)
797 (fn path => (write "\tDAV svn\n\tSVNPath ";
798 write path;
799 write "\n"))
800
801val () = Env.action_one "authzSvnAccessFile"
802 ("path", Env.string)
803 (fn path => (write "\tAuthzSVNAccessFile ";
804 write path;
26716b02 805 write "\n"))*)
efffba2a 806
db9c7cb7 807val () = Env.action_two "addDescription"
808 ("description", Env.string, "patterns", Env.list Env.string)
809 (fn (desc, pats) =>
810 case pats of
811 [] => ()
812 | _ => (write "\tAddDescription \"";
813 write (String.toString desc);
814 write "\"";
815 app (fn pat => (write " "; write pat)) pats;
816 write "\n"))
817
818val () = Env.action_one "indexOptions"
819 ("options", Env.list autoindex_option)
820 (fn opts =>
821 case opts of
822 [] => ()
823 | _ => (write "\tIndexOptions";
824 app (fn (opt, arg) =>
825 (write " ";
826 write opt;
827 Option.app (fn arg =>
828 (write "="; write arg)) arg)) opts;
829 write "\n"))
830
831val () = Env.action_one "set_indexOptions"
832 ("options", Env.list autoindex_option)
833 (fn opts =>
834 case opts of
835 [] => ()
836 | _ => (write "\tIndexOptions";
837 app (fn (opt, arg) =>
838 (write " +";
839 write opt;
840 Option.app (fn arg =>
841 (write "="; write arg)) arg)) opts;
842 write "\n"))
843
844val () = Env.action_one "unset_indexOptions"
845 ("options", Env.list autoindex_option)
846 (fn opts =>
847 case opts of
848 [] => ()
849 | _ => (write "\tIndexOptions";
850 app (fn (opt, _) =>
851 (write " -";
852 write opt)) opts;
853 write "\n"))
854
855val () = Env.action_one "headerName"
856 ("name", Env.string)
857 (fn name => (write "\tHeaderName ";
858 write name;
859 write "\n"))
860
861val () = Env.action_one "readmeName"
862 ("name", Env.string)
863 (fn name => (write "\tReadmeName ";
864 write name;
865 write "\n"))
866
0ea0ecfa 867val () = Domain.registerResetLocal (fn () =>
868 ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
869
d68ab27c 870end
DomTool: HCoop's distributed system configuration tool.