summary refs log tree commit diff
diff options
context:
space:
mode:
authorLudovic Courtès <ludo@gnu.org>2014-03-08 21:23:12 +0100
committerLudovic Courtès <ludo@gnu.org>2014-03-08 21:23:12 +0100
commit5cc569dc733c3d606be5180b43c6e8566009b4a3 (patch)
tree998845eaef6705aef5bb98f0e34285c91083b470
parent7df3ade11286e52829c855b76fc395a4c3831ced (diff)
downloadguix-5cc569dc733c3d606be5180b43c6e8566009b4a3.tar.gz
offload: Prevent locked files from being GC'd.
* guix/scripts/offload.scm (%slots): New variable.
  (choose-build-machine): Add SLOT to '%slots'.
-rw-r--r--guix/scripts/offload.scm9
1 files changed, 8 insertions, 1 deletions
diff --git a/guix/scripts/offload.scm b/guix/scripts/offload.scm
index 2d2dbe36c5..e1da31af5d 100644
--- a/guix/scripts/offload.scm
+++ b/guix/scripts/offload.scm
@@ -383,6 +383,10 @@ connections allowed to MACHINE."
   "Release SLOT, a build slot as returned as by 'acquire-build-slot'."
   (close-port slot))
 
+(define %slots
+  ;; List of acquired build slots (open ports).
+  '())
+
 (define (choose-build-machine requirements machines)
   "Return the best machine among MACHINES fulfilling REQUIREMENTS, or #f."
 
@@ -418,7 +422,10 @@ connections allowed to MACHINE."
 
          ;; Return the best machine unless it's already overloaded.
          (if (< (machine-load best) 2.)
-             best
+             (begin
+               ;; Prevent SLOT from being GC'd.
+               (set! %slots (cons slot %slots))
+               best)
              (begin
                (release-build-slot slot)
                #f)))