1 files changed, 61 insertions, 1 deletions
diff --git a/guix-build-coordinator/utils.scm b/guix-build-coordinator/utils.scm
index 0b9c8f7..244adc8 100644
--- a/guix-build-coordinator/utils.scm
+++ b/guix-build-coordinator/utils.scm
@@ -3,11 +3,14 @@
   #:use-module (srfi srfi-26)
   #:use-module (srfi srfi-60)
   #:use-module (ice-9 ftw)
+  #:use-module (ice-9 popen)
   #:use-module (ice-9 match)
   #:use-module (ice-9 format)
   #:use-module (ice-9 threads)
+  #:use-module (ice-9 textual-ports)
   #:use-module (ice-9 rdelim)
   #:use-module (ice-9 binary-ports)
+  #:use-module (ice-9 exceptions)
   #:use-module (rnrs bytevectors)
   #:use-module (web uri)
   #:use-module (web http)
@@ -19,6 +22,7 @@
   #:use-module (gcrypt random)
   #:use-module (fibers)
   #:use-module (fibers channels)
+  #:use-module (json)
   #:use-module (guix pki)
   #:use-module (guix utils)
   #:use-module (guix config)
@@ -41,7 +45,10 @@
 
             narinfo-string
 
-            retry-on-error))
+            retry-on-error
+
+            s3-list-objects
+            s3-cp))
 
 
 (define %worker-thread-args
@@ -416,3 +423,56 @@ References: ~a~%"
               delay)
              (sleep delay)
              (loop (+ 1 attempt))))))))
+
+(define* (s3-list-objects s3-bucket prefix
+                          #:key (command-line-arguments '()))
+  (let ((command
+         `("aws" "s3api"
+           ,@command-line-arguments
+           "list-objects"
+           "--bucket" ,s3-bucket
+           "--prefix" ,prefix)))
+    (simple-format
+     #t
+     "running: ~A\n"
+     (string-join command))
+    (let ((pipe (apply open-pipe*
+                       OPEN_READ
+                       command)))
+
+      (let ((output    (get-string-all pipe))
+            (exit-code (status:exit-val
+                        (close-pipe pipe))))
+        (if (zero? (peek "EXIT" exit-code))
+            (if (string-null? (peek "OUT" output))
+                '()
+                (json-string->scm output))
+            (raise-exception
+             (make-exception-with-message
+              output)))))))
+
+(define* (s3-cp s3-bucket source destination
+                #:key (command-line-arguments '()))
+  (let ((command
+         `("aws" "s3"
+           ,@command-line-arguments
+           "cp"
+           ,source
+           ,(simple-format #f "s3://~A/~A"
+                           s3-bucket destination))))
+    (simple-format
+     #t
+     "running: ~A\n"
+     (string-join command))
+    (let ((exit-code
+           (status:exit-val
+            (apply system* command))))
+      (unless (zero? exit-code)
+        (raise-exception
+         (make-exception-with-message
+          (simple-format
+           #f
+           "error: command failed (~A): ~A\n"
+           exit-code
+           command))))
+      #t)))