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

Some mason improvements: 

- Rename config variables to be more intuitive, split up upload-to-factorcode? into several variables
- Add target-variant variable. This allows running multiple masons on the same architecture but with different parameters, for example bootstrapping with SSE disabled, or simply for testing on a different OS release.
- Added a boot-flags variable for use with the above
Slava Pestov 2011-09-09 19:13:06 -07:00
parent 5f13058fc5
commit 7b04c8a6fa
10 changed files with 92 additions and 54 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

13
extra/mason/child/child.factor
View File

@ -1,10 +1,10 @@
! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
! Copyright (C) 2008, 2011 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors arrays calendar combinators.short-circuit fry
continuations debugger io.directories io.files io.launcher
io.pathnames io.encodings.ascii kernel make mason.common mason.config
mason.platform mason.report mason.notify namespaces sequences
quotations macros system combinators splitting ;
io.pathnames io.encodings.ascii kernel make mason.common
mason.config mason.platform mason.report mason.notify namespaces
sequences quotations macros system combinators splitting ;
IN: mason.child
: nmake-cmd ( -- args )
@ -12,7 +12,9 @@ IN: mason.child
target-cpu get name>> "." split "-" join suffix ;
: gnu-make-cmd ( -- args )
gnu-make platform 2array ;
gnu-make
target-os get name>> target-cpu get name>> (platform)
2array ;
: make-cmd ( -- args )
{
@ -37,6 +39,7 @@ IN: mason.child
factor-vm ,
"-i=" boot-image-name append ,
"-no-user-init" ,
boot-flags get %
] { } make ;
: boot ( -- )

35
extra/mason/config/config.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
! Copyright (C) 2008, 2011 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: calendar system io.files io.pathnames namespaces kernel
accessors assocs ;
@ -27,6 +27,12 @@ SYMBOL: target-os
target-os get-global [ os target-os set-global ] unless
! (Optional) Architecture variant suffix.
SYMBOL: target-variant
! (Optional) Additional bootstrap flags.
SYMBOL: boot-flags
! Keep test-log around?
SYMBOL: builder-debug
@ -61,10 +67,22 @@ SYMBOL: docs-update-url
docs-update-url [ "http://builds.factorcode.org/docs-update" ] initialize
! Boolean. Do we release binaries and update the clean branch?
SYMBOL: upload-to-factorcode?
! Boolean. Do we upload package binaries?
SYMBOL: upload-package?
! The below are only needed if upload-to-factorcode? is true.
! Host to upload binary package to.
SYMBOL: package-host
! Username to log in.
SYMBOL: package-username
! Directory with binary packages.
SYMBOL: package-directory
! Boolean. Do we update the clean branch?
SYMBOL: update-clean-branch?
! The below are only needed if update-clean-branch? is true.
! Host with clean git repo.
SYMBOL: branch-host
@ -84,15 +102,6 @@ SYMBOL: image-username
! Directory with clean images.
SYMBOL: image-directory
! Host to upload binary package to.
SYMBOL: upload-host
! Username to log in.
SYMBOL: upload-username
! Directory with binary packages.
SYMBOL: upload-directory
! Upload timeout
SYMBOL: upload-timeout
1 hours upload-timeout set-global

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

@ -1,28 +1,37 @@
! Copyright (C) 2009, 2010 Slava Pestov.
! Copyright (C) 2009, 2011 Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: accessors fry http.client io io.encodings.utf8 io.files
kernel mason.common mason.config mason.email mason.twitter
namespaces prettyprint sequences debugger continuations ;
IN: mason.notify
: status-notify? ( -- ? )
status-url get
target-variant get not and ;
: status-params ( report arg message -- assoc )
[
short-host-name "host-name" set
target-cpu get "target-cpu" set
target-os get "target-os" set
status-secret get "secret" set
[ "report" set ]
[ "arg" set ]
[ "message" set ] tri*
] H{ } make-assoc ;
: status-notify ( report arg message -- )
'[
5 [
[
short-host-name "host-name" set
target-cpu get "target-cpu" set
target-os get "target-os" set
status-secret get "secret" set
_ "report" set
_ "arg" set
_ "message" set
] H{ } make-assoc
status-url get http-post 2drop
] retry
] [
"STATUS NOTIFY FAILED:" print
error. flush
] recover ;
status-notify? [
'[
5 [
_ _ _ status-params status-url get
http-post 2drop
] retry
] [
"STATUS NOTIFY FAILED:" print
error. flush
] recover
] [ 3drop ] if ;
: notify-heartbeat ( -- )
f f "heartbeat" status-notify ;

19
extra/mason/platform/platform-tests.factor
View File

@ -1,4 +1,21 @@
USING: tools.test strings mason.platform ;
USING: mason.config mason.platform namespaces tools.test
strings system ;
IN: mason.platform.tests
[ t ] [ platform string? ] unit-test
[
linux target-os set
x86.32 target-cpu set
f target-variant set
[ "linux-x86-32" ] [ platform ] unit-test
] with-scope
[
windows target-os set
x86.32 target-cpu set
"xp" target-variant set
[ "windows-x86-32-xp" ] [ platform ] unit-test
] with-scope

5
extra/mason/platform/platform.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! Copyright (C) 2008, 2011 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel system accessors namespaces splitting sequences
mason.config bootstrap.image assocs ;
@ -8,7 +8,8 @@ IN: mason.platform
{ { CHAR: . CHAR: - } } substitute "-" glue ;
: platform ( -- string )
target-os get name>> target-cpu get name>> (platform) ;
target-os get name>> target-cpu get name>> (platform)
target-variant get [ "-" glue ] when* ;
: gnu-make ( -- string )
target-os get { freebsd openbsd netbsd } member? "gmake" "make" ? ;

13
extra/mason/release/branch/branch.factor
View File

@ -38,11 +38,10 @@ IN: mason.release.branch
: upload-clean-image ( -- )
5 [ upload-clean-image-cmd short-running-process ] retry ;
: (update-clean-branch) ( -- )
"factor" [
push-to-clean-branch
upload-clean-image
] with-directory ;
: update-clean-branch ( -- )
upload-to-factorcode? get [ (update-clean-branch) ] when ;
update-clean-branch? get [
"factor" [
push-to-clean-branch
upload-clean-image
] with-directory
] when ;

10
extra/mason/release/upload/upload.factor
View File

@ -1,4 +1,4 @@
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
! Copyright (C) 2008, 2011 Eduardo Cavazos, Slava Pestov.
! See http://factorcode.org/license.txt for BSD license.
USING: kernel namespaces make sequences arrays io io.files
io.launcher mason.common mason.platform
@ -6,15 +6,15 @@ mason.release.archive mason.config ;
IN: mason.release.upload
: remote-location ( -- dest )
upload-directory get "/" platform 3append ;
package-directory get "/" platform 3append ;
: remote-archive-name ( archive-name -- dest )
[ remote-location "/" ] dip 3append ;
: upload ( archive-name -- )
upload-to-factorcode? get [
upload-username get
upload-host get
upload-package? get [
package-username get
package-host get
pick remote-archive-name
upload-safely
] [ drop ] if ;

2
extra/webapps/mason/version/common/common.factor
View File

@ -5,7 +5,7 @@ kernel make mason.config namespaces ;
IN: webapps.mason.version.common
: execute-on-server ( string -- )
[ "ssh" , upload-host get , "-l" , upload-username get , ] { } make
[ "ssh" , package-host get , "-l" , package-username get , ] { } make
<process>
swap >>command
5 minutes >>timeout

2
extra/webapps/mason/version/files/files.factor
View File

@ -8,7 +8,7 @@ IN: webapps.mason.version.files
[ "releases/" % % "/" % % ] "" make ;
: remote-directory ( string -- string' )
[ upload-directory get ] dip "/" glue ;
[ package-directory get ] dip "/" glue ;
SLOT: os
SLOT: cpu

2
extra/webapps/mason/version/source/source.factor
View File

@ -44,7 +44,7 @@ IN: webapps.mason.version.source
: upload-source-release ( package version -- )
"Uploading source release..." print flush
[ upload-username get upload-host get ] dip
[ package-username get package-host get ] dip
remote-source-release-name
upload-safely ;