avoid cross-namespace submodule pollution via module-code cache

When a module is loaded with submodules intact, it should not be
cached and used for a later load that is intended to obtain the
module without submodules. Avoid mismatches by constraining the
cache to modules without submodules.
This commit is contained in:
Matthew Flatt 2014-08-11 10:26:09 +01:00
parent 1d6a9078d4
commit c4508ad0d9
3 changed files with 59 additions and 2 deletions

View File

@ -1159,6 +1159,63 @@
(parameterize ([current-namespace (make-base-namespace)]) (parameterize ([current-namespace (make-base-namespace)])
(eval (mk m wrap?))))) (eval (mk m wrap?)))))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Check that module caching doesn't cause submodules
;; to be loaded/declared too early
(let ()
(define dir (find-system-path 'temp-dir))
(define tmx (build-path dir "tmx.rkt"))
(define e (compile '(module tmx racket/base
(module s racket/base
(provide x)
(define x 1)))))
(make-directory* (build-path dir "compiled"))
(define zo-path (build-path dir "compiled" "tmx_rkt.zo"))
(define (install-module-hashes! s start len c)
(define vlen (bytes-ref s (+ start 2)))
(define mode (integer->char (bytes-ref s (+ start 3 vlen))))
(case mode
[(#\T)
(define h (make-bytes 20 (+ 42 c)))
(bytes-copy! s (+ start 4 vlen) h)]
[(#\D)
(define (read-num rel-pos)
(define pos (+ start rel-pos))
(integer-bytes->integer s #t #f pos (+ pos 4)))
(define count (read-num (+ 4 vlen)))
(for/fold ([pos (+ 8 vlen)]) ([i (in-range count)])
(define pos-pos (+ pos 4 (read-num pos)))
(define mod-start (read-num pos-pos))
(define mod-len (read-num (+ pos-pos 4)))
(install-module-hashes! s (+ start mod-start) mod-len i)
(+ pos-pos 16))
(void)]
[else (error "unknown")]))
(define bstr
(let ([b (open-output-bytes)])
(write e b)
(let* ([s (get-output-bytes b)])
(install-module-hashes! s 0 (bytes-length s) 0)
s)))
(call-with-output-file zo-path
#:exists 'truncate
(lambda (o)
(write-bytes bstr o)))
(parameterize ([current-namespace (make-base-namespace)]
[current-module-declare-name (make-resolved-module-path tmx)]
[current-load-relative-directory dir])
(eval (parameterize ([read-accept-compiled #t])
(read (open-input-bytes bstr)))))
(parameterize ([current-namespace (make-base-namespace)])
(dynamic-require tmx #f)
(test #f module-declared? `(submod ,tmx s) #f)
(test 1 dynamic-require `(submod ,tmx s) 'x))
(delete-file zo-path))
;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(report-errs) (report-errs)

View File

@ -6497,7 +6497,7 @@ static Scheme_Object *do_module_execute(Scheme_Object *data, Scheme_Env *genv,
m = MALLOC_ONE_TAGGED(Scheme_Module); m = MALLOC_ONE_TAGGED(Scheme_Module);
memcpy(m, data, sizeof(Scheme_Module)); memcpy(m, data, sizeof(Scheme_Module));
if (set_cache && m->code_key) { if (set_cache && m->code_key && !m->pre_submodules && !m->post_submodules) {
if (!scheme_module_code_cache) { if (!scheme_module_code_cache) {
REGISTER_SO(scheme_module_code_cache); REGISTER_SO(scheme_module_code_cache);
scheme_module_code_cache = scheme_make_weak_equal_table(); scheme_module_code_cache = scheme_make_weak_equal_table();

View File

@ -4544,7 +4544,7 @@ static Scheme_Object *do_load_handler(void *data)
} }
} }
if (scheme_module_code_cache) { if (scheme_module_code_cache && SCHEME_TRUEP(modname)) {
intptr_t got; intptr_t got;
int vers_size, hash_header_size; int vers_size, hash_header_size;
# define HASH_HEADER_SIZE (4 + 20 + 16) # define HASH_HEADER_SIZE (4 + 20 + 16)