1 ! Copyright (C) 2009 Doug Coleman.
2 ! See http://factorcode.org/license.txt for BSD license.
3 USING: accessors alarms assocs calendar combinators
4 continuations fry http.client io.streams.string kernel init
5 namespaces prettyprint smtp arrays sequences math math.parser
11 SYMBOL: site-watcher-from
13 sites [ H{ } clone ] initialize
15 TUPLE: watching emails url last-up up? send-email? error ;
19 : ?1array ( array/object -- array )
20 dup array? [ 1array ] unless ; inline
22 : <watching> ( emails url -- watching )
29 ERROR: not-watching-site url status ;
31 : set-site-flags ( watching new-up? -- watching )
32 [ over up?>> = [ t >>send-email? ] unless ] keep >>up? ;
34 : site-bad ( watching error -- )
35 >>error f set-site-flags drop ;
37 : site-good ( watching -- )
42 : check-sites ( assoc -- )
44 swap '[ _ http-get 2drop site-good ] [ site-bad ] recover
47 : site-up-email ( email watching -- email )
48 last-up>> now swap time- duration>minutes 60 /mod
49 [ >integer number>string ] bi@
50 [ " hours, " append ] [ " minutes" append ] bi* append
51 "Site was down for (at least): " prepend >>body ;
53 : ?unparse ( string/object -- string )
54 dup string? [ unparse ] unless ; inline
56 : site-down-email ( email watching -- email )
57 error>> ?unparse >>body ;
59 : send-report ( watching -- )
63 [ drop site-watcher-from get "factor.site.watcher@gmail.com" or >>from ]
64 [ dup up?>> [ site-up-email ] [ site-down-email ] if ]
65 [ [ url>> ] [ up?>> "up" "down" ? ] bi " is " glue >>subject ]
66 [ f >>send-email? drop ]
69 : report-sites ( assoc -- )
70 [ nip send-email?>> ] assoc-filter
71 [ nip send-report ] assoc-each ;
75 SYMBOL: site-watcher-frequency
76 site-watcher-frequency [ 5 minutes ] initialize
78 : watch-sites ( assoc -- alarm )
80 _ [ check-sites ] [ report-sites ] bi
81 ] site-watcher-frequency get every ;
83 : watch-site ( emails url -- )
85 [ [ ?1array ] dip append prune ] change-emails drop
87 <watching> dup url>> sites get set-at
90 : delete-site ( url -- )
93 : unwatch-site ( emails url -- )
96 [ diff ] change-emails dup emails>> empty? [
105 SYMBOL: running-site-watcher
107 : run-site-watcher ( -- )
108 running-site-watcher get-global [
109 sites get-global watch-sites running-site-watcher set-global
112 [ f running-site-watcher set-global ] "site-watcher" add-init-hook
114 MAIN: run-site-watcher