mason: when checking if we need to build, compare source for last finished (clean/dirty/error) build with the latest source hashes, instead of the last *downloaded* source hashes. This ensures that if a build is terminated due to machine failure, we start building again next time

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?
-    [
+    [ [ file-checksum ] [ download-checksum ] bi = not ]
-        [ md5 checksum-file hex-string ]
+    [ drop t ]
-        [ download-checksums at ]
+    if ;
-        bi = not
-    ] [ drop t ] if ;
 
 : verify-image ( image -- )
     need-new-image? [ "Boot image corrupt" throw ] when ;

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
+io.files io.launcher io.pathnames namespaces prettyprint
-mason.cleanup mason.common mason.help mason.release mason.report
+combinators mason.child mason.cleanup mason.common mason.help
-mason.email mason.notify ;
+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

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 ] }

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

extra/mason/mason.factor

@@ -71,13 +71,15 @@ SYMBOL: next-email-time
     ?prepare-build-machine
     notify-heartbeat
     [
-        builds/factor set-current-directory
+        builds/factor [
-        check-disk-space
+            check-disk-space
-        new-code-available? [ build ] when
+            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

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
+USING: bootstrap.image.download init io.directories io.launcher
-kernel mason.common mason.platform ;
+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? ( -- ? )
+: update-source ( -- )
-    git-id
     git-pull-cmd short-running-process
-    git-id
+    git-id latest-git-id set-global ;
-    = not ;
+
+: 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? ( -- ? )
+: build? ( -- ? )
-    updates-available? new-image-available? or ;
+    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 ;