X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/0da1c677dd0a079c9e985af37688cc9e833fc196..86e132be99dcdbf2271119267cea6b91eb8207c3:/src/main-client.sml diff --git a/src/main-client.sml b/src/main-client.sml index 29db1b4..8d5f012 100644 --- a/src/main-client.sml +++ b/src/main-client.sml @@ -18,22 +18,35 @@ (* Driver for configuration requests *) +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 _ = +val (doit, doitDir, args) = case CommandLine.arguments () of + "-tc" :: args => (fn fname => (Main.setupUser (); ignore (Main.check fname)), + Main.checkDir, + args) + | args => (Main.request, + Main.requestDir, + args) + +val _ = + case args of [fname] => if Posix.FileSys.access (fname, []) then - Main.request fname + doit fname else - Main.request (OS.Path.joinDirFile {dir = domtoolRoot (), - file = fname}) - | [] => Main.requestDir (domtoolRoot ()) + doit (OS.Path.joinDirFile {dir = domtoolRoot (), + file = fname}) + | [] => doitDir (domtoolRoot ()) | _ => print "Invalid command-line arguments\n"