bug#31268: 'guix system vm-image' hangs

[Ludovic Courtès]

Hello Mark,

Mark H Weaver <address@hidden> skribis:

> FYI, I just pushed commit 8c21c64e59d3f4d223d8aeef91f06fdde7de1ab7 which
> updates linux-libre to 4.16.6.  Would you like to see if the problem
> still persists?

It does.

I instrumented the code to see what happens.  Opening /dev/vda works
fine, invoking “parted --version” works, so it’s really just ‘parted’
that hangs when asked to do the real thing (with 0% CPU consumption.)

However, if we strace it as with the patch below, it succeeds.  It
doesn’t seem to be a simple timing issue because adding (sleep 2) before
the parted invocation doesn’t make a difference.

To be continued…

Ludo’.

diff --git a/gnu/build/vm.scm b/gnu/build/vm.scm
index 527b4c495..b73c8f912 100644
--- a/gnu/build/vm.scm
+++ b/gnu/build/vm.scm
@@ -242,9 +242,21 @@ actual /dev name based on DEVICE."
                                      partition-size)
                             partitions)
                        ", "))
-  (apply invoke "parted" "--script"
+  (pk 'parted (which "parted"))
+  (pk 'parted2 (stat (which "parted")))
+  (pk 'opts device partitions offset)
+  (pk 'actual-options "parted" "--script"
          device "mklabel" label-type
          (options partitions offset))
+  (pk 'stat device (stat device))
+  (invoke "parted" "--version")
+  ;; (pk 'open-device device (open-fdes device O_WRONLY))
+  (pk 'parted)
+  (apply invoke "strace" "-s" "123"
+         "parted" "--script"
+         device "mklabel" label-type
+         (options partitions offset))
+  (pk 'parted-done)
 
   ;; Set the 'device' field of each partition.
   (reverse
diff --git a/gnu/system/vm.scm b/gnu/system/vm.scm
index 09a11af86..ba54a71dd 100644
--- a/gnu/system/vm.scm
+++ b/gnu/system/vm.scm
@@ -304,7 +304,7 @@ the image."
                       (ice-9 binary-ports))
 
          (let ((inputs
-                '#$(append (list qemu parted e2fsprogs dosfstools)
+                '#$(append (list strace qemu parted e2fsprogs dosfstools)
                            (map canonical-package
                                 (list sed grep coreutils findutils gawk))
                            (if register-closures? (list guix) '())))