ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

packages: Add 'package-input-rewriting/spec'.

Browse source 
* guix/packages.scm (package-input-rewriting/spec): New procedure.
* tests/packages.scm ("package-input-rewriting/spec")
("package-input-rewriting/spec, partial match"): New tests.
* doc/guix.texi (Defining Packages): Document it.
This commit is contained in:
Ludovic Courtès 2019-03-12 21:39:48 +01:00
parent 880916ac52
commit f258d88628
No known key found for this signature in database
GPG key ID: 090B11993D9AEBB5
3 changed files with 112 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
doc/guix.texi
View file

@ -5241,6 +5241,29 @@ with @var{libressl}. Then we use it to define a @dfn{variant} of the
This is exactly what the @option{--with-input} command-line option does
(@pxref{Package Transformation Options, @option{--with-input}}).
The following variant of @code{package-input-rewriting} can match packages to
be replaced by name rather than by identity.
@deffn {Scheme Procedure} package-input-rewriting/spec @var{replacements}
Return a procedure that, given a package, applies the given @var{replacements} to
all the package graph (excluding implicit inputs). @var{replacements} is a list of
spec/procedures pair; each spec is a package specification such as @code{"gcc"} or
@code{"guile@@2"}, and each procedure takes a matching package and returns a
replacement for that package.
@end deffn
The example above could be rewritten this way:
@example
(define libressl-instead-of-openssl
;; Replace all the packages called "openssl" with LibreSSL.
(package-input-rewriting/spec `(("openssl" . ,(const libressl)))))
@end example
The key difference here is that, this time, packages are matched by spec and
not by identity. In other words, any package in the graph that is called
@code{openssl} will be replaced.
A more generic procedure to rewrite a package dependency graph is
@code{package-mapping}: it supports arbitrary changes to nodes in the
graph.

38
guix/packages.scm
View file

@ -102,6 +102,7 @@ (define-module (guix packages)
package-transitive-supported-systems
package-mapping
package-input-rewriting
package-input-rewriting/spec
package-source-derivation
package-derivation
package-cross-derivation
@ -869,6 +870,43 @@ (define (rewrite p)
(package-mapping rewrite (cut assq <> replacements)))
(define (package-input-rewriting/spec replacements)
"Return a procedure that, given a package, applies the given REPLACEMENTS to
all the package graph (excluding implicit inputs). REPLACEMENTS is a list of
spec/procedures pair; each spec is a package specification such as \"gcc\" or
\"guile@2\", and each procedure takes a matching package and returns a
replacement for that package."
(define table
(fold (lambda (replacement table)
(match replacement
((spec . proc)
(let-values (((name version)
(package-name->name+version spec)))
(vhash-cons name (list version proc) table)))))
vlist-null
replacements))
(define (find-replacement package)
(vhash-fold* (lambda (item proc)
(or proc
(match item
((#f proc)
proc)
((version proc)
(and (version-prefix? version
(package-version package))
proc)))))
#f
(package-name package)
table))
(define (rewrite package)
(match (find-replacement package)
(#f package)
(proc (proc package))))
(package-mapping rewrite find-replacement))
(define-syntax-rule (package/inherit p overrides ...)
"Like (package (inherit P) OVERRIDES ...), except that the same
transformation is done to the package replacement, if any. P must be a bare

51
tests/packages.scm
View file

@ -981,6 +981,57 @@ (define read-at
((("x" dep))
(eq? dep findutils)))))))))
(test-assert "package-input-rewriting/spec"
(let* ((dep (dummy-package "chbouib"
(native-inputs `(("x" ,grep)))))
(p0 (dummy-package "example"
(inputs `(("foo" ,coreutils)
("bar" ,grep)
("baz" ,dep)))))
(rewrite (package-input-rewriting/spec
`(("coreutils" . ,(const sed))
("grep" . ,(const findutils)))))
(p1 (rewrite p0))
(p2 (rewrite p0)))
(and (not (eq? p1 p0))
(eq? p1 p2) ;memoization
(string=? "example" (package-name p1))
(match (package-inputs p1)
((("foo" dep1) ("bar" dep2) ("baz" dep3))
(and (string=? (package-full-name dep1)
(package-full-name sed))
(string=? (package-full-name dep2)
(package-full-name findutils))
(string=? (package-name dep3) "chbouib")
(eq? dep3 (rewrite dep)) ;memoization
(match (package-native-inputs dep3)
((("x" dep))
(string=? (package-full-name dep)
(package-full-name findutils))))))))))
(test-assert "package-input-rewriting/spec, partial match"
(let* ((dep (dummy-package "chbouib"
(version "1")
(native-inputs `(("x" ,grep)))))
(p0 (dummy-package "example"
(inputs `(("foo" ,coreutils)
("bar" ,dep)))))
(rewrite (package-input-rewriting/spec
`(("chbouib@123" . ,(const sed)) ;not matched
("grep" . ,(const findutils)))))
(p1 (rewrite p0)))
(and (not (eq? p1 p0))
(string=? "example" (package-name p1))
(match (package-inputs p1)
((("foo" dep1) ("bar" dep2))
(and (string=? (package-full-name dep1)
(package-full-name coreutils))
(eq? dep2 (rewrite dep)) ;memoization
(match (package-native-inputs dep2)
((("x" dep))
(string=? (package-full-name dep)
(package-full-name findutils))))))))))
(test-equal "package-patched-vulnerabilities"
'(("CVE-2015-1234")
("CVE-2016-1234" "CVE-2018-4567")