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