#!/usr/bin/perl

###############################################################################
##
## Functions for downloading and parsing Debian Security Advisories (DSAs)
## Currently also includes some FreeBSD Advisory parsing (which sucks)
##
###############################################################################

use strict;
use warnings;

#use Storable; # persistant storage
use LWP::UserAgent;
#use Config::Auto; # libconfig-auto-perl
use Time::ParseDate; # libtime-modules-perl
#use IO::Uncompress::Bunzip2 qw(bunzip2 $Bunzip2Error);
#use IO::Uncompress::Gunzip qw(gunzip $GunzipError);
#use Digest::MD5 qw(md5_hex);
use POSIX qw(mktime);
#use File::Path qw(make_path);
use HTML::Parser;

use feature "switch";

# Track renamed packages here, easy but manual. We tried to automate it
# using package metadata for distribution upgrades but that really sucked.
sub unifySrcName {
	my $name = shift;
	
	given ($name) {
		## TODO: it should map to the most recent version, not unversioned
		## TODO: we can partially automate this..
		## -> make all lower-case
		## -> replace -X.Y version numbers by highest encounter(?)
		## -> handle special cases like xfree86
		when ("proftp-dfsg")          { $name = "proftp" };
		when ("mozilla-firefox")      { $name = "iceweasel" };
		when ("mozilla-thunderbird")  { $name = "icedove" };
		when ("squid3")               { $name = "squid" };
		when ("squid/squid3")         { $name = "squid" };
		when ("tk8.3")                { $name = "tk8.4" };
		when ("tk8.4")                { $name = "tk8.4" };
		when ("xpdf-i")               { $name = "xpdf" };
		when ("zope2.10/zope2.9")     { $name = "zope2.7" };
		when ("zope-cmfplone")        { $name = "zope2.7" };
		when ("zope-ldapuserfolder")  { $name = "zope2.7" };
		when ("librmagick-ruby")      { $name = "ruby-rmagick" };
		when ("libcompass-ruby")      { $name = "ruby-compass" };
		when ("bio-ruby")             { $name = "ruby-bio" };
		when ("request-tracker3.4")   { $name = "request-tracker3.8" };
		when ("request-tracker3.6")   { $name = "request-tracker3.8" };
		when ("perl-5.005")           { $name = "perl" };
		when ("otrs2")                { $name = "otrs" };
		when ("openldap2.3")          { $name = "openldap" };
		when ("openldap2")            { $name = "openldap" };
		when ("libreoffice")          { $name = "openoffice.org" };
		when ("nsd3")                 { $name = "nsd" };
		when ("network-manager/network-manager-applet") { $name = "network-manager" };
		when ("nagios3")              { $name = "nagios" };
		when ("nagios2")              { $name = "nagios" };
		when ("mysql-dfsg-4.1")       { $name = "mysql" };
		when ("mysql-dfsg-5.0")       { $name = "mysql" };
		when ("mysql-dfsg")           { $name = "mysql" };
		when ("linux-2.6.24")         { $name = "linux-2.6" };
		when ("linux-kernel-alpha")   { $name = "linux-2.4" };
		when ("linux-kernel-i386")    { $name = "linux-2.4" };
		when ("libmusicbrainz-2.0")   { $name = "libmusicbrainz3" };
		when ("libmusicbrainz-2.1")   { $name = "libmusicbrainz3" };
		when ("libgtop1")             { $name = "libgtop2" };
		when ("libgd1")               { $name = "libgd2" };
		when ("libast1")              { $name = "libast" };
		when ("libmozjs0d")           { $name = "libast" };
		when (/^kernel-source-2.2.*/) { $name = "linux-2.2" };
		when (/^kernel-patch-2.2.*/)  { $name = "linux-2.2" };
		when ("kernel")               { $name = "linux-2.4" };
		when (/^kernel-source-2.4.*/) { $name = "linux-2.4" };
		when (/^kernel-image-2.2.*/)  { $name = "linux-2.2" };
		when (/^kernel-image-2.4.*/)  { $name = "linux-2.4" };
		when (/^kernel-patch-2.4.*/)  { $name = "linux-2.4" };
		when ("kernel-patch-benh")    { $name = "linux-2.4" };
		when ("kernel-patch-vserver") { $name = "linux-2.4" };
		when (/^kernel-source-2.6.*/) { $name = "linux-2.6" };
		when ("gnutls11")             { $name = "gnutls26" };
		when ("gnutls13")             { $name = "gnutls26" };
		when ("gallery2")             { $name = "gallery" };
		when ("firebird2")            { $name = "firebird2.5" };
		when ("firebird2.0")          { $name = "firebird2.5" };
		when ("firebird2.1")          { $name = "firebird2.5" };
		when ("fltk1.1")              { $name = "fltk1.3" };
		when ("fox1.4")               { $name = "fox1.6" };
		when ("exim-tls")             { $name = "exim" };
		when ("exim4")                { $name = "exim" };
		when ("epic4")                { $name = "epic" };
		when ("drupal6")              { $name = "drupal" };
		when ("dhcp")                 { $name = "dhcp3" };
		when ("cyrus-sasl")           { $name = "cyrus-sasl2" };
		when (/^cyrus-imapd.*/)       { $name = "cyrus-imapd" };
		when (/^kolab-cyrus-imapd.*/) { $name = "cyrus-imapd" };
		when ("cfengine")             { $name = "cfengine2" };
		when ("bind")                 { $name = "bind9" };
		when ("apache")               { $name = "apache2" };
		when ("horde2")               { $name = "horde3" };
		when ("mediawiki1.7")         { $name = "mediawiki" };
		when ("ffmpeg-debian")        { $name = "ffmpeg" };
		when ("xserver-xorg")         { $name = "xorg-server" };
		when ("xfree86-1")            { $name = "xorg-server" };
		when ("xfree86v3")            { $name = "xorg-server" };
		when ("xfree86")              { $name = "xorg-server" };
		when ("xfree86")              { $name = "xorg-server" };
		when ("xorg")                 { $name = "xorg-server" };
		when ("typo3")                { $name = "typo3-src" };
		when ("lvm10")                { $name = "lvm2" };
		when ("cupsys")               { $name = "cups" };
		when ("ethereal")             { $name = "wireshark" };
		when ("libboost1.42")         { $name = "libboost1.46" };
		when ("cinelerra-cv")         { $name = "cinelerra" };
		when ("mplayer-dmo")          { $name = "mplayer" };
		when ("libcap")               { $name = "libgda2" };
		when ("xkb-data-legacy")      { $name = "xkeyboard-config" };
		when ("boost-defaults")       { $name = "boost" };
		when ("xen-3")                { $name = "xen" };
		when ("kde-icons-gorilla")    { $name = "kde-icons-korilla" };
		when ("kde4libs")             { $name = "kdelibs" };
		when ("libcgi-application-extra-plugin-bundle-perl") { $name = "libcgi-application-plugins-perl"};
		when (/^openssl\d$/)          { $name = "openssl" };
		when (/^tomcat\d/)            { $name = "tomcat7" };
		when (/^tomcat\d.\d$/)        { $name = "tomcat7" };
		when (/^libgda\d/)            { $name = "libgda4" };
		when (/^readline\d/)          { $name = "readline6" };
		when (/^libwnck\d/)           { $name = "libwnck" };
		when (/^xerces-c\d/)          { $name = "xerces-c" };
		when (/^libticalcs\d/)        { $name = "libticals" };
		when (/^libtifiles\d/)        { $name = "libtifiles" };
		when (/^db\d.\d$/)            { $name = "db4.8" };
		when (/^gcc-.*/)              { $name = "gcc" };
		when (/^automake\d+.*/)       { $name = "automake" };
		when (/^sun-java\d/)          { $name = "sun-java6" };
		when (/^open-jdk\d/)          { $name = "open-jdk7" };
		when (/^mbrola-es\d/)         { $name = "mbrola-es" };
		when (/^mgltools-.*/)         { $name = "mgltools" };
		when (/^coin\d$/)             { $name = "coin" };
		when (/^adobereader-\.*/)     { $name = "adobereader" };
		when (/^picon-\.*/)           { $name = "picon" };
		when (/^nvidia-graphics-drivers\.*/) { $name = "nvidia-graphics-drivers" };
		when (/^boost\d\.\d\d/)       { $name = "boost" };
		when (/^llvm-\d.\d/)          { $name = "llvm" };
		when (/^octave\d.\d/)         { $name = "octave" };
		when (/^libjibx\d.\d-java/)   { $name = "libjibx-java" };
		when (/^emacs2\d/)            { $name = "emacs23" };
		when (/^emacs2\d-non-dfsg/)   { $name = "emacs23" };
		when (/^libupnp\d/)           { $name = "libupnp" };
		when (/^python\d.\d/)         { $name = "python3.2" };
		when (/^postgresql-\d.\d/)    { $name = "postgresql-9.0" };
		when (/^ruby\d.\d/)            { $name = "ruby1.9" };
		when (/^php\d/)               { $name = "php5" };
		when (/^PHP\d/)               { $name = "php5" };

	};
	return $name;
}

## Should this advisory be skipped?
sub blacklistedDSA {
	my $dsa_id = shift or die "Advisory blacklist: no id given..";
	
	## check if DSA is blacklisted..
	my @id_blacklist = ("DSA-1975", "DSA-2360");
	
	grep ($_ eq $dsa_id, @id_blacklist) and return "true";
	
	return; # FALSE
}

## Static map to correct errors in DSAs
## Return fixed list of CVE IDs or 0 to skip DSA
sub fixDSAquirks {
	my $dsa_id = shift;
	my $dsa_state = shift;
	
	my @new_names = @{@$dsa_state[0]};
	my $new_date = @$dsa_state[1];
	my @new_cves = @{@$dsa_state[2]};
	
	## most of these have dupe/wrong CVE referenced
	given ($dsa_id) {
		when ($_ eq "085") {
		 	@new_cves = ("CVE-2001-1562", "LOCAL-03/04/05", "LOCAL-08/24/08");
		}
		when ($_ eq "745") {
		 	@new_cves = ("CVE-2005-1921", "CVE-2005-2106", "CVE-2005-1921");
		}
		when ($_ eq "1095") {
		 	@new_cves = ("CVE-2006-0747", "CVE-2006-1861", "CVE-2006-2661");
		}
		when ($_ eq "1284") {
		 	@new_cves = ("CVE-2007-1320", "CVE-2007-1321", "CVE-2007-1322",
			 	"CVE-2007-2893", "CVE-2007-1366");
		}
		when ($_ eq "1502") {
		 	@new_cves = ("CVE-2007-2821", "CVE-2007-3238", "CVE-2008-0193", "CVE-2008-0194");
		}
		when ($_ eq "1706") {
		 	@new_cves = ("CVE-2009-0135", "CVE-2009-0136");
		}
		when ($_ eq "1757") {
		 	@new_cves = ("CVE-2007-2383", "CVE-2008-7220", "CVE-2009-1208");
		}
		when ($_ eq "1896") {
		 	@new_cves = ("CVE-2009-3474", "CVE-2009-3475", "CVE-2009-3476");
		}
		when ($_ eq "1896") {
		 	@new_cves = ("CVE-2009-3474", "CVE-2009-3475", "CVE-2009-3476");
		}
		
		when ($_ eq "1931") {
		 	@new_cves = ("CVE-2009-0689", "CVE-2009-2463");
		}
		when ($_ eq "1989") {
		 	@new_cves = ("CVE-2010-0789");
		}
		when ($_ eq "1941") {
			@new_cves = ("CVE-2009-0755", "CVE-2009-3903", "CVE-2009-3904",
				"CVE-2009-3905", "CVE-2009-3606", "CVE-2009-3607", "CVE-2009-3608",
				"CVE-2009-3909", "CVE-2009-3938");
		}
		when ($_ eq "2004") {
		 	@new_cves = ("CVE-2010-0787", "CVE-2010-0547");
		}
		when ($_ eq "2008") {
		 	@new_cves = ("LOCAL-02/23/10", "LOCAL-02/23/10", "LOCAL-02/23/10",
				"LOCAL-02/23/10");
		}
		when ($_ eq "2043") {
		 	@new_cves = ("CVE-2010-2062");
		}
		when ($_ eq "2044") {
		 	@new_cves = ("CVE-2010-2062");
		}
		when ($_ eq "2056") {
		 	@new_cves = ("CVE-2010-2155", "CVE-2009-4882");
		}
		when ($_ eq "2092") {
		 	@new_cves = ("CVE-2010-1625", "CVE-2010-1448", "CVE-2009-4497");
		}
		when ($_ eq "2098") {
			@new_cves = ("CVE-2010-3659", "CVE-2010-3660", "CVE-2010-3661",
				"CVE-2010-3662", "CVE-2010-3663", "CVE-2010-3664", "CVE-2010-3665",
				"CVE-2010-3666", "CVE-2010-3667", "CVE-2010-3668", "CVE-2010-3669",
				"CVE-2010-3670", "CVE-2010-3671", "CVE-2010-3672", "CVE-2010-3673",
				"CVE-2010-3674");
		}
		when ($_ eq "2103") {
		 	@new_cves = ("CVE-2010-3076");
		}
		when ($_ eq "2218") {
		 	@new_cves = ("CVE-2011-1684");
		}
		when ($_ eq "2229") {
			@new_cves = ("CVE-2005-4494", "CVE-2006-0517", "CVE-2006-0518",
				"CVE-2006-0519", "CVE-2006-0625", "CVE-2006-0626", "CVE-2006-1295",
				"CVE-2006-1702", "CVE-2007-4525", "CVE-2008-5812", "CVE-2008-5813",
				"CVE-2009-3041");
		}
		when ($_ eq "2261") {
			@new_cves = ("CVE-2009-4078", "CVE-2009-4079", "CVE-2009-4059",
				"LOCAL-12/30/10", "LOCAL-12/30/10");
		}
		when ($_ eq "2262") {
		 	@new_cves = ("LOCAL-03/01/11", "LOCAL-03/01/11", "LOCAL-03/01/11",
				"LOCAL-03/01/11", "LOCAL-05/18/11", "LOCAL-05/18/11");
		}
		when ($_ eq "2286") {
		 	@new_names = ("phpmyadmin");
		}
		when ($_ eq "2289") {
			@new_cves = ( "LOCAL-07/27/11", "LOCAL-07/27/11", "LOCAL-07/27/11",
				"LOCAL-07/27/11", "LOCAL-07/27/11", "LOCAL-07/27/11", "LOCAL-07/27/11",
				"LOCAL-07/27/11", "LOCAL-07/27/11", "LOCAL-07/27/11", "LOCAL-07/27/11",
				"LOCAL-07/27/11");
		}
		
	};
	
	return (\@new_names, $new_date, \@new_cves);
}


## Fetch DSA from debian archive. Can't use tracker since dates are missing.
## DSA started counting in November 2000. We'll simply bruteforce which DSA
## was in which year and start in 2000 til current.
sub fetchDSA {
	my $dsa_id = shift;
	my $base_url = shift;
	my $year= 2000;
	my $current_year = (gmtime())[5] + 1900;
	my $dsa;
	
	trace "  Fetching DSA-$dsa_id\n";
	
	given ($dsa_id) {
		when ($_ >= 2140) { $year=2011; }
		when ($_ >= 1965) { $year=2010; }
		when ($_ >= 1694) { $year=2009; }
		when ($_ >= 1443) { $year=2008; }
		when ($_ >= 1245) { $year=2007; }
		when ($_ >= 929)  { $year=2006; }
		when ($_ >= 622)  { $year=2005; }
		when ($_ >= 406)  { $year=2004; }
		when ($_ >= 220)  { $year=2003; }
		when ($_ >= 96)   { $year=2002; }
		when ($_ >= 11)   { $year=2001; }
	};
	
	until (defined $dsa) {
		#my $url=	$config->{"dsa_base_url"} . $year . "/dsa-" . sprintf("%03d",$dsa_id);
		my $url=	$base_url . $year . "/dsa-" . sprintf("%03d",$dsa_id);
		$dsa = get $url;

		return $dsa if (defined $dsa);
	
		if ($year >= $current_year) {
			note "  Could not fetch DSA $dsa_id\n";
			return "";
		}
		$year++;
	}
}


# fetch FSAs from freeside. returns 3-tuple (("kfreebsd-8"), $date, @CVE) if
# kernel-fsa and () if not
our @__FSAINDEX;
our $__FSAIDXTIMESTAMP = 0;
sub fetchFSA($$) {
	
	my $id = shift;
	our $fsa_base_url = shift;

	sub getFSAurls() {

		$\ = "\n";
		#print $__FSAIDXTIMESTAMP;
		#print time;
		return @__FSAINDEX if $__FSAIDXTIMESTAMP + 60 >= time;
		#print "not caching";
		$__FSAIDXTIMESTAMP = time();
		our @fsaurls;

		sub start {
			my ($self, $tagname, $attr, $attrseq, $origtext) = @_;
			if ($tagname eq 'a') {
				if ($attr->{"href"} =~ /^FreeBSD-SA-/ && $attr->{"href"} ne "FreeBSD-SA-06%3a14-amd.txt") {
				 	# wtf? what douchbag added this as a FreeBSD-SA?
					push @fsaurls, $fsa_base_url . "/" . $attr->{href};
				}
			}
		}
		
		sub getIDfromFSA ($) {
			$_ = shift;
			/FreeBSD-SA-(\d\d)%3a(\d\d)/;
			my $year = $1;
			my $num = $2; 
			$year += 2000 if $year < 90;
			$year *= 1000;
			return $year + $num;
		}

		my $p = HTML::Parser->new;
		$p->handler(start => \&start);
		#$p->parse(get ($fsabase));
		$p->parse(get ($_)) foreach @fsaurls;
		$p->eof;
		
		
		@__FSAINDEX = sort { getIDfromFSA $a > getIDfromFSA $b } @fsaurls;
		return @__FSAINDEX;
	}

	my @fsas = getFSAurls();
	#	die "unexisting FSA" if $id > $#fsas;
 	return "" if ($id > $#fsas);
	return get $fsas[$id];
}

## Try to find new DSAs by iteration, return table of DSAs to process
sub checkDSAs {
	my $state = shift;
	my $config = shift;
	my %dsatable;
	my $next_dsa = $state->{"next_adv"};

	trace "Checking for new DSAs..\n";
	
	if ($next_dsa < $config->{"first_dsa"}) {
		note "Cache was deleted, starting at DSA $next_dsa\n";
		$next_dsa = $config->{"first_dsa"};
	}

	$next_dsa++ if (blacklistedDSA("DSA-".$next_dsa));
	my $dsa = fetchDSA($next_dsa, $config->{"dsa_base_url"});
	until ($dsa eq "") {
		debug "  Got DSA-$next_dsa\n";
		$dsa =~ s/.*<div\ id="inner">//si;
		$dsa =~ s/<div\ id="footer">.*//si;
		$dsatable{$next_dsa} = $dsa;
		$next_dsa++;
		$next_dsa++ if (blacklistedDSA("DSA-".$next_dsa));
		$dsa = fetchDSA($next_dsa, $config->{"dsa_base_url"});
	}

	my $next_fsa = $state->{"next_fsa"};

	if ($next_fsa < $config->{"first_fsa"}) {
		note "Cache was deleted, starting at FSA $next_fsa\n";
		$next_fsa = $config->{"first_fsa"};
	}

	my $fsa = fetchFSA($next_fsa, $config->{"fsa_base_url"});
	until ($fsa eq "") {
		debug "  Got FSA-$next_fsa\n";
		$dsatable{"FSA-$next_fsa"} = $fsa;
		$next_fsa++;
		$fsa = fetchFSA($next_fsa, $config->{"fsa_base_url"});
	}

	$state->{"next_adv"} = $next_dsa;
	$state->{"next_fsa"} = $next_fsa;
	
	return \%dsatable;
}


## Parse DSA html data and return array
## (src-pkg-name date (CVE-id)*)
sub parseDSAhtml {
	my $dsa = shift;
	
	my @dsa_names;
	my @dsa_CVEs;
	my @tmp;
	my %tmp;
	
	# Date Reported -> $dsa_date
	$dsa =~ /<dt>Date\ Reported:<\/dt>\s+<dd>(\d+)\s+(\w+)\s+(\d+)<\/dd>/s;
	my $dsa_date = parsedate("$1-$2-$3");
	die "  Unable to extract date from DSA" unless (defined $dsa_date);
	
	# Affected Packages -> @dsa_names
	$dsa =~ /<dt>Affected\ Packages:<\/dt>(.*)<\/dd>\s+<dt>Vulnerable:/s;
	die "Unable to find src package in DSA" unless defined $1;
	
	@tmp = split(/, /, $1);
	foreach my $tmpstr (@tmp) {
		if ($tmpstr =~ /<a href=.*>(.*)<\/a>/s) {
			#push(@dsa_names, $1);
			#push(@dsa_names, unifySrcName($1));
			$tmp{unifySrcName($1)} = 1;
		}
	}
	@dsa_names = keys %tmp;
	
	# Security database references (CVEs) -> @dsa_CVEs
	$dsa =~ /<dt>Security\ database\ references:<\/dt>\s+<dd>(.*)<\/dd>\s+<dt>More\ information:/s;
	die "  Unable to find CVEs in DSA" unless defined $1;
	
	@tmp = split(/(,|<br>)/, $1);
	foreach my $tmpstr (@tmp) {
		if ($tmpstr =~ /<a href=.*mitre.org.*>(.*)<\/a>/s) {
			push(@dsa_CVEs, $1);
		}
	}
	
	return (\@dsa_names, $dsa_date, \@dsa_CVEs);
}

# parse freebsd security announcements
sub parseFSA ($) {
	my $str = shift;
	my %FSA;
	my %details;

	($_, %FSA) = split /\n[IVX]+\.\s+(.*)\n/, $str;
	$FSA{"Preamble"} = $_;
	my @src = ("kfreebsd");
    # get cve and reldate
	/\nCVE Name:\s*(.*)\n/;
	my @CVE = split /, /, $1 if defined $1;
	/\nAnnounced:\**(.*)\n/;
	my $reldate = 0;
	$reldate = parsedate $1 if defined $1;
	return (\@src, $reldate, \@CVE) if /\nModule:\s*kernel\n/;
	
	# make sure this is a kernel package
	return () if !defined $FSA{"Correction details"};
	foreach (split /\n/, $FSA{"Correction details"}) {
		return (\@src, $reldate, \@CVE) if /^  src\/sys\/(?!conf\/newvers\.sh)/;    
	}
    return ();
}


1;