diff --git a/basis/bootstrap/image/upload/upload.factor b/basis/bootstrap/image/upload/upload.factor index 080bc31fa9..832d2e4a26 100644 --- 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 7b4585d726..ce9bbcc7b0 100644 --- 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 stream-contents + ] with-directory [ blank? ] trim-tail ; + : repository-url>name ( string -- string' ) file-name ".git" ?tail drop ;