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