From e4ce0d033150a4523d0bd76c7b16fccefd9081a3 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 25 Feb 2014 14:54:40 -0700 Subject: [PATCH] add PLTUSERHOME The new `PLTUSERHOME` environment variable redirects all of the user-specific paths reported by `find-system-path`. Also, improve the tests for `raco exe` (particularly the bug fixed in 6cb6f3fbf1) using `PLTUSERHOME`. --- .../tests/compiler/embed/test.rkt | 44 +++++++------ .../scribblings/reference/filesystem.scrbl | 66 +++++++++++-------- racket/src/racket/src/file.c | 55 ++++++++++------ 3 files changed, 97 insertions(+), 68 deletions(-) diff --git a/pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/test.rkt b/pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/test.rkt index 6588421ca8..c56c8fd9e5 100644 --- a/pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/test.rkt +++ b/pkgs/compiler-pkgs/compiler-test/tests/compiler/embed/test.rkt @@ -53,28 +53,30 @@ (let ([plthome (getenv "PLTHOME")] [collects (getenv "PLTCOLLECTS")] [out (open-output-string)]) + (define temp-home-dir (make-temporary-file "racket-tmp-home~a" 'directory)) ;; Try to hide usual collections: - (when plthome - (putenv "PLTHOME" (path->string (build-path (find-system-path 'temp-dir) "NOPE")))) - (when collects - (putenv "PLTCOLLECTS" (path->string (build-path (find-system-path 'temp-dir) "NOPE")))) - ;; Execute: - (parameterize ([current-directory (find-system-path 'temp-dir)]) - (when (file-exists? "stdout") - (delete-file "stdout")) - (let ([path (if (and mred? (eq? 'macosx (system-type))) - (let-values ([(base name dir?) (split-path exe)]) - (build-path exe "Contents" "MacOS" - (path-replace-suffix name #""))) - exe)]) - (test #t - path - (parameterize ([current-output-port out]) - (system* path))))) - (when plthome - (putenv "PLTHOME" plthome)) - (when collects - (putenv "PLTCOLLECTS" collects)) + (parameterize ([current-environment-variables + (environment-variables-copy + (current-environment-variables))]) + (putenv "PLTUSERHOME" (path->string temp-home-dir)) + (when plthome + (putenv "PLTHOME" (path->string (build-path (find-system-path 'temp-dir) "NOPE")))) + (when collects + (putenv "PLTCOLLECTS" (path->string (build-path (find-system-path 'temp-dir) "NOPE")))) + ;; Execute: + (parameterize ([current-directory (find-system-path 'temp-dir)]) + (when (file-exists? "stdout") + (delete-file "stdout")) + (let ([path (if (and mred? (eq? 'macosx (system-type))) + (let-values ([(base name dir?) (split-path exe)]) + (build-path exe "Contents" "MacOS" + (path-replace-suffix name #""))) + exe)]) + (test #t + path + (parameterize ([current-output-port out]) + (system* path)))))) + (delete-directory/files temp-home-dir) (let ([stdout-file (build-path (find-system-path 'temp-dir) "stdout")]) (if (file-exists? stdout-file) (test expect with-input-from-file stdout-file diff --git a/pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl b/pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl index 507bf4bec4..e9cc71ab11 100644 --- a/pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl +++ b/pkgs/racket-pkgs/racket-doc/scribblings/reference/filesystem.scrbl @@ -21,17 +21,23 @@ by @racket[kind], which must be one of the following: @itemize[ - @item{@indexed-racket['home-dir] --- the current user's home - directory. + @item{@indexed-racket['home-dir] --- the current @deftech{user's home + directory}. - On Unix and Mac OS X, this directory is determined by expanding - the path @filepath{~}, which is expanded by first checking for a - @indexed-envvar{HOME} environment variable. If none is defined, the - @indexed-envvar{USER} and @indexed-envvar{LOGNAME} environment + On all platforms, if the @indexed-envvar{PLTUSERHOME} environment + variable is defined as a @tech{complete} path, then the path is used + as the user's home directory. + + On Unix and Mac OS X, when @envvar{PLTUSERHOME} does not apply, + the user's home directory is determined by + expanding the path @filepath{~}, which is expanded by first checking + for a @indexed-envvar{HOME} environment variable. If none is defined, + the @indexed-envvar{USER} and @indexed-envvar{LOGNAME} environment variables are consulted (in that order) to find a user name, and then system files are consulted to locate the user's home directory. - On Windows, the user's home directory is the user-specific profile + On Windows, when @envvar{PLTUSERHOME} does not apply, + the user's home directory is the user-specific profile directory as determined by the Windows registry. If the registry cannot provide a directory for some reason, the value of the @indexed-envvar{USERPROFILE} environment variable is used instead, as @@ -44,12 +50,14 @@ by @racket[kind], which must be one of the following: @item{@indexed-racket['pref-dir] --- the standard directory for storing the current user's preferences. On Unix, the directory is - @filepath{.racket} in the user's home directory. On Windows, it - is @filepath{Racket} in the user's application-data folder as - specified by the Windows registry; the application-data folder is - usually @filepath{Application Data} in the user's profile - directory. On Mac OS X, it is @filepath{Library/Preferences} in the - user's home directory. This directory might not exist.} + @filepath{.racket} in the @tech{user's home directory}. On Windows, + it is @filepath{Racket} in the @tech{user's home directory} if + determined by @envvar{PLTUSERHOME}, otherwise in the user's + application-data folder as specified by the Windows registry; the + application-data folder is usually @filepath{Application Data} in the + user's profile directory. On Mac OS X, the preferences directory + is @filepath{Library/Preferences} in the + @tech{user's home directory}. The preferences directory might not exist.} @item{@indexed-racket['pref-file] --- a file that contains a symbol-keyed association list of preference values. The file's @@ -70,7 +78,7 @@ by @racket[kind], which must be one of the following: @item{@indexed-racket['init-dir] --- the directory containing the initialization file used by the Racket executable. - It is the same as the current user's home directory.} + It is the same as the @tech{user's home directory}.} @item{@indexed-racket['init-file] --- the file loaded at start-up by the Racket executable. The directory part of the @@ -103,24 +111,26 @@ by @racket[kind], which must be one of the following: overridden by the @DFlag{addon} or @Flag{A} command-line flag. If no environment variable or flag is specified, or if the value is not a legal path name, then this directory defaults to - @filepath{Library/Racket} in the user's home directory on Mac + @filepath{Library/Racket} in the @tech{user's home directory} on Mac OS X and @racket['pref-dir] otherwise. The directory might not exist.} @item{@indexed-racket['doc-dir] --- the standard directory for - storing the current user's documents. On Unix, it's the same as - @racket['home-dir]. On Mac OS X, it's the - @filepath{Documents} directory in the user's home directory. On - Windows, it is the user's documents folder as specified by the - Windows registry; the documents folder is usually @filepath{My Documents} - in the user's home directory.} + storing the current user's documents. On Unix, it's + the @tech{user's home directory}. On Windows, it is the @tech{user's + home directory} if determined by @envvar{PLTUSERHOME}, otherwise it + is the user's documents folder as specified by the Windows registry; + the documents folder is usually @filepath{My Documents} in the user's + home directory. On Mac OS X, it's the @filepath{Documents} directory + in the @tech{user's home directory}.} @item{@indexed-racket['desk-dir] --- the directory for the current user's - desktop. On Unix, it's the same as @racket['home-dir]. On - Windows, it is the user's desktop folder as specified by the Windows - registry; the documents folder is usually @filepath{Desktop} in the - user's home directory. On Mac OS X, it is the desktop directory, - which is specifically @filepath{~/Desktop} on Mac OS X.} + desktop. On Unix, it's the @tech{user's home directory}. On + Windows, it is the @tech{user's home directory} if determined by + @envvar{PLTUSERHOME}, otherwise it is the user's desktop folder as + specified by the Windows registry; the desktop folder is usually + @filepath{Desktop} in the user's home directory. On Mac OS X, it is + @filepath{Desktop} in the @tech{user's home directory}} @item{@indexed-racket['sys-dir] --- the directory containing the operating system for Windows. On @|AllUnix|, the @@ -157,7 +167,9 @@ by @racket[kind], which must be one of the following: from @racket[(find-system-path 'exec-file)] or @racket[(find-system-path 'run-file)] to a complete path.} - ]} + ] + +@history[#:changed "6.0.0.3" @elem{Added @envvar{PLTUSERHOME}.}]} @defproc[(path-list-string->path-list [str (or/c string? bytes?)] [default-path-list (listof path?)]) diff --git a/racket/src/racket/src/file.c b/racket/src/racket/src/file.c index ca7d57fb2c..25c471e85a 100644 --- a/racket/src/racket/src/file.c +++ b/racket/src/racket/src/file.c @@ -1847,7 +1847,7 @@ static char *do_expand_filename(Scheme_Object *o, char* filename, int ilen, cons char user[256], *home = NULL, *naya; struct passwd *who = NULL; int u, f, len, flen; - + for (u = 0, f = 1; u < 255 && filename[f] && filename[f] != '/'; u++, f++) { @@ -1867,13 +1867,13 @@ static char *do_expand_filename(Scheme_Object *o, char* filename, int ilen, cons if (!user[0]) { if (!(home = getenv("HOME"))) { char *ptr; - + ptr = getenv("USER"); if (!ptr) ptr = getenv("LOGNAME"); - + who = ptr ? getpwnam(ptr) : NULL; - + if (!who) who = getpwuid(getuid()); } @@ -6272,9 +6272,12 @@ find_system_path(int argc, Scheme_Object **argv) { /* Everything else is in ~: */ Scheme_Object *home; - char *home_str, *ex_home; + char *home_str, *ex_home, *alt_home; int ends_in_slash; + /* cast here avoids a clang warning: */ +# define mz_STR_OFFSET(s, d) ((const char *)s XFORM_OK_PLUS d) + if ((which == id_pref_dir) || (which == id_pref_file) || (which == id_addon_dir)) { @@ -6296,19 +6299,30 @@ find_system_path(int argc, Scheme_Object **argv) #endif home_str = "~/"; } - - ex_home = do_expand_filename(NULL, home_str, strlen(home_str), NULL, - NULL, - 0, 1, - 0, SCHEME_UNIX_PATH_KIND, - 1); - if (!ex_home) { - /* Something went wrong with the user lookup. Just drop "~'. */ - home = scheme_make_sized_offset_path(home_str, 1, -1, 1); - } else - home = scheme_make_path(ex_home); + alt_home = getenv("PLTUSERHOME"); + if (alt_home && scheme_is_complete_path(alt_home, strlen(alt_home), SCHEME_PLATFORM_PATH_KIND)) { + home = scheme_make_path(alt_home); + if (home_str[2]) { + Scheme_Object *a[2]; + a[0] = home; + a[1] = scheme_make_path(mz_STR_OFFSET(home_str, 2)); + home = scheme_build_path(2, a); + } else + home = scheme_path_to_directory_path(home); + } else { + ex_home = do_expand_filename(NULL, home_str, strlen(home_str), NULL, + NULL, + 0, 1, + 0, SCHEME_UNIX_PATH_KIND, + 1); + if (!ex_home) { + /* Something went wrong with the user lookup. Just drop "~'. */ + home = scheme_make_sized_offset_path(home_str, 1, -1, 1); + } else + home = scheme_make_path(ex_home); + } if ((which == id_pref_dir) || (which == id_init_dir) || (which == id_home_dir) || (which == id_addon_dir) @@ -6317,9 +6331,6 @@ find_system_path(int argc, Scheme_Object **argv) ends_in_slash = (SCHEME_PATH_VAL(home))[SCHEME_PATH_LEN(home) - 1] == '/'; - /* cast here avoids a clang warning: */ -# define mz_STR_OFFSET(s, d) ((const char *)s + d) - if (which == id_init_file) return append_path(home, scheme_make_path(mz_STR_OFFSET("/.racketrc", ends_in_slash))); if (which == id_pref_file) { @@ -6359,7 +6370,11 @@ find_system_path(int argc, Scheme_Object **argv) home = NULL; - { + p = getenv("PLTUSERHOME"); + if (p && scheme_is_complete_path(p, strlen(p), SCHEME_PLATFORM_PATH_KIND)) + home = scheme_path_to_directory_path(scheme_make_path(p)); + + if (!home) { /* Try to get Application Data directory: */ LPITEMIDLIST items; int which_folder;