Re: GNU Guix 1.2.0rc1 available for testing!

[Mathieu Othacehe]

Hello Florian,

> Thank you for the quick patch!  Clearly you have been spot-on.
> “Partition formatting is in progress, please wait” is displayed
> considerably longer but eventually succeeds.  I tried 3 times
> successfully with your patch.  I tried again without your patch and it
> failed.  I tried once more with your patch and formatting succeeded
> again.

That's good news! Here's a more complete patch that I intend to push on
the 1.2.0 branch. It logs the time spent waiting for disk
synchronization.

It would be great if you could test it one more time, so that we know if
4 seconds is enough or if we should use an even higher delay.

Thanks again,

Mathieu

>From f3d41cff6704ad748d51e4dd548c045034656b66 Mon Sep 17 00:00:00 2001
From: Mathieu Othacehe <othacehe@gnu.org>
Date: Tue, 17 Nov 2020 09:50:01 +0100
Subject: [PATCH] installer: Fix device synchronization.

Reported by Florian Pelz:
https://lists.gnu.org/archive/html/guix-devel/2020-11/msg00326.html.

* gnu/installer/utils.scm (call-with-time): New procedure,
(let/time): new macro.
* gnu/installer/parted.scm (with-delay-device-in-use?): Increase the retry
count to 16.
(non-install-devices): Remove the call to with-delay-device-in-use? as it
doesn't return the expected result, and would block much longer now.
(free-parted): Log the time required to sync each device.
---
 gnu/installer/parted.scm | 27 ++++++++++++++-------------
 gnu/installer/utils.scm  | 14 ++++++++++++++
 2 files changed, 28 insertions(+), 13 deletions(-)

diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index f2352c5779..3ad1721795 100644
--- a/gnu/installer/parted.scm
+++ b/gnu/installer/parted.scm
@@ -41,6 +41,7 @@
   #:use-module (ice-9 regex)
   #:use-module (rnrs io ports)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-34)
   #:use-module (srfi srfi-35)
@@ -318,7 +319,7 @@ PARTED-OBJECT field equals PARTITION, return #f if not 
found."
 fail. See rereadpt function in wipefs.c of util-linux for an explanation."
   ;; Kernel always return EINVAL for BLKRRPART on loopdevices.
   (and (not (string-match "/dev/loop*" file-name))
-       (let loop ((try 4))
+       (let loop ((try 16))
          (usleep 250000)
          (let ((in-use? (device-in-use? file-name)))
            (if (and in-use? (> try 0))
@@ -339,15 +340,12 @@ fail. See rereadpt function in wipefs.c of util-linux for 
an explanation."
 (define (non-install-devices)
   "Return all the available devices, except the busy one, allegedly the
 install device. DEVICE-IS-BUSY? is a parted call, checking if the device is
-mounted. The install image uses an overlayfs so the install device does not
-appear as mounted and won't be considered as busy. So use also DEVICE-IN-USE?
-from (guix build syscalls) module, who will try to re-read the device's
-partition table to determine whether or not it is already used (like sfdisk
-from util-linux)."
+mounted."
+  ;; FIXME: The install image uses an overlayfs so the install device does not
+  ;; appear as mounted and won't be considered as busy.
   (remove (lambda (device)
             (let ((file-name (device-path device)))
-              (or (device-is-busy? device)
-                  (with-delay-device-in-use? file-name))))
+              (device-is-busy? device)))
           (devices)))
 
 
@@ -1368,9 +1366,12 @@ the devices not to be used before returning."
   (let ((device-file-names (map device-path devices)))
     (for-each force-device-sync devices)
     (for-each (lambda (file-name)
-                (let ((in-use? (with-delay-device-in-use? file-name)))
-                  (and in-use?
-                       (error
-                        (format #f (G_ "Device ~a is still in use.")
-                                file-name)))))
+                (let/time ((time in-use?
+                                 (with-delay-device-in-use? file-name)))
+                  (if in-use?
+                      (error
+                       (format #f (G_ "Device ~a is still in use.")
+                               file-name))
+                      (syslog "Syncing ~a took ~a seconds.~%"
+                              file-name (time-second time)))))
               device-file-names)))
diff --git a/gnu/installer/utils.scm b/gnu/installer/utils.scm
index 5f8fe8ca01..a7fa66a199 100644
--- a/gnu/installer/utils.scm
+++ b/gnu/installer/utils.scm
@@ -22,6 +22,7 @@
   #:use-module (guix build utils)
   #:use-module (guix i18n)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-19)
   #:use-module (srfi srfi-34)
   #:use-module (ice-9 match)
   #:use-module (ice-9 rdelim)
@@ -36,6 +37,8 @@
 
             syslog-port
             syslog
+            call-with-time
+            let/time
 
             with-server-socket
             current-server-socket
@@ -117,6 +120,17 @@ COMMAND exited successfully, #f otherwise."
 ;;; Logging.
 ;;;
 
+(define (call-with-time thunk kont)
+  "Call THUNK and pass KONT the elapsed time followed by THUNK's return
+values."
+  (let* ((start  (current-time time-monotonic))
+         (result (call-with-values thunk list))
+         (end    (current-time time-monotonic)))
+    (apply kont (time-difference end start) result)))
+
+(define-syntax-rule (let/time ((time result exp)) body ...)
+  (call-with-time (lambda () exp) (lambda (time result) body ...)))
+
 (define (open-syslog-port)
   "Return an open port (a socket) to /dev/log or #f if that wasn't possible."
   (let ((sock (socket AF_UNIX SOCK_DGRAM 0)))
-- 
2.29.2