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

mason: add support for forcing a build across the farm by reading a counter value from the server

db4
Slava Pestov 2010-09-04 18:00:33 -07:00
parent 67a828f0f7
commit 2cba7fd727
2 changed files with 22 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

2
extra/mason/mason.factor
View File

@ -73,7 +73,7 @@ SYMBOL: next-email-time
[ [
builds/factor [ builds/factor [
check-disk-space check-disk-space
update-code update-sources
build? [ build ] [ 5 minutes sleep ] if build? [ build ] [ 5 minutes sleep ] if
] with-directory ] with-directory
] [ ] [

45
extra/mason/updates/updates.factor
View File

@ -1,17 +1,19 @@
! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov. ! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license. ! See http://factorcode.org/license.txt for BSD license.
USING: bootstrap.image.download init io.directories io.launcher USING: bootstrap.image.download http.client init io.directories
kernel namespaces mason.common mason.platform ; io.launcher kernel math.parser namespaces mason.config
mason.common mason.platform ;
IN: mason.updates IN: mason.updates
SYMBOLS: latest-git-id latest-boot-image ; TUPLE: sources git-id boot-image counter ;
SYMBOLS: last-git-id last-boot-image ;
C: <sources> sources
SYMBOLS: latest-sources last-built-sources ;
[ [
f latest-git-id set-global f latest-sources set-global
f latest-boot-image set-global f last-built-sources set-global
f last-git-id set-global
f last-boot-image set-global
] "mason.updates" add-startup-hook ] "mason.updates" add-startup-hook
: git-pull-cmd ( -- cmd ) : git-pull-cmd ( -- cmd )
@ -23,31 +25,26 @@ SYMBOLS: last-git-id last-boot-image ;
"master" "master"
} ; } ;
: update-source ( -- ) : latest-git-id ( -- git-id )
git-pull-cmd short-running-process git-pull-cmd short-running-process
git-id latest-git-id set-global ; git-id ;
: update-boot-image ( -- ) : latest-boot-image ( -- boot-image )
boot-image-name boot-image-name
[ maybe-download-image drop ] [ maybe-download-image drop ] [ file-checksum ] bi ;
[ file-checksum latest-boot-image set-global ] bi ;
: update-code ( -- ) : latest-counter ( -- counter )
update-source counter-url http-get nip string>number ;
update-boot-image ;
: new-source-available? ( -- ? ) : update-sources ( -- )
last-git-id get-global latest-git-id get-global = not ; latest-git-id latest-boot-image latest-counter <sources>
latest-sources set-global ;
: new-image-available? ( -- ? )
last-boot-image get-global latest-boot-image get-global = not ;
: build? ( -- ? ) : build? ( -- ? )
new-source-available? new-image-available? or ; latest-sources get-global last-built-sources get-global = not ;
: finish-build ( -- ) : finish-build ( -- )
#! If the build completed (successfully or not) without #! If the build completed (successfully or not) without
#! mason crashing or being killed, don't build this git ID #! mason crashing or being killed, don't build this git ID
#! and boot image hash again. #! and boot image hash again.
latest-git-id get-global last-git-id set-global latest-sources get-global last-built-sources set-global ;
latest-boot-image get-global last-boot-image set-global ;