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