Package input loop detection

[Christopher Baines]

I've had this issue for a while now, while adding some packages, I'll
create a loop in the package graph, which causes Guix to just loop
infinitely when trying to generate derivations.

I've included a very rough patch which detects and informs the user what
has happened, this is an example of what this looks like (with a version
of the wip-rails branch I've broken):


$ guix build ruby-rails

error: input loop detected, error generating a derivation for #<package 
address@hidden 
/home/chris/Projects/Guix/guix-wip-rails/gnu/packages/rails.scm:136 2d9f300>

This shouldn't happen with Guix packages, please consider reporting a bug.

Report bugs to: address@hidden
GNU Guix home page: <https://www.gnu.org/software/guix/>
General help using GNU software: <http://www.gnu.org/gethelp/>

If any of the packages below are not included in Guix, it could be that one of
them is causing the loop. The packages are listed in reverse order, so the
first package listed is a input to the second package for example, and the
start and end of the detected loop is highlighted with an arrow (--->).

 --->   #<package address@hidden gnu/packages/ruby.scm:446 2b82d80>
        #<package address@hidden gnu/packages/ruby.scm:6865 2bcc300>
        #<package address@hidden gnu/packages/ruby.scm:6822 2bcc3c0>
        #<package address@hidden gnu/packages/ruby.scm:325 2b6d300>
 --->   #<package address@hidden gnu/packages/ruby.scm:446 2b82d80>
        #<package address@hidden gnu/packages/ruby.scm:4562 2bb3c00>
        #<package address@hidden gnu/packages/ruby.scm:2794 2ba0900>
        #<package address@hidden 
/home/chris/Projects/Guix/guix-wip-rails/gnu/packages/rails.scm:267 3b619c0>
        #<package address@hidden 
/home/chris/Projects/Guix/guix-wip-rails/gnu/packages/rails.scm:237 3b61c00>
        #<package address@hidden 
/home/chris/Projects/Guix/guix-wip-rails/gnu/packages/rails.scm:183 2d9f0c0>
        #<package address@hidden 
/home/chris/Projects/Guix/guix-wip-rails/gnu/packages/rails.scm:136 2d9f300>


I'm not particularly fond of the implementation, because the
package-derivation function is called from expand-input called from
bag->derivation, the information about the part of the graph that has
been traversed is passed through each function.

The seen-package-list argument could be removed, but the ordering
information is really useful when printing out the error message. I
think it should be still possible to generate this after finding the
issue by searching through the graph of packages, which would allow
removing this one argument.

One other thought I had is that this could be extracted to something in
guix lint, which would at least allow finding these problems, without
touching the core derivation related code.

What do people think?

Thanks,

Chris


From ac8434025cc16fee2bc84345313305fc9146ca20 Mon Sep 17 00:00:00 2001
From: Christopher Baines <address@hidden>
Date: Mon, 5 Feb 2018 16:28:42 +0000
Subject: [PATCH] WIP: Add package input loop detection.

---
 guix/packages.scm | 60 +++++++++++++++++++++++++++++++++++++++++++++----------
 1 file changed, 50 insertions(+), 10 deletions(-)

diff --git a/guix/packages.scm b/guix/packages.scm
index 7d884aa36..c34191183 100644
--- a/guix/packages.scm
+++ b/guix/packages.scm
@@ -21,6 +21,7 @@
 ;;; along with GNU Guix.  If not, see <http://www.gnu.org/licenses/>.
 
 (define-module (guix packages)
+  #:use-module (guix ui)
   #:use-module (guix utils)
   #:use-module (guix records)
   #:use-module (guix store)
@@ -860,7 +861,8 @@ Return the cached result when available."
     ((_ package system body ...)
      (cached (=> %derivation-cache) package system body ...))))
 
-(define* (expand-input store package input system #:optional cross-system)
+(define* (expand-input store package input system #:optional cross-system
+                       #:key seen-packages seen-package-list)
   "Expand INPUT, an input tuple, such that it contains only references to
 derivation paths or store paths.  PACKAGE is only used to provide contextual
 information in exceptions."
@@ -873,7 +875,9 @@ information in exceptions."
     (if cross-system
         (cut package-cross-derivation store <> cross-system system
              #:graft? #f)
-        (cut package-derivation store <> system #:graft? #f)))
+        (cut package-derivation store <> system #:graft? #f
+             #:seen-packages seen-packages
+             #:seen-package-list seen-package-list)))
 
   (match input
     (((? string? name) (? package? package))
@@ -1077,7 +1081,8 @@ TARGET."
     (bag-grafts store bag)))
 
 (define* (bag->derivation store bag
-                          #:optional context)
+                          #:optional context
+                          #:key seen-packages seen-package-list)
   "Return the derivation to build BAG for SYSTEM.  Optionally, CONTEXT can be
 a package object describing the context in which the call occurs, for improved
 error reporting."
@@ -1085,7 +1090,9 @@ error reporting."
       (bag->cross-derivation store bag)
       (let* ((system     (bag-system bag))
              (inputs     (bag-transitive-inputs bag))
-             (input-drvs (map (cut expand-input store context <> system)
+             (input-drvs (map (cut expand-input store context <> system
+                                   #:seen-packages seen-packages
+                                   #:seen-package-list seen-package-list)
                               inputs))
              (paths      (delete-duplicates
                           (append-map (match-lambda
@@ -1102,20 +1109,27 @@ error reporting."
                (bag-arguments bag)))))
 
 (define* (bag->cross-derivation store bag
-                                #:optional context)
+                                #:optional context
+                                #:key seen-packages seen-package-list)
   "Return the derivation to build BAG, which is actually a cross build.
 Optionally, CONTEXT can be a package object denoting the context of the call.
 This is an internal procedure."
   (let* ((system      (bag-system bag))
          (target      (bag-target bag))
          (host        (bag-transitive-host-inputs bag))
-         (host-drvs   (map (cut expand-input store context <> system target)
+         (host-drvs   (map (cut expand-input store context <> system target
+                                #:seen-packages seen-packages
+                                #:seen-package-list seen-package-list)
                            host))
          (target*     (bag-transitive-target-inputs bag))
-         (target-drvs (map (cut expand-input store context <> system)
+         (target-drvs (map (cut expand-input store context <> system
+                                #:seen-packages seen-packages
+                                #:seen-package-list seen-package-list)
                            target*))
          (build       (bag-transitive-build-inputs bag))
-         (build-drvs  (map (cut expand-input store context <> system)
+         (build-drvs  (map (cut expand-input store context <> system
+                                #:seen-packages seen-packages
+                                #:seen-package-list seen-package-list)
                            build))
          (all         (append build target* host))
          (paths       (delete-duplicates
@@ -1144,15 +1158,41 @@ This is an internal procedure."
 
 (define* (package-derivation store package
                              #:optional (system (%current-system))
-                             #:key (graft? (%graft?)))
+                             #:key (graft? (%graft?))
+                             (seen-packages (setq))
+                             (seen-package-list '()))
   "Return the <derivation> object of PACKAGE for SYSTEM."
 
+  (if (set-contains? seen-packages package)
+      (begin
+        (simple-format #t "\nerror: input loop detected, error generating a 
derivation for ~A\n"
+                       (last seen-package-list))
+        (display "
+This shouldn't happen with Guix packages, please consider reporting a bug.\n")
+        (show-bug-report-information)
+        (display "
+If any of the packages below are not included in Guix, it could be that one of
+them is causing the loop. The packages are listed in reverse order, so the
+first package listed is a input to the second package for example, and the
+start and end of the detected loop is highlighted with an arrow (--->).\n\n")
+        (for-each (lambda (seen-package)
+                    (if (eq? package seen-package)
+                        (display " --->"))
+                    (simple-format #t "\t~A\n" seen-package))
+                  (cons package
+                        seen-package-list))
+        (exit 1)))
+
   ;; Compute the derivation and cache the result.  Caching is important
   ;; because some derivations, such as the implicit inputs of the GNU build
   ;; system, will be queried many, many times in a row.
   (cached package (cons system graft?)
           (let* ((bag (package->bag package system #f #:graft? graft?))
-                 (drv (bag->derivation store bag package)))
+                 (drv (bag->derivation store bag package
+                                       #:seen-packages
+                                       (set-insert package seen-packages)
+                                       #:seen-package-list
+                                       (cons package seen-package-list))))
             (if graft?
                 (match (bag-grafts store bag)
                   (()
-- 
2.16.1

signature.asc
Description: PGP signature