From: Chris Hanson <org/chris-hanson/cph>
Date: Tue, 11 Nov 1997 12:52:15 +0000 (+0000)
Subject: Signal error when unable to determine user name or home directory.
X-Git-Tag: 20090517-FFI~4937
X-Git-Url: https://birchwood-abbey.net/git?a=commitdiff_plain;h=d2563b4e86e559c709493777c81d7c57c47b1de3;p=mit-scheme.git

Signal error when unable to determine user name or home directory.
---

diff --git a/v7/src/runtime/ntprm.scm b/v7/src/runtime/ntprm.scm
index 90b92baa1..289494a84 100644
--- a/v7/src/runtime/ntprm.scm
+++ b/v7/src/runtime/ntprm.scm
@@ -1,6 +1,6 @@
 #| -*-Scheme-*-
 
-$Id: ntprm.scm,v 1.12 1997/10/22 05:18:00 cph Exp $
+$Id: ntprm.scm,v 1.13 1997/11/11 12:52:15 cph Exp $
 
 Copyright (c) 1992-97 Massachusetts Institute of Technology
 
@@ -252,23 +252,23 @@ MIT in each case. |#
 	(and homedir
 	     (pathname-name
 	      (directory-pathname-as-file (directory-pathname homedir)))))
-      "nouser"))
+      (error "Unable to determine current user name.")))
 
 (define (user-home-directory user-name)
-  (or (and user-name
-	   (let ((try
-		  (lambda (directory)
-		    (pathname-as-directory
-		     (merge-pathnames user-name directory)))))
-	     (cond ((get-environment-variable "USERDIR")
-		    => (lambda (userdir)
-			 (try (pathname-as-directory
-			       (merge-pathnames userdir)))))
-		   ((nt/current-home-directory)
-		    => (lambda (homedir)
-			 (try (directory-pathname-as-file homedir))))
-		   (else #f))))
-      (merge-pathnames "\\")))
+  (let ((try
+	 (lambda (directory)
+	   (pathname-as-directory
+	    (merge-pathnames user-name directory)))))
+    (cond ((get-environment-variable "USERDIR")
+	   => (lambda (userdir)
+		(try (pathname-as-directory
+		      (merge-pathnames userdir)))))
+	  ((nt/current-home-directory)
+	   => (lambda (homedir)
+		(if (string=? user-name (current-user-name))
+		    homedir
+		    (try (directory-pathname-as-file homedir)))))
+	  (else (error "Unable to find user home directory:" user-name)))))
 
 (define (nt/current-home-directory)
   (let ((homedrive (get-environment-variable "HOMEDRIVE"))