2011-09-09 22:13:06 -04:00
|
|
|
! Copyright (C) 2009, 2011 Slava Pestov.
|
2009-04-17 21:59:59 -04:00
|
|
|
! See http://factorcode.org/license.txt for BSD license.
|
2014-11-15 19:20:49 -05:00
|
|
|
USING: accessors continuations debugger fry http.client io
|
|
|
|
io.encodings.utf8 io.files kernel make mason.common mason.config
|
|
|
|
mason.email mason.twitter namespaces sequences ;
|
2009-04-17 21:59:59 -04:00
|
|
|
IN: mason.notify
|
|
|
|
|
2011-09-09 22:13:06 -04:00
|
|
|
: status-notify? ( -- ? )
|
|
|
|
status-url get
|
|
|
|
target-variant get not and ;
|
|
|
|
|
|
|
|
: status-params ( report arg message -- assoc )
|
|
|
|
[
|
2012-07-19 14:24:45 -04:00
|
|
|
short-host-name "host-name" ,,
|
|
|
|
target-cpu get "target-cpu" ,,
|
|
|
|
target-os get "target-os" ,,
|
|
|
|
status-secret get "secret" ,,
|
|
|
|
[ "report" ,, ]
|
|
|
|
[ "arg" ,, ]
|
|
|
|
[ "message" ,, ] tri*
|
|
|
|
] H{ } make ;
|
2011-09-09 22:13:06 -04:00
|
|
|
|
2010-04-17 15:51:29 -04:00
|
|
|
: status-notify ( report arg message -- )
|
2011-09-09 22:13:06 -04:00
|
|
|
status-notify? [
|
|
|
|
'[
|
|
|
|
5 [
|
|
|
|
_ _ _ status-params status-url get
|
|
|
|
http-post 2drop
|
|
|
|
] retry
|
|
|
|
] [
|
2011-09-09 22:33:13 -04:00
|
|
|
"STATUS NOTIFY FAILED:" print-timestamp
|
2011-09-09 22:13:06 -04:00
|
|
|
error. flush
|
|
|
|
] recover
|
|
|
|
] [ 3drop ] if ;
|
2009-04-17 21:59:59 -04:00
|
|
|
|
2010-04-11 21:42:12 -04:00
|
|
|
: notify-heartbeat ( -- )
|
2010-04-17 15:51:29 -04:00
|
|
|
f f "heartbeat" status-notify ;
|
2010-04-11 21:42:12 -04:00
|
|
|
|
2010-09-17 02:43:14 -04:00
|
|
|
: notify-idle ( -- )
|
|
|
|
f f "idle" status-notify ;
|
|
|
|
|
2009-04-17 21:59:59 -04:00
|
|
|
: notify-begin-build ( git-id -- )
|
2011-09-09 22:33:13 -04:00
|
|
|
[ "Starting build of GIT ID " prepend print-timestamp ]
|
2010-04-17 15:51:29 -04:00
|
|
|
[ f swap "git-id" status-notify ]
|
2009-04-17 21:59:59 -04:00
|
|
|
bi ;
|
|
|
|
|
|
|
|
: notify-make-vm ( -- )
|
2011-09-09 22:33:13 -04:00
|
|
|
"Compiling VM" print-timestamp
|
2010-04-17 15:51:29 -04:00
|
|
|
f f "make-vm" status-notify ;
|
2009-04-17 21:59:59 -04:00
|
|
|
|
|
|
|
: notify-boot ( -- )
|
2011-09-09 22:33:13 -04:00
|
|
|
"Bootstrapping" print-timestamp
|
2010-04-17 15:51:29 -04:00
|
|
|
f f "boot" status-notify ;
|
2009-04-17 21:59:59 -04:00
|
|
|
|
|
|
|
: notify-test ( -- )
|
2011-09-09 22:33:13 -04:00
|
|
|
"Running tests" print-timestamp
|
2010-04-17 15:51:29 -04:00
|
|
|
f f "test" status-notify ;
|
2009-04-17 21:59:59 -04:00
|
|
|
|
|
|
|
: notify-report ( status -- )
|
2011-09-09 22:33:13 -04:00
|
|
|
[ name>> "Build finished with status: " prepend print-timestamp ]
|
2009-04-17 21:59:59 -04:00
|
|
|
[
|
2010-04-17 15:51:29 -04:00
|
|
|
[ "report" utf8 file-contents ] dip
|
|
|
|
[ name>> "report" status-notify ] [ email-report ] 2bi
|
2009-04-17 21:59:59 -04:00
|
|
|
] bi ;
|
|
|
|
|
2010-09-17 02:43:14 -04:00
|
|
|
: notify-upload ( -- )
|
|
|
|
f f "upload" status-notify ;
|
|
|
|
|
|
|
|
: notify-finish ( -- )
|
|
|
|
f f "finish" status-notify ;
|
|
|
|
|
2009-04-17 21:59:59 -04:00
|
|
|
: notify-release ( archive-name -- )
|
2011-09-09 22:33:13 -04:00
|
|
|
[ "Uploaded " prepend [ print-timestamp ] [ mason-tweet ] bi ]
|
2010-04-17 15:51:29 -04:00
|
|
|
[ f swap "release" status-notify ]
|
2009-05-21 01:08:43 -04:00
|
|
|
bi ;
|