diff --git a/gnu/packages.scm b/gnu/packages.scm index ccfc83dd11..4e7045e605 100644 --- a/gnu/packages.scm +++ b/gnu/packages.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2013 Mark H Weaver ;;; Copyright © 2014 Eric Bavier ;;; Copyright © 2016, 2017 Alex Kost @@ -34,6 +34,7 @@ #:use-module (guix profiles) #:use-module (guix describe) #:use-module (guix deprecation) + #:use-module (guix gexp) #:use-module (ice-9 vlist) #:use-module (ice-9 match) #:use-module (ice-9 binary-ports) @@ -46,6 +47,7 @@ #:use-module (srfi srfi-39) #:export (search-patch search-patches + local-patches search-auxiliary-file %patch-path %auxiliary-files-path @@ -101,6 +103,17 @@ FILE-NAME found in %PATCH-PATH." (list (search-patch file-name) ...)) +(define-syntax local-patches + (lambda (s) + (syntax-case s () + ((_ files ...) + (let ((scoped (map (lambda (file) + (string-append "patches/" file)) + (syntax->datum #'(files ...))))) + (with-syntax (((scoped ...) (datum->syntax #'x scoped))) + #`(list (local-file scoped #:recursive? #t) + ...))))))) + (define %distro-root-directory ;; Absolute file name of the module hierarchy. Since (gnu packages …) might ;; live in a directory different from (guix), try to get the best match. diff --git a/gnu/packages/base.scm b/gnu/packages/base.scm index ea2e102c15..b449b5c2b5 100644 --- a/gnu/packages/base.scm +++ b/gnu/packages/base.scm @@ -106,7 +106,7 @@ command-line arguments, multiple languages, and so on.") (sha256 (base32 "1yy33kiwrxrwj2nxa4fg15bvmwyghqbs8qwkdvy5phm784f7brjq")) - (patches (search-patches "grep-timing-sensitive-test.patch")))) + (patches (local-patches "grep-timing-sensitive-test.patch")))) (build-system gnu-build-system) (native-inputs `(("perl" ,perl))) ;some of the tests require it (inputs `(("pcre" ,pcre))) @@ -187,7 +187,7 @@ implementation offers several extensions over the standard utility.") (sha256 (base32 "1n7xy657ii0sa42zx6944v2m4v9qrh6sqgmw17l3nch3y43sxlyh")) - (patches (search-patches "tar-skip-unreliable-tests.patch" + (patches (local-patches "tar-skip-unreliable-tests.patch" "tar-remove-wholesparse-check.patch")))) (build-system gnu-build-system) ;; Note: test suite requires ~1GiB of disk space. @@ -245,7 +245,7 @@ standard utility.") (sha256 (base32 "1zfqy4rdcy279vwn2z1kbv19dcfw25d2aqy9nzvdkq5bjzd0nqdc")) - (patches (search-patches "patch-hurd-path-max.patch")))) + (patches (local-patches "patch-hurd-path-max.patch")))) (build-system gnu-build-system) (arguments ;; Work around a cross-compilation bug whereby libpatch.a would provide @@ -298,7 +298,7 @@ interactive means to merge two files.") (sha256 (base32 "16kqz9yz98dasmj70jwf5py7jk558w96w0vgp3zf9xsqk3gzpzn5")) - (patches (search-patches "findutils-localstatedir.patch" + (patches (local-patches "findutils-localstatedir.patch" "findutils-test-rwlock-threads.patch")))) (build-system gnu-build-system) (arguments @@ -335,7 +335,7 @@ used to apply commands with arbitrarily long arguments.") (sha256 (base32 "1yjcrh5hw70c0yn8zw55pd6j51dj90anpq8mmg649ps9g3gdhn24")) - (patches (search-patches "coreutils-ls.patch")))) + (patches (local-patches "coreutils-ls.patch")))) (build-system gnu-build-system) (inputs `(("acl" ,acl) ; TODO: add SELinux ("gmp" ,gmp) ;bignums in 'expr', yay! @@ -450,7 +450,7 @@ standard.") (sha256 (base32 "06cfqzpqsvdnsxbysl5p2fgdgxgl9y4p7scpnrfa8z2zgkjdspz0")) - (patches (search-patches "make-impure-dirs.patch")))) + (patches (local-patches "make-impure-dirs.patch")))) (build-system gnu-build-system) (native-inputs `(("pkg-config" ,pkg-config))) ; to detect Guile (inputs `(("guile" ,guile-3.0))) @@ -518,7 +518,7 @@ change. GNU make offers many powerful extensions over the standard utility.") (sha256 (base32 "1rin1f5c7wm4n3piky6xilcrpf2s0n3dd5vqq8irrxkcic3i1w49")) - (patches (search-patches "binutils-loongson-workaround.patch")))) + (patches (local-patches "binutils-loongson-workaround.patch")))) (build-system gnu-build-system) ;; TODO: Add dependency on zlib + those for Gold. @@ -722,7 +722,7 @@ the store.") "use_ldconfig=no")) #t)) (modules '((guix build utils))) - (patches (search-patches "glibc-ldd-x86_64.patch" + (patches (local-patches "glibc-ldd-x86_64.patch" "glibc-hidden-visibility-ldconfig.patch" "glibc-versioned-locpath.patch" "glibc-allow-kernel-2.6.32.patch" @@ -938,7 +938,7 @@ the store.") ("python" ,python-minimal) ,@(if (target-powerpc?) - `(("powerpc64le-patch" ,@(search-patches + `(("powerpc64le-patch" ,@(local-patches "glibc-ldd-powerpc.patch"))) '()) ,@(if (hurd-target?) @@ -979,7 +979,7 @@ with the Linux kernel.") (sha256 (base32 "1bxqpg91d02qnaz837a5kamm0f43pr1il4r9pknygywsar713i72")) - (patches (search-patches "glibc-ldd-x86_64.patch" + (patches (local-patches "glibc-ldd-x86_64.patch" "glibc-CVE-2019-19126.patch" "glibc-hidden-visibility-ldconfig.patch" "glibc-versioned-locpath.patch" @@ -997,7 +997,7 @@ with the Linux kernel.") (sha256 (base32 "0jzh58728flfh939a8k9pi1zdyalfzlxmwra7k0rzji5gvavivpk")) - (patches (search-patches "glibc-ldd-x86_64.patch" + (patches (local-patches "glibc-ldd-x86_64.patch" "glibc-CVE-2019-7309.patch" "glibc-CVE-2019-9169.patch" "glibc-2.29-git-updates.patch" @@ -1017,7 +1017,7 @@ with the Linux kernel.") (sha256 (base32 "10iha5ynvdj5m62vgpgqbq4cwvc2yhyl2w9yyyjgfxmdmx8h145i")) - (patches (search-patches "glibc-ldd-x86_64.patch" + (patches (local-patches "glibc-ldd-x86_64.patch" "glibc-2.28-git-fixes.patch" "glibc-hidden-visibility-ldconfig.patch" "glibc-versioned-locpath.patch" @@ -1036,7 +1036,7 @@ with the Linux kernel.") (sha256 (base32 "0wpwq7gsm7sd6ysidv0z575ckqdg13cr2njyfgrbgh4f65adwwji")) - (patches (search-patches "glibc-ldd-x86_64.patch" + (patches (local-patches "glibc-ldd-x86_64.patch" "glibc-2.27-git-fixes.patch" "glibc-hidden-visibility-ldconfig.patch" "glibc-versioned-locpath.patch" diff --git a/gnu/packages/bioinformatics.scm b/gnu/packages/bioinformatics.scm index 2b67cab609..d35179f5bc 100644 --- a/gnu/packages/bioinformatics.scm +++ b/gnu/packages/bioinformatics.scm @@ -5108,7 +5108,7 @@ form of assemblies or reads.") (sha256 (base32 "0hyg2smw1nz69mfvjpk45xyyychmda92c80a0cv7baji84ri4iyn")) - (patches (search-patches "metabat-fix-compilation.patch")))) + (patches (local-patches "metabat-fix-compilation.patch")))) (build-system scons-build-system) (arguments `(#:scons ,scons-python2 @@ -6232,7 +6232,7 @@ Roche 454, Ion Torrent and Pacific BioSciences SMRT.") (sha256 (base32 "1n2s5wvvj2y0vfgjkg1q11xahpbagxz7h2vf5q7qyy25s12kbzbd")) - (patches (search-patches "mosaicatcher-unbundle-htslib.patch")))) + (patches (local-patches "mosaicatcher-unbundle-htslib.patch")))) (build-system cmake-build-system) (arguments `(#:tests? #false ; there are no tests @@ -6454,7 +6454,7 @@ accessed/downloaded on demand across HTTP.") version "-src.zip")) (sha256 (base32 "0as8gxm4pjyc8dxmm1sl873rrd7wn5qs0l29nqfnl31x8i467xaa")) - (patches (search-patches "plink-1.07-unclobber-i.patch" + (patches (local-patches "plink-1.07-unclobber-i.patch" "plink-endian-detection.patch")))) (build-system gnu-build-system) (arguments @@ -7705,7 +7705,7 @@ includes software to (sha256 (base32 "0vhrpjfdf75ba04b24xknp41790cvcgwl0vgpy7qbzj5xh2521ss")) - (patches (search-patches "vsearch-unbundle-cityhash.patch")) + (patches (local-patches "vsearch-unbundle-cityhash.patch")) (snippet '(begin ;; Remove bundled cityhash sources. The vsearch source is adjusted diff --git a/gnu/packages/commencement.scm b/gnu/packages/commencement.scm index e7bd6cf002..237540d7e3 100644 --- a/gnu/packages/commencement.scm +++ b/gnu/packages/commencement.scm @@ -1,5 +1,5 @@ ;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020 Ludovic Courtès +;;; Copyright © 2012, 2013, 2014, 2015, 2016, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès ;;; Copyright © 2014 Andreas Enge ;;; Copyright © 2012 Nikita Karetnikov ;;; Copyright © 2014, 2015, 2017 Mark H Weaver @@ -2115,7 +2115,7 @@ ac_cv_c_float_format='IEEE (little-endian)' (method url-fetch) (uri (string-append "mirror://gnu/binutils/binutils-" version ".tar.bz2")) - (patches (search-patches "binutils-boot-2.20.1a.patch")) + (patches (local-patches "binutils-boot-2.20.1a.patch")) (sha256 (base32 "0r7dr0brfpchh5ic0z9r4yxqn4ybzmlh25sbp30cacqk8nb7rlvi"))))) @@ -2191,7 +2191,7 @@ ac_cv_c_float_format='IEEE (little-endian)' (uri (string-append "mirror://gnu/glibc/glibc-" version ".tar.gz")) - (patches (search-patches "glibc-boot-2.16.0.patch" + (patches (local-patches "glibc-boot-2.16.0.patch" "glibc-bootstrap-system-2.16.0.patch")) (sha256 (base32 @@ -3317,7 +3317,7 @@ memoized as a function of '%current-system'." ("perl" ,perl-boot0) ("python" ,python-boot0) ,@(if (target-powerpc?) - `(("powerpc64le-patch" ,@(search-patches + `(("powerpc64le-patch" ,@(local-patches "glibc-ldd-powerpc.patch"))) '()))) (inputs @@ -3471,7 +3471,7 @@ exec ~a/bin/~a-~a -B~a/lib -Wl,-dynamic-linker -Wl,~a/~a \"$@\"~%" ;; This time we need 'msgfmt' to install all the libc.mo files. (native-inputs `(,@(package-native-inputs glibc-final-with-bootstrap-bash) ,@(if (target-powerpc?) - `(("powerpc64le-patch" ,@(search-patches + `(("powerpc64le-patch" ,@(local-patches "glibc-ldd-powerpc.patch"))) '()) ("gettext" ,gettext-boot0))) diff --git a/gnu/packages/gcc.scm b/gnu/packages/gcc.scm index 493ff2659f..1576b90503 100644 --- a/gnu/packages/gcc.scm +++ b/gnu/packages/gcc.scm @@ -155,7 +155,7 @@ where the OS part is overloaded to denote a specific ABI---into GCC (sha256 (base32 "10k2k71kxgay283ylbbhhs51cl55zn2q38vj5pk4k950qdnirrlj")) - (patches (search-patches "gcc-4-compile-with-gcc-5.patch" + (patches (local-patches "gcc-4-compile-with-gcc-5.patch" "gcc-fix-texi2pod.patch")))) (build-system gnu-build-system) @@ -380,7 +380,7 @@ Go. It also includes runtime support libraries for these languages.") (sha256 (base32 "08yggr18v373a1ihj0rg2vd6psnic42b518xcgp3r9k81xz1xyr2")) - (patches (search-patches "gcc-arm-link-spec-fix.patch" + (patches (local-patches "gcc-arm-link-spec-fix.patch" "gcc-4.8-libsanitizer-fix.patch" "gcc-asan-missing-include.patch" "gcc-fix-texi2pod.patch")) @@ -413,7 +413,7 @@ Go. It also includes runtime support libraries for these languages.") (sha256 (base32 "14l06m7nvcvb0igkbip58x59w3nq6315k6jcz3wr9ch1rn9d44bc")) - (patches (search-patches "gcc-4.9-libsanitizer-fix.patch" + (patches (local-patches "gcc-4.9-libsanitizer-fix.patch" "gcc-4.9-libsanitizer-ustat.patch" "gcc-4.9-libsanitizer-mode-size.patch" "gcc-arm-bug-71399.patch" @@ -475,7 +475,7 @@ Go. It also includes runtime support libraries for these languages.") (sha256 (base32 "11zd1hgzkli3b2v70qsm2hyqppngd4616qc96lmm9zl2kl9yl32k")) - (patches (search-patches "gcc-arm-bug-71399.patch" + (patches (local-patches "gcc-arm-bug-71399.patch" "gcc-libsanitizer-ustat.patch" "gcc-strmov-store-file-names.patch" "gcc-5.0-libvtv-runpath.patch" @@ -514,7 +514,7 @@ Go. It also includes runtime support libraries for these languages.") (sha256 (base32 "0i89fksfp6wr1xg9l8296aslcymv2idn60ip31wr9s4pwin7kwby")) - (patches (search-patches "gcc-strmov-store-file-names.patch" + (patches (local-patches "gcc-strmov-store-file-names.patch" "gcc-6-libsanitizer-mode-size.patch" "gcc-6-source-date-epoch-1.patch" "gcc-6-source-date-epoch-2.patch" @@ -544,7 +544,7 @@ Go. It also includes runtime support libraries for these languages.") (sha256 (base32 "0qg6kqc5l72hpnj4vr6l0p69qav0rh4anlkk3y55540zy3klc6dq")) - (patches (search-patches "gcc-strmov-store-file-names.patch" + (patches (local-patches "gcc-strmov-store-file-names.patch" "gcc-7-libsanitizer-mode-size.patch" "gcc-5.0-libvtv-runpath.patch")))) (description @@ -563,7 +563,7 @@ It also includes runtime support libraries for these languages."))) (sha256 (base32 "0l7d4m9jx124xsk6xardchgy2k5j5l2b15q322k31f0va4d8826k")) - (patches (search-patches "gcc-8-strmov-store-file-names.patch" + (patches (local-patches "gcc-8-strmov-store-file-names.patch" "gcc-5.0-libvtv-runpath.patch" "gcc-8-sort-libtool-find-output.patch")))))) @@ -578,7 +578,7 @@ It also includes runtime support libraries for these languages."))) (sha256 (base32 "13l3p6g2krilaawbapmn9zmmrh3zdwc36mfr3msxfy038hps6pf9")) - (patches (search-patches "gcc-9-strmov-store-file-names.patch" + (patches (local-patches "gcc-9-strmov-store-file-names.patch" "gcc-9-asan-fix-limits-include.patch" "gcc-5.0-libvtv-runpath.patch")))))) @@ -593,7 +593,7 @@ It also includes runtime support libraries for these languages."))) (sha256 (base32 "0i6378ig6h397zkhd7m4ccwjx5alvzrf2hm27p1pzwjhlv0h9x34")) - (patches (search-patches "gcc-9-strmov-store-file-names.patch" + (patches (local-patches "gcc-9-strmov-store-file-names.patch" "gcc-5.0-libvtv-runpath.patch")))))) (define-public gcc-11 @@ -607,7 +607,7 @@ It also includes runtime support libraries for these languages."))) (sha256 (base32 "12zs6vd2rapp42x154m479hg3h3lsafn3xhg06hp5hsldd9xr3nh")) - (patches (search-patches "gcc-9-strmov-store-file-names.patch" + (patches (local-patches "gcc-9-strmov-store-file-names.patch" "gcc-5.0-libvtv-runpath.patch")))))) ;; Note: When changing the default gcc version, update @@ -1129,7 +1129,7 @@ dependence analysis and bounds on piecewise step-polynomials.") (sha256 (base32 "13d9cqa5rzhbjq0xf0b2dyxag7pqa72xj9dhsa03m8ccr1a4npq9")) - (patches (search-patches "isl-0.11.1-aarch64-support.patch")))))) + (patches (local-patches "isl-0.11.1-aarch64-support.patch")))))) (define-public cloog (package diff --git a/gnu/packages/python.scm b/gnu/packages/python.scm index 3bb57ee2bd..413c3cb01e 100644 --- a/gnu/packages/python.scm +++ b/gnu/packages/python.scm @@ -116,7 +116,7 @@ (sha256 (base32 "0hds28cg226m8j8sr394nm9yc4gxhvlv109w0avsf2mxrlrz0hsd")) - (patches (search-patches "python-2.7-search-paths.patch" + (patches (local-patches "python-2.7-search-paths.patch" "python-2-deterministic-build-info.patch" "python-2.7-site-prefixes.patch" "python-2.7-source-date-epoch.patch" @@ -370,7 +370,7 @@ data types.") (method url-fetch) (uri (string-append "https://www.python.org/ftp/python/" version "/Python-" version ".tar.xz")) - (patches (search-patches + (patches (local-patches "python-CVE-2020-26116.patch" "python-3.8-CVE-2021-3177.patch" "python-3-fix-tests.patch" @@ -531,7 +531,7 @@ data types.") (method url-fetch) (uri (string-append "https://www.python.org/ftp/python/" version "/Python-" version ".tar.xz")) - (patches (search-patches + (patches (local-patches "python-3.9-fix-tests.patch" "python-3-deterministic-build-info.patch" "python-3-search-paths.patch")) diff --git a/guix/gexp.scm b/guix/gexp.scm index f3d278b3e6..830fea6c1d 100644 --- a/guix/gexp.scm +++ b/guix/gexp.scm @@ -30,12 +30,15 @@ #:use-module (guix diagnostics) #:use-module (guix i18n) #:use-module (rnrs bytevectors) + #:autoload (gcrypt hash) (file-sha256 open-sha256-port) + #:autoload (guix serialization) (write-file) #:use-module (srfi srfi-1) #:use-module (srfi srfi-9) #:use-module (srfi srfi-9 gnu) #:use-module (srfi srfi-26) #:use-module (srfi srfi-34) #:use-module (srfi srfi-35) + #:use-module (srfi srfi-71) #:use-module (ice-9 format) #:use-module (ice-9 match) #:export (gexp @@ -59,6 +62,7 @@ local-file-name local-file-recursive? local-file-select? + local-file-cache-authoritative? plain-file plain-file? @@ -421,27 +425,30 @@ Here TARGET is bound to the cross-compilation triplet or #f." ;; absolute file name. We keep it in a promise to compute it lazily and avoid ;; repeated 'stat' calls. (define-record-type - (%%local-file file absolute name recursive? select?) + (%%local-file file absolute name recursive? select? + store-file) local-file? (file local-file-file) ;string (absolute %local-file-absolute-file-name) ;promise string (name local-file-name) ;string (recursive? local-file-recursive?) ;Boolean - (select? local-file-select?)) ;string stat -> Boolean + (select? local-file-select?) ;string stat -> Boolean + (store-file local-file-store-file)) ;string | #f (define (true file stat) #t) (define* (%local-file file promise #:optional (name (basename file)) #:key (literal? #t) location - recursive? (select? true)) + recursive? (select? true) store-file) ;; This intermediate procedure is part of our ABI, but the underlying ;; %%LOCAL-FILE is not. (when (and (not literal?) (not (string-prefix? "/" file))) (warning (and=> location source-properties->location) (G_ "resolving '~a' relative to current directory~%") file)) - (%%local-file file promise name recursive? select?)) + (%%local-file file promise name recursive? select? + store-file)) (define (absolute-file-name file directory) "Return the canonical absolute file name for FILE, which lives in the @@ -451,7 +458,7 @@ vicinity of DIRECTORY." ((not directory) file) ((string-prefix? "/" directory) (string-append directory "/" file)) - (else file)))) + (else (string-append directory "/" file))))) (define-syntax-rule (assume-valid-file-name file) "This is a syntactic keyword to tell 'local-file' that it can assume that @@ -477,13 +484,43 @@ where FILE is the entry's absolute file name and STAT is the result of This is the declarative counterpart of the 'interned-file' monadic procedure. It is implemented as a macro to capture the current source directory where it appears." + (define (store-file-name file recursive?) + (pk 'f-o-p file recursive? + (fixed-output-path (basename file) + (if recursive? + (let ((port get-hash (open-sha256-port))) + (write-file file port) + (force-output port) + (get-hash)) + (file-sha256 file)) + #:hash-algo 'sha256 + #:recursive? recursive?))) + (syntax-case s (assume-valid-file-name) ((_ file rest ...) (string? (syntax->datum #'file)) ;; FILE is a literal, so resolve it relative to the source directory. - #'(%local-file file - (delay (absolute-file-name file (current-source-directory))) - rest ...)) + (let* ((directory (and=> (syntax-source s) + (lambda (properties) + (and=> (assq-ref properties 'filename) dirname)))) + (absolute (and directory + (absolute-file-name (syntax->datum #'file) + directory))) + (recursive? (equal? '(#:recursive? #t) + (syntax->datum #'(rest ...)))) + (store-file (and absolute + (or recursive? + (null? (syntax->datum #'(rest ...)))) + (catch 'system-error + (lambda () + (store-file-name absolute recursive?)) + (const #f))))) + #`(%local-file file + (delay (absolute-file-name file (current-source-directory))) + #,@(if store-file + #`(#:store-file #,store-file) + #'()) + rest ...))) ((_ (assume-valid-file-name file) rest ...) ;; FILE is not a literal, so resolve it relative to the current ;; directory. Since the user declared FILE is valid, do not pass @@ -514,16 +551,34 @@ appears." 'system-error' exception is raised if FILE could not be found." (force (%local-file-absolute-file-name file))) +(define valid-path?* + (store-lift valid-path?)) +(define add-temp-root* + (store-lift add-temp-root)) + +(define local-file-cache-authoritative? + (make-parameter (and (not (getenv "GUIX_DISABLE_LOCAL_FILE_CACHE")) + #;(not (getenv "GUIX_UNINSTALLED"))))) + (define-gexp-compiler (local-file-compiler (file ) system target) ;; "Compile" FILE by adding it to the store. (match file - (($ file (= force absolute) name recursive? select?) + (($ file absolute name recursive? select? + store-file) ;; Canonicalize FILE so that if it's a symlink, it is resolved. Failing ;; to do that, when RECURSIVE? is #t, we could end up creating a dangling ;; symlink in the store, and when RECURSIVE? is #f 'add-to-store' would ;; just throw an error, both of which are inconvenient. - (interned-file absolute name - #:recursive? recursive? #:select? select?)))) + (mlet %store-monad ((valid? (if (and store-file + (local-file-cache-authoritative?)) + (mbegin %store-monad + ;; (add-temp-root* store-file) + (valid-path?* store-file)) + (return #f)))) + (if valid? + (return store-file) + (interned-file (force absolute) name + #:recursive? recursive? #:select? select?)))))) (define-record-type (%plain-file name content references)