bin/url-minder

   1 #!/usr/bin/perl -w
   2
   3 use strict;
   4 use vars qw($RECEIVER %urls @mess);
   5
   6 $RECEIVER = 'mailto:yourself@somewhere.edu';
   7
   8 use Fcntl;
   9 use AnyDBM_File;
  10 use MD5;
  11 use LWP;
  12
  13 tie %urls, 'AnyDBM_File', 'urls', O_CREAT|O_RDWR, 0644 or
  14     die "Can't open urls: $!";
  15
  16 # If arguments, add them as URLs to check in the database
  17 for (@ARGV) { $urls{$_} = "NEW"; }
  18
  19 my $ua = LWP::UserAgent->new;
  20
  21 my $url;
  22 for $url (keys %urls) {
  23    print "Checking $url...\n";
  24    my $res = $ua->request(HTTP::Request->new(GET => $url));
  25    if ($res->is_success) {
  26         my $hash = "MD5:" . MD5->hexhash($res->content);
  27         if ($hash ne $urls{$url}) {
  28            push(@mess, "$url changed");
  29            $urls{$url} = $hash;
  30         }
  31         else {
  32            print "  unchanged\n";
  33         }
  34    }
  35    elsif ($res->code >= 500) {  # local failure, better luck next time
  36         print "  ", $res->code, " ", $res->message, "\n";
  37         my $count = $urls{$url};
  38         $count = 5 unless $count =~ /^\d+$/;
  39         if ($count > 0) {
  40             print "  will still try $count more times\n";
  41             $urls{$url} = $count - 1;
  42             next;
  43         }
  44         print "  giving up\n";
  45         push(@mess, "$url: Giving up: " . $res->message);
  46         delete $urls{$url};
  47    }
  48    else {
  49         print "  bad\n";
  50         push(@mess, "$url: " . $res->code . " " . $res->message);
  51         delete $urls{$url};
  52    }
  53 }
  54
  55 if (@mess) {
  56     my $req = HTTP::Request->new(POST => $RECEIVER);
  57     $req->header(Subject => 'URL Notification service');
  58     $req->content(join("\n", @mess, ""));
  59     $ua->request($req)->is_success or die "Can't POST to $RECEIVER";
  60 }