[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[bug#45104] pull: Add a "with-substitutes" option.
|
From: |
Mathieu Othacehe |
|
Subject: |
[bug#45104] pull: Add a "with-substitutes" option. |
|
Date: |
Fri, 29 Jan 2021 14:36:30 +0100 |
|
User-agent: |
Gnus/5.13 (Gnus v5.13) Emacs/27.1 (gnu/linux) |
Here's a v2 with the missing docstrings.
Thanks,
Mathieu
>From 31dad6456825a329ba0f07c95e3e99258d186a8f Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Fri, 29 Jan 2021 13:48:44 +0100
Subject: [PATCH v2] guix: channels: Introduce
"channel-with-substitutes-available".
* guix/channels.scm (find-latest-commit-with-substitutes,
channel-with-substitutes-available): New procedures.
* guix/scripts/pull.scm (guix-pull): Move "channel-list" call inside the
%current-system parameter scope.
* doc/guix.texi (Channels with substitutes): New section.
---
doc/guix.texi | 27 ++++++++++-
guix/channels.scm | 37 ++++++++++++++-
guix/scripts/pull.scm | 103 +++++++++++++++++++++---------------------
3 files changed, 114 insertions(+), 53 deletions(-)
diff --git a/doc/guix.texi b/doc/guix.texi
index ff9e8da2e0..6587a49d0e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -40,7 +40,7 @@ Copyright @copyright{} 2016, 2017, 2018, 2019, 2020 Julien
Lepiller@*
Copyright @copyright{} 2016 Alex ter Weele@*
Copyright @copyright{} 2016, 2017, 2018, 2019 Christopher Baines@*
Copyright @copyright{} 2017, 2018, 2019 Clément Lassieur@*
-Copyright @copyright{} 2017, 2018, 2020 Mathieu Othacehe@*
+Copyright @copyright{} 2017, 2018, 2020, 2021 Mathieu Othacehe@*
Copyright @copyright{} 2017 Federico Beffa@*
Copyright @copyright{} 2017, 2018 Carlo Zancanaro@*
Copyright @copyright{} 2017 Thomas Danckaert@*
@@ -245,6 +245,7 @@ Channels
* Specifying Channel Authorizations:: Defining channel authors authorizations.
* Primary URL:: Distinguishing mirror to original.
* Writing Channel News:: Communicating information to channel's users.
+* Channels with substitutes:: Using channels with available substitutes.
Development
@@ -4919,6 +4920,7 @@ updates.
* Specifying Channel Authorizations:: Defining channel authors authorizations.
* Primary URL:: Distinguishing mirror to original.
* Writing Channel News:: Communicating information to channel's users.
+* Channels with substitutes:: Using channels with available substitutes.
@end menu
@node Specifying Additional Channels
@@ -5390,6 +5392,29 @@ xgettext -o news.po -l scheme -ken etc/news.txt
To sum up, yes, you could use your channel as a blog. But beware, this
is @emph{not quite} what your users might expect.
+@node Channels with substitutes
+@section Channels with substitutes
+
+When running @command{guix pull}, Guix will first compile the
+definitions of every available package. This is an expensive operation
+for which substitutes (@pxref{Substitutes}) may be available. The
+following snippet in @file{channels.scm} will ensure that @command{guix
+pull} uses the latest commit with available substitutes for the package
+definitions. This is done by querying the continuous integration
+server at @url{https://ci.guix.gnu.org}.
+
+Be careful, this does not mean that all the packages that you will
+install after running @command{guix pull} will have available
+substitutes. It only ensures that @command{guix pull} will not try to
+compile package definitions. This is particularly useful when using
+machines with limited resources.
+
+@lisp
+(list
+ (channel-with-substitutes-available
+ %default-guix-channel
+ "https://ci.guix.gnu.org";))
+@end lisp
@c *********************************************************************
@node Development
diff --git a/guix/channels.scm b/guix/channels.scm
index 0c84eed477..a04eae1c10 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -20,6 +20,7 @@
(define-module (guix channels)
#:use-module (git)
+ #:use-module (guix ci)
#:use-module (guix git)
#:use-module (guix git-authenticate)
#:use-module ((guix openpgp)
@@ -98,7 +99,9 @@
channel-news-entry-title
channel-news-entry-body
- channel-news-for-commit))
+ channel-news-for-commit
+
+ channel-with-substitutes-available))
;;; Commentary:
;;;
@@ -1044,6 +1047,38 @@ NEW. When OLD is omitted or is #f, return all the news
entries of CHANNEL."
'()
(apply throw key error rest)))))
+(define (find-latest-commit-with-substitutes url)
+ "Return the latest commit with available substitutes for the Guix package
+definitions at URL. Return false if no commit were found."
+ (let* ((job-name (string-append "guix." (%current-system)))
+ (build (match (latest-builds url 1
+ #:job job-name
+ #:status 0) ;success
+ ((build) build)
+ (_ #f)))
+ (evaluation (and build
+ (evaluation url (build-evaluation build))))
+ (commit (and evaluation
+ (match (evaluation-checkouts evaluation)
+ ((checkout)
+ (checkout-commit checkout))))))
+ commit))
+
+(define (channel-with-substitutes-available chan url)
+ "Return a channel inheriting from CHAN but which commit field is set to the
+latest commit with available substitutes for the Guix package definitions at
+URL. The current system is taken into account.
+
+If no commit with available substitutes were found, the commit field is set to
+false and a warning message is printed."
+ (let ((commit (find-latest-commit-with-substitutes url)))
+ (unless commit
+ (warning (G_ "could not find available substitutes at ~a~%")
+ url))
+ (channel
+ (inherit chan)
+ (commit commit))))
+
;;; Local Variables:
;;; eval: (put 'with-guile 'scheme-indent-function 1)
;;; End:
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index 83cdc1d1eb..4e0ab5d341 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -765,60 +765,61 @@ Use '~/.config/guix/channels.scm' instead."))
#:argument-handler no-arguments))
(substitutes? (assoc-ref opts 'substitutes?))
(dry-run? (assoc-ref opts 'dry-run?))
- (channels (channel-list opts))
(profile (or (assoc-ref opts 'profile) %current-profile))
(current-channels (profile-channels profile))
(validate-pull (assoc-ref opts 'validate-pull))
(authenticate? (assoc-ref opts 'authenticate-channels?)))
- (cond ((assoc-ref opts 'query)
- (process-query opts profile))
- ((assoc-ref opts 'generation)
- (process-generation-change opts profile))
- (else
- (with-store store
- (with-status-verbosity (assoc-ref opts 'verbosity)
- (parameterize ((%current-system (assoc-ref opts 'system))
- (%graft? (assoc-ref opts 'graft?)))
- (with-build-handler (build-notifier #:use-substitutes?
- substitutes?
- #:verbosity
- (assoc-ref opts
'verbosity)
- #:dry-run? dry-run?)
- (set-build-options-from-command-line store opts)
- (ensure-default-profile)
- (honor-x509-certificates store)
-
- (let ((instances
- (latest-channel-instances store channels
- #:current-channels
- current-channels
- #:validate-pull
- validate-pull
- #:authenticate?
- authenticate?)))
- (format (current-error-port)
- (N_ "Building from this channel:~%"
- "Building from these channels:~%"
- (length instances)))
- (for-each (lambda (instance)
- (let ((channel
- (channel-instance-channel
instance)))
- (format (current-error-port)
- " ~10a~a\t~a~%"
- (channel-name channel)
- (channel-url channel)
- (string-take
- (channel-instance-commit
instance)
- 7))))
- instances)
- (parameterize ((%guile-for-build
- (package-derivation
- store
- (if (assoc-ref opts 'bootstrap?)
- %bootstrap-guile
- (default-guile)))))
- (with-profile-lock profile
- (run-with-store store
- (build-and-install instances
profile)))))))))))))))
+ (cond
+ ((assoc-ref opts 'query)
+ (process-query opts profile))
+ ((assoc-ref opts 'generation)
+ (process-generation-change opts profile))
+ (else
+ (with-store store
+ (with-status-verbosity (assoc-ref opts 'verbosity)
+ (parameterize ((%current-system (assoc-ref opts 'system))
+ (%graft? (assoc-ref opts 'graft?)))
+ (with-build-handler (build-notifier #:use-substitutes?
+ substitutes?
+ #:verbosity
+ (assoc-ref opts 'verbosity)
+ #:dry-run? dry-run?)
+ (set-build-options-from-command-line store opts)
+ (ensure-default-profile)
+ (honor-x509-certificates store)
+
+ (let* ((channels (channel-list opts))
+ (instances
+ (latest-channel-instances store channels
+ #:current-channels
+ current-channels
+ #:validate-pull
+ validate-pull
+ #:authenticate?
+ authenticate?)))
+ (format (current-error-port)
+ (N_ "Building from this channel:~%"
+ "Building from these channels:~%"
+ (length instances)))
+ (for-each (lambda (instance)
+ (let ((channel
+ (channel-instance-channel instance)))
+ (format (current-error-port)
+ " ~10a~a\t~a~%"
+ (channel-name channel)
+ (channel-url channel)
+ (string-take
+ (channel-instance-commit instance)
+ 7))))
+ instances)
+ (parameterize ((%guile-for-build
+ (package-derivation
+ store
+ (if (assoc-ref opts 'bootstrap?)
+ %bootstrap-guile
+ (default-guile)))))
+ (with-profile-lock profile
+ (run-with-store store
+ (build-and-install instances profile)))))))))))))))
;;; pull.scm ends here
--
2.29.2