bug#56441: guix time-machine broken by profiles speed-up

[Ludovic Courtès]

Hi,

Ludovic Courtès <ludo@gnu.org> skribis:

> Another option (thinking out loud):
>
>   • in ‘package-cache-file’, unconditionally generate a v3 profile (we
>     could add a ‘version’ field to <profile> etc.);
>
>   • likewise in ‘channel-instances->derivation’.

The patches below do that.  As discussed on IRC, it’s not pretty but
it’s pragmatic.

Tested with:

  ./pre-inst-env guix time-machine \
    --commit=85a5110de79f4fe9fd822ede3915654ee699d6c5 -- describe

How does that sound?

> Problem: it doesn’t address the case where you install the ‘guix’
> package in a regular profile (I think?).

I haven’t yet checked whether this is the case.

Ludo’.

>From e1d7117cb4f81f4f590ff9c9a8fe14797cc210f1 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 8 Jul 2022 12:26:50 +0200
Subject: [PATCH 1/2] profiles: Support the creation of profiles with version 3
 manifests.

* guix/profiles.scm (%manifest-format-version): New variable.
(manifest->gexp): Add optional 'format-version' parameter.
[optional, entry->gexp]: Honor it.
(profile-derivation): Add #:format-version parameter and honor it.
(<profile>)[format-version]: New field.
(profile-compiler): Honor it.
* guix/build/profiles.scm (manifest-sexp->inputs+search-paths): Support
both versions 3 and 4.  Remove unused 'properties' variable.
* tests/profiles.scm ("profile-derivation format version 3"): New test.
---
 guix/build/profiles.scm |  6 +++---
 guix/profiles.scm       | 48 ++++++++++++++++++++++++++++++-----------
 tests/profiles.scm      | 28 ++++++++++++++++++++++++
 3 files changed, 66 insertions(+), 16 deletions(-)

diff --git a/guix/build/profiles.scm b/guix/build/profiles.scm
index 2ab76bde74..0c92f222b4 100644
--- a/guix/build/profiles.scm
+++ b/guix/build/profiles.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2015, 2017, 2018, 2019, 2020, 2021 Ludovic Courtès 
<ludo@gnu.org>
+;;; Copyright © 2015, 2017-2022 Ludovic Courtès <ludo@gnu.org>
 ;;;
 ;;; This file is part of GNU Guix.
 ;;;
@@ -162,7 +162,7 @@ (define-syntax let-fields
        (begin body ...))))
 
   (match manifest                            ;this must match 'manifest->gexp'
-    (('manifest ('version 4)
+    (('manifest ('version (or 3 4))
                 ('packages (entries ...)))
      (let loop ((entries entries)
                 (inputs '())
@@ -170,7 +170,7 @@ (define-syntax let-fields
        (match entries
          (((name version output item fields ...) . rest)
           (let ((paths search-paths))
-            (let-fields fields (propagated-inputs search-paths properties)
+            (let-fields fields (propagated-inputs search-paths)
               (loop (append rest propagated-inputs) ;breadth-first traversal
                     (cons item inputs)
                     (append search-paths paths)))))
diff --git a/guix/profiles.scm b/guix/profiles.scm
index a21cc432dc..d1dfa13e98 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -452,12 +452,23 @@ (define (inferior->entry)
          packages)
     manifest-entry=?)))
 
-(define (manifest->gexp manifest)
-  "Return a representation of MANIFEST as a gexp."
+(define %manifest-format-version
+  ;; The current manifest format version.
+  4)
+
+(define* (manifest->gexp manifest #:optional
+                         (format-version %manifest-format-version))
+  "Return a representation in FORMAT-VERSION of MANIFEST as a gexp."
   (define (optional name value)
-    (if (null? value)
-        #~()
-        #~((#$name #$value))))
+    (match format-version
+      (4
+       (if (null? value)
+           #~()
+           #~((#$name #$value))))
+      (3
+       (match name
+         ('properties #~((#$name #$@value)))
+         (_           #~((#$name #$value)))))))
 
   (define (entry->gexp entry)
     ;; Maintain in state monad a vhash of visited entries, indexed by their
@@ -467,10 +478,11 @@ (define (entry->gexp entry)
     ;; the presence of propagated inputs, where we could otherwise end up
     ;; repeating large trees.
     (mlet %state-monad ((visited (current-state)))
-      (if (match (vhash-assq (manifest-entry-item entry) visited)
-            ((_ . previous-entry)
-             (manifest-entry=? previous-entry entry))
-            (#f #f))
+      (if (and (= format-version 4)
+               (match (vhash-assq (manifest-entry-item entry) visited)
+                 ((_ . previous-entry)
+                  (manifest-entry=? previous-entry entry))
+                 (#f #f)))
           (return #~(repeated #$(manifest-entry-name entry)
                               #$(manifest-entry-version entry)
                               (ungexp (manifest-entry-item entry)
@@ -500,9 +512,14 @@ (define (entry->gexp entry)
                                               search-paths))
                             #$@(optional 'properties properties))))))))))
 
+  (unless (memq format-version '(3 4))
+    (raise (formatted-message
+            (G_ "cannot emit manifests formatted as version ~a")
+            format-version)))
+
   (match manifest
     (($ <manifest> (entries ...))
-     #~(manifest (version 4)
+     #~(manifest (version #$format-version)
                  (packages #$(run-with-state
                                  (mapm %state-monad entry->gexp entries)
                                vlist-null))))))
@@ -1883,6 +1900,7 @@ (define* (profile-derivation manifest
                              (allow-unsupported-packages? #f)
                              (allow-collisions? #f)
                              (relative-symlinks? #f)
+                             (format-version %manifest-format-version)
                              system target)
   "Return a derivation that builds a profile (aka. 'user environment') with
 the given MANIFEST.  The profile includes additional derivations returned by
@@ -1968,7 +1986,7 @@ (define builder
 
             #+(if locales? set-utf8-locale #t)
 
-            (build-profile #$output '#$(manifest->gexp manifest)
+            (build-profile #$output '#$(manifest->gexp manifest format-version)
                            #:extra-inputs '#$extra-inputs
                            #:symlink #$(if relative-symlinks?
                                            #~symlink-relative
@@ -2007,19 +2025,23 @@ (define-record-type* <profile> profile make-profile
   (allow-collisions?  profile-allow-collisions?   ;Boolean
                       (default #f))
   (relative-symlinks? profile-relative-symlinks?  ;Boolean
-                      (default #f)))
+                      (default #f))
+  (format-version     profile-format-version      ;integer
+                      (default %manifest-format-version)))
 
 (define-gexp-compiler (profile-compiler (profile <profile>) system target)
   "Compile PROFILE to a derivation."
   (match profile
     (($ <profile> name manifest hooks
-                  locales? allow-collisions? relative-symlinks?)
+                  locales? allow-collisions? relative-symlinks?
+                  format-version)
      (profile-derivation manifest
                          #:name name
                          #:hooks hooks
                          #:locales? locales?
                          #:allow-collisions? allow-collisions?
                          #:relative-symlinks? relative-symlinks?
+                         #:format-version format-version
                          #:system system #:target target))))
 
 (define* (profile-search-paths profile
diff --git a/tests/profiles.scm b/tests/profiles.scm
index f002dfc5e4..7bed946bf3 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -286,6 +286,34 @@ (define transform1
                  (string=? (dirname (readlink bindir))
                            (derivation->output-path guile))))))
 
+(test-assertm "profile-derivation format version 3"
+  ;; Make sure we can create and read a version 3 manifest.
+  (mlet* %store-monad
+      ((entry ->    (package->manifest-entry %bootstrap-guile
+                                             #:properties '((answer . 42))))
+       (manifest -> (manifest (list entry)))
+       (drv1        (profile-derivation manifest
+                                        #:format-version 3 ;old version
+                                        #:hooks '()
+                                        #:locales? #f))
+       (drv2        (profile-derivation manifest
+                                        #:hooks '()
+                                        #:locales? #f))
+       (profile1 -> (derivation->output-path drv1))
+       (profile2 -> (derivation->output-path drv2))
+       (_          (built-derivations (list drv1 drv2))))
+    (return (let ((manifest1 (profile-manifest profile1))
+                  (manifest2 (profile-manifest profile2)))
+              (match (manifest-entries manifest1)
+                ((entry1)
+                 (match (manifest-entries manifest2)
+                   ((entry2)
+                    (and (manifest-entry=? entry1 entry2)
+                         (equal? (manifest-entry-properties entry1)
+                                 '((answer . 42)))
+                         (equal? (manifest-entry-properties entry2)
+                                 '((answer . 42))))))))))))
+
 (test-assertm "profile-derivation, ordering & collisions"
   ;; ENTRY1 and ENTRY2 both provide 'bin/guile'--a collision.  Make sure
   ;; ENTRY1 "wins" over ENTRY2.  See <https://bugs.gnu.org/49102>.

base-commit: 33179b180a5b02b730b4b37369ccf48204597940
-- 
2.36.1

>From d404ef913482c6a9c692bad2142cf7202ebc1cc4 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Fri, 8 Jul 2022 12:31:25 +0200
Subject: [PATCH 2/2] channels: Emit version 3 profiles.

Fixes <https://issues.guix.gnu.org/56441>.
Reported by zimoun <zimon.toutoune@gmail.com>.

* guix/channels.scm (package-cache-file): Add 'format-version' field to
PROFILE.
(channel-instances->derivation): Pass #:format-version to
'profile-derivation'.
---
 guix/channels.scm | 15 ++++++++++++---
 1 file changed, 12 insertions(+), 3 deletions(-)

diff --git a/guix/channels.scm b/guix/channels.scm
index ce1a60436f..689b30e0eb 100644
--- a/guix/channels.scm
+++ b/guix/channels.scm
@@ -1,5 +1,5 @@
 ;;; GNU Guix --- Functional package management for GNU
-;;; Copyright © 2018, 2019, 2020, 2021 Ludovic Courtès <ludo@gnu.org>
+;;; Copyright © 2018-2022 Ludovic Courtès <ludo@gnu.org>
 ;;; Copyright © 2018 Ricardo Wurmus <rekado@elephly.net>
 ;;; Copyright © 2019 Jan (janneke) Nieuwenhuizen <janneke@gnu.org>
 ;;; Copyright © 2021 Brice Waegeneire <brice@waegenei.re>
@@ -896,7 +896,12 @@ (define (instance->entry instance drv)
 (define (package-cache-file manifest)
   "Build a package cache file for the instance in MANIFEST.  This is meant to
 be used as a profile hook."
-  (let ((profile (profile (content manifest) (hooks '()))))
+  ;; Note: Emit a profile in format version 3, which was introduced in 2017
+  ;; and is readable by Guix since before version 1.0.  This ensures that the
+  ;; Guix in MANIFEST is able to read the manifest file created for its own
+  ;; profile below.  See <https://issues.guix.gnu.org/56441>.
+  (let ((profile (profile (content manifest) (hooks '())
+                          (format-version 3))))
     (define build
       #~(begin
           (use-modules (gnu packages))
@@ -937,8 +942,12 @@ (define (channel-instances->derivation instances)
   "Return the derivation of the profile containing INSTANCES, a list of
 channel instances."
   (mlet %store-monad ((manifest (channel-instances->manifest instances)))
+    ;; Emit a profile in format version so that, if INSTANCES denotes an old
+    ;; Guix, it can still read that profile, for instance for the purposes of
+    ;; 'guix describe'.
     (profile-derivation manifest
-                        #:hooks %channel-profile-hooks)))
+                        #:hooks %channel-profile-hooks
+                        #:format-version 3)))
 
 (define latest-channel-instances*
   (store-lift latest-channel-instances))
-- 
2.36.1