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