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.

1 files changed, 14 insertions, 0 deletions

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)))