diff --git a/pkgs/racket-doc/scribblings/raco/info.scrbl b/pkgs/racket-doc/scribblings/raco/info.scrbl index 97db62f589..89d58cce55 100644 --- a/pkgs/racket-doc/scribblings/raco/info.scrbl +++ b/pkgs/racket-doc/scribblings/raco/info.scrbl @@ -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].}] diff --git a/pkgs/racket-doc/scribblings/raco/setup.scrbl b/pkgs/racket-doc/scribblings/raco/setup.scrbl index 06dcf8c408..d246debb51 100644 --- a/pkgs/racket-doc/scribblings/raco/setup.scrbl +++ b/pkgs/racket-doc/scribblings/raco/setup.scrbl @@ -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?)) diff --git a/racket/collects/setup/getinfo.rkt b/racket/collects/setup/getinfo.rkt index 0c81b0e0cb..fe802c5430 100644 --- a/racket/collects/setup/getinfo.rkt +++ b/racket/collects/setup/getinfo.rkt @@ -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 diff --git a/racket/collects/setup/infotab.rkt b/racket/collects/setup/infotab.rkt index 101be5e928..a107ef1e05 100644 --- a/racket/collects/setup/infotab.rkt +++ b/racket/collects/setup/infotab.rkt @@ -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))