2009-03-14 11:53:51 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! Copyright (C) 2009 Doug Coleman.
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								! See http://factorcode.org/license.txt for BSD license.
							 | 
						
					
						
							
								
									
										
										
										
											2010-06-10 17:39:13 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								USING: accessors timers arrays calendar combinators
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-19 17:48:32 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								combinators.smart continuations debugger http.client fry
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								init io.streams.string kernel locals math math.parser db
							 | 
						
					
						
							
								
									
										
										
										
											2009-04-06 18:49:34 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								namespaces sequences site-watcher.db site-watcher.email ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-14 11:53:51 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								IN: site-watcher
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-18 18:07:46 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								SYMBOL: site-watcher-frequency
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-19 18:05:08 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								5 minutes site-watcher-frequency set-global
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-18 18:07:46 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								 
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								SYMBOL: running-site-watcher
							 | 
						
					
						
							
								
									
										
										
										
											2009-10-19 22:17:02 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								[ f running-site-watcher set-global ] "site-watcher" add-startup-hook
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-14 11:53:51 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-18 18:07:46 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								<PRIVATE
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-14 11:53:51 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-18 18:07:46 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: check-sites ( seq -- )
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-14 11:53:51 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-18 18:07:46 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        [ dup url>> http-get 2drop site-good ] [ site-bad ] recover
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] each ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-14 11:53:51 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-04-06 18:49:34 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: site-up-email ( site -- body )
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-14 11:53:51 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    last-up>> now swap time- duration>minutes 60 /mod
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ >integer number>string ] bi@
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ " hours, " append ] [ " minutes" append ] bi* append
							 | 
						
					
						
							
								
									
										
										
										
											2009-04-06 18:49:34 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    "Site was down for (at least): " prepend ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-14 11:53:51 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-04-06 18:49:34 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: site-down-email ( site -- body ) error>> ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-14 11:53:51 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-18 18:07:46 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: send-report ( site -- )
							 | 
						
					
						
							
								
									
										
										
										
											2009-04-06 18:49:34 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ dup up?>> [ site-up-email ] [ site-down-email ] if ]
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ [ url>> ] [ up?>> "up" "down" ? ] bi " is " glue ] tri
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    send-site-email ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-14 11:53:51 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-18 19:05:05 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: send-reports ( seq -- )
							 | 
						
					
						
							
								
									
										
										
										
											2011-10-17 00:23:21 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    [ [ send-report ] each ] unless-empty ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-14 11:53:51 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-18 18:45:33 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								PRIVATE>
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-04-06 22:59:27 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: watch-sites ( -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    find-sites check-sites sites-to-report send-reports ;
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-14 11:53:51 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-19 17:48:32 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: run-site-watcher ( db -- )
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    [ running-site-watcher get ] dip '[ 
							 | 
						
					
						
							
								
									
										
										
										
											2009-04-06 22:59:27 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        [ _ [ watch-sites ] with-db ] site-watcher-frequency get every
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-19 17:48:32 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								        running-site-watcher set
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-14 11:53:51 -04:00
										 
									 
								 
							 | 
							
								
							 | 
							
								
							 | 
							
							
								    ] unless ;
							 | 
						
					
						
							| 
								
							 | 
							
								
							 | 
							
								
							 | 
							
							
								
							 | 
						
					
						
							
								
									
										
										
										
											2009-03-18 18:07:46 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								: stop-site-watcher ( -- )
							 | 
						
					
						
							
								
									
										
										
										
											2010-06-10 17:39:13 -04:00
										 
									 
								 
							 | 
							
								
									
										
									
								
							 | 
							
								
							 | 
							
							
								    running-site-watcher get [ stop-timer ] when* ;
							 |