From 86e132be99dcdbf2271119267cea6b91eb8207c3 Mon Sep 17 00:00:00 2001
From: Adam Chlipala <adamc@hcoop.net>
Date: Sat, 17 Nov 2007 13:51:22 +0000
Subject: [PATCH 1/1] Make 'domtool -tc' (no other arguments) work properly

---
 src/main-client.sml | 20 ++++++++++++++------
 src/main.sml        | 42 +++++++++++++++++++++++-------------------
 2 files changed, 37 insertions(+), 25 deletions(-)

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"
diff --git a/src/main.sml b/src/main.sml
index 4198901..f32fa2d 100644
--- 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 ()
 
-- 
2.20.1