site-watcher uses the db now
Doug Coleman
parent
32678fc4d1
commit
2bb3f782c6
|
|
@ -1 +1 @@
|
|||
Doug Coleman
|
||||
Doug Coleman
|
||||
|
|
@ -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"
|
||||
|
|
@ -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 <sqlite-db> swap with-db ; inline
|
||||
|
||||
TUPLE: account account-id email ;
|
||||
|
||||
: <account> ( 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 ;
|
||||
|
||||
: <site> ( 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 ;
|
||||
|
||||
: <watching-site> ( 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 )
|
||||
[ <account> select-tuple account-id>> ]
|
||||
[ <site> select-tuple site-id>> ] bi* ;
|
||||
|
||||
: watch-site ( email url -- )
|
||||
select-account/site <watching-site> insert-tuple ;
|
||||
|
||||
: unwatch-site ( email url -- )
|
||||
select-account/site <watching-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
|
||||
|
||||
<PRIVATE
|
||||
|
||||
: ?1array ( array/object -- array )
|
||||
dup array? [ 1array ] unless ; inline
|
||||
: set-notify-site-watchers ( site new-up? -- site )
|
||||
[ over up?>> = [ t >>changed? ] unless ] keep >>up? ;
|
||||
|
||||
: <watching> ( 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 -- )
|
||||
[ <email> ] 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<sequence ] map email-accounts
|
||||
"update site set changed = 'f';" sql-command ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
SYMBOL: site-watcher-frequency
|
||||
site-watcher-frequency [ 5 minutes ] initialize
|
||||
|
||||
: watch-sites ( assoc -- alarm )
|
||||
'[
|
||||
_ [ check-sites ] [ report-sites ] bi
|
||||
: watch-sites ( -- alarm )
|
||||
[
|
||||
[
|
||||
f <site> 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
|
||||
] [
|
||||
<watching> dup url>> sites get set-at
|
||||
] if ;
|
||||
: watch-new-site ( url -- )
|
||||
<site> 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 -- )
|
||||
<account> 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 <site> select-tuples
|
||||
] with-sqlite-db ;
|
||||
|
|
|
|||
Loading…
Reference in New Issue