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:
Matthew Flatt 2016-04-15 09:54:26 -06:00
parent 6369e56709
commit e1a5e41ddc
4 changed files with 85 additions and 47 deletions

View File

@ -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].}]

View File

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

View File

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

View File

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