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

mason: add new idle, upload, finish states to make status display more helpful

release
Slava Pestov 2010-09-16 23:43:14 -07:00
parent 7122f9fccb
commit c4d717a49a
9 changed files with 77 additions and 49 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

10
extra/mason/build/build.factor
View File

@ -42,9 +42,13 @@ IN: mason.build
[ [
begin-build begin-build
build-child build-child
[ notify-report ] [ notify-report ] [
[ status-clean eq? [ upload-docs release ] when ] bi status-clean eq?
[ notify-upload upload-docs release ] when
] bi
notify-finish
finish-build finish-build
] [ cleanup ] [ ] continuations:cleanup ; ] [ cleanup ] [ ] continuations:cleanup
notify-idle ;
MAIN: build MAIN: build

9
extra/mason/notify/notify.factor
View File

@ -27,6 +27,9 @@ IN: mason.notify
: notify-heartbeat ( -- ) : notify-heartbeat ( -- )
f f "heartbeat" status-notify ; f f "heartbeat" status-notify ;
: notify-idle ( -- )
f f "idle" status-notify ;
: notify-begin-build ( git-id -- ) : notify-begin-build ( git-id -- )
[ "Starting build of GIT ID " write print flush ] [ "Starting build of GIT ID " write print flush ]
[ f swap "git-id" status-notify ] [ f swap "git-id" status-notify ]
@ -51,6 +54,12 @@ IN: mason.notify
[ name>> "report" status-notify ] [ email-report ] 2bi [ name>> "report" status-notify ] [ email-report ] 2bi
] bi ; ] bi ;
: notify-upload ( -- )
f f "upload" status-notify ;
: notify-finish ( -- )
f f "finish" status-notify ;
: notify-release ( archive-name -- ) : notify-release ( archive-name -- )
[ "Uploaded " prepend [ print flush ] [ mason-tweet ] bi ] [ "Uploaded " prepend [ print flush ] [ mason-tweet ] bi ]
[ f swap "release" status-notify ] [ f swap "release" status-notify ]

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

@ -4,16 +4,20 @@ USING: accessors calendar db db.sqlite db.tuples db.types kernel
math math.order sequences combinators.short-circuit ; math math.order sequences combinators.short-circuit ;
IN: mason.server IN: mason.server
CONSTANT: +idle+ "idle"
CONSTANT: +starting+ "starting" CONSTANT: +starting+ "starting"
CONSTANT: +make-vm+ "make-vm" CONSTANT: +make-vm+ "make-vm"
CONSTANT: +boot+ "boot" CONSTANT: +boot+ "boot"
CONSTANT: +test+ "test" CONSTANT: +test+ "test"
CONSTANT: +clean+ "status-clean" CONSTANT: +upload+ "upload"
CONSTANT: +finish+ "finish"
CONSTANT: +dirty+ "status-dirty" CONSTANT: +dirty+ "status-dirty"
CONSTANT: +error+ "status-error" CONSTANT: +error+ "status-error"
CONSTANT: +clean+ "status-clean"
TUPLE: builder TUPLE: builder
host-name os cpu host-name os cpu heartbeat-timestamp
clean-git-id clean-timestamp clean-git-id clean-timestamp
last-release release-git-id last-release release-git-id
last-git-id last-timestamp last-report last-git-id last-timestamp last-report
@ -24,6 +28,7 @@ builder "BUILDERS" {
{ "host-name" "HOST_NAME" TEXT +user-assigned-id+ } { "host-name" "HOST_NAME" TEXT +user-assigned-id+ }
{ "os" "OS" TEXT +user-assigned-id+ } { "os" "OS" TEXT +user-assigned-id+ }
{ "cpu" "CPU" TEXT +user-assigned-id+ } { "cpu" "CPU" TEXT +user-assigned-id+ }
{ "heartbeat-timestamp" "HEARTBEAT_TIMESTAMP" TIMESTAMP }
{ "clean-git-id" "CLEAN_GIT_ID" TEXT } { "clean-git-id" "CLEAN_GIT_ID" TEXT }
{ "clean-timestamp" "CLEAN_TIMESTAMP" TIMESTAMP } { "clean-timestamp" "CLEAN_TIMESTAMP" TIMESTAMP }
@ -60,23 +65,11 @@ counter "COUNTER" {
counter-tuple [ 0 or 1 + dup ] change-value update-tuple counter-tuple [ 0 or 1 + dup ] change-value update-tuple
] with-transaction ; ] with-transaction ;
: crashed-builders ( -- seq ) : funny-builders ( -- crashed broken )
builder new select-tuples builder new select-tuples
[ current-timestamp>> 5 hours ago before? ] filter ; [ [ heartbeat-timestamp>> 30 minutes ago before? ] filter ]
[ [ [ clean-git-id>> ] [ last-git-id>> ] bi = not ] filter ]
: broken-builders ( -- seq ) bi ;
builder new select-tuples
[
clean-timestamp>>
{ [ not ] [ 1 weeks ago before? ] } 1||
] filter ;
: funny-builders ( -- crashed broken limbo )
builder new select-tuples
[ [ current-timestamp>> 1 hours ago before? ] filter ]
[ [ clean-timestamp>> 1 weeks ago before? ] filter ]
[ [ [ clean-git-id>> ] [ release-git-id>> ] bi = not ] filter ]
tri ;
: os/cpu ( builder -- string ) : os/cpu ( builder -- string )
[ os>> ] [ cpu>> ] bi "/" glue ; [ os>> ] [ cpu>> ] bi "/" glue ;

4
extra/mason/server/watchdog/watchdog.factor
View File

@ -9,7 +9,7 @@ IN: mason.server.watchdog
<XML <XML
<html> <html>
<body> <body>
<p>Machines which have not sent a heartbeat for several hours:</p> <p>Machines which are not sending heartbeats:</p>
<ul><-></ul> <ul><-></ul>
<a href="http://builds.factorcode.org/dashboard">Dashboard</a> <a href="http://builds.factorcode.org/dashboard">Dashboard</a>
</body> </body>
@ -31,6 +31,6 @@ IN: mason.server.watchdog
: check-builders ( -- ) : check-builders ( -- )
[ [
funny-builders 2drop funny-builders drop
[ send-crashed-builder-email ] unless-empty [ send-crashed-builder-email ] unless-empty
] with-mason-db ; ] with-mason-db ;

8
extra/webapps/mason/dashboard.xml
View File

@ -4,17 +4,13 @@
<t:title>Mason dashboard</t:title> <t:title>Mason dashboard</t:title>
<h1>Crashed build machines</h1> <h1>Crashed build machines</h1>
<p>Machines which have not sent a heartbeat for several hours:</p> <p>Machines which are not sending heartbeats:</p>
<t:xml t:name="crashed" /> <t:xml t:name="crashed" />
<h1>Broken build machines</h1> <h1>Broken build machines</h1>
<p>Machines which have not had a successful build for over a week:</p> <p>Machines with failing builds:</p>
<t:xml t:name="broken" /> <t:xml t:name="broken" />
<h1>Build machines in limbo</h1>
<p>Machines with a clean build that have not uploaded binary for that build:</p>
<t:xml t:name="limbo" />
<h1>Force build now</h1> <h1>Force build now</h1>
<p>Requires build engineer status.</p> <p>Requires build engineer status.</p>

3
extra/webapps/mason/dashboard/dashboard.factor
View File

@ -20,7 +20,6 @@ IN: webapps.mason.downloads
funny-builders funny-builders
[ builder-list ] tri@ [ builder-list ] tri@
[ "crashed" set-value ] [ "crashed" set-value ]
[ "broken" set-value ] [ "broken" set-value ] bi*
[ "limbo" set-value ] tri*
] with-mason-db ] with-mason-db
] >>init ; ] >>init ;

2
extra/webapps/mason/download-package.xml
View File

@ -24,7 +24,7 @@
<table border="1"> <table border="1">
<tr><td>Host name:</td><td><t:xml t:name="host-name" /></td></tr> <tr><td>Host name:</td><td><t:xml t:name="host-name" /></td></tr>
<tr><td>Last heartbeat:</td><td><t:label t:name="current-timestamp" /></td></tr> <tr><td>Last heartbeat:</td><td><t:label t:name="heartbeat-timestamp" /></td></tr>
<tr><td>Current status:</td><td><t:xml t:name="status" /></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 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> <tr><td>Last clean build:</td><td><t:xml t:name="last-clean-build" /></td></tr>

10
extra/webapps/mason/package/package.factor
View File

@ -13,13 +13,16 @@ IN: webapps.mason.package
: status-string ( builder -- string ) : status-string ( builder -- string )
dup status>> { dup status>> {
{ +dirty+ [ drop "Dirty" ] } { +idle+ [ drop "Idle" ] }
{ +clean+ [ drop "Clean" ] }
{ +error+ [ drop "Error" ] }
{ +starting+ [ "Starting build" building ] } { +starting+ [ "Starting build" building ] }
{ +make-vm+ [ "Compiling VM" building ] } { +make-vm+ [ "Compiling VM" building ] }
{ +boot+ [ "Bootstrapping" building ] } { +boot+ [ "Bootstrapping" building ] }
{ +test+ [ "Testing" building ] } { +test+ [ "Testing" building ] }
{ +upload+ [ "Uploading package" building ] }
{ +finish+ [ "Finishing build" building ] }
{ +dirty+ [ drop "Dirty" ] }
{ +clean+ [ drop "Clean" ] }
{ +error+ [ drop "Error" ] }
[ 2drop "Unknown" ] [ 2drop "Unknown" ]
} case ; } case ;
@ -63,6 +66,7 @@ IN: webapps.mason.package
[ release-git-id>> git-link "git-id" set-value ] [ release-git-id>> git-link "git-id" set-value ]
[ requirements "requirements" set-value ] [ requirements "requirements" set-value ]
[ host-name>> "host-name" set-value ] [ host-name>> "host-name" set-value ]
[ heartbeat-timestamp>> "heartbeat-timestamp" set-value ]
[ current-status "status" set-value ] [ current-status "status" set-value ]
[ last-build-status "last-build" set-value ] [ last-build-status "last-build" set-value ]
[ clean-build-status "last-clean-build" set-value ] [ clean-build-status "last-clean-build" set-value ]

51
extra/webapps/mason/status-update/status-update.factor
View File

@ -5,24 +5,38 @@ furnace.redirection html.forms http.server.responses io kernel
mason.server namespaces validators webapps.mason.utils ; mason.server namespaces validators webapps.mason.utils ;
IN: webapps.mason.status-update IN: webapps.mason.status-update
: find-builder ( -- builder ) : find-builder ( host-name os cpu -- builder )
builder new builder new
"host-name" value >>host-name swap >>cpu
"target-os" value >>os swap >>os
"target-cpu" value >>cpu swap >>host-name
dup select-tuple [ ] [ dup insert-tuple ] ?if ; dup select-tuple [ ] [ dup insert-tuple ] ?if ;
: git-id ( builder id -- ) >>current-git-id +starting+ >>status drop ; : heartbeat ( builder -- )
now >>heartbeat-timestamp
drop ;
: make-vm ( builder -- ) +make-vm+ >>status drop ; : status ( builder status -- )
>>status
now >>current-timestamp
drop ;
: boot ( builder -- ) +boot+ >>status drop ; : idle ( builder -- ) +idle+ status ;
: test ( builder -- ) +test+ >>status drop ; : git-id ( builder id -- ) >>current-git-id +starting+ status ;
: report ( builder status content -- ) : make-vm ( builder -- ) +make-vm+ status ;
[ >>status ] [ >>last-report ] bi*
dup status>> +clean+ = [ : boot ( builder -- ) +boot+ status ;
: test ( builder -- ) +test+ status ;
: report ( builder content status -- )
[
>>last-report
now >>current-timestamp
] dip
+clean+ = [
dup current-git-id>> >>clean-git-id dup current-git-id>> >>clean-git-id
dup current-timestamp>> >>clean-timestamp dup current-timestamp>> >>clean-timestamp
] when ] when
@ -30,6 +44,10 @@ IN: webapps.mason.status-update
dup current-timestamp>> >>last-timestamp dup current-timestamp>> >>last-timestamp
drop ; drop ;
: upload ( builder -- ) +upload+ status ;
: finish ( builder -- ) +finish+ status ;
: release ( builder name -- ) : release ( builder name -- )
>>last-release >>last-release
dup clean-git-id>> >>release-git-id dup clean-git-id>> >>release-git-id
@ -37,12 +55,15 @@ IN: webapps.mason.status-update
: update-builder ( builder -- ) : update-builder ( builder -- )
"message" value { "message" value {
{ "heartbeat" [ drop ] } { "heartbeat" [ heartbeat ] }
{ "idle" [ idle ] }
{ "git-id" [ "arg" value git-id ] } { "git-id" [ "arg" value git-id ] }
{ "make-vm" [ make-vm ] } { "make-vm" [ make-vm ] }
{ "boot" [ boot ] } { "boot" [ boot ] }
{ "test" [ test ] } { "test" [ test ] }
{ "report" [ "arg" value "report" value report ] } { "report" [ "report" value "arg" value report ] }
{ "upload" [ upload ] }
{ "finish" [ finish ] }
{ "release" [ "arg" value release ] } { "release" [ "arg" value release ] }
} case ; } case ;
@ -63,8 +84,10 @@ IN: webapps.mason.status-update
[ [
[ [
"host-name" value
"target-os" value
"target-cpu" value
find-builder find-builder
now >>current-timestamp
[ update-builder ] [ update-tuple ] bi [ update-builder ] [ update-tuple ] bi
] with-mason-db ] with-mason-db
"OK" "text/plain" <content> "OK" "text/plain" <content>