Working on site-watcher
parent
3f1e6a46e4
commit
2628ddde5e
|
@ -12,8 +12,7 @@ TUPLE: account account-id account-name email ;
|
||||||
swap >>account-name ;
|
swap >>account-name ;
|
||||||
|
|
||||||
account "ACCOUNT" {
|
account "ACCOUNT" {
|
||||||
{ "account-id" "ACCOUNT_ID" +db-assigned-id+ }
|
{ "account-name" "ACCOUNT_NAME" VARCHAR +user-assigned-id+ }
|
||||||
{ "account-name" "ACCOUNT_NAME" VARCHAR }
|
|
||||||
{ "email" "EMAIL" VARCHAR }
|
{ "email" "EMAIL" VARCHAR }
|
||||||
} define-persistent
|
} define-persistent
|
||||||
|
|
||||||
|
@ -33,15 +32,15 @@ site "SITE" {
|
||||||
{ "last-error" "LAST_ERROR" TIMESTAMP }
|
{ "last-error" "LAST_ERROR" TIMESTAMP }
|
||||||
} define-persistent
|
} define-persistent
|
||||||
|
|
||||||
TUPLE: watching-site account-id site-id ;
|
TUPLE: watching-site account-name site-id ;
|
||||||
|
|
||||||
: <watching-site> ( account-id site-id -- watching-site )
|
: <watching-site> ( account-name site-id -- watching-site )
|
||||||
watching-site new
|
watching-site new
|
||||||
swap >>site-id
|
swap >>site-id
|
||||||
swap >>account-id ;
|
swap >>account-name ;
|
||||||
|
|
||||||
watching-site "WATCHING_SITE" {
|
watching-site "WATCHING_SITE" {
|
||||||
{ "account-id" "ACCOUNT_ID" INTEGER +user-assigned-id+ }
|
{ "account-name" "ACCOUNT_NAME" VARCHAR +user-assigned-id+ }
|
||||||
{ "site-id" "SITE_ID" INTEGER +user-assigned-id+ }
|
{ "site-id" "SITE_ID" INTEGER +user-assigned-id+ }
|
||||||
} define-persistent
|
} define-persistent
|
||||||
|
|
||||||
|
@ -71,22 +70,23 @@ TUPLE: reporting-site email url up? changed? last-up? error last-error ;
|
||||||
"update site set changed = 'f';" sql-command ;
|
"update site set changed = 'f';" sql-command ;
|
||||||
|
|
||||||
: insert-site ( url -- site )
|
: insert-site ( url -- site )
|
||||||
<site> dup select-tuple [
|
<site> dup select-tuple [ ] [ dup t >>up? insert-tuple ] ?if ;
|
||||||
dup t >>up? insert-tuple
|
|
||||||
] unless ;
|
|
||||||
|
|
||||||
: insert-account ( account-name -- ) <account> insert-tuple ;
|
: insert-account ( account-name -- ) <account> insert-tuple ;
|
||||||
|
|
||||||
: find-sites ( -- seq ) f <site> select-tuples ;
|
: find-sites ( -- seq ) f <site> select-tuples ;
|
||||||
|
|
||||||
: select-account/site ( email url -- account site )
|
: select-account/site ( username url -- account site )
|
||||||
[ <account> select-tuple account-id>> ]
|
insert-site site-id>> ;
|
||||||
[ insert-site site-id>> ] bi* ;
|
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: watch-site ( email url -- )
|
: watch-site ( username url -- )
|
||||||
select-account/site <watching-site> insert-tuple ;
|
select-account/site <watching-site> insert-tuple ;
|
||||||
|
|
||||||
: unwatch-site ( email url -- )
|
: unwatch-site ( username url -- )
|
||||||
select-account/site <watching-site> delete-tuples ;
|
select-account/site <watching-site> delete-tuples ;
|
||||||
|
|
||||||
|
: watching-sites ( username -- sites )
|
||||||
|
f <watching-site> select-tuples
|
||||||
|
[ site-id>> site new swap >>site-id select-tuple ] map ;
|
|
@ -44,14 +44,13 @@ SYMBOL: running-site-watcher
|
||||||
|
|
||||||
PRIVATE>
|
PRIVATE>
|
||||||
|
|
||||||
: watch-sites ( -- alarm )
|
: watch-sites ( -- )
|
||||||
[
|
find-sites check-sites sites-to-report send-reports ;
|
||||||
find-sites check-sites sites-to-report send-reports
|
|
||||||
] site-watcher-frequency get every ;
|
|
||||||
|
|
||||||
: run-site-watcher ( -- )
|
: run-site-watcher ( -- )
|
||||||
running-site-watcher get [
|
running-site-watcher get [
|
||||||
watch-sites running-site-watcher set-global
|
[ watch-sites ] site-watcher-frequency get every
|
||||||
|
running-site-watcher set-global
|
||||||
] unless ;
|
] unless ;
|
||||||
|
|
||||||
: stop-site-watcher ( -- )
|
: stop-site-watcher ( -- )
|
||||||
|
|
|
@ -0,0 +1,7 @@
|
||||||
|
<?xml version='1.0' ?>
|
||||||
|
|
||||||
|
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||||
|
|
||||||
|
<p>SiteWatcher is a free service for web masters. It periodically tries fetching your web site via HTTP, and sends you an e-mail, SMS or Tweet if this fails. <t:a t:href="$site-watcher-app/list">Sign up now!</t:a></p>
|
||||||
|
|
||||||
|
</t:chloe>
|
|
@ -2,40 +2,31 @@
|
||||||
|
|
||||||
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||||
|
|
||||||
<html>
|
<p> Don't you hate it when your web site goes down, and all your users go buy that <a href="http://en.wikipedia.org/wiki/Slanket">slanket</a> from your competitor instead. Now using SiteWatcher, you can ensure this will never happen again! </p>
|
||||||
<head>
|
|
||||||
<title>SiteWatcher</title>
|
<t:a t:href="$site-watcher-app/update-notify">Contact info</t:a>
|
||||||
</head>
|
|
||||||
<body>
|
<h3>Step 2: add some sites to watch</h3>
|
||||||
<h1>SiteWatcher</h1>
|
|
||||||
<h2>It tells you if your web site goes down.</h2>
|
<t:form t:action="$site-watcher-app/add">
|
||||||
<table>
|
<table>
|
||||||
<t:bind-each t:name="sites">
|
<tr><th>URL:</th><td> <t:field t:name="url" t:size="80" /> <button type="submit">Done</button> </td></tr>
|
||||||
<tr>
|
</table>
|
||||||
<td> <t:label t:name="url" /> </td>
|
</t:form>
|
||||||
<td> <t:button t:action="$site-watcher-app/remove" t:for="url">Remove</t:button> </td>
|
|
||||||
</tr>
|
<h3>Step 3: keep track of your sites</h3>
|
||||||
</t:bind-each>
|
|
||||||
</table>
|
<table border="2">
|
||||||
<p>
|
<tr> <th>URL</th><th></th> </tr>
|
||||||
<t:button t:action="$site-watcher-app/check">Check now</t:button>
|
<t:bind-each t:name="sites">
|
||||||
</p>
|
<tr>
|
||||||
<hr />
|
<td> <t:label t:name="url" /> </td>
|
||||||
<h3>Add a new site</h3>
|
<td> <t:button t:action="$site-watcher-app/remove" t:for="url">Remove</t:button> </td>
|
||||||
<t:form t:action="$site-watcher-app/add">
|
</tr>
|
||||||
<table>
|
</t:bind-each>
|
||||||
<tr>
|
</table>
|
||||||
<th>URL:</th>
|
<p>
|
||||||
<td> <t:field t:name="url" t:size="80" /> </td>
|
<t:button t:action="$site-watcher-app/check">Check now</t:button>
|
||||||
</tr>
|
</p>
|
||||||
<tr>
|
|
||||||
<th>E-mail:</th>
|
|
||||||
<td> <t:field t:name="email" t:size="80" /> </td>
|
|
||||||
</tr>
|
|
||||||
</table>
|
|
||||||
<p> <button type="submit">Done</button> </p>
|
|
||||||
</t:form>
|
|
||||||
</body>
|
|
||||||
</html>
|
|
||||||
|
|
||||||
</t:chloe>
|
</t:chloe>
|
||||||
|
|
|
@ -1,31 +1,51 @@
|
||||||
! Copyright (C) 2009 Slava Pestov.
|
! Copyright (C) 2009 Slava Pestov.
|
||||||
! See http://factorcode.org/license.txt for BSD license.
|
! See http://factorcode.org/license.txt for BSD license.
|
||||||
USING: accessors furnace.actions furnace.alloy furnace.redirection
|
USING: accessors assocs db.sqlite furnace.actions furnace.alloy
|
||||||
html.forms http.server http.server.dispatchers namespaces site-watcher
|
furnace.auth furnace.auth.features.deactivate-user
|
||||||
site-watcher.private kernel urls validators db.sqlite assocs ;
|
furnace.auth.features.edit-profile
|
||||||
|
furnace.auth.features.recover-password
|
||||||
|
furnace.auth.features.registration furnace.auth.login
|
||||||
|
furnace.boilerplate furnace.redirection html.forms http.server
|
||||||
|
http.server.dispatchers kernel namespaces site-watcher site-watcher.db
|
||||||
|
site-watcher.private urls validators io.sockets.secure.unix.debug
|
||||||
|
io.servers.connection db db.tuples sequences ;
|
||||||
|
QUALIFIED: assocs
|
||||||
IN: webapps.site-watcher
|
IN: webapps.site-watcher
|
||||||
|
|
||||||
TUPLE: site-watcher-app < dispatcher ;
|
TUPLE: site-watcher-app < dispatcher ;
|
||||||
|
|
||||||
CONSTANT: site-list-url URL" $site-watcher-app/"
|
CONSTANT: site-list-url URL" $site-watcher-app/"
|
||||||
|
|
||||||
|
: <main-action> ( -- action )
|
||||||
|
<page-action>
|
||||||
|
[
|
||||||
|
logged-in?
|
||||||
|
[ URL" $site-watcher-app/list" <redirect> ]
|
||||||
|
[ { site-watcher-app "main" } <chloe-content> ] if
|
||||||
|
] >>display ;
|
||||||
|
|
||||||
: <site-list-action> ( -- action )
|
: <site-list-action> ( -- action )
|
||||||
<page-action>
|
<page-action>
|
||||||
{ site-watcher-app "site-list" } >>template
|
{ site-watcher-app "site-list" } >>template
|
||||||
[
|
[
|
||||||
begin-form
|
! Silly query
|
||||||
sites get values "sites" set-value
|
username watching-sites
|
||||||
] >>init ;
|
"sites" set-value
|
||||||
|
] >>init
|
||||||
|
<protected>
|
||||||
|
"list watched sites" >>description ;
|
||||||
|
|
||||||
: <add-site-action> ( -- action )
|
: <add-site-action> ( -- action )
|
||||||
<action>
|
<action>
|
||||||
[
|
[
|
||||||
{ { "url" [ v-url ] } { "email" [ v-email ] } } validate-params
|
{ { "url" [ v-url ] } } validate-params
|
||||||
] >>validate
|
] >>validate
|
||||||
[
|
[
|
||||||
"email" value "url" value watch-site
|
username "url" value watch-site
|
||||||
site-list-url <redirect>
|
site-list-url <redirect>
|
||||||
] >>submit ;
|
] >>submit
|
||||||
|
<protected>
|
||||||
|
"add a watched site" >>description ;
|
||||||
|
|
||||||
: <remove-site-action> ( -- action )
|
: <remove-site-action> ( -- action )
|
||||||
<action>
|
<action>
|
||||||
|
@ -33,22 +53,79 @@ CONSTANT: site-list-url URL" $site-watcher-app/"
|
||||||
{ { "url" [ v-url ] } } validate-params
|
{ { "url" [ v-url ] } } validate-params
|
||||||
] >>validate
|
] >>validate
|
||||||
[
|
[
|
||||||
"url" value delete-site
|
username "url" value unwatch-site
|
||||||
site-list-url <redirect>
|
site-list-url <redirect>
|
||||||
] >>submit ;
|
] >>submit
|
||||||
|
<protected>
|
||||||
|
"remove a watched site" >>description ;
|
||||||
|
|
||||||
: <check-sites-action> ( -- action )
|
: <check-sites-action> ( -- action )
|
||||||
<action>
|
<action>
|
||||||
[
|
[
|
||||||
sites get [ check-sites ] [ report-sites ] bi
|
watch-sites
|
||||||
site-list-url <redirect>
|
site-list-url <redirect>
|
||||||
] >>submit ;
|
] >>submit
|
||||||
|
<protected>
|
||||||
|
"check watched sites" >>description ;
|
||||||
|
|
||||||
|
: <update-notify-action> ( -- action )
|
||||||
|
<page-action>
|
||||||
|
[
|
||||||
|
username <account> select-tuple from-object
|
||||||
|
] >>init
|
||||||
|
{ site-watcher-app "update-notify" } >>template
|
||||||
|
[
|
||||||
|
{
|
||||||
|
{ "email" [ [ v-email ] v-optional ] }
|
||||||
|
{ "twitter" [ [ v-one-word ] v-optional ] }
|
||||||
|
{ "sms" [ [ v-one-line ] v-optional ] }
|
||||||
|
} validate-params
|
||||||
|
] >>validate
|
||||||
|
[
|
||||||
|
username <account> select-tuple
|
||||||
|
"email" value >>email
|
||||||
|
update-tuple
|
||||||
|
site-list-url <redirect>
|
||||||
|
] >>submit
|
||||||
|
<protected>
|
||||||
|
"update notification details" >>description ;
|
||||||
|
|
||||||
: <site-watcher-app> ( -- dispatcher )
|
: <site-watcher-app> ( -- dispatcher )
|
||||||
site-watcher-app new-dispatcher
|
site-watcher-app new-dispatcher
|
||||||
<site-list-action> "" add-responder
|
<main-action> "" add-responder
|
||||||
|
<site-list-action> "list" add-responder
|
||||||
<add-site-action> "add" add-responder
|
<add-site-action> "add" add-responder
|
||||||
<remove-site-action> "remove" add-responder
|
<remove-site-action> "remove" add-responder
|
||||||
<check-sites-action> "check" add-responder ;
|
<check-sites-action> "check" add-responder
|
||||||
|
<update-notify-action> "update-notify" add-responder ;
|
||||||
|
|
||||||
<site-watcher-app> "resource:test.db" <sqlite-db> <alloy> main-responder set-global
|
: <login-config> ( responder -- responder' )
|
||||||
|
"SiteWatcher" <login-realm>
|
||||||
|
"SiteWatcher" >>name
|
||||||
|
allow-registration
|
||||||
|
allow-password-recovery
|
||||||
|
allow-edit-profile
|
||||||
|
allow-deactivation ;
|
||||||
|
|
||||||
|
: <site-watcher-server> ( -- threaded-server )
|
||||||
|
<http-server>
|
||||||
|
<test-secure-config> >>secure-config
|
||||||
|
8081 >>insecure
|
||||||
|
8431 >>secure ;
|
||||||
|
|
||||||
|
: site-watcher-db ( -- db )
|
||||||
|
"resource:test.db" <sqlite-db> ;
|
||||||
|
|
||||||
|
<site-watcher-app>
|
||||||
|
<login-config>
|
||||||
|
<boilerplate> { site-watcher-app "site-watcher" } >>template
|
||||||
|
site-watcher-db <alloy>
|
||||||
|
main-responder set-global
|
||||||
|
|
||||||
|
: start-site-watcher ( -- )
|
||||||
|
<site-watcher-server> start-server ;
|
||||||
|
|
||||||
|
: init-db ( -- )
|
||||||
|
site-watcher-db [
|
||||||
|
{ site account watching-site } [ ensure-table ] each
|
||||||
|
] with-db ;
|
|
@ -0,0 +1,16 @@
|
||||||
|
<?xml version='1.0' ?>
|
||||||
|
|
||||||
|
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||||
|
|
||||||
|
<html>
|
||||||
|
<head>
|
||||||
|
<title>SiteWatcher</title>
|
||||||
|
</head>
|
||||||
|
<body>
|
||||||
|
<h1>SiteWatcher</h1>
|
||||||
|
<h2>It tells you if your web site goes down.</h2>
|
||||||
|
<t:call-next-template />
|
||||||
|
</body>
|
||||||
|
</html>
|
||||||
|
|
||||||
|
</t:chloe>
|
|
@ -0,0 +1,16 @@
|
||||||
|
<?xml version='1.0' ?>
|
||||||
|
|
||||||
|
<t:chloe xmlns:t="http://factorcode.org/chloe/1.0">
|
||||||
|
|
||||||
|
<h3>Enter your contact details</h3>
|
||||||
|
|
||||||
|
<t:form t:action="$site-watcher-app/update-notify">
|
||||||
|
<table>
|
||||||
|
<tr><th>E-mail:</th><td><t:field t:name="email" t:size="80" /></td></tr>
|
||||||
|
<tr><th>Twitter:</th><td><t:field t:name="twitter" t:size="80" /></td></tr>
|
||||||
|
<tr><th>SMS:</th><td><t:field t:name="sms" t:size="80" /></td></tr>
|
||||||
|
</table>
|
||||||
|
<p> <button type="submit">Done</button> </p>
|
||||||
|
</t:form>
|
||||||
|
|
||||||
|
</t:chloe>
|
Loading…
Reference in New Issue