site-watcher uses the db now
Doug Coleman
parent
32678fc4d1
commit
2bb3f782c6
|
|
@ -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.
|
! Copyright (C) 2009 Doug Coleman.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors alarms assocs calendar combinators
|
USING: db.sqlite db.types db.tuples kernel accessors
|
||||||
continuations fry http.client io.streams.string kernel init
|
db io.files io.files.temp locals io.directories continuations
|
||||||
namespaces prettyprint smtp arrays sequences math math.parser
|
assocs sequences alarms namespaces http.client init calendar
|
||||||
strings sets ;
|
math math.parser smtp strings io prettyprint combinators arrays
|
||||||
|
generalizations combinators.smart ;
|
||||||
IN: site-watcher
|
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
|
SYMBOL: site-watcher-from
|
||||||
|
"factor-site-watcher@gmail.com" site-watcher-from set-global
|
||||||
|
|
||||||
sites [ H{ } clone ] initialize
|
SYMBOL: site-watcher-frequency
|
||||||
|
10 seconds site-watcher-frequency set-global
|
||||||
|
|
||||||
TUPLE: watching emails url last-up up? send-email? error ;
|
SYMBOL: running-site-watcher
|
||||||
|
|
||||||
<PRIVATE
|
<PRIVATE
|
||||||
|
|
||||||
: ?1array ( array/object -- array )
|
: set-notify-site-watchers ( site new-up? -- site )
|
||||||
dup array? [ 1array ] unless ; inline
|
[ over up?>> = [ t >>changed? ] unless ] keep >>up? ;
|
||||||
|
|
||||||
: <watching> ( emails url -- watching )
|
: site-good ( site -- )
|
||||||
watching new
|
t set-notify-site-watchers
|
||||||
swap >>url
|
|
||||||
swap ?1array >>emails
|
|
||||||
now >>last-up
|
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
|
f >>error
|
||||||
t set-site-flags
|
f >>last-error
|
||||||
now >>last-up drop ;
|
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
|
[ dup url>> http-get 2drop site-good ] [ site-bad ] recover
|
||||||
] assoc-each ;
|
] each ;
|
||||||
|
|
||||||
: site-up-email ( email watching -- email )
|
: site-up-email ( email site -- email )
|
||||||
last-up>> now swap time- duration>minutes 60 /mod
|
last-up>> now swap time- duration>minutes 60 /mod
|
||||||
[ >integer number>string ] bi@
|
[ >integer number>string ] bi@
|
||||||
[ " hours, " append ] [ " minutes" append ] bi* append
|
[ " hours, " append ] [ " minutes" append ] bi* append
|
||||||
"Site was down for (at least): " prepend >>body ;
|
"Site was down for (at least): " prepend >>body ;
|
||||||
|
|
||||||
: ?unparse ( string/object -- string )
|
: site-down-email ( email site -- email )
|
||||||
dup string? [ unparse ] unless ; inline
|
error>> >>body ;
|
||||||
|
|
||||||
: site-down-email ( email watching -- email )
|
: send-report ( site -- )
|
||||||
error>> ?unparse >>body ;
|
|
||||||
|
|
||||||
: send-report ( watching -- )
|
|
||||||
[ <email> ] dip
|
[ <email> ] dip
|
||||||
{
|
{
|
||||||
[ emails>> >>to ]
|
[ email>> 1array >>to ]
|
||||||
[ drop site-watcher-from get "factor.site.watcher@gmail.com" or >>from ]
|
[ drop site-watcher-from get "factor.site.watcher@gmail.com" or >>from ]
|
||||||
[ dup up?>> [ site-up-email ] [ site-down-email ] if ]
|
[ dup up?>> [ site-up-email ] [ site-down-email ] if ]
|
||||||
[ [ url>> ] [ up?>> "up" "down" ? ] bi " is " glue >>subject ]
|
[ [ url>> ] [ up?>> "up" "down" ? ] bi " is " glue >>subject ]
|
||||||
[ f >>send-email? drop ]
|
|
||||||
} cleave send-email ;
|
} cleave send-email ;
|
||||||
|
|
||||||
: report-sites ( assoc -- )
|
: email-accounts ( seq -- )
|
||||||
[ nip send-email?>> ] assoc-filter
|
[ ] [ [ send-report ] each ] if-empty ;
|
||||||
[ nip send-report ] assoc-each ;
|
|
||||||
|
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>
|
PRIVATE>
|
||||||
|
|
||||||
SYMBOL: site-watcher-frequency
|
: watch-sites ( -- alarm )
|
||||||
site-watcher-frequency [ 5 minutes ] initialize
|
[
|
||||||
|
[
|
||||||
: watch-sites ( assoc -- alarm )
|
f <site> select-tuples check-sites report-sites
|
||||||
'[
|
] with-sqlite-db
|
||||||
_ [ check-sites ] [ report-sites ] bi
|
|
||||||
] site-watcher-frequency get every ;
|
] site-watcher-frequency get every ;
|
||||||
|
|
||||||
: watch-site ( emails url -- )
|
: watch-new-site ( url -- )
|
||||||
sites get ?at [
|
<site> t >>up? insert-tuple ;
|
||||||
[ [ ?1array ] dip append prune ] change-emails drop
|
|
||||||
] [
|
|
||||||
<watching> dup url>> sites get set-at
|
|
||||||
] if ;
|
|
||||||
|
|
||||||
: delete-site ( url -- )
|
: insert-account ( email -- )
|
||||||
sites get delete-at ;
|
<account> insert-tuple ;
|
||||||
|
|
||||||
: 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 ( -- )
|
: run-site-watcher ( -- )
|
||||||
running-site-watcher get-global [
|
running-site-watcher get [
|
||||||
sites get-global watch-sites running-site-watcher set-global
|
watch-sites running-site-watcher set-global
|
||||||
] unless ;
|
] unless ;
|
||||||
|
|
||||||
|
: stop-site-watcher ( -- )
|
||||||
|
running-site-watcher get [ cancel-alarm ] when* ;
|
||||||
|
|
||||||
[ f running-site-watcher set-global ] "site-watcher" add-init-hook
|
[ 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