HCoop / hcoop / zz_old / domtool2-proto.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
More describers
[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
239
ef021e72 240fun logDir {user, node, vhostId} =
dc99a551 241 String.concat [Config.Apache.logDirOf (isVersion1 node) user,
244a93c6 242 "/",
ef021e72 243 node,
244 "/",
245 vhostId]
246
d68ab27c 247val () = Slave.registerFileHandler (fn fs =>
037af74e 248 let
249 val spl = OS.Path.splitDirFile (#file fs)
250 in
251 if String.isSuffix ".vhost" (#file spl)
2ec5502f 252 orelse String.isSuffix ".vhost_ssl" (#file spl) then let
253 val realVhostFile = OS.Path.joinDirFile
254 {dir = Config.Apache.confDir,
255 file = #file spl}
256
257 val user = findVhostUser (#file fs)
258 val oldUser = findVhostUser realVhostFile
259 in
260 if (oldUser = NONE andalso #action fs <> Slave.Add)
261 orelse (user = NONE andalso #action fs <> Slave.Delete) then
262 print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "! Taking no action.\n")
263 else
264 let
3cac59ff 265 val vhostId = if OS.Path.ext (#file spl) = SOME "vhost_ssl" then
ef021e72 266 OS.Path.base (#file spl) ^ ".ssl"
267 else
268 OS.Path.base (#file spl)
269
2ec5502f 270 fun realLogDir user =
ef021e72 271 logDir {user = valOf user,
272 node = Slave.hostname (),
273 vhostId = vhostId}
2ec5502f 274 in
275 vhostsChanged := true;
276 case #action fs of
277 Slave.Delete =>
278 (if !logDeleted then
279 ()
280 else
c829302a 281 (ignore (OS.Process.system (down ()));
2ec5502f 282 logDeleted := true);
283 ignore (OS.Process.system (Config.rm
284 ^ " -rf "
285 ^ realVhostFile));
286 ignore (OS.Process.system (Config.rm
287 ^ " -rf "
288 ^ realLogDir oldUser)))
289 | Slave.Add =>
290 let
291 val rld = realLogDir user
292 in
293 ignore (OS.Process.system (Config.cp
294 ^ " "
295 ^ #file fs
296 ^ " "
297 ^ realVhostFile));
298 if Posix.FileSys.access (rld, []) then
299 ()
300 else
244a93c6 301 Slave.mkDirAll rld
2ec5502f 302 end
303
304 | _ =>
305 (ignore (OS.Process.system (Config.cp
306 ^ " "
307 ^ #file fs
308 ^ " "
309 ^ realVhostFile));
310 if user <> oldUser then
311 let
312 val old = realLogDir oldUser
313 val rld = realLogDir user
314 in
315 if !logDeleted then
316 ()
317 else
c829302a 318 (ignore (OS.Process.system (down ()));
2ec5502f 319 logDeleted := true);
320 ignore (OS.Process.system (Config.rm
321 ^ " -rf "
322 ^ realLogDir oldUser));
323 if Posix.FileSys.access (rld, []) then
324 ()
325 else
244a93c6 326 Slave.mkDirAll rld
2ec5502f 327 end
328 else
329 ())
330 end
331 end
037af74e 332 else
333 ()
334 end)
d68ab27c 335
336val () = Slave.registerPostHandler
337 (fn () =>
338 (if !vhostsChanged then
c829302a 339 Slave.shellF ([if !logDeleted then undown () else reload ()],
d68ab27c 340 fn cl => "Error reloading Apache with " ^ cl)
341 else
342 ()))
343
037af74e 344val vhostFiles : (string * TextIO.outstream) list ref = ref []
345fun write' s = app (fn (node, file) => TextIO.output (file, s node)) (!vhostFiles)
346fun write s = app (fn (_, file) => TextIO.output (file, s)) (!vhostFiles)
d68ab27c 347
697d1a52 348val rewriteEnabled = ref false
19bdfddd 349val localRewriteEnabled = ref false
3d3acca9 350val currentVhost = ref ""
351val currentVhostId = ref ""
3eb5fd92 352val sslEnabled = ref false
697d1a52 353
037af74e 354val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ())
e1cb845e 355fun registerPre f =
356 let
357 val old = !pre
358 in
359 pre := (fn x => (old x; f x))
360 end
361
362val post = ref (fn () => ())
363fun registerPost f =
364 let
365 val old = !post
366 in
367 post := (fn () => (old (); f ()))
368 end
369
370val aliaser = ref (fn _ : string => ())
371fun registerAliaser f =
372 let
373 val old = !aliaser
374 in
375 aliaser := (fn x => (old x; f x))
376 end
377
d68ab27c 378val () = Env.containerV_one "vhost"
379 ("host", Env.string)
380 (fn (env, host) =>
381 let
382 val nodes = Env.env (Env.list Env.string) (env, "WebNodes")
383
d858369d 384 val ssl = Env.env ssl (env, "SSL")
d68ab27c 385 val user = Env.env Env.string (env, "User")
386 val group = Env.env Env.string (env, "Group")
387 val docroot = Env.env Env.string (env, "DocumentRoot")
388 val sadmin = Env.env Env.string (env, "ServerAdmin")
d858369d 389 val suexec = Env.env Env.bool (env, "SuExec")
d68ab27c 390
391 val fullHost = host ^ "." ^ Domain.currentDomain ()
d858369d 392 val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
393 val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
d68ab27c 394 in
3d3acca9 395 currentVhost := fullHost;
396 currentVhostId := vhostId;
3eb5fd92 397 sslEnabled := Option.isSome ssl;
3d3acca9 398
697d1a52 399 rewriteEnabled := false;
19bdfddd 400 localRewriteEnabled := false;
d68ab27c 401 vhostFiles := map (fn node =>
402 let
403 val file = Domain.domainFile {node = node,
404 name = confFile}
dc99a551 405
406 val ld = logDir {user = user, node = node, vhostId = vhostId}
d68ab27c 407 in
25c7a818 408 TextIO.output (file, "# Owner: ");
409 TextIO.output (file, user);
410 TextIO.output (file, "\n<VirtualHost ");
d68ab27c 411 TextIO.output (file, Domain.nodeIp node);
412 TextIO.output (file, ":");
d858369d 413 TextIO.output (file, case ssl of
414 SOME _ => "443"
415 | NONE => "80");
d68ab27c 416 TextIO.output (file, ">\n");
037af74e 417 TextIO.output (file, "\tErrorLog ");
dc99a551 418 TextIO.output (file, ld);
037af74e 419 TextIO.output (file, "/error.log\n\tCustomLog ");
dc99a551 420 TextIO.output (file, ld);
037af74e 421 TextIO.output (file, "/access.log combined\n");
c829302a 422 TextIO.output (file, "\tServerName ");
423 TextIO.output (file, fullHost);
d3c9f0c6 424 app
425 (fn dom => (TextIO.output (file, "\n\tServerAlias ");
426 TextIO.output (file, host);
427 TextIO.output (file, ".");
428 TextIO.output (file, dom)))
429 (Domain.currentAliasDomains ());
640d7ace 430
c829302a 431 if suexec then
432 if isVersion1 node then
433 (TextIO.output (file, "\n\tUser ");
434 TextIO.output (file, user);
435 TextIO.output (file, "\n\tGroup ");
436 TextIO.output (file, group))
437 else
438 (TextIO.output (file, "\n\tSuexecUserGroup ");
439 TextIO.output (file, user);
440 TextIO.output (file, " ");
441 TextIO.output (file, group))
442 else
443 ();
640d7ace 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 ();
640d7ace 452
8c06608a 453 TextIO.output (file, "\n\tDAVLockDB /var/lock/apache2/dav/");
640d7ace 454 TextIO.output (file, user);
455 TextIO.output (file, "/DAVLock");
456
dc99a551 457 (ld, file)
d68ab27c 458 end)
459 nodes;
d68ab27c 460 write "\n\tDocumentRoot ";
461 write docroot;
462 write "\n\tServerAdmin ";
463 write sadmin;
d858369d 464 case ssl of
465 SOME cert =>
466 (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
467 write cert)
468 | NONE => ();
037af74e 469 write "\n";
8a2bb410 470 !pre {user = user, nodes = nodes, id = vhostId, hostname = fullHost};
471 app (fn dom => !aliaser (host ^ "." ^ dom)) (Domain.currentAliasDomains ())
d68ab27c 472 end,
e1cb845e 473 fn () => (!post ();
474 write "</VirtualHost>\n";
037af74e 475 app (TextIO.closeOut o #2) (!vhostFiles)))
d68ab27c 476
19bdfddd 477val inLocal = ref false
478
ff2a424a 479val () = Env.container_one "location"
480 ("prefix", Env.string)
481 (fn prefix =>
482 (write "\t<Location ";
483 write prefix;
19bdfddd 484 write ">\n";
485 inLocal := true),
486 fn () => (write "\t</Location>\n";
487 inLocal := false;
488 localRewriteEnabled := false))
ff2a424a 489
490val () = Env.container_one "directory"
491 ("directory", Env.string)
492 (fn directory =>
493 (write "\t<Directory ";
494 write directory;
19bdfddd 495 write ">\n";
496 inLocal := true),
497 fn () => (write "\t</Directory>\n";
498 inLocal := false;
499 localRewriteEnabled := false))
ff2a424a 500
697d1a52 501fun checkRewrite () =
19bdfddd 502 if !inLocal then
503 if !rewriteEnabled orelse !localRewriteEnabled then
504 ()
505 else
506 (write "\tRewriteEngine on\n";
507 localRewriteEnabled := true)
508 else if !rewriteEnabled then
697d1a52 509 ()
510 else
511 (write "\tRewriteEngine on\n";
512 rewriteEnabled := true)
513
514val () = Env.action_three "localProxyRewrite"
515 ("from", Env.string, "to", Env.string, "port", Env.int)
516 (fn (from, to, port) =>
517 (checkRewrite ();
518 write "\tRewriteRule\t";
519 write from;
520 write "\thttp://localhost:";
521 write (Int.toString port);
522 write "/";
523 write to;
524 write " [P]\n"))
525
169731e9 526val () = Env.action_two "proxyPass"
527 ("from", Env.string, "to", Env.string)
528 (fn (from, to) =>
529 (write "\tProxyPass\t";
530 write from;
531 write "\t";
532 write to;
533 write "\n"))
534
535val () = Env.action_two "proxyPassReverse"
536 ("from", Env.string, "to", Env.string)
537 (fn (from, to) =>
538 (write "\tProxyPassReverse\t";
539 write from;
540 write "\t";
541 write to;
542 write "\n"))
697d1a52 543
544val () = Env.action_three "rewriteRule"
545 ("from", Env.string, "to", Env.string, "flags", Env.list flag)
546 (fn (from, to, flags) =>
547 (checkRewrite ();
548 write "\tRewriteRule\t";
549 write from;
550 write "\t";
551 write to;
552 case flags of
553 [] => ()
554 | flag::rest => (write " [";
555 write flag;
556 app (fn flag => (write ",";
557 write flag)) rest;
558 write "]");
559 write "\n"))
560
169731e9 561val () = Env.action_three "rewriteCond"
562 ("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
563 (fn (from, to, flags) =>
564 (checkRewrite ();
565 write "\tRewriteCond\t";
566 write from;
567 write "\t";
568 write to;
569 case flags of
570 [] => ()
571 | flag::rest => (write " [";
572 write flag;
573 app (fn flag => (write ",";
574 write flag)) rest;
575 write "]");
576 write "\n"))
577
e28c342c 578val () = Env.action_one "rewriteBase"
579 ("prefix", Env.string)
580 (fn prefix =>
581 (checkRewrite ();
582 write "\tRewriteBase\t";
583 write prefix;
584 write "\n"))
585
3d3acca9 586val () = Env.action_one "rewriteLogLevel"
587 ("level", Env.int)
588 (fn level =>
589 (checkRewrite ();
590 write "\tRewriteLog ";
037af74e 591 write' (fn x => x);
3d3acca9 592 write "/rewrite.log\n\tRewriteLogLevel ";
593 write (Int.toString level);
594 write "\n"))
595
0279185b 596val () = Env.action_two "alias"
597 ("from", Env.string, "to", Env.string)
598 (fn (from, to) =>
599 (write "\tAlias\t";
600 write from;
601 write " ";
602 write to;
603 write "\n"))
604
605val () = Env.action_two "scriptAlias"
606 ("from", Env.string, "to", Env.string)
607 (fn (from, to) =>
608 (write "\tScriptAlias\t";
609 write from;
610 write " ";
611 write to;
612 write "\n"))
613
614val () = Env.action_two "errorDocument"
615 ("code", Env.string, "handler", Env.string)
616 (fn (code, handler) =>
617 (write "\tErrorDocument\t";
618 write code;
619 write " ";
620 write handler;
621 write "\n"))
622
ff8db773 623val () = Env.action_one "options"
624 ("options", Env.list apache_option)
625 (fn opts =>
626 case opts of
627 [] => ()
628 | _ => (write "\tOptions";
629 app (fn opt => (write " "; write opt)) opts;
630 write "\n"))
631
632val () = Env.action_one "set_options"
633 ("options", Env.list apache_option)
634 (fn opts =>
635 case opts of
636 [] => ()
637 | _ => (write "\tOptions";
638 app (fn opt => (write " +"; write opt)) opts;
639 write "\n"))
640
641val () = Env.action_one "unset_options"
642 ("options", Env.list apache_option)
643 (fn opts =>
644 case opts of
645 [] => ()
646 | _ => (write "\tOptions";
647 app (fn opt => (write " -"; write opt)) opts;
648 write "\n"))
0279185b 649
69d98465 650val () = Env.action_one "directoryIndex"
651 ("filenames", Env.list Env.string)
652 (fn opts =>
653 (write "\tDirectoryIndex";
654 app (fn opt => (write " "; write opt)) opts;
655 write "\n"))
656
d3c9f0c6 657val () = Env.action_one "serverAliasHost"
69d98465 658 ("host", Env.string)
659 (fn host =>
660 (write "\tServerAlias ";
661 write host;
e1cb845e 662 write "\n";
663 !aliaser host))
69d98465 664
d3c9f0c6 665val () = Env.action_one "serverAlias"
666 ("host", Env.string)
667 (fn host =>
668 (app
669 (fn dom =>
670 let
671 val full = host ^ "." ^ dom
672 in
673 write "\tServerAlias ";
674 write full;
675 write "\n";
676 !aliaser full
677 end)
678 (Domain.currentDomains ())))
679
680val () = Env.action_none "serverAliasDefault"
681 (fn () =>
682 (app
683 (fn dom =>
684 (write "\tServerAlias ";
685 write dom;
686 write "\n";
687 !aliaser dom))
688 (Domain.currentDomains ())))
689
00e4345d 690val authType = fn (EVar "basic", _) => SOME "basic"
691 | (EVar "digest", _) => SOME "digest"
7fb3d705 692 | (EVar "kerberos", _) => SOME "kerberos"
00e4345d 693 | _ => NONE
694
3eb5fd92 695fun allowAuthType "kerberos" = !sslEnabled
696 | allowAuthType _ = true
697
00e4345d 698val () = Env.action_one "authType"
699 ("type", authType)
700 (fn ty =>
3eb5fd92 701 if allowAuthType ty then
702 (write "\tAuthType ";
703 write ty;
704 write "\n";
705 case ty of
706 "kerberos" =>
707 write "\tKrbMethodNegotiate off\n\tKrbMethodK5Passwd on\n\tKrbVerifyKDC off\n\tKrbAuthRealms HCOOP.NET\n\tKrbSaveCredentials on\n"
708 | _ => ())
709 else
710 print "WARNING: Skipped Kerberos authType because this isn't an SSL vhost.\n")
00e4345d 711
712val () = Env.action_one "authName"
713 ("name", Env.string)
714 (fn name =>
715 (write "\tAuthName \"";
716 write name;
717 write "\"\n"))
718
719val () = Env.action_one "authUserFile"
720 ("file", Env.string)
721 (fn name =>
722 (write "\tAuthUserFile ";
723 write name;
724 write "\n"))
725
726val () = Env.action_none "requireValidUser"
727 (fn () => write "\tRequire valid-user\n")
728
729val () = Env.action_one "requireUser"
730 ("users", Env.list Env.string)
731 (fn names =>
732 case names of
733 [] => ()
734 | _ => (write "\tRequire user";
735 app (fn name => (write " "; write name)) names;
736 write "\n"))
737
738val () = Env.action_one "requireGroup"
739 ("groups", Env.list Env.string)
740 (fn names =>
741 case names of
742 [] => ()
743 | _ => (write "\tRequire group";
744 app (fn name => (write " "; write name)) names;
745 write "\n"))
746
747val () = Env.action_none "orderAllowDeny"
748 (fn () => write "\tOrder allow,deny\n")
749
750val () = Env.action_none "orderDenyAllow"
751 (fn () => write "\tOrder deny,allow\n")
752
753val () = Env.action_none "allowFromAll"
754 (fn () => write "\tAllow from all\n")
755
756val () = Env.action_one "allowFrom"
757 ("entries", Env.list Env.string)
758 (fn names =>
759 case names of
760 [] => ()
761 | _ => (write "\tAllow from";
762 app (fn name => (write " "; write name)) names;
763 write "\n"))
764
765val () = Env.action_none "denyFromAll"
766 (fn () => write "\tDeny from all\n")
767
768val () = Env.action_one "denyFrom"
769 ("entries", Env.list Env.string)
770 (fn names =>
771 case names of
772 [] => ()
773 | _ => (write "\tDeny from";
774 app (fn name => (write " "; write name)) names;
775 write "\n"))
776
777val () = Env.action_none "satisfyAll"
778 (fn () => write "\tSatisfy all\n")
779
780val () = Env.action_none "satisfyAny"
781 (fn () => write "\tSatisfy any\n")
782
4cc63b03 783val () = Env.action_one "forceType"
784 ("type", Env.string)
785 (fn ty => (write "\tForceType ";
786 write ty;
787 write "\n"))
788
789val () = Env.action_none "forceTypeOff"
790 (fn () => write "\tForceType None\n")
791
792val () = Env.action_two "action"
793 ("what", Env.string, "how", Env.string)
794 (fn (what, how) => (write "\tAction ";
795 write what;
796 write " ";
797 write how;
798 write "\n"))
799
800val () = Env.action_one "addDefaultCharset"
801 ("charset", Env.string)
802 (fn ty => (write "\tAddDefaultCharset ";
803 write ty;
804 write "\n"))
805
26716b02 806(*val () = Env.action_one "davSvn"
efffba2a 807 ("path", Env.string)
808 (fn path => (write "\tDAV svn\n\tSVNPath ";
809 write path;
810 write "\n"))
811
812val () = Env.action_one "authzSvnAccessFile"
813 ("path", Env.string)
814 (fn path => (write "\tAuthzSVNAccessFile ";
815 write path;
26716b02 816 write "\n"))*)
efffba2a 817
2aa13b91 818val () = Env.action_none "davFilesystem"
819 (fn path => write "\tDAV filesystem\n")
820
db9c7cb7 821val () = Env.action_two "addDescription"
822 ("description", Env.string, "patterns", Env.list Env.string)
823 (fn (desc, pats) =>
824 case pats of
825 [] => ()
826 | _ => (write "\tAddDescription \"";
827 write (String.toString desc);
828 write "\"";
829 app (fn pat => (write " "; write pat)) pats;
830 write "\n"))
831
832val () = Env.action_one "indexOptions"
833 ("options", Env.list autoindex_option)
834 (fn opts =>
835 case opts of
836 [] => ()
837 | _ => (write "\tIndexOptions";
838 app (fn (opt, arg) =>
839 (write " ";
840 write opt;
841 Option.app (fn arg =>
842 (write "="; write arg)) arg)) opts;
843 write "\n"))
844
845val () = Env.action_one "set_indexOptions"
846 ("options", Env.list autoindex_option)
847 (fn opts =>
848 case opts of
849 [] => ()
850 | _ => (write "\tIndexOptions";
851 app (fn (opt, arg) =>
852 (write " +";
853 write opt;
854 Option.app (fn arg =>
855 (write "="; write arg)) arg)) opts;
856 write "\n"))
857
858val () = Env.action_one "unset_indexOptions"
859 ("options", Env.list autoindex_option)
860 (fn opts =>
861 case opts of
862 [] => ()
863 | _ => (write "\tIndexOptions";
864 app (fn (opt, _) =>
865 (write " -";
866 write opt)) opts;
867 write "\n"))
868
869val () = Env.action_one "headerName"
870 ("name", Env.string)
871 (fn name => (write "\tHeaderName ";
872 write name;
873 write "\n"))
874
875val () = Env.action_one "readmeName"
876 ("name", Env.string)
877 (fn name => (write "\tReadmeName ";
878 write name;
879 write "\n"))
880
d71ae374 881val () = Env.action_two "setEnv"
882 ("key", Env.string, "value", Env.string)
883 (fn (key, value) => (write "\tSetEnv \"";
884 write key;
885 write "\" \"";
3a319372 886 write (String.translate (fn #"\"" => "\\\""
887 | ch => str ch) value);
d71ae374 888 write "\"\n"))
889
0ea0ecfa 890val () = Domain.registerResetLocal (fn () =>
891 ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
892
1f5e7aad 893val () = Domain.registerDescriber (Domain.considerAll
894 [Domain.Extension {extension = "vhost",
71e08489 895 heading = fn host => "Web vhost " ^ host},
1f5e7aad 896 Domain.Extension {extension = "vhost_ssl",
71e08489 897 heading = fn host => "SSL web vhost " ^ host}])
1f5e7aad 898
d68ab27c 899end
DomTool: HCoop's distributed system configuration tool.