X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/c53e82e40cef407de986aa329d31457915ad0dbe..9a34b0017d95d8ff3563a0afa583c92e6356ad6f:/src/main-client.sml diff --git a/src/main-client.sml b/src/main-client.sml index c70dfb8..1c6333d 100644 --- a/src/main-client.sml +++ b/src/main-client.sml @@ -16,24 +16,58 @@ * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA. *) -(* Driver for server *) +(* 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 home = Posix.SysDB.Passwd.home (Posix.SysDB.getpwuid uid) + val dname = Posix.SysDB.Passwd.home (Posix.SysDB.getpwuid (uid ())) in - OS.Path.joinDirFile {dir = home, - file = "domtool"} + OS.Path.joinDirFile {dir = dname, + file = ".domtool"} end -val _ = +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 (doit, doitDir, args) = case CommandLine.arguments () of + "-tc" :: args => (fn fname => + let + val _ : string = Main.setupUser () + 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, + args) + | args => (fn fname => Main.request (fname, libnameOpt ()), + 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"