Working on site-watcher
Slava Pestov
parent
3f1e6a46e4
commit
2628ddde5e
|
|
@ -12,8 +12,7 @@ TUPLE: account account-id account-name email ;
|
|||
swap >>account-name ;
|
||||
|
||||
account "ACCOUNT" {
|
||||
{ "account-id" "ACCOUNT_ID" +db-assigned-id+ }
|
||||
{ "account-name" "ACCOUNT_NAME" VARCHAR }
|
||||
{ "account-name" "ACCOUNT_NAME" VARCHAR +user-assigned-id+ }
|
||||
{ "email" "EMAIL" VARCHAR }
|
||||
} define-persistent
|
||||
|
||||
|
|
@ -33,15 +32,15 @@ site "SITE" {
|
|||
{ "last-error" "LAST_ERROR" TIMESTAMP }
|
||||
} 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
|
||||
swap >>site-id
|
||||
swap >>account-id ;
|
||||
swap >>account-name ;
|
||||
|
||||
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+ }
|
||||
} 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 ;
|
||||
|
||||
: insert-site ( url -- site )
|
||||
<site> dup select-tuple [
|
||||
dup t >>up? insert-tuple
|
||||
] unless ;
|
||||
<site> dup select-tuple [ ] [ dup t >>up? insert-tuple ] ?if ;
|
||||
|
||||
: insert-account ( account-name -- ) <account> insert-tuple ;
|
||||
|
||||
: find-sites ( -- seq ) f <site> select-tuples ;
|
||||
|
||||
: select-account/site ( email url -- account site )
|
||||
[ <account> select-tuple account-id>> ]
|
||||
[ insert-site site-id>> ] bi* ;
|
||||
: select-account/site ( username url -- account site )
|
||||
insert-site site-id>> ;
|
||||
|
||||
PRIVATE>
|
||||
|
||||
: watch-site ( email url -- )
|
||||
: watch-site ( username url -- )
|
||||
select-account/site <watching-site> insert-tuple ;
|
||||
|
||||
: unwatch-site ( email url -- )
|
||||
: unwatch-site ( username url -- )
|
||||
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>
|
||||
|
||||
: watch-sites ( -- alarm )
|
||||
[
|
||||
find-sites check-sites sites-to-report send-reports
|
||||
] site-watcher-frequency get every ;
|
||||
: watch-sites ( -- )
|
||||
find-sites check-sites sites-to-report send-reports ;
|
||||
|
||||
: run-site-watcher ( -- )
|
||||
running-site-watcher get [
|
||||
watch-sites running-site-watcher set-global
|
||||
[ watch-sites ] site-watcher-frequency get every
|
||||
running-site-watcher set-global
|
||||
] unless ;
|
||||
|
||||
: 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">
|
||||
|
||||
<html>
|
||||
<head>
|
||||
<title>SiteWatcher</title>
|
||||
</head>
|
||||
<body>
|
||||
<h1>SiteWatcher</h1>
|
||||
<h2>It tells you if your web site goes down.</h2>
|
||||
<table>
|
||||
<t:bind-each t:name="sites">
|
||||
<tr>
|
||||
<td> <t:label t:name="url" /> </td>
|
||||
<td> <t:button t:action="$site-watcher-app/remove" t:for="url">Remove</t:button> </td>
|
||||
</tr>
|
||||
</t:bind-each>
|
||||
</table>
|
||||
<p>
|
||||
<t:button t:action="$site-watcher-app/check">Check now</t:button>
|
||||
</p>
|
||||
<hr />
|
||||
<h3>Add a new site</h3>
|
||||
<t:form t:action="$site-watcher-app/add">
|
||||
<table>
|
||||
<tr>
|
||||
<th>URL:</th>
|
||||
<td> <t:field t:name="url" t:size="80" /> </td>
|
||||
</tr>
|
||||
<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>
|
||||
<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>
|
||||
|
||||
<t:a t:href="$site-watcher-app/update-notify">Contact info</t:a>
|
||||
|
||||
<h3>Step 2: add some sites to watch</h3>
|
||||
|
||||
<t:form t:action="$site-watcher-app/add">
|
||||
<table>
|
||||
<tr><th>URL:</th><td> <t:field t:name="url" t:size="80" /> <button type="submit">Done</button> </td></tr>
|
||||
</table>
|
||||
</t:form>
|
||||
|
||||
<h3>Step 3: keep track of your sites</h3>
|
||||
|
||||
<table border="2">
|
||||
<tr> <th>URL</th><th></th> </tr>
|
||||
<t:bind-each t:name="sites">
|
||||
<tr>
|
||||
<td> <t:label t:name="url" /> </td>
|
||||
<td> <t:button t:action="$site-watcher-app/remove" t:for="url">Remove</t:button> </td>
|
||||
</tr>
|
||||
</t:bind-each>
|
||||
</table>
|
||||
<p>
|
||||
<t:button t:action="$site-watcher-app/check">Check now</t:button>
|
||||
</p>
|
||||
|
||||
</t:chloe>
|
||||
|
|
|
|||
|
|
@ -1,31 +1,51 @@
|
|||
! Copyright (C) 2009 Slava Pestov.
|
||||
! See http://factorcode.org/license.txt for BSD license.
|
||||
USING: accessors furnace.actions furnace.alloy furnace.redirection
|
||||
html.forms http.server http.server.dispatchers namespaces site-watcher
|
||||
site-watcher.private kernel urls validators db.sqlite assocs ;
|
||||
USING: accessors assocs db.sqlite furnace.actions furnace.alloy
|
||||
furnace.auth furnace.auth.features.deactivate-user
|
||||
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
|
||||
|
||||
TUPLE: site-watcher-app < dispatcher ;
|
||||
|
||||
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 )
|
||||
<page-action>
|
||||
{ site-watcher-app "site-list" } >>template
|
||||
[
|
||||
begin-form
|
||||
sites get values "sites" set-value
|
||||
] >>init ;
|
||||
! Silly query
|
||||
username watching-sites
|
||||
"sites" set-value
|
||||
] >>init
|
||||
<protected>
|
||||
"list watched sites" >>description ;
|
||||
|
||||
: <add-site-action> ( -- action )
|
||||
<action>
|
||||
[
|
||||
{ { "url" [ v-url ] } { "email" [ v-email ] } } validate-params
|
||||
{ { "url" [ v-url ] } } validate-params
|
||||
] >>validate
|
||||
[
|
||||
"email" value "url" value watch-site
|
||||
username "url" value watch-site
|
||||
site-list-url <redirect>
|
||||
] >>submit ;
|
||||
] >>submit
|
||||
<protected>
|
||||
"add a watched site" >>description ;
|
||||
|
||||
: <remove-site-action> ( -- action )
|
||||
<action>
|
||||
|
|
@ -33,22 +53,79 @@ CONSTANT: site-list-url URL" $site-watcher-app/"
|
|||
{ { "url" [ v-url ] } } validate-params
|
||||
] >>validate
|
||||
[
|
||||
"url" value delete-site
|
||||
username "url" value unwatch-site
|
||||
site-list-url <redirect>
|
||||
] >>submit ;
|
||||
] >>submit
|
||||
<protected>
|
||||
"remove a watched site" >>description ;
|
||||
|
||||
: <check-sites-action> ( -- action )
|
||||
<action>
|
||||
[
|
||||
sites get [ check-sites ] [ report-sites ] bi
|
||||
watch-sites
|
||||
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 new-dispatcher
|
||||
<site-list-action> "" add-responder
|
||||
<main-action> "" add-responder
|
||||
<site-list-action> "list" add-responder
|
||||
<add-site-action> "add" 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