From 32becaf860dae08bd00418d4033b0842d47fc05b Mon Sep 17 00:00:00 2001 From: Robby Findler Date: Sun, 31 Jul 2011 12:18:51 -0400 Subject: [PATCH] added a #:security-guard argument to: managed-compile-zo make-caching-managed-compile-zo make-compilation-manager-load/use-compiled-handler that gets used when compiled files, dep files, and compiled/ directories are created. --- collects/compiler/cm.rkt | 62 ++++++++++++++++++---------- collects/scribblings/raco/make.scrbl | 31 ++++++++++---- 2 files changed, 64 insertions(+), 29 deletions(-) diff --git a/collects/compiler/cm.rkt b/collects/compiler/cm.rkt index a94836a11f..eb8edc0ad6 100644 --- a/collects/compiler/cm.rkt +++ b/collects/compiler/cm.rkt @@ -23,8 +23,8 @@ get-file-sha1 get-compiled-file-sha1 with-compile-output - parallel-lock-client + parallel-lock-client make-compile-lock compile-lock->parallel-lock-client) @@ -169,30 +169,42 @@ ;; closed and the file is reliably deleted if there's a break (define (with-compile-output path proc) (let ([bp (current-break-parameterization)] - [tmp-path (make-temporary-file "tmp~a" #f (path-only path))] + [tmp-path (with-compiler-security-guard (make-temporary-file "tmp~a" #f (path-only path)))] [ok? #f]) (dynamic-wind void (lambda () (begin0 - (let ([out (open-output-file tmp-path #:exists 'truncate/replace)]) + (let ([out (with-compiler-security-guard (open-output-file tmp-path #:exists 'truncate/replace))]) (dynamic-wind void (lambda () (call-with-break-parameterization bp (lambda () (proc out tmp-path)))) (lambda () - (close-output-port out)))) + (with-compiler-security-guard (close-output-port out))))) (set! ok? #t))) (lambda () - (if ok? - (if (eq? (system-type) 'windows) - (let ([tmp-path2 (make-temporary-file "tmp~a" #f (path-only path))]) - (with-handlers ([exn:fail:filesystem? void]) - (rename-file-or-directory path tmp-path2 #t)) - (rename-file-or-directory tmp-path path #t) - (try-delete-file tmp-path2)) - (rename-file-or-directory tmp-path path #t)) - (try-delete-file tmp-path)))))) + (with-compiler-security-guard + (if ok? + (if (eq? (system-type) 'windows) + (let ([tmp-path2 (make-temporary-file "tmp~a" #f (path-only path))]) + (with-handlers ([exn:fail:filesystem? void]) + (rename-file-or-directory path tmp-path2 #t)) + (rename-file-or-directory tmp-path path #t) + (try-delete-file tmp-path2)) + (rename-file-or-directory tmp-path path #t)) + (try-delete-file tmp-path))))))) + +(define-syntax-rule + (with-compiler-security-guard expr) + (parameterize ([current-security-guard (pick-security-guard)]) + expr)) + +(define compiler-security-guard (make-parameter #f)) + +(define (pick-security-guard) + (or (compiler-security-guard) + (current-security-guard))) (define (get-source-sha1 p) (with-handlers ([exn:fail:filesystem? (lambda (exn) @@ -351,7 +363,7 @@ ;; Write the code and dependencies: (when code - (make-directory*/ignore-exists-exn code-dir) + (with-compiler-security-guard (make-directory*/ignore-exists-exn code-dir)) (with-compile-output zo-name (lambda (out tmp-name) (with-handlers ([exn:fail? @@ -573,16 +585,17 @@ (begin (trace-printf "checking: ~a" orig-path) (do-check)))) -(define (managed-compile-zo zo [read-src-syntax read-syntax]) - ((make-caching-managed-compile-zo read-src-syntax) zo)) +(define (managed-compile-zo zo [read-src-syntax read-syntax] #:security-guard [security-guard #f]) + ((make-caching-managed-compile-zo read-src-syntax #:security-guard security-guard) zo)) -(define (make-caching-managed-compile-zo [read-src-syntax read-syntax]) +(define (make-caching-managed-compile-zo [read-src-syntax read-syntax] #:security-guard [security-guard #f]) (let ([cache (make-hash)]) (lambda (src) (parameterize ([current-load/use-compiled (make-compilation-manager-load/use-compiled-handler/table cache - #f)]) + #f + #:security-guard security-guard)]) (compile-root (car (use-compiled-file-paths)) (path->complete-path src) cache @@ -590,10 +603,14 @@ #f) (void))))) -(define (make-compilation-manager-load/use-compiled-handler [delete-zos-when-rkt-file-does-not-exist? #f]) - (make-compilation-manager-load/use-compiled-handler/table (make-hash) delete-zos-when-rkt-file-does-not-exist?)) +(define (make-compilation-manager-load/use-compiled-handler [delete-zos-when-rkt-file-does-not-exist? #f] + #:security-guard + [security-guard #f]) + (make-compilation-manager-load/use-compiled-handler/table (make-hash) delete-zos-when-rkt-file-does-not-exist? + #:security-guard security-guard)) -(define (make-compilation-manager-load/use-compiled-handler/table cache delete-zos-when-rkt-file-does-not-exist?) +(define (make-compilation-manager-load/use-compiled-handler/table cache delete-zos-when-rkt-file-does-not-exist? + #:security-guard [security-guard #f]) (let ([orig-eval (current-eval)] [orig-load (current-load)] [orig-registry (namespace-module-registry (current-namespace))] @@ -637,7 +654,8 @@ (namespace-module-registry (current-namespace)))] [else (trace-printf "processing: ~a" path) - (compile-root (car modes) path cache read-syntax #f) + (parameterize ([compiler-security-guard security-guard]) + (compile-root (car modes) path cache read-syntax #f)) (trace-printf "done: ~a" path)]) (default-handler path mod-name)) (when (null? modes) diff --git a/collects/scribblings/raco/make.scrbl b/collects/scribblings/raco/make.scrbl index e93b6b1f65..890f3a1a01 100644 --- a/collects/scribblings/raco/make.scrbl +++ b/collects/scribblings/raco/make.scrbl @@ -121,7 +121,8 @@ implements the compilation and dependency management used by @exec{raco make} and @exec{raco setup}.} @defproc[(make-compilation-manager-load/use-compiled-handler - [delete-zos-when-rkt-file-does-not-exist? any/c #f]) + [delete-zos-when-rkt-file-does-not-exist? any/c #f] + [#:security-guard security-guard (or/c security-guard? #f) #f]) (path? (or/c symbol? false/c) . -> . any)]{ Returns a procedure suitable as a value for the @@ -208,6 +209,15 @@ If the @racket[delete-zos-when-rkt-file-does-not-exist?] argument is a true value, then the returned handler will delete @filepath{.zo} files when there is no corresponding original source file. +If the @racket[security-guard] argument is supplied, it is used when +creating @filepath{.zo} files, @filepath{.dep} files, and @filepath{compiled/} +directories. +If it is @racket[#f], then +the security guard in the @racket[current-security-guard] when +the files are created is used (not the security guard at the point +@racket[make-compilation-manager-load/use-compiled-handler] is called). + + @emph{Do not} install the result of @racket[make-compilation-manager-load/use-compiled-handler] when the current namespace contains already-loaded versions of modules that may @@ -218,7 +228,8 @@ modules may produce compiled files with inconsistent timestamps and/or @defproc[(managed-compile-zo [file path-string?] - [read-src-syntax (any/c input-port? . -> . syntax?) read-syntax]) + [read-src-syntax (any/c input-port? . -> . syntax?) read-syntax] + [#:security-guard security-guard (or/c security-guard? #f) #f]) void?]{ Compiles the given module source file to a @filepath{.zo}, installing @@ -230,7 +241,15 @@ to record the timestamps of immediate files used to compile the source If @racket[file] is compiled from source, then @racket[read-src-syntax] is used in the same way as @racket[read-syntax] to read the source module. The normal -@racket[read-syntax] is used for any required files, however.} +@racket[read-syntax] is used for any required files, however. + +If @racket[security-guard] is not @racket[#f], then the provided security +guard is used when creating the @filepath{compiled/} directories, as well +as the @filepath{.dep} and @filepath{.zo} files. If it is @racket[#f], then +the security guard in the @racket[current-security-guard] when +the files are created is used (not the security guard at the point +@racket[managed-compile-zo] is called). +} @defboolparam[trust-existing-zos trust?]{ @@ -242,14 +261,14 @@ out-of-date @filepath{.zo} files instead of re-compiling from source.} @defproc[(make-caching-managed-compile-zo - [read-src-syntax (any/c input-port? . -> . syntax?)]) + [read-src-syntax (any/c input-port? . -> . syntax?)] + [#:security-guard security-guard (or/c security-guard? #f) #f]) (path-string? . -> . void?)]{ Returns a procedure that behaves like @racket[managed-compile-zo] (providing the same @racket[read-src-syntax] each time), but a cache of timestamp information is preserved across calls to the procedure.} - @defparam[manager-compile-notify-handler notify (path? . -> . any)]{ A parameter for a procedure of one argument that is called whenever a @@ -273,7 +292,6 @@ A parameter whose value is called for each file that is loaded and @racket[#f], then the file is compiled as usual. The default is @racket[(lambda (x) #f)].} - @defproc[(file-stamp-in-collection [p path?]) (or/c (cons/c number? promise?) #f)]{ Calls @racket[file-stamp-in-paths] with @racket[p] and @racket[(current-library-collection-paths)].} @@ -288,7 +306,6 @@ Returns the file-modification date and @racket[delay]ed hash of This function is intended for use with @racket[manager-skip-file-handler].} - @defproc[(get-file-sha1 [p path?]) (or/c string? #f)]{ Computes a SHA-1 hash for the file @racket[p]; the result is