From a0023d57973a3daa73d34256dd0ed28955fb7c3a Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Tue, 25 Jun 2019 14:31:58 -0600 Subject: [PATCH] fix `environment-variables-copy` and case-normalization Preserve the original case of an environment variable for round-tripping on systems where environment variable names are case-normalized. --- pkgs/racket-test-core/tests/racket/file.rktl | 14 ++++-- racket/src/io/envvar/main.rkt | 33 +++++++++----- racket/src/racket/src/string.c | 45 +++++++++++++------- 3 files changed, 62 insertions(+), 30 deletions(-) diff --git a/pkgs/racket-test-core/tests/racket/file.rktl b/pkgs/racket-test-core/tests/racket/file.rktl index 35a4cdb464..61a66f7c63 100644 --- a/pkgs/racket-test-core/tests/racket/file.rktl +++ b/pkgs/racket-test-core/tests/racket/file.rktl @@ -1405,9 +1405,7 @@ (test #f environment-variables-ref env #"BANANA") (test #f getenv "BANANA") - (let ([apple (if (eq? 'windows (system-type)) - #"apple" - #"APPLE")]) + (let ([apple #"APPLE"]) (test apple car (member apple (environment-variables-names env)))) (test #f member #"BANANA" (environment-variables-names env)) (test #f member #"banana" (environment-variables-names env))) @@ -1418,6 +1416,16 @@ (env-var-tests)) (env-var-tests) +;; Partly a test of case-normalization: +(let* ([e (current-environment-variables)] + [e2 (environment-variables-copy e)] + [names2 (environment-variables-names e2)]) + (test (length (environment-variables-names e)) length names2) + (for ([k (in-list (environment-variables-names e))]) + (test #t 'name (and (member k names2) #t)) + (test (environment-variables-ref e k) + environment-variables-ref e2 k))) + (arity-test getenv 1 1) (arity-test putenv 2 2) diff --git a/racket/src/io/envvar/main.rkt b/racket/src/io/envvar/main.rkt index 666f845fca..72314de6c4 100644 --- a/racket/src/io/envvar/main.rkt +++ b/racket/src/io/envvar/main.rkt @@ -13,6 +13,9 @@ environment-variables-copy environment-variables-names) +;; Keep a mapping from normalized to (cons ). +;; That way, we can find values based on the normalized key, +;; but we preserve the original case. (struct environment-variables ([ht #:mutable]) ; #f => use OS-level environment variables #:authentic) @@ -43,7 +46,7 @@ (bytes->immutable-bytes val0) val0)) (check who bytes-no-nuls? val) - (loop (cddr args) (hash-set ht (normalize-key key) val))])]))) + (loop (cddr args) (hash-set ht (normalize-key key) (cons key val)))])]))) (define/who (environment-variables-ref e k) (check who environment-variables? e) @@ -60,7 +63,7 @@ (end-atomic) s] [else - (hash-ref ht (normalize-key k) #f)])) + (cdr (hash-ref ht (normalize-key k) '(#f . #f)))])) (define none (gensym 'none)) @@ -83,7 +86,9 @@ [else (fail)]))] [else (define nk (normalize-key k)) - (set-environment-variables-ht! e (if v (hash-set ht nk v) (hash-remove ht nk)))])) + (set-environment-variables-ht! e (if v + (hash-set ht nk (cons k v)) + (hash-remove ht nk)))])) (define/who (environment-variables-copy e) (check who environment-variables? e) @@ -101,13 +106,17 @@ (for/hash ([i (in-range (rktio_envvars_count rktio ev))]) (define k (rktio_envvars_name_ref rktio ev i)) (define v (rktio_envvars_value_ref rktio ev i)) + (define case-k + (begin0 + (bytes->immutable-bytes (rktio_to_bytes k)) + (rktio_free k))) (values - (begin0 - (bytes->immutable-bytes (rktio_to_bytes k)) - (rktio_free k)) - (begin0 - (bytes->immutable-bytes (rktio_to_bytes v)) - (rktio_free v)))) + (normalize-key case-k) + (cons + case-k + (begin0 + (bytes->immutable-bytes (rktio_to_bytes v)) + (rktio_free v))))) (rktio_envvars_free rktio ev))])) (end-atomic) (environment-variables ht)] @@ -120,6 +129,8 @@ (define ht (environment-variables-ht e)) (cond [(not ht) - (map normalize-key (environment-variables-names (environment-variables-copy e)))] + (environment-variables-names (environment-variables-copy e))] [else - (hash-keys ht)])) + ;; Return unnormalized keys, which makes sense for preserving + ;; the original case + (map car (hash-values ht))])) diff --git a/racket/src/racket/src/string.c b/racket/src/racket/src/string.c index 9ffd8d2091..7519783339 100644 --- a/racket/src/racket/src/string.c +++ b/racket/src/racket/src/string.c @@ -2030,6 +2030,10 @@ int scheme_any_string_has_null(Scheme_Object *o) /* Environment Variables */ /***********************************************************************/ +/* A `scheme_environment_variables_type` record wraps a hash table + that maps normalized keys to (cons ), where the key + in the pair preserves its original case. */ + #define SCHEME_ENVVARS_TABLE(ev) ((Scheme_Hash_Tree *)SCHEME_PTR_VAL(ev)) Scheme_Object *scheme_make_environment_variables(Scheme_Hash_Tree *ht) @@ -2146,13 +2150,13 @@ static Scheme_Object *sch_getenv(int argc, Scheme_Object *argv[]) } else { bs = normalize_env_case(bs); val = scheme_hash_tree_get(ht, bs); - return val ? val : scheme_false; + return val ? SCHEME_CDR(val) : scheme_false; } } static Scheme_Object *sch_putenv(int argc, Scheme_Object *argv[]) { - Scheme_Object *varbs, *valbs, *ev; + Scheme_Object *varbs, *valbs, *norm_varbs, *ev; Scheme_Hash_Tree *ht; char *var; char *val; @@ -2177,14 +2181,20 @@ static Scheme_Object *sch_putenv(int argc, Scheme_Object *argv[]) ht = SCHEME_ENVVARS_TABLE(ev); if (ht) { - varbs = normalize_env_case(varbs); + norm_varbs = normalize_env_case(varbs); if (SCHEME_FALSEP(valbs)) { - ht = scheme_hash_tree_set(ht, varbs, NULL); + ht = scheme_hash_tree_set(ht, norm_varbs, NULL); } else { - varbs = byte_string_to_immutable(1, &varbs); + if (SAME_OBJ(varbs, norm_varbs)) { + varbs = byte_string_to_immutable(1, &varbs); + norm_varbs = varbs; + } else { + varbs = byte_string_to_immutable(1, &varbs); + norm_varbs = byte_string_to_immutable(1, &norm_varbs); + } valbs = byte_string_to_immutable(1, &valbs); - ht = scheme_hash_tree_set(ht, varbs, valbs); + ht = scheme_hash_tree_set(ht, norm_varbs, scheme_make_pair(varbs, valbs)); } SCHEME_PTR_VAL(ev) = (Scheme_Object *)ht; @@ -2230,14 +2240,16 @@ static Scheme_Object *env_copy(int argc, Scheme_Object *argv[]) { intptr_t i; rktio_envvars_t *envvars; - Scheme_Object *var, *val; + Scheme_Object *var, *val, *norm_var; envvars = rktio_envvars(scheme_rktio); for (i = rktio_envvars_count(scheme_rktio, envvars); i--; ) { var = scheme_make_immutable_sized_byte_string(rktio_envvars_name_ref(scheme_rktio, envvars, i), -1, 1); val = scheme_make_immutable_sized_byte_string(rktio_envvars_value_ref(scheme_rktio, envvars, i), -1, 1); - var = normalize_env_case(var); - ht = scheme_hash_tree_set(ht, var, val); + norm_var = normalize_env_case(var); + if (!SAME_OBJ(var, norm_var)) + norm_var = byte_string_to_immutable(1, &norm_var); + ht = scheme_hash_tree_set(ht, norm_var, scheme_make_pair(var, val)); } rktio_envvars_free(scheme_rktio, envvars); @@ -2249,7 +2261,7 @@ static Scheme_Object *env_copy(int argc, Scheme_Object *argv[]) static Scheme_Object *env_make(int argc, Scheme_Object *argv[]) { Scheme_Hash_Tree *ht; - Scheme_Object *varbs, *valbs; + Scheme_Object *varbs, *valbs, *norm_varbs; int i; ht = scheme_make_hash_tree(SCHEME_hashtr_equal); @@ -2274,11 +2286,12 @@ static Scheme_Object *env_make(int argc, Scheme_Object *argv[]) || scheme_byte_string_has_null(valbs))) scheme_wrong_contract("make-environment-variables", "(or/c bytes-no-nuls? #f)", i+1, argc, argv); - varbs = normalize_env_case(varbs); - varbs = byte_string_to_immutable(1, &varbs); valbs = byte_string_to_immutable(1, &valbs); - ht = scheme_hash_tree_set(ht, varbs, valbs); + norm_varbs = normalize_env_case(varbs); + if (!SAME_OBJ(varbs, norm_varbs)) + norm_varbs = byte_string_to_immutable(1, &norm_varbs); + ht = scheme_hash_tree_set(ht, norm_varbs, scheme_make_pair(varbs, valbs)); } return scheme_make_environment_variables(ht); @@ -2302,7 +2315,7 @@ static Scheme_Object *sch_getenv_names(int argc, Scheme_Object *argv[]) for (i = scheme_hash_tree_next(ht, -1); i != -1; i = scheme_hash_tree_next(ht, i)) { scheme_hash_tree_index(ht, i, &key, &val); - r = scheme_make_pair(key, r); + r = scheme_make_pair(SCHEME_CAR(val), r); } return r; @@ -2325,8 +2338,8 @@ rktio_envvars_t *scheme_environment_variables_to_envvars(Scheme_Object *ev) rktio_envvars_set(scheme_rktio, envvars, - SCHEME_BYTE_STR_VAL(key), - SCHEME_BYTE_STR_VAL(val)); + SCHEME_BYTE_STR_VAL(SCHEME_CAR(val)), + SCHEME_BYTE_STR_VAL(SCHEME_CDR(val))); } return envvars;