nixo
/
guix-devel
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

packages: Implement grafts. 

Thanks to Mark H. Weaver <mhw@netris.org> for insightful discussions
and suggestions.

* guix/packages.scm (<package>)[graft]: New field.
  (patch-and-repack): Invoke 'package-derivation' with #:graft? #f.
  (package-source-derivation): Likewise.  Do not use (%guile-for-build)
  in call to 'patch-and-repack', and we could end up using a grafted
  Guile.
  (expand-input): Likewise, also for 'package-cross-derivation' call.
  (package->bag): Add #:graft? parameter.  Honor it.  Use 'strip-append'
  instead of 'package-full-name'.
  (input-graft, input-cross-graft, bag-grafts, package-grafts): New
  procedures.
  (package-derivation, package-cross-derivation): Add #:graft? parameter
  and honor it.
* gnu/packages/bootstrap.scm (package-with-bootstrap-guile): Add
  recursive call on 'graft'.
* guix/build-system/gnu.scm (package-with-explicit-inputs,
  package-with-extra-configure-variable, static-package): Likewise.
  (gnu-build): Use the ungrafted Guile to avoid full rebuilds.
  (gnu-cross-build): Likewise.
* guix/build-system/cmake.scm (cmake-build): Likewise.
* guix/build-system/glib-or-gtk.scm (glib-or-gtk-build): Likewise.
* guix/build-system/perl.scm (perl-build): Likewise.
* guix/build-system/python.scm (python-build): Likewise.
* guix/build-system/ruby.scm (ruby-build): Likewise.
* guix/build-system/trivial.scm (guile-for-build): Likewise.
* tests/packages.scm ("package-derivation, direct graft",
  "package-cross-derivation, direct graft", "package-grafts,
  indirect grafts", "package-grafts, indirect grafts, cross",
  "package-grafts, indirect grafts, propagated inputs",
  "package-derivation, indirect grafts"): New tests.
  ("bag->derivation", "bag->derivation, cross-compilation"): Wrap in
  'parameterize'.
* doc/guix.texi (Security Updates): New node.
  (Invoking guix build): Document --no-graft.
This commit is contained in:
Ludovic Courtès 2014-10-27 18:09:00 +01:00
parent 50373bab7a
commit 05962f2958
12 changed files with 347 additions and 73 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

63
doc/guix.texi
View File

@ -2569,6 +2569,10 @@ candidates:
guix build guile --with-source=../guile-2.0.9.219-e1bb7.tar.xz
@end example
@item --no-grafts
Do not ``graft'' packages. In practice, this means that package updates
available as grafts are not applied. @xref{Security Updates}, for more
information on grafts.
@item --derivations
@itemx -d
@ -3003,6 +3007,7 @@ For information on porting to other architectures or kernels,
* System Installation:: Installing the whole operating system.
* System Configuration:: Configuring a GNU system.
* Installing Debugging Files:: Feeding the debugger.
* Security Updates:: Deploying security fixes quickly.
* Package Modules:: Packages from the programmer's viewpoint.
* Packaging Guidelines:: Growing the distribution.
* Bootstrapping:: GNU/Linux built from scratch.
@ -4280,6 +4285,64 @@ the load. To check whether a package has a @code{debug} output, use
@command{guix package --list-available} (@pxref{Invoking guix package}).
@node Security Updates
@section Security Updates
@indentedblock
Note: As of version @value{VERSION}, the feature described in this
section is experimental.
@end indentedblock
@cindex security updates
Occasionally, important security vulnerabilities are discovered in core
software packages and must be patched. Guix follows a functional
package management discipline (@pxref{Introduction}), which implies
that, when a package is changed, @emph{every package that depends on it}
must be rebuilt. This can significantly slow down the deployment of
fixes in core packages such as libc or Bash, since basically the whole
distribution would need to be rebuilt. Using pre-built binaries helps
(@pxref{Substitutes}), but deployment may still take more time than
desired.
@cindex grafts
To address that, Guix implements @dfn{grafts}, a mechanism that allows
for fast deployment of critical updates without the costs associated
with a whole-distribution rebuild. The idea is to rebuild only the
package that needs to be patched, and then to ``graft'' it onto packages
explicitly installed by the user and that were previously referring to
the original package. The cost of grafting is typically very low, and
order of magnitudes lower than a full rebuild of the dependency chain.
@cindex replacements of packages, for grafts
For instance, suppose a security update needs to be applied to Bash.
Guix developers will provide a package definition for the ``fixed''
Bash, say @var{bash-fixed}, in the usual way (@pxref{Defining
Packages}). Then, the original package definition is augmented with a
@code{replacement} field pointing to the package containing the bug fix:
@example
(define bash
(package
(name "bash")
;; @dots{}
(replacement bash-fixed)))
@end example
From there on, any package depending directly or indirectly on Bash that
is installed will automatically be ``rewritten'' to refer to
@var{bash-fixed} instead of @var{bash}. This grafting process takes
time proportional to the size of the package, but expect less than a
minute for an ``average'' package on a recent machine.
Currently, the graft and the package it replaces (@var{bash-fixed} and
@var{bash} in the example above) must have the exact same @code{name}
and @code{version} fields. This restriction mostly comes from the fact
that grafting works by patching files, including binary files, directly.
Other restrictions may apply: for instance, when adding a graft to a
package providing a shared library, the original shared library and its
replacement must have the same @code{SONAME} and be binary-compatible.
@node Package Modules
@section Package Modules

4
gnu/packages/bootstrap.scm
View File

@ -146,7 +146,9 @@ check whether everything is alright."
(native-inputs (map rewritten-input
(package-native-inputs p)))
(propagated-inputs (map rewritten-input
(package-propagated-inputs p)))))))
(package-propagated-inputs p)))
(replacement (and=> (package-replacement p)
package-with-bootstrap-guile))))))
(define* (glibc-dynamic-linker
#:optional (system (or (and=> (%current-target-system)

4
guix/build-system/cmake.scm
View File

@ -125,11 +125,11 @@ provides a 'CMakeLists.txt' file as its build system."
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system))
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system

4
guix/build-system/glib-or-gtk.scm
View File

@ -168,11 +168,11 @@
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system))
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system

30
guix/build-system/gnu.scm
View File

@ -91,6 +91,13 @@ builder, or the distro's final Guile when GUILE is #f."
`(#:guile ,guile
#:implicit-inputs? #f
,@args)))
(replacement
(let ((replacement (package-replacement p)))
(and replacement
(package-with-explicit-inputs replacement inputs loc
#:native-inputs
native-inputs
#:guile guile))))
(native-inputs
(let ((filtered (duplicate-filter native-inputs*)))
`(,@(call native-inputs*)
@ -132,6 +139,11 @@ flags for VARIABLE, the associated value is augmented."
(substring flag ,len))
flag))
,flags)))))))
(replacement
(let ((replacement (package-replacement p)))
(and replacement
(package-with-extra-configure-variable replacement
variable value))))
(inputs (rewritten-inputs (package-inputs p)))
(propagated-inputs (rewritten-inputs (package-propagated-inputs p))))))
@ -155,7 +167,8 @@ use `--strip-all' as the arguments to `strip'."
((#:strip-flags flags)
(if strip-all?
''("--strip-all")
flags)))))))
flags)))))
(replacement (and=> (package-replacement p) static-package))))
(define* (dist-package p source)
"Return a package that runs takes source files from the SOURCE directory,
@ -290,9 +303,11 @@ are allowed to refer to."
(define canonicalize-reference
(match-lambda
((? package? p)
(derivation->output-path (package-derivation store p system)))
(derivation->output-path (package-derivation store p system
#:graft? #f)))
(((? package? p) output)
(derivation->output-path (package-derivation store p system)
(derivation->output-path (package-derivation store p system
#:graft? #f)
output))
((? string? output)
output)))
@ -328,11 +343,12 @@ are allowed to refer to."
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system))
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))))
(package-derivation store guile system
#:graft? #f)))))
(build-expression->derivation store name builder
#:system system
@ -472,11 +488,11 @@ platform."
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system))
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system

4
guix/build-system/perl.scm
View File

@ -114,11 +114,11 @@ provides a `Makefile.PL' file as its build system."
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system))
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:system system

4
guix/build-system/python.scm
View File

@ -160,11 +160,11 @@ provides a 'setup.py' file as its build system."
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system))
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs

4
guix/build-system/ruby.scm
View File

@ -99,11 +99,11 @@
(define guile-for-build
(match guile
((? package?)
(package-derivation store guile system))
(package-derivation store guile system #:graft? #f))
(#f
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))))
(package-derivation store guile system #:graft? #f)))))
(build-expression->derivation store name builder
#:inputs inputs

4
guix/build-system/trivial.scm
View File

@ -28,11 +28,11 @@
(define (guile-for-build store guile system)
(match guile
((? package?)
(package-derivation store guile system))
(package-derivation store guile system #:graft? #f))
(#f ; the default
(let* ((distro (resolve-interface '(gnu packages commencement)))
(guile (module-ref distro 'guile-final)))
(package-derivation store guile system)))))
(package-derivation store guile system #:graft? #f)))))
(define* (lower name
#:key source inputs native-inputs outputs system target

147
guix/packages.scm
View File

@ -26,6 +26,7 @@
#:use-module (ice-9 match)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-9 gnu)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-35)
@ -65,6 +66,7 @@
package-outputs
package-native-search-paths
package-search-paths
package-replacement
package-synopsis
package-description
package-license
@ -85,6 +87,7 @@
package-derivation
package-cross-derivation
package-output
package-grafts
%supported-systems
@ -97,6 +100,7 @@
&package-cross-build-system-error
package-cross-build-system-error?
%graft?
package->bag
bag->derivation
bag-transitive-inputs
@ -211,6 +215,8 @@ corresponds to the arguments expected by `set-path-environment-variable'."
; inputs
(native-search-paths package-native-search-paths (default '()))
(search-paths package-search-paths (default '()))
(replacement package-replacement ; package | #f
(default #f) (thunked))
(synopsis package-synopsis) ; one-line description
(description package-description) ; one or two paragraphs
@ -445,8 +451,8 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
(and (member name (cons decompression-type
'("tar" "xz" "patch")))
(list name
(package-derivation store p
system)))))
(package-derivation store p system
#:graft? #f)))))
(or inputs (%standard-patch-inputs))))
(modules (delete-duplicates (cons '(guix build utils) modules))))
@ -472,12 +478,10 @@ IMPORTED-MODULES specify modules to use/import for use by SNIPPET."
;; Patches and/or a snippet.
(let ((source (method store uri 'sha256 sha256 name
#:system system))
(guile (match (or guile-for-build (%guile-for-build)
(default-guile))
(guile (match (or guile-for-build (default-guile))
((? package? p)
(package-derivation store p system))
((? derivation? drv)
drv))))
(package-derivation store p system
#:graft? #f)))))
(patch-and-repack store source patches
#:inputs inputs
#:snippet snippet
@ -617,8 +621,9 @@ information in exceptions."
(define derivation
(if cross-system
(cut package-cross-derivation store <> cross-system system)
(cut package-derivation store <> system)))
(cut package-cross-derivation store <> cross-system system
#:graft? #f)
(cut package-derivation store <> system #:graft? #f)))
(match input
(((? string? name) (? package? package))
@ -643,20 +648,27 @@ information in exceptions."
(package package)
(input x)))))))
(define %graft?
;; Whether to honor package grafts by default.
(make-parameter #t))
(define* (package->bag package #:optional
(system (%current-system))
(target (%current-target-system)))
(target (%current-target-system))
#:key (graft? (%graft?)))
"Compile PACKAGE into a bag for SYSTEM, possibly cross-compiled to TARGET,
and return it."
;; Bind %CURRENT-SYSTEM and %CURRENT-TARGET-SYSTEM so that thunked field
;; values can refer to it.
(parameterize ((%current-system system)
(%current-target-system target))
(match package
(match (if graft?
(or (package-replacement package) package)
package)
(($ <package> name version source build-system
args inputs propagated-inputs native-inputs self-native-input?
outputs)
(or (make-bag build-system (package-full-name package)
(or (make-bag build-system (string-append name "-" version)
#:system system
#:target target
#:source source
@ -676,6 +688,77 @@ and return it."
(&package-error
(package package))))))))))
(define (input-graft store system)
"Return a procedure that, given an input referring to a package with a
graft, returns a pair with the original derivation and the graft's derivation,
and returns #f for other inputs."
(match-lambda
((label (? package? package) sub-drv ...)
(let ((replacement (package-replacement package)))
(and replacement
(let ((orig (package-derivation store package system
#:graft? #f))
(new (package-derivation store replacement system)))
(graft
(origin orig)
(replacement new)
(origin-output (match sub-drv
(() "out")
((output) output)))
(replacement-output origin-output))))))
(x
#f)))
(define (input-cross-graft store target system)
"Same as 'input-graft', but for cross-compilation inputs."
(match-lambda
((label (? package? package) sub-drv ...)
(let ((replacement (package-replacement package)))
(and replacement
(let ((orig (package-cross-derivation store package target system
#:graft? #f))
(new (package-cross-derivation store replacement
target system)))
(graft
(origin orig)
(replacement new)
(origin-output (match sub-drv
(() "out")
((output) output)))
(replacement-output origin-output))))))
(_
#f)))
(define* (bag-grafts store bag)
"Return the list of grafts applicable to BAG. Each graft is a <graft>
record."
(let ((target (bag-target bag))
(system (bag-system bag)))
(define native-grafts
(filter-map (input-graft store system)
(append (bag-transitive-build-inputs bag)
(bag-transitive-target-inputs bag)
(if target
'()
(bag-transitive-host-inputs bag)))))
(define target-grafts
(if target
(filter-map (input-cross-graft store target system)
(bag-transitive-host-inputs bag))
'()))
(append native-grafts target-grafts)))
(define* (package-grafts store package
#:optional (system (%current-system))
#:key target)
"Return the list of grafts applicable to PACKAGE as built for SYSTEM and
TARGET."
(let* ((package (or (package-replacement package) package))
(bag (package->bag package system target)))
(bag-grafts store bag)))
(define* (bag->derivation store bag
#:optional context)
"Return the derivation to build BAG for SYSTEM. Optionally, CONTEXT can be
@ -743,23 +826,47 @@ This is an internal procedure."
(bag-arguments bag))))
(define* (package-derivation store package
#:optional (system (%current-system)))
#:optional (system (%current-system))
#:key (graft? (%graft?)))
"Return the <derivation> object of PACKAGE for SYSTEM."
;; Compute the derivation and cache the result. Caching is important
;; because some derivations, such as the implicit inputs of the GNU build
;; system, will be queried many, many times in a row.
(cached package system
(bag->derivation store (package->bag package system #f)
package)))
(cached package (cons system graft?)
(let* ((bag (package->bag package system #f #:graft? graft?))
(drv (bag->derivation store bag package)))
(if graft?
(match (bag-grafts store bag)
(()
drv)
(grafts
(let ((guile (package-derivation store (default-guile)
system #:graft? #f)))
(graft-derivation store (bag-name bag) drv grafts
#:system system
#:guile guile))))
drv))))
(define* (package-cross-derivation store package target
#:optional (system (%current-system)))
#:optional (system (%current-system))
#:key (graft? (%graft?)))
"Cross-build PACKAGE for TARGET (a GNU triplet) from host SYSTEM (a Guix
system identifying string)."
(cached package (cons system target)
(bag->derivation store (package->bag package system target)
package)))
(cached package (list system target graft?)
(let* ((bag (package->bag package system target #:graft? graft?))
(drv (bag->derivation store bag package)))
(if graft?
(match (bag-grafts store bag)
(()
drv)
(grafts
(graft-derivation store (bag-name bag) drv grafts
#:system system
#:guile
(package-derivation store (default-guile)
system #:graft? #f))))
drv))))
(define* (package-output store package
#:optional (output "out") (system (%current-system)))

11
guix/scripts/build.scm
View File

@ -202,6 +202,7 @@ options handled by 'set-build-options-from-command-line', and listed in
(define %default-options
;; Alist of default option values.
`((system . ,(%current-system))
(graft? . #t)
(substitutes? . #t)
(build-hook? . #t)
(print-build-trace? . #t)
@ -222,6 +223,8 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(display (_ "
--with-source=SOURCE
use SOURCE when building the corresponding package"))
(display (_ "
--no-grafts do not graft packages"))
(display (_ "
-d, --derivations return the derivation paths of the given packages"))
(display (_ "
@ -278,6 +281,10 @@ Build the given PACKAGE-OR-DERIVATION and return their output paths.\n"))
(option '("with-source") #t #f
(lambda (opt name arg result)
(alist-cons 'with-source arg result)))
(option '("no-grafts") #f #f
(lambda (opt name arg result)
(alist-cons 'graft? #f
(alist-delete 'graft? result eq?))))
%standard-build-options))
@ -292,7 +299,9 @@ build."
(define src? (assoc-ref opts 'source?))
(define sys (assoc-ref opts 'system))
(define graft? (assoc-ref opts 'graft?))
(parameterize ((%graft? graft?))
(let ((opts (options/with-source store
(options/resolve-packages store opts))))
(filter-map (match-lambda
@ -309,7 +318,7 @@ build."
;; Nothing to do; maybe for --log-file.
#f)
(_ #f))
opts)))
opts))))
(define (options/resolve-packages store opts)
"Return OPTS with package specification strings replaced by actual

95
tests/packages.scm
View File

@ -33,8 +33,9 @@
#:use-module (guix build-system gnu)
#:use-module (gnu packages)
#:use-module (gnu packages base)
#:use-module (gnu packages guile)
#:use-module (gnu packages bootstrap)
#:use-module (srfi srfi-11)
#:use-module (srfi srfi-1)
#:use-module (srfi srfi-26)
#:use-module (srfi srfi-34)
#:use-module (srfi srfi-64)
@ -47,10 +48,6 @@
(define %store
(open-connection-for-tests))
(test-begin "packages")
(define-syntax-rule (dummy-package name* extra-fields ...)
(package (name name*) (version "0") (source #f)
(build-system gnu-build-system)
@ -58,6 +55,9 @@
(home-page #f) (license #f)
extra-fields ...))
(test-begin "packages")
(test-assert "printer with location"
(string-match "^#<package foo-0 foo.scm:42 [[:xdigit:]]+>$"
(with-output-to-string
@ -375,6 +375,80 @@
(package-cross-derivation %store p "mips64el-linux-gnu")
#f)))
(test-equal "package-derivation, direct graft"
(package-derivation %store gnu-make)
(let ((p (package (inherit coreutils)
(replacement gnu-make))))
(package-derivation %store p)))
(test-equal "package-cross-derivation, direct graft"
(package-cross-derivation %store gnu-make "mips64el-linux-gnu")
(let ((p (package (inherit coreutils)
(replacement gnu-make))))
(package-cross-derivation %store p "mips64el-linux-gnu")))
(test-assert "package-grafts, indirect grafts"
(let* ((new (dummy-package "dep"
(arguments '(#:implicit-inputs? #f))))
(dep (package (inherit new) (version "0.0")))
(dep* (package (inherit dep) (replacement new)))
(dummy (dummy-package "dummy"
(arguments '(#:implicit-inputs? #f))
(inputs `(("dep" ,dep*))))))
(equal? (package-grafts %store dummy)
(list (graft
(origin (package-derivation %store dep))
(replacement (package-derivation %store new)))))))
(test-assert "package-grafts, indirect grafts, cross"
(let* ((new (dummy-package "dep"
(arguments '(#:implicit-inputs? #f))))
(dep (package (inherit new) (version "0.0")))
(dep* (package (inherit dep) (replacement new)))
(dummy (dummy-package "dummy"
(arguments '(#:implicit-inputs? #f))
(inputs `(("dep" ,dep*)))))
(target "mips64el-linux-gnu"))
(equal? (package-grafts %store dummy #:target target)
(list (graft
(origin (package-cross-derivation %store dep target))
(replacement
(package-cross-derivation %store new target)))))))
(test-assert "package-grafts, indirect grafts, propagated inputs"
(let* ((new (dummy-package "dep"
(arguments '(#:implicit-inputs? #f))))
(dep (package (inherit new) (version "0.0")))
(dep* (package (inherit dep) (replacement new)))
(prop (dummy-package "propagated"
(propagated-inputs `(("dep" ,dep*)))
(arguments '(#:implicit-inputs? #f))))
(dummy (dummy-package "dummy"
(arguments '(#:implicit-inputs? #f))
(inputs `(("prop" ,prop))))))
(equal? (package-grafts %store dummy)
(list (graft
(origin (package-derivation %store dep))
(replacement (package-derivation %store new)))))))
(test-assert "package-derivation, indirect grafts"
(let* ((new (dummy-package "dep"
(arguments '(#:implicit-inputs? #f))))
(dep (package (inherit new) (version "0.0")))
(dep* (package (inherit dep) (replacement new)))
(dummy (dummy-package "dummy"
(arguments '(#:implicit-inputs? #f))
(inputs `(("dep" ,dep*)))))
(guile (package-derivation %store (canonical-package guile-2.0)
#:graft? #f)))
(equal? (package-derivation %store dummy)
(graft-derivation %store "dummy-0"
(package-derivation %store dummy #:graft? #f)
(package-grafts %store dummy)
;; Use the same Guile as 'package-derivation'.
#:guile guile))))
(test-equal "package->bag"
`("foo86-hurd" #f (,(package-source gnu-make))
(,(canonical-package glibc)) (,(canonical-package coreutils)))
@ -406,17 +480,20 @@
(eq? package dep)))))
(test-assert "bag->derivation"
(parameterize ((%graft? #f))
(let ((bag (package->bag gnu-make))
(drv (package-derivation %store gnu-make)))
(parameterize ((%current-system "foox86-hurd")) ;should have no effect
(equal? drv (bag->derivation %store bag)))))
(equal? drv (bag->derivation %store bag))))))
(test-assert "bag->derivation, cross-compilation"
(let ((bag (package->bag gnu-make (%current-system) "mips64el-linux-gnu"))
(drv (package-cross-derivation %store gnu-make "mips64el-linux-gnu")))
(parameterize ((%graft? #f))
(let* ((target "mips64el-linux-gnu")
(bag (package->bag gnu-make (%current-system) target))
(drv (package-cross-derivation %store gnu-make target)))
(parameterize ((%current-system "foox86-hurd") ;should have no effect
(%current-target-system "foo64-linux-gnu"))
(equal? drv (bag->derivation %store bag)))))
(equal? drv (bag->derivation %store bag))))))
(unless (false-if-exception (getaddrinfo "www.gnu.org" "80" AI_NUMERICSERV))
(test-skip 1))