From 12d00767f036029f1f5738de644d4972db374f4f Mon Sep 17 00:00:00 2001 From: Ludovic Courtès Date: Mon, 2 Dec 2024 15:04:46 +0100 Subject: etc: Move manifests to a separate directory. MIME-Version: 1.0 Content-Type: text/plain; charset=UTF-8 Content-Transfer-Encoding: 8bit * 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 --- Makefile.am | 20 ++--- etc/disarchive-manifest.scm | 136 -------------------------------- etc/hurd-manifest.scm | 85 -------------------- etc/kernels-manifest.scm | 35 --------- etc/manifests/disarchive.scm | 136 ++++++++++++++++++++++++++++++++ etc/manifests/hurd.scm | 85 ++++++++++++++++++++ etc/manifests/kernels.scm | 35 +++++++++ etc/manifests/release.scm | 175 +++++++++++++++++++++++++++++++++++++++++ etc/manifests/source.scm | 55 +++++++++++++ etc/manifests/system-tests.scm | 103 ++++++++++++++++++++++++ etc/manifests/time-travel.scm | 91 +++++++++++++++++++++ etc/manifests/upgrade.scm | 137 ++++++++++++++++++++++++++++++++ etc/release-manifest.scm | 175 ----------------------------------------- etc/source-manifest.scm | 55 ------------- etc/system-tests.scm | 103 ------------------------ etc/time-travel-manifest.scm | 91 --------------------- etc/upgrade-manifest.scm | 137 -------------------------------- 17 files changed, 827 insertions(+), 827 deletions(-) delete mode 100644 etc/disarchive-manifest.scm delete mode 100644 etc/hurd-manifest.scm delete mode 100644 etc/kernels-manifest.scm create mode 100644 etc/manifests/disarchive.scm create mode 100644 etc/manifests/hurd.scm create mode 100644 etc/manifests/kernels.scm create mode 100644 etc/manifests/release.scm create mode 100644 etc/manifests/source.scm create mode 100644 etc/manifests/system-tests.scm create mode 100644 etc/manifests/time-travel.scm create mode 100644 etc/manifests/upgrade.scm delete mode 100644 etc/release-manifest.scm delete mode 100644 etc/source-manifest.scm delete mode 100644 etc/system-tests.scm delete mode 100644 etc/time-travel-manifest.scm delete mode 100644 etc/upgrade-manifest.scm diff --git a/Makefile.am b/Makefile.am index edbedd27f4..1070d707c4 100644 --- a/Makefile.am +++ b/Makefile.am @@ -694,7 +694,7 @@ endif !CAN_RUN_TESTS check-system: $(GOBJECTS) $(AM_V_at)$(top_builddir)/pre-inst-env \ - guix build -m $(top_srcdir)/etc/system-tests.scm -K + guix build -m $(top_srcdir)/etc/manifests/system-tests.scm -K # Public keys used to sign substitutes. dist_pkgdata_DATA = \ @@ -741,17 +741,17 @@ EXTRA_DIST += \ build-aux/update-guix-package.scm \ build-aux/xgettext.scm \ doc/build.scm \ - etc/disarchive-manifest.scm \ etc/guix-install.sh \ etc/historical-authorizations \ etc/news.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 \ + etc/manifests/disarchive.scm \ + etc/manifests/hurd.scm \ + etc/manifests/kernels.scm \ + etc/manifests/release.scm \ + etc/manifests/source.scm \ + etc/manifests/system-tests.scm \ + etc/manifests/time-travel.scm \ + etc/manifests/upgrade.scm \ scripts/guix.in \ tests/cve-sample.json \ tests/keys/civodul.pub \ @@ -1202,7 +1202,7 @@ assert-no-store-file-names: # server so that '--display-missing' doesn't print two lists. assert-binaries-available: $(GOBJECTS) $(AM_V_at)$(top_builddir)/pre-inst-env \ - guix weather -m "$(top_srcdir)/etc/release-manifest.scm" \ + guix weather -m "$(top_srcdir)/etc/manifests/release.scm" \ --substitute-urls="https://ci.guix.gnu.org" \ --display-missing diff --git a/etc/disarchive-manifest.scm b/etc/disarchive-manifest.scm deleted file mode 100644 index 3dbfa356df..0000000000 --- a/etc/disarchive-manifest.scm +++ /dev/null @@ -1,136 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021-2024 Ludovic Courtès -;;; -;;; 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 . - -;;; 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-manifest.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/hurd-manifest.scm b/etc/hurd-manifest.scm deleted file mode 100644 index cb6b82d5f8..0000000000 --- a/etc/hurd-manifest.scm +++ /dev/null @@ -1,85 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2020, 2023 Janneke Nieuwenhuizen -;;; -;;; 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 . - -;;; 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/kernels-manifest.scm b/etc/kernels-manifest.scm deleted file mode 100644 index bacb222d64..0000000000 --- a/etc/kernels-manifest.scm +++ /dev/null @@ -1,35 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2022 Leo Famulari -;;; -;;; 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 . - -;;; 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/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 +;;; +;;; 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 . + +;;; 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 +;;; +;;; 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 . + +;;; 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 +;;; +;;; 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 . + +;;; 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 +;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen +;;; Copyright © 2023 Andreas Enge +;;; +;;; 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 . + +;;; 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 + ;; 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 + ;; 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 +;;; +;;; 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 . + +;;; 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 +;;; +;;; 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 . + +(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 +;;; +;;; 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 . + +;;; 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 channels) + guix-instance? + (channels guix-instance-channels)) + +(define-gexp-compiler (guix-instance-compiler (instance ) + system target) + (match 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 ; 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 +;;; +;;; 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 . + +;; 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)) diff --git a/etc/release-manifest.scm b/etc/release-manifest.scm deleted file mode 100644 index b003f216ff..0000000000 --- a/etc/release-manifest.scm +++ /dev/null @@ -1,175 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2020-2022, 2024 Ludovic Courtès -;;; Copyright © 2020 Jan (janneke) Nieuwenhuizen -;;; Copyright © 2023 Andreas Enge -;;; -;;; 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 . - -;;; 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 - ;; 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 - ;; 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/source-manifest.scm b/etc/source-manifest.scm deleted file mode 100644 index 3e1ae07959..0000000000 --- a/etc/source-manifest.scm +++ /dev/null @@ -1,55 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2021, 2024 Ludovic Courtès -;;; -;;; 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 . - -;;; 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/system-tests.scm b/etc/system-tests.scm deleted file mode 100644 index 221a63bb7f..0000000000 --- a/etc/system-tests.scm +++ /dev/null @@ -1,103 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2016, 2018-2020, 2022 Ludovic Courtès -;;; -;;; 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 . - -(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/time-travel-manifest.scm b/etc/time-travel-manifest.scm deleted file mode 100644 index 039ca89889..0000000000 --- a/etc/time-travel-manifest.scm +++ /dev/null @@ -1,91 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2022 Ludovic Courtès -;;; -;;; 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 . - -;;; 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 channels) - guix-instance? - (channels guix-instance-channels)) - -(define-gexp-compiler (guix-instance-compiler (instance ) - system target) - (match 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 ; 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/upgrade-manifest.scm b/etc/upgrade-manifest.scm deleted file mode 100644 index 9c97d2b4e5..0000000000 --- a/etc/upgrade-manifest.scm +++ /dev/null @@ -1,137 +0,0 @@ -;;; GNU Guix --- Functional package management for GNU -;;; Copyright © 2024 Ludovic Courtès -;;; -;;; 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 . - -;; 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)) -- cgit v1.2.3