Using my new found love for Google Earth and some perl hacking, I created a little tool that allows me to monitor the log information above and put threats, errors and accesses on the map (literally!).

Here’s how it works: a perl script runs on a regular basis and scans a number of log files on my system for new information. If new information is found, it generates a KML file with placemarks that point to the location that is responsible for the log information. Say snort complains about a potential SQL injection attempt from address a.b.c.d, then the script will look up the location of a.b.c.d (again using Marc’s free ip2location database), add a placemark for it (with some details from the log files) and repeats the same sequence for other new log information. Everything is bundled up in a KML file, a tour is added and the stuff is shipped to Google Earth.

Inside Google Earth, I see the following under “Places”:

There are 6 entries that sshd generated, one from snort and one from fail2ban. Here’s one example:

And here’s another one from the US:

For each entry one can also get a traceroute, whois and black-list information. And to top it all off, there’s an animated tour feature that visits all the threats automatically (wish that KML would support auto-play and auto-repeat features).

The script can run from the command line and it’s output can be piped into a new kml-file like this:

$ perl geforensics.pl > foo.kml

Then take foo.kml and place it somewhere on a server or load it up directly in Google Earth.

The script also detects if it is running as a CGI. In that case it will use KML’s NetworkLink feature with refreshMode set to “onInterval” to refresh the placemarks automatically after a given period (I use 5 mins here). Pretty cool to see GE refresh the map automatically

And here’s a screencast that puts it all together (watch it in full-screen): I start the tour of incidents, then select a specific host in China, initiate a traceroute and while the traceroute is running I check if the guy is listed in some black-lists (he is), once the traceroute comes back I go to the first hop (my ISP), then over to the destination and check the WHOIS information for the ip-address.

And here’s a sample KML file if you want to see it for yourself (in Google Earth):
2009-04-07-gef.kml

The perl code for the little tool is now available at: 2009-04-16-gforensics.pl.gz (gzip compressed perl file – 4KB).

[Update 04/07/2009: If you like this post, you may also want to take a look at the Google Earth Forensics post, which is IMHO a lot cooler ]

[Update 04/16/2009: I added a link to source code at the end of this post. ]

I played a bit more with the idea that I presented in “Apache access_log to Google Earth KML” and, I think, I came up with something extremely cool.

When you surf around on the Internet (or use any TCP/IP service), your data is being routed through an endless list of gateways. Your packets are hopping from one system to the next one, until the final destination has been reached. And data served by the remote destination is hopping it’s way back to you.

On Unix we have the traceroute utility (on Windows it’s called ‘tracert’) that allows you to figure out the route that your packets are taking to a remote destination.

In my web server’s access_log I can see a line where a host at the ip-address 67.195.37.190 accessed a certain url on my server. Resolving that ip-address to a name (via “host 67.195.37.190″) reveals that it is one of Yahoo.com’s crawlers. Using traceroute on the same address shows the following (I changed my internal network address to aaa.bbb.ccc.ddd below):

$ traceroute -q 1 -e -I 67.195.37.190
traceroute to 67.195.37.190 (67.195.37.190), 64 hops max, 60 byte packets
 1  netgear (aaa.bbb.ccc.ddd)  0.781 ms
 2  208-3-81-1.cnsp.net (208.3.81.1)  12.871 ms
 3  144.223.172.81 (144.223.172.81)  35.880 ms
 4  sl-bb20-ana-0-0.sprintlink.net (144.232.1.241)  54.828 ms
 5  sl-crs2-ana-0-13-5-0.sprintlink.net (144.232.1.177)  40.534 ms
 6  192.205.33.189 (192.205.33.189)  39.042 ms
 7  cr1.la2ca.ip.att.net (12.122.128.14)  54.288 ms
 8  cr1.sffca.ip.att.net (12.122.3.121)  51.418 ms
 9  12.122.137.97 (12.122.137.97)  45.766 ms
10  12.86.154.18 (12.86.154.18)  49.140 ms
11  so-1-0-0.pat1.swp.yahoo.com (216.115.110.43)  72.021 ms
12  as0.pat1.gqb.yahoo.com (216.115.96.45)  73.443 ms
13  xe-5-0-0.msr1.gq1.yahoo.com (66.196.67.1)  73.514 ms
14  xe-8-0-0.clr2-a-sat.gq1.yahoo.com (67.195.0.19)  76.818 ms
15  te-6-0.bas5-2-con.gq1.yahoo.com (98.137.31.34)  79.453 ms
16  llf320059.crawl.yahoo.net (67.195.37.190)  76.748 ms
$

This output tells me that it takes roughly 80 milliseconds to get packets from my system to the final destination at Yahoo. However, it does not tell me what geographical path my packets take.

Hold on to your socks, because here’s the same path after I ran it through my little traceroute visualization tool (displayed in Google Earth):

The tool I created this morning, will automatically run a traceroute to any ip-address and it will create a Google Earth compatible KML file. Again we are using Marc’s free database to map ip-addresses to locations on the map. For each hop it records the hop’s ip-address, name and, if available, location. The tool also creates a tour that allows to jump from hop to hop in an animated fashion, until you arrive at your final destination where even more information (Whois) is displayed.

When you try one of the sample files below in Google Earth, just double-click the “Animate Route (play me)” item in the “Places” area:

As you jump from hop to hop, information about the current gateway is being displayed roughly in the geo location where that gateway is physically located (the free database mentioned above does have some hosts that are not mapped and I’m skipping those automatically).

And here are two KMZ files that you can download to Google Earth in order to see the stuff:

• Complete Trace to Yahoo.net (1.8KB)
• Incomplete Trace to Amazon.com (1.9KB)

“Complete” above means that I was able to trace the route all the way to the destination host. And “Incomplete” means that I aborted the trace after a number of systems along the path did not respond to my trace queries.

And if you want to see a live example, click the following link to see the path from my server to your system.

The perl code for the little tool is now available at: 2009-04-16-gtrace.pl.gz (gzip compressed perl file – 2.5KB).

Just the other day I saw link to a free IP address geolocation SQL database (thanks Marc for making that one available). I downloaded the 11MB file and added the database to my mysql server.

Next, I created a simple perl script, that walks over my web servers (apache) access_log, extracts ip-addresses, access-date/time and url and finally converts all those items (using above mentioned database) into a KML file that can be fed to Google Earth.

The result looks like this in Google Earth:

And here’s the script that does the magic (it assumes that you have stored the database in “ipinfo”):

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45

use strict;
use DBI;
 
my %seen;
my $dbh = DBI->connect("dbi:mysql:ipinfo","username","password");
die "unable to connect to database" unless ($dbh);
# kml header
print qq{< ?xml version="1.0" encoding="UTF-8"?>
<kml xmlns="http://www.opengis.net/kml/2.2">
\t<document>
};
# loop over access_log lines
while(<>) {
    # does it look like an access log entry?
    next unless (/^(\d+)\.(\d+)\.(\d+)\.(\d+).*\[([^\]]+)\]\s+"(\S+)\s+(\S+)\s+HTTP\/\d.\d/);
    my($a,$b,$c,$d,$date,$method,$uri)=($1,$2,$3,$4,$5,$6,$7);
    # make sure we have a good ip address
    next if ($a < 0 || $a > 255 || $b < 0 || $b > 255 ||
             $c < 0 || $c > 255 || $d < 0 || $d > 255);
    # did we see this IP already?
    next if $seen{"$a.$b.$c.$d"}++;
    # compute value for ipinfo lookup
    my($val)=($a*256+$b)*256+$c;
    # fetch ipinfo data
    # WARNING! for whatever reason the code-beautifier adds an extra space between the < and = below
    # WARNING! that space has to be removed in your code!
    my($r)=$dbh->selectall_arrayref(qq{select country_code,region_code,city,latitude,longitude
        from ip_group_city where ip_start< =$val order by ip_start desc limit 1});
    # no information? no placemark!
    next if !defined($r);
    print qq{\t\t<Placemark>\n};
    print qq{\t\t\t<name>$a.$b.$c.$d</name>\n};
    print qq{\t\t\t<description>\n< ![CDATA[\n};
    print qq{<b>$method $uri from $r->[0]->[0]/$r->[0]->[1]/$r->[0]->[2] at <i>$date</i><br />\n};
    print qq{]]>\n\t\t\t</description>\n};
    print qq{\t\t\t<point>\n};
    print qq{\t\t\t\t<coordinates>$r->[0]->[4],$r->[0]->[3]</coordinates>\n};
    print qq{\t\t\t</point>\n};
    print qq{\t\t\n};
}
# kml trailer
print qq{\t</document>
</kml>
};
$dbh->disconnect();

And you run the above script via:

perl log2kml.pl < access_log > output.kml

Here’s a little sample file from my web-server. Each ip-address is only recorded once, so if you have the same person visit your site several times, only the first hit will be shown and subsequent ones are ignored: log2kml.kmz (51K – click to open it in Google Earth)

Next up is a version that does live-tracking: as the web server is hit, Google Earth will automatically rotate to the location associated with the ip-address

How it all started

I am a longtime user of Jay Allen’s Blacklist and was happy with it for a long time. Recently I could not keep up with adding new keywords/urls to the black list. There seem to be a million variations of “Texas Hold’em” out there and I ended up adding those items slowly to the Blacklist system (in the end I actually added “texas” as a Blacklist item only to find a “texa$ H0ld’em” the next day in my list of moderated comments).

I started to look more carefully at the offending posts and investigated the submitting IP addresses in detail. Soon I realized that most of the stuff was coming from public proxy servers. Companies stupid enough to run public proxies and hijacked user systems are on top of the list of systems that submitted spam to my server.

Monitoring the proxies

My apache configuration was changed to include some proxy specific information in my access_logs. I changed the line:
LogFormat "%h %l %u %t "%r" %>s %b "%{Referer}i" "%{User-Agent}i"" combined
to
LogFormat "%h %l %u %t "%r" %>s %b "%{Referer}i" "%{User-Agent}i" %{HTTP_X_FORWARDED_FOR}e" combined

This means that the apache server will also log the contents of the environment variable “HTTP_X_FORWARDED_FOR” to the access_log, whenever that environment variable is present. And the environment variable is present if the current request contains a “X-Forwarded-For:” header item. The presence of this item is almost always a clear indication that the request was handled by a proxy server. Items that would have previously been logged like this:

200.242.249.70 - - [15/Jan/2005:11:31:52 -0700] "POST /blog/mt-comments.cgi HTTP/1.0" 302 0 "http://www.kahunaburger.com/blog/mt-comments.cgi?entry_id=113" "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; .NET CLR 1.1.4322)"

suddenly looked like this:

200.242.249.70 - - [15/Jan/2005:11:31:52 -0700] "POST /blog/mt-comments.cgi HTTP/1.0" 302 0 "http://www.kahunaburger.com/blog/mt-comments.cgi?entry_id=113" "Mozilla/4.0 (compatible; MSIE 6.0; Windows NT 5.2; .NET CLR 1.1.4322)" 168.41.192.0

(note the addition of the IP address at the end of the line)

That’s when I started focusing on proxies and developed mt-commentproxyblock, which evolved into mt-proxyplug.

What does it do?

mt-proxyplug when installed on a MovableType system will act as a ‘CommentFilter’. Every comment submission is passed through it, before it is committed to the database. The plugin will inspect the remote IP address of the system that submits the comment. First it will check if there is a “X-Forwarded-For:” header item in the current comment submission request. The mere presence of the header field is an indication that stuff is being submitted through a proxy server. It will then query the Distributed Sender Blackhole List and the Blitzed Open Proxy Monitor List for entries for the submitting remote IP address. If either one knows about the IP address, then we assume that the comment comes from a known public proxy system.

In a last test the remote system is probed on a number of common proxy ports. We try to get access through the system to a well-known and relatively stable host on the internet. If this request is processed successfully on any of the probed ports we also assume that the remote end is indeed a public proxy.

If any one of the above tests is positive we are not executing the other tests and simply flag the current comment submission as suspicious.

A configuration section at the top of the file allows for customization of the list of tests the plugin should run.
There is also a CACHE_COUNT definition that specifies how many found proxies the plugin should keep track of (this will make it much quicker on subsequent requests, if a proxy is used numerous times in a row).

A log of the plugin’s actions is also provided in MT’s Activity Log. Here’s just a small section from my current log:

Since I installed the plugin on kahunaburger.com’s blog it has caught 121 of 122 comment submissions. The one that slipped through was actually caught by mt-spamassassin. During the same time period I also received 4 good comment submissions which made it through the system without any problems.

How to use mt-proxyplug

Just drop the file below into your MovableType’s plugins folder. Modify the “settings” section to your liking (the default values are the recommended values) and you’re set.
No other modules are required (I assume that IO::Socket is available on all newer perl installations). HTTP::CheckProxy (as used in the previous version of the plugin) has been dropped, because it would report false positives (or is it “true negatives”?).

Update 01/20/2005: I’ve updated the plugin below to version 0.6. Two changes since the original version:
1) I set CHECK_LIST_DSBL_ORG to “0″ by default, based on ioerror.us’s comments here
2) I fixed the require list at the top of the file to include “LWP::UserAgent” after receiving a problem report from Chris.

You can download the plugin here: mt-proxyplug.pl.gz (2.5KB, gzip)

Along the same lines as yesterday’s SpamAssassin and MovableType entry, here’s another weapon against the “texas hold’em” and “football–betting” idiots.

Those morons have a tendency to conceal their identity. They are hiding behind public proxy servers and bombard your servers with their crap from there. So all we have to do is to check for a public proxy when somebody tries to submit a comment. If I detect a submission through a public proxy server it will not end up on the site, but will be ignored silently.

The proxy check is done in two stages:

• if we find the HTTP_X_FORWARDED_FOR environment variable we assume that a proxy has handled the request and we don’t even look any further.
• if no HTTP_X_FORWARDED_FOR is found, we grab Apache’s REMOTE_ADDR environment variable (the ip-address of the system who sent the current request) and use the HTTP::CheckProxy module to test whether the submitting system is a public proxy server

If a comment submission is coming from a public proxy we drop a line in the server’s error_log. Here are just some of the entries I captured since I installed it:

[Thu Jan 13 08:35:21 2005] comment denied - using proxy: 216.49.49.118 80.25.156.151 -
poker/bushmills1614@rocketmail.com/80.58.4.111
[Thu Jan 13 08:35:46 2005] comment denied - using proxy: 24.215.40.47 -
football betting/bob@y6322o.com/63.110.140.28
[Thu Jan 13 08:39:00 2005] comment denied - using proxy: 58.40.89.127 -
phentermine/gocha9985@see.it/203.199.92.158
[Thu Jan 13 08:48:59 2005] comment denied - using proxy: 115.120.174.78, 127.0.0.1 -
online poker/absolut5129@freemail.com/80.255.49.222

And before somebody points me at Brad’s DBSL plugin: I’ve tested all the proxies listed above and they do not appear in the DSBL.

In order to use the plugin you will need to have the perl module HTTP::CheckProxy on your system. Drop the perl-code below into your MT plugins folder and you should be ready to go. Again, this has only been tested under Apache!

You can download the compressed version here: mt-commentproxyblock.pl.gz (1 Kb,gzip)

#!/usr/bin/perl -w
package MT::Plugin::CommentProxyBlock;
use strict;
use lib '../lib';
use vars qw ($VERSION);
$VERSION='0.2';
use constant ACCEPT_RESPONSE => 1;
use constant DENY_RESPONSE   => 0;
use MT;
use MT::App::Comments;
use HTTP::CheckProxy;
eval{ require MT::Plugin };
unless ($@) {
    my $plugin = {
        name => qq{Comment Proxy Block for Movable Type v$VERSION},
        description => qq{Will block attempts to post a comment via a proxy server},
    };
    MT->add_plugin(new MT::Plugin($plugin));
    # tell MT that we want to be called to filter comments
    MT->add_callback('CommentFilter', 1, $plugin, \&proxyCheck_filter);
}
# proxyCheck_filter
#
# checks environment for an entry which indicates we are handling a request that
# came from a proxy server (HTTP_X_FORWARDED_FOR). If environment does not give
# any indication, check REMOTE_ADDR and see if it proxies requests for us. If
# either is true we deny the comment posting attempt. Tested in Apache only!
sub proxyCheck_filter {
    my($eh,$app,$comment)=@_;
    my($isProxy,$proxy)=(0,'');
    # uncomment to get a complete dump of the environment
    # dumpEnv();
    # check environment
    $proxy=$ENV{HTTP_X_FORWARDED_FOR};
    if(defined($proxy) && length($proxy)) {
        print STDERR "[".scalar(localtime())."] proxy request forwarded for: $proxy\n";
        # if we have a X-Forwarded-For header, it was most likely
        # added by the system that sent the request
        $proxy=$ENV{REMOTE_ADDR};
        $isProxy++;
    }
    # check remote address
    unless($isProxy) {
        $proxy=$ENV{REMOTE_ADDR};
        print STDERR "[".scalar(localtime())."] probing for open proxy: $proxy\n";
        my $p=HTTP::CheckProxy->new($proxy,qq{http://www.google.com/});
        $isProxy++ if($p->guilty());
    }
    if($isProxy) {
        print STDERR "[".scalar(localtime())."] comment denied - " .
          "using proxy: $proxy - " .
          join("/",$comment->author,$comment->email,$comment->ip) .
          "\n";
        return DENY_RESPONSE;
    }
    return ACCEPT_RESPONSE;
}
sub dumpEnv {
    print STDERR "[".scalar(localtime())."] environment for $0:\n";
    foreach my $key (sort keys %ENV) {
        print STDERR "[".scalar(localtime())."]   $key = ",$ENV{$key},"\n";
    }
}
1;

A few days ago I saw the post on ioerror.us which details a solution to link WordPress’s comment checking system with Spam Assassin. I run MovableType and a WordPress solution does not work for me. The code needed to change a bit before it was usable on my system.

After enabling it last night and disabling mt-blacklist, I’m happy to report that it has caught every single comment spam attempt (a total of 32 attempts were registered). Spam indications appear in my server’s error_log like this:

[Tue Jan 11 08:33:34 2005] spam from diet pills/jane_doe7082@work.com/
148.244.150.58: score 10.7 (limit 5.0)

A message like this indicates that the ‘CommentFilter’ implemented in mt-spamassassin.pl has received notification from the Spam Assassin daemon that the current comment is over the Spam Assassin threshold.

In order to use the mt-spamassassin.pl plugin you will need to have Spam Assassin’s spamd running on your own network or need access to spamd running on a remote system. Enter the name of the system that runs spamd in $sa_spamd_host (use ‘localhost’ if it’s running on the same host as MovableType) and also enter the port number where spamd can be reached in $sa_spamd_port. And because I did not find a way to retrieve a blog owners email address from within the MoveableType plugin, please also enter your email address in $mt_owner. For SpamAssassin’s user_prefs to work, you should also set your real (unix) userid in $mt_userid. Drop the modified file in your blog’s plugins folder and it should be ready to go.

Thanks to http://www.ioerror.us/ for the cool idea!

You can download the compressed version here: mt-spamassassin.pl.gz (1.5 Kb,gzip)

Update 01/14/2005: I’ve since added another plugin called mt-commentproxyblock, which has detected every single spam submission on 01/13/2005 before it was passed through mt-spamassassin. It seems that the majority of spammers do use public proxies and those are easy to detect.

Update 01/20/2005: I just posed a new version of the plugin with a few enhancements. If you have both mt-spamassassin and mt-proxyplug on your system, a comment will be shortcut if mt-proxyplug has already determined that it comes from an open proxy. Specifically, mt-spamassassin will look at the visible-flag of the comment and will not work on comments which are not visible. This will cut down on processing time for spam comments.
Second, Justin was nice enough to correct the fake Message-header I’ve been sending to spamd to make it more RFC-2822 compliant. Thanks!
Third, you can now specify a $mt_moderate threshold value. This means that if a comment submission is below the Spam threshold (defined in Spam Assassin), but above the $mt_moderate value, it will be moderated instead of being allowed all the way through to the blog.

#!/usr/bin/perl -w
package MT::Plugin::SpamAssassin;
use strict;
use lib '../lib';
use vars qw ($VERSION);
$VERSION='0.4';
# (CHANGE ME) what host is running spamd?
my $sa_spamd_host = q{localhost};
# (CHANGE ME) what port is spamd listening on?
my $sa_spamd_port = 783;
# (CHANGE ME) who is the owner of the blog?
my $mt_owner      = q{me@localhost.com};
# (CHANGE ME) what is the userid for SpamAssassin?
my $mt_userid     = q{me};
# (CHANGE ME) what is the moderate threshold?
my $mt_moderate   = 1.5;
use constant ACCEPT_RESPONSE => 1;
use constant DENY_RESPONSE   => 0;
use MT;
use MT::App::Comments;
use IO::Socket;
use Time::Local qw(timegm);
use POSIX;
eval{ require MT::Plugin };
unless ($@) {
    my $plugin = {
        name => qq{Spamassassin for Movable Type v$VERSION},
        description => qq{Spamassassin for Movable Type},
    };
    MT->add_plugin(new MT::Plugin($plugin));
    # tell MT that we want to be called to filter comments
    MT->add_callback('CommentFilter', 10, $plugin, \&sa_filter);
}
# sa_filter
#
# 'CommentFilter' that is called for each attempt to post a comment
# on your blog. We'll pass the incoming comment to spamd running on
# $sa_spamd_host:$sa_spamd_port. If spamd responds with an indication
# that the comment was spam, then we'll repond with DENY_RESPONSE.
# If spamd says it's no spam or we can't get a good connection to
# spamd, we'll respond with ACCEPT_RESPONSE
sub sa_filter {
    my($eh,$app,$comment)=@_;
    unless($comment->visible()) {
        return ACCEPT_RESPONSE;
    }
    #print STDERR "[".scalar(localtime())."] mt-spamassassin: " .
    #  join("/",$comment->author,$comment->email,$comment->url,$comment->ip) . "\n";
    my $now=rfc822_date();
    my $hostname=gethostbyaddr(inet_aton($comment->ip), AF_INET);
    my $message="From " . $comment->email . " " . $now . "\n" .
      "Received: from client ([" . $comment->ip . "] ".
      ($hostname?$hostname:$comment->ip) . ")" .
      " by " . $ENV{HTTP_HOST} . " via MovableType; " . $now . "\n" .
      "Message-id: <". sprintf("%x\$%x",time,rand(65535)) .
      "\@" . ($hostname?$hostname:sprintf("[%s]",$comment->ip)) . ">\n" .
      "From: " . $comment->author .
      " <" . $comment->email . ">\nDate: " . $now . "\n" .
      "Subject: MovableType comment\n" .
      "To: $mt_owner\n\n" .
      $comment->url . "\n".
      $comment->text;
    # make sure all lines end in "\r\n";
    $message =~ s/\r\n/\n/gs;
    $message =~ s/\r/\n/gs;
    $message =~ s/\n/\r\n/gs;
    # now send it off to Spamassassin
    my $socket=IO::Socket::INET->new(PeerAddr => $sa_spamd_host,
                                     PeerPort => $sa_spamd_port,
                                     Proto    => "tcp",
                                     Type     => SOCK_STREAM);
    # no socket - no spam check
    return ACCEPT_RESPONSE unless($socket);
    # create the CHECK message for spamd
    $message = "CHECK SPAMC/1.2\r\n" .
      "User: $mt_userid\r\n" .
      "Content-Length: ".length($message).
      "\r\n\r\n".
      $message;
    # print STDERR "[".scalar(localtime())."] sending to spamd:\n$message\n";
    # send it to spamd
    my $toSend=$message;
    while(length($toSend)) {
        my $written = $socket->send($toSend);
        unless(defined($written)) {
            # oh no, something went wrong 
            return ACCEPT_RESPONSE;
        }
        $toSend=substr($toSend,$written);
    }
    # close writing end of socket
    $socket->shutdown(1);
    # suck in response from SpamAssassin
    my $response;
    while(1) {
        my $buffer;
        unless(defined($socket->recv($buffer, 1024))) {
            return ACCEPT_RESPONSE;
        }
        last unless(length($buffer));
        $response .= $buffer;
    }
    # trim  whitespace off the beginning of the response
    $response =~ s/^\s*//;
    # check if it is really a SpamAssassin response
    return ACCEPT_RESPONSE unless ($response =~ /^spamd\/[\d\.]+/i);
    # now find "Spam: True|False ; score / limit" header
    return ACCEPT_RESPONSE
      unless ($response =~ /spam:\s*(\S+)\s*;\s*([\d\.]+)\s*\/\s*([\d\.]+)/is);
    my($flag,$score,$limit)=($1,$2,$3);
    #if($flag =~ /false/i) {
        #print STDERR "[".scalar(localtime())."] no spam:\n$message\n";
    #}
    print STDERR "[".scalar(localtime())."] spam $flag from " .
      join("/",$comment->author,$comment->email,$comment->ip) .
      ": score $score (limit $limit)\n";
    if($flag =~ /false/i) {
        if($score > $mt_moderate) {
            print STDERR "[".scalar(localtime())."] moderating comment\n";
            $comment->visible(0);
        }
        return ACCEPT_RESPONSE;
    }
    # log a line to the error_log
    return DENY_RESPONSE;
}
# rfc822_date
#
# generate a GMT date according to rfc822
sub rfc822_date {
    # offset in hours (from Mail::Sendmail)
    my $offset  = sprintf "%.1f", (timegm(localtime) - time) / 3600;
    my $minutes = sprintf "%02d", abs( $offset - int($offset) ) * 60;
    my $TZ  = sprintf("%+03d", int($offset)) . $minutes;
    return POSIX::strftime("%a, %d %b %Y %T $TZ",localtime(time()));
}
1;

Now add RSS to the mix. Imagine a few hundred of those employees point at popular RSS feeds out there. Even if each individual employee follows the rules set by the RSS feed provider and only checks the feed every 1-2 hrs (or whatever else the minimum update time may be), the RSS server will still see a few hundred hits from the same set of IP-addresses over time. And there have been situations where a server administrator has shut down access to the RSS feed because of obvious violation of the rules (too many accesses to the feed in too little time from the same IP-address).

What’s needed in this case is a caching proxy server where all people behind the firewall funnel their feed requests to an internal system. The internal system will check (based on the URL of the feed) whether it has downloaded the RSS feed recently and will provide the cached copy instead of bothering the RSS server. Once the minimum time between updates has passed, the proxy will get a fresh copy of the RSS feed.

The script below will do exactly what just mentioned. Besides it’ll also do some house-keeping on the feeds, display a list of all available feeds when hit without any argument and compress feed contents before storing them in the database.

In order to use it, you would do the following:
1) let’s assume you install the script at http://rssproxy.mycompany.com/rssproxy.pl
2) you want to provide a proxy for the slashdot rss feed at http://slashdot.org/index.rss
3) you would ask your users to use the feed http://rssproxy.mycompany.com/rssproxy.pl/slashdot.org/index.rss instead of the original feed.

Hitting the proxy via http://rssproxy.mycompany.com/rssproxy.pl would display a list of all known feeds and how often they’ve been used, etc.

Just after I had finished this I found out that http://www.rsscache.com/ is providing the same functionality as a public service.

Hope one or the other person still finds it useful.

Yesterday, Brian G emailed me and asked me a question related to the article above. In passing he mentioned that he had received a response from Veo about the file-format. One email later I had the Veo-response in my hands and guess how suprised I was when I read this: the data delivered from the camera is in JPEG format, it only misses a JPEG header!!! DUH!!!

Along with the email I also received a 400 byte binary file with the header. After a few more hours of work (tacking on the header was not enough), I received my first full frame from the camera. I was happy to see that my decoding efforts were pretty darn close to the information that Brian forwarded.

So now I (and you) can access those cameras from any platform that supports perl and the IO::Select and IO::Socket modules.

Here’s a little sample script that saves 10 frames at 640 x 480 at 1 frame/sec:

#!/usr/bin/perl -w

use strict;
use Veo;

my $veo=Veo->new(host => ’192.168.1.1′, port => 1600);
$veo->login(user => ‘admin’, password => ‘password’);
my($images)=10;
$veo->selectStream(Veo::VEO_STREAM_640X480,1);
$veo->stream(\&cb);

sub cb {
    my($type,$frame,$data)=@_;
    print STDERR qq{image $frame with },length($data),qq{ bytes\n};
    open(OUT,”>”.sprintf(“veo-%02d.jpg”,$images));
    binmode(OUT);
    print OUT $data;
    close(OUT);
    # return value > 0 indicates “keep on streaming”
    # return value = 0 indicates “stop streaming”
    return $images–;
}

Easy – isn’t it?

And here’s another sample. This time we use the move() method to pan the camera head and take pictures after each step. This script will logon to the camera, move the head all the way to the left and then slowly move to the right while taking a single frame after each step to the right.

#!/usr/bin/perl -w

use strict;
use lib “.”;
use Veo;

my $veo=Veo->new(host => ’192.168.1.1′, port => 1600);
$veo->login(user => ‘admin’, password => ‘password’);
$veo->selectStream(Veo::VEO_STREAM_320X240,1);
my($rc);
# move all the way to the left
while($rc=$veo->move(Veo::VEO_MOVE_FULL_LEFT)) {
    last if($rc != Veo::OK);
}
# now take one frame at a time and move right
do {
    $veo->stream(sub {
                     # args are: frametype, framenumber, framedata
                     open(OUT,”>frame-”.sprintf(“%04d”,$_[1]).”.jpg”) || return 0;
                     binmode(OUT);
                     print OUT $_[2];
                     close(OUT);
                     return 0;
                 });
    $rc=$veo->move(Veo::VEO_MOVE_RIGHT);
} while($rc == Veo::OK);

As it says in the documentation of the module, I’m going to finish this up over the next few days, but I’ve been asked soo often that I decided to release this piece half-baked. Have fun with the Veo.pm (right-click, save as …, the usual) perl module and let me know if it works or doesn’t work for you.

Update 8/16/2004:

James A. Russo quickly converted the perl-module into something Java-people can use. Hop on over to http://www.halo3.net/ to find the Java-classes and some more information. James also used the Veo.pm perl module in a quick perl CGI to retrieve images from the camera and move the camera position. Here it is (thanks James):

#!/usr/bin/perl

# webveo.pl – James A. Russo jr@halo3.net – August 14th, 2004.
#
# Quick and dirty script allowing a Veo Observer Network Camera to be used from a simple web page.
#
# It will redirect you to the $URL variable when moving. So a simple webpage like this should work:
#
# …
# <img src=”/path/to/webveo.cgi?action=getimage”>
# <a href=”/path/to/webveo.cgi?move=fullup”>Move Up</a>
# …
#
#
# This script uses Veo.pm from Tobias Hoellrich. See http://www.kahunaburger.com/blog/archives/000157.html for more info.
#

use CGI;
use Veo;
use Fcntl qw/ :flock /;

my $USER = “admin”;
my $PASSWORD = “password”;
my $HOST = “192.168.1.142″;
my $PORT = 1600;

# Other options for STREAM.
# Veo::VEO_STREAM_640X480;
# Veo::VEO_STREAM_160X120;
my $STREAM = Veo::VEO_STREAM_320X240;
my $URL= “index.html”;

## Nothing below this line needs editing..

my $CGI = new CGI;
my $ACTION = $CGI->param(‘action’);
my $MOVE = $CGI->param(‘move’);

# We synchronize since two admins can’t log in at once.
open FL, “>.lock” || die “Unable to open lock file.”;
flock(FL,LOCK_EX);

my $VEO = Veo->new(host => $HOST, port => $PORT);

$VEO->login(user => $USER, password => $PASSWORD);

if ($MOVE) {
    if ($MOVE eq “up”) {
        $VEO->move(Veo::VEO_MOVE_UP);
    } elsif ($MOVE eq “fullup”) {
        $VEO->move(Veo::VEO_MOVE_FULL_UP);
    } elsif ($MOVE eq “down”) {
        $VEO->move(Veo::VEO_MOVE_DOWN);
    } elsif ($MOVE eq “fulldown”) {
        $VEO->move(Veo::VEO_MOVE_FULL_DOWN);
    } elsif ($MOVE eq “left”) {
        $VEO->move(Veo::VEO_MOVE_LEFT);
    } elsif ($MOVE eq “fullleft”) {
        $VEO->move(Veo::VEO_MOVE_FULL_LEFT);
    } elsif ($MOVE eq “right”) {
        $VEO->move(Veo::VEO_MOVE_RIGHT);
    } elsif ($MOVE eq “fullright”) {
        $VEO->move(Veo::VEO_MOVE_FULL_RIGHT);
    }
    $VEO->logout;
    print “Location: $URL\n\n”;
} elsif ($ACTION eq “getimage”) {
    $VEO->selectStream($STREAM,1);
    $VEO->stream(\&image_cb);
    # callback will be called once, and then we will get here..
    $VEO->logout;
    # unflock happens on exit..
    exit(1);
} else {
    print “Content-type: text/html\n\n”;
    print “Unknown action: $ACTION\n”;
}

sub image_cb {
    my($type,$frame,$data)=@_;
    print “Content-type: image/jpeg\n\n”;
    print $data;
    # We only want the one image…
    return 0;
}

After downloading the Camera SDK from Veo’s web site I created a minimal application that would connect to the camera on fixed interverals and store a JPG frame on the harddisk. This happens on one of my Windows PCs, because the SDK is only available for Windows (I’m still looking for a way to decode the XJPG frames). The JPG file is then shipped to my FreeBSD box. The FreeBSD system also happens to be the web server for kahunaburger.com.

Again on a fixed interval, the FreeBSD system will look at the new file and compare the file to the “lastest” camera grab. If it detects a certain amount of difference between the two frames, it will start the process of saving the current frame. “Saving the current frame” involves:

• copying the “latest” image to the “last” image

• copying the “current” image to the “latest” image
• generating a thumbnail for the “latest” image
• maintaining a list of up to 80 saved frames
• maintaining a list of up to 80 thumbnails
• regenerating a HTML page that shows those thumbnails and saved frames

Here is a small section from the HTML-page generated by the scaript. This section shows the table that holds the thumbnails for all saved frames. As you hover over each thumbnail, the big picture is automatically updated, showing you a full-size picture of the frame the mouse is currently over.

The code uses pretty much only standard stuff besides the Imager and the HTML::Template modules. Both of them are available on CPAN and/or through ActiveState’s ppm.

I’m not supplying the index.template file mentioned in the script, because mine is tuned for the kahunaburger.com environment and will not work for you anyway. Just make sure you have a template variable content in the body and a variable js in the head.

Let's me know, if you have questions.

#!/usr/bin/perl -w

# we are always strict - aren't we?
use strict;

use File::Spec;
use File::stat;
use File::Copy;

use Imager;
use HTML::Template;

# use the FORCE to generate the HTML page even if no change was detected
use constant FORCE => 0;

# what's the URL for the page?
use constant THISURL => qq{http://www.yourserver.com/motion/};
# what's the filesystem path for the page?
use constant PATH => qq{/mnt/apache/www.yourserver.com/htdocs/motion};

# constants that determine when we keep an image
use constant DARKNESS => 0.190;
use constant DIFFERENCE => 1.000;
use constant GRAYNOISE => 40;
use constant DIFFWIDTH => 160;

# where are the "latest" and "last" files kept?
use constant IMAGEDIR => qq{pia};
use constant SOURCE => qq{webcam.jpg};
use constant LATEST => qq{latest.jpg};
use constant LAST => qq{last.jpg};
use constant TIMESTAMP => qq{.timestamp};

# how many frames/thumbnails do we keep around?
use constant SAVEFRAMES => 80;
use constant SAVEDIR => qq{save};
use constant SAVEPREFIX => qq{saved-};

use constant THUMBDIR => qq{thumb};
# how wide are our thumbnails?
use constant THUMBWIDTH => 80;

# what's the filename for the templat file?
use constant HTMLTEMPLATE => qq{index.template};
# and where does the final html file go?
use constant HTMLFINAL => qq{index.html};

# go to "our" directory
unless(chdir(PATH)) {
    print STDERR "unable to change directory to ",PATH,"\n";
    exit(1);
}

# check if camera source exists
if(!-f SOURCE || -z _) {
    print STDERR "no source or empty source file\n";
    exit(1);
}
# check modification time of old source against
# camera source
my ($lastcheck)=0;
my $newsource=File::Spec->catfile(IMAGEDIR,SOURCE);
my $last=File::Spec->catfile(IMAGEDIR,LAST);
my $latest=File::Spec->catfile(IMAGEDIR,LATEST);
if(-f $latest) {
    my $tstat=stat($latest);
    $lastcheck=$tstat->mtime;
}
my $sstat=stat(SOURCE);
if($lastcheck >= $sstat->mtime) {
    print STDERR "no new data\n";
    exit(1);
}
# copy current source to latest and verify
unless(copy(SOURCE,$newsource) && -f $newsource && -s _ == $sstat->size) {
    print STDERR "invalid new source after copy\n";
    exit(1);
}
# copy access/modtime
utime($sstat->atime,$sstat->mtime,$newsource);
# we are good to go ... remove last (ignore errors)
unlink($last);
# move latest to last (ignore errors)
move($latest,$last);
# move newsource to latest (ignore errors)
move($newsource,$latest);
# open the image files
my $latestImage=Imager->new();
unless($latestImage->open(file=>$latest)) {
    print STDERR "cannot open $latest - ",$latestImage->errstr(),"\n";
    exit(1);
}
my $lastImage=Imager->new();
unless($lastImage->open(file=>$last)) {
    print STDERR "cannot open $last - ",$lastImage->errstr(),"\n";
    exit(1);
}

my(@savedFiles);
unless(opendir(DIR,SAVEDIR)) {
    print STDERR "cannot open save directory\n";
}
while(my $entry=readdir(DIR)) {
    my $filename=File::Spec->catfile(SAVEDIR,$entry);
    next unless (-f $filename);
    push(@savedFiles,[$entry,stat($filename)->mtime]);
}
close(DIR);
# sort files by modification time (newest first)
@savedFiles=sort { $b->[1] <=> $a->[1] } @savedFiles;

# now check if this image is worth saving
if(FORCE || compareImages($lastImage,$latestImage)) {
    # looks like latest fits the criteria, let's save it to the
    # motion directory

    # trim number of saved files to SAVEFRAMES-1 (we are going to add one)
    if(scalar(@savedFiles) >= SAVEFRAMES - 1) {
        my(@oldFiles)=splice(@savedFiles,SAVEFRAMES - 1);
        foreach (@oldFiles) {
            # remove saved frame
            unlink(File::Spec->catfile(SAVEDIR,$_->[0]));
            # remove thumbnail
            unlink(File::Spec->catfile(THUMBDIR,$_->[0]));
        }
    }
    # generate a new filename
    my $savedFile=SAVEPREFIX.time.qq{.jpg};
    # add to list of saved files
    unshift(@savedFiles,[$savedFile,time]);
    $latestImage->write(file=>File::Spec->catfile(SAVEDIR,$savedFile));
    # generate thumbnail
    $latestImage=$latestImage->scale(xpixels=>THUMBWIDTH);
    $latestImage->write(file=>File::Spec->catfile(THUMBDIR,$savedFile));
}
# synchronize the save/thumb folders to make sure we are not wasting space
# in the thumb dir
if(opendir(DIR,THUMBDIR)) {
    my(@thumbsToRemove);
    my(@filesInSaved)=(map { $_->[0] } @savedFiles);
    while(my $entry=readdir(DIR)) {
        my $filename=File::Spec->catfile(THUMBDIR,$entry);
        next unless (-f $filename);
        # is the thumb also in the save directory?
        next if(grep(/^$entry$/i,@filesInSaved));
        push(@thumbsToRemove,$filename);
    }
    close(DIR);
    foreach(@thumbsToRemove) {
        unlink($_);
    }
}

# generate the table for the images
my $t=qq{<table border="1">};
my($rows)=0;
my($saved)=SAVEFRAMES;
while($saved) {
    if(!($saved % 8)) {
        if($saved != SAVEFRAMES) {
            $t.=qq{</tr>\n};
            if($rows++ == 4) {
                $t.=qq{<tr><td colspan="8"><center><img name="latest" src="$latest"><div id="label">}.
                  scalar(localtime()).qq{</div></center></td></tr>\n};
            }
        }
        $t.=qq{<tr>};
    }
    if(scalar(@savedFiles)) {
        my $entry=shift(@savedFiles);
        my $imgname=THUMBDIR.qq{/}.$entry->[0];
        my $simgname=SAVEDIR.qq{/}.$entry->[0];
        my $datestamp=scalar(localtime($entry->[1]));
        $t.=qq{<td><center><a href="#" onmouseover="update('latest','$simgname','$datestamp')">}.
          qq{<img border="0" src="$imgname" alt="$datestamp"></a></center></td>};
    }else{
        $t.=qq{<td>&nbsp;</td>};
    }
    $saved--;
}
$t.=qq{</tr></table>\n};
# we are ready to generate the HTML file
my $template = HTML::Template->new(
                                   filename => HTMLTEMPLATE,
                                   die_on_bad_params => 0,
                                  );
my $htmlfile=HTMLFINAL.$$;
unless(open(OUT,">$htmlfile")) {
    print STDERR "cannot write to $htmlfile - $!";
    exit(1);
}
# use this and a meta variable in your template to automatically refresh the page (300=5 mins)
$template->param('meta' => qq{<META HTTP-EQUIV="refresh" content="300;URL=}.THISURL.qq{">});
$template->param('title' => "yourserver.com - motion cam - last update ".scalar(localtime()));
$template->param('content' => $t);
$template->param('js' => qq{
<SCRIPT language="JavaScript">
<!-- Begin
    function browserdetect(){
      //returns 1 for IE, 2 for N6,3 for N4 and others
      if(navigator.appName=="Microsoft Internet Explorer"){return 1;}
      else if(navigator.appName=="Netscape" && parseInt(navigator.appVersion)==5){return 2;}
      else{return 3;}
    }

    function update(imgname,source,date_stamp) {
      var browsertype; browsertype=browserdetect();
      if(browsertype==2){ //if N6
        document.getElementById(imgname).src=source;
      }else{
        document.all[imgname].src=source;
      }
      el = document.all ? document.all('label') :
             document.getElementById ? document.getElementById('label') : null;
      if (el) el.innerHTML = date_stamp;
    }
// End -->
</SCRIPT>});
print OUT $template->output;
close(OUT);
# remove current file
unlink(HTMLFINAL);
# and bring current one into place
move($htmlfile,HTMLFINAL);
exit(0);

sub compareImages {
    my($img1,$img2)=@_;
    # scale down for comparison
    $img1=$img1->scale(xpixels=>DIFFWIDTH);
    $img2=$img2->scale(xpixels=>DIFFWIDTH);
    # convert to grayscale
    $img1=$img1->convert(preset=>'grey');
    $img2=$img2->convert(preset=>'grey');
    return diffImages($img2, $img1, DARKNESS, DIFFERENCE);
}

sub diffImages {
    my($older,$newer,$darkness,$difference)=@_;
    my($white)=$older->getwidth()*$older->getheight()*255;
    my($d2,$s2)=("",0);
    $newer->write(data=>\$d2,type=>'raw');
    # check darkness of frame
    map { $s2+=ord($_) } split(//,$d2);
    # do we have a dark frame?
    if($s2/$white <= $darkness) {
        return 0;
    }
    my($d1,$s1)=("",0);
    $older->write(data=>\$d1,type=>'raw');
    my($i)=0;
    map { my $x=abs(ord($_)-vec($d2,$i++,8));
          $s1+=($x*$x) if($x>=GRAYNOISE);
      } split(//,$d1);
    my $d=$s1/$white;
    if($d < $difference) {
        return 0;
    }
    return 1;
}