diff --git a/basis/bootstrap/image/download/download.factor b/basis/bootstrap/image/download/download.factor index 3a1abb3b2d..eeaccd9347 100644 --- a/basis/bootstrap/image/download/download.factor +++ b/basis/bootstrap/image/download/download.factor @@ -10,13 +10,17 @@ CONSTANT: url URL" http://factorcode.org/images/latest/" url "checksums.txt" >url derive-url http-get nip string-lines [ " " split1 ] { } map>assoc ; +: file-checksum ( image -- checksum ) + md5 checksum-file hex-string ; + +: download-checksum ( image -- checksum ) + download-checksums at ; + : need-new-image? ( image -- ? ) dup exists? - [ - [ md5 checksum-file hex-string ] - [ download-checksums at ] - bi = not - ] [ drop t ] if ; + [ [ file-checksum ] [ download-checksum ] bi = not ] + [ drop t ] + if ; : verify-image ( image -- ) need-new-image? [ "Boot image corrupt" throw ] when ; diff --git a/extra/mason/build/build.factor b/extra/mason/build/build.factor index f2018449fc..9a24be1f18 100644 --- a/extra/mason/build/build.factor +++ b/extra/mason/build/build.factor @@ -1,9 +1,10 @@ -! Copyright (C) 2008, 2009 Eduardo Cavazos, Slava Pestov. +! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: arrays kernel calendar io.directories io.encodings.utf8 -io.files io.launcher namespaces prettyprint combinators mason.child -mason.cleanup mason.common mason.help mason.release mason.report -mason.email mason.notify ; +io.files io.launcher io.pathnames namespaces prettyprint +combinators mason.child mason.cleanup mason.common mason.help +mason.release mason.report mason.email mason.notify +mason.platform mason.updates ; QUALIFIED: continuations IN: mason.build @@ -11,12 +12,17 @@ IN: mason.build now datestamp stamp set build-dir make-directory ; -: enter-build-dir ( -- ) build-dir set-current-directory ; +: enter-build-dir ( -- ) + build-dir set-current-directory ; -: clone-builds-factor ( -- ) +: clone-source ( -- ) "git" "clone" builds/factor 3array short-running-process ; -: begin-build ( -- ) +: copy-image ( -- ) + builds/factor boot-image-name append-path + [ "." copy-file-into ] [ "factor" copy-file-into ] bi ; + +: save-git-id ( -- ) "factor" [ git-id ] with-directory { [ "git-id" to-file ] [ "factor/git-id" to-file ] @@ -24,15 +30,20 @@ IN: mason.build [ notify-begin-build ] } cleave ; +: begin-build ( -- ) + clone-source + copy-image + save-git-id ; + : build ( -- ) create-build-dir enter-build-dir - clone-builds-factor [ begin-build build-child [ notify-report ] [ status-clean eq? [ upload-help release ] when ] bi + finish-build ] [ cleanup ] [ ] continuations:cleanup ; MAIN: build diff --git a/extra/mason/child/child.factor b/extra/mason/child/child.factor index d9821f8fcc..66e6eb3722 100644 --- a/extra/mason/child/child.factor +++ b/extra/mason/child/child.factor @@ -29,13 +29,6 @@ IN: mason.child try-process ] with-directory ; -: builds-factor-image ( -- img ) - builds/factor boot-image-name append-path ; - -: copy-image ( -- ) - builds-factor-image "." copy-file-into - builds-factor-image "factor" copy-file-into ; - : factor-vm ( -- string ) target-os get "winnt" = "./factor.com" "./factor" ? ; @@ -81,7 +74,6 @@ MACRO: recover-cond ( alist -- ) ] if ; : build-child ( -- status ) - copy-image { { [ notify-make-vm make-vm ] [ compile-failed ] } { [ notify-boot boot ] [ boot-failed ] } diff --git a/extra/mason/common/common.factor b/extra/mason/common/common.factor index db68a558e0..05c0ac87bb 100644 --- a/extra/mason/common/common.factor +++ b/extra/mason/common/common.factor @@ -1,4 +1,4 @@ -! Copyright (C) 2008, 2009 Eduardo Cavazos, Slava Pestov. +! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel namespaces sequences splitting system accessors math.functions make io io.files io.pathnames io.directories @@ -20,16 +20,19 @@ SYMBOL: current-git-id #! 30 minutes to complete, to catch hangs. >process 30 minutes >>timeout try-output-process ; -HOOK: really-delete-tree os ( path -- ) +HOOK: (really-delete-tree) os ( path -- ) -M: windows really-delete-tree +M: windows (really-delete-tree) #! Workaround: Cygwin GIT creates read-only files for #! some reason. [ { "chmod" "ug+rw" "-R" } swap absolute-path suffix short-running-process ] [ delete-tree ] bi ; -M: unix really-delete-tree delete-tree ; +M: unix (really-delete-tree) delete-tree ; + +: really-delete-tree ( path -- ) + dup exists? [ (really-delete-tree) ] [ drop ] if ; : retry ( n quot -- ) [ iota ] dip diff --git a/extra/mason/mason.factor b/extra/mason/mason.factor index 9ba0640ef7..046cd2c525 100755 --- a/extra/mason/mason.factor +++ b/extra/mason/mason.factor @@ -71,13 +71,15 @@ SYMBOL: next-email-time ?prepare-build-machine notify-heartbeat [ - builds/factor set-current-directory - check-disk-space - new-code-available? [ build ] when + builds/factor [ + check-disk-space + update-code + build? [ build ] [ 5 minutes sleep ] if + ] with-directory ] [ build-loop-error + 5 minutes sleep ] recover - 5 minutes sleep build-loop ; MAIN: build-loop \ No newline at end of file diff --git a/extra/mason/updates/updates.factor b/extra/mason/updates/updates.factor index 4221bd4376..86ecab9ee3 100644 --- a/extra/mason/updates/updates.factor +++ b/extra/mason/updates/updates.factor @@ -1,9 +1,19 @@ ! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: bootstrap.image.download io.directories io.launcher -kernel mason.common mason.platform ; +USING: bootstrap.image.download init io.directories io.launcher +kernel namespaces mason.common mason.platform ; IN: mason.updates +SYMBOLS: latest-git-id latest-boot-image ; +SYMBOLS: last-git-id last-boot-image ; + +[ + f latest-git-id set-global + f latest-boot-image set-global + f last-git-id set-global + f last-boot-image set-global +] "mason.updates" add-startup-hook + : git-pull-cmd ( -- cmd ) { "git" @@ -13,14 +23,31 @@ IN: mason.updates "master" } ; -: updates-available? ( -- ? ) - git-id +: update-source ( -- ) git-pull-cmd short-running-process - git-id - = not ; + git-id latest-git-id set-global ; + +: update-boot-image ( -- ) + boot-image-name + [ maybe-download-image drop ] + [ file-checksum latest-boot-image set-global ] bi ; + +: update-code ( -- ) + update-source + update-boot-image ; + +: new-source-available? ( -- ? ) + last-git-id get-global latest-git-id get-global = not ; : new-image-available? ( -- ? ) - boot-image-name maybe-download-image ; + last-boot-image get-global latest-boot-image get-global = not ; -: new-code-available? ( -- ? ) - updates-available? new-image-available? or ; +: build? ( -- ? ) + new-source-available? new-image-available? or ; + +: finish-build ( -- ) + #! If the build completed (successfully or not) without + #! mason crashing or being killed, don't build this git ID + #! and boot image hash again. + latest-git-id get-global last-git-id set-global + latest-boot-image get-global last-boot-image set-global ;