mason: big overhaul
- add heartbeats for eventual notification of when build machines go down - mason.version: replaces mason.release, builds source package automatically, and tweets when new versions released - webapps.mason: new downloads action includes automatically-generated source download and release announcement linksrelease
parent
956ffa8946
commit
89560ee4d9
|
@ -6,6 +6,6 @@ USING: mason.email mason.common mason.config namespaces tools.test ;
|
|||
"linux" target-os set
|
||||
"x86.64" target-cpu set
|
||||
"12345" current-git-id set
|
||||
status-error subject prefix-subject
|
||||
status-error report-subject
|
||||
] with-scope
|
||||
] unit-test
|
||||
|
|
|
@ -1,35 +1,42 @@
|
|||
! 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 accessors combinators make smtp debugger
|
||||
prettyprint sequences io io.streams.string io.encodings.utf8 io.files
|
||||
io.sockets mason.common mason.platform mason.config ;
|
||||
IN: mason.email
|
||||
|
||||
: prefix-subject ( str -- str' )
|
||||
[ "mason on " % platform % ": " % % ] "" make ;
|
||||
|
||||
: email-status ( body content-type subject -- )
|
||||
: mason-email ( body content-type subject -- )
|
||||
<email>
|
||||
builder-from get >>from
|
||||
builder-recipients get >>to
|
||||
swap prefix-subject >>subject
|
||||
swap >>subject
|
||||
swap >>content-type
|
||||
swap >>body
|
||||
send-email ;
|
||||
|
||||
: subject ( status -- str )
|
||||
[ current-git-id get 7 short head " -- " ] dip {
|
||||
: subject-prefix ( -- string )
|
||||
"mason on " platform ": " 3append ;
|
||||
|
||||
: report-subject ( status -- string )
|
||||
[
|
||||
subject-prefix %
|
||||
current-git-id get 7 short head %
|
||||
" -- " %
|
||||
{
|
||||
{ status-clean [ "clean" ] }
|
||||
{ status-dirty [ "dirty" ] }
|
||||
{ status-error [ "error" ] }
|
||||
} case 3append ;
|
||||
} case %
|
||||
] "" make ;
|
||||
|
||||
: email-report ( report status -- )
|
||||
[ "text/html" ] dip subject email-status ;
|
||||
[ "text/html" ] dip report-subject mason-email ;
|
||||
|
||||
: email-error ( error callstack -- )
|
||||
[
|
||||
"Fatal error on " write host-name print nl
|
||||
[ error. ] [ callstack. ] bi*
|
||||
] with-string-writer "text/plain" "fatal error"
|
||||
email-status ;
|
||||
] with-string-writer
|
||||
"text/plain"
|
||||
subject-prefix "fatal error" append
|
||||
mason-email ;
|
||||
|
|
|
@ -1,8 +1,8 @@
|
|||
! Copyright (C) 2008 Eduardo Cavazos, Slava Pestov.
|
||||
! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors calendar continuations debugger io
|
||||
io.directories io.files kernel mason.common
|
||||
mason.email mason.updates namespaces threads ;
|
||||
mason.email mason.updates mason.notify namespaces threads ;
|
||||
FROM: mason.build => build ;
|
||||
IN: mason
|
||||
|
||||
|
@ -15,6 +15,7 @@ IN: mason
|
|||
error. flush ;
|
||||
|
||||
: build-loop ( -- )
|
||||
notify-heartbeat
|
||||
?prepare-build-machine
|
||||
[
|
||||
[
|
||||
|
|
|
@ -1,4 +1,4 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! Copyright (C) 2009, 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: arrays accessors io io.sockets io.encodings.utf8 io.files
|
||||
io.launcher kernel make mason.config mason.common mason.email
|
||||
|
@ -22,6 +22,9 @@ IN: mason.notify
|
|||
] retry
|
||||
] [ 2drop ] if ;
|
||||
|
||||
: notify-heartbeat ( -- )
|
||||
f { "heartbeat" } status-notify ;
|
||||
|
||||
: notify-begin-build ( git-id -- )
|
||||
[ "Starting build of GIT ID " write print flush ]
|
||||
[ f swap "git-id" swap 2array status-notify ]
|
||||
|
|
|
@ -25,6 +25,9 @@ SYMBOLS: host-name target-os target-cpu message message-arg ;
|
|||
target-cpu get >>cpu
|
||||
dup select-tuple [ ] [ dup insert-tuple ] ?if ;
|
||||
|
||||
: heartbeat ( -- )
|
||||
now >>heartbeat-timestamp ;
|
||||
|
||||
: git-id ( builder id -- )
|
||||
>>current-git-id +starting+ >>status drop ;
|
||||
|
||||
|
@ -51,6 +54,7 @@ SYMBOLS: host-name target-os target-cpu message message-arg ;
|
|||
|
||||
: update-builder ( builder -- )
|
||||
message get {
|
||||
{ "heartbeat" [ heartbeat ] }
|
||||
{ "git-id" [ message-arg get git-id ] }
|
||||
{ "make-vm" [ make-vm ] }
|
||||
{ "boot" [ boot ] }
|
||||
|
|
|
@ -1 +0,0 @@
|
|||
Slava Pestov
|
|
@ -1,82 +0,0 @@
|
|||
! Copyright (C) 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors calendar db db.tuples db.types grouping io
|
||||
io.encodings.ascii io.launcher kernel locals make
|
||||
mason.release.archive mason.config mason.platform mason.server
|
||||
namespaces sequences ;
|
||||
IN: mason.server.release
|
||||
|
||||
: platform ( builder -- string )
|
||||
[ os>> ] [ cpu>> ] bi (platform) ;
|
||||
|
||||
: package-name ( builder -- string )
|
||||
[ platform ] [ last-release>> ] bi "/" glue ;
|
||||
|
||||
: release-name ( version builder -- string )
|
||||
[
|
||||
"releases/" %
|
||||
over % "/" %
|
||||
[ "factor-" % platform % "-" % % ]
|
||||
[ os>> extension % ]
|
||||
bi
|
||||
] "" make ;
|
||||
|
||||
: release-command ( version builder -- command )
|
||||
[
|
||||
"cp " %
|
||||
[ nip package-name % " " % ] [ release-name % ] 2bi
|
||||
] "" make ;
|
||||
|
||||
TUPLE: release
|
||||
host-name os cpu
|
||||
last-release release-git-id ;
|
||||
|
||||
release "RELEASES" {
|
||||
{ "host-name" "HOST_NAME" TEXT +user-assigned-id+ }
|
||||
{ "os" "OS" TEXT +user-assigned-id+ }
|
||||
{ "cpu" "CPU" TEXT +user-assigned-id+ }
|
||||
{ "last-release" "LAST_RELEASE" TEXT }
|
||||
{ "release-git-id" "RELEASE_GIT_ID" TEXT }
|
||||
} define-persistent
|
||||
|
||||
:: <release> ( version builder -- release )
|
||||
release new
|
||||
builder host-name>> >>host-name
|
||||
builder os>> >>os
|
||||
builder cpu>> >>cpu
|
||||
builder release-git-id>> >>release-git-id
|
||||
version builder release-name >>last-release ;
|
||||
|
||||
: execute-on-server ( string -- )
|
||||
[ "ssh" , upload-host get , "-l" , upload-username get , ] { } make
|
||||
<process>
|
||||
swap >>command
|
||||
5 minutes >>timeout
|
||||
ascii [ write ] with-process-writer ;
|
||||
|
||||
: release-script ( version builders -- string )
|
||||
[ upload-directory get "cd " "\n" surround ] 2dip
|
||||
[ release-command ] with map "\n" join
|
||||
append ;
|
||||
|
||||
: create-releases ( version builders -- )
|
||||
release-script execute-on-server ;
|
||||
|
||||
: update-releases ( version builders -- )
|
||||
[
|
||||
release new delete-tuples
|
||||
[ <release> insert-tuple ] with each
|
||||
] with-transaction ;
|
||||
|
||||
: check-releases ( builders -- )
|
||||
[ release-git-id>> ] map all-equal?
|
||||
[ "Not all builders are up to date" throw ] unless ;
|
||||
|
||||
: do-release ( version -- )
|
||||
[
|
||||
builder new select-tuples
|
||||
[ nip check-releases ]
|
||||
[ create-releases ]
|
||||
[ update-releases ]
|
||||
2tri
|
||||
] with-mason-db ;
|
|
@ -17,7 +17,8 @@ clean-git-id clean-timestamp
|
|||
last-release release-git-id
|
||||
last-git-id last-timestamp last-report
|
||||
current-git-id current-timestamp
|
||||
status ;
|
||||
status
|
||||
heartbeat-timestamp ;
|
||||
|
||||
builder "BUILDERS" {
|
||||
{ "host-name" "HOST_NAME" TEXT +user-assigned-id+ }
|
||||
|
@ -38,6 +39,8 @@ builder "BUILDERS" {
|
|||
! Can't name it CURRENT_TIMESTAMP because of bug in db library
|
||||
{ "current-timestamp" "CURR_TIMESTAMP" TIMESTAMP }
|
||||
{ "status" "STATUS" TEXT }
|
||||
|
||||
{ "heartbeat-timestamp" "HEARTBEAT_TIMESTAMP" TIMESTAMP }
|
||||
} define-persistent
|
||||
|
||||
: mason-db ( -- db ) "resource:mason.db" <sqlite-db> ;
|
||||
|
|
|
@ -1 +0,0 @@
|
|||
Slava Pestov
|
|
@ -1,49 +0,0 @@
|
|||
! Copyright (C) 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: bootstrap.image bootstrap.image.download io io.directories
|
||||
io.directories.hierarchy io.files.unique io.launcher
|
||||
io.pathnames kernel sequences namespaces mason.common mason.config ;
|
||||
IN: mason.source
|
||||
|
||||
: clone-factor ( -- )
|
||||
{ "git" "clone" } home "factor" append-path suffix try-process ;
|
||||
|
||||
: save-git-id ( -- )
|
||||
git-id "git-id" to-file ;
|
||||
|
||||
: delete-git-tree ( -- )
|
||||
".git" delete-tree ;
|
||||
|
||||
: download-images ( -- )
|
||||
images [ download-image ] each ;
|
||||
|
||||
: prepare-source ( -- )
|
||||
"factor" [ save-git-id delete-git-tree download-images ] with-directory ;
|
||||
|
||||
: package-name ( version -- string )
|
||||
"factor-src-" ".zip" surround ;
|
||||
|
||||
: make-tarball ( version -- path )
|
||||
[ { "zip" "-qr9" } ] dip package-name
|
||||
[ suffix "factor" suffix try-process ] keep ;
|
||||
|
||||
: make-package ( version -- path )
|
||||
unique-directory
|
||||
[
|
||||
clone-factor prepare-source make-tarball
|
||||
"Package created: " write absolute-path dup print
|
||||
] with-directory ;
|
||||
|
||||
: remote-location ( version -- dest )
|
||||
[ upload-directory get "/releases/" ] dip 3append ;
|
||||
|
||||
: remote-archive-name ( version -- dest )
|
||||
[ remote-location ] [ package-name ] bi "/" glue ;
|
||||
|
||||
: upload-package ( package version -- )
|
||||
[ upload-username get upload-host get ] dip
|
||||
remote-archive-name
|
||||
upload-safely ;
|
||||
|
||||
: release-source-package ( version -- )
|
||||
[ make-package ] [ upload-package ] bi ;
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
|
@ -0,0 +1,20 @@
|
|||
! Copyright (C) 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: io kernel make mason.version.common mason.version.files
|
||||
sequences ;
|
||||
IN: mason.version.binary
|
||||
|
||||
: binary-release-command ( version builder -- command )
|
||||
[
|
||||
"cp " %
|
||||
[ nip binary-package-name % " " % ]
|
||||
[ remote-binary-release-name % ]
|
||||
2bi
|
||||
] "" make ;
|
||||
|
||||
: binary-release-script ( version builders -- string )
|
||||
[ binary-release-command ] with map "\n" join ;
|
||||
|
||||
: do-binary-release ( version builders -- )
|
||||
"Copying binary releases to release directory..." print flush
|
||||
binary-release-script execute-on-server ;
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
|
@ -0,0 +1,12 @@
|
|||
! Copyright (C) 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors calendar io io.encodings.ascii io.launcher
|
||||
kernel make mason.config namespaces ;
|
||||
IN: mason.version.common
|
||||
|
||||
: execute-on-server ( string -- )
|
||||
[ "ssh" , upload-host get , "-l" , upload-username get , ] { } make
|
||||
<process>
|
||||
swap >>command
|
||||
5 minutes >>timeout
|
||||
ascii [ write ] with-process-writer ;
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
|
@ -0,0 +1,54 @@
|
|||
! Copyright (C) 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors calendar db db.tuples db.types kernel locals
|
||||
mason.version.files sequences ;
|
||||
IN: mason.version.data
|
||||
|
||||
TUPLE: release
|
||||
host-name os cpu
|
||||
last-release release-git-id ;
|
||||
|
||||
release "RELEASES" {
|
||||
{ "host-name" "HOST_NAME" TEXT +user-assigned-id+ }
|
||||
{ "os" "OS" TEXT +user-assigned-id+ }
|
||||
{ "cpu" "CPU" TEXT +user-assigned-id+ }
|
||||
{ "last-release" "LAST_RELEASE" TEXT }
|
||||
{ "release-git-id" "RELEASE_GIT_ID" TEXT }
|
||||
} define-persistent
|
||||
|
||||
:: <release> ( version builder -- release )
|
||||
release new
|
||||
builder host-name>> >>host-name
|
||||
builder os>> >>os
|
||||
builder cpu>> >>cpu
|
||||
builder release-git-id>> >>release-git-id
|
||||
version builder binary-release-name >>last-release ;
|
||||
|
||||
: update-binary-releases ( version builders -- )
|
||||
[
|
||||
release new delete-tuples
|
||||
[ <release> insert-tuple ] with each
|
||||
] with-transaction ;
|
||||
|
||||
TUPLE: version
|
||||
id version git-id timestamp source-path announcement-url ;
|
||||
|
||||
version "VERSIONS" {
|
||||
{ "id" "ID" INTEGER +db-assigned-id+ }
|
||||
{ "version" "VERSION" TEXT }
|
||||
{ "git-id" "GIT_ID" TEXT }
|
||||
{ "timestamp" "TIMESTAMP" TIMESTAMP }
|
||||
{ "source-path" "SOURCE_PATH" TEXT }
|
||||
{ "announcement-url" "ANNOUNCEMENT_URL" TEXT }
|
||||
} define-persistent
|
||||
|
||||
: update-version ( version git-id announcement-url -- )
|
||||
version new
|
||||
swap >>announcement-url
|
||||
swap >>git-id
|
||||
swap [ >>version ] [ source-release-name >>source-path ] bi
|
||||
now >>timestamp
|
||||
insert-tuple ;
|
||||
|
||||
: latest-version ( -- version )
|
||||
version new select-tuples last ;
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
|
@ -0,0 +1,39 @@
|
|||
! Copyright (C) 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors fry kernel make mason.config mason.platform
|
||||
mason.release.archive namespaces sequences ;
|
||||
IN: mason.version.files
|
||||
|
||||
: release-directory ( string version -- string )
|
||||
[ "releases/" % % "/" % % ] "" make ;
|
||||
|
||||
: remote-directory ( string -- string' )
|
||||
[ upload-directory get ] dip "/" glue ;
|
||||
|
||||
: remote ( string version -- string )
|
||||
remote-directory swap "/" glue ;
|
||||
|
||||
: platform ( builder -- string )
|
||||
[ os>> ] [ cpu>> ] bi (platform) ;
|
||||
|
||||
: binary-package-name ( builder -- string )
|
||||
[ [ platform % "/" % ] [ last-release>> % ] bi ] "" make
|
||||
remote-directory ;
|
||||
|
||||
: binary-release-name ( version builder -- string )
|
||||
[
|
||||
[
|
||||
[ "factor-" % platform % "-" % % ]
|
||||
[ os>> extension % ]
|
||||
bi
|
||||
] "" make
|
||||
] [ drop ] 2bi release-directory ;
|
||||
|
||||
: remote-binary-release-name ( version builder -- string )
|
||||
[ binary-release-name ] [ drop ] 2bi remote ;
|
||||
|
||||
: source-release-name ( version -- string )
|
||||
[ "factor-src-" ".zip" surround ] keep release-directory ;
|
||||
|
||||
: remote-source-release-name ( version -- string )
|
||||
[ source-release-name ] keep remote ;
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
|
@ -0,0 +1,51 @@
|
|||
! Copyright (C) 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: bootstrap.image bootstrap.image.download io
|
||||
io.directories io.directories.hierarchy io.files.unique
|
||||
io.launcher io.pathnames kernel mason.common mason.config
|
||||
mason.version.files namespaces sequences ;
|
||||
IN: mason.version.source
|
||||
|
||||
: clone-factor ( -- )
|
||||
{ "git" "clone" "git://factorcode.org/git/factor.git" } try-process ;
|
||||
|
||||
: git-reset ( git-id -- )
|
||||
{ "git" "reset" "--hard" } swap suffix try-process ;
|
||||
|
||||
: save-git-id ( git-id -- )
|
||||
"git-id" to-file ;
|
||||
|
||||
: delete-git-tree ( -- )
|
||||
".git" delete-tree
|
||||
".gitignore" delete-file ;
|
||||
|
||||
: download-images ( -- )
|
||||
images [ download-image ] each ;
|
||||
|
||||
: prepare-source ( git-id -- )
|
||||
"factor" [
|
||||
[ git-reset ] [ save-git-id ] bi
|
||||
delete-git-tree
|
||||
download-images
|
||||
] with-directory ;
|
||||
|
||||
: (make-source-release) ( version -- path )
|
||||
[ { "zip" "-qr9" } ] dip source-release-name file-name
|
||||
[ suffix "factor" suffix try-process ] keep ;
|
||||
|
||||
: make-source-release ( version git-id -- path )
|
||||
"Creating source release..." print flush
|
||||
unique-directory
|
||||
[
|
||||
clone-factor prepare-source (make-source-release)
|
||||
"Package created: " write absolute-path dup print
|
||||
] with-directory ;
|
||||
|
||||
: upload-source-release ( package version -- )
|
||||
"Uploading source release..." print flush
|
||||
[ upload-username get upload-host get ] dip
|
||||
remote-source-release-name
|
||||
upload-safely ;
|
||||
|
||||
: do-source-release ( version git-id -- )
|
||||
[ make-source-release ] [ drop upload-source-release ] 2bi ;
|
|
@ -0,0 +1,52 @@
|
|||
! Copyright (C) 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors bit.ly combinators db.tuples debugger fry
|
||||
grouping io io.streams.string kernel locals make mason.email
|
||||
mason.server mason.twitter mason.version.binary
|
||||
mason.version.common mason.version.data mason.version.files
|
||||
mason.version.source sequences threads ;
|
||||
IN: mason.version
|
||||
|
||||
: check-releases ( builders -- )
|
||||
[ release-git-id>> ] map all-equal?
|
||||
[ "Some builders are out of date" throw ] unless ;
|
||||
|
||||
: make-release-directory ( version -- )
|
||||
"Creating release directory..." print flush
|
||||
[ "mkdir -p " % "" release-directory % "\n" % ] "" make
|
||||
execute-on-server ;
|
||||
|
||||
: tweet-release ( version announcement-url -- )
|
||||
[
|
||||
"Factor " %
|
||||
[ % " released -- " % ] [ shorten-url % ] bi*
|
||||
] "" make mason-tweet ;
|
||||
|
||||
:: (do-release) ( version announcement-url -- )
|
||||
[
|
||||
builder new select-tuples :> builders
|
||||
builders first release-git-id>> :> git-id
|
||||
|
||||
builders check-releases
|
||||
version make-release-directory
|
||||
version builders do-binary-release
|
||||
version builders update-binary-releases
|
||||
version git-id do-source-release
|
||||
version git-id announcement-url update-version
|
||||
version announcement-url tweet-release
|
||||
|
||||
"Done." print flush
|
||||
] with-mason-db ;
|
||||
|
||||
: send-release-email ( string version -- )
|
||||
[ "text/plain" ] dip "Release output: " prepend mason-email ;
|
||||
|
||||
:: do-release ( version announcement-url -- )
|
||||
[
|
||||
[
|
||||
[
|
||||
version announcement-url (do-release)
|
||||
] try
|
||||
] with-string-writer
|
||||
version send-release-email
|
||||
] "Mason release" spawn drop ;
|
|
@ -28,6 +28,7 @@
|
|||
|
||||
<table border="1">
|
||||
<tr><td>Host name:</td><td><t:xml t:name="host-name" /></td></tr>
|
||||
<tr><td>Last heartbeat:</td><td><t:xml t:name="last-heartbeat" /></td></tr>
|
||||
<tr><td>Current status:</td><td><t:xml t:name="status" /></td></tr>
|
||||
<tr><td>Last build:</td><td><t:xml t:name="last-build" /></td></tr>
|
||||
<tr><td>Last clean build:</td><td><t:xml t:name="last-clean-build" /></td></tr>
|
||||
|
|
|
@ -0,0 +1,22 @@
|
|||
<?xml version='1.0' ?>
|
||||
|
||||
<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
|
||||
"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
|
||||
|
||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||
|
||||
<h2>Stable release: <t:link t:name="stable-release" /></h2>
|
||||
|
||||
<table id="mytable" cellspacing="0" summary="Stable releases">
|
||||
<t:xml t:name="release-grid" />
|
||||
</table>
|
||||
|
||||
<p><b>Source code</b>: <t:link t:name="source-release" /></p>
|
||||
|
||||
<h2>Development release</h2>
|
||||
|
||||
<table id="mytable" cellspacing="0" summary="Development releases">
|
||||
<t:xml t:name="package-grid" />
|
||||
</table>
|
||||
|
||||
</t:chloe>
|
|
@ -0,0 +1 @@
|
|||
Slava Pestov
|
|
@ -0,0 +1,25 @@
|
|||
! Copyright (C) 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors furnace.actions html.components html.forms
|
||||
kernel mason.server mason.version.data webapps.mason.grids
|
||||
webapps.mason.utils ;
|
||||
IN: webapps.mason.downloads
|
||||
|
||||
: stable-release ( version -- link )
|
||||
[ version>> ] [ announcement-url>> ] bi <simple-link> ;
|
||||
|
||||
: source-release ( version -- link )
|
||||
[ version>> ] [ source-path>> download-url ] bi <simple-link> ;
|
||||
|
||||
: <downloads-action> ( -- action )
|
||||
<page-action>
|
||||
[
|
||||
[
|
||||
package-grid "package-grid" set-value
|
||||
release-grid "release-grid" set-value
|
||||
|
||||
latest-version
|
||||
[ stable-release "stable-release" set-value ]
|
||||
[ source-release "source-release" set-value ] bi
|
||||
] with-mason-db
|
||||
] >>init ;
|
|
@ -2,7 +2,7 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors assocs db.tuples furnace.actions
|
||||
furnace.utilities http.server.responses kernel locals
|
||||
mason.server mason.server.release sequences splitting urls
|
||||
mason.server mason.version.data sequences splitting urls
|
||||
webapps.mason.utils xml.syntax xml.writer ;
|
||||
IN: webapps.mason.grids
|
||||
|
||||
|
@ -19,7 +19,6 @@ CONSTANT: oses
|
|||
{ "macosx" "Mac OS X" }
|
||||
{ "linux" "Linux" }
|
||||
{ "freebsd" "FreeBSD" }
|
||||
{ "netbsd" "NetBSD" }
|
||||
{ "openbsd" "OpenBSD" }
|
||||
}
|
||||
|
||||
|
|
|
@ -11,8 +11,12 @@
|
|||
</head>
|
||||
<body>
|
||||
<t:form t:action="$mason-app/make-release">
|
||||
Version: <t:field t:name="version" />
|
||||
<button type="submit">Go</button>
|
||||
<table>
|
||||
<tr><td>Version:</td><td><t:field t:name="version" /></td></tr>
|
||||
<tr><td>Announcement URL:</td><td><t:field t:name="announcement-url" /></td></tr>
|
||||
</table>
|
||||
|
||||
<p><button type="submit">Go</button></p>
|
||||
</t:form>
|
||||
</body>
|
||||
</html>
|
||||
|
|
|
@ -1,8 +1,7 @@
|
|||
! Copyright (C) 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors furnace.actions html.forms
|
||||
http.server.responses mason.server mason.server.release
|
||||
validators ;
|
||||
http.server.responses mason.server mason.version validators ;
|
||||
IN: webapps.mason.make-release
|
||||
|
||||
: <make-release-action> ( -- action )
|
||||
|
@ -10,7 +9,7 @@ IN: webapps.mason.make-release
|
|||
[ { { "version" [ v-one-line ] } } validate-params ] >>validate
|
||||
[
|
||||
[
|
||||
"version" value do-release
|
||||
"version" value "announcement-url" value do-release
|
||||
"OK" "text/html" <content>
|
||||
] with-mason-db
|
||||
] >>submit ;
|
||||
|
|
|
@ -3,7 +3,8 @@
|
|||
USING: accessors furnace.auth furnace.db
|
||||
http.server.dispatchers mason.server webapps.mason.grids
|
||||
webapps.mason.make-release webapps.mason.package
|
||||
webapps.mason.release webapps.mason.report ;
|
||||
webapps.mason.release webapps.mason.report
|
||||
webapps.mason.downloads ;
|
||||
IN: webapps.mason
|
||||
|
||||
TUPLE: mason-app < dispatcher ;
|
||||
|
@ -21,19 +22,16 @@ can-make-releases? define-capability
|
|||
{ mason-app "download-package" } >>template
|
||||
"package" add-responder
|
||||
|
||||
<package-grid-action>
|
||||
"packages" add-responder
|
||||
|
||||
<download-release-action>
|
||||
{ mason-app "download-release" } >>template
|
||||
"release" add-responder
|
||||
|
||||
<release-grid-action>
|
||||
"releases" add-responder
|
||||
<downloads-action>
|
||||
{ mason-app "downloads" } >>template
|
||||
"downloads" add-responder
|
||||
|
||||
<make-release-action>
|
||||
{ mason-app "make-release" } >>template
|
||||
|
||||
<protected>
|
||||
"make releases" >>description
|
||||
{ can-make-releases? } >>capabilities
|
||||
|
|
|
@ -2,8 +2,9 @@
|
|||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays combinators furnace.actions html.forms
|
||||
kernel mason.platform mason.report mason.server present
|
||||
sequences webapps.mason webapps.mason.report
|
||||
webapps.mason.utils xml.syntax ;
|
||||
sequences webapps.mason webapps.mason.report webapps.mason.utils
|
||||
xml.syntax ;
|
||||
FROM: mason.version.files => platform ;
|
||||
IN: webapps.mason.package
|
||||
|
||||
: building ( builder string -- xml )
|
||||
|
@ -31,7 +32,7 @@ IN: webapps.mason.package
|
|||
over [ [ git-link ] [ present ] bi* " (built on " ")" surround 2array ] [ 2drop f ] if ;
|
||||
|
||||
: packages-url ( builder -- url )
|
||||
[ os>> ] [ cpu>> ] bi (platform) "http://downloads.factorcode.org/" prepend ;
|
||||
platform download-url ;
|
||||
|
||||
: package-link ( builder -- xml )
|
||||
[ packages-url ] [ last-release>> ] bi [ "/" glue ] keep link ;
|
||||
|
@ -40,7 +41,7 @@ IN: webapps.mason.package
|
|||
packages-url dup link ;
|
||||
|
||||
: clean-image-url ( builder -- url )
|
||||
[ os>> ] [ cpu>> ] bi (platform) "http://factorcode.org/images/clean/" prepend ;
|
||||
platform "http://factorcode.org/images/clean/" prepend ;
|
||||
|
||||
: clean-image-link ( builder -- link )
|
||||
clean-image-url dup link ;
|
||||
|
@ -65,6 +66,7 @@ IN: webapps.mason.package
|
|||
[ current-status "status" set-value ]
|
||||
[ last-build-status "last-build" set-value ]
|
||||
[ clean-build-status "last-clean-build" set-value ]
|
||||
[ heartbeat-timestamp>> "heartbeat-timestamp" set-value ]
|
||||
[ packages-link "binaries" set-value ]
|
||||
[ clean-image-link "clean-images" set-value ]
|
||||
[ report-link "last-report" set-value ]
|
||||
|
|
|
@ -6,8 +6,7 @@ webapps.mason.utils io.pathnames ;
|
|||
IN: webapps.mason.release
|
||||
|
||||
: release-link ( builder -- xml )
|
||||
[ "http://downloads.factorcode.org/" ] dip
|
||||
last-release>> [ "/" glue ] [ file-name ] bi link ;
|
||||
last-release>> [ download-url ] [ file-name ] bi link ;
|
||||
|
||||
: <download-release-action> ( -- action )
|
||||
<page-action>
|
||||
|
|
|
@ -1,7 +1,7 @@
|
|||
! Copyright (C) 2010 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors arrays assocs db.tuples furnace.actions
|
||||
html.forms kernel mason.server mason.server.release sequences
|
||||
html.forms kernel mason.server mason.version.data sequences
|
||||
validators xml.syntax ;
|
||||
IN: webapps.mason.utils
|
||||
|
||||
|
@ -38,3 +38,6 @@ IN: webapps.mason.utils
|
|||
] [ drop f ] if
|
||||
] bi
|
||||
2array sift [ [XML <li><-></li> XML] ] map [XML <ul><-></ul> XML] ;
|
||||
|
||||
: download-url ( string -- string' )
|
||||
"http://downloads.factorcode.org/" prepend ;
|
||||
|
|
Loading…
Reference in New Issue