diff --git a/extra/mason/email/email-tests.factor b/extra/mason/email/email-tests.factor index 5f48ff0d4f..77f651feb9 100644 --- a/extra/mason/email/email-tests.factor +++ b/extra/mason/email/email-tests.factor @@ -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 diff --git a/extra/mason/email/email.factor b/extra/mason/email/email.factor index 302df599b4..1389a2e27c 100644 --- a/extra/mason/email/email.factor +++ b/extra/mason/email/email.factor @@ -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 -- ) 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 { - { status-clean [ "clean" ] } - { status-dirty [ "dirty" ] } - { status-error [ "error" ] } - } case 3append ; +: 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 % + ] "" 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 ; diff --git a/extra/mason/mason.factor b/extra/mason/mason.factor index 42f3737e11..9732c03dfa 100755 --- a/extra/mason/mason.factor +++ b/extra/mason/mason.factor @@ -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 [ [ diff --git a/extra/mason/notify/notify.factor b/extra/mason/notify/notify.factor index 122c8a47cd..d7319c0f20 100644 --- a/extra/mason/notify/notify.factor +++ b/extra/mason/notify/notify.factor @@ -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 ] diff --git a/extra/mason/server/notify/notify.factor b/extra/mason/server/notify/notify.factor index 2c04a43016..3303749c4f 100644 --- a/extra/mason/server/notify/notify.factor +++ b/extra/mason/server/notify/notify.factor @@ -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 ] } diff --git a/extra/mason/server/release/authors.txt b/extra/mason/server/release/authors.txt deleted file mode 100644 index d4f5d6b3ae..0000000000 --- a/extra/mason/server/release/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov \ No newline at end of file diff --git a/extra/mason/server/release/release.factor b/extra/mason/server/release/release.factor deleted file mode 100644 index 04ca2955a7..0000000000 --- a/extra/mason/server/release/release.factor +++ /dev/null @@ -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 - -:: ( 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 - - 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 - [ 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 ; diff --git a/extra/mason/server/server.factor b/extra/mason/server/server.factor index d0fe29b917..26be4df57c 100644 --- a/extra/mason/server/server.factor +++ b/extra/mason/server/server.factor @@ -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" ; diff --git a/extra/mason/source/authors.txt b/extra/mason/source/authors.txt deleted file mode 100644 index d4f5d6b3ae..0000000000 --- a/extra/mason/source/authors.txt +++ /dev/null @@ -1 +0,0 @@ -Slava Pestov \ No newline at end of file diff --git a/extra/mason/source/source.factor b/extra/mason/source/source.factor deleted file mode 100644 index 72c63660e3..0000000000 --- a/extra/mason/source/source.factor +++ /dev/null @@ -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 ; diff --git a/extra/mason/version/authors.txt b/extra/mason/version/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/mason/version/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/mason/version/binary/authors.txt b/extra/mason/version/binary/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/mason/version/binary/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/mason/version/binary/binary.factor b/extra/mason/version/binary/binary.factor new file mode 100644 index 0000000000..5273b644ee --- /dev/null +++ b/extra/mason/version/binary/binary.factor @@ -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 ; diff --git a/extra/mason/version/common/authors.txt b/extra/mason/version/common/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/mason/version/common/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/mason/version/common/common.factor b/extra/mason/version/common/common.factor new file mode 100644 index 0000000000..65d01c3f71 --- /dev/null +++ b/extra/mason/version/common/common.factor @@ -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 + + swap >>command + 5 minutes >>timeout + ascii [ write ] with-process-writer ; diff --git a/extra/mason/version/data/authors.txt b/extra/mason/version/data/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/mason/version/data/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/mason/version/data/data.factor b/extra/mason/version/data/data.factor new file mode 100644 index 0000000000..eb735c918c --- /dev/null +++ b/extra/mason/version/data/data.factor @@ -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 + +:: ( 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 + [ 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 ; diff --git a/extra/mason/version/files/authors.txt b/extra/mason/version/files/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/mason/version/files/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/mason/version/files/files.factor b/extra/mason/version/files/files.factor new file mode 100644 index 0000000000..1335885c3d --- /dev/null +++ b/extra/mason/version/files/files.factor @@ -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 ; diff --git a/extra/mason/version/source/authors.txt b/extra/mason/version/source/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/mason/version/source/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/mason/version/source/source.factor b/extra/mason/version/source/source.factor new file mode 100644 index 0000000000..cc41ee3e6b --- /dev/null +++ b/extra/mason/version/source/source.factor @@ -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 ; diff --git a/extra/mason/version/version.factor b/extra/mason/version/version.factor new file mode 100644 index 0000000000..a2093124f7 --- /dev/null +++ b/extra/mason/version/version.factor @@ -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 ; diff --git a/extra/webapps/mason/download-package.xml b/extra/webapps/mason/download-package.xml index 7e50f958cd..cff9dbe789 100644 --- a/extra/webapps/mason/download-package.xml +++ b/extra/webapps/mason/download-package.xml @@ -28,6 +28,7 @@ + diff --git a/extra/webapps/mason/downloads.xml b/extra/webapps/mason/downloads.xml new file mode 100644 index 0000000000..82d6572579 --- /dev/null +++ b/extra/webapps/mason/downloads.xml @@ -0,0 +1,22 @@ + + + + + + +

Stable release:

+ +
Host name:
Last heartbeat:
Current status:
Last build:
Last clean build:
+ +
+ +

Source code:

+ +

Development release

+ + + +
+ + diff --git a/extra/webapps/mason/downloads/authors.txt b/extra/webapps/mason/downloads/authors.txt new file mode 100644 index 0000000000..1901f27a24 --- /dev/null +++ b/extra/webapps/mason/downloads/authors.txt @@ -0,0 +1 @@ +Slava Pestov diff --git a/extra/webapps/mason/downloads/downloads.factor b/extra/webapps/mason/downloads/downloads.factor new file mode 100644 index 0000000000..7ff9e64f6b --- /dev/null +++ b/extra/webapps/mason/downloads/downloads.factor @@ -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 ; + +: source-release ( version -- link ) + [ version>> ] [ source-path>> download-url ] bi ; + +: ( -- 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 ; diff --git a/extra/webapps/mason/grids/grids.factor b/extra/webapps/mason/grids/grids.factor index 86d9ba38b3..d9d12ef745 100644 --- a/extra/webapps/mason/grids/grids.factor +++ b/extra/webapps/mason/grids/grids.factor @@ -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" } } @@ -36,7 +35,7 @@ CONSTANT: cpus :: render-grid-row ( cpu quot -- xml ) cpu second oses keys [| os | cpu os quot render-grid-cell ] map [XML <-><-> XML] ; - + :: render-grid ( quot -- xml ) render-grid-header cpus [ quot render-grid-row ] map diff --git a/extra/webapps/mason/make-release.xml b/extra/webapps/mason/make-release.xml index f12ba014f2..7143d819ab 100644 --- a/extra/webapps/mason/make-release.xml +++ b/extra/webapps/mason/make-release.xml @@ -11,8 +11,12 @@ - Version: - + + + +
Version:
Announcement URL:
+ +

diff --git a/extra/webapps/mason/make-release/make-release.factor b/extra/webapps/mason/make-release/make-release.factor index 4cc3873d91..c90aaad297 100644 --- a/extra/webapps/mason/make-release/make-release.factor +++ b/extra/webapps/mason/make-release/make-release.factor @@ -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 : ( -- 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" ] with-mason-db ] >>submit ; diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor index e134778fc7..ecb1348532 100644 --- a/extra/webapps/mason/mason.factor +++ b/extra/webapps/mason/mason.factor @@ -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 - - "packages" add-responder - { mason-app "download-release" } >>template "release" add-responder - - "releases" add-responder + + { mason-app "downloads" } >>template + "downloads" add-responder { mason-app "make-release" } >>template - "make releases" >>description { can-make-releases? } >>capabilities diff --git a/extra/webapps/mason/package/package.factor b/extra/webapps/mason/package/package.factor index d1ed03cbf4..5c36a7f23a 100644 --- a/extra/webapps/mason/package/package.factor +++ b/extra/webapps/mason/package/package.factor @@ -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 ] diff --git a/extra/webapps/mason/release/release.factor b/extra/webapps/mason/release/release.factor index a7c0f71154..98fa42b68c 100644 --- a/extra/webapps/mason/release/release.factor +++ b/extra/webapps/mason/release/release.factor @@ -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 ; : ( -- action ) diff --git a/extra/webapps/mason/utils/utils.factor b/extra/webapps/mason/utils/utils.factor index 8197cce820..ad56737bc1 100644 --- a/extra/webapps/mason/utils/utils.factor +++ b/extra/webapps/mason/utils/utils.factor @@ -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
  • <->
    • XML] ] map [XML
      <->
    XML] ; + +: download-url ( string -- string' ) + "http://downloads.factorcode.org/" prepend ;