From 6a3aee711ae9d6ad927c0717c03cd2304504e753 Mon Sep 17 00:00:00 2001 From: Matthew Flatt Date: Fri, 24 Oct 2014 08:27:50 -0600 Subject: [PATCH] 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 --- .../distro-build-server/drive-clients.rkt | 11 +++++++++++ 1 file changed, 11 insertions(+) diff --git a/pkgs/distro-build-pkgs/distro-build-server/drive-clients.rkt b/pkgs/distro-build-pkgs/distro-build-server/drive-clients.rkt index 1bd48a4..2258600 100644 --- a/pkgs/distro-build-pkgs/distro-build-server/drive-clients.rkt +++ b/pkgs/distro-build-pkgs/distro-build-server/drive-clients.rkt @@ -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