summaryrefslogtreecommitdiff
path: root/gnu
diff options
context:
space:
mode:
authorMathieu Othacehe <othacehe@gnu.org>2020-11-17 09:50:01 +0100
committerMathieu Othacehe <othacehe@gnu.org>2020-11-17 19:09:19 +0100
commit9113de2ca2db195908e3262b3752f8392ada8630 (patch)
tree35faae978bf3c29d01c5b22c00b920e6d48599a7 /gnu
parent37c21b130c0072f23bb735ca6903d8711416d5d9 (diff)
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.
Diffstat (limited to 'gnu')
-rw-r--r--gnu/installer/parted.scm27
-rw-r--r--gnu/installer/utils.scm14
2 files changed, 28 insertions, 13 deletions
diff --git a/gnu/installer/parted.scm b/gnu/installer/parted.scm
index f592d315f5..9ef263d1f9 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)))
@@ -1390,9 +1388,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)))