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