From a26828f1caf2db5890dedd8e9354fdf0bf99d8f6 Mon Sep 17 00:00:00 2001
From: Christopher Baines <mail@cbaines.net>
Date: Sun, 14 Feb 2021 10:03:05 +0000
Subject: Tweak the S3 publish hook to avoid issues for not submitted outputs

Agents can skip submitting outputs where those outputs have already been
received, this saves some work when all the information is communicated in the
build status.

The publish hook worked with this change, because it checks for narinfo files,
and would not bother about the missing outputs if the corresponding narinfo
existed. This didn't quite work with the s3 publish hook though, but these
changes address that by getting the two hooks to write and check for narinfo
files in the same location.
---
 guix-build-coordinator/hooks.scm | 67 ++++++++++++++++++++++------------------
 1 file changed, 37 insertions(+), 30 deletions(-)

diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm
index 02c4857..a31b804 100644
--- a/guix-build-coordinator/hooks.scm
+++ b/guix-build-coordinator/hooks.scm
@@ -79,6 +79,7 @@
           #:key
           (public-key  (read-file-sexp %public-key-file))
           (private-key (read-file-sexp %private-key-file))
+          (narinfo-directory publish-directory)
           post-publish-hook)
   (mkdir-p (string-append publish-directory "/nar/lzip"))
 
@@ -110,7 +111,7 @@
                                 ".narinfo"))
 
                 (narinfo-location
-                 (string-append publish-directory "/"
+                 (string-append narinfo-directory "/"
                                 narinfo-filename)))
 
            (unless (file-exists? narinfo-location)
@@ -153,6 +154,7 @@
           #:key
           (aws-command "aws")
           (command-line-arguments '())
+          (narinfo-directory #f)
           (public-key  (read-file-sexp %public-key-file))
           (private-key (read-file-sexp %private-key-file))
           post-publish-hook)
@@ -176,40 +178,45 @@
 
     (build-success-publish-hook
      temp-dir
+     #:narinfo-directory (or narinfo-directory temp-dir)
      #:public-key public-key
      #:private-key private-key
      #:post-publish-hook
      (lambda (directory narinfo-filename nar-filename)
-       (unless (s3-file-exists? narinfo-filename)
-         (retry-on-error
-          (lambda ()
-            (s3-cp s3-bucket
-                   (string-append directory "/" nar-filename)
-                   nar-filename
-                   #:command aws-command
-                   #:command-line-arguments
-                   command-line-arguments))
-          #:times 6
-          #:delay 20)
-
-         (when post-publish-hook
-           (post-publish-hook directory
-                              narinfo-filename
-                              nar-filename))
-
-         (retry-on-error
-          (lambda ()
-            (s3-cp s3-bucket
-                   (string-append directory "/" narinfo-filename)
-                   narinfo-filename
-                   #:command aws-command
-                   #:command-line-arguments
-                   command-line-arguments))
-          #:times 6
-          #:delay 20))
+       (let ((narinfo-full-filename
+              (string-append (or narinfo-directory temp-dir)
+                             "/" narinfo-filename)))
+         (unless (s3-file-exists? narinfo-filename)
+           (retry-on-error
+            (lambda ()
+              (s3-cp s3-bucket
+                     (string-append directory "/" nar-filename)
+                     nar-filename
+                     #:command aws-command
+                     #:command-line-arguments
+                     command-line-arguments))
+            #:times 6
+            #:delay 20)
+
+           (when post-publish-hook
+             (post-publish-hook directory
+                                narinfo-filename
+                                nar-filename))
 
-       (delete-file (string-append directory "/" narinfo-filename))
-       (delete-file (string-append directory "/" nar-filename))))))
+           (retry-on-error
+            (lambda ()
+              (s3-cp s3-bucket
+                     narinfo-full-filename
+                     narinfo-filename
+                     #:command aws-command
+                     #:command-line-arguments
+                     command-line-arguments))
+            #:times 6
+            #:delay 20))
+
+         (unless narinfo-directory
+           (delete-file narinfo-full-filename))
+         (delete-file (string-append directory "/" nar-filename)))))))
 
 (define (default-build-failure-hook build-coordinator build-id)
   (define datastore
-- 
cgit v1.2.3