bug#27271: [PATCH 0/4] Catch collisions at profile creation time

bug#27271: [PATCH 0/4] Catch collisions at profile creation time

[Ludovic Courtès]

Hello Guix!

These patches allow us to catch problematic collisions when computing
a profile derivation.  As we know, the profile builder often spits out
a number of warnings about collisions but that is not very useful because
users cannot distinguish the problematic cases from the harmless cases
(an example of a harmless case is when GDB and Binutils provide an
almost-identical .info file twice).

Concretely, what happens is something like this:

--8<---------------cut here---------------start------------->8---
$ ./pre-inst-env guix package -i guile-cairo -n
The following package would be upgraded:
   guile-cairo	1.4.1 → 1.4.1	/gnu/store/k9p7j9ijb9vfkmvcgr4vqy20vkg6nsbg-guile-cairo-1.4.1

guix package: error: profile contains conflicting entries for guile-cairo:out
guix package: error:   first entry: guile-cairo@1.4.1:out /gnu/store/k9p7j9ijb9vfkmvcgr4vqy20vkg6nsbg-guile-cairo-1.4.1
guix package: error:   second entry: guile-cairo@1.4.1:out /gnu/store/x0jp2q06snx7skrqdmlkn0r5fhyvvn00-guile-cairo-1.4.1
guix package: error:    ... propagated from guile-rsvg@2.18.1
$ ./pre-inst-env guix package -i guile-cairo guile-rsvg guile-present -n
The following packages would be upgraded:
   guile-cairo	1.4.1 → 1.4.1	/gnu/store/k9p7j9ijb9vfkmvcgr4vqy20vkg6nsbg-guile-cairo-1.4.1
   guile-rsvg	2.18.1 → 2.18.1	/gnu/store/xp8wcyvhplsv45gkj9r4n6zmcdancfkn-guile-rsvg-2.18.1
   guile-present	0.3.0 → 0.3.0	/gnu/store/qwk8fzijyllaxv4vw114gqzix1qvfmp2-guile-present-0.3.0

guix package: error: profile contains conflicting entries for guile-cairo:out
guix package: error:   first entry: guile-cairo@1.4.1:out /gnu/store/k9p7j9ijb9vfkmvcgr4vqy20vkg6nsbg-guile-cairo-1.4.1
guix package: error:   second entry: guile-cairo@1.4.1:out /gnu/store/x0jp2q06snx7skrqdmlkn0r5fhyvvn00-guile-cairo-1.4.1
guix package: error:    ... propagated from guile-charting@0.2.0
$ ./pre-inst-env guix package -i guile-cairo guile-rsvg guile-charting guile-present -n
The following packages would be upgraded:
   guile-cairo	1.4.1 → 1.4.1	/gnu/store/k9p7j9ijb9vfkmvcgr4vqy20vkg6nsbg-guile-cairo-1.4.1
   guile-rsvg	2.18.1 → 2.18.1	/gnu/store/xp8wcyvhplsv45gkj9r4n6zmcdancfkn-guile-rsvg-2.18.1
   guile-charting	0.2.0 → 0.2.0	/gnu/store/11368xymyhk4zz8zwvbdmp5dzcl0vxvc-guile-charting-0.2.0
   guile-present	0.3.0 → 0.3.0	/gnu/store/qwk8fzijyllaxv4vw114gqzix1qvfmp2-guile-present-0.3.0

substitute: updating list of substitutes from 'https://bayfront.guixsd.org'... 100.0%
substitute: updating list of substitutes from 'https://mirror.hydra.gnu.org'... 100.0%
The following derivations would be built:
   /gnu/store/r361w7fa57vm7js8lk4bnsc7lwv2avby-profile.drv
   /gnu/store/l5hf8cg5fx6par39659ihkhdgp3kls1n-xdg-mime-database.drv
   /gnu/store/k8jmvc8yjk3qg8xbgcfgpgngq7vkygld-info-dir.drv
   /gnu/store/ivnqmwwxwric5lhw5gqnpkxq6gbzj23i-fonts-dir.drv
   /gnu/store/hdaasxvm64h06xxzwrnx2gch981h88wf-ca-certificate-bundle.drv
   /gnu/store/axzp9vj4h59nnbmf6ccaajb9qq97xwb8-gtk-icon-themes.drv
   /gnu/store/8dkb7k53x1c0zhb9qdgrgr53j5j3biwf-gtk-im-modules.drv
   /gnu/store/v2w6qpf0kk2d70wv01f3ln1v758sgzqm-manual-database.drv
--8<---------------cut here---------------end--------------->8---

As in the example above, conflicts may arise when doing a partial
upgrade of a profile, because this is a situation where you can easily
end up with conflicting versions of a given package.  It’s much less
likely when using ‘guix package -m’ or similar.

An open question is whether there are commonly used combinations of
packages that trigger conflicts.  I haven’t had any problems with my
profile (with 234 packages) nor with my GuixSD config, but I encourage
you to test it on your profile!

Thoughts?

Ludo’.

Ludovic Courtès (3):
  profiles: Represent propagated inputs as manifest entries.
  profiles: Manifest entries keep a reference to their parent entry.
  profiles: Catch and report collisions in the profile.

 guix/profiles.scm  | 241 +++++++++++++++++++++++++++++++++++++++++------------
 guix/ui.scm        |  27 ++++++
 tests/profiles.scm |  87 +++++++++++++++++++
 3 files changed, 301 insertions(+), 54 deletions(-)

-- 
2.13.0

bug#27271: [PATCH 1/4] profiles: Represent propagated inputs as manifest entries.

[Ludovic Courtès]

* guix/profiles.scm (package->manifest-entry): Turn DEPS into a list of
manifest entries.
(manifest->gexp)[entry->gexp]: Call 'entry->gexp' on DEPS.
Bump version to 3.
(sexp->manifest)[infer-dependency]: New procedure.
Use it for versions 1 and 2.  Parse version 3.
(manifest-inputs)[entry->gexp]: New procedure.
Adjust to 'dependencies' being a list of <manifest-entry>.
* tests/profiles.scm ("packages->manifest, propagated inputs")
("read-manifest"): New fields.
---
 guix/profiles.scm  | 73 +++++++++++++++++++++++++++++++++++++++---------------
 tests/profiles.scm | 36 +++++++++++++++++++++++++++
 2 files changed, 89 insertions(+), 20 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 6733f105e..a66add3e0 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -154,7 +154,7 @@
   (output       manifest-entry-output             ; string
                 (default "out"))
   (item         manifest-entry-item)              ; package | store path
-  (dependencies manifest-entry-dependencies       ; (store path | package)*
+  (dependencies manifest-entry-dependencies       ; <manifest-entry>*
                 (default '()))
   (search-paths manifest-entry-search-paths       ; search-path-specification*
                 (default '())))
@@ -179,10 +179,10 @@
   "Return a manifest entry for the OUTPUT of package PACKAGE."
   (let ((deps (map (match-lambda
                     ((label package)
-                     (gexp-input package))
+                     (package->manifest-entry package))
                     ((label package output)
-                     (gexp-input package output)))
-                   (package-transitive-propagated-inputs package))))
+                     (package->manifest-entry package output)))
+                   (package-propagated-inputs package))))
     (manifest-entry
      (name (package-name package))
      (version (package-version package))
@@ -210,20 +210,20 @@ denoting a specific output of a package."
       (($ <manifest-entry> name version output (? string? path)
                            (deps ...) (search-paths ...))
        #~(#$name #$version #$output #$path
-                 (propagated-inputs #$deps)
+                 (propagated-inputs #$(map entry->gexp deps))
                  (search-paths #$(map search-path-specification->sexp
                                       search-paths))))
       (($ <manifest-entry> name version output (? package? package)
                            (deps ...) (search-paths ...))
        #~(#$name #$version #$output
                  (ungexp package (or output "out"))
-                 (propagated-inputs #$deps)
+                 (propagated-inputs #$(map entry->gexp deps))
                  (search-paths #$(map search-path-specification->sexp
                                       search-paths))))))
 
   (match manifest
     (($ <manifest> (entries ...))
-     #~(manifest (version 2)
+     #~(manifest (version 3)
                  (packages #$(map entry->gexp entries))))))
 
 (define (find-package name version)
@@ -254,17 +254,27 @@ procedure is here for backward-compatibility and will eventually vanish."
           (package-native-search-paths package)
           '())))
 
+  (define (infer-dependency item)
+    ;; Return a <manifest-entry> for ITEM.
+    (let-values (((name version)
+                  (package-name->name+version
+                   (store-path-package-name item))))
+      (manifest-entry
+        (name name)
+        (version version)
+        (item item))))
+
   (match sexp
     (('manifest ('version 0)
                 ('packages ((name version output path) ...)))
      (manifest
       (map (lambda (name version output path)
              (manifest-entry
-              (name name)
-              (version version)
-              (output output)
-              (item path)
-              (search-paths (infer-search-paths name version))))
+               (name name)
+               (version version)
+               (output output)
+               (item path)
+               (search-paths (infer-search-paths name version))))
            name version output path)))
 
     ;; Version 1 adds a list of propagated inputs to the
@@ -286,7 +296,7 @@ procedure is here for backward-compatibility and will eventually vanish."
                  (version version)
                  (output output)
                  (item path)
-                 (dependencies deps)
+                 (dependencies (map infer-dependency deps))
                  (search-paths (infer-search-paths name version)))))
            name version output path deps)))
 
@@ -304,10 +314,30 @@ procedure is here for backward-compatibility and will eventually vanish."
                (version version)
                (output output)
                (item path)
-               (dependencies deps)
+               (dependencies (map infer-dependency deps))
                (search-paths (map sexp->search-path-specification
                                   search-paths))))
            name version output path deps search-paths)))
+
+    ;; Version 3 represents DEPS as full-blown manifest entries.
+    (('manifest ('version 3 minor-version ...)
+                ('packages (entries ...)))
+     (letrec ((sexp->manifest-entry
+               (match-lambda
+                 ((name version output path
+                        ('propagated-inputs deps)
+                        ('search-paths search-paths)
+                        extra-stuff ...)
+                  (manifest-entry
+                    (name name)
+                    (version version)
+                    (output output)
+                    (item path)
+                    (dependencies (map sexp->manifest-entry deps))
+                    (search-paths (map sexp->search-path-specification
+                                       search-paths)))))))
+
+       (manifest (map sexp->manifest-entry entries))))
     (_
      (raise (condition
              (&message (message "unsupported manifest format")))))))
@@ -471,12 +501,15 @@ replace it."
 
 (define (manifest-inputs manifest)
   "Return a list of <gexp-input> objects for MANIFEST."
-  (append-map (match-lambda
-               (($ <manifest-entry> name version output thing deps)
-                ;; THING may be a package or a file name.  In the latter case,
-                ;; assume it's already valid.  Ditto for DEPS.
-                (cons (gexp-input thing output) deps)))
-              (manifest-entries manifest)))
+  (define entry->input
+    (match-lambda
+      (($ <manifest-entry> name version output thing deps)
+       ;; THING may be a package or a file name.  In the latter case, assume
+       ;; it's already valid.
+       (cons (gexp-input thing output)
+             (append-map entry->input deps)))))
+
+  (append-map entry->input (manifest-entries manifest)))
 
 (define* (manifest-lookup-package manifest name #:optional version)
   "Return as a monadic value the first package or store path referenced by
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 093422792..e8b1bb832 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -288,6 +288,42 @@
            (manifest-entry-search-paths
             (package->manifest-entry mpl)))))
 
+(test-equal "packages->manifest, propagated inputs"
+  (map (match-lambda
+         ((label package)
+          (list (package-name package) (package-version package)
+                package)))
+       (package-propagated-inputs packages:guile-2.2))
+  (map (lambda (entry)
+         (list (manifest-entry-name entry)
+               (manifest-entry-version entry)
+               (manifest-entry-item entry)))
+       (manifest-entry-dependencies
+        (package->manifest-entry packages:guile-2.2))))
+
+(test-assertm "read-manifest"
+  (mlet* %store-monad ((manifest -> (packages->manifest
+                                     (list (package
+                                             (inherit %bootstrap-guile)
+                                             (native-search-paths
+                                              (package-native-search-paths
+                                               packages:guile-2.0))))))
+                       (drv (profile-derivation manifest
+                                                #:hooks '()
+                                                #:locales? #f))
+                       (out -> (derivation->output-path drv)))
+    (define (entry->sexp entry)
+      (list (manifest-entry-name entry)
+            (manifest-entry-version entry)
+            (manifest-entry-search-paths entry)
+            (manifest-entry-dependencies entry)))
+
+    (mbegin %store-monad
+      (built-derivations (list drv))
+      (let ((manifest2 (profile-manifest out)))
+        (return (equal? (map entry->sexp (manifest-entries manifest))
+                        (map entry->sexp (manifest-entries manifest2))))))))
+
 (test-assertm "etc/profile"
   ;; Make sure we get an 'etc/profile' file that at least defines $PATH.
   (mlet* %store-monad
-- 
2.13.0

bug#27271: [PATCH 2/4] profiles: Manifest entries keep a reference to their parent entry.

[Ludovic Courtès]

* guix/profiles.scm (<manifest-entry>)[parent]: New field.
(package->manifest-entry): Add #:parent parameter.  Fill out the
'parent' field of <manifest-entry>; pass #:parent in recursive calls.
* guix/profiles.scm (sexp->manifest)[sexp->manifest-entry]: New
procedure.  Use it for version 3.
* tests/profiles.scm ("manifest-entry-parent"): New procedure.
("read-manifest")[entry->sexp]: Add 'manifest-entry-parent' to the
result.
---
 guix/profiles.scm  | 120 ++++++++++++++++++++++++++++++++---------------------
 tests/profiles.scm |  12 +++++-
 2 files changed, 83 insertions(+), 49 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index a66add3e0..c85d7ef5c 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -68,6 +68,7 @@
             manifest-entry-item
             manifest-entry-dependencies
             manifest-entry-search-paths
+            manifest-entry-parent
 
             manifest-pattern
             manifest-pattern?
@@ -157,7 +158,9 @@
   (dependencies manifest-entry-dependencies       ; <manifest-entry>*
                 (default '()))
   (search-paths manifest-entry-search-paths       ; search-path-specification*
-                (default '())))
+                (default '()))
+  (parent       manifest-entry-parent        ; promise (#f | <manifest-entry>)
+                (default (delay #f))))
 
 (define-record-type* <manifest-pattern> manifest-pattern
   make-manifest-pattern
@@ -175,21 +178,28 @@
         (call-with-input-file file read-manifest)
         (manifest '()))))
 
-(define* (package->manifest-entry package #:optional (output "out"))
+(define* (package->manifest-entry package #:optional (output "out")
+                                  #:key (parent (delay #f)))
   "Return a manifest entry for the OUTPUT of package PACKAGE."
-  (let ((deps (map (match-lambda
-                    ((label package)
-                     (package->manifest-entry package))
-                    ((label package output)
-                     (package->manifest-entry package output)))
-                   (package-propagated-inputs package))))
-    (manifest-entry
-     (name (package-name package))
-     (version (package-version package))
-     (output output)
-     (item package)
-     (dependencies (delete-duplicates deps))
-     (search-paths (package-transitive-native-search-paths package)))))
+  ;; For each dependency, keep a promise pointing to its "parent" entry.
+  (letrec* ((deps  (map (match-lambda
+                          ((label package)
+                           (package->manifest-entry package
+                                                    #:parent (delay entry)))
+                          ((label package output)
+                           (package->manifest-entry package output
+                                                    #:parent (delay entry))))
+                        (package-propagated-inputs package)))
+            (entry (manifest-entry
+                     (name (package-name package))
+                     (version (package-version package))
+                     (output output)
+                     (item package)
+                     (dependencies (delete-duplicates deps))
+                     (search-paths
+                      (package-transitive-native-search-paths package))
+                     (parent parent))))
+    entry))
 
 (define (packages->manifest packages)
   "Return a list of manifest entries, one for each item listed in PACKAGES.
@@ -254,7 +264,7 @@ procedure is here for backward-compatibility and will eventually vanish."
           (package-native-search-paths package)
           '())))
 
-  (define (infer-dependency item)
+  (define (infer-dependency item parent)
     ;; Return a <manifest-entry> for ITEM.
     (let-values (((name version)
                   (package-name->name+version
@@ -262,7 +272,28 @@ procedure is here for backward-compatibility and will eventually vanish."
       (manifest-entry
         (name name)
         (version version)
-        (item item))))
+        (item item)
+        (parent parent))))
+
+  (define* (sexp->manifest-entry sexp #:optional (parent (delay #f)))
+    (match sexp
+      ((name version output path
+             ('propagated-inputs deps)
+             ('search-paths search-paths)
+             extra-stuff ...)
+       ;; For each of DEPS, keep a promise pointing to ENTRY.
+       (letrec* ((deps* (map (cut sexp->manifest-entry <> (delay entry))
+                             deps))
+                 (entry (manifest-entry
+                          (name name)
+                          (version version)
+                          (output output)
+                          (item path)
+                          (dependencies deps*)
+                          (search-paths (map sexp->search-path-specification
+                                             search-paths))
+                          (parent parent))))
+         entry))))
 
   (match sexp
     (('manifest ('version 0)
@@ -291,13 +322,17 @@ procedure is here for backward-compatibility and will eventually vanish."
                             directories)
                            ((directories ...)
                             directories))))
-               (manifest-entry
-                 (name name)
-                 (version version)
-                 (output output)
-                 (item path)
-                 (dependencies (map infer-dependency deps))
-                 (search-paths (infer-search-paths name version)))))
+               (letrec* ((deps* (map (cute infer-dependency <> (delay entry))
+                                     deps))
+                         (entry (manifest-entry
+                                  (name name)
+                                  (version version)
+                                  (output output)
+                                  (item path)
+                                  (dependencies deps*)
+                                  (search-paths
+                                   (infer-search-paths name version)))))
+                 entry)))
            name version output path deps)))
 
     ;; Version 2 adds search paths and is slightly more verbose.
@@ -309,35 +344,24 @@ procedure is here for backward-compatibility and will eventually vanish."
                             ...)))
      (manifest
       (map (lambda (name version output path deps search-paths)
-             (manifest-entry
-               (name name)
-               (version version)
-               (output output)
-               (item path)
-               (dependencies (map infer-dependency deps))
-               (search-paths (map sexp->search-path-specification
-                                  search-paths))))
+             (letrec* ((deps* (map (cute infer-dependency <> (delay entry))
+                                   deps))
+                       (entry (manifest-entry
+                                (name name)
+                                (version version)
+                                (output output)
+                                (item path)
+                                (dependencies deps*)
+                                (search-paths
+                                 (map sexp->search-path-specification
+                                      search-paths)))))
+               entry))
            name version output path deps search-paths)))
 
     ;; Version 3 represents DEPS as full-blown manifest entries.
     (('manifest ('version 3 minor-version ...)
                 ('packages (entries ...)))
-     (letrec ((sexp->manifest-entry
-               (match-lambda
-                 ((name version output path
-                        ('propagated-inputs deps)
-                        ('search-paths search-paths)
-                        extra-stuff ...)
-                  (manifest-entry
-                    (name name)
-                    (version version)
-                    (output output)
-                    (item path)
-                    (dependencies (map sexp->manifest-entry deps))
-                    (search-paths (map sexp->search-path-specification
-                                       search-paths)))))))
-
-       (manifest (map sexp->manifest-entry entries))))
+     (manifest (map sexp->manifest-entry entries)))
     (_
      (raise (condition
              (&message (message "unsupported manifest format")))))))
diff --git a/tests/profiles.scm b/tests/profiles.scm
index e8b1bb832..94759c05e 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -301,6 +301,15 @@
        (manifest-entry-dependencies
         (package->manifest-entry packages:guile-2.2))))
 
+(test-assert "manifest-entry-parent"
+  (let ((entry (package->manifest-entry packages:guile-2.2)))
+    (match (manifest-entry-dependencies entry)
+      ((dependencies ..1)
+       (and (every (lambda (parent)
+                     (eq? entry (force parent)))
+                   (map manifest-entry-parent dependencies))
+            (not (force (manifest-entry-parent entry))))))))
+
 (test-assertm "read-manifest"
   (mlet* %store-monad ((manifest -> (packages->manifest
                                      (list (package
@@ -316,7 +325,8 @@
       (list (manifest-entry-name entry)
             (manifest-entry-version entry)
             (manifest-entry-search-paths entry)
-            (manifest-entry-dependencies entry)))
+            (manifest-entry-dependencies entry)
+            (force (manifest-entry-parent entry))))
 
     (mbegin %store-monad
       (built-derivations (list drv))
-- 
2.13.0

bug#27271: [PATCH 3/4] guix package: Always upgrade packages that have propagated inputs.

[Ludovic Courtès]

* guix/scripts/package.scm (transaction-upgrade-entry): Always upgrade
packages that have propagated inputs.
---
 guix/scripts/package.scm | 5 ++++-
 1 file changed, 4 insertions(+), 1 deletion(-)

diff --git a/guix/scripts/package.scm b/guix/scripts/package.scm
index f050fad97..4de95869f 100644
--- a/guix/scripts/package.scm
+++ b/guix/scripts/package.scm
@@ -298,7 +298,10 @@ synopsis or description matches all of REGEXPS."
              ((=)
               (let ((candidate-path (derivation->output-path
                                      (package-derivation (%store) pkg))))
-                (if (string=? path candidate-path)
+                ;; XXX: When there are propagated inputs, assume we need to
+                ;; upgrade the whole entry.
+                (if (and (string=? path candidate-path)
+                         (null? (package-propagated-inputs pkg)))
                     transaction
                     (manifest-transaction-install-entry
                      (package->manifest-entry pkg output)
-- 
2.13.0

bug#27271: [PATCH 4/4] profiles: Catch and report collisions in the profile.

[Ludovic Courtès]

* guix/profiles.scm (&profile-collision-error): New error condition.
(manifest-entry-lookup, lower-manifest-entry, check-for-collisions): New
procedures.
(profile-derivation): Add call to 'check-for-collisions'.
* guix/ui.scm (call-with-error-handling): Handle '&profile-collision-error'.
* tests/profiles.scm ("collision", "no collision"): New tests.
---
 guix/profiles.scm  | 94 ++++++++++++++++++++++++++++++++++++++++++++++++------
 guix/ui.scm        | 27 ++++++++++++++++
 tests/profiles.scm | 41 ++++++++++++++++++++++++
 3 files changed, 153 insertions(+), 9 deletions(-)

diff --git a/guix/profiles.scm b/guix/profiles.scm
index c85d7ef5c..980229ca7 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -35,6 +35,7 @@
   #:use-module (guix gexp)
   #:use-module (guix monads)
   #:use-module (guix store)
+  #:use-module (ice-9 vlist)
   #:use-module (ice-9 match)
   #:use-module (ice-9 regex)
   #:use-module (ice-9 ftw)
@@ -51,6 +52,10 @@
             profile-error-profile
             &profile-not-found-error
             profile-not-found-error?
+            &profile-collistion-error
+            profile-collision-error?
+            profile-collision-error-entry
+            profile-collision-error-conflict
             &missing-generation-error
             missing-generation-error?
             missing-generation-error-generation
@@ -130,6 +135,11 @@
 (define-condition-type &profile-not-found-error &profile-error
   profile-not-found-error?)
 
+(define-condition-type &profile-collision-error &error
+  profile-collision-error?
+  (entry    profile-collision-error-entry)        ;<manifest-entry>
+  (conflict profile-collision-error-conflict))    ;<manifest-entry>
+
 (define-condition-type &missing-generation-error &profile-error
   missing-generation-error?
   (generation missing-generation-error-generation))
@@ -178,6 +188,70 @@
         (call-with-input-file file read-manifest)
         (manifest '()))))
 
+(define (manifest-entry-lookup manifest)
+  "Return a lookup procedure for the entries of MANIFEST.  The lookup
+procedure takes two arguments: the entry name and output."
+  (define mapping
+    (let loop ((entries (manifest-entries manifest))
+               (mapping vlist-null))
+      (fold (lambda (entry result)
+              (vhash-cons (cons (manifest-entry-name entry)
+                                (manifest-entry-output entry))
+                          entry
+                          (loop (manifest-entry-dependencies entry)
+                                result)))
+            mapping
+            entries)))
+
+  (lambda (name output)
+    (match (vhash-assoc (cons name output) mapping)
+      ((_ . entry) entry)
+      (#f          #f))))
+
+(define* (lower-manifest-entry entry system #:key target)
+  "Lower ENTRY for SYSTEM and TARGET such that its 'item' field is a store
+file name."
+  (let ((item (manifest-entry-item entry)))
+    (if (string? item)
+        (with-monad %store-monad
+          (return entry))
+        (mlet %store-monad ((drv (lower-object item system
+                                               #:target target))
+                            (output -> (manifest-entry-output entry)))
+          (return (manifest-entry
+                    (inherit entry)
+                    (item (derivation->output-path drv output))))))))
+
+(define* (check-for-collisions manifest system #:key target)
+  "Check whether the entries of MANIFEST conflict with one another; raise a
+'&profile-collision-error' when a conflict is encountered."
+  (define lookup
+    (manifest-entry-lookup manifest))
+
+  (with-monad %store-monad
+    (foldm %store-monad
+           (lambda (entry result)
+             (match (lookup (manifest-entry-name entry)
+                            (manifest-entry-output entry))
+               ((? manifest-entry? second)        ;potential conflict
+                (mlet %store-monad ((first (lower-manifest-entry entry system
+                                                                 #:target
+                                                                 target))
+                                    (second (lower-manifest-entry second system
+                                                                  #:target
+                                                                  target)))
+                  (if (string=? (manifest-entry-item first)
+                                (manifest-entry-item second))
+                      (return result)
+                      (raise (condition
+                              (&profile-collision-error
+                               (entry first)
+                               (conflict second)))))))
+               (#f                                ;no conflict
+                (return result))))
+           #t
+           (manifest-entries manifest))))
+
 (define* (package->manifest-entry package #:optional (output "out")
                                   #:key (parent (delay #f)))
   "Return a manifest entry for the OUTPUT of package PACKAGE."
@@ -1116,15 +1190,17 @@ a dependency on the 'glibc-utf8-locales' package.
 
 When TARGET is true, it must be a GNU triplet, and the packages in MANIFEST
 are cross-built for TARGET."
-  (mlet %store-monad ((system (if system
-                                  (return system)
-                                  (current-system)))
-                      (extras (if (null? (manifest-entries manifest))
-                                  (return '())
-                                  (sequence %store-monad
-                                            (map (lambda (hook)
-                                                   (hook manifest))
-                                                 hooks)))))
+  (mlet* %store-monad ((system (if system
+                                   (return system)
+                                   (current-system)))
+                       (ok?    (check-for-collisions manifest system
+                                                     #:target target))
+                       (extras (if (null? (manifest-entries manifest))
+                                   (return '())
+                                   (sequence %store-monad
+                                             (map (lambda (hook)
+                                                    (hook manifest))
+                                                  hooks)))))
     (define inputs
       (append (filter-map (lambda (drv)
                             (and (derivation? drv)
diff --git a/guix/ui.scm b/guix/ui.scm
index 5060fd6dc..82be0311d 100644
--- a/guix/ui.scm
+++ b/guix/ui.scm
@@ -476,6 +476,33 @@ interpreted."
              (leave (G_ "generation ~a of profile '~a' does not exist~%")
                     (missing-generation-error-generation c)
                     (profile-error-profile c)))
+            ((profile-collision-error? c)
+             (let ((entry    (profile-collision-error-entry c))
+                   (conflict (profile-collision-error-conflict c)))
+               (define (report-parent-entries entry)
+                 (let ((parent (force (manifest-entry-parent entry))))
+                   (when (manifest-entry? parent)
+                     (report-error (G_ "   ... propagated from ~a@~a~%")
+                                   (manifest-entry-name parent)
+                                   (manifest-entry-version parent))
+                     (report-parent-entries parent))))
+
+               (report-error (G_ "profile contains conflicting entries for ~a:~a~%")
+                             (manifest-entry-name entry)
+                             (manifest-entry-output entry))
+               (report-error (G_ "  first entry: ~a@~a:~a ~a~%")
+                             (manifest-entry-name entry)
+                             (manifest-entry-version entry)
+                             (manifest-entry-output entry)
+                             (manifest-entry-item entry))
+               (report-parent-entries entry)
+               (report-error (G_ "  second entry: ~a@~a:~a ~a~%")
+                             (manifest-entry-name conflict)
+                             (manifest-entry-version conflict)
+                             (manifest-entry-output conflict)
+                             (manifest-entry-item conflict))
+               (report-parent-entries conflict)
+               (exit 1)))
             ((nar-error? c)
              (let ((file (nar-error-file c))
                    (port (nar-error-port c)))
diff --git a/tests/profiles.scm b/tests/profiles.scm
index 94759c05e..ac9e2181d 100644
--- a/tests/profiles.scm
+++ b/tests/profiles.scm
@@ -35,6 +35,7 @@
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-11)
+  #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-64))
 
 ;; Test the (guix profiles) module.
@@ -334,6 +335,46 @@
         (return (equal? (map entry->sexp (manifest-entries manifest))
                         (map entry->sexp (manifest-entries manifest2))))))))
 
+(test-equal "collision"
+  '(("guile-bootstrap" "2.0") ("guile-bootstrap" "42"))
+  (guard (c ((profile-collision-error? c)
+             (let ((entry1 (profile-collision-error-entry c))
+                   (entry2 (profile-collision-error-conflict c)))
+               (list (list (manifest-entry-name entry1)
+                           (manifest-entry-version entry1))
+                     (list (manifest-entry-name entry2)
+                           (manifest-entry-version entry2))))))
+    (run-with-store %store
+      (mlet* %store-monad ((p0 -> (package
+                                    (inherit %bootstrap-guile)
+                                    (version "42")))
+                           (p1 -> (dummy-package "p1"
+                                    (propagated-inputs `(("p0" ,p0)))))
+                           (manifest -> (packages->manifest
+                                         (list %bootstrap-guile p1)))
+                           (drv (profile-derivation manifest
+                                                    #:hooks '()
+                                                    #:locales? #f)))
+        (return #f)))))
+
+(test-assertm "no collision"
+  ;; Here we have an entry that is "lowered" (its 'item' field is a store file
+  ;; name) and another entry (its 'item' field is a package) that is
+  ;; equivalent.
+  (mlet* %store-monad ((p -> (dummy-package "p"
+                               (propagated-inputs
+                                `(("guile" ,%bootstrap-guile)))))
+                       (guile    (package->derivation %bootstrap-guile))
+                       (entry -> (manifest-entry
+                                   (inherit (package->manifest-entry
+                                             %bootstrap-guile))
+                                   (item (derivation->output-path guile))))
+                       (manifest -> (manifest
+                                     (list entry
+                                           (package->manifest-entry p))))
+                       (drv (profile-derivation manifest)))
+    (return (->bool drv))))
+
 (test-assertm "etc/profile"
   ;; Make sure we get an 'etc/profile' file that at least defines $PATH.
   (mlet* %store-monad
-- 
2.13.0

bug#27271: [PATCH 0/4] Catch collisions at profile creation time

[Ricardo Wurmus]

Hi Ludo,

> These patches allow us to catch problematic collisions when computing
> a profile derivation.  As we know, the profile builder often spits out
> a number of warnings about collisions but that is not very useful because
> users cannot distinguish the problematic cases from the harmless cases
> (an example of a harmless case is when GDB and Binutils provide an
> almost-identical .info file twice).

This is very good!  Thanks for implementing it!

> An open question is whether there are commonly used combinations of
> packages that trigger conflicts.  I haven’t had any problems with my
> profile (with 234 packages) nor with my GuixSD config, but I encourage
> you to test it on your profile!

We often see this at the MDC because some people don’t use manifests and
I may have upgraded the shared Guix instance between invocations of
“guix package”.  This happens particularly often with numpy because
that’s propagated quite often.  (I’d *love* to get rid of propagated
inputs in Python!  They are so annoying!)

> Thoughts?

I’ll give this a try soon and report my experience with it.
Thanks again!

-- 
Ricardo

GPG: BCA6 89B6 3655 3801 C3C6  2150 197A 5888 235F ACAC
https://elephly.net

bug#27271: [PATCH 0/4] Catch collisions at profile creation time

[Ludovic Courtès]

Heya,

Ricardo Wurmus <rekado@elephly.net> skribis:

>> These patches allow us to catch problematic collisions when computing
>> a profile derivation.  As we know, the profile builder often spits out
>> a number of warnings about collisions but that is not very useful because
>> users cannot distinguish the problematic cases from the harmless cases
>> (an example of a harmless case is when GDB and Binutils provide an
>> almost-identical .info file twice).
>
> This is very good!  Thanks for implementing it!
>
>> An open question is whether there are commonly used combinations of
>> packages that trigger conflicts.  I haven’t had any problems with my
>> profile (with 234 packages) nor with my GuixSD config, but I encourage
>> you to test it on your profile!
>
> We often see this at the MDC because some people don’t use manifests and
> I may have upgraded the shared Guix instance between invocations of
> “guix package”.  This happens particularly often with numpy because
> that’s propagated quite often.  (I’d *love* to get rid of propagated
> inputs in Python!  They are so annoying!)

Perhaps we could modify ‘sys.path’ from the top of ‘__init__.py’ file to
get something similar to RUNPATH.  I’m not sure if there are any
downsides or gotchas.  Thoughts?

> I’ll give this a try soon and report my experience with it.

Great, thanks for your feedback!

Ludo’.

bug#27271: [PATCH 0/4] Catch collisions at profile creation time

[Marius Bakke]

[-- Attachment #1: Type: text/plain, Size: 2039 bytes --]

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

> Heya,
>
> Ricardo Wurmus <rekado@elephly.net> skribis:
>
>>> These patches allow us to catch problematic collisions when computing
>>> a profile derivation.  As we know, the profile builder often spits out
>>> a number of warnings about collisions but that is not very useful because
>>> users cannot distinguish the problematic cases from the harmless cases
>>> (an example of a harmless case is when GDB and Binutils provide an
>>> almost-identical .info file twice).
>>
>> This is very good!  Thanks for implementing it!
>>
>>> An open question is whether there are commonly used combinations of
>>> packages that trigger conflicts.  I haven’t had any problems with my
>>> profile (with 234 packages) nor with my GuixSD config, but I encourage
>>> you to test it on your profile!
>>
>> We often see this at the MDC because some people don’t use manifests and
>> I may have upgraded the shared Guix instance between invocations of
>> “guix package”.  This happens particularly often with numpy because
>> that’s propagated quite often.  (I’d *love* to get rid of propagated
>> inputs in Python!  They are so annoying!)
>
> Perhaps we could modify ‘sys.path’ from the top of ‘__init__.py’ file to
> get something similar to RUNPATH.  I’m not sure if there are any
> downsides or gotchas.  Thoughts?

Python actually has a native mechanism for setting up package-specific
search paths: https://docs.python.org/3/library/site.html

In short, it looks for a file "package.pth" where additional search
paths can be specified (other sys.path manipulations are allowed too).

I asked Hartmut about this during the python-build-system refactoring,
and the counter-argument was that if package A and B depends on
different versions of package C, odd failures could occur. I'm not
convinced propagation sidesteps this problem, however:

https://lists.gnu.org/archive/html/guix-devel/2016-10/msg00856.html

It would be good to try it out.

[-- Attachment #2: signature.asc --]
[-- Type: application/pgp-signature, Size: 487 bytes --]

bug#27271: Avoiding ‘propagated-inputs’ for Python dependencies

[Ludovic Courtès]

Heya,

(+Cc: Hartmut.)

Marius Bakke <mbakke@fastmail.com> skribis:

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

[...]

>> Perhaps we could modify ‘sys.path’ from the top of ‘__init__.py’ file to
>> get something similar to RUNPATH.  I’m not sure if there are any
>> downsides or gotchas.  Thoughts?
>
> Python actually has a native mechanism for setting up package-specific
> search paths: https://docs.python.org/3/library/site.html
>
> In short, it looks for a file "package.pth" where additional search
> paths can be specified (other sys.path manipulations are allowed too).

Looks good at first sight.

> I asked Hartmut about this during the python-build-system refactoring,
> and the counter-argument was that if package A and B depends on
> different versions of package C, odd failures could occur. I'm not
> convinced propagation sidesteps this problem, however:
>
> https://lists.gnu.org/archive/html/guix-devel/2016-10/msg00856.html

I think we’re in trouble anyway if multiple versions of a package end up
in the dependency graph because that’s not something Python supports
(the same is probably true for most languages, with the notable
exception of Node.)

Perhaps it would be worth making a PoC to see what happens with a small
set of packages?

(I’m not volunteering though, just trying to tweak others into doing
it.  :-))

Ludo’.

[bug#27271] Avoiding ‘propagated-inputs’ for Python dependencies

[Hartmut Goebel]

Am 10.06.2017 um 15:39 schrieb Ludovic Courtès:
>> > I asked Hartmut about this during the python-build-system refactoring,
>> > and the counter-argument was that if package A and B depends on
>> > different versions of package C, odd failures could occur. I'm not
>> > convinced propagation sidesteps this problem, however:
>> >
>> > https://lists.gnu.org/archive/html/guix-devel/2016-10/msg00856.html
> I think we’re in trouble anyway if multiple versions of a package end up
> in the dependency graph because that’s not something Python supports
> (the same is probably true for most languages, with the notable
> exception of Node.)

That's true, you will have trouble anyway.

But when adding the paths via .pth file, we will get more problems and –
even more important – these problems will not be reported. Obscure bugs
will the the result.

The Zen of Python [1] says:

Errors should never pass silently.

When using .pth-files, we will get a ot of silent errors.

Analysis
--------------

1. Paths searched for .pth files are processed in the order of sys.path
(PYTHONPATH)
2. Within each path, .pth files are processed alphabetically (see
site.addsitedir())
3. Within the .pth file, paths are processed in top-down order.

Let's assume, we add a file ".package-name.pth" to each package.

Now if a user installs packages AAA in his/her profile, AAA's
dependencies will be listed in ".AAA.pth". AAA depends on SOME-PACKAGE,
which at the time of AAA's installation is @>=1.0. Some time later, he
user installs package BBB, which requires SOME-PACKAGE @>=1.3.(being
backward-compatible with 1.0).

Since from guix's point of view AAA and BBB are not interfering, both
packages are installed fine. No warnings will be reported.

But BBB is bound to fail! .AAA.pth is always processed prior to
.BBB.pth, so SOME-PACKAGE will always be @1.0 - which is to old for BBB.


[1] https://www.python.org/dev/peps/pep-0020/

-- 
Regards
Hartmut Goebel

| Hartmut Goebel          | h.goebel@crazy-compilers.com               |
| www.crazy-compilers.com | compilers which you thought are impossible |

[bug#27271] Avoiding ‘propagated-inputs’ for Python dependencies

[Hartmut Goebel]

Hi,

in addition to what I just wrote, you should be aware of this
implementation restriction:

.pth-files are searched only in directories listed in sys.path
(PYTHONPATH), they are not searched recursively.

Assuming the dependency-graph AAA -> SOME-PACKAGE -> PPP, guix (after
implementing this proposal) will only install AAA into the profile and
only .AAA.pth will be processes. This will result into PPP to be not found.

This could be worked around by adding a module "sitecustomize.py" to our
python setup, which could implement the recursive addition of paths.

BTW: The corresponding patch for python-2.7-site-prefixes.patch is
missing for Python 3, so for Python 3 no .pth-files are processed at
all  – I assume. (I have no time ATM for testing. Sorry.)

-- 
Regards
Hartmut Goebel

| Hartmut Goebel          | h.goebel@crazy-compilers.com               |
| www.crazy-compilers.com | compilers which you thought are impossible |

[bug#27271] [PATCH 0/4] Catch collisions at profile creation time

[Ricardo Wurmus]

Hi Ludo,

L> These patches allow us to catch problematic collisions when computing
L> a profile derivation.  As we know, the profile builder often spits out
L> a number of warnings about collisions but that is not very useful because
L> users cannot distinguish the problematic cases from the harmless cases
L> (an example of a harmless case is when GDB and Binutils provide an
L> almost-identical .info file twice).

[…]

R> I’ll give this a try soon and report my experience with it.

I just tried it and I didn’t work the way I thought it would.

Here’s what I did:

  # install old numpy
  guix package -p /tmp/test -i /gnu/store/s02iw98l234ngkcnxqi7jz54vqqgx6hj-python2-numpy-1.10.4

  # install a package depending on a later version of numpy
  guix package -p /tmp/test -i bamm

It built bamm and then proceeded to build a profile, while spitting out
hundreds of lines about conflicts between python2-numpy-1.10.4 and
python2-numpy-1.12.0.

This is the profile’s manifest:

--8<---------------cut here---------------start------------->8---
(manifest
  (version 3)
  (packages
    (("bamm"
      "1.7.3"
      "out"
      "/gnu/store/lcb2s2x3s50gmf24asl2mvv34jhx8n1x-bamm-1.7.3"
      (propagated-inputs
        (("python2-numpy"
          "1.12.0"
          "out"
          "/gnu/store/pzf5yszv5dlzmk71w7srdi2qdqh2j40a-python2-numpy-1.12.0"
          (propagated-inputs ())
          (search-paths ()))))
      (search-paths ()))
     ("python2-numpy"
      "1.10.4"
      "out"
      "/gnu/store/s02iw98l234ngkcnxqi7jz54vqqgx6hj-python2-numpy-1.10.4"
      (propagated-inputs ())
      (search-paths ())))))
--8<---------------cut here---------------end--------------->8---

Did I do something wrong?

I also wonder if we should add a way to force Guix to build the profile
despite the detected conflict.

--
Ricardo

GPG: BCA6 89B6 3655 3801 C3C6  2150 197A 5888 235F ACAC
https://elephly.net

[bug#27271] [PATCH 0/4] Catch collisions at profile creation time

[Ludovic Courtès]

[-- Attachment #1: Type: text/plain, Size: 1725 bytes --]

Hi,

Ricardo Wurmus <rekado@elephly.net> skribis:

> I just tried it and I didn’t work the way I thought it would.
>
> Here’s what I did:
>
>   # install old numpy
>   guix package -p /tmp/test -i /gnu/store/s02iw98l234ngkcnxqi7jz54vqqgx6hj-python2-numpy-1.10.4
>
>   # install a package depending on a later version of numpy
>   guix package -p /tmp/test -i bamm
>
> It built bamm and then proceeded to build a profile, while spitting out
> hundreds of lines about conflicts between python2-numpy-1.10.4 and
> python2-numpy-1.12.0.

Oops, good catch.  This is fixed with the attached patch.  Now I get:

--8<---------------cut here---------------start------------->8---
$ ./pre-inst-env guix package -p /tmp/test -i bamm
substitute: updating list of substitutes from 'https://mirror.hydra.gnu.org'... 100.0%
The following package will be installed:
   bamm	1.7.3	/gnu/store/lcb2s2x3s50gmf24asl2mvv34jhx8n1x-bamm-1.7.3

guix package: error: profile contains conflicting entries for python2-numpy:out
guix package: error:   first entry: python2-numpy@1.12.0:out /gnu/store/pzf5yszv5dlzmk71w7srdi2qdqh2j40a-python2-numpy-1.12.0
guix package: error:    ... propagated from bamm@1.7.3
guix package: error:   second entry: python2-numpy@1.10.4:out /gnu/store/pykndifwj34mc1h7m78d1b6c03gb5zq1-python2-numpy-1.10.4
--8<---------------cut here---------------end--------------->8---

I’ll add a test case for this.

> I also wonder if we should add a way to force Guix to build the profile
> despite the detected conflict.

Good question.  I wouldn’t be hard to do, but maybe we can wait until
there’s demand so we can analyze the use case better?

Thanks for testing!

Ludo’.


[-- Warning: decoded text below may be mangled, UTF-8 assumed --]
[-- Attachment #2: Type: text/x-patch, Size: 1126 bytes --]

diff --git a/guix/profiles.scm b/guix/profiles.scm
index 980229ca7..52a8bd2ea 100644
--- a/guix/profiles.scm
+++ b/guix/profiles.scm
@@ -157,6 +157,19 @@
 ;; Convenient alias, to avoid name clashes.
 (define make-manifest manifest)
 
+(define (manifest-transitive-entries manifest)
+  "Return the entries of MANIFEST along with their propagated inputs,
+recursively."
+  (let loop ((entries (manifest-entries manifest))
+             (result  '()))
+    (match entries
+      (()
+       (reverse result))
+      ((head . tail)
+       (loop (append (manifest-entry-dependencies head)
+                     tail)
+             (cons head result))))))
+
 (define-record-type* <manifest-entry> manifest-entry
   make-manifest-entry
   manifest-entry?
@@ -250,7 +263,7 @@ file name."
                (#f                                ;no conflict
                 (return result))))
            #t
-           (manifest-entries manifest))))
+           (manifest-transitive-entries manifest))))
 
 (define* (package->manifest-entry package #:optional (output "out")
                                   #:key (parent (delay #f)))

bug#27271: [PATCH 0/4] Catch collisions at profile creation time

[Ludovic Courtès]

Pushed, thanks!

Ludo’.