HCoop / hcoop / domtool2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Fix type of default WWW env var
[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
8cbb9632
AC		 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
f8dfbbcc
AC		 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
e95a129e
AC		 152val cond_flag = fn (EVar "cond_nocase", _) => SOME "NC"
153 | (EVar "ornext", _) => SOME "OR"
154 | _ => NONE
155
d441e69f
AC		 156val apache_option = fn (EVar "execCGI", _) => SOME "ExecCGI"
157 | (EVar "includesNOEXEC", _) => SOME "IncludesNOEXEC"
158 | (EVar "indexes", _) => SOME "Indexes"
159 | _ => NONE
160
9d7fa346
AC		 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
f8dfbbcc 197
8a7c40fa 198val vhostsChanged = ref false
8e965b2d 199val logDeleted = ref false
8a7c40fa
AC		 200
201val () = Slave.registerPreHandler
8e965b2d
AC		 202 (fn () => (vhostsChanged := false;
203 logDeleted := false))
8a7c40fa 204
7db53a0b
AC		 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 =>
00a13ad8
AC		 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 ()
7db53a0b
AC		 219 in
220 loop ()
221 before TextIO.closeIn inf
3a941c29 222 end handle _ => NONE
7db53a0b 223
55d4a268
AC		 224val webNodes_full = Config.Apache.webNodes_all @ Config.Apache.webNodes_admin
225
226fun isVersion1 node =
f8ef6c20
AC		 227 List.exists (fn (n, {version = ConfigTypes.APACHE_1_3, ...}) => n = node
228 | _ => false) webNodes_full
55d4a268
AC		 229
230fun imVersion1 () = isVersion1 (Slave.hostname ())
231
f8ef6c20
AC		 232fun isWaklog node =
233 List.exists (fn (n, {auth = ConfigTypes.MOD_WAKLOG, ...}) => n = node
234 | _ => false) webNodes_full
235
55d4a268
AC		 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
b59d9074 240fun logDir {user, node, vhostId} =
2a7d2818 241 String.concat [Config.Apache.logDirOf (isVersion1 node) user,
409542d7 242 "/",
b59d9074
AC		 243 node,
244 "/",
245 vhostId]
246
8a7c40fa 247val () = Slave.registerFileHandler (fn fs =>
7a2b27f0
AC		 248 let
249 val spl = OS.Path.splitDirFile (#file fs)
250 in
251 if String.isSuffix ".vhost" (#file spl)
3a941c29
AC		 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
5b07cebd 265 val vhostId = if OS.Path.ext (#file spl) = SOME "vhost_ssl" then
b59d9074
AC		 266 OS.Path.base (#file spl) ^ ".ssl"
267 else
268 OS.Path.base (#file spl)
269
3a941c29 270 fun realLogDir user =
b59d9074
AC		 271 logDir {user = valOf user,
272 node = Slave.hostname (),
273 vhostId = vhostId}
3a941c29
AC		 274 in
275 vhostsChanged := true;
276 case #action fs of
277 Slave.Delete =>
278 (if !logDeleted then
279 ()
280 else
55d4a268 281 (ignore (OS.Process.system (down ()));
3a941c29
AC		 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
409542d7 301 Slave.mkDirAll rld
3a941c29
AC		 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
55d4a268 318 (ignore (OS.Process.system (down ()));
3a941c29
AC		 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
409542d7 326 Slave.mkDirAll rld
3a941c29
AC		 327 end
328 else
329 ())
330 end
331 end
7a2b27f0
AC		 332 else
333 ()
334 end)
8a7c40fa
AC		 335
336val () = Slave.registerPostHandler
337 (fn () =>
338 (if !vhostsChanged then
55d4a268 339 Slave.shellF ([if !logDeleted then undown () else reload ()],
8a7c40fa
AC		 340 fn cl => "Error reloading Apache with " ^ cl)
341 else
342 ()))
343
7a2b27f0
AC		 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)
8a7c40fa 347
f8dfbbcc 348val rewriteEnabled = ref false
ce01b51a 349val localRewriteEnabled = ref false
c98b57cf
AC		 350val currentVhost = ref ""
351val currentVhostId = ref ""
8a5b34c9 352val sslEnabled = ref false
f8dfbbcc 353
7a2b27f0 354val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ())
7f75d838
AC		 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
8a7c40fa
AC		 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
434a7b1f 384 val ssl = Env.env ssl (env, "SSL")
8a7c40fa
AC		 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")
434a7b1f 389 val suexec = Env.env Env.bool (env, "SuExec")
8a7c40fa
AC		 390
391 val fullHost = host ^ "." ^ Domain.currentDomain ()
434a7b1f
AC		 392 val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
393 val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
8a7c40fa 394 in
c98b57cf
AC		 395 currentVhost := fullHost;
396 currentVhostId := vhostId;
8a5b34c9 397 sslEnabled := Option.isSome ssl;
c98b57cf 398
f8dfbbcc 399 rewriteEnabled := false;
ce01b51a 400 localRewriteEnabled := false;
8a7c40fa
AC		 401 vhostFiles := map (fn node =>
402 let
403 val file = Domain.domainFile {node = node,
404 name = confFile}
2a7d2818
AC		 405
406 val ld = logDir {user = user, node = node, vhostId = vhostId}
8a7c40fa 407 in
00a13ad8
AC		 408 TextIO.output (file, "# Owner: ");
409 TextIO.output (file, user);
410 TextIO.output (file, "\n<VirtualHost ");
8a7c40fa
AC		 411 TextIO.output (file, Domain.nodeIp node);
412 TextIO.output (file, ":");
434a7b1f
AC		 413 TextIO.output (file, case ssl of
414 SOME _ => "443"
415 | NONE => "80");
8a7c40fa 416 TextIO.output (file, ">\n");
7a2b27f0 417 TextIO.output (file, "\tErrorLog ");
2a7d2818 418 TextIO.output (file, ld);
7a2b27f0 419 TextIO.output (file, "/error.log\n\tCustomLog ");
2a7d2818 420 TextIO.output (file, ld);
7a2b27f0 421 TextIO.output (file, "/access.log combined\n");
55d4a268
AC		 422 TextIO.output (file, "\tServerName ");
423 TextIO.output (file, fullHost);
e519d696
AC		 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 ());
3f84c976 430
55d4a268
AC		 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 ();
3f84c976 444
f8ef6c20 445 if isWaklog node then
a09d0e82 446 (TextIO.output (file, "\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
f8ef6c20 447 TextIO.output (file, user);
fdf9a42d 448 TextIO.output (file, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
f8ef6c20
AC		 449 TextIO.output (file, user))
450 else
451 ();
3f84c976 452
e34e1f36 453 TextIO.output (file, "\n\tDAVLockDB /var/lock/apache2/dav/");
3f84c976
AC		 454 TextIO.output (file, user);
455 TextIO.output (file, "/DAVLock");
456
2a7d2818 457 (ld, file)
8a7c40fa
AC		 458 end)
459 nodes;
8a7c40fa
AC		 460 write "\n\tDocumentRoot ";
461 write docroot;
462 write "\n\tServerAdmin ";
463 write sadmin;
434a7b1f
AC		 464 case ssl of
465 SOME cert =>
466 (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
467 write cert)
468 | NONE => ();
7a2b27f0 469 write "\n";
5cab5a98
AC		 470 !pre {user = user, nodes = nodes, id = vhostId, hostname = fullHost};
471 app (fn dom => !aliaser (host ^ "." ^ dom)) (Domain.currentAliasDomains ())
8a7c40fa 472 end,
7f75d838
AC		 473 fn () => (!post ();
474 write "</VirtualHost>\n";
7a2b27f0 475 app (TextIO.closeOut o #2) (!vhostFiles)))
8a7c40fa 476
ce01b51a
AC		 477val inLocal = ref false
478
2882ee37
AC		 479val () = Env.container_one "location"
480 ("prefix", Env.string)
481 (fn prefix =>
482 (write "\t<Location ";
483 write prefix;
ce01b51a
AC		 484 write ">\n";
485 inLocal := true),
486 fn () => (write "\t</Location>\n";
487 inLocal := false;
488 localRewriteEnabled := false))
2882ee37
AC		 489
490val () = Env.container_one "directory"
491 ("directory", Env.string)
492 (fn directory =>
493 (write "\t<Directory ";
494 write directory;
ce01b51a
AC		 495 write ">\n";
496 inLocal := true),
497 fn () => (write "\t</Directory>\n";
498 inLocal := false;
499 localRewriteEnabled := false))
2882ee37 500
f8dfbbcc 501fun checkRewrite () =
ce01b51a
AC		 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
f8dfbbcc
AC		 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
e95a129e
AC		 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"))
f8dfbbcc
AC		 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
e95a129e
AC		 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
94b7b11a
AC		 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
c98b57cf
AC		 586val () = Env.action_one "rewriteLogLevel"
587 ("level", Env.int)
588 (fn level =>
589 (checkRewrite ();
590 write "\tRewriteLog ";
7a2b27f0 591 write' (fn x => x);
c98b57cf
AC		 592 write "/rewrite.log\n\tRewriteLogLevel ";
593 write (Int.toString level);
594 write "\n"))
595
d5754b53
AC		 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
d441e69f
AC		 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"))
d5754b53 649
edd38024
AC		 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
e519d696 657val () = Env.action_one "serverAliasHost"
edd38024
AC		 658 ("host", Env.string)
659 (fn host =>
660 (write "\tServerAlias ";
661 write host;
7f75d838
AC		 662 write "\n";
663 !aliaser host))
edd38024 664
e519d696
AC		 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
2aeb9eec
AC		 690val authType = fn (EVar "basic", _) => SOME "basic"
691 | (EVar "digest", _) => SOME "digest"
35dc7746 692 | (EVar "kerberos", _) => SOME "kerberos"
2aeb9eec
AC		 693 | _ => NONE
694
8a5b34c9
AC		 695fun allowAuthType "kerberos" = !sslEnabled
696 | allowAuthType _ = true
697
2aeb9eec
AC		 698val () = Env.action_one "authType"
699 ("type", authType)
700 (fn ty =>
8a5b34c9
AC		 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")
2aeb9eec
AC		 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
7f012ffd
AC		 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
64e85bae 806(*val () = Env.action_one "davSvn"
c8505e59
AC		 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;
64e85bae 816 write "\n"))*)
c8505e59 817
0aed4302
AC		 818val () = Env.action_none "davFilesystem"
819 (fn path => write "\tDAV filesystem\n")
820
9d7fa346
AC		 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
eda33894
AC		 881val () = Env.action_two "setEnv"
882 ("key", Env.string, "value", Env.string)
883 (fn (key, value) => (write "\tSetEnv \"";
884 write key;
885 write "\" \"";
ca6ffb3f
AC		 886 write (String.translate (fn #"\"" => "\\\""
887 | ch => str ch) value);
eda33894
AC		 888 write "\"\n"))
889
71420f8b
AC		 890val () = Domain.registerResetLocal (fn () =>
891 ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
892
8a7c40fa 893end
Unnamed repository; edit this file to name it for gitweb.