#! /usr/bin/perl -w

#   upscan - Scan upstream directories for new versions
#   Copyright (c) 2003  Martin Schulze <joey@infodrom.org>
#
#   This program is free software; you can redistribute it and/or modify
#   it under the terms of the GNU General Public License as published by
#   the Free Software Foundation; either version 2 of the License, or
#   (at your option) any later version.
#
#   This program is distributed in the hope that it will be useful,
#   but WITHOUT ANY WARRANTY; without even the implied warranty of
#   MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#   GNU General Public License for more details.
#
#   You should have received a copy of the GNU General Public License
#   along with this program; if not, write to the Free Software
#   Foundation, Inc.,59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.

use strict;
use Getopt::Long;
use LWP::UserAgent;

my %config = (
	      'proxy' => '',
	      'config' => 'upscan.config',
	      );

# Recognised options:
#   --config|-c  config-file
#   --proxy|-p proxy-addr
#
my %options = (
	       'config=s' => \$config{config},
	       'proxy=s' => \$config{proxy},
	       );


sub read_config
{
    my $cfg = shift;
    my $lines;
    my $add = '';

    open (F, $cfg) || die "Can't open $cfg";
    while (<F>) {
	next if (/^\s*\#/);
	next if (/^\s*$/);
	if (/\s*(\S.*\S)\s*\\/) {
	    $lines .= $add.$1;
	    $add = ' ';
	} else {
	    $_ =~ s/^\s+//;
	    $lines .= $add.$_;
	    $add = '';
	}
    }
    close (F);
    return $lines;
}


# Parse commandline options
#
GetOptions (%options);

my $cfg = read_config ($config{config});

my $connection = LWP::UserAgent->new;
$connection->proxy(['http', 'ftp'], $config{proxy}) if (exists $config{proxy});

foreach my $line (split (/\n/, $cfg)) {
    my @elm = split (/ /, $line);
    my @path = ($elm[1] =~ /(.+\/)([^\/]+)/);
    my @results = ();

    my $result = $connection->get($path[0]);

    my $link;
    foreach $_ (split (/\r?\n/, $result->content)) {
	if (/href\s*=\s*[\"\']?([^\"\'\s]+)[\"\']?(\s*|\s[^>]+)>/i) {
	    $link = $1;
	    if ($link =~ /^(.*\/)?$path[1]$/) {
		my $ver = $2;
		if (system("dpkg --compare-versions '$elm[2]' lt '$ver'") == 0) {
		    push (@results, $ver . ' ' . $path[0] . $link);
		}
	    }
	}
    }
    if ($#results > -1) {
	if ($elm[3] =~ /mail=(.*)/) {
	    my $addr = $1;
	    open (MAIL, "|/usr/sbin/sendmail -t") || die "Can't connect to sendmail";
	    printf MAIL "From: Upstream Scanner <%s>\n", $ENV{'LOGNAME'};
	    printf MAIL "Subject: New upstream version of %s available\n", $elm[0];
	    printf MAIL "To: %s\n", $addr;
	    print  MAIL "\n";
	    printf MAIL "Package: %s\n", $elm[0];
	    printf MAIL "Severity: wishlist\n";
	    print  MAIL "\n";
	    printf MAIL "%s\n", join ("\n", sort (@results));
	    print  MAIL "\n";
	    print  MAIL "This mail was automatically generated based on the configuration:\n";
	    printf MAIL "%s\n", $config{config};
	    print  MAIL "\n";
	    close (MAIL);
	} else {
	    printf STDERR "Unrecognized action \`%s'\n", $elm[3];
	}
    }
}