ryan77627/guix
1
0
Fork 0
mirror of https://git.in.rschanz.org/ryan77627/guix.git synced 2024-11-07 07:26:13 -05:00
Code Issues Projects Releases Packages Wiki Activity Actions

installer: Fix device synchronization.

Browse source 
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.
This commit is contained in:
Mathieu Othacehe 2020-11-17 09:50:01 +01:00
parent 37c21b130c
commit 9113de2ca2
No known key found for this signature in database
GPG key ID: 8354763531769CA6
2 changed files with 28 additions and 13 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

23
gnu/installer/parted.scm
View file

@ -41,6 +41,7 @@ (define-module (gnu installer parted)
#: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 @@ (define (with-delay-device-in-use? file-name)
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 @@ (define (remove-logical-devices)
(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 @@ (define (free-parted devices)
(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?
(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)))))
file-name))
(syslog "Syncing ~a took ~a seconds.~%"
file-name (time-second time)))))
device-file-names)))

14
gnu/installer/utils.scm
View file

@ -22,6 +22,7 @@ (define-module (gnu installer utils)
#: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 @@ (define-module (gnu installer utils)
syslog-port
syslog
call-with-time
let/time
with-server-socket
current-server-socket
@ -117,6 +120,17 @@ (define (pause)
;;; 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)))