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