2 Domtool (http
://hcoop
.sf
.net
/)
3 Copyright (C
) 2004 Adam Chlipala
5 This program is free software
; you can redistribute it
and/or
6 modify it under the terms
of the GNU General Public License
7 as published by the Free Software Foundation
; either version
2
8 of the License
, or (at your option
) any later version
.
10 This program is distributed
in the hope that it will be useful
,
11 but WITHOUT ANY WARRANTY
; without even the implied warranty
of
12 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE
. See the
13 GNU General Public License for more details
.
15 You should have received a copy
of the GNU General Public License
16 along
with this program
; if not
, write to the Free Software
17 Foundation
, Inc
., 59 Temple Place
- Suite
330, Boston
, MA
02111-1307, USA
.
20 (* Apache vhost management module
, with Webalizer support
*)
22 structure Apache
:> APACHE
=
24 open Config ApacheConfig Util
26 val vhosts
= ref (NONE
: TextIO.outstream option
)
28 fun init () = vhosts
:= SOME (TextIO.openOut (scratchDir ^
"/vhosts.conf"))
29 fun finish () = (TextIO.closeOut (valOf (!vhosts
));
32 fun handler
{path
, domain
, parent
, vars
, paths
, users
, groups
} =
34 val _
= Domtool
.dprint ("Reading host " ^ path ^
" for " ^ domain ^
"....")
36 val vhosts
= valOf (!vhosts
)
38 val hf
= TextIO.openIn path
39 val rewrite
= ref
false
41 val conf
= TextIO.openOut (wblConfDir ^
"/" ^ domain ^
".conf")
42 val _
= TextIO.output (conf
, "LogFile\t" ^ logDir ^ domain ^
"-access.log\n" ^
43 "OutputDir\t" ^ wblDocDir ^
"/" ^ domain ^
"\n" ^
44 "HostName\t" ^ domain ^
"\n" ^
45 "HideSite\t" ^ domain ^
"\n" ^
46 "HideReferrer\t" ^ domain ^
"\n")
48 val dir
= wblDocDir ^
"/" ^ domain
50 if Posix
.FileSys
.access (dir
, []) then
53 Posix
.FileSys
.mkdir (dir
, Posix
.FileSys
.S
.flags
[Posix
.FileSys
.S
.ixoth
, Posix
.FileSys
.S
.irwxu
,
54 Posix
.FileSys
.S
.irgrp
, Posix
.FileSys
.S
.iwgrp
])
56 val htac
= TextIO.openOut (dir ^
"/.htaccess")
57 val user
= ref defaultUser
58 val group
= ref defaultGroup
61 (case String.tokens
Char.isSpace line
of
64 if StringSet
.member (users
, user
') then
67 Domtool
.error (path
, "not authorized to run as " ^ user
')
68 |
["Group", group
'] =>
69 if StringSet
.member (groups
, group
') then
72 Domtool
.error (path
, "not authorized to run as group " ^ group
')
73 |
["ServerAdmin", email
] => TextIO.output (vhosts
, "\tServerAdmin " ^ email ^
"\n")
74 |
["UserDir"] => TextIO.output (vhosts
, "\tUserDir public_html\n\t<Directory /home/*/public_html/cgi-bin>\n\t\tAllowOverride None\n\t\tOptions ExecCGI\n\t\tAllow from all\n\t\tSetHandler cgi-script\n\t</Directory>\n\tScriptAliasMatch ^/~(.*)/cgi-bin/(.*) /home/$1/public_html/cgi-bin/$2\n")
75 |
["DocumentRoot", p
] =>
76 if checkPath (paths
, p
) then
77 TextIO.output (vhosts
, "\tDocumentRoot " ^ p ^
"\n")
79 print (path ^
": not authorized to use " ^ p ^
"\n")
80 |
"RewriteRule" :: args
=>
81 (if not (!rewrite
) then
83 TextIO.output (vhosts
, "\tRewriteEngine on\n"))
86 TextIO.output (vhosts
, foldl (fn (a
, s
) => s ^
" " ^ a
) "\tRewriteRule" args ^
"\n"))
87 |
["Alias", from
, to
] =>
88 if checkPath (paths
, to
) then
89 TextIO.output (vhosts
, "\tAlias " ^ from ^
" " ^ to ^
"\n")
91 Domtool
.error (path
, "not authorized to use " ^ to
)
92 |
"ErrorDocument" :: code
:: rest
=>
93 TextIO.output (vhosts
, foldl (fn (a
, s
) => s ^
" " ^ a
) ("\tErrorDocument " ^ code
) rest ^
"\n")
94 |
["ScriptAlias", from
, to
] =>
95 if checkPath (paths
, to
) then
96 TextIO.output (vhosts
, "\tScriptAlias " ^ from ^
" \"" ^ to ^
"\"\n")
98 Domtool
.error (path
, "not authorized to use " ^ to
)
100 TextIO.output (vhosts
, "\t<Location />\n\t\tOptions +Includes +IncludesNOEXEC\n\t</Location>\n")
101 |
["ServerAlias", dom
] =>
102 if validDomain dom
then
104 val file
= foldr (fn (c
, s
) => s ^
"/" ^ c
) dataDir (String.fields (fn ch
=> ch
= #
".") dom
) ^
".aliased"
106 if Posix
.FileSys
.access (file
, []) then
107 (TextIO.output (vhosts
, "\tServerAlias " ^ dom ^
"\n");
108 TextIO.output (conf
, "HideSite\t" ^ dom ^
"\n" ^
109 "HideReferrer\t" ^ dom ^
"\n"))
111 Domtool
.error (path
, "not authorized to ServerAlias " ^ dom
)
114 Domtool
.error (path
, "bad host: " ^ dom
)
115 |
"WebalizerUsers" :: users
=>
116 TextIO.output (htac
, "AuthType Basic\n" ^
117 "AuthName \"Abulafia web account\"\n" ^
118 "AuthUserFile " ^ passwdFile ^
"\n" ^
119 foldl (fn (u
, s
) => s ^
" " ^ u
) "Require user" users ^
"\n")
120 |
["AbuPrivate"] => TextIO.output (vhosts
,
122 "\t\tAuthName \"Abulafia web account\"\n" ^
123 "\t\tAuthType basic\n" ^
124 "\t\tAuthUserFile " ^ passwdFile ^
"\n" ^
125 "\t\tRequire valid-user\n" ^
126 "\t\tOrder Deny,Allow\n" ^
127 "\t\tDeny from all\n" ^
128 "\t\tAllow from 127.0.0.1\n" ^
129 "\t\tAllow from 63.246.10.45\n" ^
130 "\t\tSatisfy any\n" ^
132 |
["Default"] => (TextIO.output (vhosts
, "\tServerAlias " ^ parent ^
"\n");
133 TextIO.output (conf
, "HideSite\t" ^ parent ^
"\n" ^
134 "HideReferrer\t" ^ parent ^
"\n"))
136 if checkPath (paths
, p
) then
137 TextIO.output (vhosts
, "\t<Directory " ^ p ^
">\n" ^
138 "\t\tOptions ExecCGI\n" ^
139 "\t\tSetHandler cgi-script\n" ^
142 Domtool
.error (path
, "not authorized to use " ^ p
)
144 if checkPath (paths
, p
) then
145 TextIO.output (vhosts
, "\t<Directory " ^ p ^
">\n" ^
146 "\t\tForceType text/html\n" ^
149 Domtool
.error (path
, "not authorized to use " ^ p
)
150 | cmd
::_
=> Domtool
.error (path
, "unknown option: " ^ cmd
))
152 TextIO.output (vhosts
, "<VirtualHost *>\n" ^
153 "\tServerName " ^ domain ^
"\n" ^
154 "\tErrorLog " ^ logDir ^ domain ^
"-error.log\n" ^
155 "\tCustomLog " ^ logDir ^ domain ^
"-access.log combined\n" ^
156 "\tIndexOptions FancyIndexing FoldersFirst\n");
157 ioLoop (fn () => Domtool
.inputLine hf
) loop ();
158 TextIO.output (vhosts
, "\tUser ");
159 TextIO.output (vhosts
, !user
);
160 TextIO.output (vhosts
, "\n\tGroup ");
161 TextIO.output (vhosts
, !group
);
162 TextIO.output (vhosts
, "\n</VirtualHost>\n\n");
164 TextIO.closeOut conf
;
166 end handle Io
=> Domtool
.error (path
, "IO error")
169 if OS
.Process
.isSuccess (OS
.Process
.system
170 (diff ^
" " ^ scratchDir ^
"/vhosts.conf " ^ dataFile
)) then
172 else if not (OS
.Process
.isSuccess (OS
.Process
.system
173 (cp ^
" " ^ scratchDir ^
"/vhosts.conf " ^ dataFile
))) then
174 (print
"Error copying vhosts.conf\n";
176 else if OS
.Process
.isSuccess (OS
.Process
.system pubCommand
) then
179 (print
"Error publishing vhosts.conf\n";
182 fun mkdom _
= OS
.Process
.success
184 val _
= Domtool
.setVhostHandler
{init
= init
,