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.)
This commit is contained in:
Matthew Flatt
parent
05523a0b42
commit
b2b00010e3
|
|
@ -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?
|
||||
|
|
|
|||
|
|
@ -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}.}]
|
||||
|
|
|
|||
|
|
@ -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}.}
|
||||
|
||||
|
|
|
|||
|
|
@ -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")
|
||||
|
||||
)
|
||||
|
|
|
|||
|
|
@ -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?
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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)))]))
|
||||
|
|
|
|||
|
|
@ -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))
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user