diff options
Diffstat (limited to 'guix/channels.scm')
| -rw-r--r-- | guix/channels.scm | 86 |
1 files changed, 42 insertions, 44 deletions
diff --git a/guix/channels.scm b/guix/channels.scm index 041fae2a9c..aca8302ba0 100644 --- a/guix/channels.scm +++ b/guix/channels.scm @@ -47,6 +47,7 @@ #:use-module (srfi srfi-35) #:autoload (guix self) (whole-package make-config.scm) #:autoload (guix inferior) (gexp->derivation-in-inferior) ;FIXME: circular dep + #:autoload (guix quirks) (%quirks %patches applicable-patch? apply-patch) #:use-module (ice-9 match) #:use-module (ice-9 vlist) #:use-module ((ice-9 rdelim) #:select (read-string)) @@ -199,6 +200,37 @@ description file or its default value." channel INSTANCE." (channel-metadata-dependencies (channel-instance-metadata instance))) +(define (apply-patches checkout commit patches) + "Apply the matching PATCHES to CHECKOUT, modifying files in place. The +result is unspecified." + (let loop ((patches patches)) + (match patches + (() #t) + ((patch rest ...) + (when (applicable-patch? patch checkout commit) + (apply-patch patch checkout)) + (loop rest))))) + +(define* (latest-channel-instance store channel + #:key (patches %patches)) + "Return the latest channel instance for CHANNEL." + (define (dot-git? file stat) + (and (string=? (basename file) ".git") + (eq? 'directory (stat:type stat)))) + + (let-values (((checkout commit) + (update-cached-checkout (channel-url channel) + #:ref (channel-reference channel)))) + (when (guix-channel? channel) + ;; Apply the relevant subset of PATCHES directly in CHECKOUT. This is + ;; safe to do because 'switch-to-ref' eventually does a hard reset. + (apply-patches checkout commit patches)) + + (let* ((name (url+commit->name (channel-url channel) commit)) + (checkout (add-to-store store name #t "sha256" checkout + #:select? (negate dot-git?)))) + (channel-instance channel commit checkout)))) + (define* (latest-channel-instances store channels #:optional (previous-channels '())) "Return a list of channel instances corresponding to the latest checkouts of CHANNELS and the channels on which they depend. PREVIOUS-CHANNELS is a list @@ -224,20 +256,16 @@ of previously processed channels." (G_ "Updating channel '~a' from Git repository at '~a'...~%") (channel-name channel) (channel-url channel)) - (let-values (((checkout commit) - (latest-repository-commit store (channel-url channel) - #:ref (channel-reference - channel)))) - (let ((instance (channel-instance channel commit checkout))) - (let-values (((new-instances new-channels) - (latest-channel-instances - store - (channel-instance-dependencies instance) - previous-channels))) - (values (append (cons channel new-channels) - previous-channels) - (append (cons instance new-instances) - instances)))))))) + (let ((instance (latest-channel-instance store channel))) + (let-values (((new-instances new-channels) + (latest-channel-instances + store + (channel-instance-dependencies instance) + previous-channels))) + (values (append (cons channel new-channels) + previous-channels) + (append (cons instance new-instances) + instances))))))) previous-channels '() ;instances channels)) @@ -309,36 +337,6 @@ to '%package-module-path'." (gexp->derivation-in-inferior name build core))) -(define (syscalls-reexports-local-variables? source) - "Return true if (guix build syscalls) contains the bug described at -<https://bugs.gnu.org/36723>." - (catch 'system-error - (lambda () - (define content - (call-with-input-file (string-append source - "/guix/build/syscalls.scm") - read-string)) - - ;; The faulty code would use the 're-export' macro, causing the - ;; 'AT_SYMLINK_NOFOLLOW' local variable to be re-exported when using - ;; Guile > 2.2.4. - (string-contains content "(re-export variable)")) - (lambda args - (if (= ENOENT (system-error-errno args)) - #f - (apply throw args))))) - -(define (guile-2.2.4) - (module-ref (resolve-interface '(gnu packages guile)) - 'guile-2.2.4)) - -(define %quirks - ;; List of predicate/package pairs. This allows us provide information - ;; about specific Guile versions that old Guix revisions might need to use - ;; just to be able to build and run the trampoline in %SELF-BUILD-FILE. See - ;; <https://bugs.gnu.org/37506> - `((,syscalls-reexports-local-variables? . ,guile-2.2.4))) - (define* (guile-for-source source #:optional (quirks %quirks)) "Return the Guile package to use when building SOURCE or #f if the default '%guile-for-build' should be good enough." |