1 files changed, 71 insertions, 9 deletions

diff --git a/guix-build-coordinator/hooks.scm b/guix-build-coordinator/hooks.scm
index d419365..9d9a5b1 100644
--- a/guix-build-coordinator/hooks.scm
+++ b/guix-build-coordinator/hooks.scm
@@ -25,6 +25,7 @@
   #:use-module (guix pki)
   #:use-module (guix config)
   #:use-module (guix build utils)
+  #:use-module (guix-build-coordinator config)
   #:use-module (guix-build-coordinator utils)
   #:use-module (guix-build-coordinator datastore)
   #:use-module (guix-build-coordinator coordinator)
@@ -42,12 +43,12 @@
                     build-id agent-id)
      (current-error-port))))
 
-
 (define* (build-success-publish-hook
           publish-directory
           #:key
           (public-key  (read-file-sexp %public-key-file))
-          (private-key (read-file-sexp %private-key-file)))
+          (private-key (read-file-sexp %private-key-file))
+          post-publish-hook)
   (mkdir-p (string-append publish-directory "/nar/lzip"))
 
   (lambda (datastore build-id)
@@ -64,15 +65,19 @@
                 (nar-location
                  (build-output-file-location datastore build-id
                                              output-name))
+                (nar-filename
+                 (string-append "/nar/lzip/"
+                                (basename output-filename)))
                 (nar-destination
                  (string-append publish-directory
-                                "/nar/lzip/"
-                                (basename output-filename)))
+                                nar-filename))
+                (narinfo-filename
+                 (string-append (string-take (basename output-filename) 32)
+                                ".narinfo"))
+
                 (narinfo-location
-                 (string-append publish-directory
-                                "/"
-                                (string-take (basename output-filename) 32)
-                                ".narinfo")))
+                 (string-append publish-directory "/"
+                                narinfo-filename)))
 
            (copy-file nar-location nar-destination)
 
@@ -91,9 +96,66 @@
                          #:derivation derivation-name
                          #:public-key public-key
                          #:private-key private-key)
-                        port)))))
+                        port)))
+
+           (when post-publish-hook
+             (post-publish-hook publish-directory
+                                narinfo-filename
+                                nar-filename))))
        (datastore-list-build-outputs datastore build-id)))))
 
+(define* (build-success-s3-publish-hook
+          s3-bucket
+          #:key
+          (command-line-arguments '())
+          (public-key  (read-file-sexp %public-key-file))
+          (private-key (read-file-sexp %private-key-file)))
+  (define (s3-file-exists? name)
+    (if (null?
+         (retry-on-error
+          (lambda ()
+            (s3-list-objects s3-bucket name
+                             #:command-line-arguments
+                             command-line-arguments))
+          #:times 6
+          #:delay 20))
+        #f
+        #t))
+
+  (let ((temp-dir (string-append (%config 'data-dir)
+                                 "/temp-s3-uploads")))
+    (unless (file-exists? temp-dir)
+      (mkdir temp-dir))
+
+    (build-success-publish-hook
+     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-line-arguments
+                   command-line-arguments))
+          #:times 6
+          #:delay 20)
+         (retry-on-error
+          (lambda ()
+            (s3-cp s3-bucket
+                   (string-append directory "/" narinfo-filename)
+                   narinfo-filename
+                   #:command-line-arguments
+                   command-line-arguments))
+          #:times 6
+          #:delay 20))
+
+       (delete-file (string-append directory "/" narinfo-filename))
+       (delete-file (string-append directory "/" nar-filename))))))
+
 (define (default-build-failure-hook datastore build-id)
   (let ((agent-id
          (datastore-agent-for-build datastore build-id)))