webapps.mason: add dashboard showing crashed machines, add a mechanism for forcing a build across the farm
parent
5df4edc14f
commit
67a828f0f7
|
@ -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
|
||||
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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>
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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>
|
|
@ -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 ] }
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
|
@ -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 ;
|
||||
|
|
Loading…
Reference in New Issue