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.
This commit is contained in:
parent
63af93f1b4
commit
32becaf860
|
@ -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)
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user