offload: Distinguish between 'decline' and 'postpone'.

* guix/scripts/offload.scm (transfer-and-offload): New procedure, with
  core formerly in 'process-request'.
  (choose-build-machine): Remove 'requirements' parameter.
  (process-request): Reply 'decline' when none of MACHINES matches the
  requirements, and 'postpone' when MACHINES are busy.

1 files changed, 67 insertions, 42 deletions

diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index e1da31af5d..dffc3e9fd2 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -199,6 +199,43 @@ there, and write the build log to LOG-PORT.  Return the exit status."
 
     (close-pipe pipe)))
 
+(define* (transfer-and-offload drv machine
+                               #:key
+                               (inputs '())
+                               (outputs '())
+                               (max-silent-time 3600)
+                               (build-timeout 7200)
+                               print-build-trace?)
+  "Offload DRV to MACHINE.  Prior to the actual offloading, transfer all of
+INPUTS to MACHINE; if building DRV succeeds, retrieve all of OUTPUTS from
+MACHINE."
+  ;; Acquire MACHINE's exclusive lock to serialize file transfers
+  ;; to/from MACHINE in the presence of several 'offload' hook
+  ;; instance.
+  (when (with-machine-lock machine 'bandwidth
+          (send-files (cons (derivation-file-name drv) inputs)
+                      machine))
+    (let ((status (offload drv machine
+                           #:print-build-trace? print-build-trace?
+                           #:max-silent-time max-silent-time
+                           #:build-timeout build-timeout)))
+      (if (zero? status)
+          (begin
+            ;; Likewise (see above.)
+            (with-machine-lock machine 'bandwidth
+              (retrieve-files outputs machine))
+            (format (current-error-port)
+                    "done with offloaded '~a'~%"
+                    (derivation-file-name drv)))
+          (begin
+            (format (current-error-port)
+                    "derivation '~a' offloaded to '~a' failed \
+with exit code ~a~%"
+                    (derivation-file-name drv)
+                    (build-machine-name machine)
+                    (status:exit-val status))
+            (primitive-exit (status:exit-val status)))))))
+
 (define (send-files files machine)
   "Send the subset of FILES that's missing to MACHINE's store.  Return #t on
 success, #f otherwise."
@@ -387,8 +424,8 @@ connections allowed to MACHINE."
   ;; List of acquired build slots (open ports).
   '())
 
-(define (choose-build-machine requirements machines)
-  "Return the best machine among MACHINES fulfilling REQUIREMENTS, or #f."
+(define (choose-build-machine machines)
+  "Return the best machine among MACHINES, or #f."
 
   ;; Proceed like this:
   ;;   1. Acquire the global machine-choice lock.
@@ -411,9 +448,7 @@ connections allowed to MACHINE."
         (and (pred machine)
              (list machine slot)))))
 
-    (let ((machines+slots (sort (filter (undecorate
-                                         (cut machine-matches? <> requirements))
-                                        machines+slots)
+    (let ((machines+slots (sort machines+slots
                                 (undecorate machine-less-loaded-or-faster?))))
       (match machines+slots
         (((best slot) (others slots) ...)
@@ -436,43 +471,33 @@ connections allowed to MACHINE."
                           print-build-trace? (max-silent-time 3600)
                           (build-timeout 7200))
   "Process a request to build DRV."
-  (let* ((local?  (and wants-local? (string=? system (%current-system))))
-         (reqs    (build-requirements
-                   (system system)
-                   (features features)))
-         (machine (choose-build-machine reqs (build-machines))))
-    (if machine
-        (begin
-          (display "# accept\n")
-          (let ((inputs  (string-tokenize (read-line)))
-                (outputs (string-tokenize (read-line))))
-            ;; Acquire MACHINE's exclusive lock to serialize file transfers
-            ;; to/from MACHINE in the presence of several 'offload' hook
-            ;; instance.
-            (when (with-machine-lock machine 'bandwidth
-                    (send-files (cons (derivation-file-name drv) inputs)
-                                machine))
-              (let ((status (offload drv machine
-                                     #:print-build-trace? print-build-trace?
-                                     #:max-silent-time max-silent-time
-                                     #:build-timeout build-timeout)))
-                (if (zero? status)
-                    (begin
-                      ;; Likewise (see above.)
-                      (with-machine-lock machine 'bandwidth
-                        (retrieve-files outputs machine))
-                      (format (current-error-port)
-                              "done with offloaded '~a'~%"
-                              (derivation-file-name drv)))
-                    (begin
-                      (format (current-error-port)
-                              "derivation '~a' offloaded to '~a' failed \
-with exit code ~a~%"
-                              (derivation-file-name drv)
-                              (build-machine-name machine)
-                              (status:exit-val status))
-                      (primitive-exit (status:exit-val status))))))))
-        (display "# decline\n"))))
+  (let* ((local?     (and wants-local? (string=? system (%current-system))))
+         (reqs       (build-requirements
+                      (system system)
+                      (features features)))
+         (candidates (filter (cut machine-matches? <> reqs)
+                             (build-machines))))
+    (match candidates
+      (()
+       ;; We'll never be able to match REQS.
+       (display "# decline\n"))
+      ((_ ...)
+       (let ((machine (choose-build-machine candidates)))
+         (if machine
+             (begin
+               ;; Offload DRV to MACHINE.
+               (display "# accept\n")
+               (let ((inputs  (string-tokenize (read-line)))
+                     (outputs (string-tokenize (read-line))))
+                 (transfer-and-offload drv machine
+                                       #:inputs inputs
+                                       #:outputs outputs
+                                       #:max-silent-time max-silent-time
+                                       #:build-timeout build-timeout
+                                       #:print-build-trace? print-build-trace?)))
+
+             ;; Not now, all the machines are busy.
+             (display "# postpone\n")))))))
 
 (define-syntax-rule (with-nar-error-handling body ...)
   "Execute BODY with any &nar-error suitably reported to the user."