Make 'domtool -tc' (no other arguments) work properly

diff --git a/src/main-client.sml b/src/main-client.sml
index 1aa1a0f..8d5f012 100644 (file)
--- 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"

diff --git a/src/main.sml b/src/main.sml
index 4198901..f32fa2d 100644 (file)
--- a/src/main.sml
+++ b/src/main.sml
@@ -96,7 +96,24 @@ fun notTmp s =
     String.sub (s, 0) <> #"."
     andalso CharVector.all (fn ch => Char.isAlphaNum ch orelse ch = #"." orelse ch = #"_" orelse ch = #"-") s
 
-fun checkDir dname =
+fun setupUser () =
+    let
+       val user =
+           case Posix.ProcEnv.getenv "DOMTOOL_USER" of
+               NONE =>
+               let
+                   val uid = Posix.ProcEnv.getuid ()
+               in
+                   Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid uid)
+               end
+             | SOME user => user
+    in
+       Acl.read Config.aclFile;
+       Domain.setUser user;
+       user
+    end
+
+fun checkDir' dname =
     let
        val b = basis ()
 
@@ -127,6 +144,10 @@ fun checkDir dname =
                 ())
     end
 
+fun checkDir dname =
+    (setupUser ();
+     checkDir' dname)
+
 fun reduce fname =
     let
        val (G, body) = check fname
@@ -180,23 +201,6 @@ fun context x =
            print ("Additional information: " ^ s ^ "\n");
            raise e)
 
-fun setupUser () =
-    let
-       val user =
-           case Posix.ProcEnv.getenv "DOMTOOL_USER" of
-               NONE =>
-               let
-                   val uid = Posix.ProcEnv.getuid ()
-               in
-                   Posix.SysDB.Passwd.name (Posix.SysDB.getpwuid uid)
-               end
-             | SOME user => user
-    in
-       Acl.read Config.aclFile;
-       Domain.setUser user;
-       user
-    end
-
 fun requestContext f =
     let
        val user = setupUser ()
@@ -262,7 +266,7 @@ fun requestDir dname =
 
        val _ = ErrorMsg.reset ()
 
-       val (user, bio) = requestBio (fn () => checkDir dname)
+       val (user, bio) = requestBio (fn () => checkDir' dname)
 
        val b = basis ()