642e35fc0e9cfbba35ee8318e1011c4801139426
[hcoop/domtool2.git] / src / main-client.sml
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 (* Driver for configuration requests *)
20
21 val () = Domain.declareClient ()
22
23 fun uid () =
24 case Posix.ProcEnv.getenv "DOMTOOL_USER" of
25 NONE => Posix.ProcEnv.getuid ()
26 | SOME user => Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam user)
27
28 fun domtoolRoot () =
29 let
30 val dname = Posix.SysDB.Passwd.home (Posix.SysDB.getpwuid (uid ()))
31 in
32 OS.Path.joinDirFile {dir = dname,
33 file = ".domtool"}
34 end
35
36 fun libnameOpt () =
37 let
38 val libname = OS.Path.joinDirFile {dir = domtoolRoot (),
39 file = "lib.dtl"}
40 in
41 if Posix.FileSys.access (libname, []) then
42 SOME libname
43 else
44 NONE
45 end
46
47 val (tc, fake, args) = foldl (fn (arg, (tc, fake, args)) =>
48 case arg of
49 "-tc" => (true, fake, args)
50 | "-fake" => (tc, true, args)
51 | _ => (tc, fake, arg :: args))
52 (false, false, []) (CommandLine.arguments ())
53
54 val args = rev args
55
56 val (doit, doitDir) =
57 if tc then
58 (fn fname =>
59 let
60 val _ : string = Main.setupUser ()
61 val () = if fake then
62 Domain.fakePrivileges ()
63 else
64 ()
65 val env = Main.basis ()
66 val env =
67 case libnameOpt () of
68 NONE => env
69 | SOME libname => #1 (Main.check env libname)
70 in
71 ignore (Main.check env fname)
72 end,
73 Main.checkDir)
74 else
75 (fn fname => Main.request (fname, libnameOpt ()),
76 Main.requestDir)
77
78 val _ =
79 case args of
80 [fname] =>
81 if Posix.FileSys.access (fname, []) then
82 doit fname
83 else
84 doit (OS.Path.joinDirFile {dir = domtoolRoot (),
85 file = fname})
86 | [] => doitDir (domtoolRoot ())
87 | _ => print "Invalid command-line arguments\n"