bootstrap.image.upload: Upload images per-branch.

diff --git a/basis/bootstrap/image/upload/upload.factor b/basis/bootstrap/image/upload/upload.factor
index 080bc31fa9d56eb2d0a797d6e17faa627e812ce9..832d2e4a26808846bd44d3079c8725492316bedd 100644 (file)
--- a/basis/bootstrap/image/upload/upload.factor
+++ b/basis/bootstrap/image/upload/upload.factor
@@ -1,8 +1,8 @@
 ! 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 fry io
-io.directories io.encodings.ascii io.encodings.utf8 io.files
+USING: bootstrap.image checksums checksums.openssl cli.git 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
@@ -20,6 +20,15 @@ SYMBOL: build-images-destination
     "slava_pestov@downloads.factorcode.org:downloads.factorcode.org/images/build/"
     or ;
 
+: factor-git-branch ( -- name )
+    image-path parent-directory git-current-branch ;
+
+: git-branch-destination ( -- dest )
+    build-images-destination get
+    "slava_pestov@downloads.factorcode.org:downloads.factorcode.org/images/"
+    or
+    factor-git-branch "/" 3append ;
+
 : checksums-path ( -- temp ) "checksums.txt" temp-file ;
 
 : boot-image-names ( -- seq )
@@ -47,7 +56,8 @@ M: windows scp-name "pscp" ;
     [
         \ scp-name get-global scp-name or ,
         boot-image-names %
-        checksums-path , latest-destination ,
+        checksums-path ,
+        git-branch-destination [ print flush ] [ , ] bi
     ] { } make try-process ;
 
 : append-build ( path -- path' )
@@ -84,11 +94,20 @@ M: windows scp-name "pscp" ;
         ] { } make try-process
     ] with-build-images ;
 
+: create-remote-upload-directory ( -- )
+    '[
+        "ssh" ,
+        "slava_pestov@downloads.factorcode.org" ,
+        "mkdir -p downloads.factorcode.org/images/" factor-git-branch append ,
+    ] { } make try-process ;
+
 : upload-new-images ( -- )
     [
         make-images
         "Computing checksums..." print flush
         compute-checksums
+        "Creating remote directory..." print flush
+        create-remote-upload-directory
         "Uploading images..." print flush
         upload-images
         "Uploading build images..." print flush

diff --git a/extra/cli/git/git.factor b/extra/cli/git/git.factor
index 7b4585d726a373b7d4b81987e7fd327d91a8c835..ce9bbcc7b01b1039c9236f4468b1a5936d30fc4f 100644 (file)
--- a/extra/cli/git/git.factor
+++ b/extra/cli/git/git.factor
@@ -1,12 +1,13 @@
 ! Copyright (C) 2017 Doug Coleman.
 ! See http://factorcode.org/license.txt for BSD license.
 USING: arrays concurrency.combinators concurrency.semaphores fry
-io.directories io.files.info io.launcher io.pathnames kernel
-math namespaces sequences splitting system-info.linux ;
+io io.directories io.encodings.utf8 io.files.info io.launcher
+io.pathnames kernel math namespaces sequences splitting
+system-info unicode ;
 IN: cli.git
 
 SYMBOL: cli-git-num-parallel
-cli-git-num-parallel [ hyperthreads 2 * ] initialize
+cli-git-num-parallel [ cpus 2 * ] initialize
 
 : git-clone-as ( ssh-url path -- process )
     [ { "git" "clone" } ] 2dip 2array append run-process ;
@@ -21,6 +22,12 @@ cli-git-num-parallel [ hyperthreads 2 * ] initialize
     ".git" append-path current-directory get prepend-path
     ?file-info dup [ directory? ] when ;
 
+: git-current-branch ( directory -- name )
+    [
+        { "git" "rev-parse" "--abbrev-ref" "HEAD" }
+        utf8 <process-reader> stream-contents
+    ] with-directory [ blank? ] trim-tail ;
+
 : repository-url>name ( string -- string' )
     file-name ".git" ?tail drop ;