From f5853c7e3146421d5ca2923cd0b8a7f92e7627af Mon Sep 17 00:00:00 2001
From: Doug Coleman <doug.coleman@gmail.com>
Date: Tue, 4 Aug 2015 15:05:38 -0700
Subject: [PATCH] bootstrap.image.upload: Upload build images as well for
 posterity.

---
 basis/bootstrap/image/upload/upload.factor | 64 ++++++++++++++++++----
 1 file changed, 54 insertions(+), 10 deletions(-)

diff --git a/basis/bootstrap/image/upload/upload.factor b/basis/bootstrap/image/upload/upload.factor
index a1f0a777bb..f8f5f17140 100644
--- a/basis/bootstrap/image/upload/upload.factor
+++ b/basis/bootstrap/image/upload/upload.factor
@@ -1,25 +1,32 @@
 ! Copyright (C) 2008 Slava Pestov.
+! Copyright (C) 2015 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
-USING: bootstrap.image checksums checksums.openssl io
-io.directories io.encodings.ascii io.files io.files.temp
-io.launcher kernel make namespaces sequences system ;
+USING: bootstrap.image checksums checksums.openssl fry io
+io.directories io.encodings.ascii io.encodings.utf8 io.files
+io.files.temp io.files.unique io.launcher io.pathnames kernel
+make math.parser namespaces sequences splitting system ;
 IN: bootstrap.image.upload
 
 SYMBOL: upload-images-destination
+SYMBOL: build-images-destination
 
-: destination ( -- dest )
+: latest-destination ( -- dest )
     upload-images-destination get
     "slava_pestov@downloads.factorcode.org:downloads.factorcode.org/images/latest/"
     or ;
 
-: checksums ( -- temp )
-    "checksums.txt" temp-file ;
+: build-destination ( -- dest )
+    build-images-destination get
+    "slava_pestov@downloads.factorcode.org:downloads.factorcode.org/images/build/"
+    or ;
+
+: checksums-path ( -- temp ) "checksums.txt" temp-file ;
 
 : boot-image-names ( -- seq )
     images [ boot-image-name ] map ;
 
 : compute-checksums ( -- )
-    checksums ascii [
+    checksums-path ascii [
         boot-image-names [
             [ write bl ]
             [ openssl-md5 checksum-file hex-string print ]
@@ -40,14 +47,51 @@ M: windows scp-name "pscp" ;
     [
         \ scp-name get-global scp-name or ,
         boot-image-names %
-        checksums , destination ,
+        checksums-path , latest-destination ,
     ] { } make try-process ;
 
-: new-images ( -- )
+: append-build ( path -- path' )
+    build number>string "." glue ;
+
+: checksum-lines-append-build ( -- )
+    "checksums.txt" utf8 [
+        [ " " split1 [ append-build ] dip " " glue ] map
+    ] change-file-lines ;
+
+: with-build-images ( quot -- )
+    '[
+        ! Copy boot images
+        boot-image-names current-temporary-directory get copy-files-into
+        ! Copy checksums
+        checksums-path current-temporary-directory get copy-file-into
+        current-temporary-directory get [
+            ! Rewrite checksum lines with build number
+            checksum-lines-append-build
+            ! Rename file to file.build-number
+            current-directory get directory-files [ dup append-build move-file ] each
+            ! Run the quot in the current-directory, which is the unique directory
+            @
+        ] with-directory
+    ] cleanup-unique-directory ; inline
+
+: upload-build-images ( -- )
+    [
+        [
+            \ scp-name get-global scp-name or ,
+            current-directory get directory-files %
+            build-destination ,
+        ] { } make try-process
+    ] with-build-images ;
+
+: upload-new-images ( -- )
     [
         make-images
+        "Computing checksums..." print flush
         compute-checksums
+        "Uploading images..." print flush
         upload-images
+        "Uploading build images..." print flush
+        upload-build-images
     ] with-resource-directory ;
 
-MAIN: new-images
+MAIN: upload-new-images