1 ;;; GNU Guix --- Functional package management for GNU
2 ;;; Copyright © 2018, 2019 Ludovic Courtès <ludo@gnu.org>
3 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
4 ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
6 ;;; This file is part of GNU Guix.
8 ;;; GNU Guix is free software; you can redistribute it and/or modify it
9 ;;; under the terms of the GNU General Public License as published by
10 ;;; the Free Software Foundation; either version 3 of the License, or (at
11 ;;; your option) any later version.
13 ;;; GNU Guix is distributed in the hope that it will be useful, but
14 ;;; WITHOUT ANY WARRANTY; without even the implied warranty of
15 ;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
16 ;;; GNU General Public License for more details.
18 ;;; You should have received a copy of the GNU General Public License
19 ;;; along with GNU Guix. If not, see <http://www.gnu.org/licenses/>.
21 (define-module (guix channels)
22 #:use-module (guix git)
23 #:use-module (guix records)
24 #:use-module (guix gexp)
25 #:use-module (guix modules)
26 #:use-module (guix discovery)
27 #:use-module (guix monads)
28 #:use-module (guix profiles)
29 #:use-module (guix derivations)
30 #:use-module (guix combinators)
31 #:use-module (guix diagnostics)
32 #:use-module (guix store)
33 #:use-module (guix i18n)
34 #:use-module ((guix utils)
35 #:select (source-properties->location
37 #:use-module (srfi srfi-1)
38 #:use-module (srfi srfi-2)
39 #:use-module (srfi srfi-9)
40 #:use-module (srfi srfi-11)
41 #:use-module (srfi srfi-34)
42 #:use-module (srfi srfi-35)
43 #:autoload (guix self) (whole-package make-config.scm)
44 #:autoload (guix inferior) (gexp->derivation-in-inferior) ;FIXME: circular dep
45 #:use-module (ice-9 match)
46 #:use-module (ice-9 vlist)
59 channel-instance-channel
60 channel-instance-commit
61 channel-instance-checkout
63 latest-channel-instances
64 checkout->channel-instance
65 latest-channel-derivation
66 channel-instances->manifest
67 %channel-profile-hooks
68 channel-instances->derivation
74 ;;; This module implements "channels." A channel is usually a source of
75 ;;; package definitions. There's a special channel, the 'guix' channel, that
76 ;;; provides all of Guix, including its commands and its documentation.
77 ;;; User-defined channels are expected to typically provide a bunch of .scm
78 ;;; files meant to be added to the '%package-search-path'.
80 ;;; This module provides tools to fetch and update channels from a Git
81 ;;; repository and to build them.
85 (define-record-type* <channel> channel make-channel
89 (branch channel-branch (default "master"))
90 (commit channel-commit (default #f))
91 (location channel-location
92 (default (current-source-location)) (innate)))
94 (define %default-channels
95 ;; Default list of channels.
99 (url "https://git.savannah.gnu.org/git/guix.git"))))
101 (define (guix-channel? channel)
102 "Return true if CHANNEL is the 'guix' channel."
103 (eq? 'guix (channel-name channel)))
105 (define-record-type <channel-instance>
106 (channel-instance channel commit checkout)
108 (channel channel-instance-channel)
109 (commit channel-instance-commit)
110 (checkout channel-instance-checkout))
112 (define-record-type <channel-metadata>
113 (channel-metadata directory dependencies)
115 (directory channel-metadata-directory) ;string with leading slash
116 (dependencies channel-metadata-dependencies)) ;list of <channel>
118 (define (channel-reference channel)
119 "Return the \"reference\" for CHANNEL, an sexp suitable for
120 'latest-repository-commit'."
121 (match (channel-commit channel)
122 (#f `(branch . ,(channel-branch channel)))
123 (commit `(commit . ,(channel-commit channel)))))
125 (define (read-channel-metadata port)
126 "Read from PORT channel metadata in the format expected for the
127 '.guix-channel' file. Return a <channel-metadata> record, or raise an error
128 if valid metadata could not be read from PORT."
130 (('channel ('version 0) properties ...)
131 (let ((directory (and=> (assoc-ref properties 'directory) first))
132 (dependencies (or (assoc-ref properties 'dependencies) '())))
134 (cond ((not directory) "/")
135 ((string-prefix? "/" directory) directory)
136 (else (string-append "/" directory)))
138 (let ((get (lambda* (key #:optional default)
139 (or (and=> (assoc-ref item key) first) default))))
140 (and-let* ((name (get 'name))
142 (branch (get 'branch "master")))
147 (commit (get 'commit))))))
149 ((and ('channel ('version version) _ ...) sexp)
151 (&message (message "unsupported '.guix-channel' version"))
153 (location (source-properties->location
154 (source-properties sexp)))))))
157 (&message (message "invalid '.guix-channel' file"))
159 (location (source-properties->location
160 (source-properties sexp)))))))))
162 (define (read-channel-metadata-from-source source)
163 "Return a channel-metadata record read from channel's SOURCE/.guix-channel
164 description file, or return the default channel-metadata record if that file
168 (call-with-input-file (string-append source "/.guix-channel")
169 read-channel-metadata))
171 (if (= ENOENT (system-error-errno args))
172 (channel-metadata "/" '())
173 (apply throw args)))))
175 (define (channel-instance-metadata instance)
176 "Return a channel-metadata record read from the channel INSTANCE's
177 description file or its default value."
178 (read-channel-metadata-from-source (channel-instance-checkout instance)))
180 (define (channel-instance-dependencies instance)
181 "Return the list of channels that are declared as dependencies for the given
183 (channel-metadata-dependencies (channel-instance-metadata instance)))
185 (define* (latest-channel-instances store channels #:optional (previous-channels '()))
186 "Return a list of channel instances corresponding to the latest checkouts of
187 CHANNELS and the channels on which they depend. PREVIOUS-CHANNELS is a list
188 of previously processed channels."
189 ;; Only process channels that are unique, or that are more specific than a
190 ;; previous channel specification.
191 (define (ignore? channel others)
192 (member channel others
194 (and (eq? (channel-name a) (channel-name b))
195 (or (channel-commit b)
196 (not (or (channel-commit a)
197 (channel-commit b))))))))
199 ;; Accumulate a list of instances. A list of processed channels is also
200 ;; accumulated to decide on duplicate channel specifications.
201 (define-values (resulting-channels instances)
202 (fold2 (lambda (channel previous-channels instances)
203 (if (ignore? channel previous-channels)
204 (values previous-channels instances)
206 (format (current-error-port)
207 (G_ "Updating channel '~a' from Git repository at '~a'...~%")
208 (channel-name channel)
209 (channel-url channel))
210 (let-values (((checkout commit)
211 (latest-repository-commit store (channel-url channel)
212 #:ref (channel-reference
214 (let ((instance (channel-instance channel commit checkout)))
215 (let-values (((new-instances new-channels)
216 (latest-channel-instances
218 (channel-instance-dependencies instance)
220 (values (append (cons channel new-channels)
222 (append (cons instance new-instances)
228 (let ((instance-name (compose channel-name channel-instance-channel)))
229 ;; Remove all earlier channel specifications if they are followed by a
230 ;; more specific one.
231 (values (delete-duplicates instances
233 (eq? (instance-name a) (instance-name b))))
234 resulting-channels)))
236 (define* (checkout->channel-instance checkout
238 (url checkout) (name 'guix))
239 "Return a channel instance for CHECKOUT, which is assumed to be a checkout
240 of COMMIT at URL. Use NAME as the channel name."
241 (let* ((commit (or commit (make-string 40 #\0)))
242 (channel (channel (name name)
245 (channel-instance channel commit checkout)))
247 (define %self-build-file
248 ;; The file containing code to build Guix. This serves the same purpose as
249 ;; a makefile, and, similarly, is intended to always keep this name.
250 "build-aux/build-self.scm")
252 (define %pull-version
253 ;; This is the version of the 'guix pull' protocol. It specifies what's
254 ;; expected from %SELF-BUILD-FILE. The initial version ("0") was when we'd
255 ;; place a set of compiled Guile modules in ~/.config/guix/latest.
258 (define (standard-module-derivation name source core dependencies)
259 "Return a derivation that builds with CORE, a Guix instance, the Scheme
260 modules in SOURCE and that depend on DEPENDENCIES, a list of lowerable
261 objects. The assumption is that SOURCE contains package modules to be added
262 to '%package-module-path'."
264 (let* ((metadata (read-channel-metadata-from-source source))
265 (directory (channel-metadata-directory metadata)))
268 ;; This is code that we'll run in CORE, a Guix instance, with its own
269 ;; modules and so on. That way, we make sure these modules are built for
270 ;; the right Guile version, with the right dependencies, and that they get
271 ;; to see the right (gnu packages …) modules.
272 (with-extensions dependencies
274 (use-modules (guix build compile)
279 (string-append #$output "/lib/guile/" (effective-version)
282 (string-append #$output "/share/guile/site/"
283 (effective-version)))
285 (let* ((subdir #$directory)
286 (source (string-append #$source subdir)))
287 (compile-files source go (find-files source "\\.scm$"))
288 (mkdir-p (dirname scm))
289 (symlink (string-append #$source subdir) scm))
293 (gexp->derivation-in-inferior name build core)))
295 (define* (build-from-source name source
296 #:key core verbose? commit
298 "Return a derivation to build Guix from SOURCE, using the self-build script
299 contained therein; use COMMIT as the version string. When CORE is true, build
300 package modules under SOURCE using CORE, an instance of Guix."
301 ;; Running the self-build script makes it easier to update the build
302 ;; procedure: the self-build script of the Guix-to-be-installed contains the
303 ;; right dependencies, build procedure, etc., which the Guix-in-use may not
306 (string-append source "/" %self-build-file))
308 (if (file-exists? script)
309 (let ((build (save-module-excursion
311 ;; Disable deprecation warnings; it's OK for SCRIPT to
312 ;; use deprecated APIs and the user doesn't have to know
314 (parameterize ((guix-warning-port
315 (%make-void-port "w")))
316 (primitive-load script))))))
317 ;; BUILD must be a monadic procedure of at least one argument: the
320 ;; Note: BUILD can return #f if it does not support %PULL-VERSION. In
321 ;; the future we'll fall back to a previous version of the protocol
322 ;; when that happens.
323 (build source #:verbose? verbose? #:version commit
324 #:pull-version %pull-version))
326 ;; Build a set of modules that extend Guix using the standard method.
327 (standard-module-derivation name source core dependencies)))
329 (define* (build-channel-instance instance
330 #:optional core (dependencies '()))
331 "Return, as a monadic value, the derivation for INSTANCE, a channel
332 instance. DEPENDENCIES is a list of extensions providing Guile modules that
333 INSTANCE depends on."
334 (build-from-source (symbol->string
335 (channel-name (channel-instance-channel instance)))
336 (channel-instance-checkout instance)
337 #:commit (channel-instance-commit instance)
339 #:dependencies dependencies))
341 (define (resolve-dependencies instances)
342 "Return a procedure that, given one of the elements of INSTANCES, returns
343 list of instances it depends on."
344 (define channel-instance-name
345 (compose channel-name channel-instance-channel))
347 (define table ;map a name to an instance
348 (fold (lambda (instance table)
349 (vhash-consq (channel-instance-name instance)
355 (fold (lambda (instance edges)
356 (fold (lambda (channel edges)
357 (let ((name (channel-name channel)))
358 (match (vhash-assq name table)
360 (vhash-consq instance target edges)))))
362 (channel-instance-dependencies instance)))
367 (vhash-foldq* cons '() instance edges)))
369 (define (channel-instance-derivations instances)
370 "Return the list of derivations to build INSTANCES, in the same order as
372 (define core-instance
373 ;; The 'guix' channel is treated specially: it's an implicit dependency of
374 ;; all the other channels.
375 (find (lambda (instance)
376 (guix-channel? (channel-instance-channel instance)))
380 (resolve-dependencies instances))
382 (define (instance->derivation instance)
383 (mlet %store-monad ((system (current-system)))
384 (mcached (if (eq? instance core-instance)
385 (build-channel-instance instance)
386 (mlet %store-monad ((core (instance->derivation core-instance))
387 (deps (mapm %store-monad instance->derivation
389 (build-channel-instance instance core deps)))
393 (unless core-instance
394 (let ((loc (and=> (any (compose channel-location channel-instance-channel)
396 source-properties->location)))
397 (raise (apply make-compound-condition
399 (&message (message "'guix' channel is lacking")))
401 (list (condition (&error-location (location loc))))
404 (mapm %store-monad instance->derivation instances))
406 (define (whole-package-for-legacy name modules)
407 "Return a full-blown Guix package for MODULES, a derivation that builds Guix
408 modules in the old ~/.config/guix/latest style."
410 (resolve-interface '(gnu packages guile)))
412 (define modules+compiled
413 ;; Since MODULES contains both .scm and .go files at its root, re-bundle
414 ;; it so that it has share/guile/site and lib/guile, which is what
415 ;; 'whole-package' expects.
416 (computed-file (derivation-name modules)
417 (with-imported-modules '((guix build utils))
419 (use-modules (guix build utils))
424 (string-append #$output "/share/guile/site"))
426 (string-append #$output "/lib/guile/" version))
428 (mkdir-p share) (mkdir-p lib)
429 (symlink #$modules (string-append share "/" version))
430 (symlink #$modules (string-append lib "/site-ccache"))))))
432 (letrec-syntax ((list (syntax-rules (->)
435 ((_ (module -> variable) rest ...)
436 (cons (module-ref (resolve-interface
437 '(gnu packages module))
440 ((_ variable rest ...)
441 (cons (module-ref packages 'variable)
443 (whole-package name modules+compiled
445 ;; In the "old style", %SELF-BUILD-FILE would simply return a
446 ;; derivation that builds modules. We have to infer what the
447 ;; dependencies of these modules were.
448 (list guile-json guile-git guile-bytestructures
449 (ssh -> guile-ssh) (tls -> gnutls)))))
451 (define (old-style-guix? drv)
452 "Return true if DRV corresponds to a ~/.config/guix/latest style of
454 ;; Here we rely on a gross historical fact: that derivations produced by the
455 ;; "old style" (before commit 8a0d9bc8a3f153159d9e239a151c0fa98f1e12d8,
456 ;; dated May 30, 2018) did not depend on "guix-command.drv".
457 (not (find (lambda (input)
458 (string=? "guix-command"
460 (derivation-input-derivation input))))
461 (derivation-inputs drv))))
463 (define (channel-instances->manifest instances)
464 "Return a profile manifest with entries for all of INSTANCES, a list of
466 (define (instance->entry instance drv)
467 (let ((commit (channel-instance-commit instance))
468 (channel (channel-instance-channel instance)))
470 (name (symbol->string (channel-name channel)))
471 (version (string-take commit 7))
472 (item (if (guix-channel? channel)
473 (if (old-style-guix? drv)
474 (whole-package-for-legacy (string-append name "-" version)
479 `((source (repository
481 (url ,(channel-url channel))
482 (branch ,(channel-branch channel))
483 (commit ,commit))))))))
485 (mlet* %store-monad ((derivations (channel-instance-derivations instances))
486 (entries -> (map instance->entry instances derivations)))
487 (return (manifest entries))))
489 (define (package-cache-file manifest)
490 "Build a package cache file for the instance in MANIFEST. This is meant to
491 be used as a profile hook."
492 (mlet %store-monad ((profile (profile-derivation manifest
497 (use-modules (gnu packages))
499 (if (defined? 'generate-package-cache)
501 ;; Delegate package cache generation to the inferior.
502 (format (current-error-port)
503 "Generating package cache for '~a'...~%"
505 (generate-package-cache #$output))
508 (gexp->derivation-in-inferior "guix-package-cache" build
511 ;; If the Guix in PROFILE is too old and
512 ;; lacks 'guix repl', don't build the cache
513 ;; instead of failing.
516 #:properties '((type . profile-hook)
517 (hook . package-cache))
520 (define %channel-profile-hooks
521 ;; The default channel profile hooks.
522 (cons package-cache-file %default-profile-hooks))
524 (define (channel-instances->derivation instances)
525 "Return the derivation of the profile containing INSTANCES, a list of
527 (mlet %store-monad ((manifest (channel-instances->manifest instances)))
528 (profile-derivation manifest
529 #:hooks %channel-profile-hooks)))
531 (define latest-channel-instances*
532 (store-lift latest-channel-instances))
534 (define* (latest-channel-derivation #:optional (channels %default-channels))
535 "Return as a monadic value the derivation that builds the profile for the
536 latest instances of CHANNELS."
537 (mlet %store-monad ((instances (latest-channel-instances* channels)))
538 (channel-instances->derivation instances)))
540 (define (profile-channels profile)
541 "Return the list of channels corresponding to entries in PROFILE. If
542 PROFILE is not a profile created by 'guix pull', return the empty list."
543 (filter-map (lambda (entry)
544 (match (assq 'source (manifest-entry-properties entry))
545 (('source ('repository ('version 0)
550 (channel (name (string->symbol
551 (manifest-entry-name entry)))
555 ;; No channel information for this manifest entry.
556 ;; XXX: Pre-0.15.0 Guix did not provide that information,
557 ;; but there's not much we can do in that case.
560 ;; Show most recently installed packages last.
562 (manifest-entries (profile-manifest profile)))))