tribes/guix
1
0
Fork 1
mirror of https://git.savannah.gnu.org/git/guix.git synced 2026-05-28 12:01:49 +02:00
Code Activity

etc: Move manifests to a separate directory.

Browse Source 
* etc/disarchive-manifest.scm, etc/hurd-manifest.scm,
etc/kernels-manifest.scm, etc/release-manifest.scm,
etc/source-manifest.scm, etc/system-tests.scm,
etc/time-travel-manifest.scm, etc/upgrade-manifest.scm: Move to…
* etc/manifests: … here, and drop “-manifest” from file name.
* Makefile.am (EXTRA_DIST, assert-binaries-available, check-system):
Adjust accordingly.

Change-Id: Iedee3d0cdd42e72ef8bbf654ea5d3b47dca95874
This commit is contained in:
Ludovic Courtès
2024-12-02 15:04:46 +01:00
parent b8a45bd047
commit 12d00767f0
9 changed files with 11 additions and 11 deletions
Download Patch File Download Diff File Expand all files Collapse all files
etc/manifests/disarchive.scm
+136
View File
@@ -0,0 +1,136 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021-2024 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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/>.
;;; This file returns a manifest that builds a directory containing Disarchive
;;; metadata for all the tarballs packages refer to.
(use-modules (srfi srfi-1) (ice-9 match)
(guix packages) (guix gexp) (guix profiles)
(guix base16)
(gnu packages))
(include "source.scm")
(define (tarball-origin? origin)
(match (origin-actual-file-name origin)
(#f #f)
((? string? file)
;; As of version 0.4.0, Disarchive can only deal with raw tarballs,
;; gzip-compressed tarballs, and xz-compressed tarballs.
(and (origin-hash origin)
(or (string-suffix? ".tar.gz" file)
(string-suffix? ".tgz" file)
(string-suffix? ".tar.bz2" file)
(string-suffix? ".tbz2" file)
(string-suffix? ".tar.xz" file)
(string-suffix? ".tar" file))))))
(define (origin->disarchive origin)
"Return a directory containing Disarchive metadata for ORIGIN, a tarball, or
an empty directory if ORIGIN could not be disassembled."
(define file-name
(let ((hash (origin-hash origin)))
(string-append (symbol->string (content-hash-algorithm hash))
"/"
(bytevector->base16-string
(content-hash-value hash)))))
(define disarchive
(specification->package "disarchive"))
(define build
(with-imported-modules '((guix build utils))
#~(begin
(use-modules (guix build utils)
(srfi srfi-34))
(define tarball
#+(upstream-origin origin))
(define file-name
(string-append #$output "/" #$file-name))
(define profile
#+(profile (content (packages->manifest (list disarchive)))))
(mkdir-p (dirname file-name))
(setenv "PATH" (string-append profile "/bin"))
(setenv "GUILE_LOAD_PATH"
(string-append profile "/share/guile/site/"
(effective-version)))
(setenv "GUILE_LOAD_COMPILED_PATH"
(string-append profile "/lib/guile/" (effective-version)
"/site-ccache"))
(guard (c ((invoke-error? c)
;; Sometimes Disarchive fails with "could not find Gzip
;; compressor". When that happens, produce an empty
;; directory instead of failing.
(report-invoke-error c)
(delete-file file-name)))
(with-output-to-file file-name
(lambda ()
;; Disarchive records the tarball name in its output. Thus,
;; strip the hash from TARBALL.
(let ((short-name (strip-store-file-name tarball)))
(symlink tarball short-name)
(invoke "disarchive" "disassemble" short-name))))))))
(computed-file (match (origin-actual-file-name origin)
((? string? str) (string-append str ".dis"))
(#f "anonymous-tarball.dis"))
build))
;; The manifest containing Disarchive data.
(let* ((origins (all-origins))
(disarchives
(filter-map (lambda (origin)
(and (tarball-origin? origin)
;; Dismiss origins with (sha256 #f) such as that of
;; IceCat.
(and=> (origin-hash origin)
content-hash-value)
;; FIXME: Exclude the Chromium tarball because it's
;; huge and "disarchive disassemble" exceeds the
;; max-silent timeout.
(not (string-prefix?
"chromium-"
(origin-actual-file-name origin)))
(manifest-entry
(name
(string-append (origin-actual-file-name origin)
".dis"))
(version "0")
(item (origin->disarchive origin)))))
origins)))
(manifest
(cons (manifest-entry
(name "disarchive-collection")
(version (number->string (length origins)))
(item (directory-union "disarchive-collection"
(map manifest-entry-item disarchives)
#:copy? #t)))
;; Cuirass can distribute derivation builds to build machines if and
;; only if it has one "job" per derivation. Thus, add them here in
;; addition to "disarchive-collection".
disarchives)))
etc/manifests/hurd.scm
+85
View File
@@ -0,0 +1,85 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020, 2023 Janneke Nieuwenhuizen <janneke@gnu.org>
;;;
;;; 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/>.
;;; Commentary:
;;;
;;; This file defines a manifest with a selection of packages for Cuirass to
;;; build for GNU/Hurd.
;;;
;;; Code:
(use-modules (gnu)
(gnu system hurd)
(guix packages)
(guix utils)
(ice-9 match)
(srfi srfi-1))
(use-package-modules
autotools base bootloaders commencement compression file gawk gdb gettext gtk
guile guile-xyz hurd less m4 package-management python ssh
texinfo tls version-control)
(define (input->package input)
"Return the INPUT as package, or #f."
(match input
((label (and (? package?) package))
package)
((label (and (? package?) package . output))
(cons package output))
(_ #f)))
(define guix-dependencies
(filter-map input->package
(fold alist-delete (package-direct-inputs guix)
'("glibc-utf8-locales" "graphviz" "po4a"))))
(define (package-without-tests p)
(package/inherit p
(arguments
(substitute-keyword-arguments (package-arguments p)
((#:tests? _ #f) #f)))))
(packages->manifest
(cons*
;; where it all starts
hello
;; development utililities
diffutils file findutils gawk grep gzip less m4 openssh-sans-x tar xz
;; development packages
autoconf automake libtool texinfo
gcc-toolchain gdb-minimal git-minimal gnu-make
gettext-minimal python-minimal
guile-3.0 guile-2.2 guile-2.0
guile-readline guile-colorized
guile-gnutls guile-fibers guile-json-4
;; ourselves!
(package-without-tests guix)
;; system
grub-minimal grub
;; system reconfigure
gdk-pixbuf
(append
guix-dependencies
%base-packages/hurd)))
etc/manifests/kernels.scm
+35
View File
@@ -0,0 +1,35 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 Leo Famulari <leo@famulari.name>
;;;
;;; 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/>.
;;; This file returns a manifest of packages related to linux-libre.
;;; Simplistically, it selects packages whose names begin with "linux-libre".
;;; It is used to assist continuous integration of the kernel packages.
(use-modules (guix packages)
(guix profiles)
(gnu packages))
(manifest
(map package->manifest-entry
(fold-packages
(lambda (package lst)
(if (string-prefix? "linux-libre"
(package-name package))
(cons package lst)
lst))
'())))
etc/manifests/release.scm
+175
View File
@@ -0,0 +1,175 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2020-2022, 2024 Ludovic Courtès <ludo@gnu.org>
;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
;;; Copyright © 2023 Andreas Enge <andreas@enge.fr>
;;;
;;; 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/>.
;;; This file returns a manifest containing release-critical bit, for all the
;;; supported architectures and cross-compilation targets.
(use-modules (gnu packages)
(guix packages)
(guix profiles)
((guix platform) #:select (targets))
((gnu services xorg) #:select (%default-xorg-modules))
(guix utils)
(guix gexp)
(srfi srfi-1)
(srfi srfi-26))
(define* (package->manifest-entry* package system
#:key target)
"Return a manifest entry for PACKAGE on SYSTEM, optionally cross-compiled to
TARGET."
(manifest-entry
(inherit (package->manifest-entry package))
(name (string-append (package-name package) "." system
(if target
(string-append "." target)
"'")))
(item (with-parameters ((%current-system system)
(%current-target-system target))
package))))
(define %base-packages
;; Packages that must be substitutable on all the platforms Guix supports.
(map specification->package
'("bootstrap-tarballs" "gcc-toolchain" "nss-certs"
"openssh" "emacs" "vim" "python" "guile" "guix")))
(define %base-packages/armhf
;; The guix package doesn't build natively on armhf due to Guile memory
;; issues compiling the package modules
(remove (lambda (package)
(string=? (package-name package) "guix"))
%base-packages))
(define %base-packages/hurd
;; XXX: For now we are less demanding of "i586-gnu".
(map specification->package
'("coreutils" "grep" "findutils" "gawk" "make"
#;"gcc-toolchain" "tar" "xz")))
(define %system-packages
;; Key packages proposed by the Guix System installer.
(append (map specification->package
'("xorg-server" "xfce" "gnome" "mate" "enlightenment"
"openbox" "awesome" "i3-wm" "ratpoison"
"emacs" "emacs-exwm" "emacs-desktop-environment"
"xlockmore" "slock" "libreoffice"
"connman" "network-manager" "network-manager-applet"
"openssh" "ntp" "tor"
"linux-libre" "grub-hybrid"
"icecat"))
%default-xorg-modules))
(define %packages-to-cross-build
;; Packages that must be cross-buildable from x86_64-linux.
;; FIXME: Add (@ (gnu packages gcc) gcc) when <https://bugs.gnu.org/40463>
;; is fixed.
(append (list (@ (gnu packages guile) guile-3.0/pinned))
(map specification->package
'("coreutils" "grep" "sed" "findutils" "diffutils" "patch"
"gawk" "gettext" "gzip" "xz"
"hello" "zlib"))))
(define %packages-to-cross-build-for-mingw
;; Many things don't build for MinGW. Restrict to what's known to work.
(map specification->package '("hello")))
(define %cross-bootstrap-targets
;; Cross-compilation triplets for which 'bootstrap-tarballs' must be
;; buildable.
'("i586-pc-gnu"
"arm-linux-gnueabihf"
"aarch64-linux-gnu"))
;;;
;;; Manifests.
;;;
(define %base-manifest
(manifest
(append-map (lambda (system)
(map (cut package->manifest-entry* <> system)
(cond ((string=? system "i586-gnu")
%base-packages/hurd)
((string=? system "armhf-linux")
%base-packages/armhf)
((string=? system "powerpc64le-linux")
;; FIXME: Drop 'bootstrap-tarballs' until
;; <https://bugs.gnu.org/48055> is fixed.
(drop %base-packages 1))
(else
%base-packages))))
%cuirass-supported-systems)))
(define %system-manifest
(manifest
(append-map (lambda (system)
;; Some of %SYSTEM-PACKAGES are currently unsupported on some
;; systems--e.g., GNOME on non-x86_64, due to Rust. Filter
;; them out.
(filter-map (lambda (package)
(and (supported-package? package system)
(package->manifest-entry* package system)))
%system-packages))
'("x86_64-linux" "i686-linux")))) ;Guix System
(define %cross-manifest
(manifest
(append-map (lambda (target)
(map (cut package->manifest-entry* <> "x86_64-linux"
#:target target)
(if (target-mingw? target)
%packages-to-cross-build-for-mingw
%packages-to-cross-build)))
(fold delete (targets)
'(;; Like in (gnu ci), dismiss cross-compilation to x86:
;; it's pointless.
"x86_64-linux-gnu"
"i686-linux-gnu"
;; Ignore obsolete systems, as in (gnu ci).
"mips64el-linux-gnu"
"powerpc-linux-gnu"
"powerpc64-linux-gnu"
;; Ignore bare-metal targets.
"avr"
"or1k-elf"
"xtensa-ath9k-elf"
;; XXX: Important bits like libsigsegv and libffi don't
;; support RISCV at the moment, so don't require RISCV
;; support.
"riscv64-linux-gnu")))))
(define %cross-bootstrap-manifest
(manifest
(map (lambda (target)
(package->manifest-entry*
(specification->package "bootstrap-tarballs")
"x86_64-linux" #:target target))
%cross-bootstrap-targets)))
;; Return the union of all three manifests.
(concatenate-manifests (list %base-manifest
%system-manifest
%cross-manifest
%cross-bootstrap-manifest))
etc/manifests/source.scm
+55
View File
@@ -0,0 +1,55 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2021, 2024 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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/>.
;;; This file returns a manifest containing origins of all the packages. The
;;; main purpose is to allow continuous integration services to keep upstream
;;; source code around. It can also be passed to 'guix weather -m'.
(use-modules (srfi srfi-1) (srfi srfi-26)
(ice-9 match) (ice-9 vlist)
(guix packages) (guix profiles)
(gnu packages))
(define (upstream-origin source)
"Return SOURCE without any patches or snippet."
(origin (inherit source)
(snippet #f) (patches '())))
(define (all-origins)
"Return the list of origins referred to by all the packages."
(let loop ((packages (all-packages))
(origins '())
(visited vlist-null))
(match packages
((head . tail)
(let ((new (remove (cut vhash-assq <> visited)
(package-direct-sources head))))
(loop tail (append new origins)
(fold (cut vhash-consq <> #t <>)
visited new))))
(()
origins))))
;; Return a manifest containing all the origins.
(manifest (map (lambda (origin)
(manifest-entry
(name (or (origin-actual-file-name origin)
"origin"))
(version "0")
(item (upstream-origin origin))))
(all-origins)))
etc/manifests/system-tests.scm
+103
View File
@@ -0,0 +1,103 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2016, 2018-2020, 2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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/>.
(use-modules (gnu tests)
(gnu packages package-management)
(guix monads)
(guix store)
((guix git-download) #:select (git-predicate))
((guix utils) #:select (current-source-directory))
(git)
(ice-9 match))
(define (source-commit directory)
"Return the commit of the head of DIRECTORY or #f if it could not be
determined."
(let ((repository #f))
(catch 'git-error
(lambda ()
(set! repository (repository-open directory))
(let* ((head (repository-head repository))
(target (reference-target head))
(commit (oid->string target)))
(repository-close! repository)
commit))
(lambda _
(when repository
(repository-close! repository))
#f))))
(define (tests-for-current-guix source commit)
"Return a list of tests for perform, using Guix built from SOURCE, a channel
instance."
;; Honor the 'TESTS' environment variable so that one can select a subset
;; of tests to run in the usual way:
;;
;; make check-system TESTS=installed-os
(let ((guix (channel-source->package source #:commit commit)))
(map (lambda (test)
(system-test
(inherit test)
(value (mparameterize %store-monad ((current-guix-package guix))
(system-test-value test)))))
(match (getenv "TESTS")
(#f
(all-system-tests))
((= string-tokenize (tests ...))
(filter (lambda (test)
(member (system-test-name test) tests))
(all-system-tests)))))))
(define (system-test->manifest-entry test)
"Return a manifest entry for TEST, a system test."
(manifest-entry
(name (string-append "test." (system-test-name test)))
(version "0")
(item test)))
(define (system-test-manifest)
"Return a manifest containing all the system tests, or all those selected by
the 'TESTS' environment variable."
(define source
(string-append (current-source-directory) "/.."))
(define commit
;; Fetch the current commit ID so we can potentially build the same
;; derivation as ci.guix.gnu.org.
(source-commit source))
;; Intern SOURCE so that 'build-from-source' in (guix channels) sees
;; "fresh" file names and thus doesn't find itself loading .go files
;; from ~/.cache/guile when it loads 'build-aux/build-self.scm'.
(let* ((source (local-file source
(if commit
(string-append "guix-"
(string-take commit 7))
"guix-source")
#:recursive? #t
#:select?
(or (git-predicate source)
(const #t))))
(tests (tests-for-current-guix source commit)))
(format (current-error-port) "Selected ~a system tests...~%"
(length tests))
(manifest (map system-test->manifest-entry tests))))
;; Return the manifest.
(system-test-manifest)
etc/manifests/time-travel.scm
+91
View File
@@ -0,0 +1,91 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2022 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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/>.
;;; This file returns a manifest containing entries to build past Guix
;;; releases from the current Guix, as per 'guix time-machine'.
(use-modules (srfi srfi-9) (ice-9 match)
(guix channels) (guix gexp)
((guix store) #:select (%store-monad))
((guix monads) #:select (mparameterize return))
((guix git) #:select (%repository-cache-directory))
((guix build utils) #:select (mkdir-p)))
;; Representation of the latest channels. This type exists just so we can
;; refer to such records in a gexp.
(define-record-type <guix-instance>
(guix-instance channels)
guix-instance?
(channels guix-instance-channels))
(define-gexp-compiler (guix-instance-compiler (instance <guix-instance>)
system target)
(match instance
(($ <guix-instance> channels)
;; When this manifest is evaluated by Cuirass, make sure it does not
;; fiddle with the cached checkout that Cuirass is also using since
;; concurrent accesses are unsafe.
(mparameterize %store-monad ((%repository-cache-directory
(string-append (%repository-cache-directory)
"/time-travel/" system)))
(return (mkdir-p (%repository-cache-directory)))
(latest-channel-derivation channels)))))
(define (guix-instance->manifest-entry instance)
"Return a manifest entry for INSTANCE."
(define (shorten commit)
(string-take commit 7))
(manifest-entry
(name "guix")
(version (string-join (map (compose shorten channel-commit)
(guix-instance-channels instance))
"-"))
(item instance)))
(define (commit->guix-instance commit)
"Return a Guix instance for COMMIT."
(guix-instance (list (channel
(inherit %default-guix-channel)
(commit commit)))))
(define %release-commits
;; Release commits: the list of version/commit pairs.
;;
;; Note: To merely compute the derivation of these revisions, we need to be
;; able to build their dependencies. Some of them no longer build from
;; source due to time traps like <https://issues.guix.gnu.org/58650>; those
;; need to be built beforehand in a virtual build machine running "in the
;; past".
'(("1.4.0" . "8e2f32cee982d42a79e53fc1e9aa7b8ff0514714")
("1.3.0" . "a0178d34f582b50e9bdbb0403943129ae5b560ff")
("1.2.0" . "a099685659b4bfa6b3218f84953cbb7ff9e88063")
("1.1.0" . "d62c9b2671be55ae0305bebfda17b595f33797f2")
("1.0.1" . "d68de958b60426798ed62797ff7c96c327a672ac")
("1.0.0" . "6298c3ffd9654d3231a6f25390b056483e8f407c")
("0.16.0" . "4a0b87f0ec5b6c2dcf82b372dd20ca7ea6acdd9c")))
(manifest
(map (match-lambda
((version . commit)
(let ((entry (guix-instance->manifest-entry
(commit->guix-instance commit))))
(manifest-entry
(inherit entry)
(version version)))))
%release-commits))
etc/manifests/upgrade.scm
+137
View File
@@ -0,0 +1,137 @@
;;; GNU Guix --- Functional package management for GNU
;;; Copyright © 2024 Ludovic Courtès <ludo@gnu.org>
;;;
;;; 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/>.
;; This manifest computes upgrades of key packages using updaters from (guix
;; upstream) and supporting code for the 'with-latest' transformation.
(use-modules (guix memoization)
(guix monads)
(guix graph)
(guix packages)
(guix profiles)
(guix store)
(guix transformations)
(guix upstream)
((guix scripts build) #:select (dependents))
((guix scripts graph) #:select (%bag-node-type))
((guix import github) #:select (%github-api))
(guix build-system gnu)
(guix build-system cmake)
((gnu packages) #:select (all-packages))
(gnu packages backup)
(gnu packages curl)
(gnu packages freedesktop)
(gnu packages gnupg)
(gnu packages ssh)
(gnu packages tls)
(gnu packages version-control)
(gnu packages xorg)
(ice-9 match)
(srfi srfi-1))
;; Bypass the GitHub updater: we'd need an API token or we would hit the rate
;; limit.
(%github-api "http://example.org")
(define security-packages
(list xorg-server
elogind
openssl
gnutls
curl
curl-ssh
libarchive
libgit2
libssh
;; GnuPG.
libassuan
libgpg-error
libgcrypt
libksba
npth
gnupg
gpgme
pinentry))
(define latest-version
(mlambdaq (package)
(package-with-upstream-version package
;; Preserve patches and snippets to get
;; exactly the same as what we'd have with
;; 'guix refresh -u PACKAGE'.
#:preserve-patches? #t
;; XXX: Disable source code authentication:
;; this requires a local keyring, populated
;; from key servers, but key servers may be
;; unreliable or may lack the upstream
;; keys. Leave it up to packagers to
;; actually authenticate code and make sure
;; it matches what this manifest computed.
#:authenticate? #f)))
(define individual-security-upgrades
;; Upgrades of individual packages with their direct dependents built
;; against that upgrade.
(manifest
(with-store store
(append-map (lambda (package)
(let* ((name (package-name package))
(newest (latest-version package))
(update (package-input-rewriting
`((,package . ,newest)))))
(map (lambda (package)
(manifest-entry
(inherit (package->manifest-entry
(update package)))
(name (string-append (package-name package)
"-with-latest-" name))))
(dependents store (list package) 1))))
security-packages))))
(define joint-security-upgrades
;; All of SECURITY-PACKAGES updated at once, together with their dependents.
(manifest
(with-store store
(let ((update-all (package-input-rewriting
(map (lambda (package)
`(,package . ,(latest-version package)))
security-packages))))
(map (lambda (package)
(manifest-entry
(inherit (package->manifest-entry
(update-all package)))
(name (string-append (package-name package) "-full-upgrade"))))
(dependents store security-packages 2))))))
;; Install a UTF-8 locale so that file names in Git checkouts are interpreted
;; as UTF-8 (the libgit2 source tree contains non-ASCII file names, for
;; instance). XXX: This works around the fact that 'cuirass register' and
;; thus 'cuirass evaluate' may not be running with a UTF-8 locale.
(unless (string-suffix? ".UTF-8" (setlocale LC_ALL))
(or (false-if-exception (setlocale LC_ALL "C.UTF-8"))
(false-if-exception (setlocale LC_ALL "en_US.UTF-8"))
(format (current-error-port) "warning: failed to install UTF-8 locale~%")))
(concatenate-manifests
(list individual-security-upgrades joint-security-upgrades))