X-Git-Url: https://git.hcoop.net/hcoop/domtool2.git/blobdiff_plain/e903f39884591490f7a023a730149cb1894b499d..86e132be99dcdbf2271119267cea6b91eb8207c3:/src/main-client.sml

diff --git a/src/main-client.sml b/src/main-client.sml
index 1aa1a0f..8d5f012 100644
--- a/src/main-client.sml
+++ b/src/main-client.sml
@@ -18,19 +18,27 @@
 
 (* 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"}
     end
 
-val (doit, args) =
+val (doit, doitDir, args) =
     case CommandLine.arguments () of
-	"-tc" :: args => (fn fname => (Main.setupUser (); ignore (Main.check fname)), args)
-      | args => (Main.request, args)
+	"-tc" :: args => (fn fname => (Main.setupUser (); ignore (Main.check fname)),
+			  Main.checkDir,
+			  args)
+      | args => (Main.request,
+		 Main.requestDir,
+		 args)
 
 val _ =
     case args of
@@ -40,5 +48,5 @@ val _ =
 	else
 	    doit (OS.Path.joinDirFile {dir = domtoolRoot (),
 				       file = fname})
-      | [] => Main.requestDir (domtoolRoot ())
+      | [] => doitDir (domtoolRoot ())
       | _ => print "Invalid command-line arguments\n"