mason: add timeouts in more places, clean up .dmg creation code
parent
5eb3d8e8bd
commit
9e130a5153
|
@ -15,7 +15,7 @@ QUALIFIED: continuations
|
|||
: enter-build-dir ( -- ) build-dir set-current-directory ;
|
||||
|
||||
: clone-builds-factor ( -- )
|
||||
"git" "clone" builds/factor 3array try-output-process ;
|
||||
"git" "clone" builds/factor 3array short-running-process ;
|
||||
|
||||
: begin-build ( -- )
|
||||
"factor" [ git-id ] with-directory
|
||||
|
|
|
@ -6,7 +6,7 @@ mason.common mason.config mason.platform namespaces ;
|
|||
IN: mason.cleanup
|
||||
|
||||
: compress ( filename -- )
|
||||
dup exists? [ "bzip2" swap 2array try-output-process ] [ drop ] if ;
|
||||
dup exists? [ "bzip2" swap 2array short-running-process ] [ drop ] if ;
|
||||
|
||||
: compress-image ( -- )
|
||||
boot-image-name compress ;
|
||||
|
|
|
@ -10,25 +10,25 @@ IN: mason.common
|
|||
|
||||
SYMBOL: current-git-id
|
||||
|
||||
: short-running-process ( command -- )
|
||||
#! Give network operations and shell commands at most
|
||||
#! 15 minutes to complete, to catch hangs.
|
||||
>process
|
||||
15 minutes >>timeout
|
||||
+closed+ >>stdin
|
||||
try-output-process ;
|
||||
|
||||
HOOK: really-delete-tree os ( path -- )
|
||||
|
||||
M: windows really-delete-tree
|
||||
#! Workaround: Cygwin GIT creates read-only files for
|
||||
#! some reason.
|
||||
[ { "chmod" "ug+rw" "-R" } swap (normalize-path) suffix try-output-process ]
|
||||
[ { "chmod" "ug+rw" "-R" } swap (normalize-path) suffix short-running-process ]
|
||||
[ delete-tree ]
|
||||
bi ;
|
||||
|
||||
M: unix really-delete-tree delete-tree ;
|
||||
|
||||
: short-running-process ( command -- )
|
||||
#! Give network operations at most 15 minutes to complete.
|
||||
<process>
|
||||
swap >>command
|
||||
15 minutes >>timeout
|
||||
+closed+ >>stdin
|
||||
try-output-process ;
|
||||
|
||||
: retry ( n quot -- )
|
||||
'[ drop @ f ] attempt-all drop ; inline
|
||||
|
||||
|
|
|
@ -6,7 +6,7 @@ IN: mason.help
|
|||
|
||||
: make-help-archive ( -- )
|
||||
"factor/temp" [
|
||||
{ "tar" "cfz" "docs.tar.gz" "docs" } try-output-process
|
||||
{ "tar" "cfz" "docs.tar.gz" "docs" } short-running-process
|
||||
] with-directory ;
|
||||
|
||||
: upload-help-archive ( -- )
|
||||
|
|
|
@ -18,7 +18,7 @@ IN: mason.notify
|
|||
<process>
|
||||
_ [ +closed+ ] unless* >>stdin
|
||||
_ >>command
|
||||
try-output-process
|
||||
short-running-process
|
||||
] retry
|
||||
] [ 2drop ] if ;
|
||||
|
||||
|
|
|
@ -1,6 +1,6 @@
|
|||
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays combinators io.directories
|
||||
USING: arrays combinators locals io.directories
|
||||
io.directories.hierarchy io.files io.launcher io.pathnames
|
||||
kernel make mason.common mason.config mason.platform namespaces
|
||||
prettyprint sequences ;
|
||||
|
@ -18,21 +18,20 @@ IN: mason.release.archive
|
|||
|
||||
: archive-name ( -- string ) base-name extension append ;
|
||||
|
||||
: make-windows-archive ( archive-name -- )
|
||||
[ "zip" , "-r" , , "factor" , ] { } make try-output-process ;
|
||||
:: make-windows-archive ( archive-name -- )
|
||||
{ "zip" "-r" archive-name "factor" } short-running-process ;
|
||||
|
||||
:: make-disk-image ( archive-name volume-name dmg-root -- )
|
||||
{ "hdiutil" "create" "-srcfolder" dmg-root "-fs" "HFS+" "-volname" volume-name archive-name } short-running-process ;
|
||||
|
||||
: make-macosx-archive ( archive-name -- )
|
||||
{ "mkdir" "dmg-root" } try-output-process
|
||||
{ "cp" "-R" "factor" "dmg-root" } try-output-process
|
||||
{ "hdiutil" "create"
|
||||
"-srcfolder" "dmg-root"
|
||||
"-fs" "HFS+"
|
||||
"-volname" "factor" }
|
||||
swap suffix try-output-process
|
||||
"dmg-root" make-directory
|
||||
"factor" "dmg-root" copy-tree-into
|
||||
"factor" "dmg-root" make-disk-image
|
||||
"dmg-root" really-delete-tree ;
|
||||
|
||||
: make-unix-archive ( archive-name -- )
|
||||
[ "tar" , "-cvzf" , , "factor" , ] { } make try-output-process ;
|
||||
:: make-unix-archive ( archive-name -- )
|
||||
{ "tar" "-cvzf" archive-name "factor" } short-running-process ;
|
||||
|
||||
: make-archive ( archive-name -- )
|
||||
target-os get {
|
||||
|
|
Loading…
Reference in New Issue