steve
/
factor
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

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

modern-harvey2
Doug Coleman 2017-08-31 21:06:17 -05:00
parent a372224e9b
commit 081b642dee
2 changed files with 32 additions and 6 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

25
basis/bootstrap/image/upload/upload.factor
View File

@ -1,8 +1,8 @@
! Copyright (C) 2008 Slava Pestov. ! Copyright (C) 2008 Slava Pestov.
! Copyright (C) 2015 Doug Coleman. ! Copyright (C) 2015 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image checksums checksums.openssl fry io USING: bootstrap.image checksums checksums.openssl cli.git fry
io.directories io.encodings.ascii io.encodings.utf8 io.files io io.directories io.encodings.ascii io.encodings.utf8 io.files
io.files.temp io.files.unique io.launcher io.pathnames kernel io.files.temp io.files.unique io.launcher io.pathnames kernel
make math.parser namespaces sequences splitting system ; make math.parser namespaces sequences splitting system ;
IN: bootstrap.image.upload IN: bootstrap.image.upload
@ -20,6 +20,15 @@ SYMBOL: build-images-destination
"slava_pestov@downloads.factorcode.org:downloads.factorcode.org/images/build/" "slava_pestov@downloads.factorcode.org:downloads.factorcode.org/images/build/"
or ; 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 ; : checksums-path ( -- temp ) "checksums.txt" temp-file ;
: boot-image-names ( -- seq ) : boot-image-names ( -- seq )
@ -47,7 +56,8 @@ M: windows scp-name "pscp" ;
[ [
\ scp-name get-global scp-name or , \ scp-name get-global scp-name or ,
boot-image-names % boot-image-names %
checksums-path , latest-destination , checksums-path ,
git-branch-destination [ print flush ] [ , ] bi
] { } make try-process ; ] { } make try-process ;
: append-build ( path -- path' ) : append-build ( path -- path' )
@ -84,11 +94,20 @@ M: windows scp-name "pscp" ;
] { } make try-process ] { } make try-process
] with-build-images ; ] 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 ( -- ) : upload-new-images ( -- )
[ [
make-images make-images
"Computing checksums..." print flush "Computing checksums..." print flush
compute-checksums compute-checksums
"Creating remote directory..." print flush
create-remote-upload-directory
"Uploading images..." print flush "Uploading images..." print flush
upload-images upload-images
"Uploading build images..." print flush "Uploading build images..." print flush

13
extra/cli/git/git.factor
View File

@ -1,12 +1,13 @@
! Copyright (C) 2017 Doug Coleman. ! Copyright (C) 2017 Doug Coleman.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: arrays concurrency.combinators concurrency.semaphores fry USING: arrays concurrency.combinators concurrency.semaphores fry
io.directories io.files.info io.launcher io.pathnames kernel io io.directories io.encodings.utf8 io.files.info io.launcher
math namespaces sequences splitting system-info.linux ; io.pathnames kernel math namespaces sequences splitting
system-info unicode ;
IN: cli.git IN: cli.git
SYMBOL: cli-git-num-parallel 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-as ( ssh-url path -- process )
[ { "git" "clone" } ] 2dip 2array append run-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 ".git" append-path current-directory get prepend-path
?file-info dup [ directory? ] when ; ?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' ) : repository-url>name ( string -- string' )
file-name ".git" ?tail drop ; file-name ".git" ?tail drop ;