HCoop / hcoop / domtool2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Mailman shortcut working
[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
e9f528ab
AC		 386fun doPre x = !pre x
387fun doPost () = !post ()
388
7f75d838
AC		 389val aliaser = ref (fn _ : string => ())
390fun registerAliaser f =
391 let
392 val old = !aliaser
393 in
394 aliaser := (fn x => (old x; f x))
395 end
396
8a7c40fa
AC		 397val () = Env.containerV_one "vhost"
398 ("host", Env.string)
399 (fn (env, host) =>
400 let
401 val nodes = Env.env (Env.list Env.string) (env, "WebNodes")
402
434a7b1f 403 val ssl = Env.env ssl (env, "SSL")
8a7c40fa
AC		 404 val user = Env.env Env.string (env, "User")
405 val group = Env.env Env.string (env, "Group")
406 val docroot = Env.env Env.string (env, "DocumentRoot")
407 val sadmin = Env.env Env.string (env, "ServerAdmin")
434a7b1f 408 val suexec = Env.env Env.bool (env, "SuExec")
8a7c40fa
AC		 409
410 val fullHost = host ^ "." ^ Domain.currentDomain ()
434a7b1f
AC		 411 val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
412 val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
8a7c40fa 413 in
c98b57cf
AC		 414 currentVhost := fullHost;
415 currentVhostId := vhostId;
8a5b34c9 416 sslEnabled := Option.isSome ssl;
c98b57cf 417
f8dfbbcc 418 rewriteEnabled := false;
ce01b51a 419 localRewriteEnabled := false;
8a7c40fa
AC		 420 vhostFiles := map (fn node =>
421 let
422 val file = Domain.domainFile {node = node,
423 name = confFile}
2a7d2818
AC		 424
425 val ld = logDir {user = user, node = node, vhostId = vhostId}
8a7c40fa 426 in
00a13ad8
AC		 427 TextIO.output (file, "# Owner: ");
428 TextIO.output (file, user);
429 TextIO.output (file, "\n<VirtualHost ");
8a7c40fa
AC		 430 TextIO.output (file, Domain.nodeIp node);
431 TextIO.output (file, ":");
434a7b1f
AC		 432 TextIO.output (file, case ssl of
433 SOME _ => "443"
434 | NONE => "80");
8a7c40fa 435 TextIO.output (file, ">\n");
7a2b27f0 436 TextIO.output (file, "\tErrorLog ");
2a7d2818 437 TextIO.output (file, ld);
7a2b27f0 438 TextIO.output (file, "/error.log\n\tCustomLog ");
2a7d2818 439 TextIO.output (file, ld);
7a2b27f0 440 TextIO.output (file, "/access.log combined\n");
55d4a268
AC		 441 TextIO.output (file, "\tServerName ");
442 TextIO.output (file, fullHost);
e519d696
AC		 443 app
444 (fn dom => (TextIO.output (file, "\n\tServerAlias ");
445 TextIO.output (file, host);
446 TextIO.output (file, ".");
447 TextIO.output (file, dom)))
448 (Domain.currentAliasDomains ());
3f84c976 449
55d4a268
AC		 450 if suexec then
451 if isVersion1 node then
452 (TextIO.output (file, "\n\tUser ");
453 TextIO.output (file, user);
454 TextIO.output (file, "\n\tGroup ");
455 TextIO.output (file, group))
456 else
457 (TextIO.output (file, "\n\tSuexecUserGroup ");
458 TextIO.output (file, user);
459 TextIO.output (file, " ");
460 TextIO.output (file, group))
461 else
462 ();
3f84c976 463
f8ef6c20 464 if isWaklog node then
a09d0e82 465 (TextIO.output (file, "\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
f8ef6c20 466 TextIO.output (file, user);
fdf9a42d 467 TextIO.output (file, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
f8ef6c20
AC		 468 TextIO.output (file, user))
469 else
470 ();
3f84c976 471
e34e1f36 472 TextIO.output (file, "\n\tDAVLockDB /var/lock/apache2/dav/");
3f84c976
AC		 473 TextIO.output (file, user);
474 TextIO.output (file, "/DAVLock");
475
2a7d2818 476 (ld, file)
8a7c40fa
AC		 477 end)
478 nodes;
8a7c40fa
AC		 479 write "\n\tDocumentRoot ";
480 write docroot;
481 write "\n\tServerAdmin ";
482 write sadmin;
434a7b1f
AC		 483 case ssl of
484 SOME cert =>
485 (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
486 write cert)
487 | NONE => ();
7a2b27f0 488 write "\n";
5cab5a98
AC		 489 !pre {user = user, nodes = nodes, id = vhostId, hostname = fullHost};
490 app (fn dom => !aliaser (host ^ "." ^ dom)) (Domain.currentAliasDomains ())
8a7c40fa 491 end,
7f75d838
AC		 492 fn () => (!post ();
493 write "</VirtualHost>\n";
7a2b27f0 494 app (TextIO.closeOut o #2) (!vhostFiles)))
8a7c40fa 495
ce01b51a
AC		 496val inLocal = ref false
497
2882ee37
AC		 498val () = Env.container_one "location"
499 ("prefix", Env.string)
500 (fn prefix =>
501 (write "\t<Location ";
502 write prefix;
ce01b51a
AC		 503 write ">\n";
504 inLocal := true),
505 fn () => (write "\t</Location>\n";
506 inLocal := false;
507 localRewriteEnabled := false))
2882ee37
AC		 508
509val () = Env.container_one "directory"
510 ("directory", Env.string)
511 (fn directory =>
512 (write "\t<Directory ";
513 write directory;
ce01b51a
AC		 514 write ">\n";
515 inLocal := true),
516 fn () => (write "\t</Directory>\n";
517 inLocal := false;
518 localRewriteEnabled := false))
2882ee37 519
f8dfbbcc 520fun checkRewrite () =
ce01b51a
AC		 521 if !inLocal then
522 if !rewriteEnabled orelse !localRewriteEnabled then
523 ()
524 else
525 (write "\tRewriteEngine on\n";
526 localRewriteEnabled := true)
527 else if !rewriteEnabled then
f8dfbbcc
AC		 528 ()
529 else
530 (write "\tRewriteEngine on\n";
531 rewriteEnabled := true)
532
533val () = Env.action_three "localProxyRewrite"
534 ("from", Env.string, "to", Env.string, "port", Env.int)
535 (fn (from, to, port) =>
536 (checkRewrite ();
537 write "\tRewriteRule\t";
538 write from;
539 write "\thttp://localhost:";
540 write (Int.toString port);
541 write "/";
542 write to;
543 write " [P]\n"))
544
e95a129e
AC		 545val () = Env.action_two "proxyPass"
546 ("from", Env.string, "to", Env.string)
547 (fn (from, to) =>
548 (write "\tProxyPass\t";
549 write from;
550 write "\t";
551 write to;
552 write "\n"))
553
554val () = Env.action_two "proxyPassReverse"
555 ("from", Env.string, "to", Env.string)
556 (fn (from, to) =>
557 (write "\tProxyPassReverse\t";
558 write from;
559 write "\t";
560 write to;
561 write "\n"))
f8dfbbcc
AC		 562
563val () = Env.action_three "rewriteRule"
564 ("from", Env.string, "to", Env.string, "flags", Env.list flag)
565 (fn (from, to, flags) =>
566 (checkRewrite ();
567 write "\tRewriteRule\t";
568 write from;
569 write "\t";
570 write to;
571 case flags of
572 [] => ()
573 | flag::rest => (write " [";
574 write flag;
575 app (fn flag => (write ",";
576 write flag)) rest;
577 write "]");
578 write "\n"))
579
e95a129e
AC		 580val () = Env.action_three "rewriteCond"
581 ("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
582 (fn (from, to, flags) =>
583 (checkRewrite ();
584 write "\tRewriteCond\t";
585 write from;
586 write "\t";
587 write to;
588 case flags of
589 [] => ()
590 | flag::rest => (write " [";
591 write flag;
592 app (fn flag => (write ",";
593 write flag)) rest;
594 write "]");
595 write "\n"))
596
94b7b11a
AC		 597val () = Env.action_one "rewriteBase"
598 ("prefix", Env.string)
599 (fn prefix =>
600 (checkRewrite ();
601 write "\tRewriteBase\t";
602 write prefix;
603 write "\n"))
604
c98b57cf
AC		 605val () = Env.action_one "rewriteLogLevel"
606 ("level", Env.int)
607 (fn level =>
608 (checkRewrite ();
609 write "\tRewriteLog ";
7a2b27f0 610 write' (fn x => x);
c98b57cf
AC		 611 write "/rewrite.log\n\tRewriteLogLevel ";
612 write (Int.toString level);
613 write "\n"))
614
d5754b53
AC		 615val () = Env.action_two "alias"
616 ("from", Env.string, "to", Env.string)
617 (fn (from, to) =>
618 (write "\tAlias\t";
619 write from;
620 write " ";
621 write to;
622 write "\n"))
623
624val () = Env.action_two "scriptAlias"
625 ("from", Env.string, "to", Env.string)
626 (fn (from, to) =>
627 (write "\tScriptAlias\t";
628 write from;
629 write " ";
630 write to;
631 write "\n"))
632
633val () = Env.action_two "errorDocument"
634 ("code", Env.string, "handler", Env.string)
635 (fn (code, handler) =>
636 (write "\tErrorDocument\t";
637 write code;
638 write " ";
639 write handler;
640 write "\n"))
641
d441e69f
AC		 642val () = Env.action_one "options"
643 ("options", Env.list apache_option)
644 (fn opts =>
645 case opts of
646 [] => ()
647 | _ => (write "\tOptions";
648 app (fn opt => (write " "; write opt)) opts;
649 write "\n"))
650
651val () = Env.action_one "set_options"
652 ("options", Env.list apache_option)
653 (fn opts =>
654 case opts of
655 [] => ()
656 | _ => (write "\tOptions";
657 app (fn opt => (write " +"; write opt)) opts;
658 write "\n"))
659
660val () = Env.action_one "unset_options"
661 ("options", Env.list apache_option)
662 (fn opts =>
663 case opts of
664 [] => ()
665 | _ => (write "\tOptions";
666 app (fn opt => (write " -"; write opt)) opts;
667 write "\n"))
d5754b53 668
edd38024
AC		 669val () = Env.action_one "directoryIndex"
670 ("filenames", Env.list Env.string)
671 (fn opts =>
672 (write "\tDirectoryIndex";
673 app (fn opt => (write " "; write opt)) opts;
674 write "\n"))
675
e519d696 676val () = Env.action_one "serverAliasHost"
edd38024
AC		 677 ("host", Env.string)
678 (fn host =>
679 (write "\tServerAlias ";
680 write host;
7f75d838
AC		 681 write "\n";
682 !aliaser host))
edd38024 683
e519d696
AC		 684val () = Env.action_one "serverAlias"
685 ("host", Env.string)
686 (fn host =>
687 (app
688 (fn dom =>
689 let
690 val full = host ^ "." ^ dom
691 in
692 write "\tServerAlias ";
693 write full;
694 write "\n";
695 !aliaser full
696 end)
697 (Domain.currentDomains ())))
698
699val () = Env.action_none "serverAliasDefault"
700 (fn () =>
701 (app
702 (fn dom =>
703 (write "\tServerAlias ";
704 write dom;
705 write "\n";
706 !aliaser dom))
707 (Domain.currentDomains ())))
708
2aeb9eec
AC		 709val authType = fn (EVar "basic", _) => SOME "basic"
710 | (EVar "digest", _) => SOME "digest"
35dc7746 711 | (EVar "kerberos", _) => SOME "kerberos"
2aeb9eec
AC		 712 | _ => NONE
713
8a5b34c9
AC		 714fun allowAuthType "kerberos" = !sslEnabled
715 | allowAuthType _ = true
716
2aeb9eec
AC		 717val () = Env.action_one "authType"
718 ("type", authType)
719 (fn ty =>
8a5b34c9
AC		 720 if allowAuthType ty then
721 (write "\tAuthType ";
722 write ty;
723 write "\n";
724 case ty of
725 "kerberos" =>
726 write "\tKrbMethodNegotiate off\n\tKrbMethodK5Passwd on\n\tKrbVerifyKDC off\n\tKrbAuthRealms HCOOP.NET\n\tKrbSaveCredentials on\n"
727 | _ => ())
728 else
729 print "WARNING: Skipped Kerberos authType because this isn't an SSL vhost.\n")
2aeb9eec
AC		 730
731val () = Env.action_one "authName"
732 ("name", Env.string)
733 (fn name =>
734 (write "\tAuthName \"";
735 write name;
736 write "\"\n"))
737
738val () = Env.action_one "authUserFile"
739 ("file", Env.string)
740 (fn name =>
741 (write "\tAuthUserFile ";
742 write name;
743 write "\n"))
744
745val () = Env.action_none "requireValidUser"
746 (fn () => write "\tRequire valid-user\n")
747
748val () = Env.action_one "requireUser"
749 ("users", Env.list Env.string)
750 (fn names =>
751 case names of
752 [] => ()
753 | _ => (write "\tRequire user";
754 app (fn name => (write " "; write name)) names;
755 write "\n"))
756
757val () = Env.action_one "requireGroup"
758 ("groups", Env.list Env.string)
759 (fn names =>
760 case names of
761 [] => ()
762 | _ => (write "\tRequire group";
763 app (fn name => (write " "; write name)) names;
764 write "\n"))
765
766val () = Env.action_none "orderAllowDeny"
767 (fn () => write "\tOrder allow,deny\n")
768
769val () = Env.action_none "orderDenyAllow"
770 (fn () => write "\tOrder deny,allow\n")
771
772val () = Env.action_none "allowFromAll"
773 (fn () => write "\tAllow from all\n")
774
775val () = Env.action_one "allowFrom"
776 ("entries", Env.list Env.string)
777 (fn names =>
778 case names of
779 [] => ()
780 | _ => (write "\tAllow from";
781 app (fn name => (write " "; write name)) names;
782 write "\n"))
783
784val () = Env.action_none "denyFromAll"
785 (fn () => write "\tDeny from all\n")
786
787val () = Env.action_one "denyFrom"
788 ("entries", Env.list Env.string)
789 (fn names =>
790 case names of
791 [] => ()
792 | _ => (write "\tDeny from";
793 app (fn name => (write " "; write name)) names;
794 write "\n"))
795
796val () = Env.action_none "satisfyAll"
797 (fn () => write "\tSatisfy all\n")
798
799val () = Env.action_none "satisfyAny"
800 (fn () => write "\tSatisfy any\n")
801
7f012ffd
AC		 802val () = Env.action_one "forceType"
803 ("type", Env.string)
804 (fn ty => (write "\tForceType ";
805 write ty;
806 write "\n"))
807
808val () = Env.action_none "forceTypeOff"
809 (fn () => write "\tForceType None\n")
810
811val () = Env.action_two "action"
812 ("what", Env.string, "how", Env.string)
813 (fn (what, how) => (write "\tAction ";
814 write what;
815 write " ";
816 write how;
817 write "\n"))
818
819val () = Env.action_one "addDefaultCharset"
820 ("charset", Env.string)
821 (fn ty => (write "\tAddDefaultCharset ";
822 write ty;
823 write "\n"))
824
64e85bae 825(*val () = Env.action_one "davSvn"
c8505e59
AC		 826 ("path", Env.string)
827 (fn path => (write "\tDAV svn\n\tSVNPath ";
828 write path;
829 write "\n"))
830
831val () = Env.action_one "authzSvnAccessFile"
832 ("path", Env.string)
833 (fn path => (write "\tAuthzSVNAccessFile ";
834 write path;
64e85bae 835 write "\n"))*)
c8505e59 836
0aed4302
AC		 837val () = Env.action_none "davFilesystem"
838 (fn path => write "\tDAV filesystem\n")
839
9d7fa346
AC		 840val () = Env.action_two "addDescription"
841 ("description", Env.string, "patterns", Env.list Env.string)
842 (fn (desc, pats) =>
843 case pats of
844 [] => ()
845 | _ => (write "\tAddDescription \"";
846 write (String.toString desc);
847 write "\"";
848 app (fn pat => (write " "; write pat)) pats;
849 write "\n"))
850
851val () = Env.action_one "indexOptions"
852 ("options", Env.list autoindex_option)
853 (fn opts =>
854 case opts of
855 [] => ()
856 | _ => (write "\tIndexOptions";
857 app (fn (opt, arg) =>
858 (write " ";
859 write opt;
860 Option.app (fn arg =>
861 (write "="; write arg)) arg)) opts;
862 write "\n"))
863
864val () = Env.action_one "set_indexOptions"
865 ("options", Env.list autoindex_option)
866 (fn opts =>
867 case opts of
868 [] => ()
869 | _ => (write "\tIndexOptions";
870 app (fn (opt, arg) =>
871 (write " +";
872 write opt;
873 Option.app (fn arg =>
874 (write "="; write arg)) arg)) opts;
875 write "\n"))
876
877val () = Env.action_one "unset_indexOptions"
878 ("options", Env.list autoindex_option)
879 (fn opts =>
880 case opts of
881 [] => ()
882 | _ => (write "\tIndexOptions";
883 app (fn (opt, _) =>
884 (write " -";
885 write opt)) opts;
886 write "\n"))
887
888val () = Env.action_one "headerName"
889 ("name", Env.string)
890 (fn name => (write "\tHeaderName ";
891 write name;
892 write "\n"))
893
894val () = Env.action_one "readmeName"
895 ("name", Env.string)
896 (fn name => (write "\tReadmeName ";
897 write name;
898 write "\n"))
899
eda33894
AC		 900val () = Env.action_two "setEnv"
901 ("key", Env.string, "value", Env.string)
902 (fn (key, value) => (write "\tSetEnv \"";
903 write key;
904 write "\" \"";
ca6ffb3f
AC		 905 write (String.translate (fn #"\"" => "\\\""
906 | ch => str ch) value);
eda33894
AC		 907 write "\"\n"))
908
71420f8b
AC		 909val () = Domain.registerResetLocal (fn () =>
910 ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
911
41c58daf
AC		 912val () = Domain.registerDescriber (Domain.considerAll
913 [Domain.Extension {extension = "vhost",
d300166d 914 heading = fn host => "Web vhost " ^ host},
41c58daf 915 Domain.Extension {extension = "vhost_ssl",
d300166d 916 heading = fn host => "SSL web vhost " ^ host}])
41c58daf 917
8a7c40fa 918end
Unnamed repository; edit this file to name it for gitweb.