www

commit 6a3aee711ae9d6ad927c0717c03cd2304504e753
parent 1521fd2b8ec6f42137e8ca8a56b91c927397639d
Author: Matthew Flatt <mflatt@racket-lang.org>
Date:   Fri, 24 Oct 2014 08:27:50 -0600

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

Diffstat:
M
pkgs/distro-build-pkgs/distro-build-server/drive-clients.rkt
 | 
11
+++++++++++

1 file changed, 11 insertions(+), 0 deletions(-)
diff --git 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