X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/e1b99e23f8d30efc7842ee006e0ff3ef0347b7df..8ca17b9a328732cac9ccd9e1c96c8d35777afe88:/src/main-client.sml diff --git a/src/main-client.sml b/src/main-client.sml index f0a6f69..642e35f 100644 --- a/src/main-client.sml +++ b/src/main-client.sml @@ -18,19 +18,62 @@ (* Driver for configuration requests *) +val () = Domain.declareClient () + +fun uid () = + case Posix.ProcEnv.getenv "DOMTOOL_USER" of + NONE => Posix.ProcEnv.getuid () + | SOME user => Posix.SysDB.Passwd.uid (Posix.SysDB.getpwnam user) + fun domtoolRoot () = let - val uid = Posix.ProcEnv.getuid () - val dname = Posix.SysDB.Passwd.home (Posix.SysDB.getpwuid uid) + val dname = Posix.SysDB.Passwd.home (Posix.SysDB.getpwuid (uid ())) in OS.Path.joinDirFile {dir = dname, - file = "domtool"} + file = ".domtool"} end -val (doit, args) = - case CommandLine.arguments () of - "-tc" :: args => (fn fname => (Main.setupUser (); ignore (Main.check fname)), args) - | args => (Main.request, args) +fun libnameOpt () = + let + val libname = OS.Path.joinDirFile {dir = domtoolRoot (), + file = "lib.dtl"} + in + if Posix.FileSys.access (libname, []) then + SOME libname + else + NONE + end + +val (tc, fake, args) = foldl (fn (arg, (tc, fake, args)) => + case arg of + "-tc" => (true, fake, args) + | "-fake" => (tc, true, args) + | _ => (tc, fake, arg :: args)) + (false, false, []) (CommandLine.arguments ()) + +val args = rev args + +val (doit, doitDir) = + if tc then + (fn fname => + let + val _ : string = Main.setupUser () + val () = if fake then + Domain.fakePrivileges () + else + () + val env = Main.basis () + val env = + case libnameOpt () of + NONE => env + | SOME libname => #1 (Main.check env libname) + in + ignore (Main.check env fname) + end, + Main.checkDir) + else + (fn fname => Main.request (fname, libnameOpt ()), + Main.requestDir) val _ = case args of @@ -40,5 +83,5 @@ val _ = else doit (OS.Path.joinDirFile {dir = domtoolRoot (), file = fname}) - | [] => Main.requestDir (domtoolRoot ()) + | [] => doitDir (domtoolRoot ()) | _ => print "Invalid command-line arguments\n"