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

webapps.mason: add dashboard showing crashed machines, add a mechanism for forcing a build across the farm

db4
Slava Pestov 2010-09-04 17:59:18 -07:00
parent 5df4edc14f
commit 67a828f0f7
10 changed files with 96 additions and 64 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

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

@ -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

33
extra/mason/server/server.factor
View File

@ -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" <sqlite-db> ;
: with-mason-db ( quot -- )
[ mason-db ] dip with-db ; inline
: init-mason-db ( -- )
{ builder counter } ensure-tables ;

2
extra/webapps/mason/downloads.xml
View File

@ -14,4 +14,6 @@
<t:xml t:name="package-grid" />
</table>
<p><t:a t:href="$mason-app/dashboard">Build farm dashboard</t:a> (core team only)</p>
</t:chloe>

12
extra/webapps/mason/grids/grids.factor
View File

@ -45,12 +45,6 @@ CONSTANT: cpus
</table>
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 ;

24
extra/webapps/mason/make-release.xml
View File

@ -1,24 +0,0 @@
<?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">
<html xmlns="http://www.w3.org/1999/xhtml">
<head>
<title>Make release</title>
</head>
<body>
<t:form t:action="$mason-app/make-release">
<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>
</t:chloe>

2
extra/webapps/mason/make-release/make-release.factor
View File

@ -5,7 +5,7 @@ http.server.responses mason.server mason.version validators ;
IN: webapps.mason.make-release
: <make-release-action> ( -- action )
<page-action>
<action>
[
{
{ "version" [ v-one-line ] }

43
extra/webapps/mason/mason.factor
View File

@ -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
: <mason-protected> ( responder -- responder' )
<protected>
"access the build farm dashboard" >>description
{ build-engineer? } >>capabilities ;
: <mason-app> ( -- dispatcher )
mason-app new-dispatcher
@ -30,12 +36,21 @@ can-make-releases? define-capability
{ mason-app "downloads" } >>template
"downloads" add-responder
<make-release-action>
{ mason-app "make-release" } >>template
<protected>
"make releases" >>description
{ can-make-releases? } >>capabilities
"make-release" add-responder
<status-update-action>
"status-update" add-responder ;
"status-update" add-responder
<counter-action>
"counter" add-responder
<dispatcher>
<dashboard-action>
{ mason-app "dashboard" } >>template
"" add-responder
<make-release-action>
"increment-counter" add-responder
<increment-counter-action>
"increment-counter" add-responder
<mason-protected> "dashboard" add-responder ;

16
extra/webapps/mason/utils/utils.factor
View File

@ -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 ;

12
extra/webapps/user-admin/user-admin.factor
View File

@ -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 -- )
<user>
select-tuple
[ can-administer-users? suffix ] change-capabilities
: give-capability ( username capability -- )
[ <user> select-tuple ] dip
'[ _ suffix ] change-capabilities
update-tuple ;
: make-admin ( username -- )
can-administer-users? give-capability ;

9
extra/websites/concatenative/concatenative.factor
View File

@ -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" <sqlite-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> <login-config> <factor-boilerplate> "user-admin" add-responder
<pastebin> <factor-recaptcha> <login-config> <factor-boilerplate> "pastebin" add-responder
<planet> <login-config> <factor-boilerplate> "planet" add-responder
<mason-app> <login-config> "mason" add-responder
<mason-app> <login-config> <factor-boilerplate> "mason" add-responder
"/tmp/docs/" <help-webapp> "docs" add-responder
test-db <alloy>
main-responder set-global ;
@ -105,7 +108,7 @@ SYMBOL: dh-file
<login-config> <factor-boilerplate> test-db <alloy> "concatenative.org" add-responder
<pastebin> <factor-recaptcha> <login-config> <factor-boilerplate> test-db <alloy> "paste.factorcode.org" add-responder
<planet> <login-config> <factor-boilerplate> test-db <alloy> "planet.factorcode.org" add-responder
<mason-app> <login-config> test-db <alloy> "builds.factorcode.org" add-responder
<mason-app> <login-config> <factor-boilerplate> test-db <alloy> "builds.factorcode.org" add-responder
home "docs" append-path <help-webapp> "docs.factorcode.org" add-responder
home "cgi" append-path <gitweb> "gitweb.factorcode.org" add-responder
main-responder set-global ;