HCoop / hcoop / domtool2.git / blame
? search:
summary | shortlog | log | commit | commitdiff | tree
blob | blame (incremental) | history | HEAD
Remove auto-generated file from repo
[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
c17d0537 239fun fixperms () = if imVersion1 () then Config.Apache.fixperms1 else Config.Apache.fixperms
55d4a268 240
b59d9074 241fun logDir {user, node, vhostId} =
2a7d2818 242 String.concat [Config.Apache.logDirOf (isVersion1 node) user,
409542d7 243 "/",
b59d9074
AC		 244 node,
245 "/",
246 vhostId]
247
8a7c40fa 248val () = Slave.registerFileHandler (fn fs =>
7a2b27f0
AC		 249 let
250 val spl = OS.Path.splitDirFile (#file fs)
251 in
252 if String.isSuffix ".vhost" (#file spl)
3a941c29
AC		 253 orelse String.isSuffix ".vhost_ssl" (#file spl) then let
254 val realVhostFile = OS.Path.joinDirFile
255 {dir = Config.Apache.confDir,
256 file = #file spl}
257
258 val user = findVhostUser (#file fs)
19026493
AC		 259 val oldUser = case #action fs of
260 Slave.Delete false => user
261 | _ => findVhostUser realVhostFile
3a941c29
AC		 262 in
263 if (oldUser = NONE andalso #action fs <> Slave.Add)
1638d5a2 264 orelse (user = NONE andalso not (Slave.isDelete (#action fs))) then
3a941c29
AC		 265 print ("Can't find user in " ^ #file fs ^ " or " ^ realVhostFile ^ "! Taking no action.\n")
266 else
267 let
5b07cebd 268 val vhostId = if OS.Path.ext (#file spl) = SOME "vhost_ssl" then
b59d9074
AC		 269 OS.Path.base (#file spl) ^ ".ssl"
270 else
271 OS.Path.base (#file spl)
272
3a941c29 273 fun realLogDir user =
b59d9074
AC		 274 logDir {user = valOf user,
275 node = Slave.hostname (),
276 vhostId = vhostId}
c17d0537
AC		 277
278 fun backupLogs () =
279 OS.Path.joinDirFile
280 {dir = Config.Apache.backupLogDirOf
281 (isVersion1 (Slave.hostname ())),
282 file = vhostId}
3a941c29
AC		 283 in
284 vhostsChanged := true;
285 case #action fs of
1638d5a2 286 Slave.Delete _ =>
31b50af0
AC		 287 let
288 val ldir = realLogDir oldUser
289 in
290 if !logDeleted then
291 ()
292 else
293 (ignore (OS.Process.system (down ()));
c17d0537 294 ignore (OS.Process.system (fixperms ()));
31b50af0
AC		 295 logDeleted := true);
296 ignore (OS.Process.system (Config.rm
297 ^ " -rf "
298 ^ realVhostFile));
299 Slave.moveDirCreate {from = ldir,
c17d0537 300 to = backupLogs ()}
31b50af0 301 end
3a941c29
AC		 302 | Slave.Add =>
303 let
304 val rld = realLogDir user
305 in
306 ignore (OS.Process.system (Config.cp
307 ^ " "
308 ^ #file fs
309 ^ " "
310 ^ realVhostFile));
311 if Posix.FileSys.access (rld, []) then
312 ()
313 else
c17d0537 314 Slave.moveDirCreate {from = backupLogs (),
31b50af0 315 to = rld}
3a941c29
AC		 316 end
317
318 | _ =>
319 (ignore (OS.Process.system (Config.cp
320 ^ " "
321 ^ #file fs
322 ^ " "
323 ^ realVhostFile));
324 if user <> oldUser then
325 let
326 val old = realLogDir oldUser
327 val rld = realLogDir user
328 in
329 if !logDeleted then
330 ()
331 else
55d4a268 332 (ignore (OS.Process.system (down ()));
3a941c29
AC		 333 logDeleted := true);
334 ignore (OS.Process.system (Config.rm
335 ^ " -rf "
336 ^ realLogDir oldUser));
337 if Posix.FileSys.access (rld, []) then
338 ()
339 else
409542d7 340 Slave.mkDirAll rld
3a941c29
AC		 341 end
342 else
343 ())
344 end
345 end
7a2b27f0
AC		 346 else
347 ()
348 end)
8a7c40fa
AC		 349
350val () = Slave.registerPostHandler
351 (fn () =>
352 (if !vhostsChanged then
55d4a268 353 Slave.shellF ([if !logDeleted then undown () else reload ()],
8a7c40fa
AC		 354 fn cl => "Error reloading Apache with " ^ cl)
355 else
356 ()))
357
7a2b27f0
AC		 358val vhostFiles : (string * TextIO.outstream) list ref = ref []
359fun write' s = app (fn (node, file) => TextIO.output (file, s node)) (!vhostFiles)
360fun write s = app (fn (_, file) => TextIO.output (file, s)) (!vhostFiles)
8a7c40fa 361
f8dfbbcc 362val rewriteEnabled = ref false
ce01b51a 363val localRewriteEnabled = ref false
c98b57cf
AC		 364val currentVhost = ref ""
365val currentVhostId = ref ""
8a5b34c9 366val sslEnabled = ref false
f8dfbbcc 367
7a2b27f0 368val pre = ref (fn _ : {user : string, nodes : string list, id : string, hostname : string} => ())
7f75d838
AC		 369fun registerPre f =
370 let
371 val old = !pre
372 in
373 pre := (fn x => (old x; f x))
374 end
375
376val post = ref (fn () => ())
377fun registerPost f =
378 let
379 val old = !post
380 in
381 post := (fn () => (old (); f ()))
382 end
383
384val aliaser = ref (fn _ : string => ())
385fun registerAliaser f =
386 let
387 val old = !aliaser
388 in
389 aliaser := (fn x => (old x; f x))
390 end
391
8a7c40fa
AC		 392val () = Env.containerV_one "vhost"
393 ("host", Env.string)
394 (fn (env, host) =>
395 let
396 val nodes = Env.env (Env.list Env.string) (env, "WebNodes")
397
434a7b1f 398 val ssl = Env.env ssl (env, "SSL")
8a7c40fa
AC		 399 val user = Env.env Env.string (env, "User")
400 val group = Env.env Env.string (env, "Group")
401 val docroot = Env.env Env.string (env, "DocumentRoot")
402 val sadmin = Env.env Env.string (env, "ServerAdmin")
434a7b1f 403 val suexec = Env.env Env.bool (env, "SuExec")
8a7c40fa
AC		 404
405 val fullHost = host ^ "." ^ Domain.currentDomain ()
434a7b1f
AC		 406 val vhostId = fullHost ^ (if Option.isSome ssl then ".ssl" else "")
407 val confFile = fullHost ^ (if Option.isSome ssl then ".vhost_ssl" else ".vhost")
8a7c40fa 408 in
c98b57cf
AC		 409 currentVhost := fullHost;
410 currentVhostId := vhostId;
8a5b34c9 411 sslEnabled := Option.isSome ssl;
c98b57cf 412
f8dfbbcc 413 rewriteEnabled := false;
ce01b51a 414 localRewriteEnabled := false;
8a7c40fa
AC		 415 vhostFiles := map (fn node =>
416 let
417 val file = Domain.domainFile {node = node,
418 name = confFile}
2a7d2818
AC		 419
420 val ld = logDir {user = user, node = node, vhostId = vhostId}
8a7c40fa 421 in
00a13ad8
AC		 422 TextIO.output (file, "# Owner: ");
423 TextIO.output (file, user);
424 TextIO.output (file, "\n<VirtualHost ");
8a7c40fa
AC		 425 TextIO.output (file, Domain.nodeIp node);
426 TextIO.output (file, ":");
434a7b1f
AC		 427 TextIO.output (file, case ssl of
428 SOME _ => "443"
429 | NONE => "80");
8a7c40fa 430 TextIO.output (file, ">\n");
7a2b27f0 431 TextIO.output (file, "\tErrorLog ");
2a7d2818 432 TextIO.output (file, ld);
7a2b27f0 433 TextIO.output (file, "/error.log\n\tCustomLog ");
2a7d2818 434 TextIO.output (file, ld);
7a2b27f0 435 TextIO.output (file, "/access.log combined\n");
55d4a268
AC		 436 TextIO.output (file, "\tServerName ");
437 TextIO.output (file, fullHost);
e519d696
AC		 438 app
439 (fn dom => (TextIO.output (file, "\n\tServerAlias ");
440 TextIO.output (file, host);
441 TextIO.output (file, ".");
442 TextIO.output (file, dom)))
443 (Domain.currentAliasDomains ());
3f84c976 444
55d4a268
AC		 445 if suexec then
446 if isVersion1 node then
447 (TextIO.output (file, "\n\tUser ");
448 TextIO.output (file, user);
449 TextIO.output (file, "\n\tGroup ");
450 TextIO.output (file, group))
451 else
452 (TextIO.output (file, "\n\tSuexecUserGroup ");
453 TextIO.output (file, user);
454 TextIO.output (file, " ");
455 TextIO.output (file, group))
456 else
457 ();
3f84c976 458
f8ef6c20 459 if isWaklog node then
a09d0e82 460 (TextIO.output (file, "\n\tWaklogEnabled on\n\tWaklogLocationPrincipal ");
f8ef6c20 461 TextIO.output (file, user);
fdf9a42d 462 TextIO.output (file, "/daemon@HCOOP.NET /etc/keytabs/user.daemon/");
f8ef6c20
AC		 463 TextIO.output (file, user))
464 else
465 ();
3f84c976 466
e34e1f36 467 TextIO.output (file, "\n\tDAVLockDB /var/lock/apache2/dav/");
3f84c976
AC		 468 TextIO.output (file, user);
469 TextIO.output (file, "/DAVLock");
470
2a7d2818 471 (ld, file)
8a7c40fa
AC		 472 end)
473 nodes;
8a7c40fa
AC		 474 write "\n\tDocumentRoot ";
475 write docroot;
476 write "\n\tServerAdmin ";
477 write sadmin;
434a7b1f
AC		 478 case ssl of
479 SOME cert =>
480 (write "\n\tSSLEngine on\n\tSSLCertificateFile ";
481 write cert)
482 | NONE => ();
7a2b27f0 483 write "\n";
5cab5a98
AC		 484 !pre {user = user, nodes = nodes, id = vhostId, hostname = fullHost};
485 app (fn dom => !aliaser (host ^ "." ^ dom)) (Domain.currentAliasDomains ())
8a7c40fa 486 end,
7f75d838
AC		 487 fn () => (!post ();
488 write "</VirtualHost>\n";
7a2b27f0 489 app (TextIO.closeOut o #2) (!vhostFiles)))
8a7c40fa 490
ce01b51a
AC		 491val inLocal = ref false
492
2882ee37
AC		 493val () = Env.container_one "location"
494 ("prefix", Env.string)
495 (fn prefix =>
496 (write "\t<Location ";
497 write prefix;
ce01b51a
AC		 498 write ">\n";
499 inLocal := true),
500 fn () => (write "\t</Location>\n";
501 inLocal := false;
502 localRewriteEnabled := false))
2882ee37
AC		 503
504val () = Env.container_one "directory"
505 ("directory", Env.string)
506 (fn directory =>
507 (write "\t<Directory ";
508 write directory;
ce01b51a
AC		 509 write ">\n";
510 inLocal := true),
511 fn () => (write "\t</Directory>\n";
512 inLocal := false;
513 localRewriteEnabled := false))
2882ee37 514
f8dfbbcc 515fun checkRewrite () =
ce01b51a
AC		 516 if !inLocal then
517 if !rewriteEnabled orelse !localRewriteEnabled then
518 ()
519 else
520 (write "\tRewriteEngine on\n";
521 localRewriteEnabled := true)
522 else if !rewriteEnabled then
f8dfbbcc
AC		 523 ()
524 else
525 (write "\tRewriteEngine on\n";
526 rewriteEnabled := true)
527
528val () = Env.action_three "localProxyRewrite"
529 ("from", Env.string, "to", Env.string, "port", Env.int)
530 (fn (from, to, port) =>
531 (checkRewrite ();
532 write "\tRewriteRule\t";
533 write from;
534 write "\thttp://localhost:";
535 write (Int.toString port);
536 write "/";
537 write to;
538 write " [P]\n"))
539
e95a129e
AC		 540val () = Env.action_two "proxyPass"
541 ("from", Env.string, "to", Env.string)
542 (fn (from, to) =>
543 (write "\tProxyPass\t";
544 write from;
545 write "\t";
546 write to;
547 write "\n"))
548
549val () = Env.action_two "proxyPassReverse"
550 ("from", Env.string, "to", Env.string)
551 (fn (from, to) =>
552 (write "\tProxyPassReverse\t";
553 write from;
554 write "\t";
555 write to;
556 write "\n"))
f8dfbbcc
AC		 557
558val () = Env.action_three "rewriteRule"
559 ("from", Env.string, "to", Env.string, "flags", Env.list flag)
560 (fn (from, to, flags) =>
561 (checkRewrite ();
562 write "\tRewriteRule\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
e95a129e
AC		 575val () = Env.action_three "rewriteCond"
576 ("test", Env.string, "pattern", Env.string, "flags", Env.list cond_flag)
577 (fn (from, to, flags) =>
578 (checkRewrite ();
579 write "\tRewriteCond\t";
580 write from;
581 write "\t";
582 write to;
583 case flags of
584 [] => ()
585 | flag::rest => (write " [";
586 write flag;
587 app (fn flag => (write ",";
588 write flag)) rest;
589 write "]");
590 write "\n"))
591
94b7b11a
AC		 592val () = Env.action_one "rewriteBase"
593 ("prefix", Env.string)
594 (fn prefix =>
595 (checkRewrite ();
596 write "\tRewriteBase\t";
597 write prefix;
598 write "\n"))
599
c98b57cf
AC		 600val () = Env.action_one "rewriteLogLevel"
601 ("level", Env.int)
602 (fn level =>
603 (checkRewrite ();
604 write "\tRewriteLog ";
7a2b27f0 605 write' (fn x => x);
c98b57cf
AC		 606 write "/rewrite.log\n\tRewriteLogLevel ";
607 write (Int.toString level);
608 write "\n"))
609
d5754b53
AC		 610val () = Env.action_two "alias"
611 ("from", Env.string, "to", Env.string)
612 (fn (from, to) =>
613 (write "\tAlias\t";
614 write from;
615 write " ";
616 write to;
617 write "\n"))
618
619val () = Env.action_two "scriptAlias"
620 ("from", Env.string, "to", Env.string)
621 (fn (from, to) =>
622 (write "\tScriptAlias\t";
623 write from;
624 write " ";
625 write to;
626 write "\n"))
627
628val () = Env.action_two "errorDocument"
629 ("code", Env.string, "handler", Env.string)
630 (fn (code, handler) =>
631 (write "\tErrorDocument\t";
632 write code;
633 write " ";
634 write handler;
635 write "\n"))
636
d441e69f
AC		 637val () = Env.action_one "options"
638 ("options", Env.list apache_option)
639 (fn opts =>
640 case opts of
641 [] => ()
642 | _ => (write "\tOptions";
643 app (fn opt => (write " "; write opt)) opts;
644 write "\n"))
645
646val () = Env.action_one "set_options"
647 ("options", Env.list apache_option)
648 (fn opts =>
649 case opts of
650 [] => ()
651 | _ => (write "\tOptions";
652 app (fn opt => (write " +"; write opt)) opts;
653 write "\n"))
654
655val () = Env.action_one "unset_options"
656 ("options", Env.list apache_option)
657 (fn opts =>
658 case opts of
659 [] => ()
660 | _ => (write "\tOptions";
661 app (fn opt => (write " -"; write opt)) opts;
662 write "\n"))
d5754b53 663
edd38024
AC		 664val () = Env.action_one "directoryIndex"
665 ("filenames", Env.list Env.string)
666 (fn opts =>
667 (write "\tDirectoryIndex";
668 app (fn opt => (write " "; write opt)) opts;
669 write "\n"))
670
e519d696 671val () = Env.action_one "serverAliasHost"
edd38024
AC		 672 ("host", Env.string)
673 (fn host =>
674 (write "\tServerAlias ";
675 write host;
7f75d838
AC		 676 write "\n";
677 !aliaser host))
edd38024 678
e519d696
AC		 679val () = Env.action_one "serverAlias"
680 ("host", Env.string)
681 (fn host =>
682 (app
683 (fn dom =>
684 let
685 val full = host ^ "." ^ dom
686 in
687 write "\tServerAlias ";
688 write full;
689 write "\n";
690 !aliaser full
691 end)
692 (Domain.currentDomains ())))
693
694val () = Env.action_none "serverAliasDefault"
695 (fn () =>
696 (app
697 (fn dom =>
698 (write "\tServerAlias ";
699 write dom;
700 write "\n";
701 !aliaser dom))
702 (Domain.currentDomains ())))
703
2aeb9eec
AC		 704val authType = fn (EVar "basic", _) => SOME "basic"
705 | (EVar "digest", _) => SOME "digest"
35dc7746 706 | (EVar "kerberos", _) => SOME "kerberos"
2aeb9eec
AC		 707 | _ => NONE
708
8a5b34c9
AC		 709fun allowAuthType "kerberos" = !sslEnabled
710 | allowAuthType _ = true
711
2aeb9eec
AC		 712val () = Env.action_one "authType"
713 ("type", authType)
714 (fn ty =>
8a5b34c9
AC		 715 if allowAuthType ty then
716 (write "\tAuthType ";
717 write ty;
718 write "\n";
719 case ty of
720 "kerberos" =>
721 write "\tKrbMethodNegotiate off\n\tKrbMethodK5Passwd on\n\tKrbVerifyKDC off\n\tKrbAuthRealms HCOOP.NET\n\tKrbSaveCredentials on\n"
722 | _ => ())
723 else
724 print "WARNING: Skipped Kerberos authType because this isn't an SSL vhost.\n")
2aeb9eec
AC		 725
726val () = Env.action_one "authName"
727 ("name", Env.string)
728 (fn name =>
729 (write "\tAuthName \"";
730 write name;
731 write "\"\n"))
732
733val () = Env.action_one "authUserFile"
734 ("file", Env.string)
735 (fn name =>
736 (write "\tAuthUserFile ";
737 write name;
738 write "\n"))
739
740val () = Env.action_none "requireValidUser"
741 (fn () => write "\tRequire valid-user\n")
742
743val () = Env.action_one "requireUser"
744 ("users", Env.list Env.string)
745 (fn names =>
746 case names of
747 [] => ()
748 | _ => (write "\tRequire user";
749 app (fn name => (write " "; write name)) names;
750 write "\n"))
751
752val () = Env.action_one "requireGroup"
753 ("groups", Env.list Env.string)
754 (fn names =>
755 case names of
756 [] => ()
757 | _ => (write "\tRequire group";
758 app (fn name => (write " "; write name)) names;
759 write "\n"))
760
761val () = Env.action_none "orderAllowDeny"
762 (fn () => write "\tOrder allow,deny\n")
763
764val () = Env.action_none "orderDenyAllow"
765 (fn () => write "\tOrder deny,allow\n")
766
767val () = Env.action_none "allowFromAll"
768 (fn () => write "\tAllow from all\n")
769
770val () = Env.action_one "allowFrom"
771 ("entries", Env.list Env.string)
772 (fn names =>
773 case names of
774 [] => ()
775 | _ => (write "\tAllow from";
776 app (fn name => (write " "; write name)) names;
777 write "\n"))
778
779val () = Env.action_none "denyFromAll"
780 (fn () => write "\tDeny from all\n")
781
782val () = Env.action_one "denyFrom"
783 ("entries", Env.list Env.string)
784 (fn names =>
785 case names of
786 [] => ()
787 | _ => (write "\tDeny from";
788 app (fn name => (write " "; write name)) names;
789 write "\n"))
790
791val () = Env.action_none "satisfyAll"
792 (fn () => write "\tSatisfy all\n")
793
794val () = Env.action_none "satisfyAny"
795 (fn () => write "\tSatisfy any\n")
796
7f012ffd
AC		 797val () = Env.action_one "forceType"
798 ("type", Env.string)
799 (fn ty => (write "\tForceType ";
800 write ty;
801 write "\n"))
802
803val () = Env.action_none "forceTypeOff"
804 (fn () => write "\tForceType None\n")
805
806val () = Env.action_two "action"
807 ("what", Env.string, "how", Env.string)
808 (fn (what, how) => (write "\tAction ";
809 write what;
810 write " ";
811 write how;
812 write "\n"))
813
814val () = Env.action_one "addDefaultCharset"
815 ("charset", Env.string)
816 (fn ty => (write "\tAddDefaultCharset ";
817 write ty;
818 write "\n"))
819
64e85bae 820(*val () = Env.action_one "davSvn"
c8505e59
AC		 821 ("path", Env.string)
822 (fn path => (write "\tDAV svn\n\tSVNPath ";
823 write path;
824 write "\n"))
825
826val () = Env.action_one "authzSvnAccessFile"
827 ("path", Env.string)
828 (fn path => (write "\tAuthzSVNAccessFile ";
829 write path;
64e85bae 830 write "\n"))*)
c8505e59 831
0aed4302
AC		 832val () = Env.action_none "davFilesystem"
833 (fn path => write "\tDAV filesystem\n")
834
9d7fa346
AC		 835val () = Env.action_two "addDescription"
836 ("description", Env.string, "patterns", Env.list Env.string)
837 (fn (desc, pats) =>
838 case pats of
839 [] => ()
840 | _ => (write "\tAddDescription \"";
841 write (String.toString desc);
842 write "\"";
843 app (fn pat => (write " "; write pat)) pats;
844 write "\n"))
845
846val () = Env.action_one "indexOptions"
847 ("options", Env.list autoindex_option)
848 (fn opts =>
849 case opts of
850 [] => ()
851 | _ => (write "\tIndexOptions";
852 app (fn (opt, arg) =>
853 (write " ";
854 write opt;
855 Option.app (fn arg =>
856 (write "="; write arg)) arg)) opts;
857 write "\n"))
858
859val () = Env.action_one "set_indexOptions"
860 ("options", Env.list autoindex_option)
861 (fn opts =>
862 case opts of
863 [] => ()
864 | _ => (write "\tIndexOptions";
865 app (fn (opt, arg) =>
866 (write " +";
867 write opt;
868 Option.app (fn arg =>
869 (write "="; write arg)) arg)) opts;
870 write "\n"))
871
872val () = Env.action_one "unset_indexOptions"
873 ("options", Env.list autoindex_option)
874 (fn opts =>
875 case opts of
876 [] => ()
877 | _ => (write "\tIndexOptions";
878 app (fn (opt, _) =>
879 (write " -";
880 write opt)) opts;
881 write "\n"))
882
883val () = Env.action_one "headerName"
884 ("name", Env.string)
885 (fn name => (write "\tHeaderName ";
886 write name;
887 write "\n"))
888
889val () = Env.action_one "readmeName"
890 ("name", Env.string)
891 (fn name => (write "\tReadmeName ";
892 write name;
893 write "\n"))
894
eda33894
AC		 895val () = Env.action_two "setEnv"
896 ("key", Env.string, "value", Env.string)
897 (fn (key, value) => (write "\tSetEnv \"";
898 write key;
899 write "\" \"";
ca6ffb3f
AC		 900 write (String.translate (fn #"\"" => "\\\""
901 | ch => str ch) value);
eda33894
AC		 902 write "\"\n"))
903
71420f8b
AC		 904val () = Domain.registerResetLocal (fn () =>
905 ignore (OS.Process.system (Config.rm ^ " -rf /var/domtool/vhosts/*")))
906
41c58daf
AC		 907val () = Domain.registerDescriber (Domain.considerAll
908 [Domain.Extension {extension = "vhost",
d300166d 909 heading = fn host => "Web vhost " ^ host},
41c58daf 910 Domain.Extension {extension = "vhost_ssl",
d300166d 911 heading = fn host => "SSL web vhost " ^ host}])
41c58daf 912
8a7c40fa 913end
Unnamed repository; edit this file to name it for gitweb.