Subject: [bug#74542] [PATCH 11/11] etc: Add upgrade manifest.

From: Ludovic Courtès <[email-masked]>
Date: Tue, 26 Nov 2024 11:33:50 +0100

* guix/scripts/build.scm (dependents): Export.
* etc/upgrade-manifest.scm: New file.
* Makefile.am (EXTRA_DIST): Add it.

Change-Id: I1b2a2ebd09e559c68da9f25772bf33caacb4c031
---
 Makefile.am              |  1 +
 etc/upgrade-manifest.scm | 98 ++++++++++++++++++++++++++++++++++++++++
 guix/scripts/build.scm   |  2 +
 3 files changed, 101 insertions(+)
 create mode 100644 etc/upgrade-manifest.scm

diff --git a/Makefile.am b/Makefile.am
index e94ba87797..0cff32c607 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -743,6 +743,7 @@ EXTRA_DIST +=						\
   etc/source-manifest.scm				\
   etc/system-tests.scm					\
   etc/time-travel-manifest.scm				\
+  etc/upgrade-manifest.scm				\
   scripts/guix.in					\
   tests/cve-sample.json					\
   tests/keys/civodul.pub				\
diff --git a/etc/upgrade-manifest.scm b/etc/upgrade-manifest.scm
new file mode 100644
index 0000000000..6dd605ef03
--- /dev/null
+++ b/etc/upgrade-manifest.scm
@@ -0,0 +1,98 @@
+;;; GNU Guix --- Functional package management for GNU
+;;; Copyright © 2024 Ludovic Courtès <[email-masked]>
+;;;
+;;; 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 the 'with-latest'
+;; package transformation.
+
+(use-modules (guix monads)
+             (guix graph)
+             (guix packages)
+             (guix profiles)
+             (guix store)
+             (guix transformations)
+             ((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))
+             (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 (leaf-packages)
+  (with-store store
+    (run-with-store store
+      (mlet %store-monad ((edges (node-back-edges %bag-node-type (all-packages))))
+        (return (filter (lambda (package)
+                          (null? (edges package)))
+                        (all-packages)))))))
+
+(define security-packages
+  '("git" "git-minimal"
+    "xorg-server"
+    "elogind"
+    "openssl"
+    "gnutls"
+    "libarchive"
+    "libgit2"
+    "libssh"
+
+    ;; GnuPG.
+    "libassuan"
+    "libgpg-error"
+    "libgcrypt"
+    "libksba"
+    "npth"
+    "gnupg"
+    "gpgme"
+    "pinentry"))
+
+(define security-upgrades
+  ;; Upgrades of individual packages with their dependents built against that
+  ;; upgrade.
+  (manifest
+   (with-store store
+     (append-map (match-lambda
+                   ((package . output)
+                    (let* ((name (package-name package))
+                           (latest (options->transformation
+                                    `((with-latest . ,name)))))
+                      (map (lambda (package)
+                             (manifest-entry
+                               (inherit (package->manifest-entry
+                                         (latest (pk 'latest package))))
+                               (name (string-append (package-name package)
+                                                    "-with-latest-" name))))
+                           (dependents store (list package) 2)))))
+                 (specifications->packages security-packages)))))
+
+(define leaf-package-updates
+  ;; Select a subset (~22%) of all the leaf packages, typically small C/C++
+  ;; packages not part of a bigger "collection" or repo (CRAN, PyPI, etc.).
+  (manifest
+   (filter-map (lambda (package)
+                 (and (memq (package-build-system package)
+                            (list gnu-build-system cmake-build-system))
+                      (package-with-upstream-version (pk 'up package))))
+               (leaf-packages))))
+
+(concatenate-manifest (list leaf-package-updates security-upgrades))
diff --git a/guix/scripts/build.scm b/guix/scripts/build.scm
index 1b0b006ad5..ddebcaf743 100644
--- a/guix/scripts/build.scm
+++ b/guix/scripts/build.scm
@@ -63,6 +63,8 @@ (define-module (guix scripts build)
             show-cross-build-options-help
             show-native-build-options-help
 
+            dependents
+
             guix-build
             register-root
             register-root*))
-- 
2.46.0