suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

fix environment-variables-copy and case-normalization

Browse Source 
Preserve the original case of an environment variable for
round-tripping on systems where environment variable names are
case-normalized.
This commit is contained in:
Matthew Flatt 2019-06-25 14:31:58 -06:00
parent d4123698b4
commit a0023d5797
3 changed files with 62 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

14
pkgs/racket-test-core/tests/racket/file.rktl
View File

@ -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)

33
racket/src/io/envvar/main.rkt
View File

@ -13,6 +13,9 @@
environment-variables-copy
environment-variables-names)
;; Keep a mapping from normalized <key> to (cons <key> <val>).
;; 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))]))

45
racket/src/racket/src/string.c
View File

@ -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 <key> <val>), 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;