[bug#74888] [PATCH 0/3] Fixes to the 'security-updates' and 'ungraft' manifests

[bug#74888] [PATCH 0/3] Fixes to the 'security-updates' and 'ungraft' manifests

[Ludovic Courtès]

Hi!

This fixes mistakes I made in these two manifests and that led them
to compute derivations that differ from what you’d get by changing
the code manually.

There’s still one discrepancy, which is due to the use of
‘computed-origin-method’:

  https://lists.gnu.org/archive/html/guix-devel/2024-12/msg00113.html

Hopefully this will be addressed soon.

Thanks,
Ludo’.

Ludovic Courtès (3):
  packages: Add #:recursive? to ‘package-input-rewriting’.
  etc: upgrade: Really compute joint upgrades.
  etc: ungraft: Use ‘package-mapping’ directly.

 doc/guix.texi             |  6 +++++-
 etc/manifests/ungraft.scm | 13 +++++++------
 etc/manifests/upgrade.scm |  3 ++-
 guix/packages.scm         |  9 +++++++--
 tests/packages.scm        | 32 +++++++++++++++++++++++++++++++-
 5 files changed, 52 insertions(+), 11 deletions(-)


base-commit: 0787a180b3ca64d3958438920ca1b58a2a27fba4
-- 
2.46.0

[bug#74888] [PATCH 1/3] packages: Add #:recursive? to ‘package-input-rewriting’.

[Ludovic Courtès]

* guix/packages.scm (package-input-rewriting): Add #:recursive?
[cut?]: Honor it.
* tests/packages.scm ("package-input-rewriting, recursive"): New test.
* doc/guix.texi (Defining Package Variants): Document it.

Change-Id: Ie82f35ae0ae873dc68f8b1c0dd6616f552772e65
---
 doc/guix.texi      |  6 +++++-
 guix/packages.scm  |  9 +++++++--
 tests/packages.scm | 32 +++++++++++++++++++++++++++++++-
 3 files changed, 43 insertions(+), 4 deletions(-)

diff --git a/doc/guix.texi b/doc/guix.texi
index a2915de954..995ff5ad4e 100644
--- a/doc/guix.texi
+++ b/doc/guix.texi
@@ -8653,13 +8653,17 @@ Defining Package Variants
 graph, is what the @code{package-input-rewriting} procedure in
 @code{(guix packages)} implements.
 
-@deffn {Procedure} package-input-rewriting replacements [rewrite-name] [#:deep? #t]
+@deffn {Procedure} package-input-rewriting replacements [rewrite-name] @
+  [#:deep? #t] [#:recursive? #f]
 Return a procedure that, when passed a package, replaces its direct and
 indirect dependencies, including implicit inputs when @var{deep?} is
 true, according to @var{replacements}.  @var{replacements} is a list of
 package pairs; the first element of each pair is the package to replace,
 and the second one is the replacement.
 
+When @var{recursive?} is true, apply replacements to the right-hand sides of
+@var{replacements} as well, recursively.
+
 Optionally, @var{rewrite-name} is a one-argument procedure that takes
 the name of a package and returns its new name after rewrite.
 @end deffn
diff --git a/guix/packages.scm b/guix/packages.scm
index 0ce3276051..75271b7a05 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -1582,12 +1582,16 @@ (define* (package-mapping proc #:optional (cut? (const #f))
 
 (define* (package-input-rewriting replacements
                                   #:optional (rewrite-name identity)
-                                  #:key (deep? #t))
+                                  #:key (deep? #t)
+                                  (recursive? #f))
   "Return a procedure that, when passed a package, replaces its direct and
 indirect dependencies, including implicit inputs when DEEP? is true, according
 to REPLACEMENTS.  REPLACEMENTS is a list of package pairs; the first element
 of each pair is the package to replace, and the second one is the replacement.
 
+When RECURSIVE? is true, apply replacements to the right-hand sides of
+REPLACEMENTS as well, recursively.
+
 Optionally, REWRITE-NAME is a one-argument procedure that takes the name of a
 package and returns its new name after rewrite."
   (define replacement-property
@@ -1608,7 +1612,8 @@ (define* (package-input-rewriting replacements
 
   (define (cut? p)
     (or (assq-ref (package-properties p) replacement-property)
-        (assq-ref replacements p)))
+        (and (not recursive?)
+             (assq-ref replacements p))))
 
   (package-mapping rewrite cut?
                    #:deep? deep?))
diff --git a/tests/packages.scm b/tests/packages.scm
index 7c28e75c45..6417bc79de 100644
--- a/tests/packages.scm
+++ b/tests/packages.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2012-2023 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2012-2024 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2021 Maxim Cournoyer <maxim.cournoyer@gmail.com>
 ;;; Copyright © 2021 Maxime Devos <maximedevos@telenet.be>
@@ -1501,6 +1501,36 @@ (define compressors '(("gzip"  . "gz")
       ((("python" python) _ ...)
        (derivation-file-name (package-derivation %store python))))))
 
+(test-assert "package-input-rewriting, recursive"
+  (let* ((dep (dummy-package "dep" (native-inputs (list grep))))
+         (p0  (dummy-package "example1" (inputs (list dep grep))))
+         (p1  (dummy-package "example2" (inputs (list dep grep))))
+         (replacements `((,grep . ,findutils) (,p0 . ,p1)))
+         (rewrite (package-input-rewriting replacements))
+         (rewrite/recursive (package-input-rewriting replacements
+                                                     #:recursive? #t))
+         (p2 (rewrite p0))
+         (p3 (rewrite/recursive p0)))
+    (and (string=? (package-name p2) "example2")
+         ;; Here P0 is replaced by P1, but P1 itself is kept unchanged.
+         (match (package-inputs p2)
+           ((("dep" dep1) ("grep" dep2))
+            (and (match (package-native-inputs dep1)
+                   ((("grep" x)) (eq? x grep)))
+                 (eq? dep2 grep))))
+
+         ;; Here P0 is replaced by P1, and in addition references to GREP in
+         ;; P1 and its dependencies are also replaced by FINDUTILS.
+         (string=? (package-name p3) "example2")
+         (match (package-inputs p3)
+           ((("dep" dep1) ("grep" dep2))
+            (and (match (package-native-inputs dep1)
+                   ((("grep" x))
+                    (string=? (package-full-name x)
+                              (package-full-name findutils))))
+                 (string=? (package-full-name dep2)
+                           (package-full-name findutils))))))))
+
 (test-assert "package-input-rewriting/spec"
   (let* ((dep     (dummy-package "chbouib"
                     (native-inputs `(("x" ,grep)))))
-- 
2.46.0

[bug#74888] [PATCH 2/3] etc: upgrade: Really compute joint upgrades.

[Ludovic Courtès]

Previously, since input rewriting did not happen recursively, libgcrypt
would for instance be built against the old libgpg-error.

* etc/manifests/upgrade.scm (joint-security-upgrades): Pass #:recursive? #t
to ‘package-input-rewriting’.

Change-Id: I7daaa11629aa12b833ca941a3a996c3db2754a7a
---
 etc/manifests/upgrade.scm | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/etc/manifests/upgrade.scm b/etc/manifests/upgrade.scm
index 03a7d6d319..8136b8f8d4 100644
--- a/etc/manifests/upgrade.scm
+++ b/etc/manifests/upgrade.scm
@@ -119,7 +119,8 @@ (define joint-security-upgrades
      (let ((update-all (package-input-rewriting
                         (map (lambda (package)
                                `(,package . ,(latest-version package)))
-                             security-packages))))
+                             security-packages)
+                        #:recursive? #t)))
        (map (lambda (package)
               (manifest-entry
                 (inherit (package->manifest-entry
-- 
2.46.0

[bug#74888] [PATCH 3/3] etc: ungraft: Use ‘package-mapping’ directly.

[Ludovic Courtès]

* etc/manifests/ungraft.scm (ungraft): New procedure.
<top-level>: Use it.  Remove ‘ungraft-all’.

Change-Id: I6f1badf06dad9116d4242c7d1fff5ca53e6522f8
---
 etc/manifests/ungraft.scm | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/etc/manifests/ungraft.scm b/etc/manifests/ungraft.scm
index 3e42b98ece..5caef65d4c 100644
--- a/etc/manifests/ungraft.scm
+++ b/etc/manifests/ungraft.scm
@@ -35,15 +35,16 @@ (define (grafted-packages)
           (length result) (map package-full-name result))
     result))
 
+(define ungraft
+  (package-mapping (lambda (p)
+                     (or (package-replacement p) p))
+                   #:deep? #t))
+
 (manifest
  (with-store store
-   (let* ((grafted (grafted-packages))
-          (ungraft-all (package-input-rewriting
-                        (map (lambda (package)
-                               `(,package . ,(package-replacement package)))
-                             grafted))))
+   (let ((grafted (grafted-packages)))
      (map (lambda (package)
             (manifest-entry
-              (inherit (package->manifest-entry (ungraft-all package)))
+              (inherit (package->manifest-entry (ungraft package)))
               (name (string-append (package-name package) "-ungrafted"))))
           (dependents store grafted)))))
-- 
2.46.0