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 90b92baa1b13a83ab5a69a4ea7c420f46ba090cf..289494a84db3a741c3203cb92b88b52047903e7c 100644 (file)
--- 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"))