diff --git a/extra/mason/build/build.factor b/extra/mason/build/build.factor index 5031b5d930..a9e32e5315 100644 --- a/extra/mason/build/build.factor +++ b/extra/mason/build/build.factor @@ -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 diff --git a/extra/mason/cleanup/cleanup.factor b/extra/mason/cleanup/cleanup.factor index 3e6209fed0..fb8e2e893a 100755 --- a/extra/mason/cleanup/cleanup.factor +++ b/extra/mason/cleanup/cleanup.factor @@ -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 ; diff --git a/extra/mason/common/common.factor b/extra/mason/common/common.factor index a743c3fe9a..bc1b182734 100755 --- a/extra/mason/common/common.factor +++ b/extra/mason/common/common.factor @@ -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. - - swap >>command - 15 minutes >>timeout - +closed+ >>stdin - try-output-process ; - : retry ( n quot -- ) '[ drop @ f ] attempt-all drop ; inline diff --git a/extra/mason/help/help.factor b/extra/mason/help/help.factor index 9ed9653a08..6b44e49c61 100644 --- a/extra/mason/help/help.factor +++ b/extra/mason/help/help.factor @@ -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 ( -- ) diff --git a/extra/mason/notify/notify.factor b/extra/mason/notify/notify.factor index 6c643d64d5..30da0c8286 100644 --- a/extra/mason/notify/notify.factor +++ b/extra/mason/notify/notify.factor @@ -18,7 +18,7 @@ IN: mason.notify _ [ +closed+ ] unless* >>stdin _ >>command - try-output-process + short-running-process ] retry ] [ 2drop ] if ; diff --git a/extra/mason/release/archive/archive.factor b/extra/mason/release/archive/archive.factor index 79d6993a91..51534edccd 100755 --- a/extra/mason/release/archive/archive.factor +++ b/extra/mason/release/archive/archive.factor @@ -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 {