HCoop / hcoop / zz_old / domtool2-proto.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
More Mailman virtual host stuff
[hcoop/zz_old/domtool2-proto.git] / src / plugins / apache.sml
CommitLineData
d68ab27c 1(* HCoop Domtool (http://hcoop.sourceforge.net/)
3eb5fd92 2 * Copyright (c) 2006-2007, Adam Chlipala
d68ab27c 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
86b9e743 25fun webNode node =
26 List.exists (fn (x, _) => x = node) Config.Apache.webNodes_all
27 orelse (Domain.hasPriv "www"
28 andalso List.exists (fn (x, _) => x = node) Config.Apache.webNodes_admin)
29
4cb2e7e7 30val _ = Env.type_one "web_node"
31 Env.string
86b9e743 32 webNode
4cb2e7e7 33
19bdfddd 34val _ = Env.registerFunction ("web_node_to_node",
35 fn [e] => SOME e
36 | _ => NONE)
37
697d1a52 38val _ = Env.type_one "proxy_port"
39 Env.int
169731e9 40 (fn n => n > 1024)
41
42val _ = Env.type_one "proxy_target"
43 Env.string
44 (fn s =>
45 let
46 fun default () = List.exists (fn s' => s = s') Config.Apache.proxyTargets
47 in
48 case String.fields (fn ch => ch = #":") s of
49 ["http", "//localhost", rest] =>
50 (case String.fields (fn ch => ch = #"/") rest of
51 port :: _ =>
52 (case Int.fromString port of
53 NONE => default ()
54 | SOME n => n > 1024 orelse default ())
55 | _ => default ())
56 | _ => default ()
57 end)
697d1a52 58
59val _ = Env.type_one "rewrite_arg"
60 Env.string
61 (CharVector.all Char.isAlphaNum)
62
25c7a818 63val _ = Env.type_one "suexec_flag"
64 Env.bool
65 (fn b => b orelse Domain.hasPriv "www")
66
ff2a424a 67fun validLocation s =
68 size s > 0 andalso size s < 1000 andalso CharVector.all
69 (fn ch => Char.isAlphaNum ch
70 orelse ch = #"-"
71 orelse ch = #"_"
72 orelse ch = #"."
73 orelse ch = #"/") s
74
75val _ = Env.type_one "location"
76 Env.string
77 validLocation
78
d858369d 79fun validCert s = Acl.query {user = Domain.getUser (),
80 class = "cert",
81 value = s}
82
83val _ = Env.type_one "ssl_cert_path"
84 Env.string
85 validCert
86
87fun ssl e = case e of
88 (EVar "no_ssl", _) => SOME NONE
89 | (EApp ((EVar "use_cert", _), s), _) => Option.map SOME (Env.string s)
90 | _ => NONE
91
d68ab27c 92val dl = ErrorMsg.dummyLoc
93
28cf1be3 94val defaults = [("WebNodes",
95 (TList (TBase "web_node", dl), dl),
96 (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes_default), dl))),
97 ("SSL",
98 (TBase "ssl", dl),
99 (fn () => (EVar "no_ssl", dl))),
100 ("User",
101 (TBase "your_user", dl),
102 (fn () => (EString (Domain.getUser ()), dl))),
103 ("Group",
104 (TBase "your_group", dl),
105 (fn () => (EString "nogroup", dl))),
106 ("DocumentRoot",
107 (TBase "your_path", dl),
108 (fn () => (EString (Domain.homedir () ^ "/" ^ Config.Apache.public_html), dl))),
109 ("ServerAdmin",
110 (TBase "email", dl),
111 (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl))),
112 ("SuExec",
113 (TBase "suexec_flag", dl),
114 (fn () => (EVar "true", dl)))]
115
116val () = app Defaults.registerDefault defaults
697d1a52 117
118val redirect_code = fn (EVar "temp", _) => SOME "temp"
119 | (EVar "permanent", _) => SOME "permanent"
120 | (EVar "seeother", _) => SOME "seeother"
121 | (EVar "redir300", _) => SOME "300"
122 | (EVar "redir301", _) => SOME "301"
123 | (EVar "redir302", _) => SOME "302"
124 | (EVar "redir303", _) => SOME "303"
125 | (EVar "redir304", _) => SOME "304"
126 | (EVar "redir305", _) => SOME "305"
127 | (EVar "redir307", _) => SOME "307"
128 | _ => NONE
129
130val flag = fn (EVar "redirect", _) => SOME "R"
131 | (EVar "forbidden", _) => SOME "F"
132 | (EVar "gone", _) => SOME "G"
133 | (EVar "last", _) => SOME "L"
134 | (EVar "chain", _) => SOME "C"
135 | (EVar "nosubreq", _) => SOME "NS"
136 | (EVar "nocase", _) => SOME "NC"
137 | (EVar "qsappend", _) => SOME "QSA"
138 | (EVar "noescape", _) => SOME "NE"
139 | (EVar "passthrough", _) => SOME "PT"
140 | (EApp ((EVar "mimeType", _), e), _) =>
141 Option.map (fn s => "T=" ^ s) (Env.string e)
142 | (EApp ((EVar "redirectWith", _), e), _) =>
143 Option.map (fn s => "R=" ^ s) (redirect_code e)
144 | (EApp ((EVar "skip", _), e), _) =>
145 Option.map (fn n => "S=" ^ Int.toString n) (Env.int e)
146 | (EApp ((EApp ((EVar "env", _), e1), _), e2), _) =>
147 (case Env.string e1 of
148 NONE => NONE
149 | SOME s1 => Option.map (fn s2 => "E=" ^ s1 ^ ":" ^ s2)
150 (Env.string e2))
151
152 | _ => NONE
153
169731e9 154val cond_flag = fn (EVar "cond_nocase", _) => SOME "NC"
155 | (EVar "ornext", _) => SOME "OR"
156 | _ => NONE
157
ff8db773 158val apache_option = fn (EVar "execCGI", _) => SOME "ExecCGI"
159 | (EVar "includesNOEXEC", _) => SOME "IncludesNOEXEC"
160 | (EVar "indexes", _) => SOME "Indexes"
161 | _ => NONE
162
db9c7cb7 163val autoindex_width = fn (EVar "autofit", _) => SOME "*"
164 | (EApp ((EVar "characters", _), n), _) =>
165 Option.map Int.toString (Env.int n)
166 | _ => NONE
167
168val autoindex_option = fn (EApp ((EVar "descriptionWidth", _), w), _) =>
169 Option.map (fn w => ("DescriptionWidth", SOME w))
170 (autoindex_width w)
171 | (EVar "fancyIndexing", _) => SOME ("FancyIndexing", NONE)
172 | (EVar "foldersFirst", _) => SOME ("FoldersFirst", NONE)
173 | (EVar "htmlTable", _) => SOME ("HTMLTable", NONE)
174 | (EVar "iconsAreLinks", _) => SOME ("IconsAreLinks", NONE)
175 | (EApp ((EVar "iconHeight", _), n), _) =>
176 Option.map (fn w => ("IconHeight", SOME (Int.toString w)))
177 (Env.int n)
178 | (EApp ((EVar "iconWidth", _), n), _) =>
179 Option.map (fn w => ("IconWidth", SOME (Int.toString w)))
180 (Env.int n)
181 | (EVar "ignoreCase", _) => SOME ("IgnoreCase", NONE)
182 | (EVar "ignoreClient", _) => SOME ("IgnoreClient", NONE)
183 | (EApp ((EVar "nameWidth", _), w), _) =>
184 Option.map (fn w => ("NameWidth", SOME w))
185 (autoindex_width w)
186 | (EVar "scanHtmlTitles", _) => SOME ("ScanHTMLTitles", NONE)
187 | (EVar "suppressColumnSorting", _) => SOME ("SuppressColumnSorting", NONE)
188 | (EVar "suppressDescription", _) => SOME ("SuppressDescription", NONE)
189 | (EVar "suppressHtmlPreamble", _) => SOME ("SuppressHTMLPreamble", NONE)
190 | (EVar "suppressIcon", _) => SOME ("SuppressIcon", NONE)
191 | (EVar "suppressLastModified", _) => SOME ("SuppressLastModified", NONE)
192 | (EVar "suppressRules", _) => SOME ("SuppressRules", NONE)
193 | (EVar "suppressSize", _) => SOME ("SuppressSize", NONE)
194 | (EVar "trackModified", _) => SOME ("TrackModified", NONE)
195 | (EVar "versionSort", _) => SOME ("VersionSort", NONE)
196 | (EVar "xhtml", _) => SOME ("XHTML", NONE)
197
198 | _ => NONE
697d1a52 199
d68ab27c 200val vhostsChanged = ref false
8bd6a399 201val logDeleted = ref false
d68ab27c 202
203val () = Slave.registerPreHandler
8bd6a399 204 (fn () => (vhostsChanged := false;
205 logDeleted := false))
d68ab27c 206
acb4199f 207fun findVhostUser fname =
208 let
209 val inf = TextIO.openIn fname
210
211 fun loop () =
212 case TextIO.inputLine inf of
213 NONE => NONE
214 | SOME line =>
25c7a818 215 if String.isPrefix "# Owner: " line then
216 case String.tokens Char.isSpace line of
217 [_, _, user] => SOME user
218 | _ => NONE
219 else
220 loop ()
acb4199f 221 in
222 loop ()
223 before TextIO.closeIn inf
2ec5502f 224 end handle _ => NONE
acb4199f 225
c829302a 226val webNodes_full = Config.Apache.webNodes_all @ Config.Apache.webNodes_admin
227
228fun isVersion1 node =
3410e495 229 List.exists (fn (n, {version = ConfigTypes.APACHE_1_3, ...}) => n = node
230 | _ => false) webNodes_full
c829302a 231
232fun imVersion1 () = isVersion1 (Slave.hostname ())
233
3410e495 234fun isWaklog node =
235 List.exists (fn (n, {auth = ConfigTypes.MOD_WAKLOG, ...}) => n = node
236 | _ => false) webNodes_full
237
c829302a 238fun down () = if imVersion1 () then Config.Apache.down1 else Config.Apache.down
239fun undown () = if imVersion1 () then Config.Apache.undown1 else Config.Apache.undown
240fun reload () = if imVersion1 () then Config.Apache.reload1 else Config.Apache.reload
073e0aa1 241fun fixperms () = if imVersion1 () then Config.Apache.fixperms1 else Config.Apache.fixperms
c829302a 242
ef021e72 243fun logDir {user, node, vhostId} =
dc99a551 244 String.concat [Config.Apache.logDirOf (isVersion1 node) user,
244a93c6 245 "/",
ef021e72 246 node,
247 "/",
248 vhostId]
249
d68ab27c 250val () = Slave.registerFileHandler (fn fs =>
037af74e 251 let
252 val spl = OS.Path.splitDirFile (#file fs)
253 in
254 if String.isSuffix ".vhost" (#file spl)
2ec5502f 255 orelse String.isSuffix ".vhost_ssl" (#file spl) then let
256 val realVhostFile = OS.Path.joinDirFile
257 {dir = Config.Apache.confDir,
258 file = #file spl}
259
260 val user = findVhostUser (#file fs)
a5083ebf 261 val oldUser = case #action fs of
262 Slave.Delete false => user
263 | _ => findVhostUser realVhostFile
2ec5502f 264 in
265 if (oldUser = NONE andalso #action fs <> Slave.Add)
32a3db08 266 orelse (user = NONE andalso not (Slave.isDelete (#action fs))) then
2ec5502f 267 print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "! Taking no action.\n")
268 else
269 let
3cac59ff 270 val vhostId = if OS.Path.ext (#file spl) = SOME "vhost_ssl" then
ef021e72 271 OS.Path.base (#file spl) ^ ".ssl"
272 else
273 OS.Path.base (#file spl)
274
2ec5502f 275 fun realLogDir user =
ef021e72 276 logDir {user = valOf user,
277 node = Slave.hostname (),
278 vhostId = vhostId}
073e0aa1 279
280 fun backupLogs () =
281 OS.Path.joinDirFile
282 {dir = Config.Apache.backupLogDirOf
283 (isVersion1 (Slave.hostname ())),
284 file = vhostId}
2ec5502f 285 in
286 vhostsChanged := true;
287 case #action fs of
32a3db08 288 Slave.Delete _ =>
ddecf6de 289 let
290 val ldir = realLogDir oldUser
291 in
292 if !logDeleted then
293 ()
294 else
295 (ignore (OS.Process.system (down ()));
073e0aa1 296 ignore (OS.Process.system (fixperms ()));
ddecf6de 297 logDeleted := true);
298 ignore (OS.Process.system (Config.rm
299 ^ " -rf "
300 ^ realVhostFile));
301 Slave.moveDirCreate {from = ldir,
073e0aa1 302 to = backupLogs ()}
ddecf6de 303 end
2ec5502f 304 | Slave.Add =>
305 let
306 val rld = realLogDir user
307 in
308 ignore (OS.Process.system (Config.cp
309 ^ " "
310 ^ #file fs
311 ^ " "
312 ^ realVhostFile));
313 if Posix.FileSys.access (rld, []) then
314 ()
315 else
073e0aa1 316 Slave.moveDirCreate {from = backupLogs (),
ddecf6de 317 to = rld}
2ec5502f 318 end
319
320 | _ =>
321 (ignore (OS.Process.system (Config.cp
322 ^ " "
323 ^ #file fs
324 ^ " "
325 ^ realVhostFile));
326 if user <> oldUser then
327 let
328 val old = realLogDir oldUser
329 val rld = realLogDir user
330 in
331 if !logDeleted then
332 ()
333 else
c829302a 334 (ignore (OS.Process.system (down ()));
2ec5502f 335 logDeleted := true);
336 ignore (OS.Process.system (Config.rm
337 ^ " -rf "
338 ^ realLogDir oldUser));
339 if Posix.FileSys.access (rld, []) then
340 ()
341 else
244a93c6 342 Slave.mkDirAll rld
2ec5502f 343 end
344 else
345 ())
346 end
347 end
037af74e 348 else
349 ()
350 end)
d68ab27c 351
352val () = Slave.registerPostHandler
353 (fn () =>
354 (if !vhostsChanged then
c829302a 355 Slave.shellF ([if !logDeleted then undown () else reload ()],
d68ab27c 356 fn cl => "Error reloading Apache with " ^ cl)
357 else
358 ()))
359
037af74e 360val vhostFiles : (string * TextIO.outstream) list ref = ref []
361fun write' s = app (fn (node, file) => TextIO.output (file, s node)) (!vhostFiles)
362fun write s = app (fn (_, file) => TextIO.output (file, s)) (!vhostFiles)
d68ab27c 363
697d1a52 364val rewriteEnabled = ref false
19bdfddd 365val localRewriteEnabled = ref false
3d3acca9 366val currentVhost = ref ""
367val currentVhostId = ref ""
3eb5fd92 368val sslEnabled = ref false
697d1a52 369
037af74e 370val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ())
e1cb845e 371fun registerPre f =
372 let
373 val old = !pre
374 in
375 pre := (fn x => (old x; f x))
376 end
377
378val post = ref (fn () => ())
379fun registerPost f =
380 let
381 val old = !post
382 in
383 post := (fn () => (old (); f ()))
384 end
385
386val aliaser = ref (fn _ : string => ())
387fun registerAliaser f =
388 let
389 val old = !aliaser
390 in
391 aliaser := (fn x => (old x; f x))
392 end
393
d68ab27c 394val () = Env.containerV_one "vhost"
395 ("host", Env.string)
396 (fn (env, host) =>
397 let
398 val nodes = Env.env (Env.list Env.string) (env, "WebNodes")
399
d858369d 400 val ssl = Env.env ssl (env, "SSL")
d68ab27c 401 val user = Env.env Env.string (env, "User")
402 val group = Env.env Env.string (env, "Group")
403 val docroot = Env.env Env.string (env, "DocumentRoot")
404 val sadmin = Env.env Env.string (env, "ServerAdmin")
d858369d 405 val suexec = Env.env Env.bool (env, "SuExec")
d68ab27c 406
407 val fullHost = host ^ "." ^ Domain.currentDomain ()
d858369d 408 val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
409 val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
d68ab27c 410 in
3d3acca9 411 currentVhost := fullHost;
412 currentVhostId := vhostId;
3eb5fd92 413 sslEnabled := Option.isSome ssl;
3d3acca9 414
697d1a52 415 rewriteEnabled := false;
19bdfddd 416 localRewriteEnabled := false;
d68ab27c 417 vhostFiles := map (fn node =>
418 let
419 val file = Domain.domainFile {node = node,
420 name = confFile}
dc99a551 421
422 val ld = logDir {user = user, node = node, vhostId = vhostId}
d68ab27c 423 in
25c7a818 424 TextIO.output (file, "# Owner: ");
425 TextIO.output (file, user);
426 TextIO.output (file, "\n<VirtualHost ");
d68ab27c 427 TextIO.output (file, Domain.nodeIp node);
428 TextIO.output (file, ":");
d858369d 429 TextIO.output (file, case ssl of
430 SOME _ => "443"
431 | NONE => "80");
d68ab27c 432 TextIO.output (file, ">\n");
037af74e 433 TextIO.output (file, "\tErrorLog ");
dc99a551 434 TextIO.output (file, ld);
037af74e 435 TextIO.output (file, "/error.log\n\tCustomLog ");
dc99a551 436 TextIO.output (file, ld);
037af74e 437 TextIO.output (file, "/access.log combined\n");
c829302a 438 TextIO.output (file, "\tServerName ");
439 TextIO.output (file, fullHost);
d3c9f0c6 440 app
441 (fn dom => (TextIO.output (file, "\n\tServerAlias ");
442 TextIO.output (file, host);
443 TextIO.output (file, ".");
444 TextIO.output (file, dom)))
445 (Domain.currentAliasDomains ());
640d7ace 446
c829302a 447 if suexec then
448 if isVersion1 node then
449 (TextIO.output (file, "\n\tUser ");
450 TextIO.output (file, user);
451 TextIO.output (file, "\n\tGroup ");
452 TextIO.output (file, group))
453 else
454 (TextIO.output (file, "\n\tSuexecUserGroup ");
455 TextIO.output (file, user);
456 TextIO.output (file, " ");
457 TextIO.output (file, group))
458 else
459 ();
640d7ace 460
3410e495 461 if isWaklog node then
d29832ae 462 (TextIO.output (file, "\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
3410e495 463 TextIO.output (file, user);
c56e702d 464 TextIO.output (file, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
3410e495 465 TextIO.output (file, user))
466 else
467 ();
640d7ace 468
8c06608a 469 TextIO.output (file, "\n\tDAVLockDB /var/lock/apache2/dav/");
640d7ace 470 TextIO.output (file, user);
471 TextIO.output (file, "/DAVLock");
472
dc99a551 473 (ld, file)
d68ab27c 474 end)
475 nodes;
d68ab27c 476 write "\n\tDocumentRoot ";
477 write docroot;
478 write "\n\tServerAdmin ";
479 write sadmin;
d858369d 480 case ssl of
481 SOME cert =>
482 (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
483 write cert)
484 | NONE => ();
037af74e 485 write "\n";
8a2bb410 486 !pre {user = user, nodes = nodes, id = vhostId, hostname = fullHost};
487 app (fn dom => !aliaser (host ^ "." ^ dom)) (Domain.currentAliasDomains ())
d68ab27c 488 end,
e1cb845e 489 fn () => (!post ();
490 write "</VirtualHost>\n";
037af74e 491 app (TextIO.closeOut o #2) (!vhostFiles)))
d68ab27c 492
19bdfddd 493val inLocal = ref false
494
ff2a424a 495val () = Env.container_one "location"
496 ("prefix", Env.string)
497 (fn prefix =>
498 (write "\t<Location ";
499 write prefix;
19bdfddd 500 write ">\n";
501 inLocal := true),
502 fn () => (write "\t</Location>\n";
503 inLocal := false;
504 localRewriteEnabled := false))
ff2a424a 505
506val () = Env.container_one "directory"
507 ("directory", Env.string)
508 (fn directory =>
509 (write "\t<Directory ";
510 write directory;
19bdfddd 511 write ">\n";
512 inLocal := true),
513 fn () => (write "\t</Directory>\n";
514 inLocal := false;
515 localRewriteEnabled := false))
ff2a424a 516
697d1a52 517fun checkRewrite () =
19bdfddd 518 if !inLocal then
519 if !rewriteEnabled orelse !localRewriteEnabled then
520 ()
521 else
522 (write "\tRewriteEngine on\n";
523 localRewriteEnabled := true)
524 else if !rewriteEnabled then
697d1a52 525 ()
526 else
527 (write "\tRewriteEngine on\n";
528 rewriteEnabled := true)
529
530val () = Env.action_three "localProxyRewrite"
531 ("from", Env.string, "to", Env.string, "port", Env.int)
532 (fn (from, to, port) =>
533 (checkRewrite ();
534 write "\tRewriteRule\t";
535 write from;
536 write "\thttp://localhost:";
537 write (Int.toString port);
538 write "/";
539 write to;
540 write " [P]\n"))
541
169731e9 542val () = Env.action_two "proxyPass"
543 ("from", Env.string, "to", Env.string)
544 (fn (from, to) =>
545 (write "\tProxyPass\t";
546 write from;
547 write "\t";
548 write to;
549 write "\n"))
550
551val () = Env.action_two "proxyPassReverse"
552 ("from", Env.string, "to", Env.string)
553 (fn (from, to) =>
554 (write "\tProxyPassReverse\t";
555 write from;
556 write "\t";
557 write to;
558 write "\n"))
697d1a52 559
560val () = Env.action_three "rewriteRule"
561 ("from", Env.string, "to", Env.string, "flags", Env.list flag)
562 (fn (from, to, flags) =>
563 (checkRewrite ();
564 write "\tRewriteRule\t";
565 write from;
566 write "\t";
567 write to;
568 case flags of
569 [] => ()
570 | flag::rest => (write " [";
571 write flag;
572 app (fn flag => (write ",";
573 write flag)) rest;
574 write "]");
575 write "\n"))
576
169731e9 577val () = Env.action_three "rewriteCond"
578 ("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
579 (fn (from, to, flags) =>
580 (checkRewrite ();
581 write "\tRewriteCond\t";
582 write from;
583 write "\t";
584 write to;
585 case flags of
586 [] => ()
587 | flag::rest => (write " [";
588 write flag;
589 app (fn flag => (write ",";
590 write flag)) rest;
591 write "]");
592 write "\n"))
593
e28c342c 594val () = Env.action_one "rewriteBase"
595 ("prefix", Env.string)
596 (fn prefix =>
597 (checkRewrite ();
598 write "\tRewriteBase\t";
599 write prefix;
600 write "\n"))
601
3d3acca9 602val () = Env.action_one "rewriteLogLevel"
603 ("level", Env.int)
604 (fn level =>
605 (checkRewrite ();
606 write "\tRewriteLog ";
037af74e 607 write' (fn x => x);
3d3acca9 608 write "/rewrite.log\n\tRewriteLogLevel ";
609 write (Int.toString level);
610 write "\n"))
611
0279185b 612val () = Env.action_two "alias"
613 ("from", Env.string, "to", Env.string)
614 (fn (from, to) =>
615 (write "\tAlias\t";
616 write from;
617 write " ";
618 write to;
619 write "\n"))
620
621val () = Env.action_two "scriptAlias"
622 ("from", Env.string, "to", Env.string)
623 (fn (from, to) =>
624 (write "\tScriptAlias\t";
625 write from;
626 write " ";
627 write to;
628 write "\n"))
629
630val () = Env.action_two "errorDocument"
631 ("code", Env.string, "handler", Env.string)
632 (fn (code, handler) =>
633 (write "\tErrorDocument\t";
634 write code;
635 write " ";
636 write handler;
637 write "\n"))
638
ff8db773 639val () = Env.action_one "options"
640 ("options", Env.list apache_option)
641 (fn opts =>
642 case opts of
643 [] => ()
644 | _ => (write "\tOptions";
645 app (fn opt => (write " "; write opt)) opts;
646 write "\n"))
647
648val () = Env.action_one "set_options"
649 ("options", Env.list apache_option)
650 (fn opts =>
651 case opts of
652 [] => ()
653 | _ => (write "\tOptions";
654 app (fn opt => (write " +"; write opt)) opts;
655 write "\n"))
656
657val () = Env.action_one "unset_options"
658 ("options", Env.list apache_option)
659 (fn opts =>
660 case opts of
661 [] => ()
662 | _ => (write "\tOptions";
663 app (fn opt => (write " -"; write opt)) opts;
664 write "\n"))
0279185b 665
69d98465 666val () = Env.action_one "directoryIndex"
667 ("filenames", Env.list Env.string)
668 (fn opts =>
669 (write "\tDirectoryIndex";
670 app (fn opt => (write " "; write opt)) opts;
671 write "\n"))
672
d3c9f0c6 673val () = Env.action_one "serverAliasHost"
69d98465 674 ("host", Env.string)
675 (fn host =>
676 (write "\tServerAlias ";
677 write host;
e1cb845e 678 write "\n";
679 !aliaser host))
69d98465 680
d3c9f0c6 681val () = Env.action_one "serverAlias"
682 ("host", Env.string)
683 (fn host =>
684 (app
685 (fn dom =>
686 let
687 val full = host ^ "." ^ dom
688 in
689 write "\tServerAlias ";
690 write full;
691 write "\n";
692 !aliaser full
693 end)
694 (Domain.currentDomains ())))
695
696val () = Env.action_none "serverAliasDefault"
697 (fn () =>
698 (app
699 (fn dom =>
700 (write "\tServerAlias ";
701 write dom;
702 write "\n";
703 !aliaser dom))
704 (Domain.currentDomains ())))
705
00e4345d 706val authType = fn (EVar "basic", _) => SOME "basic"
707 | (EVar "digest", _) => SOME "digest"
7fb3d705 708 | (EVar "kerberos", _) => SOME "kerberos"
00e4345d 709 | _ => NONE
710
3eb5fd92 711fun allowAuthType "kerberos" = !sslEnabled
712 | allowAuthType _ = true
713
00e4345d 714val () = Env.action_one "authType"
715 ("type", authType)
716 (fn ty =>
3eb5fd92 717 if allowAuthType ty then
718 (write "\tAuthType ";
719 write ty;
720 write "\n";
721 case ty of
722 "kerberos" =>
723 write "\tKrbMethodNegotiate off\n\tKrbMethodK5Passwd on\n\tKrbVerifyKDC off\n\tKrbAuthRealms HCOOP.NET\n\tKrbSaveCredentials on\n"
724 | _ => ())
725 else
726 print "WARNING: Skipped Kerberos authType because this isn't an SSL vhost.\n")
00e4345d 727
728val () = Env.action_one "authName"
729 ("name", Env.string)
730 (fn name =>
731 (write "\tAuthName \"";
732 write name;
733 write "\"\n"))
734
735val () = Env.action_one "authUserFile"
736 ("file", Env.string)
737 (fn name =>
738 (write "\tAuthUserFile ";
739 write name;
740 write "\n"))
741
742val () = Env.action_none "requireValidUser"
743 (fn () => write "\tRequire valid-user\n")
744
745val () = Env.action_one "requireUser"
746 ("users", Env.list Env.string)
747 (fn names =>
748 case names of
749 [] => ()
750 | _ => (write "\tRequire user";
751 app (fn name => (write " "; write name)) names;
752 write "\n"))
753
754val () = Env.action_one "requireGroup"
755 ("groups", Env.list Env.string)
756 (fn names =>
757 case names of
758 [] => ()
759 | _ => (write "\tRequire group";
760 app (fn name => (write " "; write name)) names;
761 write "\n"))
762
763val () = Env.action_none "orderAllowDeny"
764 (fn () => write "\tOrder allow,deny\n")
765
766val () = Env.action_none "orderDenyAllow"
767 (fn () => write "\tOrder deny,allow\n")
768
769val () = Env.action_none "allowFromAll"
770 (fn () => write "\tAllow from all\n")
771
772val () = Env.action_one "allowFrom"
773 ("entries", Env.list Env.string)
774 (fn names =>
775 case names of
776 [] => ()
777 | _ => (write "\tAllow from";
778 app (fn name => (write " "; write name)) names;
779 write "\n"))
780
781val () = Env.action_none "denyFromAll"
782 (fn () => write "\tDeny from all\n")
783
784val () = Env.action_one "denyFrom"
785 ("entries", Env.list Env.string)
786 (fn names =>
787 case names of
788 [] => ()
789 | _ => (write "\tDeny from";
790 app (fn name => (write " "; write name)) names;
791 write "\n"))
792
793val () = Env.action_none "satisfyAll"
794 (fn () => write "\tSatisfy all\n")
795
796val () = Env.action_none "satisfyAny"
797 (fn () => write "\tSatisfy any\n")
798
4cc63b03 799val () = Env.action_one "forceType"
800 ("type", Env.string)
801 (fn ty => (write "\tForceType ";
802 write ty;
803 write "\n"))
804
805val () = Env.action_none "forceTypeOff"
806 (fn () => write "\tForceType None\n")
807
808val () = Env.action_two "action"
809 ("what", Env.string, "how", Env.string)
810 (fn (what, how) => (write "\tAction ";
811 write what;
812 write " ";
813 write how;
814 write "\n"))
815
816val () = Env.action_one "addDefaultCharset"
817 ("charset", Env.string)
818 (fn ty => (write "\tAddDefaultCharset ";
819 write ty;
820 write "\n"))
821
26716b02 822(*val () = Env.action_one "davSvn"
efffba2a 823 ("path", Env.string)
824 (fn path => (write "\tDAV svn\n\tSVNPath ";
825 write path;
826 write "\n"))
827
828val () = Env.action_one "authzSvnAccessFile"
829 ("path", Env.string)
830 (fn path => (write "\tAuthzSVNAccessFile ";
831 write path;
26716b02 832 write "\n"))*)
efffba2a 833
2aa13b91 834val () = Env.action_none "davFilesystem"
835 (fn path => write "\tDAV filesystem\n")
836
db9c7cb7 837val () = Env.action_two "addDescription"
838 ("description", Env.string, "patterns", Env.list Env.string)
839 (fn (desc, pats) =>
840 case pats of
841 [] => ()
842 | _ => (write "\tAddDescription \"";
843 write (String.toString desc);
844 write "\"";
845 app (fn pat => (write " "; write pat)) pats;
846 write "\n"))
847
848val () = Env.action_one "indexOptions"
849 ("options", Env.list autoindex_option)
850 (fn opts =>
851 case opts of
852 [] => ()
853 | _ => (write "\tIndexOptions";
854 app (fn (opt, arg) =>
855 (write " ";
856 write opt;
857 Option.app (fn arg =>
858 (write "="; write arg)) arg)) opts;
859 write "\n"))
860
861val () = Env.action_one "set_indexOptions"
862 ("options", Env.list autoindex_option)
863 (fn opts =>
864 case opts of
865 [] => ()
866 | _ => (write "\tIndexOptions";
867 app (fn (opt, arg) =>
868 (write " +";
869 write opt;
870 Option.app (fn arg =>
871 (write "="; write arg)) arg)) opts;
872 write "\n"))
873
874val () = Env.action_one "unset_indexOptions"
875 ("options", Env.list autoindex_option)
876 (fn opts =>
877 case opts of
878 [] => ()
879 | _ => (write "\tIndexOptions";
880 app (fn (opt, _) =>
881 (write " -";
882 write opt)) opts;
883 write "\n"))
884
885val () = Env.action_one "headerName"
886 ("name", Env.string)
887 (fn name => (write "\tHeaderName ";
888 write name;
889 write "\n"))
890
891val () = Env.action_one "readmeName"
892 ("name", Env.string)
893 (fn name => (write "\tReadmeName ";
894 write name;
895 write "\n"))
896
d71ae374 897val () = Env.action_two "setEnv"
898 ("key", Env.string, "value", Env.string)
899 (fn (key, value) => (write "\tSetEnv \"";
900 write key;
901 write "\" \"";
3a319372 902 write (String.translate (fn #"\"" => "\\\""
903 | ch => str ch) value);
d71ae374 904 write "\"\n"))
905
0ea0ecfa 906val () = Domain.registerResetLocal (fn () =>
907 ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
908
1f5e7aad 909val () = Domain.registerDescriber (Domain.considerAll
910 [Domain.Extension {extension = "vhost",
71e08489 911 heading = fn host => "Web vhost " ^ host},
1f5e7aad 912 Domain.Extension {extension = "vhost_ssl",
71e08489 913 heading = fn host => "SSL web vhost " ^ host}])
1f5e7aad 914
d68ab27c 915end
DomTool: HCoop's distributed system configuration tool.