aboutsummaryrefslogtreecommitdiff
path: root/etc/manifests
diff options
context:
space:
mode:
Diffstat (limited to 'etc/manifests')
-rw-r--r--etc/manifests/disarchive.scm136
-rw-r--r--etc/manifests/hurd.scm85
-rw-r--r--etc/manifests/kernels.scm35
-rw-r--r--etc/manifests/release.scm175
-rw-r--r--etc/manifests/source.scm55
-rw-r--r--etc/manifests/system-tests.scm103
-rw-r--r--etc/manifests/time-travel.scm91
-rw-r--r--etc/manifests/upgrade.scm137
8 files changed, 817 insertions, 0 deletions
diff --git a/etc/manifests/disarchive.scm b/etc/manifests/disarchive.scm
new file mode 100644
index 0000000000..a7f71414b6
--- /dev/null
+++ b/etc/manifests/disarchive.scm
@@ -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)))
diff --git a/etc/manifests/hurd.scm b/etc/manifests/hurd.scm
new file mode 100644
index 0000000000..cb6b82d5f8
--- /dev/null
+++ b/etc/manifests/hurd.scm
@@ -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)))
diff --git a/etc/manifests/kernels.scm b/etc/manifests/kernels.scm
new file mode 100644
index 0000000000..bacb222d64
--- /dev/null
+++ b/etc/manifests/kernels.scm
@@ -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))
+ '())))
diff --git a/etc/manifests/release.scm b/etc/manifests/release.scm
new file mode 100644
index 0000000000..b003f216ff
--- /dev/null
+++ b/etc/manifests/release.scm
@@ -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))
diff --git a/etc/manifests/source.scm b/etc/manifests/source.scm
new file mode 100644
index 0000000000..3e1ae07959
--- /dev/null
+++ b/etc/manifests/source.scm
@@ -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)))
diff --git a/etc/manifests/system-tests.scm b/etc/manifests/system-tests.scm
new file mode 100644
index 0000000000..221a63bb7f
--- /dev/null
+++ b/etc/manifests/system-tests.scm
@@ -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)
diff --git a/etc/manifests/time-travel.scm b/etc/manifests/time-travel.scm
new file mode 100644
index 0000000000..039ca89889
--- /dev/null
+++ b/etc/manifests/time-travel.scm
@@ -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))
diff --git a/etc/manifests/upgrade.scm b/etc/manifests/upgrade.scm
new file mode 100644
index 0000000000..9c97d2b4e5
--- /dev/null
+++ b/etc/manifests/upgrade.scm
@@ -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))
generated by cgit