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