#!/usr/bin/perl
#
# Copyright (C) 2004 Florian Ragwitz.
#
# Written for the Debian GNU/Linux distribution based on latest.pl
# Copyright (c) 2003 Henrique Dias <hdias@aesbuc.pt>
#
# License: GNU General Public License v2

use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Request;
use HTTP::Response;

my $VERSION = "0.02";

(my $name = $0) =~ s#^.*/##;

my $dir = "/tmp/$name-$$";
my $dest = "/var/lib/libfile-scan-perl/virus-definitions.pm";
my $cpan = "http://search.cpan.org/src/HDIAS";
my $url = "http://search.cpan.org/search?mode=module&format=xml&query=File::Scan";

my $content = &get_content($url);
my ($module_version) = $content =~ /<VERSION>(\d+\.\d+)<\/VERSION>/i;

my $dpkg_output = `COLUMNS=120 dpkg -l libfile-scan-perl`;
my ($debian_version) = $dpkg_output =~ m/libfile-scan-perl\s+([^\s]+)/;

system("dpkg --compare-versions $module_version gt $debian_version");

if($? != 0) {
	print "File::Scan is already up-to-date.\n";
	exit 1;
}

mkdir $dir;
chdir $dir;
mkdir 'files';

my @files = qw( Makefile.PL files/signatures.txt files/suspicious.txt files/Scan.base );

for( @files ) {
	my $in = "$cpan/File-Scan-$module_version/$_";
	&save($_, &get_content($in));
}

system("perl Makefile.PL >/dev/null 2>&1");
unlink("Makefile");

my $found = 0;

open(SCAN, "<Scan.pm") or die("Can't open Scan.pm: $!");
open(DATA, ">$dest") or die("Can't open $dest: $!");

while( <SCAN> ) {
	$found-- if /__END__/;
	print DATA if $found;
	$found++ if /__DATA__/;
}

print DATA "1;";

close(SCAN);
close(DATA);

system("rm -r $dir");

exit;

sub save {
	my $file = shift;
	my $content = shift;

	$file = "$dir/$file" if($dir);
	open(FILE, ">$file") or die("$!");
	binmode(FILE);
	print FILE $content;
	close(FILE);
	return();
}

sub get_content {
	my $url = shift;

	my $req = HTTP::Request->new(GET => $url);
	my $ua = LWP::UserAgent->new();
	my $response = $ua->request($req);
	if($response->is_error()) {
		print $response->status_line . "\n";
		exit(1);
	}
	my $content = $response->content();
	return($content);
}

__END__

=pod

=head1 NAME

update-libfile-scan-perl - download new version of libfile-scan-perl's virus definitions

=head1 SYNOPSIS

B<libfile-scan-perl>

=head1 DESCRIPTION

B<update-libfile-scan-perl> fetches the current version of libfile-scan-perl's
virus definitions and installs them.

=head1 FILES

B</var/lib/libfile-scan-perl/virus-definitions.pm> Here we install the new
definitions.

=head1 AUTHOR

This manual page was written by Florian Ragwitz E<lt>rafl@debian.orgE<gt>
for the B<Debian> system (but may be used by others).
Permission  is granted to copy, distribute and/or modify this document under
the terms of the GNU General Public License, Version 2 any later version 
published by the Free Software Foundation.

On Debian systems, the complete text of the GNU General Public License can
be found in F</usr/share/common-licenses/GPL>.

=cut
