[hcoop/zz_old/domtool.git] / src / domtool.sml

(*
Domtool (http://hcoop.sf.net/)
Copyright (C) 2004  Adam Chlipala

This program is free software; you can redistribute it and/or
modify it under the terms of the GNU General Public License
as published by the Free Software Foundation; either version 2
of the License, or (at your option) any later version.

This program is distributed in the hope that it will be useful,
but WITHOUT ANY WARRANTY; without even the implied warranty of
MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
GNU General Public License for more details.

You should have received a copy of the GNU General Public License
along with this program; if not, write to the Free Software
Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA  02111-1307, USA.
*)

(* Main domtool structure *)

structure Domtool =
struct
    open Config Util

    val uid = Posix.ProcEnv.wordToUid (SysWord.fromInt uid)

    val dprint = if debug then (fn x => print (x ^ "\n")) else (fn _ => ())

    fun openIn fname =
	((*dprint ("Open " ^ fname ^ "....");*)
	 TextIO.openIn fname)

    fun opendir fname =
	((*dprint ("Open dir " ^ fname ^ "....");*)
	 Posix.FileSys.opendir fname)

    fun inputLine fl =
	let
	    val s = TextIO.inputLine fl
	in
	    if size s = 0 orelse String.sub (s, 0) <> #"#" then
		s
	    else
		inputLine fl
	end
			
    fun hd' ([], x) = x
      | hd' (h::_, _) = h

    fun domPrep (a, b) =
	(case b of
	     "" => a
	   | _ => a ^ "." ^ b)


    type map = string StringMap.map
    type set = StringSet.set

    type handlerData = {path : string,
			domain : string,
			parent : string,
			vars : map,
			paths : set,
			users : set,
			groups : set}
    type mkdomData = {path : string,
		      domain : string}
    type handler = {init : unit -> unit,
		    file : handlerData -> unit,
		    finish : unit -> unit,
		    publish : unit -> OS.Process.status,
		    mkdom : mkdomData -> OS.Process.status}

    val nullHandler = {init = fn () => (),
		       file = fn (_ : handlerData) => (),
		       finish = fn () => (),
		       publish = fn () => OS.Process.success,
		       mkdom = fn (_ : mkdomData) => OS.Process.success}

    val vhostHandler = ref nullHandler
    fun setVhostHandler f = vhostHandler := f

    val handlers = ref (StringMap.empty : handler StringMap.map)
    fun setHandler (fname, handler) = handlers := StringMap.insert (!handlers, fname, handler)

    fun error (path, msg) = print (path ^ ": " ^ msg ^ "\n")

    fun read () =
	let
	    val vhostHandler = !vhostHandler

	    val _ = Posix.FileSys.mkdir (lockFile, Posix.FileSys.S.irwxu)

	    fun readDir (path, prefix, vars, paths, users, groups) =
		let
		    val _ = dprint ("readDir: " ^ path)
		    val dir = opendir path

		    val vars =
			if Posix.FileSys.access (path ^ "/.vars", []) then
			    let
				val vf = openIn (path ^ "/.vars")

				fun loop vars =
				    let
					val line = inputLine vf
				    in
					case line of
					    "" => vars
					  | _ =>
					    (case String.tokens Char.isSpace line of
						 [n, v] =>
						 if validHost n then
						     loop (StringMap.insert (vars, n, v))
						 else
						     (error (path ^ "/.vars", "Invalid variable declaration: " ^
									      String.substring (line, 0, size line - 1));
						      loop vars)
					       | _ => loop vars)
				    end
			    in
				loop vars
				before TextIO.closeIn vf
			    end
			else
			    vars

		    val pp = path ^ "/.paths"
		    val paths =
			if Posix.FileSys.access (pp, []) then
			   (if Posix.FileSys.ST.uid (Posix.FileSys.stat pp) = uid then
				let
				    val vf = openIn pp
					     
				    fun loop paths =
					let
					    val line = inputLine vf
					in
					    case line of
						"" => paths
					      | _ =>
						(case String.tokens Char.isSpace line of
						     [path] => loop (StringSet.add (paths, path))
						   | _ => loop paths)
					end
				in
				    loop paths
				    before TextIO.closeIn vf
				end
			    else
				(error (pp, "wrong owner to be used");
				 paths))
			else
			    paths

		    val up = path ^ "/.users"
		    val users =
			if Posix.FileSys.access (up, []) then
			   (if Posix.FileSys.ST.uid (Posix.FileSys.stat up) = uid then
				let
				    val vf = openIn up
					     
				    fun loop users =
					let
					    val line = inputLine vf
					in
					    case line of
						"" => users
					      | _ =>
						(case String.tokens Char.isSpace line of
						     [user] => loop (StringSet.add (users, user))
						   | _ => loop users)
					end
				in
				    loop users
				    before TextIO.closeIn vf
				end
			    else
				(error (up, ": wrong owner to be used.");
				 users))
			else
			    users

		    val gp = path ^ "/.groups"
		    val groups =
			if Posix.FileSys.access (gp, []) then
			   (if Posix.FileSys.ST.uid (Posix.FileSys.stat gp) = uid then
				let
				    val vf = openIn gp
					     
				    fun loop groups =
					let
					    val line = inputLine vf
					in
					    case line of
						"" => groups
					      | _ =>
						(case String.tokens Char.isSpace line of
						     [group] => loop (StringSet.add (groups, group))
						   | _ => loop groups)
					end
				in
				    loop groups
				    before TextIO.closeIn vf
				end
			    else
				(error (gp, "wrong owner to be used.");
				 groups))
			else
			    groups

		    fun loop (name, ()) =
			let
			    val path' = path ^ "/" ^ name
			    val prefix' = domPrep (name, prefix)
			in
			    if not (Posix.FileSys.access (path', [])) then
				()
			    else if Posix.FileSys.ST.isDir (Posix.FileSys.stat path') then
				readDir (path', prefix', vars, paths, users, groups)
			    else if isTmp name then
				()
			    else case StringMap.find (!handlers, name) of
				     NONE => if validHost name andalso path' <> defaultWebPath then
						 #file vhostHandler {path = path',
								     domain = prefix',
								     parent = prefix,
								     vars = vars,
								     paths = paths,
								     users = users,
								     groups = groups}
					     else
						 ()
				   | SOME {file, ...} => file {path = path',
							       domain = prefix',
							       parent = prefix,
							       vars = vars,
							       paths = paths,
							       users = users,
							       groups = groups}
			end
		in
		    ioOptLoop (fn () => Posix.FileSys.readdir dir) loop ();
		    Posix.FileSys.closedir dir
		end handle Io => error (path, "IO error")
	in
	    #init vhostHandler ();
	    StringMap.app (fn {init, ...} => init ()) (!handlers);
	    readDir (dataDir, "", StringMap.empty,
		     StringSet.empty, StringSet.empty, StringSet.empty);
	    StringMap.app (fn {finish, ...} => finish ()) (!handlers);
	    #finish vhostHandler ();
	    Posix.FileSys.rmdir lockFile;
	    print "Processing complete.\n";
	    OS.Process.system dompub
	end handle Io => (print "IO error. Is domtool already running?\n";
			  OS.Process.failure)

    fun combineStatus (a, b) =
	if OS.Process.isSuccess a andalso OS.Process.isSuccess b then
	    OS.Process.success
	else
	    OS.Process.failure

    fun publish () =
	StringMap.foldl (fn ({publish, ...}, status) =>
			    combineStatus (status, publish ()))
			(#publish (!vhostHandler) ())
			(!handlers)

    fun mkdir dir =
	let
	    fun mkd (tokens, acc) =
		case tokens of
		    [] => true
		  | (dir::rest) =>
		    let
			val dir = acc ^ "/" ^ dir
		    in
			if not (Posix.FileSys.access (dir, []))
			   andalso OS.Process.system ("mkdir " ^ dir) = OS.Process.failure then
			    (print ("Can't created directory " ^ dir ^ "\n");
			     false)
			else
			    mkd (rest, dir)
		    end
	in
	    mkd (String.tokens (fn ch => ch = #"/") dir, dataDir)
	end

    fun mkdom (dom, user) =
	if not (validDomain dom) then
	    (print "Invalid domain\n";
	     OS.Process.failure)
	else if not (validUser user) then
	    (print "Invalid user\n";
	     OS.Process.failure)
	else
	    let
		val dir' = toDir dom
		val dir = dataDir ^ dir'
	    in
		if not (mkdir dir')
		   orelse OS.Process.system ("echo " ^ user ^ " >" ^ dir ^ "/.users") = OS.Process.failure
		   orelse OS.Process.system ("echo " ^ user ^ " >" ^ dir ^ "/.groups") = OS.Process.failure
		   orelse OS.Process.system ("echo /home/" ^ user ^ " >" ^ dir ^ "/.paths") = OS.Process.failure
		   orelse OS.Process.system ("chown -R " ^ user ^ "." ^ user ^ " " ^ dir) = OS.Process.failure
		   orelse OS.Process.system ("chmod -R g+w " ^ dir) = OS.Process.failure
		   orelse OS.Process.system ("chown domains.adm " ^ dir ^ "/.users " ^ dir ^ "/.groups " ^ dir ^ "/.paths") = OS.Process.failure then
		    (print "Setup failed\n";
		     OS.Process.failure)
		else if not (OS.Process.isSuccess
			     (StringMap.foldl (fn ({mkdom, ...}, status) =>
						  combineStatus (status, mkdom {path = dir, domain = dom}))
					      (#mkdom (!vhostHandler) {path = dir, domain = dom})
					      (!handlers))) then
		    (print "Setup failed\n";
		     OS.Process.failure)
		else
		    (print "Domain created\n";
		     OS.Process.success)
	    end
end
Commit	Line	Data
182a2654 AC	1	(*
	2	Domtool (http://hcoop.sf.net/)
	3	Copyright (C) 2004 Adam Chlipala
	4
	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.
	9
	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.
	14
	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.
	18	*)
	19
	20	(* Main domtool structure *)
	21
	22	structure Domtool =
	23	struct
	24	open Config Util
	25
	26	val uid = Posix.ProcEnv.wordToUid (SysWord.fromInt uid)
	27
	28	val dprint = if debug then (fn x => print (x ^ "\n")) else (fn _ => ())
	29
	30	fun openIn fname =
	31	((dprint ("Open " ^ fname ^ "....");)
	32	TextIO.openIn fname)
	33
	34	fun opendir fname =
	35	((dprint ("Open dir " ^ fname ^ "....");)
	36	Posix.FileSys.opendir fname)
	37
	38	fun inputLine fl =
	39	let
	40	val s = TextIO.inputLine fl
	41	in
	42	if size s = 0 orelse String.sub (s, 0) <> #"#" then
	43	s
	44	else
	45	inputLine fl
	46	end
	47
	48	fun hd' ([], x) = x
	49	\| hd' (h::_, _) = h
	50
	51	fun domPrep (a, b) =
	52	(case b of
	53	"" => a
	54	\| _ => a ^ "." ^ b)
	55
	56
	57	type map = string StringMap.map
	58	type set = StringSet.set
	59
	60	type handlerData = {path : string,
	61	domain : string,
	62	parent : string,
	63	vars : map,
	64	paths : set,
65	users : set,
66	groups : set}
67	type mkdomData = {path : string,
68	domain : string}
69	type handler = {init : unit -> unit,
70	file : handlerData -> unit,
71	finish : unit -> unit,
72	publish : unit -> OS.Process.status,
73	mkdom : mkdomData -> OS.Process.status}
74
75	val nullHandler = {init = fn () => (),
76	file = fn (_ : handlerData) => (),
77	finish = fn () => (),
78	publish = fn () => OS.Process.success,
79	mkdom = fn (_ : mkdomData) => OS.Process.success}
80
81	val vhostHandler = ref nullHandler
82	fun setVhostHandler f = vhostHandler := f
83
84	val handlers = ref (StringMap.empty : handler StringMap.map)
85	fun setHandler (fname, handler) = handlers := StringMap.insert (!handlers, fname, handler)
86
87	fun error (path, msg) = print (path ^ ": " ^ msg ^ "\n")
88
89	fun read () =
90	let
91	val vhostHandler = !vhostHandler
92
93	val _ = Posix.FileSys.mkdir (lockFile, Posix.FileSys.S.irwxu)
94
95	fun readDir (path, prefix, vars, paths, users, groups) =
96	let
97	val _ = dprint ("readDir: " ^ path)
98	val dir = opendir path
99
100	val vars =
101	if Posix.FileSys.access (path ^ "/.vars", []) then
102	let
103	val vf = openIn (path ^ "/.vars")
104
105	fun loop vars =
106	let
107	val line = inputLine vf
108	in
109	case line of
110	"" => vars
111	\| _ =>
112	(case String.tokens Char.isSpace line of
113	[n, v] =>
114	if validHost n then
115	loop (StringMap.insert (vars, n, v))
116	else
117	(error (path ^ "/.vars", "Invalid variable declaration: " ^
118	String.substring (line, 0, size line - 1));
119	loop vars)
120	\| _ => loop vars)
121	end
122	in
123	loop vars
124	before TextIO.closeIn vf
125	end
126	else
127	vars
128
129	val pp = path ^ "/.paths"
130	val paths =
131	if Posix.FileSys.access (pp, []) then
132	(if Posix.FileSys.ST.uid (Posix.FileSys.stat pp) = uid then
133	let
134	val vf = openIn pp
135
136	fun loop paths =
137	let
138	val line = inputLine vf
139	in
140	case line of
141	"" => paths
142	\| _ =>
143	(case String.tokens Char.isSpace line of
144	[path] => loop (StringSet.add (paths, path))
145	\| _ => loop paths)
146	end
147	in
148	loop paths
149	before TextIO.closeIn vf
150	end
151	else
152	(error (pp, "wrong owner to be used");
153	paths))
154	else
155	paths
156
157	val up = path ^ "/.users"
158	val users =
159	if Posix.FileSys.access (up, []) then
160	(if Posix.FileSys.ST.uid (Posix.FileSys.stat up) = uid then
161	let
162	val vf = openIn up
163
164	fun loop users =
165	let
166	val line = inputLine vf
167	in
168	case line of
169	"" => users
170	\| _ =>
171	(case String.tokens Char.isSpace line of
172	[user] => loop (StringSet.add (users, user))
173	\| _ => loop users)
174	end
175	in
176	loop users
177	before TextIO.closeIn vf
178	end
179	else
180	(error (up, ": wrong owner to be used.");
181	users))
182	else
183	users
184
185	val gp = path ^ "/.groups"
186	val groups =
187	if Posix.FileSys.access (gp, []) then
188	(if Posix.FileSys.ST.uid (Posix.FileSys.stat gp) = uid then
189	let
190	val vf = openIn gp
191
192	fun loop groups =
193	let
194	val line = inputLine vf
195	in
196	case line of
197	"" => groups
198	\| _ =>
199	(case String.tokens Char.isSpace line of
200	[group] => loop (StringSet.add (groups, group))
201	\| _ => loop groups)
202	end
203	in
204	loop groups
205	before TextIO.closeIn vf
206	end
207	else
208	(error (gp, "wrong owner to be used.");
209	groups))
210	else
211	groups
212
213	fun loop (name, ()) =
214	let
215	val path' = path ^ "/" ^ name
216	val prefix' = domPrep (name, prefix)
217	in
218	if not (Posix.FileSys.access (path', [])) then
219	()
220	else if Posix.FileSys.ST.isDir (Posix.FileSys.stat path') then
221	readDir (path', prefix', vars, paths, users, groups)
222	else if isTmp name then
223	()
224	else case StringMap.find (!handlers, name) of
225	NONE => if validHost name andalso path' <> defaultWebPath then
226	#file vhostHandler {path = path',
227	domain = prefix',
228	parent = prefix,
229	vars = vars,
230	paths = paths,
231	users = users,
232	groups = groups}
233	else
234	()
235	\| SOME {file, ...} => file {path = path',
236	domain = prefix',
237	parent = prefix,
238	vars = vars,
239	paths = paths,
240	users = users,
241	groups = groups}
242	end
243	in
244	ioOptLoop (fn () => Posix.FileSys.readdir dir) loop ();
245	Posix.FileSys.closedir dir
246	end handle Io => error (path, "IO error")
247	in
248	#init vhostHandler ();
249	StringMap.app (fn {init, ...} => init ()) (!handlers);
250	readDir (dataDir, "", StringMap.empty,
251	StringSet.empty, StringSet.empty, StringSet.empty);
252	StringMap.app (fn {finish, ...} => finish ()) (!handlers);
253	#finish vhostHandler ();
254	Posix.FileSys.rmdir lockFile;
255	print "Processing complete.\n";
256	OS.Process.system dompub
257	end handle Io => (print "IO error. Is domtool already running?\n";
258	OS.Process.failure)
259
260	fun combineStatus (a, b) =
261	if OS.Process.isSuccess a andalso OS.Process.isSuccess b then
262	OS.Process.success
263	else
264	OS.Process.failure
265
266	fun publish () =
267	StringMap.foldl (fn ({publish, ...}, status) =>
268	combineStatus (status, publish ()))
269	(#publish (!vhostHandler) ())
270	(!handlers)
271
272	fun mkdir dir =
273	let
274	fun mkd (tokens, acc) =
275	case tokens of
276	[] => true
277	\| (dir::rest) =>
278	let
279	val dir = acc ^ "/" ^ dir
280	in
281	if not (Posix.FileSys.access (dir, []))
282	andalso OS.Process.system ("mkdir " ^ dir) = OS.Process.failure then
283	(print ("Can't created directory " ^ dir ^ "\n");
284	false)
285	else
286	mkd (rest, dir)
287	end
288	in
289	mkd (String.tokens (fn ch => ch = #"/") dir, dataDir)
290	end
291
292	fun mkdom (dom, user) =
293	if not (validDomain dom) then
294	(print "Invalid domain\n";
295	OS.Process.failure)
296	else if not (validUser user) then
297	(print "Invalid user\n";
298	OS.Process.failure)
299	else
300	let
301	val dir' = toDir dom
302	val dir = dataDir ^ dir'
303	in
304	if not (mkdir dir')
305	orelse OS.Process.system ("echo " ^ user ^ " >" ^ dir ^ "/.users") = OS.Process.failure
306	orelse OS.Process.system ("echo " ^ user ^ " >" ^ dir ^ "/.groups") = OS.Process.failure
307	orelse OS.Process.system ("echo /home/" ^ user ^ " >" ^ dir ^ "/.paths") = OS.Process.failure
308	orelse OS.Process.system ("chown -R " ^ user ^ "." ^ user ^ " " ^ dir) = OS.Process.failure
309	orelse OS.Process.system ("chmod -R g+w " ^ dir) = OS.Process.failure
310	orelse OS.Process.system ("chown domains.adm " ^ dir ^ "/.users " ^ dir ^ "/.groups " ^ dir ^ "/.paths") = OS.Process.failure then
311	(print "Setup failed\n";
312	OS.Process.failure)
313	else if not (OS.Process.isSuccess
314	(StringMap.foldl (fn ({mkdom, ...}, status) =>
315	combineStatus (status, mkdom {path = dir, domain = dom}))
316	(#mkdom (!vhostHandler) {path = dir, domain = dom})
317	(!handlers))) then
318	(print "Setup failed\n";
319	OS.Process.failure)
320	else
321	(print "Domain created\n";
322	OS.Process.success)
323	end
324	end