diff options
| -rw-r--r-- | doc/guix.texi | 24 | ||||
| -rw-r--r-- | guix/scripts/build.scm | 29 | ||||
| -rw-r--r-- | tests/scripts-build.scm | 19 |
3 files changed, 69 insertions, 3 deletions
diff --git a/doc/guix.texi b/doc/guix.texi index 47fc199c6c..0c5d641b48 100644 --- a/doc/guix.texi +++ b/doc/guix.texi @@ -4513,6 +4513,30 @@ This is a recursive, deep replacement. So in this example, both This is implemented using the @code{package-input-rewriting} Scheme procedure (@pxref{Defining Packages, @code{package-input-rewriting}}). + +@item --with-graft=@var{package}=@var{replacement} +This is similar to @code{--with-input} but with an important difference: +instead of rebuilding all the dependency chain, @var{replacement} is +built and then @dfn{grafted} onto the binaries that were initially +referring to @var{package}. @xref{Security Updates}, for more +information on grafts. + +For example, the command below grafts version 3.5.4 of GnuTLS onto Wget +and all its dependencies, replacing references to the version of GnuTLS +they currently refer to: + +@example +guix build --with-graft=gnutls=gnutls@@3.5.4 wget +@end example + +This has the advantage of being much faster than rebuilding everything. +But there is a caveat: it works if and only if @var{package} and +@var{replacement} are strictly compatible---for example, if they provide +a library, the application binary interface (ABI) of those libraries +must be compatible. If @var{replacement} is somehow incompatible with +@var{package}, then the resulting package may be unusable. Use with +care! + @end table @node Additional Build Options diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm index bd97d56dce..8c2c4902fc 100644 --- a/guix/scripts/build.scm +++ b/guix/scripts/build.scm @@ -209,13 +209,31 @@ called \"guile\" must be replaced with a dependency on a version 2.1 of (rewrite obj) obj)))) +(define (transform-package-inputs/graft replacement-specs) + "Return a procedure that, when passed a package, replaces its direct +dependencies according to REPLACEMENT-SPECS. REPLACEMENT-SPECS is a list of +strings like \"gnutls=gnutls@3.5.4\" meaning that packages are built using the +current 'gnutls' package, after which version 3.5.4 is grafted onto them." + (define (replacement-pair old new) + (cons old + (package (inherit old) (replacement new)))) + + (let* ((replacements (evaluate-replacement-specs replacement-specs + replacement-pair)) + (rewrite (package-input-rewriting replacements))) + (lambda (store obj) + (if (package? obj) + (rewrite obj) + obj)))) + (define %transformations ;; Transformations that can be applied to things to build. The car is the ;; key used in the option alist, and the cdr is the transformation ;; procedure; it is called with two arguments: the store, and a list of ;; things to build. `((with-source . ,transform-package-source) - (with-input . ,transform-package-inputs))) + (with-input . ,transform-package-inputs) + (with-graft . ,transform-package-inputs/graft))) (define %transformation-options ;; The command-line interface to the above transformations. @@ -227,7 +245,9 @@ called \"guile\" must be replaced with a dependency on a version 2.1 of (list (option '("with-source") #t #f (parser 'with-source)) (option '("with-input") #t #f - (parser 'with-input))))) + (parser 'with-input)) + (option '("with-graft") #t #f + (parser 'with-graft))))) (define (show-transformation-options-help) (display (_ " @@ -235,7 +255,10 @@ called \"guile\" must be replaced with a dependency on a version 2.1 of use SOURCE when building the corresponding package")) (display (_ " --with-input=PACKAGE=REPLACEMENT - replace dependency PACKAGE by REPLACEMENT"))) + replace dependency PACKAGE by REPLACEMENT")) + (display (_ " + --with-graft=PACKAGE=REPLACEMENT + graft REPLACEMENT on packages that refer to PACKAGE"))) (define (options->transformation opts) diff --git a/tests/scripts-build.scm b/tests/scripts-build.scm index e48c8da264..e2610904e2 100644 --- a/tests/scripts-build.scm +++ b/tests/scripts-build.scm @@ -102,4 +102,23 @@ ((("x" dep)) (eq? dep findutils))))))))))) +(test-assert "options->transformation, with-graft" + (let* ((p (dummy-package "guix.scm" + (inputs `(("foo" ,grep) + ("bar" ,(dummy-package "chbouib" + (native-inputs `(("x" ,grep))))))))) + (t (options->transformation '((with-input . "grep=findutils"))))) + (with-store store + (let ((new (t store p))) + (and (not (eq? new p)) + (match (package-inputs new) + ((("foo" dep1) ("bar" dep2)) + (and (string=? (package-full-name dep1) + (package-full-name grep)) + (eq? (package-replacement dep1) findutils) + (string=? (package-name dep2) "chbouib") + (match (package-native-inputs dep2) + ((("x" dep)) + (eq? (package-replacement dep) findutils))))))))))) + (test-end) |