distro-build: try connecting a few times to let a VM warm up

This strategy has been successful for the package-build service,
and it will hopefully cut down on spurious snapshot build failures
that happen when a VM's networking doesn't start up quickly enough.

original commit: 14f984ba63bf3b9714e11b46d42f0402043d144f
This commit is contained in:
Matthew Flatt 2014-10-24 08:27:50 -06:00
parent 1521fd2b8e
commit 6a3aee711a

View File

@ -125,6 +125,15 @@
(when vbox
(stop-vbox-vm vbox)))
(define (try-until-ready c host port user server-port kind cmd)
(when (get-opt c '#:vbox)
;; A VM may take a little while to get networking set up and
;; respond, so give a dummy `cmd` a few tries
(let loop ([tries 3])
(unless (ssh-script host port user server-port kind cmd)
(sleep 1)
(loop (sub1 tries))))))
;; ----------------------------------------
(define scp (find-executable-path "scp"))
@ -280,6 +289,7 @@
(define (sh . args)
(list "/bin/sh" "-c" (apply ~a args)))
(define j (or (get-opt c '#:j) 1))
(try-until-ready c host port user server-port 'unix (sh "echo hello"))
(ssh-script
host port user
server-port
@ -308,6 +318,7 @@
(define j (or (get-opt c '#:j) 1))
(define (cmd . args)
(list "cmd" "/c" (shell-protect (apply ~a args) platform)))
(try-until-ready c host port user server-port 'windows (cmd "echo hello"))
(ssh-script
host port user
server-port