1 ! Copyright (C) 2008, 2010 Eduardo Cavazos, Slava Pestov.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors calendar combinators continuations debugger fry
4 io kernel make mason.common mason.config mason.platform
5 math.order namespaces sequences smtp ;
8 : mason-email ( body content-type subject -- )
11 builder-from get >>from
12 builder-recipients get >>to
18 "E-MAILING FAILED:" print-timestamp
22 : subject-prefix ( -- string )
23 "mason on " platform ": " 3append ;
25 : report-subject ( status -- string )
28 current-git-id get 7 short head %
31 { status-clean [ "clean" ] }
32 { status-dirty [ "dirty" ] }
33 { status-error [ "error" ] }
37 : email-report ( report status -- )
38 [ "text/html" ] dip report-subject mason-email ;
40 ! Some special logic to throttle the amount of fatal errors
41 ! coming in, if eg git-daemon goes down on factorcode.org and
42 ! it fails pulling every 5 minutes.
44 SYMBOL: last-email-time
46 SYMBOL: next-email-time
48 : send-email-throttled? ( -- ? )
49 ! We sent too many errors. See if its time to send a new
51 now next-email-time get-global after?
52 [ f next-email-time set-global t ] [ f ] if ;
54 : throttle-time ( -- dt ) 6 hours ;
56 : throttle-emails ( -- )
57 ! Last e-mail was less than 20 minutes ago. Don't send any
59 throttle-time hence next-email-time set-global
60 f last-email-time set-global ;
62 : maximum-frequency ( -- dt ) 30 minutes ;
64 : send-email-capped? ( -- ? )
65 ! We're about to send an error after sending another one.
66 ! See if we should start throttling emails.
67 last-email-time get-global
70 [ throttle-emails f ] [ t ] if ;
72 : email-fatal? ( -- ? )
74 { [ next-email-time get-global ] [ send-email-throttled? ] }
75 { [ last-email-time get-global ] [ send-email-capped? ] }
76 [ now last-email-time set-global t ]
78 dup [ now last-email-time set-global ] when ;
80 : email-fatal ( string subject -- )
81 [ print nl print flush ]
84 now last-email-time set-global
85 [ "text/plain" subject-prefix ] dip append