diff --git a/extra/mason/config/config.factor b/extra/mason/config/config.factor index b72b949ed5..9e61b58ef8 100644 --- a/extra/mason/config/config.factor +++ b/extra/mason/config/config.factor @@ -34,9 +34,16 @@ target-os get-global [ ! Keep test-log around? SYMBOL: builder-debug +! URL for counter notifications. +SYMBOL: counter-url + +counter-url [ "http://builds.factorcode.org/counter" ] initialize + ! URL for status notifications. SYMBOL: status-url +status-url [ "http://builds.factorcode.org/status-update" ] initialize + ! Password for status notifications. SYMBOL: status-secret diff --git a/extra/mason/server/server.factor b/extra/mason/server/server.factor index d0fe29b917..a57dfb714e 100644 --- a/extra/mason/server/server.factor +++ b/extra/mason/server/server.factor @@ -1,6 +1,7 @@ ! Copyright (C) 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: db db.sqlite db.tuples db.types kernel ; +USING: accessors calendar db db.sqlite db.tuples db.types kernel +math math.order sequences ; IN: mason.server CONSTANT: +starting+ "starting" @@ -23,13 +24,13 @@ builder "BUILDERS" { { "host-name" "HOST_NAME" TEXT +user-assigned-id+ } { "os" "OS" TEXT +user-assigned-id+ } { "cpu" "CPU" TEXT +user-assigned-id+ } - + { "clean-git-id" "CLEAN_GIT_ID" TEXT } { "clean-timestamp" "CLEAN_TIMESTAMP" TIMESTAMP } { "last-release" "LAST_RELEASE" TEXT } { "release-git-id" "RELEASE_GIT_ID" TEXT } - + { "last-git-id" "LAST_GIT_ID" TEXT } { "last-timestamp" "LAST_TIMESTAMP" TIMESTAMP } { "last-report" "LAST_REPORT" TEXT } @@ -40,7 +41,33 @@ builder "BUILDERS" { { "status" "STATUS" TEXT } } define-persistent +TUPLE: counter id value ; + +counter "COUNTER" { + { "id" "ID" INTEGER +db-assigned-id+ } + { "value" "VALUE" INTEGER } +} define-persistent + +: counter-tuple ( -- counter ) + counter new select-tuple + [ counter new dup insert-tuple ] unless* ; + +: counter-value ( -- n ) + [ counter-tuple value>> 0 or ] with-transaction ; + +: increment-counter-value ( -- n ) + [ + counter-tuple [ 0 or 1 + dup ] change-value update-tuple + ] with-transaction ; + +: crashed-builders ( -- seq ) + builder new select-tuples + [ current-timestamp>> 5 hours ago before? ] filter ; + : mason-db ( -- db ) "resource:mason.db" ; : with-mason-db ( quot -- ) [ mason-db ] dip with-db ; inline + +: init-mason-db ( -- ) + { builder counter } ensure-tables ; diff --git a/extra/webapps/mason/downloads.xml b/extra/webapps/mason/downloads.xml index 4ff3567bd2..8cd8c51e50 100644 --- a/extra/webapps/mason/downloads.xml +++ b/extra/webapps/mason/downloads.xml @@ -14,4 +14,6 @@ +

Build farm dashboard (core team only)

+ diff --git a/extra/webapps/mason/grids/grids.factor b/extra/webapps/mason/grids/grids.factor index 9c861e1345..c2973070cc 100644 --- a/extra/webapps/mason/grids/grids.factor +++ b/extra/webapps/mason/grids/grids.factor @@ -45,12 +45,6 @@ CONSTANT: cpus XML] ; -: package-url ( builder -- url ) - [ URL" $mason-app/package" ] dip - [ os>> "os" set-query-param ] - [ cpu>> "cpu" set-query-param ] bi - adjust-url ; - : package-date ( filename -- date ) "." split1 drop 16 tail* 6 head* ; @@ -72,12 +66,6 @@ CONSTANT: cpus ] with-mason-db ] >>display ; -: release-url ( builder -- url ) - [ URL" $mason-app/release" ] dip - [ os>> "os" set-query-param ] - [ cpu>> "cpu" set-query-param ] bi - adjust-url ; - : release-version ( filename -- release ) ".tar.gz" ?tail drop ".zip" ?tail drop ".dmg" ?tail drop "-" split1-last nip ; diff --git a/extra/webapps/mason/make-release.xml b/extra/webapps/mason/make-release.xml deleted file mode 100644 index 7143d819ab..0000000000 --- a/extra/webapps/mason/make-release.xml +++ /dev/null @@ -1,24 +0,0 @@ - - - - - - - - - Make release - - - - - - -
Version:
Announcement URL:
- -

- - - - - diff --git a/extra/webapps/mason/make-release/make-release.factor b/extra/webapps/mason/make-release/make-release.factor index e7cd13a895..2668a290db 100644 --- a/extra/webapps/mason/make-release/make-release.factor +++ b/extra/webapps/mason/make-release/make-release.factor @@ -5,7 +5,7 @@ http.server.responses mason.server mason.version validators ; IN: webapps.mason.make-release : ( -- action ) - + [ { { "version" [ v-one-line ] } diff --git a/extra/webapps/mason/mason.factor b/extra/webapps/mason/mason.factor index 81eb36a17d..4f816bb482 100644 --- a/extra/webapps/mason/mason.factor +++ b/extra/webapps/mason/mason.factor @@ -1,17 +1,23 @@ ! Copyright (C) 2009, 2010 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. -USING: accessors furnace.auth furnace.db +USING: accessors furnace.actions 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.downloads webapps.mason.status-update ; +webapps.mason.package webapps.mason.release webapps.mason.report +webapps.mason.downloads webapps.mason.counter +webapps.mason.status-update webapps.mason.dashboard +webapps.mason.make-release webapps.mason.increment-counter ; IN: webapps.mason TUPLE: mason-app < dispatcher ; -SYMBOL: can-make-releases? +SYMBOL: build-engineer? -can-make-releases? define-capability +build-engineer? define-capability + +: ( responder -- responder' ) + + "access the build farm dashboard" >>description + { build-engineer? } >>capabilities ; : ( -- dispatcher ) mason-app new-dispatcher @@ -30,12 +36,21 @@ can-make-releases? define-capability { mason-app "downloads" } >>template "downloads" add-responder - - { mason-app "make-release" } >>template - - "make releases" >>description - { can-make-releases? } >>capabilities - "make-release" add-responder - - "status-update" add-responder ; + "status-update" add-responder + + + "counter" add-responder + + + + { mason-app "dashboard" } >>template + "" add-responder + + + "increment-counter" add-responder + + + "increment-counter" add-responder + + "dashboard" add-responder ; diff --git a/extra/webapps/mason/utils/utils.factor b/extra/webapps/mason/utils/utils.factor index ad56737bc1..b26fd5e5bb 100644 --- a/extra/webapps/mason/utils/utils.factor +++ b/extra/webapps/mason/utils/utils.factor @@ -1,8 +1,8 @@ ! 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.version.data sequences -validators xml.syntax ; +furnace.utilities html.forms kernel mason.server +mason.version.data sequences validators xml.syntax urls ; IN: webapps.mason.utils : link ( url label -- xml ) @@ -41,3 +41,15 @@ IN: webapps.mason.utils : download-url ( string -- string' ) "http://downloads.factorcode.org/" prepend ; + +: package-url ( builder -- url ) + [ URL" $mason-app/package" ] dip + [ os>> "os" set-query-param ] + [ cpu>> "cpu" set-query-param ] bi + adjust-url ; + +: release-url ( builder -- url ) + [ URL" $mason-app/release" ] dip + [ os>> "os" set-query-param ] + [ cpu>> "cpu" set-query-param ] bi + adjust-url ; diff --git a/extra/webapps/user-admin/user-admin.factor b/extra/webapps/user-admin/user-admin.factor index c0cd601af5..700cf56e20 100644 --- a/extra/webapps/user-admin/user-admin.factor +++ b/extra/webapps/user-admin/user-admin.factor @@ -1,7 +1,7 @@ ! Copyright (C) 2008 Slava Pestov. ! See http://factorcode.org/license.txt for BSD license. USING: kernel sequences accessors namespaces combinators words -assocs db.tuples arrays splitting strings validators urls +assocs db.tuples arrays splitting strings validators urls fry html.forms html.components furnace @@ -158,8 +158,10 @@ can-administer-users? define-capability "administer users" >>description { can-administer-users? } >>capabilities ; -: make-admin ( username -- ) - - select-tuple - [ can-administer-users? suffix ] change-capabilities +: give-capability ( username capability -- ) + [ select-tuple ] dip + '[ _ suffix ] change-capabilities update-tuple ; + +: make-admin ( username -- ) + can-administer-users? give-capability ; diff --git a/extra/websites/concatenative/concatenative.factor b/extra/websites/concatenative/concatenative.factor index efa4c4b635..afcaff52f9 100644 --- a/extra/websites/concatenative/concatenative.factor +++ b/extra/websites/concatenative/concatenative.factor @@ -25,12 +25,15 @@ webapps.planet webapps.wiki webapps.user-admin webapps.help -webapps.mason ; +webapps.mason +mason.server ; IN: websites.concatenative : test-db ( -- db ) "resource:test.db" ; : init-factor-db ( -- ) + mason-db [ init-mason-db ] with-db + test-db [ init-furnace-tables @@ -86,7 +89,7 @@ SYMBOL: dh-file "user-admin" add-responder "pastebin" add-responder "planet" add-responder - "mason" add-responder + "mason" add-responder "/tmp/docs/" "docs" add-responder test-db main-responder set-global ; @@ -105,7 +108,7 @@ SYMBOL: dh-file test-db "concatenative.org" add-responder test-db "paste.factorcode.org" add-responder test-db "planet.factorcode.org" add-responder - test-db "builds.factorcode.org" add-responder + test-db "builds.factorcode.org" add-responder home "docs" append-path "docs.factorcode.org" add-responder home "cgi" append-path "gitweb.factorcode.org" add-responder main-responder set-global ;