;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2014, 2015, 2017, 2018 Mark H Weaver <mhw@netris.org>
;;; Copyright © 2015 Eric Bavier <bavier@member.fsf.org>
;;; Copyright © 2016 Alex Kost <alezost@gmail.com>
-;;; Copyright © 2017 Efraim Flashner <efraim@flashner.co.il>
+;;; Copyright © 2017, 2019, 2020 Efraim Flashner <efraim@flashner.co.il>
;;; Copyright © 2019 Marius Bakke <mbakke@fastmail.com>
;;;
;;; This file is part of GNU Guix.
package-output
package-grafts
package-patched-vulnerabilities
+ package-with-patches
+ package-with-extra-patches
package/inherit
transitive-input-references
(define %supported-systems
;; This is the list of system types that are supported. By default, we
;; expect all packages to build successfully here.
- '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux" "mips64el-linux"))
+ '("x86_64-linux" "i686-linux" "armhf-linux" "aarch64-linux" "mips64el-linux" "i586-gnu"))
(define %hurd-systems
;; The GNU/Hurd systems for which support is being developed.
- '("i585-gnu" "i686-gnu"))
+ '("i586-gnu" "i686-gnu"))
(define %hydra-supported-systems
;; This is the list of system types for which build machines are available.
(catch 'system-error
(lambda ()
;; In general we want to keep relative file names for modules.
- (with-fluids ((%file-port-name-canonicalization 'relative))
- (call-with-input-file (search-path %load-path file)
- (lambda (port)
- (goto port line column)
- (match (read port)
- (('package inits ...)
- (let ((field (assoc field inits)))
- (match field
- ((_ value)
- ;; Put the `or' here, and not in the first argument of
- ;; `and=>', to work around a compiler bug in 2.0.5.
- (or (and=> (source-properties value)
- source-properties->location)
- (and=> (source-properties field)
- source-properties->location)))
- (_
- #f))))
- (_
- #f))))))
+ (call-with-input-file (search-path %load-path file)
+ (lambda (port)
+ (goto port line column)
+ (match (read port)
+ (('package inits ...)
+ (let ((field (assoc field inits)))
+ (match field
+ ((_ value)
+ (let ((loc (and=> (source-properties value)
+ source-properties->location)))
+ (and loc
+ ;; Preserve the original file name, which may be a
+ ;; relative file name.
+ (set-field loc (location-file) file))))
+ (_
+ #f))))
+ (_
+ #f)))))
(lambda _
#f)))
(_ #f)))
(let ((distro (resolve-interface '(gnu packages commencement))))
(module-ref distro 'guile-final)))
-(define (guile-2.0)
- "Return Guile 2.0."
- ;; FIXME: This is used as a workaround for <https://bugs.gnu.org/28211> when
+(define (guile-for-grafts)
+ "Return the Guile package used to build grafting derivations."
+ ;; Guile 2.2 would not work due to <https://bugs.gnu.org/28211> when
;; grafting packages.
(let ((distro (resolve-interface '(gnu packages guile))))
(module-ref distro 'guile-2.0)))
(apply invoke
(string-append #+tar "/bin/tar")
"cvfa" #$output
- ;; avoid non-determinism in the archive
- "--mtime=@0"
+ ;; Avoid non-determinism in the archive. Set the mtime
+ ;; to 1 as is the case in the store (software like gzip
+ ;; behaves differently when it stumbles upon mtime = 0).
+ "--mtime=@1"
"--owner=root:0"
"--group=root:0"
(if tar-supports-sort?
#:properties `((type . origin)
(patches . ,(length patches)))))))
+(define (package-with-patches original patches)
+ "Return package ORIGINAL with PATCHES applied."
+ (package (inherit original)
+ (source (origin (inherit (package-source original))
+ (patches patches)))))
+
+(define (package-with-extra-patches original patches)
+ "Return package ORIGINAL with all PATCHES appended to its list of patches."
+ (package-with-patches original
+ (append (origin-patches (package-source original))
+ patches)))
+
(define (transitive-inputs inputs)
"Return the closure of INPUTS when considering the 'propagated-inputs'
edges. Omit duplicate inputs, except for those already present in INPUTS
(define (bag-transitive-inputs bag)
"Same as 'package-transitive-inputs', but applied to a bag."
- (transitive-inputs (bag-direct-inputs bag)))
+ (parameterize ((%current-target-system #f))
+ (transitive-inputs (bag-direct-inputs bag))))
(define (bag-transitive-build-inputs bag)
"Same as 'package-transitive-native-inputs', but applied to a bag."
- (transitive-inputs (bag-build-inputs bag)))
+ (parameterize ((%current-target-system #f))
+ (transitive-inputs (bag-build-inputs bag))))
(define (bag-transitive-host-inputs bag)
"Same as 'package-transitive-target-inputs', but applied to a bag."
(define (bag-transitive-target-inputs bag)
"Return the \"target inputs\" of BAG, recursively."
- (transitive-inputs (bag-target-inputs bag)))
+ (parameterize ((%current-target-system (bag-target bag)))
+ (transitive-inputs (bag-target-inputs bag))))
(define* (package-closure packages #:key (system (%current-system)))
"Return the closure of PACKAGES on SYSTEM--i.e., PACKAGES and the list of
#:key (graft? (%graft?)))
"Compile PACKAGE into a bag for SYSTEM, possibly cross-compiled to TARGET,
and return it."
- (cached (=> %bag-cache)
- package (list system target graft?)
- ;; 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 (if graft?
- (or (package-replacement package) package)
- package)
- ((and self
- ($ <package> name version source build-system
- args inputs propagated-inputs native-inputs
- outputs))
- ;; Even though we prefer to use "@" to separate the package
- ;; name from the package version in various user-facing parts
- ;; of Guix, checkStoreName (in nix/libstore/store-api.cc)
- ;; prohibits the use of "@", so use "-" instead.
- (or (make-bag build-system (string-append name "-" version)
- #:system system
- #:target target
- #:source source
- #:inputs (append (inputs self)
- (propagated-inputs self))
- #:outputs outputs
- #:native-inputs (native-inputs self)
- #:arguments (args self))
- (raise (if target
- (condition
- (&package-cross-build-system-error
- (package package)))
- (condition
- (&package-error
- (package package)))))))))))
+ (let ((package (or (and graft? (package-replacement package))
+ package)))
+ (cached (=> %bag-cache)
+ package (list system target)
+ ;; 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
+ ((and self
+
($ <package> name version source build-system
+ args inputs propagated-inputs native-inputs
+ outputs))
+ ;; Even though we prefer to use "@" to separate the package
+ ;; name from the package version in various user-facing parts
+ ;; of Guix, checkStoreName (in nix/libstore/store-api.cc)
+ ;; prohibits the use of "@", so use "-" instead.
+ (or (make-bag build-system (string-append name "-" version)
+ #:system system
+ #:target target
+ #:source source
+ #:inputs (append (inputs self)
+ (propagated-inputs self))
+ #:outputs outputs
+ #:native-inputs (native-inputs self)
+ #:arguments (args self))
+ (raise (if target
+ (condition
+ (&package-cross-build-system-error
+ (package package)))
+ (condition
+ (&package-error
+ (package package))))))))))))
(define %graft-cache
;; 'eq?' cache mapping package objects to a graft corresponding to their
(()
drv)
(grafts
- (let ((guile (package-derivation store (guile-2.0)
+ (let ((guile (package-derivation store (guile-for-grafts)
system #:graft? #f)))
;; TODO: As an optimization, we can simply graft the tip
;; of the derivation graph since 'graft-derivation'
(graft-derivation store drv grafts
#:system system
#:guile
- (package-derivation store (guile-2.0)
+ (package-derivation store (guile-for-grafts)
system #:graft? #f))))
drv))))
"Return as a monadic value the absolute file name of FILE within the
OUTPUT directory of PACKAGE. When FILE is omitted, return the name of the
OUTPUT directory of PACKAGE. When TARGET is true, use it as a
-cross-compilation target triplet."
+cross-compilation target triplet.
+
+Note that this procedure does _not_ build PACKAGE. Thus, the result might or
+might not designate an existing file. We recommend not using this procedure
+unless you know what you are doing."
(lambda (store)
(define compute-derivation
(if target
HCoop / jackhill / guix / guix.git / blobdiff