diff --git a/extra/site-watcher/authors.txt b/extra/site-watcher/authors.txt index 7c1b2f2279..b4bd0e7b35 100644 --- a/extra/site-watcher/authors.txt +++ b/extra/site-watcher/authors.txt @@ -1 +1 @@ -Doug Coleman +Doug Coleman \ No newline at end of file diff --git a/extra/site-watcher/site-watcher-docs.factor b/extra/site-watcher/site-watcher-docs.factor deleted file mode 100644 index 37a1cf138d..0000000000 --- a/extra/site-watcher/site-watcher-docs.factor +++ /dev/null @@ -1,60 +0,0 @@ -! 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 index c538b12ed1..f1e7acbb5a 100644 --- a/extra/site-watcher/site-watcher.factor +++ b/extra/site-watcher/site-watcher.factor @@ -1,114 +1,166 @@ ! 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 ; +USING: db.sqlite db.types db.tuples kernel accessors +db io.files io.files.temp locals io.directories continuations +assocs sequences alarms namespaces http.client init calendar +math math.parser smtp strings io prettyprint combinators arrays +generalizations combinators.smart ; IN: site-watcher -SYMBOL: sites +: ?unparse ( string/object -- string ) + dup string? [ unparse ] unless ; inline + +: site-watcher-path ( -- path ) "site-watcher.db" temp-file ; inline + +[ site-watcher-path delete-file ] ignore-errors + +: with-sqlite-db ( quot -- ) + site-watcher-path swap with-db ; inline + +TUPLE: account account-id email ; + +: ( email -- account ) + account new + swap >>email ; + +account "ACCOUNT" { + { "account-id" "ACCOUNT_ID" +db-assigned-id+ } + { "email" "EMAIL" VARCHAR } +} define-persistent + +TUPLE: site site-id url up? changed? last-up error last-error ; + +: ( url -- site ) + site new + swap >>url ; + +site "SITE" { + { "site-id" "SITE_ID" INTEGER +db-assigned-id+ } + { "url" "URL" VARCHAR } + { "up?" "UP" BOOLEAN } + { "changed?" "CHANGED" BOOLEAN } + { "last-up" "LAST_UP" TIMESTAMP } + { "error" "ERROR" VARCHAR } + { "last-error" "LAST_ERROR" TIMESTAMP } +} define-persistent + +TUPLE: watching-site account-id site-id ; + +: ( account-id site-id -- watching-site ) + watching-site new + swap >>site-id + swap >>account-id ; + +watching-site "WATCHING_SITE" { + { "account-id" "ACCOUNT_ID" INTEGER +user-assigned-id+ } + { "site-id" "SITE_ID" INTEGER +user-assigned-id+ } +} define-persistent + +: select-account/site ( email url -- account site ) + [ select-tuple account-id>> ] + [ select-tuple site-id>> ] bi* ; + +: watch-site ( email url -- ) + select-account/site insert-tuple ; + +: unwatch-site ( email url -- ) + select-account/site delete-tuples ; SYMBOL: site-watcher-from +"factor-site-watcher@gmail.com" site-watcher-from set-global -sites [ H{ } clone ] initialize - -TUPLE: watching emails url last-up up? send-email? error ; +SYMBOL: site-watcher-frequency +10 seconds site-watcher-frequency set-global + +SYMBOL: running-site-watcher > = [ t >>changed? ] unless ] keep >>up? ; -: ( 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 -- ) +: site-good ( site -- ) + t set-notify-site-watchers + now >>last-up f >>error - t set-site-flags - now >>last-up drop ; + f >>last-error + update-tuple ; -: check-sites ( assoc -- ) +: site-bad ( site error -- ) + ?unparse >>error + f set-notify-site-watchers + now >>last-error + update-tuple ; + +: check-sites ( seq -- ) [ - swap '[ _ http-get 2drop site-good ] [ site-bad ] recover - ] assoc-each ; + [ dup url>> http-get 2drop site-good ] [ site-bad ] recover + ] each ; -: site-up-email ( email watching -- email ) +: site-up-email ( email site -- 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 site -- email ) + error>> >>body ; -: site-down-email ( email watching -- email ) - error>> ?unparse >>body ; - -: send-report ( watching -- ) +: send-report ( site -- ) [ ] dip { - [ emails>> >>to ] + [ email>> 1array >>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 ; +: email-accounts ( seq -- ) + [ ] [ [ send-report ] each ] if-empty ; + +TUPLE: reporting-site email url up? changed? last-up? error last-error ; + +: report-sites ( -- ) + "select account.email, site.url, site.up, site.changed, site.last_up, site.error, site.last_error from account, site, watching_site where account.account_id = watching_site.account_id and site.site_id = watching_site.site_id and site.changed = '1'" sql-query + [ [ reporting-site boa ] input -SYMBOL: site-watcher-frequency -site-watcher-frequency [ 5 minutes ] initialize - -: watch-sites ( assoc -- alarm ) - '[ - _ [ check-sites ] [ report-sites ] bi +: watch-sites ( -- alarm ) + [ + [ + f select-tuples check-sites report-sites + ] with-sqlite-db ] 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 ; +: watch-new-site ( url -- ) + t >>up? insert-tuple ; -: 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 +: insert-account ( email -- ) + insert-tuple ; : run-site-watcher ( -- ) - running-site-watcher get-global [ - sites get-global watch-sites running-site-watcher set-global + running-site-watcher get [ + watch-sites running-site-watcher set-global ] unless ; +: stop-site-watcher ( -- ) + running-site-watcher get [ cancel-alarm ] when* ; + [ f running-site-watcher set-global ] "site-watcher" add-init-hook -MAIN: run-site-watcher + +:: fake-sites ( -- seq ) + [ + account ensure-table + site ensure-table + watching-site ensure-table + + "erg@factorcode.org" insert-account + "http://asdfasdfasdfasdfqwerqqq.com" watch-new-site + "http://fark.com" watch-new-site + + "erg@factorcode.org" "http://asdfasdfasdfasdfqwerqqq.com" watch-site + f select-tuples + ] with-sqlite-db ;