From b2b00010e33a74f65d3b437967080deea1eb5117 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 15 Aug 2014 13:13:12 +0100 Subject: [PATCH] annotate and check packages for build and binary modes If "p" is available as a source package, which is typical, then `raco pkg install --binary p` would strip away the build dependencies of "p", so that "p" would not install properly. This commit changes `raco pkg install` to look for an annotation on the package and complain if the annotation is inconsistent with the requested conversion: a binary package cannot be used as a source package or vice versa. (A built package, as provided by a snapshot site, can be used as any kind of package.) --- .../racket-doc/pkg/scribblings/lib.scrbl | 10 +- .../racket-doc/pkg/scribblings/pkg.scrbl | 11 ++ .../racket-doc/pkg/scribblings/strip.scrbl | 77 ++++++++--- .../racket-test/tests/pkg/tests-binary.rkt | 23 +++- racket/collects/pkg/lib.rkt | 37 +++++- racket/collects/pkg/main.rkt | 5 +- racket/collects/pkg/strip.rkt | 125 ++++++++++++++---- racket/src/pack-all.rkt | 6 + 8 files changed, 227 insertions(+), 67 deletions(-) diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl index 0b530a2572..4e5c9b36f1 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/lib.scrbl @@ -144,6 +144,7 @@ dependency.} [#:in-place? in-place? boolean? #f] [#:namespace namespace namespace? (make-base-namespace)] [#:strip strip (or/c #f 'source 'binary 'binary-lib) #f] + [#:force-strip? force-string? boolean? #f] [#:use-cache? use-cache? boolean? #f] [#:quiet? quiet? boolean? #t]) (values string? path? (or/c #f string?) boolean? (listof module-path?))]{ @@ -161,7 +162,9 @@ loaded. If @racket[strip] is not @racket[#f], then files and directories are removed from the prepared directory the same as when creating the corresponding kind of package. A directory that is staged in-place -cannot be stripped. +cannot be stripped. If @racket[force-strip?] is true, then a +consistency check (intended to avoid stripping a source package as +binary, for example) is skipped. If @racket[use-cache?] is true, then a local cache is consulted before downloading a particular package with a particular checksum. Note that @@ -216,6 +219,7 @@ is true, error messages may suggest specific command-line flags for [#:quiet? boolean? quiet? #f] [#:from-command-line? from-command-line? boolean? #f] [#:strip strip (or/c #f 'source 'binary 'binary-lib) #f] + [#:force-strip? force-string? boolean? #f] [#:link-dirs? link-dirs? boolean? #f]) (or/c 'skip #f @@ -256,6 +260,7 @@ The package lock must be held; see @racket[with-pkg-lock].} [#:quiet? boolean? quiet? #f] [#:from-command-line? from-command-line? boolean? #f] [#:strip strip (or/c #f 'source 'binary 'binary-lib) #f] + [#:force-strip? force-string? boolean? #f] [#:link-dirs? link-dirs? boolean? #f]) (or/c 'skip #f @@ -318,7 +323,8 @@ The package lock must be held to allow reads; see [#:strict-doc-conflicts? strict-doc-conflicts? boolean? #f] [#:quiet? boolean? quiet? #f] [#:from-command-line? from-command-line? boolean? #f] - [#:strip strip (or/c #f 'source 'binary 'binary-lib) #f]) + [#:strip strip (or/c #f 'source 'binary 'binary-lib) #f] + [#:force-strip? force-string? boolean? #f]) (or/c 'skip #f (listof (or/c path-string? diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl index 1bd2d4095f..0906e3a43f 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/pkg.scrbl @@ -877,6 +877,17 @@ The following @filepath{info.rkt} fields are used by the package manager: set up (plus collections for global documentation indexes and links).} + @item{@racketidfont{package-content-state} --- a list of two items; + the first item is @racket['binary], @racket['binary-lib], or + @racket['built], and the second item is either @racket[#f] or a + string to represent a Racket version for compiled content. This + information is used by @exec{raco pkg install} or @exec{raco + pkg update} witj @DFlag{source}, @DFlag{binary}, or + @DFlag{binary-lib} to ensure that the package content is + consistent with the requested conversion; see also + @secref["strip"]. Absence of this definition is treated the + same as @racket[(list 'source #f)].} + ] @history[#:changed "6.1.0.5" @elem{Added @racketidfont{update-implies}.}] diff --git a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl index 47a022c3b5..c67d50e7eb 100644 --- a/pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl +++ b/pkgs/racket-pkgs/racket-doc/pkg/scribblings/strip.scrbl @@ -31,28 +31,29 @@ long as it is installed for a suitable Racket version, but the source remains available as a back-up for other programmers to consult or to re-build for a different Racket version. -A package is not specifically tagged as a @tech{source package}, -@tech{binary package}, @tech{binary library package}, or @tech{built -package}. The different kinds of -packages are just conventions based on the content of the package. All -forms of packages can be mixed in an installation, and a package can -be updated from any form to any other form. Furthermore, -@exec{raco pkg install} and @exec{raco pkg update} support -@DFlag{source}, @DFlag{binary}, @DFlag{binary-lib} flags, which can be used to convert -a @tech{built package} to a @tech{source package}, @tech{binary -package}, or @tech{binary library package}, respectively, on installation. - Programmers normally supply only @tech{source packages}, while a package catalog service may convert each source package to a @tech{binary package}, @tech{binary library package}, or @tech{built package}. Alternatively, -programmers can create @tech{binary packages}, @tech{binary library package}, or @tech{built packages} +programmers can create @tech{binary packages}, @tech{binary library packages}, or @tech{built packages} by using the @command-ref{create} subcommand with @DFlag{binary}, @DFlag{binary-lib}, or @DFlag{built}. As a convenience, the @command-ref{create} subcommand -can also create a @tech{source package} from an installed package or +can also create any kind of package from an installed package or repository checkout, dropping repository elements (such as a @filepath{.git} directory) and compiled code. Note that @command-ref{create} by default bundles a package directory as-is, -with no filtering at all. +with no filtering or annotation. + +Although a package can be specifically annotated as a @tech{source package}, +@tech{binary package}, @tech{binary library package}, or @tech{built +package} (see @racketidfont{package-content-state} in @secref["metadata"]), the different kinds of +packages are primarily just conventions based on the content of the package. All +forms of packages can be mixed in an installation, and a package can +be updated from any form to any other form. Furthermore, +@exec{raco pkg install} and @exec{raco pkg update} support +@DFlag{source}, @DFlag{binary}, @DFlag{binary-lib} flags to convert +to a package on installation; +in that case, the package's existing annotation is checked to verify that it +is consistent with the requested conversion. Creating a @tech{source package}, @tech{binary package}, @tech{binary library package}, or @tech{built package} from a directory or package installation prunes @@ -107,8 +108,9 @@ and directories: @itemlist[ @item{directories/files with names ending in @filepath{.rkt} or - @filepath{.ss} for which a corresponding compiled bytecode file is - present (in a @filepath{compiled} subdirectory);} + @filepath{.ss} for which a corresponding compiled bytecode file + is present (in a @filepath{compiled} subdirectory), not + counting @filepath{info.rkt};} @item{directories/files with names ending in @filepath{.scrbl}, @filepath{_scrbl.zo}, or @filepath{.dep};} @@ -141,7 +143,7 @@ following files (when they are not pruned): @item{for each @filepath{.html} file that refers to a @filepath{local-redirect.js} script, the path to the script is - removed; and} + removed;} @item{each @filepath{info.rkt} is adjusted as follows: an @racket[assume-virtual-sources] definition is added, any @@ -150,8 +152,14 @@ following files (when they are not pruned): @racket[copy-shared-files] definition is changed to @racket[move-shared-files], any @racket[copy-man-pages] definition is changed to @racket[move-man-pages], any - @racket[build-deps] definition is removed, and any - @racket[update-implies] definition is removed.} + @racket[build-deps] definition is removed, any + @racket[update-implies] definition is removed, and + a @racket[package-content-state] is added to changed to + @racket[(list 'binary (version))]; and} + + @item{each collection within the path gets an @filepath{info.rkt} if + it did not have one already, so that + @racket[assume-virtual-sources] can be defined.} ] @@ -167,7 +175,9 @@ compared to a @tech{binary package}: @racket[binary-lib-omit-files] definition are removed; and} @item{each @filepath{info.rkt} is adjusted to remove any - @racket[scribblings] definition.} + @racket[scribblings] definition, and + @racket[package-content-state] is adjusted to @racket[(list + 'binary-lib (version))].} ] @@ -177,8 +187,10 @@ through @racketidfont{binary-keep-files}. Creating a @tech{built package} removes any file or directory that would be removed for a @tech{source package} @emph{and} @tech{binary -package}, and it performs the @filepath{.html} file updating of a -@tech{binary package}. +package}, it performs the @filepath{.html} file updating of a +@tech{binary package}, and the package's @filepath{info.rkt} file +(added if it does not exist already) is adjusted to define +@racket[package-content-state] as @racket[(list 'built (version))]. Finally, creating a @tech{binary package}, @tech{binary library package}, or @tech{built package} @@ -206,6 +218,18 @@ package}, @tech{binary package}, @tech{binary library package}, or @tech{built p by @racket[mode].} +@defproc[(check-strip-compatible [mode (or/c 'source 'binary 'binary-lib 'built)] + [pkg-name string?] + [dir path-string?] + [error (string? . -> . any)]) + any]{ + +Check whether the content of @racket[dir] is consistent with the given +@racket[mode] conversion according to the content of a +@filepath{info.rkt} file in @racket[dir]. If not, @racket[error] is +called with an error-message string to describe the mismatch.} + + @defproc[(fixup-local-redirect-reference [file path-string?] [js-path string?]) void?]{ @@ -213,3 +237,12 @@ by @racket[mode].} Assuming that @racket[file] is an HTML file for documentation, adjusts the URL reference to @filepath{local-redirect.js}, if any, to use the prefix @racket[js-path].} + + +@defboolparam[strip-binary-compile-info compile?]{ + +A parameter that determines whether @filepath{info.rkt} files are +included in bytecode form when converting package content for a +@tech{binary packages}, @tech{binary library packages}, and +@tech{built packages}.} + diff --git a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-binary.rkt b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-binary.rkt index 4670dba5e5..3a1fbccd09 100644 --- a/pkgs/racket-pkgs/racket-test/tests/pkg/tests-binary.rkt +++ b/pkgs/racket-pkgs/racket-test/tests/pkg/tests-binary.rkt @@ -8,12 +8,12 @@ (pkg-tests - $ "raco pkg install --deps fail test-pkgs/pkg-x/" =exit> 1 - $ "raco pkg install --deps fail test-pkgs/pkg-y/" =exit> 1 - $ "raco pkg install --deps fail test-pkgs/pkg-x/ test-pkgs/pkg-z/" =exit> 1 - $ "raco pkg install --deps fail test-pkgs/pkg-y/ test-pkgs/pkg-z/" =exit> 1 - $ "raco pkg install --deps fail test-pkgs/pkg-x/ test-pkgs/pkg-y/" =exit> 1 - $ "raco pkg install --deps fail test-pkgs/pkg-y/ test-pkgs/pkg-x/" =exit> 1 + $ "raco pkg install --deps fail --copy test-pkgs/pkg-x/" =exit> 1 + $ "raco pkg install --deps fail --copy test-pkgs/pkg-y/" =exit> 1 + $ "raco pkg install --deps fail --copt test-pkgs/pkg-x/ test-pkgs/pkg-z/" =exit> 1 + $ "raco pkg install --deps fail --copy test-pkgs/pkg-y/ test-pkgs/pkg-z/" =exit> 1 + $ "raco pkg install --deps fail --copy test-pkgs/pkg-x/ test-pkgs/pkg-y/" =exit> 1 + $ "raco pkg install --deps fail --copy test-pkgs/pkg-y/ test-pkgs/pkg-x/" =exit> 1 $ "raco pkg install --deps fail --copy test-pkgs/pkg-z/" =exit> 0 @@ -261,4 +261,15 @@ $ "raco pkg remove pkg-x pkg-y pkg-z" + (shelly-case + "incompatible conversion request rejected" + $ "raco pkg install --binary test-pkgs/src-pkgs/pkg-z.zip" + =exit> 1 =stderr> #rx"not compatible" + $ "raco pkg install --binary-lib test-pkgs/src-pkgs/pkg-z.zip" + =exit> 1 =stderr> #rx"not compatible" + $ "raco pkg install --source test-pkgs/pkg-z.zip" + =exit> 1 =stderr> #rx"not compatible" + $ "raco pkg install --source test-pkgs/binary-lib-pkgs/pkg-z.zip" + =exit> 1 =stderr> #rx"not compatible") + ) diff --git a/racket/collects/pkg/lib.rkt b/racket/collects/pkg/lib.rkt index 2c98ce696f..a8fec591d5 100644 --- a/racket/collects/pkg/lib.rkt +++ b/racket/collects/pkg/lib.rkt @@ -1080,6 +1080,7 @@ download-printf metadata-ns #:strip [strip-mode #f] + #:force-strip? [force-strip? #f] #:in-place? [in-place? #f] #:in-place-clean? [in-place-clean? #f] #:link-dirs? [link-dirs? #f]) @@ -1113,7 +1114,8 @@ #:use-cache? use-cache? check-sums? download-printf metadata-ns - #:strip strip-mode)] + #:strip strip-mode + #:force-strip? force-strip?)] [(or (eq? type 'file-url) (eq? type 'dir-url) (eq? type 'github)) (define pkg-url (string->url pkg)) (define scheme (url-scheme pkg-url)) @@ -1195,6 +1197,7 @@ download-printf metadata-ns #:strip strip-mode + #:force-strip? force-strip? #:in-place? #t #:in-place-clean? #t) (set! staged? #t))) @@ -1283,7 +1286,8 @@ check-sums? download-printf metadata-ns - #:strip strip-mode) + #:strip strip-mode + #:force-strip? force-strip?) (set! staged? #t))) (λ () (when (or (file-exists? package-path) @@ -1385,6 +1389,7 @@ download-printf metadata-ns #:strip strip-mode + #:force-strip? force-strip? #:in-place? (not strip-mode) #:in-place-clean? #t) `(file ,(simple-form-path* pkg-path))) @@ -1426,6 +1431,8 @@ (delete-directory pkg-dir) (if strip-mode (begin + (unless force-strip? + (check-strip-compatible strip-mode pkg-name pkg pkg-error)) (make-directory* pkg-dir) (generate-stripped-directory strip-mode pkg pkg-dir)) (begin @@ -1455,7 +1462,8 @@ check-sums? download-printf metadata-ns - #:strip strip-mode)) + #:strip strip-mode + #:force-strip? force-strip?)) (when check-sums? (check-checksum given-checksum checksum "unexpected" pkg #f) (check-checksum checksum (install-info-checksum info) "incorrect" pkg #f)) @@ -1471,6 +1479,7 @@ #:namespace [metadata-ns (make-metadata-namespace)] #:in-place? [in-place? #f] #:strip [strip-mode #f] + #:force-strip? [force-strip? #f] #:use-cache? [use-cache? #f] #:quiet? [quiet? #t]) (define i (stage-package/info (pkg-desc-source desc) @@ -1482,7 +1491,8 @@ (if quiet? void printf) metadata-ns #:in-place? in-place? - #:strip strip-mode)) + #:strip strip-mode + #:force-strip? force-strip?)) (values (install-info-name i) (install-info-directory i) (install-info-checksum i) @@ -1538,6 +1548,7 @@ #:from-command-line? from-command-line? #:conversation conversation #:strip strip-mode + #:force-strip? force-strip? #:link-dirs? link-dirs? #:local-docs-ok? local-docs-ok? #:ai-cache ai-cache @@ -1972,6 +1983,7 @@ check-sums? download-printf metadata-ns #:strip strip-mode + #:force-strip? force-strip? #:link-dirs? link-dirs?))) ;; For the top-level call, we need to double-check that all provided packages ;; were distinct: @@ -2150,6 +2162,7 @@ #:from-command-line? [from-command-line? #f] #:conversation [conversation #f] #:strip [strip-mode #f] + #:force-strip? [force-strip? #f] #:link-dirs? [link-dirs? #f] #:summary-deps [summary-deps empty]) (define new-descs @@ -2186,6 +2199,7 @@ #:updating? updating? #:conversation conv #:strip strip-mode + #:force-strip? force-strip? (for/list ([dep (in-list deps)]) (if (pkg-desc? dep) dep @@ -2209,6 +2223,7 @@ #:from-command-line? from-command-line? #:conversation conversation #:strip strip-mode + #:force-strip? force-strip? #:link-dirs? link-dirs? #:local-docs-ok? (not strict-doc-conflicts?) #:ai-cache (box #f) @@ -2416,6 +2431,7 @@ #:quiet? [quiet? #f] #:from-command-line? [from-command-line? #f] #:strip [strip-mode #f] + #:force-strip? [force-strip? #f] #:link-dirs? [link-dirs? #f]) (define download-printf (if quiet? void printf)) (define metadata-ns (make-metadata-namespace)) @@ -2466,6 +2482,7 @@ #:quiet? quiet? #:from-command-line? from-command-line? #:strip strip-mode + #:force-strip? force-strip? #:all-platforms? all-platforms? #:force? force? #:ignore-checksums? ignore-checksums? @@ -2537,7 +2554,8 @@ #:strict-doc-conflicts? [strict-doc-conflicts? #f] #:use-cache? [use-cache? #t] #:dep-behavior [dep-behavior #f] - #:strip [strip-mode #f]) + #:strip [strip-mode #f] + #:force-strip? [force-strip? #f]) (define from-db (parameterize ([current-pkg-scope-version from-version]) (installed-pkg-table #:scope 'user))) @@ -2582,7 +2600,8 @@ #:dep-behavior (or dep-behavior 'search-auto) #:quiet? quiet? #:from-command-line? from-command-line? - #:strip strip-mode) + #:strip strip-mode + #:force-strip? force-strip?) (unless quiet? (printf "Packages migrated\n"))))) @@ -3711,6 +3730,7 @@ #:strict-doc-conflicts? boolean? #:use-cache? boolean? #:strip (or/c #f 'source 'binary 'binary-lib) + #:force-strip? boolean? #:link-dirs? boolean?) (or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))] [pkg-remove @@ -3740,6 +3760,7 @@ #:quiet? boolean? #:from-command-line? boolean? #:strip (or/c #f 'source 'binary 'binary-lib) + #:force-strip? boolean? #:link-dirs? boolean?) (or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))] [pkg-migrate @@ -3752,7 +3773,8 @@ #:use-cache? boolean? #:quiet? boolean? #:from-command-line? boolean? - #:strip (or/c #f 'source 'binary 'binary-lib)) + #:strip (or/c #f 'source 'binary 'binary-lib) + #:force-strip? boolean?) (or/c #f 'skip (listof (or/c path-string? (non-empty-listof path-string?)))))] [pkg-catalog-show (->* ((listof string?)) @@ -3790,6 +3812,7 @@ (#:namespace namespace? #:in-place? boolean? #:strip (or/c #f 'source 'binary 'binary-lib) + #:force-strip? boolean? #:use-cache? boolean? #:quiet? boolean?) (values string? diff --git a/racket/collects/pkg/main.rkt b/racket/collects/pkg/main.rkt index 532e1f4c26..0a0ee96a54 100644 --- a/racket/collects/pkg/main.rkt +++ b/racket/collects/pkg/main.rkt @@ -196,6 +196,7 @@ #:strip (or (and source 'source) (and binary 'binary) (and binary-lib 'binary-lib)) + #:force-strip? force #:link-dirs? link-dirs? (for/list ([p (in-list sources)]) (pkg-desc p a-type* name checksum #f)))))) @@ -256,6 +257,7 @@ #:strip (or (and source 'source) (and binary 'binary) (and binary-lib 'binary-lib)) + #:force-strip? force #:link-dirs? link-dirs?)))) (setup "updated" no-setup #f setup-collects jobs)))] ;; ---------------------------------------- @@ -359,7 +361,8 @@ #:use-cache? (not no-cache) #:strip (or (and source 'source) (and binary 'binary) - (and binary-lib 'binary-lib)))))) + (and binary-lib 'binary-lib)) + #:force-strip? force)))) (setup "migrated" no-setup #f setup-collects jobs)))] ;; ---------------------------------------- [create diff --git a/racket/collects/pkg/strip.rkt b/racket/collects/pkg/strip.rkt index adaf9807eb..0a9ed6fff2 100644 --- a/racket/collects/pkg/strip.rkt +++ b/racket/collects/pkg/strip.rkt @@ -7,15 +7,54 @@ racket/file racket/path racket/list - racket/set) + racket/set + racket/format) (provide generate-stripped-directory fixup-local-redirect-reference - strip-binary-compile-info) + strip-binary-compile-info + check-strip-compatible) (define strip-binary-compile-info (make-parameter #t)) -(define (generate-stripped-directory mode dir dest-dir) +(define (check-strip-compatible mode pkg dir error) + (define i (get-info/full dir)) + (define raw-status (and i + (i 'package-content-state (lambda () #f)))) + (define status (and raw-status + (list? raw-status) + ((length raw-status) . >= . 2) + (memq (car raw-status) '(source binary binary-lib built)) + (or (not (cadr raw-status)) + (string? (cadr raw-status))) + raw-status)) + (define (no) + (error (~a "package content is not compatible with the requested conversion\n" + " package: " pkg "\n" + " requested conversion: " mode "\n" + " package content: " (if status (car status) "source") "\n" + " content for version: " (or (and status (cadr status)) "none")))) + (case mode + [(source) + ;; Can't install binary[-lib] + (when (and status + (memq (car status) '(binary binary-lib))) + (no))] + [(built) + ;; Can't install binary[-lib] from wrong version + (when (and status + (memq (car status) '(binary binary-lib)) + (not (equal? (version) (cadr status)))) + (no))] + [(binary binary-lib) + ;; Need built or binary, and for the right version: + (unless (and status + (memq (car status) '(built binary binary-lib)) + (equal? (version) (cadr status))) + (no))])) + +(define (generate-stripped-directory mode dir dest-dir + #:check-status? [check-status? #t]) (define drop-keep-ns (make-base-namespace)) (define (add-drop+keeps dir base drops keeps) (define get-info (get-info/full dir #:namespace drop-keep-ns)) @@ -133,15 +172,21 @@ (fixup-info new-p src-base level mode)] [(regexp-match? #rx"[.]zo$" bstr) (fixup-zo new-p)])] - [else (void)])])] - [else (void)])) + [(built) + (when (or (eq? level 'package) + (eq? level 'package+collection)) + (cond + [(equal? #"info.rkt" bstr) + (fixup-info new-p src-base level mode)] + [else (void)]))] + [else (void)])])])) (define (explore base ; containing directory relative to `dir`, 'base at start paths ; paths in `base' drops ; hash table of paths (relative to start) to drop keeps ; hash table of paths (relative to start) to keep drop-all-by-default? ; in dropped directory? - level) ; 'package, 'collection, or 'subcollection + level) ; 'package, 'package+collection, 'collection, or 'subcollection (define next-level (case level [(package) 'collection] [else 'subcollection])) @@ -194,15 +239,16 @@ (cond [(or (not i) (not (eq? 'multi (i 'collection (lambda () #t))))) - 'collection] ; single-collection package - [else 'package]))) + 'package+collection] ; single-collection package + [else 'package]))) (explore 'same (directory-list dir) drops keeps #f level) (case mode [(binary binary-lib built) (unmove-files dir dest-dir drop-keep-ns)] [else (void)]) (case mode - [(binary binary-lib) (assume-virtual dest-dir (eq? level 'collection))] + [(built binary binary-lib) + (create-info-as-needed mode dest-dir level)] [else (void)])) (define (fixup-html new-p) @@ -297,7 +343,11 @@ (define (convert-mod info-lib defns) `(module info ,info-lib (#%module-begin - (define assume-virtual-sources #t) + ,@(case mode + [(binary binary-lib) + `((define assume-virtual-sources #t))] + [else '()]) + (define package-content-state '(,mode ,(version))) . ,(filter values (map (fixup-info-definition get-info mode) defns))))) (define new-content @@ -317,27 +367,33 @@ ;; sanity check: (unless (get-info/full dir #:namespace (make-base-namespace)) (error 'pkg-binary-create "rewrite failed")) - ;; compile it, if not top level: + ;; compile it, if not package-level: (when (strip-binary-compile-info) (unless (eq? level 'package) (managed-compile-zo new-p))))) (define ((fixup-info-definition get-info mode) defn) (match defn - [`(define build-deps . ,v) #f] - [`(define update-implies . ,v) #f] - [`(define assume-virtual-sources . ,v) #f] - [`(define copy-foreign-libs . ,v) - `(define move-foreign-libs . ,v)] - [`(define copy-shared-files . ,v) - `(define move-shared-files . ,v)] - [`(define copy-man-pages . ,v) - `(define move-man-pages . ,v)] - [`(define scribblings . ,v) + [`(define package-content-state . ,v) #f] + [_ (case mode - [(binary-lib) #f] - [else defn])] - [_ defn])) + [(built) defn] + [else + (match defn + [`(define build-deps . ,v) #f] + [`(define update-implies . ,v) #f] + [`(define assume-virtual-sources . ,v) #f] + [`(define copy-foreign-libs . ,v) + `(define move-foreign-libs . ,v)] + [`(define copy-shared-files . ,v) + `(define move-shared-files . ,v)] + [`(define copy-man-pages . ,v) + `(define move-man-pages . ,v)] + [`(define scribblings . ,v) + (case mode + [(binary-lib) #f] + [else defn])] + [_ defn])])])) (define (unmove-files dir dest-dir metadata-ns) ;; Determine whether any files slated for movement by @@ -367,21 +423,32 @@ (unmove-in dir dest-dir)) (unmove dir dest-dir)) -(define (assume-virtual dest-dir in-collection?) +(define (create-info-as-needed mode dest-dir level) ;; If an "info.rkt" file doesn't exists in a collection, - ;; add one so that `assume-virtual-sources` is defined. + ;; add one so that `package-bundle-status` and/or + ;; `assume-virtual-sources` is defined. (cond - [in-collection? + [(or (eq? mode 'built) + (not (eq? level 'package))) (define info-path (build-path dest-dir "info.rkt")) (unless (file-exists? info-path) (call-with-output-file* info-path (lambda (o) - (write `(module info setup/infotab (define assume-virtual-sources #t)) o) + (write `(module info setup/infotab + ,@(case level + [(package package+collection) + `((define package-content-state '(,mode ,(version))))] + [else '()]) + ,@(case mode + [(binary binary-lib) + `((define assume-virtual-sources #t))] + [else '()])) + o) (newline o))) (when (strip-binary-compile-info) (managed-compile-zo info-path)))] [else (for ([f (in-list (directory-list dest-dir #:build? #t))]) (when (directory-exists? f) - (assume-virtual f #t)))])) + (create-info-as-needed mode f 'collection)))])) diff --git a/racket/src/pack-all.rkt b/racket/src/pack-all.rkt index 34e3dd4688..5922ebdfbe 100644 --- a/racket/src/pack-all.rkt +++ b/racket/src/pack-all.rkt @@ -17,6 +17,11 @@ ;; Used by the top-level Makefile in the main Racket repository. +;; Increment this number if something about the way packages are +;; generated changes, so that previously generated packages are +;; reliably replaced: +(define package-format-version 2) + (define pack-dest-dir #f) (define catalog-dirs null) (define native? #f) @@ -60,6 +65,7 @@ (define (stream-directory d) (define-values (i o) (make-pipe (* 100 4096))) + (write package-format-version o) (define (skip-path? p) (let-values ([(base name dir?) (split-path p)]) (define s (path->string name))