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