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