The set of environment variables accessible via getenv
is
restricted through `get-info`, which prunes the environment variable set before it loads the "info.rkt" file. All environment variables are pruned except those listed in `PLT_INFO_ALLOW_VARS` (separated by semicolons). Related to emina/rosette#17.
This commit is contained in:
parent
6369e56709
commit
e1a5e41ddc
|
@ -33,12 +33,14 @@ declaration has a highly constrained form. It must match the following
|
|||
grammar of @racket[_info-module]:
|
||||
|
||||
@racketgrammar*[
|
||||
#:literals (info lib setup/infotab module define quote quasiquote
|
||||
#:literals (info lib setup/infotab module define quote quasiquote if
|
||||
cons car cdr list list* reverse append
|
||||
string-append path->string build-path
|
||||
equal?
|
||||
make-immutable-hash hash hash-set hash-set* hash-remove hash-clear hash-update
|
||||
collection-path
|
||||
system-library-subpath)
|
||||
system-library-subpath
|
||||
getenv)
|
||||
[info-module (module info info-mod-path
|
||||
decl
|
||||
...)]
|
||||
|
@ -53,6 +55,7 @@ grammar of @racket[_info-module]:
|
|||
[decl (define id info-expr)]
|
||||
[info-expr (@#,racket[quote] datum)
|
||||
(@#,racket[quasiquote] datum)
|
||||
(if info-expr info-expr info-expr)
|
||||
(info-primitive info-expr ...)
|
||||
id
|
||||
string
|
||||
|
@ -60,10 +63,12 @@ grammar of @racket[_info-module]:
|
|||
boolean]
|
||||
[info-primitive cons car cdr list
|
||||
list* reverse append
|
||||
equal?
|
||||
string-append
|
||||
make-immutable-hash hash hash-set hash-set* hash-remove hash-clear hash-update
|
||||
path->string build-path collection-path
|
||||
system-library-subpath]
|
||||
system-library-subpath
|
||||
getenv]
|
||||
]
|
||||
|
||||
For example, the following declaration could be the @filepath{info.rkt}
|
||||
|
@ -82,5 +87,13 @@ As illustrated in this example, an @filepath{info.rkt} file can use
|
|||
@hash-lang[] notation, but only with the @racketmodname[info] (or
|
||||
@racketmodname[setup/infotab]) language.
|
||||
|
||||
Although @racket[getenv] is allowed in an @racketmodname[info] module,
|
||||
the @racket[get-info] function loads the module with an environment that
|
||||
prunes any variable not listed in the @indexed-envvar{PLT_INFO_ALLOW_VARS}
|
||||
environment variable, which holds a list of @litchar{;}-separated
|
||||
variable names. By default, the set of allowed environment variables
|
||||
is empty.
|
||||
|
||||
See also @racket[get-info] from @racketmodname[setup/getinfo].
|
||||
|
||||
@history[#:changed "6.5.0.2" @elem{Added @racket[if], @racket[equal?], and @racket[getenv].}]
|
||||
|
|
|
@ -1536,7 +1536,16 @@ function for installing a single @filepath{.plt} file.
|
|||
@racketmodname[info] and @racketmodname[setup/infotab] modules are
|
||||
attached to @racket[namespace] from the namespace of
|
||||
@racket[get-info/full] before attempting to load
|
||||
@filepath{info.rkt} (or @filepath{info.ss}).}
|
||||
@filepath{info.rkt} (or @filepath{info.ss}).
|
||||
|
||||
As the module is loaded, the @tech[#:doc reference-doc]{environment variable set}
|
||||
is pruned to contain only environment variables that are listed in the
|
||||
@envvar{PLT_INFO_ALLOW_VARS} environment variable, which contains a
|
||||
@litchar{;}-separated list of names. By default, the list of allowed
|
||||
variable names is empty.
|
||||
|
||||
@history[#:changed "6.5.0.2" @elem{Added environment-variable
|
||||
pruning and @envvar{PLT_INFO_ALLOW_VARS} support.}]}
|
||||
|
||||
@defproc[(find-relevant-directories
|
||||
(syms (listof symbol?))
|
||||
|
|
|
@ -107,48 +107,62 @@
|
|||
;; that is required).
|
||||
;; We are, however, trusting that the bytecode form of the
|
||||
;; file (if any) matches the source.
|
||||
(let ([ns (or ns (info-namespace))])
|
||||
(if (and bootstrap?
|
||||
(parameterize ([current-namespace ns])
|
||||
(not (module-declared? file))))
|
||||
;; Attach `info' language modules to target namespace, and
|
||||
;; disable the use of compiled bytecode if it fails; we
|
||||
;; need a trial namespace to try loading bytecode, since
|
||||
;; the use of bytecode "sticks" for later attempts.
|
||||
(let ([attach!
|
||||
(lambda (ns)
|
||||
(namespace-attach-module enclosing-ns 'setup/infotab ns)
|
||||
(namespace-attach-module enclosing-ns 'setup/infotab/lang/reader ns)
|
||||
(namespace-attach-module enclosing-ns 'info ns)
|
||||
(namespace-attach-module enclosing-ns '(submod info reader) ns))]
|
||||
[try
|
||||
(lambda (ns)
|
||||
(parameterize ([current-namespace ns])
|
||||
(dynamic-require file '#%info-lookup)))])
|
||||
(define ns-id (namespace-module-registry ns))
|
||||
((with-handlers ([exn:fail? (lambda (exn)
|
||||
;; Trial namespace is damaged, so uncache:
|
||||
(hash-set! trial-namespaces ns-id #f)
|
||||
;; Try again from source:
|
||||
(lambda ()
|
||||
(attach! ns)
|
||||
(parameterize ([use-compiled-file-paths null])
|
||||
(try ns))))])
|
||||
;; To reduce the cost of the trial namespace, try to used a cached
|
||||
;; one previously generated for the `ns':
|
||||
(define try-ns (or (hash-ref trial-namespaces ns-id #f)
|
||||
(let ([try-ns (make-base-empty-namespace)])
|
||||
(attach! try-ns)
|
||||
try-ns)))
|
||||
(define v (try try-ns))
|
||||
(hash-set! trial-namespaces ns-id try-ns)
|
||||
(namespace-attach-module try-ns file ns)
|
||||
(lambda () v))))
|
||||
;; Can use compiled bytecode, etc.:
|
||||
(parameterize ([current-namespace ns])
|
||||
(dynamic-require file '#%info-lookup))))])]
|
||||
(parameterize ([current-environment-variables
|
||||
(filter-environment-variables
|
||||
(current-environment-variables))])
|
||||
(let ([ns (or ns (info-namespace))])
|
||||
(if (and bootstrap?
|
||||
(parameterize ([current-namespace ns])
|
||||
(not (module-declared? file))))
|
||||
;; Attach `info' language modules to target namespace, and
|
||||
;; disable the use of compiled bytecode if it fails; we
|
||||
;; need a trial namespace to try loading bytecode, since
|
||||
;; the use of bytecode "sticks" for later attempts.
|
||||
(let ([attach!
|
||||
(lambda (ns)
|
||||
(namespace-attach-module enclosing-ns 'setup/infotab ns)
|
||||
(namespace-attach-module enclosing-ns 'setup/infotab/lang/reader ns)
|
||||
(namespace-attach-module enclosing-ns 'info ns)
|
||||
(namespace-attach-module enclosing-ns '(submod info reader) ns))]
|
||||
[try
|
||||
(lambda (ns)
|
||||
(parameterize ([current-namespace ns])
|
||||
(dynamic-require file '#%info-lookup)))])
|
||||
(define ns-id (namespace-module-registry ns))
|
||||
((with-handlers ([exn:fail? (lambda (exn)
|
||||
;; Trial namespace is damaged, so uncache:
|
||||
(hash-set! trial-namespaces ns-id #f)
|
||||
;; Try again from source:
|
||||
(lambda ()
|
||||
(attach! ns)
|
||||
(parameterize ([use-compiled-file-paths null])
|
||||
(try ns))))])
|
||||
;; To reduce the cost of the trial namespace, try to used a cached
|
||||
;; one previously generated for the `ns':
|
||||
(define try-ns (or (hash-ref trial-namespaces ns-id #f)
|
||||
(let ([try-ns (make-base-empty-namespace)])
|
||||
(attach! try-ns)
|
||||
try-ns)))
|
||||
(define v (try try-ns))
|
||||
(hash-set! trial-namespaces ns-id try-ns)
|
||||
(namespace-attach-module try-ns file ns)
|
||||
(lambda () v))))
|
||||
;; Can use compiled bytecode, etc.:
|
||||
(parameterize ([current-namespace ns])
|
||||
(dynamic-require file '#%info-lookup)))))])]
|
||||
[else (err "does not contain a module of the right shape")])))
|
||||
|
||||
(define (filter-environment-variables ev)
|
||||
(let ([keep (environment-variables-ref ev #"PLT_INFO_ALLOW_VARS")]
|
||||
[new-ev (make-environment-variables)])
|
||||
(when keep
|
||||
(for ([n (in-list (regexp-split #rx#";" keep))]
|
||||
#:when (bytes-environment-variable-name? n))
|
||||
(define v (environment-variables-ref ev n))
|
||||
(when v
|
||||
(environment-variables-set! new-ev n v))))
|
||||
new-ev))
|
||||
|
||||
(define info-namespace
|
||||
;; To avoid loading modules into the current namespace
|
||||
;; when get-info is called, load info modules in a separate
|
||||
|
|
|
@ -60,12 +60,14 @@
|
|||
|
||||
(provide (rename-out [info-module-begin #%module-begin])
|
||||
#%app #%datum #%top
|
||||
define quote
|
||||
define quote if
|
||||
list cons car cdr quasiquote unquote unquote-splicing
|
||||
list* append reverse
|
||||
list* append reverse
|
||||
equal?
|
||||
make-immutable-hash hash hash-set hash-set* hash-remove hash-clear hash-update
|
||||
string-append
|
||||
path->string build-path collection-path
|
||||
system-library-subpath
|
||||
(rename-out [limited-require require])
|
||||
lib))
|
||||
lib
|
||||
getenv))
|
||||
|
|
Loading…
Reference in New Issue
Block a user