From 3c6ceb1891de419011d6e779e5de5ea62300678b Mon Sep 17 00:00:00 2001 From: Doug Coleman Date: Sat, 14 Mar 2009 10:53:51 -0500 Subject: [PATCH] initial checkin of site-watcher --- extra/site-watcher/authors.txt | 1 + extra/site-watcher/site-watcher-docs.factor | 60 +++++++++++ extra/site-watcher/site-watcher.factor | 114 ++++++++++++++++++++ 3 files changed, 175 insertions(+) create mode 100644 extra/site-watcher/authors.txt create mode 100644 extra/site-watcher/site-watcher-docs.factor create mode 100644 extra/site-watcher/site-watcher.factor diff --git a/extra/site-watcher/authors.txt b/extra/site-watcher/authors.txt new file mode 100644 index 0000000000..7c1b2f2279 --- /dev/null +++ b/extra/site-watcher/authors.txt @@ -0,0 +1 @@ +Doug Coleman diff --git a/extra/site-watcher/site-watcher-docs.factor b/extra/site-watcher/site-watcher-docs.factor new file mode 100644 index 0000000000..37a1cf138d --- /dev/null +++ b/extra/site-watcher/site-watcher-docs.factor @@ -0,0 +1,60 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: assocs help.markup help.syntax kernel urls alarms calendar ; +IN: site-watcher + +HELP: run-site-watcher +{ $description "Starts the site-watcher on the assoc stored in " { $link sites } "." } ; + +HELP: running-site-watcher +{ $var-description "A symbol storing the alarm of a running site-watcher if started with the " { $link run-site-watcher } " word. To prevent multiple site-watchers from running, this variable is checked before allowing another site-watcher to start." } ; + +HELP: site-watcher-from +{ $var-description "The email address from which site-watcher sends emails." } ; + +HELP: sites +{ $var-description "A symbol storing an assoc of URLs, data about a site, and who to notify if a site goes down." } ; + +HELP: watch-site +{ $values + { "emails" "a string containing an email address, or an array of such" } + { "url" url } +} +{ $description "Adds a new site to the watch assoc stored in " { $link sites } ", or adds email addresses to an already watched site." } ; + +HELP: watch-sites +{ $values + { "assoc" assoc } + { "alarm" alarm } +} +{ $description "Runs the site-watcher on the input assoc and returns the alarm that times the site check loop. This alarm may be turned off with " { $link cancel-alarm } ", thus stopping the site-watcher." } ; + +HELP: site-watcher-frequency +{ $var-description "A " { $link duration } " specifying how long to wait between checking sites." } ; + +HELP: unwatch-site +{ $values + { "emails" "a string containing an email, or an array of such" } + { "url" url } +} +{ $description "Removes an email address from being notified when a site's goes down. If this email was the last one watching the site, removes the site as well." } ; + +HELP: delete-site +{ $values + { "url" url } +} +{ $description "Removes a watched site from the " { $link sites } " assoc." } ; + +ARTICLE: "site-watcher" "Site watcher" +"The " { $vocab-link "site-watcher" } " vocabulary monitors websites and sends email when a site goes down or comes up." $nl +"To monitor a site:" +{ $subsection watch-site } +"To stop email addresses from being notified if a site's status changes:" +{ $subsection unwatch-site } +"To stop monitoring a site for all email addresses:" +{ $subsection delete-site } +"To run site-watcher using the sites variable:" +{ $subsection run-site-watcher } +; + +ABOUT: "site-watcher" diff --git a/extra/site-watcher/site-watcher.factor b/extra/site-watcher/site-watcher.factor new file mode 100644 index 0000000000..c538b12ed1 --- /dev/null +++ b/extra/site-watcher/site-watcher.factor @@ -0,0 +1,114 @@ +! Copyright (C) 2009 Doug Coleman. +! See http://factorcode.org/license.txt for BSD license. +USING: accessors alarms assocs calendar combinators +continuations fry http.client io.streams.string kernel init +namespaces prettyprint smtp arrays sequences math math.parser +strings sets ; +IN: site-watcher + +SYMBOL: sites + +SYMBOL: site-watcher-from + +sites [ H{ } clone ] initialize + +TUPLE: watching emails url last-up up? send-email? error ; + + ( emails url -- watching ) + watching new + swap >>url + swap ?1array >>emails + now >>last-up + t >>up? ; + +ERROR: not-watching-site url status ; + +: set-site-flags ( watching new-up? -- watching ) + [ over up?>> = [ t >>send-email? ] unless ] keep >>up? ; + +: site-bad ( watching error -- ) + >>error f set-site-flags drop ; + +: site-good ( watching -- ) + f >>error + t set-site-flags + now >>last-up drop ; + +: check-sites ( assoc -- ) + [ + swap '[ _ http-get 2drop site-good ] [ site-bad ] recover + ] assoc-each ; + +: site-up-email ( email watching -- email ) + last-up>> now swap time- duration>minutes 60 /mod + [ >integer number>string ] bi@ + [ " hours, " append ] [ " minutes" append ] bi* append + "Site was down for (at least): " prepend >>body ; + +: ?unparse ( string/object -- string ) + dup string? [ unparse ] unless ; inline + +: site-down-email ( email watching -- email ) + error>> ?unparse >>body ; + +: send-report ( watching -- ) + [ ] dip + { + [ emails>> >>to ] + [ drop site-watcher-from get "factor.site.watcher@gmail.com" or >>from ] + [ dup up?>> [ site-up-email ] [ site-down-email ] if ] + [ [ url>> ] [ up?>> "up" "down" ? ] bi " is " glue >>subject ] + [ f >>send-email? drop ] + } cleave send-email ; + +: report-sites ( assoc -- ) + [ nip send-email?>> ] assoc-filter + [ nip send-report ] assoc-each ; + +PRIVATE> + +SYMBOL: site-watcher-frequency +site-watcher-frequency [ 5 minutes ] initialize + +: watch-sites ( assoc -- alarm ) + '[ + _ [ check-sites ] [ report-sites ] bi + ] site-watcher-frequency get every ; + +: watch-site ( emails url -- ) + sites get ?at [ + [ [ ?1array ] dip append prune ] change-emails drop + ] [ + dup url>> sites get set-at + ] if ; + +: delete-site ( url -- ) + sites get delete-at ; + +: unwatch-site ( emails url -- ) + [ ?1array ] dip + sites get ?at [ + [ diff ] change-emails dup emails>> empty? [ + url>> delete-site + ] [ + drop + ] if + ] [ + nip delete-site + ] if ; + +SYMBOL: running-site-watcher + +: run-site-watcher ( -- ) + running-site-watcher get-global [ + sites get-global watch-sites running-site-watcher set-global + ] unless ; + +[ f running-site-watcher set-global ] "site-watcher" add-init-hook + +MAIN: run-site-watcher