Commit | Line | Data |
---|---|---|
8a7c40fa AC |
1 | (* HCoop Domtool (http://hcoop.sourceforge.net/) |
2 | * Copyright (c) 2006, Adam Chlipala | |
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 | ||
21 | structure Apache :> APACHE = struct | |
22 | ||
23 | open Ast | |
24 | ||
25 | val dl = ErrorMsg.dummyLoc | |
26 | ||
27 | val _ = Main.registerDefault ("WebNodes", | |
28 | (TList (TBase "node", dl), dl), | |
29 | (fn () => (EList (map (fn s => (EString s, dl)) Config.Apache.webNodes), dl))) | |
30 | ||
31 | val _ = Main.registerDefault ("SSL", | |
32 | (TBase "bool", dl), | |
33 | (fn () => (EVar "false", dl))) | |
34 | ||
35 | val _ = Main.registerDefault ("User", | |
36 | (TBase "your_user", dl), | |
37 | (fn () => (EString (Domain.getUser ()), dl))) | |
38 | ||
39 | val _ = Main.registerDefault ("Group", | |
40 | (TBase "your_group", dl), | |
41 | (fn () => (EString (Domain.getUser ()), dl))) | |
42 | ||
43 | val _ = Main.registerDefault ("DocumentRoot", | |
44 | (TBase "your_path", dl), | |
45 | (fn () => (EString ("/home/" ^ Domain.getUser () ^ "/public_html"), dl))) | |
46 | ||
47 | val _ = Main.registerDefault ("ServerAdmin", | |
48 | (TBase "email", dl), | |
49 | (fn () => (EString (Domain.getUser () ^ "@" ^ Config.defaultDomain), dl))) | |
50 | ||
51 | val vhostsChanged = ref false | |
52 | ||
53 | val () = Slave.registerPreHandler | |
54 | (fn () => vhostsChanged := false) | |
55 | ||
56 | val () = Slave.registerFileHandler (fn fs => | |
57 | let | |
58 | val spl = OS.Path.splitDirFile (#file fs) | |
59 | in | |
60 | if String.isSuffix ".vhost" (#file spl) | |
61 | orelse String.isSuffix ".vhost_ssl" (#file spl) then | |
62 | (vhostsChanged := true; | |
63 | case #action fs of | |
64 | Slave.Delete => | |
65 | ignore (OS.Process.system (Config.rm | |
66 | ^ " -rf " | |
67 | ^ Config.Apache.confDir | |
68 | ^ "/" | |
69 | ^ #file spl)) | |
70 | | _ => | |
71 | ignore (OS.Process.system (Config.cp | |
72 | ^ " " | |
73 | ^ #file fs | |
74 | ^ " " | |
75 | ^ Config.Apache.confDir | |
76 | ^ "/" | |
77 | ^ #file spl))) | |
78 | else | |
79 | () | |
80 | end) | |
81 | ||
82 | val () = Slave.registerPostHandler | |
83 | (fn () => | |
84 | (if !vhostsChanged then | |
85 | Slave.shellF ([Config.Apache.reload], | |
86 | fn cl => "Error reloading Apache with " ^ cl) | |
87 | else | |
88 | ())) | |
89 | ||
90 | val vhostFiles : TextIO.outstream list ref = ref [] | |
91 | fun write s = app (fn file => TextIO.output (file, s)) (!vhostFiles) | |
92 | ||
93 | val () = Env.containerV_one "vhost" | |
94 | ("host", Env.string) | |
95 | (fn (env, host) => | |
96 | let | |
97 | val nodes = Env.env (Env.list Env.string) (env, "WebNodes") | |
98 | ||
99 | val ssl = Env.env Env.bool (env, "SSL") | |
100 | val user = Env.env Env.string (env, "User") | |
101 | val group = Env.env Env.string (env, "Group") | |
102 | val docroot = Env.env Env.string (env, "DocumentRoot") | |
103 | val sadmin = Env.env Env.string (env, "ServerAdmin") | |
104 | ||
105 | val fullHost = host ^ "." ^ Domain.currentDomain () | |
106 | val confFile = fullHost ^ (if ssl then ".vhost_ssl" else ".vhost") | |
107 | in | |
108 | vhostFiles := map (fn node => | |
109 | let | |
110 | val file = Domain.domainFile {node = node, | |
111 | name = confFile} | |
112 | in | |
113 | TextIO.output (file, "<VirtualHost "); | |
114 | TextIO.output (file, Domain.nodeIp node); | |
115 | TextIO.output (file, ":"); | |
116 | TextIO.output (file, if ssl then | |
117 | "443" | |
118 | else | |
119 | "80"); | |
120 | TextIO.output (file, ">\n"); | |
121 | file | |
122 | end) | |
123 | nodes; | |
124 | write "\tSuexecUserGroup "; | |
125 | write user; | |
126 | write " "; | |
127 | write group; | |
128 | write "\n\tDocumentRoot "; | |
129 | write docroot; | |
130 | write "\n\tServerAdmin "; | |
131 | write sadmin; | |
132 | write "\n" | |
133 | end, | |
134 | fn () => (write "</VirtualHost>\n"; | |
135 | app TextIO.closeOut (!vhostFiles))) | |
136 | ||
137 | end |