guix-commits
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

04/07: Add (guix channels) and use it in (guix scripts pull).


From: Ludovic Courtès
Subject: 04/07: Add (guix channels) and use it in (guix scripts pull).
Date: Sun, 2 Sep 2018 11:08:39 -0400 (EDT)

civodul pushed a commit to branch master
in repository guix.

commit 0d39a3b98948314e135566b9315717695a9035ea
Author: Ludovic Courtès <address@hidden>
Date:   Mon Aug 27 18:05:49 2018 +0200

    Add (guix channels) and use it in (guix scripts pull).
    
    * guix/channels.scm: New file.
    * Makefile.am (MODULES): Add it.
    * guix/scripts/pull.scm: Use it.
    (%default-options): Remove 'repository-url' and 'ref'.
    (show-help, %options): Add '--channels'.
    (%self-build-file, %pull-version, build-from-source)
    (whole-package-for-legacy, derivation->manifest-entry): Remove.  These
    now exist in a similar form in (guix channels).
    (build-and-install): Change 'source' to 'instances'.  Remove #:url,
     #:branch, and #:commit.  Rewrite using 'channel-instances->manifest'.
    (channel-list): New procedure.
    (guix-pull): Parameterize %REPOSITORY-CACHE-DIRECTORY.  Call
    'honor-lets-encrypt-certificates!' unconditionally.  Load
    ~/.config/guix/channels.scm.  Rewrite to use (guix channels).
    [use-le-certs?]: Remove.
    * po/guix/POTFILES.in: Add (guix channels).
    * doc/guix.texi (Invoking guix pull): Group the description of '--url',
    '--commit', and '--branch'.  Remove mention of 'GUIX_PULL_URL'.  Add
    references to "Channels".  Document '--channels'.
    (Channels): New node.
    (Defining Packages): Link to "Channels" instead of "Package Modules".
    (Invoking guix edit): Link to "Package Modules" instead of "Defining
    Packages".
    (Package Modules): Document both GUIX_PACKAGE_PATH and channels.
---
 Makefile.am           |   1 +
 doc/guix.texi         | 277 +++++++++++++++++++++++++++++++++++++++--------
 guix/channels.scm     | 292 ++++++++++++++++++++++++++++++++++++++++++++++++++
 guix/scripts/pull.scm | 218 +++++++++++++++++--------------------
 po/guix/POTFILES.in   |   1 +
 5 files changed, 623 insertions(+), 166 deletions(-)

diff --git a/Makefile.am b/Makefile.am
index b6efd6d..af6870c 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -87,6 +87,7 @@ MODULES =                                     \
   guix/grafts.scm                              \
   guix/inferior.scm                            \
   guix/describe.scm                            \
+  guix/channels.scm                            \
   guix/gnu-maintenance.scm                     \
   guix/self.scm                                        \
   guix/upstream.scm                            \
diff --git a/doc/guix.texi b/doc/guix.texi
index 8611059..ad82c67 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -146,17 +146,18 @@ Package Management
 * Packages with Multiple Outputs::  Single source package, multiple outputs.
 * Invoking guix gc::            Running the garbage collector.
 * Invoking guix pull::          Fetching the latest Guix and distribution.
+* Channels::                    Customizing the package collection.
 * Invoking guix pack::          Creating software bundles.
 * Invoking guix archive::       Exporting and importing store files.
 
 Substitutes
 
-* Official Substitute Server::      One particular source of substitutes.
-* Substitute Server Authorization:: How to enable or disable substitutes.
-* Substitute Authentication::       How Guix verifies substitutes.
-* Proxy Settings::                  How to get substitutes via proxy.
-* Substitution Failure::            What happens when substitution fails.
-* On Trusting Binaries::            How can you trust that binary blob?
+* Official Substitute Server::  One particular source of substitutes.
+* Substitute Server Authorization::  How to enable or disable substitutes.
+* Substitute Authentication::   How Guix verifies substitutes.
+* Proxy Settings::              How to get substitutes via proxy.
+* Substitution Failure::        What happens when substitution fails.
+* On Trusting Binaries::        How can you trust that binary blob?
 
 Programming Interface
 
@@ -202,7 +203,7 @@ GNU Distribution
 
 * System Installation::         Installing the whole operating system.
 * System Configuration::        Configuring the operating system.
-* Documentation::                Browsing software user manuals.
+* Documentation::               Browsing software user manuals.
 * Installing Debugging Files::  Feeding the debugger.
 * Security Updates::            Deploying security fixes quickly.
 * Package Modules::             Packages from the programmer's viewpoint.
@@ -264,7 +265,7 @@ Services
 * Audio Services::              The MPD.
 * Virtualization Services::     Virtualization services.
 * Version Control Services::    Providing remote access to Git repositories.
-* Game Services::                Game servers.
+* Game Services::               Game servers.
 * Miscellaneous Services::      Other services.
 
 Defining Services
@@ -1694,6 +1695,7 @@ guix package -i emacs-guix
 * Packages with Multiple Outputs::  Single source package, multiple outputs.
 * Invoking guix gc::            Running the garbage collector.
 * Invoking guix pull::          Fetching the latest Guix and distribution.
+* Channels::                    Customizing the package collection.
 * Invoking guix pack::          Creating software bundles.
 * Invoking guix archive::       Exporting and importing store files.
 @end menu
@@ -2276,12 +2278,12 @@ pre-built package binaries, but source tarballs, for 
instance, which
 also result from derivation builds, can be available as substitutes.
 
 @menu
-* Official Substitute Server::      One particular source of substitutes.
-* Substitute Server Authorization:: How to enable or disable substitutes.
-* Substitute Authentication::       How Guix verifies substitutes.
-* Proxy Settings::                  How to get substitutes via proxy.
-* Substitution Failure::            What happens when substitution fails.
-* On Trusting Binaries::            How can you trust that binary blob?
+* Official Substitute Server::  One particular source of substitutes.
+* Substitute Server Authorization::  How to enable or disable substitutes.
+* Substitute Authentication::   How Guix verifies substitutes.
+* Proxy Settings::              How to get substitutes via proxy.
+* Substitution Failure::        What happens when substitution fails.
+* On Trusting Binaries::        How can you trust that binary blob?
 @end menu
 
 @node Official Substitute Server
@@ -2746,7 +2748,8 @@ the distribution currently available on your local 
machine.  To update
 that distribution, along with the Guix tools, you must run @command{guix
 pull}: the command downloads the latest Guix source code and package
 descriptions, and deploys it.  Source code is downloaded from a
address@hidden://git-scm.com, Git} repository.
address@hidden://git-scm.com, Git} repository, by default the official
address@hidden repository, though this can be customized.
 
 On completion, @command{guix package} will use packages and package
 versions from this just-retrieved copy of Guix.  Not only that, but all
@@ -2821,20 +2824,23 @@ but it supports the following options:
 Produce verbose output, writing build logs to the standard error output.
 
 @item address@hidden
-Download Guix from the Git repository at @var{url}.
-
address@hidden GUIX_PULL_URL
-By default, the source is taken from its canonical Git repository at
address@hidden, for the stable branch of Guix.  To use a different source,
-set the @code{GUIX_PULL_URL} environment variable.
-
address@hidden address@hidden
-Deploy @var{commit}, a valid Git commit ID represented as a hexadecimal
-string.
-
address@hidden address@hidden
-Deploy the tip of @var{branch}, the name of a Git branch available on
-the repository at @var{url}.
address@hidden address@hidden
address@hidden address@hidden
+Download code from the specified @var{url}, at the given @var{commit} (a valid
+Git commit ID represented as a hexadecimal string), or @var{branch}.
+
address@hidden @file{channels.scm}, configuration file
address@hidden configuration file for channels
+These options are provided for convenience, but you can also specify your
+configuration in the @file{~/.config/guix/channels.scm} file or using the
address@hidden option (see below).
+
address@hidden address@hidden
address@hidden -C @var{file}
+Read the list of channels from @var{file} instead of
address@hidden/.config/guix/channels.scm}.  @var{file} must contain Scheme code 
that
+evaluates to a list of channel objects.  @xref{Channels}, for more
+information.
 
 @item address@hidden
 @itemx -l address@hidden
@@ -2848,9 +2854,180 @@ Use the bootstrap Guile to build the latest Guix.  This 
option is only
 useful to Guix developers.
 @end table
 
+The @dfn{channel} mechanism allows you to instruct @command{guix pull} which
+repository and branch to pull from, as well as @emph{additional} repositories
+containing package modules that should be deployed.  @xref{Channels}, for more
+information.
+
 In addition, @command{guix pull} supports all the common build options
 (@pxref{Common Build Options}).
 
address@hidden Channels
address@hidden Channels
+
address@hidden channels
address@hidden @file{channels.scm}, configuration file
address@hidden configuration file for channels
address@hidden @command{guix pull}, configuration file
address@hidden configuration of @command{guix pull}
+Guix and its package collection are updated by running @command{guix pull}
+(@pxref{Invoking guix pull}).  By default @command{guix pull} downloads and
+deploys Guix itself from the official address@hidden repository.  This can be
+customized by defining @dfn{channels} in the
address@hidden/.config/guix/channels.scm} file.  A channel specifies a URL and 
branch
+of a Git repository to be deployed, and @command{guix pull} can be instructed
+to pull from one or more channels.  In other words, channels can be used to
address@hidden and to @emph{extend} Guix, as we will see below.
+
address@hidden Using a Custom Guix Channel
+
+The channel called @code{guix} specifies where Guix itself---its command-line
+tools as well as its package collection---should be downloaded.  For instance,
+suppose you want to update from your own copy of the Guix repository at
address@hidden, and specifically the @code{super-hacks} branch, you can
+write in @code{~/.config/guix/channels.scm} this specification:
+
address@hidden
+;; Tell 'guix pull' to use my own repo.
+(list (channel
+        (name 'guix)
+        (url "https://example.org/my-guix.git";)
+        (branch "super-hacks")))
address@hidden lisp
+
address@hidden
+From there on, @command{guix pull} will fetch code from the @code{super-hacks}
+branch of the repository at @code{example.org}.
+
address@hidden Specifying Additional Channels
+
address@hidden extending the package collection (channels)
address@hidden personal packages (channels)
address@hidden channels, for personal packages
+You can also specify @emph{additional channels} to pull from.  Let's say you
+have a bunch of custom package variants or personal packages that you think
+would make little sense to contribute to the Guix project, but would like to
+have these packages transparently available to you at the command line.  You
+would first write modules containing those package definitions (@pxref{Package
+Modules}), maintain them in a Git repository, and then you and anyone else can
+use it as an additional channel to get packages from.  Neat, no?
+
address@hidden What follows stems from discussions at
address@hidden <https://debbugs.gnu.org/cgi/bugreport.cgi?bug=22629#134> as 
well as
address@hidden earlier discussions on address@hidden
address@hidden Warning
+Before you, dear user, shout---``woow this is @emph{soooo coool}!''---and
+publish your personal channel to the world, we would like to share a few words
+of caution:
+
address@hidden
address@hidden
+Before publishing a channel, please consider contributing your package
+definitions to Guix proper (@pxref{Contributing}).  Guix as a project is open
+to free software of all sorts, and packages in Guix proper are readily
+available to all Guix users and benefit from the project's quality assurance
+process.
+
address@hidden
+When you maintain package definitions outside Guix, we, Guix developers,
+consider that @emph{the compatibility burden is on you}.  Remember that
+package modules and package definitions are just Scheme code that uses various
+programming interfaces (APIs).  We want to remain free to change these APIs to
+keep improving Guix, possibly in ways that break your channel.  We never
+change APIs gratuitously, but we will @emph{not} commit to freezing APIs
+either.
+
address@hidden
+Corollary: if you're using an external channel and that channel breaks, please
address@hidden the issue to the channel authors}, not to the Guix project.
address@hidden itemize
+
+You've been warned!  Having said this, we believe external channels are a
+practical way to exert your freedom to augment Guix' package collection and to
+share your improvements, which are basic tenets of
address@hidden://www.gnu.org/philosophy/free-sw.html, free software}.  Please
+email us at @email{guix-devel@@gnu.org} if you'd like to discuss this.
address@hidden quotation
+
+Once you have a Git repository containing your own package modules, you can
+write @code{~/.config/guix/channels.scm} to instruct @command{guix pull} to
+pull from your personal channel @emph{in addition} to the default Guix
+channel(s):
+
address@hidden %default-channels
address@hidden
+;; Add my personal packages to those Guix provides.
+(cons (channel
+        (name 'my-personal-packages)
+        (url "https://example.org/personal-packages.git";))
+      %default-channels)
address@hidden lisp
+
address@hidden
+Note that the snippet above is (as always!) Scheme code; we use @code{cons} to
+add a channel the list of channels that the variable @code{%default-channels}
+is bound to (@pxref{Pairs, @code{cons} and lists,, guile, GNU Guile Reference
+Manual}).  With this file in place, @command{guix pull} builds not only Guix
+but also the package modules from your own repository.  The result in
address@hidden/.config/guix/current} is the union of Guix with your own package
+modules:
+
address@hidden
+$ guix pull --list-generations
address@hidden
+Generation 19  Aug 27 2018 16:20:48
+  guix d894ab8
+    repository URL: https://git.savannah.gnu.org/git/guix.git
+    branch: master
+    commit: d894ab8e9bfabcefa6c49d9ba2e834dd5a73a300
+  my-personal-packages dd3df5e
+    repository URL: https://example.org/personal-packages.git
+    branch: master
+    commit: dd3df5e2c8818760a8fc0bd699e55d3b69fef2bb
+  11 new packages: my-gimp, my-emacs-with-cool-features, @dots{}
+  4 packages upgraded: emacs-racket-mode@@0.0.2-2.1b78827, @dots{}
address@hidden example
+
address@hidden
+The output of @command{guix pull} above shows that address@hidden includes
+both Guix and packages from the @code{my-personal-packages} channel.  Among
+the new and upgraded packages that are listed, some like @code{my-gimp} and
address@hidden might come from
address@hidden, while others come from the Guix default channel.
+
address@hidden Replicating Guix
+
address@hidden pinning, channels
address@hidden replicating Guix
address@hidden reproducibility, of Guix
+The @command{guix pull --list-generations} output above shows precisely which
+commits were used to build this instance of Guix.  We can thus replicate it,
+say, on another machine, by providing a channel specification in
address@hidden/.config/guix/channels.scm} that is ``pinned'' to these commits:
+
address@hidden
+;; Deploy specific commits of my channels of interest.
+(list (channel
+       (name 'guix)
+       (url "https://git.savannah.gnu.org/git/guix.git";)
+       (commit "d894ab8e9bfabcefa6c49d9ba2e834dd5a73a300"))
+      (channel
+       (name 'my-personal-packages)
+       (url "https://example.org/personal-packages.git";)
+       (branch "dd3df5e2c8818760a8fc0bd699e55d3b69fef2bb")))
address@hidden lisp
+
+At this point the two machines run the @emph{exact same Guix}, with access to
+the @emph{exact same packages}.  The output of @command{guix build gimp} on
+one machine will be exactly the same, bit for bit, as the output of the same
+command on the other machine.  It also means both machines have access to all
+the source code of Guix and, transitively, to all the source code of every
+package it defines.
+
+This gives you super powers, allowing you to track the provenance of binary
+artifacts with very fine grain, and to reproduce software environments at
+will---some sort of ``meta reproducibility'' capabilities, if you will.
+
 @node Invoking guix pack
 @section Invoking @command{guix pack}
 
@@ -3431,9 +3608,9 @@ more information on how to test package definitions, and
 @ref{Invoking guix lint}, for information on how to check a definition
 for style conformance.
 @vindex GUIX_PACKAGE_PATH
-Lastly, @pxref{Package Modules}, for information
+Lastly, @pxref{Channels}, for information
 on how to extend the distribution by adding your own package definitions
-to @code{GUIX_PACKAGE_PATH}.
+in a ``channel''.
 
 Finally, updating the package definition to a new upstream version
 can be partly automated by the @command{guix refresh} command
@@ -6255,8 +6432,8 @@ and that of Vim.
 
 If you are using a Guix Git checkout (@pxref{Building from Git}), or
 have created your own packages on @code{GUIX_PACKAGE_PATH}
-(@pxref{Defining Packages}), you will be able to edit the package
-recipes. Otherwise, you will be able to examine the read-only recipes
+(@pxref{Package Modules}), you will be able to edit the package
+recipes.  In other cases, you will be able to examine the read-only recipes
 for packages currently in the store.
 
 
@@ -8376,7 +8553,7 @@ For information on porting to other architectures or 
kernels,
 @menu
 * System Installation::         Installing the whole operating system.
 * System Configuration::        Configuring the operating system.
-* Documentation::                Browsing software user manuals.
+* Documentation::               Browsing software user manuals.
 * Installing Debugging Files::  Feeding the debugger.
 * Security Updates::            Deploying security fixes quickly.
 * Package Modules::             Packages from the programmer's viewpoint.
@@ -8415,7 +8592,7 @@ available.
 @menu
 * Limitations::                 What you can expect.
 * Hardware Considerations::     Supported hardware.
-* USB Stick and DVD Installation:: Preparing the installation medium.
+* USB Stick and DVD Installation::  Preparing the installation medium.
 * Preparing for Installation::  Networking, partitioning, etc.
 * Proceeding with the Installation::  The real thing.
 * Installing GuixSD in a VM::   GuixSD playground.
@@ -10096,7 +10273,7 @@ declaration.
 * Audio Services::              The MPD.
 * Virtualization Services::     Virtualization services.
 * Version Control Services::    Providing remote access to Git repositories.
-* Game Services::                Game servers.
+* Game Services::               Game servers.
 * Miscellaneous Services::      Other services.
 @end menu
 
@@ -22641,16 +22818,24 @@ name and module name must match.  For instance, the 
@code{(my-packages
 emacs)} module must be stored in a @file{my-packages/emacs.scm} file
 relative to the load path specified with @option{--load-path} or
 @code{GUIX_PACKAGE_PATH}.  @xref{Modules and the File System,,,
-guile, GNU Guile Reference Manual}, for details.}.  These package definitions
-will not be visible by default.  Users can invoke commands such as
address@hidden package} and @command{guix build} with the
address@hidden option so that they know where to find the package.  Better
-yet, they can use the
address@hidden option of these commands to make those modules visible
-(@pxref{Invoking guix build, @code{--load-path}}), or define the
address@hidden environment variable.  This environment
-variable makes it easy to extend or customize the distribution and is
-honored by all the user interfaces.
+guile, GNU Guile Reference Manual}, for details.}.  There are two ways to make
+these package definitions visible to the user interfaces:
+
address@hidden
address@hidden
+By adding the directory containing your package modules to the search path
+with the @code{-L} flag of @command{guix package} and other commands
+(@pxref{Common Build Options}), or by setting the @code{GUIX_PACKAGE_PATH}
+environment variable described below.
+
address@hidden
+By defining a @dfn{channel} and configuring @command{guix pull} so that it
+pulls from it.  A channel is essentially a Git repository containing package
+modules.  @xref{Channels}, for more information on how to define and use
+channels.
address@hidden enumerate
+
address@hidden works similarly to other search path variables:
 
 @defvr {Environment Variable} GUIX_PACKAGE_PATH
 This is a colon-separated list of directories to search for additional
diff --git a/guix/channels.scm b/guix/channels.scm
new file mode 100644
index 0000000..ec3e05e
--- /dev/null
+++ b/guix/channels.scm
@@ -0,0 +1,292 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2018 Ludovic Courtès <address@hidden>
+;;;
+;;; This file is part of GNU Guix.
+;;;
+;;; GNU Guix is free software; you can redistribute it and/or modify it
+;;; under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation; either version 3 of the License, or (at
+;;; your option) any later version.
+;;;
+;;; GNU Guix is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+;;; GNU General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
+
+(define-module (guix channels)
+  #:use-module (guix git)
+  #:use-module (guix records)
+  #:use-module (guix gexp)
+  #:use-module (guix discovery)
+  #:use-module (guix monads)
+  #:use-module (guix profiles)
+  #:use-module (guix derivations)
+  #:use-module (guix store)
+  #:use-module (guix i18n)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (srfi srfi-11)
+  #:autoload   (guix self) (whole-package)
+  #:use-module (ice-9 match)
+  #:export (channel
+            channel?
+            channel-name
+            channel-url
+            channel-branch
+            channel-commit
+            channel-location
+
+            %default-channels
+
+            channel-instance?
+            channel-instance-channel
+            channel-instance-commit
+            channel-instance-checkout
+
+            latest-channel-instances
+            channel-instance-derivations
+            latest-channel-derivations
+            channel-instances->manifest))
+
+;;; Commentary:
+;;;
+;;; This module implements "channels."  A channel is usually a source of
+;;; package definitions.  There's a special channel, the 'guix' channel, that
+;;; provides all of Guix, including its commands and its documentation.
+;;; User-defined channels are expected to typically provide a bunch of .scm
+;;; files meant to be added to the '%package-search-path'.
+;;;
+;;; This module provides tools to fetch and update channels from a Git
+;;; repository and to build them.
+;;;
+;;; Code:
+
+(define-record-type* <channel> channel make-channel
+  channel?
+  (name      channel-name)
+  (url       channel-url)
+  (branch    channel-branch (default "master"))
+  (commit    channel-commit (default #f))
+  (location  channel-location
+             (default (current-source-location)) (innate)))
+;; TODO: Add a way to express dependencies among channels.
+
+(define %default-channels
+  ;; Default list of channels.
+  (list (channel
+         (name 'guix)
+         (branch "origin/master")
+         (url "https://git.savannah.gnu.org/git/guix.git";))))
+
+(define (guix-channel? channel)
+  "Return true if CHANNEL is the 'guix' channel."
+  (eq? 'guix (channel-name channel)))
+
+(define-record-type <channel-instance>
+  (channel-instance channel commit checkout)
+  channel-instance?
+  (channel   channel-instance-channel)
+  (commit    channel-instance-commit)
+  (checkout  channel-instance-checkout))
+
+(define (channel-reference channel)
+  "Return the \"reference\" for CHANNEL, an sexp suitable for
+'latest-repository-commit'."
+  (match (channel-commit channel)
+    (#f      `(branch . ,(channel-branch channel)))
+    (commit  `(commit . ,(channel-commit channel)))))
+
+(define (latest-channel-instances store channels)
+  "Return a list of channel instances corresponding to the latest checkouts of
+CHANNELS."
+  (map (lambda (channel)
+         (format (current-error-port)
+                 (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))))
+           (channel-instance channel commit checkout)))
+       channels))
+
+(define %self-build-file
+  ;; The file containing code to build Guix.  This serves the same purpose as
+  ;; a makefile, and, similarly, is intended to always keep this name.
+  "build-aux/build-self.scm")
+
+(define %pull-version
+  ;; This is the version of the 'guix pull' protocol.  It specifies what's
+  ;; expected from %SELF-BUILD-FILE.  The initial version ("0") was when we'd
+  ;; place a set of compiled Guile modules in ~/.config/guix/latest.
+  1)
+
+(define (standard-module-derivation name source dependencies)
+  "Return a derivation that builds the Scheme modules in SOURCE and that
+depend on DEPENDENCIES, a list of lowerable objects.  The assumption is that
+SOURCE contains package modules to be added to '%package-module-path'."
+  (define modules
+    (scheme-modules* source))
+
+  ;; FIXME: We should load, say SOURCE/.guix-channel.scm, which would allow
+  ;; channel publishers to specify things such as the sub-directory where .scm
+  ;; files live, files to exclude from the channel, preferred substitute URLs,
+  ;; etc.
+  (mlet* %store-monad ((compiled
+                        (compiled-modules modules
+                                          #:name name
+                                          #:module-path (list source)
+                                          #:extensions dependencies)))
+
+    (gexp->derivation name
+                      (with-extensions dependencies
+                        (with-imported-modules '((guix build utils))
+                          #~(begin
+                              (use-modules (guix build utils))
+
+                              (let ((go  (string-append #$output "/lib/guile/"
+                                                        (effective-version)
+                                                        "/site-ccache"))
+                                    (scm (string-append #$output
+                                                        "/share/guile/site/"
+                                                        (effective-version))))
+                                (mkdir-p (dirname go))
+                                (symlink #$compiled go)
+                                (mkdir-p (dirname scm))
+                                (symlink #$source scm))))))))
+
+(define* (build-from-source name source
+                            #:key verbose? commit
+                            (dependencies '()))
+  "Return a derivation to build Guix from SOURCE, using the self-build script
+contained therein.  Use COMMIT as the version string."
+  ;; Running the self-build script makes it easier to update the build
+  ;; procedure: the self-build script of the Guix-to-be-installed contains the
+  ;; right dependencies, build procedure, etc., which the Guix-in-use may not
+  ;; be know.
+  (define script
+    (string-append source "/" %self-build-file))
+
+  (if (file-exists? script)
+      (let ((build (save-module-excursion
+                    (lambda ()
+                      (primitive-load script)))))
+        ;; BUILD must be a monadic procedure of at least one argument: the
+        ;; source tree.
+        ;;
+        ;; Note: BUILD can return #f if it does not support %PULL-VERSION.  In
+        ;; the future we'll fall back to a previous version of the protocol
+        ;; when that happens.
+        (build source #:verbose? verbose? #:version commit
+               #:pull-version %pull-version))
+
+      ;; Build a set of modules that extend Guix using the standard method.
+      (standard-module-derivation name source dependencies)))
+
+(define* (build-channel-instance instance #:optional (dependencies '()))
+  "Return, as a monadic value, the derivation for INSTANCE, a channel
+instance.  DEPENDENCIES is a list of extensions providing Guile modules that
+INSTANCE depends on."
+  (build-from-source (symbol->string
+                      (channel-name (channel-instance-channel instance)))
+                     (channel-instance-checkout instance)
+                     #:commit (channel-instance-commit instance)
+                     #:dependencies dependencies))
+
+(define (channel-instance-derivations instances)
+  "Return the list of derivations to build INSTANCES, in the same order as
+INSTANCES."
+  (define core-instance
+    ;; The 'guix' channel is treated specially: it's an implicit dependency of
+    ;; all the other channels.
+    (find (lambda (instance)
+            (guix-channel? (channel-instance-channel instance)))
+          instances))
+
+  (mlet %store-monad ((core (build-channel-instance core-instance)))
+    (mapm %store-monad
+          (lambda (instance)
+            (if (eq? instance core-instance)
+                (return core)
+                (build-channel-instance instance
+                                        (list core))))
+          instances)))
+
+(define latest-channel-derivations
+  (let ((latest-channel-instances (store-lift latest-channel-instances)))
+    (lambda (channels)
+      "Return, as a monadic value, the list of derivations for the latest
+instances of CHANNELS."
+      (mlet %store-monad ((instances (latest-channel-instances channels)))
+        (channel-instance-derivations instances)))))
+
+(define (whole-package-for-legacy name modules)
+  "Return a full-blown Guix package for MODULES, a derivation that builds Guix
+modules in the old ~/.config/guix/latest style."
+  (define packages
+    (resolve-interface '(gnu packages guile)))
+
+  (letrec-syntax ((list (syntax-rules (->)
+                          ((_)
+                           '())
+                          ((_ (module -> variable) rest ...)
+                           (cons (module-ref (resolve-interface
+                                              '(gnu packages module))
+                                             'variable)
+                                 (list rest ...)))
+                          ((_ variable rest ...)
+                           (cons (module-ref packages 'variable)
+                                 (list rest ...))))))
+    (whole-package name modules
+
+                   ;; In the "old style", %SELF-BUILD-FILE would simply return 
a
+                   ;; derivation that builds modules.  We have to infer what 
the
+                   ;; dependencies of these modules were.
+                   (list guile-json guile-git guile-bytestructures
+                         (ssh -> guile-ssh) (tls -> gnutls)))))
+
+(define (old-style-guix? drv)
+  "Return true if DRV corresponds to a ~/.config/guix/latest style of
+derivation."
+  ;; Here we rely on a gross historical fact: that derivations produced by the
+  ;; "old style" (before commit 8a0d9bc8a3f153159d9e239a151c0fa98f1e12d8,
+  ;; dated May 30, 2018) did not depend on "guix-command.drv".
+  (not (find (lambda (input)
+               (string-suffix? "-guix-command.drv"
+                               (derivation-input-path input)))
+             (derivation-inputs drv))))
+
+(define (channel-instances->manifest instances)
+  "Return a profile manifest with entries for all of INSTANCES, a list of
+channel instances."
+  (define instance->entry
+    (match-lambda
+      ((instance drv)
+       (let ((commit  (channel-instance-commit instance))
+             (channel (channel-instance-channel instance)))
+         (with-monad %store-monad
+           (return (manifest-entry
+                     (name (symbol->string (channel-name channel)))
+                     (version (string-take commit 7))
+                     (item (if (guix-channel? channel)
+                               (if (old-style-guix? drv)
+                                   (whole-package-for-legacy
+                                    (string-append name "-" version)
+                                    drv)
+                                   drv)
+                               drv))
+                     (properties
+                      `((source (repository
+                                 (version 0)
+                                 (url ,(channel-url channel))
+                                 (branch ,(channel-branch channel))
+                                 (commit ,commit))))))))))))
+
+  (mlet* %store-monad ((derivations (channel-instance-derivations instances))
+                       (entries     (mapm %store-monad instance->entry
+                                          (zip instances derivations))))
+    (return (manifest entries))))
diff --git a/guix/scripts/pull.scm b/guix/scripts/pull.scm
index ee68c21..18c04f0 100644
--- a/guix/scripts/pull.scm
+++ b/guix/scripts/pull.scm
@@ -30,26 +30,19 @@
   #:use-module (guix grafts)
   #:use-module (guix memoization)
   #:use-module (guix monads)
+  #:use-module (guix channels)
   #:autoload   (guix inferior) (open-inferior)
   #:use-module (guix scripts build)
-  #:autoload   (guix self) (whole-package)
   #:use-module (guix git)
   #:use-module (git)
   #:use-module (gnu packages)
-  #:autoload   (gnu packages ssh) (guile-ssh)
-  #:autoload   (gnu packages tls) (gnutls)
   #:use-module ((guix scripts package) #:select (build-and-use-profile))
-  #:use-module ((guix build utils)
-                #:select (with-directory-excursion delete-file-recursively))
-  #:use-module ((guix build download)
-                #:select (%x509-certificate-directory))
   #:use-module (gnu packages base)
   #:use-module (gnu packages guile)
   #:use-module ((gnu packages bootstrap)
                 #:select (%bootstrap-guile))
   #:use-module ((gnu packages certs) #:select (le-certs))
   #:use-module (srfi srfi-1)
-  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-35)
   #:use-module (srfi srfi-37)
@@ -57,9 +50,6 @@
   #:use-module (ice-9 vlist)
   #:export (guix-pull))
 
-(define %repository-url
-  (or (getenv "GUIX_PULL_URL") "https://git.savannah.gnu.org/git/guix.git";))
-
 
 ;;;
 ;;; Command-line options.
@@ -67,9 +57,7 @@
 
 (define %default-options
   ;; Alist of default option values.
-  `((repository-url . ,%repository-url)
-    (ref . (branch . "origin/master"))
-    (system . ,(%current-system))
+  `((system . ,(%current-system))
     (substitutes? . #t)
     (build-hook? . #t)
     (graft? . #t)
@@ -81,6 +69,8 @@ Download and deploy the latest version of Guix.\n"))
   (display (G_ "
       --verbose          produce verbose output"))
   (display (G_ "
+  -C, --channels=FILE    deploy the channels defined in FILE"))
+  (display (G_ "
       --url=URL          download from the Git repository at URL"))
   (display (G_ "
       --commit=COMMIT    download the specified COMMIT"))
@@ -105,6 +95,9 @@ Download and deploy the latest version of Guix.\n"))
   (cons* (option '("verbose") #f #f
                  (lambda (opt name arg result)
                    (alist-cons 'verbose? #t result)))
+         (option '(#\C "channels") #t #f
+                 (lambda (opt name arg result)
+                   (alist-cons 'channel-file arg result)))
          (option '(#\l "list-generations") #f #t
                  (lambda (opt name arg result)
                    (cons `(query list-generations ,(or arg ""))
@@ -142,70 +135,6 @@ Download and deploy the latest version of Guix.\n"))
 (define indirect-root-added
   (store-lift add-indirect-root))
 
-(define %self-build-file
-  ;; The file containing code to build Guix.  This serves the same purpose as
-  ;; a makefile, and, similarly, is intended to always keep this name.
-  "build-aux/build-self.scm")
-
-(define %pull-version
-  ;; This is the version of the 'guix pull' protocol.  It specifies what's
-  ;; expected from %SELF-BUILD-FILE.  The initial version ("0") was when we'd
-  ;; place a set of compiled Guile modules in ~/.config/guix/latest.
-  1)
-
-(define* (build-from-source source
-                            #:key verbose? commit)
-  "Return a derivation to build Guix from SOURCE, using the self-build script
-contained therein.  Use COMMIT as the version string."
-  ;; Running the self-build script makes it easier to update the build
-  ;; procedure: the self-build script of the Guix-to-be-installed contains the
-  ;; right dependencies, build procedure, etc., which the Guix-in-use may not
-  ;; be know.
-  (let* ((script (string-append source "/" %self-build-file))
-         (build  (primitive-load script)))
-    ;; BUILD must be a monadic procedure of at least one argument: the source
-    ;; tree.
-    ;;
-    ;; Note: BUILD can return #f if it does not support %PULL-VERSION.  In the
-    ;; future we'll fall back to a previous version of the protocol when that
-    ;; happens.
-    (build source #:verbose? verbose? #:version commit
-           #:pull-version %pull-version)))
-
-(define (whole-package-for-legacy name modules)
-  "Return a full-blown Guix package for MODULES, a derivation that builds Guix
-modules in the old ~/.config/guix/latest style."
-  (whole-package name modules
-
-                 ;; In the "old style", %SELF-BUILD-FILE would simply return a
-                 ;; derivation that builds modules.  We have to infer what the
-                 ;; dependencies of these modules were.
-                 (list guile-json guile-git guile-bytestructures
-                       guile-ssh gnutls)))
-
-(define* (derivation->manifest-entry drv
-                                     #:key url branch commit)
-  "Return a manifest entry for DRV, which represents Guix at COMMIT.  Record
-URL, BRANCH, and COMMIT as a property in the manifest entry."
-  (mbegin %store-monad
-    (what-to-build (list drv))
-    (built-derivations (list drv))
-    (let ((out (derivation->output-path drv)))
-      (return (manifest-entry
-                (name "guix")
-                (version (string-take commit 7))
-                (item (if (file-exists? (string-append out "/bin/guix"))
-                          drv
-                          (whole-package-for-legacy (string-append name "-"
-                                                                   version)
-                                                    drv)))
-                (properties
-                 `((source (repository
-                            (version 0)
-                            (url ,url)
-                            (branch ,branch)
-                            (commit ,commit))))))))))
-
 (define (display-profile-news profile)
   "Display what's up in PROFILE--new packages, and all that."
   (match (memv (generation-number profile)
@@ -223,8 +152,8 @@ URL, BRANCH, and COMMIT as a property in the manifest 
entry."
                                       #:heading (G_ "New in this 
revision:\n"))))
     (_ #t)))
 
-(define* (build-and-install source config-dir
-                            #:key verbose? url branch commit)
+(define* (build-and-install instances config-dir
+                            #:key verbose?)
   "Build the tool from SOURCE, and install it in CONFIG-DIR."
   (define update-profile
     (store-lift build-and-use-profile))
@@ -232,15 +161,9 @@ URL, BRANCH, and COMMIT as a property in the manifest 
entry."
   (define profile
     (string-append config-dir "/current"))
 
-  (mlet* %store-monad ((drv   (build-from-source source
-                                                 #:commit commit
-                                                 #:verbose? verbose?))
-                       (entry (derivation->manifest-entry drv
-                                                          #:url url
-                                                          #:branch branch
-                                                          #:commit commit)))
+  (mlet %store-monad ((manifest (channel-instances->manifest instances)))
     (mbegin %store-monad
-      (update-profile profile (manifest (list entry)))
+      (update-profile profile manifest)
       (return (display-profile-news profile)))))
 
 (define (honor-lets-encrypt-certificates! store)
@@ -426,45 +349,106 @@ and ALIST2 differ, display HEADING upfront."
                ((numbers ...)
                 (list-generations profile numbers)))))))))
 
+(define (channel-list opts)
+  "Return the list of channels to use.  If OPTS specify a channel file,
+channels are read from there; otherwise, if ~/.config/guix/channels.scm
+exists, read it; otherwise %DEFAULT-CHANNELS is used.  Apply channel
+transformations specified in OPTS (resulting from '--url', '--commit', or
+'--branch'), if any."
+  (define file
+    (assoc-ref opts 'channel-file))
+
+  (define default-file
+    (string-append (config-directory) "/channels.scm"))
+
+  (define (load-channels file)
+    (let ((result (load* file (make-user-module '((guix channels))))))
+      (if (and (list? result) (every channel? result))
+          result
+          (leave (G_ "'~a' did not return a list of channels~%") file))))
+
+  (define channels
+    (cond (file
+           (load-channels file))
+          ((file-exists? default-file)
+           (load-channels default-file))
+          (else
+           %default-channels)))
+
+  (define (environment-variable)
+    (match (getenv "GUIX_PULL_URL")
+      (#f #f)
+      (url
+       (warning (G_ "The 'GUIX_PULL_URL' environment variable is deprecated.
+Use '~/.config/guix/channels.scm' instead."))
+       url)))
+
+  (let ((ref (assoc-ref opts 'ref))
+        (url (or (assoc-ref opts 'repository-url)
+                 (environment-variable))))
+    (if (or ref url)
+        (match channels
+          ((one)
+           ;; When there's only one channel, apply '--url', '--commit', and
+           ;; '--branch' to this specific channel.
+           (let ((url (or url (channel-url one))))
+             (list (match ref
+                     (('commit . commit)
+                      (channel (inherit one)
+                               (url url) (commit commit) (branch #f)))
+                     (('branch . branch)
+                      (channel (inherit one)
+                               (url url) (commit #f) (branch branch)))
+                     (#f
+                      (channel (inherit one) (url url)))))))
+          (_
+           ;; Otherwise bail out.
+           (leave
+            (G_ "'--url', '--commit', and '--branch' are not applicable~%"))))
+        channels)))
+
 
 (define (guix-pull . args)
-  (define (use-le-certs? url)
-    (string-prefix? "https://git.savannah.gnu.org/"; url))
-
   (with-error-handling
     (with-git-error-handling
-     (let* ((opts  (parse-command-line args %options
-                                       (list %default-options)))
-            (url   (assoc-ref opts 'repository-url))
-            (ref   (assoc-ref opts 'ref))
-            (cache (string-append (cache-directory) "/pull")))
+     (let* ((opts     (parse-command-line args %options
+                                          (list %default-options)))
+            (cache    (string-append (cache-directory) "/pull"))
+            (channels (channel-list opts)))
+
        (cond ((assoc-ref opts 'query)
               (process-query opts))
              ((assoc-ref opts 'dry-run?)
               #t)                                 ;XXX: not very useful
              (else
               (with-store store
-                (parameterize ((%graft? (assoc-ref opts 'graft?)))
+                (parameterize ((%graft? (assoc-ref opts 'graft?))
+                               (%repository-cache-directory cache))
                   (set-build-options-from-command-line store opts)
 
-                  ;; For reproducibility, always refer to the LE certificates
-                  ;; when we know we're talking to Savannah.
-                  (when (use-le-certs? url)
-                    (honor-lets-encrypt-certificates! store))
-
-                  (format (current-error-port)
-                          (G_ "Updating from Git repository at '~a'...~%")
-                          url)
-
-                  (let-values (((checkout commit)
-                                (latest-repository-commit store url
-                                                          #:ref ref
-                                                          #:cache-directory
-                                                          cache)))
+                  ;; When certificates are already installed, use them.
+                  ;; Otherwise, use the Let's Encrypt certificates, which we
+                  ;; know Savannah uses.
+                  (let ((certs (or (getenv "SSL_CERT_DIR") "/etc/ssl/certs")))
+                    (unless (file-exists? certs)
+                      (honor-lets-encrypt-certificates! store)))
 
+                  (let ((instances (latest-channel-instances store channels)))
                     (format (current-error-port)
-                            (G_ "Building from Git commit ~a...~%")
-                            commit)
+                            (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
@@ -472,13 +456,7 @@ and ALIST2 differ, display HEADING upfront."
                                          %bootstrap-guile
                                          (canonical-package guile-2.2)))))
                       (run-with-store store
-                        (build-and-install checkout (config-directory)
-                                           #:url url
-                                           #:branch (match ref
-                                                      (('branch . branch)
-                                                       branch)
-                                                      (_ #f))
-                                           #:commit commit
+                        (build-and-install instances (config-directory)
                                            #:verbose?
                                            (assoc-ref opts 
'verbose?)))))))))))))
 
diff --git a/po/guix/POTFILES.in b/po/guix/POTFILES.in
index d11f408..7f88135 100644
--- a/po/guix/POTFILES.in
+++ b/po/guix/POTFILES.in
@@ -38,4 +38,5 @@ guix/upstream.scm
 guix/ui.scm
 guix/http-client.scm
 guix/nar.scm
+guix/channels.scm
 nix/nix-daemon/guix-daemon.cc



reply via email to

[Prev in Thread] Current Thread [Next in Thread]