#!/usr/bin/perl

use strict;
use warnings;

use Storable; # persistant storage
#use LWP::Simple; # libwww-perl
#use LWP::Debug qw(+);
use LWP::UserAgent;
use Config::Auto; # libconfig-auto-perl
use Time::ParseDate; # libtime-modules-perl
#use Linux::Distribution qw(distribution_name distribution_version); # liblinux-distribution-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;

# mustn't load the huge SHA1 table into RAM..
use DBI;
use Tie::File;

use feature "switch";

eval {
	require "debian-security-advisory.pl";
	require "ubuntu-security-advisory.pl";
	require "common-vulnerability-entry.pl";
} or do {
	require "../debian-security-advisory.pl";
	require "../ubuntu-security-advisory.pl";
	require "../common-vulnerability-entry.pl";
};

# load user config, but don't parse it as perl
$Config::Auto::DisablePerl = 1;
my $config = Config::Auto::parse("apt-sec.conf");

# setup HTTP client
my $lwp = LWP::UserAgent->new(ssl_opts => {SSL_ca_path => "/etc/ssl/certs/"});
$lwp->agent("apt-sec " . $lwp->agent);

# global variables
my $secperday = 60*60*24;
my $now = mktime(gmtime()); # look, we're atomic!  :-)
my $verbosity = 1;

# global lookup tables
my %h_dsatable; # map dsa_id   => dsa
my %h_cvetable; # map cve_id   => (rel-date, time-to-fix, score1, score2, score3))
my %h_src2dsa;  # map src-name => dsa_id
my %h_dsa2cve;  # map dsa_id   => cve_id
my %h_src2mtbf; # map src-name => MTBFstats

my %h_deb2pkg;  # map deb-name => pkg-name
my %h_pkg2src;  # map pkg-name => src-name
my %h_sha1map;  # map sha1sum  => file-path
my %h_pkg2virt; # map pkg      => virt. pkgs
my %h_virt2pkg; # map virt. pkgs => pkg

my %h_state;    # remember what we've already parsed/downloaded

my $dsatable = \%h_dsatable;
my $cvetable = \%h_cvetable;
my $src2dsa  = \%h_src2dsa;
my $dsa2cve  = \%h_dsa2cve;
my $src2mtbf = \%h_src2mtbf;

my $deb2pkg  = \%h_deb2pkg;
my $pkg2src  = \%h_pkg2src;
my $pkg2virt = \%h_pkg2virt;
my $virt2pkg = \%h_virt2pkg;

my $db; # global SQL DB
my $dbargs = {AutoCommit => 0,
							PrintError => 0};

my $state    = \%h_state;

## logging
# 1 fatal errors
# 2 errors
# 3 note
# 4 trace
# 5 debug
sub msg {
	my $lvl = shift;
	my $msg = shift;
 	if ($lvl <= $config->{"loglevel"}) {
		print $msg;
	}
}
sub debug   { msg(5, shift); }
sub trace 	{ msg(4, shift); }
sub note 		{ msg(3, shift); }
sub error 	{ msg(2, shift); }
sub fatal 	{ msg(1, shift); }


## load state, different from DBs in that we always need it
sub load_state {
	my $cache = $config->{cache_dir};
	my $err = 0;
	
	eval { $state = retrieve($cache . "state"); } or do {
		## init with default state
		$state->{"next_adv"} = 0;
		$state->{"next_fsa"} = 0;
		$state->{"Packages"} = "";
		$state->{"Sources"} = "";
		$state->{"Sha1Sums"} = "";
		$state->{"vendor"} = "";
		$err++;
	};
	return 1-$err;
}


# helper function for getting HTTP(S) objects
sub get {
	my $url = shift;
	#my $req = HTTP::Request->new(GET => $url);
	my $ret = $lwp->get($url);
	
	unless ($ret->is_success) {
		fatal("Failed: " . $ret->status_line . "\n");
		return;
	}
	return $ret->content;
}

sub detect_distribution {
	my $dist = "";
	
	#$dist = distribution_name();
	$dist = "debian";
	#$dist = "ubuntu";
	if ( $dist eq "") {
		die "Error: Distribution unknown, not LSB conform, bailing out.\n";
	}
	
	if ($state->{"vendor"} eq "" || $state->{"vendor"} ne $dist) {
		note "Detected $dist distribution\n";
		$state->{"vendor"} = $dist;
	}
}

## save state, different from DBs in that we always need it
sub save_state {
	my $cache = $config->{cache_dir};
	eval {
		store($state,     $cache . "state");
		return 1;
	} or do {
		error "Failed to save state: ";
		error "$@\n";
	};
}
	
sub load_sha1lists {
	my $cache = $config->{cache_dir};

	$db = DBI->connect("dbi:SQLite:dbname=" . $cache . "sha1sums.db","","",$dbargs);
	
	eval {
		my @row = $db->selectrow_array("select * from SQLITE_MASTER where
			name='sha2pkg' and type='table'");
	} or do {
		# create table and reset last-seen info on Sha1Sums file
		$db->do("create table sha2pkg (hash char(20) primary key, deb text, src text)");
		die "$DBI::errstr\n" if ($db->err());
		$state->{"Sha1Sums"} = "";
	};
}

sub save_sha1lists {
	my $cache = $config->{cache_dir};
	
	$db->commit();
	$db->disconnect();
	die "$DBI::errstr\n" if ($db->err());
}

## persistant storage
sub load_DBs {
	my $cache = $config->{cache_dir};
	my $err = 0;
	
	eval {
	 	$dsatable  = retrieve($cache . "dsatable");
		$cvetable  = retrieve($cache . "cvetable");
		$src2dsa   = retrieve($cache . "src2dsa");
		$dsa2cve   = retrieve($cache . "dsa2cve");
		$src2mtbf  = retrieve($cache . "src2mtbf");
		$pkg2virt  = retrieve($cache . "pkg2virt");
		$virt2pkg  = retrieve($cache . "virt2pkg");
	} or do {
		$state->{"next_adv"} = 0; # restart parsing of DSAs..
	 	%$dsatable  = ();
		%$cvetable  = ();
		%$src2dsa   = ();
		%$dsa2cve   = ();
		%$src2mtbf  = ();
		$err++;
	};
	
	eval { $deb2pkg  = retrieve($cache . "deb2pkg");
	} or do {
		# reset last-seen info on Packages
		$state->{"Packages"} = "";
		%$deb2pkg=();
		$err++;
	};
	
	eval { $pkg2src  = retrieve($cache . "pkg2src");
	} or do {
		# reset last-seen info on Sources
		$state->{"Sources"} = "";
		%$pkg2src=();
		$err++;
	};
	
	return 1-$err;
}


## persistant storage
sub save_DBs {
	my $cache = $config->{cache_dir};

	eval {
		# program status data
		store($state,     $cache . "state");
		# parsed/evaluated security data
		store($dsatable,  $cache . "dsatable");
		store($cvetable,  $cache . "cvetable");
		store($src2dsa,   $cache . "src2dsa");
		store($dsa2cve,   $cache . "dsa2cve");
		store($src2mtbf,  $cache . "src2mtbf");
		# parsed Debian packages data
		store($deb2pkg,   $cache . "deb2pkg");
		store($pkg2src,   $cache . "pkg2src");
		store($pkg2virt,  $cache . "pkg2virt");
		store($virt2pkg,  $cache . "virt2pkg");
		
		return 1;
	} or do {
		error "Failed to save cache file(s): ";
		error "$@\n";
	};
}


## Fetch current Packages, Sources and sha1sums files
## These are needed to find CVE stats by sha1sums/pkg-names
## Only Sha1Sums is custom generated, others are from Debian.
## FIXME: Server might do on-the-fly gzip (but should not for bzip2)
## Return: 1 on success, to signal that new parsing is needed.
sub fetchMeta {
	my $file = shift;
	my $urlbase =	$config->{"pkg_base_url"};
	my $dir = $config->{"cache_dir"};
	my $bzFile = $file . ".bz2";
	my $url = $urlbase . $bzFile;
	
	debug "Checking meta file from $url\n";
	
	my $req = HTTP::Request->new(GET => $urlbase . $bzFile);
	my $ret = $lwp->request($req, $dir . $bzFile);
	
	if ($ret->is_success) {
		# check if the file actally changed..
		open(FILE, $dir . $bzFile) or die "Can't open '$dir$bzFile': $!";
		binmode(FILE);
		my $stamp = Digest::MD5->new->addfile(*FILE)->hexdigest;

		if ($state->{$file} eq $stamp) {
			debug "  unchanged..\n";
			return 0;
		} else {
			$state->{$file} = $stamp;
		}

		# file seems new, unpack for parsing..(TODO: should keep in $tmp..)
		bunzip2 $dir . $bzFile => $dir . $file#, AutoClose => 1
			or die "bunzip2 failed: $Bunzip2Error\n";
		close(FILE);
		return 1; # file changed
		
	} else {
		error "Failed: " . $ret->status_line . "\n";
		return 0; # no updates
	}
}
	
# Sources and Packages are not completely consistent, esp for debian-multimedia
# He we store manual mappings for these..
sub addOrphanPkgs {
	my $pkg2src = shift;

	$pkg2src->{"liblame-dev"} = "lame";
	$pkg2src->{"lame-extras"} = "lame";
	$pkg2src->{"moonlight"} = "moon";
	$pkg2src->{"libmoon0"} = "moon";
	$pkg2src->{"xmms-mp4"} = "xmms2";
	$pkg2src->{"xmms-mp4"} = "xmms2";
  $pkg2src->{"lazarus-src-0.9.30"} = "lazarus";
  $pkg2src->{"lazarus-ide-0.9.30"} = "lazarus";
  $pkg2src->{"lcl-qt4-0.9.30"} = "lazarus";
  $pkg2src->{"lazarus-ide-qt4-0.9.30"} = "lazarus";
  $pkg2src->{"lcl-gtk2-0.9.30"} = "lazarus";
  $pkg2src->{"lazarus-ide-gtk2-0.9.30"} = "lazarus";
  $pkg2src->{"lcl-units-0.9.30"} = "lazarus";
  $pkg2src->{"lazarus-0.9.30"} = "lazarus";
  $pkg2src->{"lazarus-doc-0.9.30"} = "lazarus";
  $pkg2src->{"lcl-0.9.30"} = "lazarus";
  $pkg2src->{"lcl-utils-0.9.30"} = "lazarus";
  $pkg2src->{"lcl-nogui-0.9.30"} = "lazarus";
  $pkg2src->{"libx264-65"} = "x264";
  $pkg2src->{"libx264-114"} = "x264";
  $pkg2src->{"libx264-60"} = "x264";
#  $pkg2src->{"libmlt3"}
#  $pkg2src->{"libgmerlin-avdec0"}
#  $pkg2src->{"libxul-dev"}
#  $pkg2src->{"libmyth-0.23.1-0"}
#  $pkg2src->{"libmpeg3hv"}
#  $pkg2src->{"libquicktimehv"}
#  $pkg2src->{"libxul0d"}
#  $pkg2src->{"acroread-fonts-kor"}
}

## Parse dpkg Packages file, create map deb-name->pkg-name
sub parsePackages {
	my $pkgfile = shift;
	my $dir = $config->{"cache_dir"};
	my $pkgname;
	my @provides;
	my @lines;
	
	%$deb2pkg = ();
	%$pkg2virt = ();
	%$virt2pkg = ();

	trace "Parsing Packages file...\n";
	
 	$pkgfile = $dir . $pkgfile;
	
	tie @lines, 'Tie::File', $pkgfile or die "Unable to open file $pkgfile";
	LINE: foreach my $line (@lines) {
		if ($line =~ /^Package:\ (.+)/) {
			$pkgname = $1;
		} elsif ($line =~ /^Filename:\ .*\/(\S+)/) {
			$deb2pkg->{$1} = $pkgname;
		} elsif ($line =~ /^Provides:\ +(.+)/) {
			@provides = split(/,\ /, $1);
			foreach my $virt (@provides) {
				$virt =~ s/(\s|,)//g;
				push @{$pkg2virt->{$pkgname}}, $virt unless ($virt ~~ @{$pkg2virt->{$pkgname}});
				push @{$virt2pkg->{$virt}}, $pkgname unless ($pkgname ~~ @{$virt2pkg->{$virt}});
			}
		} else {
			next LINE;
		}
	}
	untie @lines; # close file
	
	return;
}

## Parse dpkg Sources file, create map pkg-name->src-name
sub parseSources {
	my $srcfile = shift;
	my $dir = $config->{"cache_dir"};
	my $srcname;
	my @pkgnames;
	my $checklinecontinuation=0;
	my @lines;
	
	%$pkg2src = ();
	
	trace "Parsing Sources file...\n";
	
	$srcfile = $dir . $srcfile;
	
	tie @lines, 'Tie::File', $srcfile or die "Unable to open file $srcfile";
	LINE: foreach my $line (@lines) {
		## sometimes, list of binary pkgs has newline, so we need to check next line..
		if ($checklinecontinuation == 1) {
			if ($line =~ /^[[:alpha:]]+:\ /) {
				$checklinecontinuation = 0;
			} else {
				@pkgnames = split(/,\ /, $line);
				foreach my $pkg (@pkgnames) {
					$pkg =~ s/(\s|,)//g;
					if ($pkg ne "") {
						$pkg2src->{$pkg} = unifySrcName($srcname);
					}
				}
			}
			next LINE;
		}
		if ($line =~ /^Package:\ (.+)/) {
			$srcname = $1;
		} elsif ($line =~ /^Binary:\ (.+)/) {
			@pkgnames = split(/,\ /, $1);
			foreach my $pkg (@pkgnames) {
				$pkg =~ s/(\s|,)//g;
				$pkg2src->{$pkg} = unifySrcName($srcname);
			}
			$checklinecontinuation = 1;
		} else {
			next LINE;
		}
	}
	untie @lines; # close file
		
	# Sources and Packages are sometimes not really consistent. Here we add some
	# manual entries and check for remaining pkgs without srcpkg..
	addOrphanPkgs($pkg2src);
	
	foreach my $pkg (values %$deb2pkg) {
		print "Orphan Package: $pkg\n" unless (defined $pkg2src->{$pkg});
	}
	
	return;
}

sub addSHA1 {
	my $hash = shift;
	my $deb = shift;
	my $src = shift;
	
	my ($thash,$tdeb,$tsrc) = getSHA1($hash);
	
	# if already recorded, extend and/or mark as non-unique
	if (defined $thash) {
		
		my @tdebs = split(/,/, $tdeb);
		my @tsrcs = split(/,/, $tsrc);
	
		if (! grep {$_ eq $deb} @tdebs) {
			#print "Adding deb $deb to $tdeb..\n";
			my $tmp = $tdeb . "," . $deb;
			$db->do("update sha2pkg set deb='$tmp' where hash='$hash'");
			die "$DBI::errstr\n" if ($db->err());
		}
		if (! grep {$_ eq $src} @tsrcs) {
			print "Adding src $src to $tsrc..\n";
			my $tmp = $tsrc . "," . $src;
			$db->do("update sha2pkg set src='$tmp' where hash='$hash'");
			die "$DBI::errstr\n" if ($db->err());
		}
	
	} else {
		$db->do("insert into sha2pkg (hash, deb, src) VALUES('$hash', '$deb', '$src')");
		die "Error inserting $hash/$deb/$src: $DBI::errstr\n" if ($db->err());
	}
}

sub getSHA1 {
	my $hash = shift;

	my @res = $db->selectrow_array("select * from sha2pkg where hash = '$hash'");
	
	return @res;
}

## Parse Sha1Sums file. Format: "sha1sum::deb-name::unix-file-path"
## Create 2 maps: sha1sum->file, file->deb-name
sub parseSha1Sums {
	my $sha1file = shift;
	my $dir = $config->{"cache_dir"};
	my @lines;
	
	trace "Parsing Sha1Sums file...\n";
	
	# delete existing table first.. (or else everything will be collisions!)
	$db->do("delete from sha2pkg");
	
	$sha1file = $dir . $sha1file;
	tie @lines, 'Tie::File', $sha1file or die "Unable to open file $sha1file";
	LINE: foreach my $line (@lines) {
		
		unless ($line =~ /^(\w+)::(\S+)$/) {
			die "Sha1Sums parse error, line reads: \n>>$line<<";
		}
		
		# ignore the hash of '\n' (many collisions due to empty files)
		next if ($1 eq 'da39a3ee5e6b4b0d3255bfef95601890afd80709');
		
		# To avoid collisions in the SHA table we try to resolve to src pkg right away.
		# But that means we must resolve *all* packets, which often means that we
		# have to print errors and manually fix inconsistent meta-data. :-/
		# To reduce this problem, addSHA1() keeps track of collisions and then we
		# only complain later on, when some actually measured SHA1 value has
		# ambigious security info.
		# The .deb package names are only stored for informational purposes.
		my $binpkg = $deb2pkg->{$2};
		if ($binpkg) {
			my $srcpkg = $pkg2src->{$binpkg};
			if ($srcpkg) {
				addSHA1 $1, $2, unifySrcName($srcpkg);
			} else {
				note "No srcpkg known for pkg $binpkg (inconsistent Packages/Sources data?)\n";
				addSHA1 $1, $2, "";
			}
		} else {
			note "No pkg known for deb $2 (stale entries in sha1sums?)\n";
		}
	}
	untie @lines; # close file
}

## Parse local dpkg status, return list of debs
sub parseStatus {
	my $stsfile = shift;
	my @pkglist;
	my $pkgname;
	
	trace "Parsing dpkg status..\n";
	
	open (PKG, "< $stsfile");
	my @lines = <PKG>;
	
	LINE: foreach my $line (@lines) {
		if ($line =~ /^Package:\ (.+)/) {
			$pkgname = $1;
		} elsif ($line =~ /^Status:.*installed/) {
			push @pkglist, $pkgname;
		} else {
			next LINE;
		}
	}
	close(PKG);

	error "Could not find any installed packages in status file." if ($#pkglist <= 0);
	return \@pkglist;
}

sub parseAdvisory {
	my $adv = shift;
	
	given ($state->{"vendor"}) {
		when ($_ eq "debian") { 
			return parseFSA $adv if $adv =~ /FreeBSD-SA/m;
			return parseDSAhtml($adv); 
		}
		when ($_ eq "ubuntu") { return parseUSNhtml($adv); }
#		when ($_ eq "redhat") { return checkRHSA; }
		default               { die "Unsupported distribution $_"; }
	};
}

sub fixAdvisoryQuirks {
	my @arg = @_;
	given ($state->{"vendor"}) {
		
		when ($_ eq "debian") { return fixDSAquirks(@arg); }
		when ($_ eq "ubuntu") { return fixUSNquirks(@arg); }
#		when ($_ eq "redhat") { return checkRHSA; }
		default               { die "Unsupported distribution $_"; }
	};
}

## Extract CVE ids from new advisories and print URL for mirror script
sub printCVEs {
	my $id    = shift; # Advisory ID
	my $adv   = shift; # Advisory to scan
	my $url;
	my %cves;

	trace "Looking for CVEs in advisory.. \n";

	my @dsastats = parseAdvisory($adv);
	return if !@dsastats;
	
	## fix DSAs that don't contain correct CVE refs
	@dsastats = fixAdvisoryQuirks($id, \@dsastats);
	
	foreach my $cve_id (@{$dsastats[2]}) {
		$cve_id =~ s/^CAN/CVE/;
		$cves{$cve_id} = 1;
	}
	
	foreach my $cve (keys %cves) {
		print "NeedCVE: " . $config->{"cve_base_url"}  . $cve . "\n";
		print "NeedCVE: " . $config->{"cvss_base_url"} . $cve . "\n";
	}
}

## Update internal vuln. DB with new Advisory info
## Creates CVEtable for MTBF computation:
##    ( cve-id => (date, delay, score1, score2, score3))
sub updateCVETables {
	my $id   = shift; # Advisory to merge into tables
	my @cvestats;

	trace "Updating vulnerability database with advisory ".$state->{"vendor"}."/$id\n";

	my $adv = $dsatable->{$id};
	#print $dsatable->{$id} if $id eq "FSA-301";
	my @dsastats = parseAdvisory($adv);
	return if !@dsastats;
	
	## fix DSAs that don't contain correct CVE refs
	@dsastats = fixAdvisoryQuirks($id, \@dsastats);
	
	foreach my $srcpkg (@{$dsastats[0]}) {
		push @{$src2dsa->{$srcpkg}}, $id;
		push @{$dsa2cve->{$id}}, @{$dsastats[2]};
	}

	foreach my $cve_id (@{$dsastats[2]}) {
		my $cve = fetchCVE($cve_id, $config->{"cve_base_url"}, $config->{"cvss_base_url"});
		@cvestats = parseCVE($cve_id, $cve);

	 	if ($cvestats[0] > $dsastats[1] || $cvestats[0] == 0) {
			$cvestats[0] = $dsastats[1];
		}

		my @cvedata = ( $cvestats[0], $dsastats[1]-$cvestats[0],
			              $cvestats[1], $cvestats[2], $cvestats[3] );

		$cvetable->{$cve_id} = \@cvedata;
	}
}

## Check for updates on Package information
sub aptsec_update {
	my $newAdv;
	
	unless ("--offline" ~~ @ARGV) {
		fetchMeta("Packages");
		fetchMeta("Sources");
		fetchMeta("Sha1Sums");
	}
		
	unless ("--cves" ~~ @ARGV) {
		parsePackages("Packages");
		parseSources("Sources");
		
		unless ("--nosha1" ~~ @ARGV) {
			parseSha1Sums("Sha1Sums");
		}
	}
	
	given ($state->{"vendor"}) {
		when ($_ eq "debian") { $newAdv = checkDSAs($state, $config); }
		when ($_ eq "ubuntu") { $newAdv = checkUSNs($state, $config); }
		#when ($_ eq "redhat") { ($id,$adv) = checkRHSA; }
		default               { die "Unsupported distribution $_"; }
	};
	
	foreach my $id (keys %$newAdv) {
		# if not known, process advisory 
		if ($dsatable->{$id}) {
			note $state->{"vendor"} . " advisory $id already known.\n";
		}
		elsif ("--cves" ~~ @ARGV) {
		 	## scan for CVE urls only?
			printCVEs($id, $newAdv->{$id});
		}
		else {
		 	## store advisory and parse it
			$dsatable->{$id} = $newAdv->{$id};
			updateCVETables($id);
		}
	}

	# recompute all pkg statistics
	foreach my $srcpkg (keys %$src2dsa) {
		processCVEs($srcpkg);
	}
}

## find list of src pkgs from bin pkgs based on pkg2src
sub resolvePkg2Src {
	my $pkglist = shift;
	my @srclist;
	my %tmp;
	my $srcpkg;

	foreach my $pkg (@$pkglist) {
		$srcpkg = $pkg2src->{$pkg};
		 
		if (defined $srcpkg) {
			# unique..
			$tmp{$pkg2src->{$pkg}} = 1;
		} else {
			note "Could not find source package for: $pkg\n";
		}
	}
	
	@srclist = keys %tmp;
	
	return \@srclist;
}


## compute and store MTBF, MTBR and Scores of each src pkg
## output: %src2mtbf:
##  (srcpkg=> (begin, num, delaysum, scoresum, maximpact, MTTF, MTTFl))
sub processCVEs {
	my $pkg = shift;
	my @stats = ($now, 0, 0, 0, 0);
	my %cvestats;
	my $lambda = $config->{"lambda"};
	
	trace "Processing package $pkg";
	
	## @cvestats = (date base-score impact-score exploit-score)
	foreach my $dsa_id (@{$src2dsa->{$pkg}}) {
		foreach my $cve_id (@{$dsa2cve->{$dsa_id}}) {
			$cvestats{$cvetable->{$cve_id}[0]}++;
			
			$stats[1]++;
			$stats[2]+= $cvetable->{$cve_id}[1];
			$stats[3]+= $cvetable->{$cve_id}[2];
			if ($stats[4] < $cvetable->{$cve_id}[3]) {
				$stats[4] = $cvetable->{$cve_id}[3];
			}
		}
	}

	# Ignore pkgs with less than one incident, should not happen..
	return if ($stats[1] < 1);

	my $date;
 	my $prev_date=0;
 	my $delay;
	my $months;
	my $weight=0;
	my @dates = sort (keys %cvestats);
	$stats[0] = $dates[0];
 	$stats[5]=0;
 	$stats[6]=0;
	
	foreach $date (@dates) {
		#print "$cvestats{$date} $date\n";
		foreach (1..$cvestats{$date}) {
			if ($prev_date > 0) {
				$months = ($now - $date)/$secperday/30;
				$delay = ($date - $prev_date)/$secperday;
				#$delay = 0.0000001 if ($delay == 0);
				#print "delay: $delay\n";
				$stats[5] += $delay;
				$stats[6] += $delay*exp(-$months/$lambda);
				$weight += exp(-$months/$lambda);
			}
			$prev_date = $date;
		}
	}

	## correct stats in case that last vuln. is so long ago that the
	## current reliability should be increased.
	## only use if we have more than one complete interval already
	$delay = ($now - $dates[$#dates])/$secperday;
	return if ($stats[1] == 1 && $delay < 50);
	if ($delay > $stats[5]/$stats[1] || $delay > $stats[6]/$weight) {
		$stats[5] += $delay;
		$stats[5] /= $stats[1];
		$stats[6] += $delay * exp(-0);
		$stats[6] /= $weight + exp(-0);
	} else {
		$stats[5] /= $stats[1]-1; # intervals = incidents-1
		$stats[6] /= $weight;
	}

	# save
	if ($stats[5] > 0 && $stats[6] > 0) {
		$src2mtbf->{$pkg} = \@stats;
	} else {
		die "@stats";
	}
}

# print some meta-info on internal data
sub aptsec_about {
	
	my $num_dsa = keys %$dsatable;
	my $num_cve = keys %$cvetable;
	my $num_pkg = keys %$pkg2src;
	my $num_src = keys %$src2dsa;

	#printf("\nWorking DB has %d binary packages and SHA-1 file hashes.\n",
	printf("\nThe current database records %d binary packages and %d DSAs.\n",
	 			 $num_pkg, $num_dsa);
  printf("%d CVEs are associated with %d source packages.\n",
				 $num_cve, $num_src);

}

# use pkg provides info to suggest alternative programs
sub aptsec_alternatives {

	my $pkg = shift;
	my @pkgs;
	my %provs;
	my %alts;
	my $lines;
	
	## pkg is normally not src pkg. resolve it to src and then
	## consider all bin pkgs created from it
	if ($pkg2src->{$pkg}) {
		print "\nResolving $pkg to $pkg2src->{$pkg}\n\n";
		$pkg = $pkg2src->{$pkg};
	}
		
	foreach (keys %$pkg2src) {
		if ($pkg2src->{$_} eq $pkg) {
			push @pkgs, $_;
		}
	}
	
	foreach $pkg (@pkgs) {
		#print "Provided by $pkg:\n";
		foreach (@{$pkg2virt->{$pkg}}) {
			#print "$_\n";
			$provs{$_} = 1;
		}
	}

	print "\nSimilar functions are provided by:\n\n";
	foreach my $func (keys %provs) {
		#print "Function $func also is provided by:\n\t";

		foreach (@{$virt2pkg->{$func}}) {
			$alts{$pkg2src->{$_}} = 1;
		}
	}
	$lines=0;
	foreach (keys %alts) {
		print "$_ ";
		$lines++;
	}
	print "-" unless $lines;
	print "\n\n";

}

## print overview for pkg high scores
sub aptsec_hitlist {
	my @stats;
	my @pkg = (keys %$src2mtbf);
	
	# TODO: Some DSAs have to recognized CVEs, integrate security tracker
	# foreach my $pkg (@pkg) {
	# 	print "no dsa for $pkg\n" unless defined ($src2dsa->{$pkg})
	# }

	print "\nOverall MTBF/MTTF:\n\n";
	foreach my $pkg (@pkg) {
		my @stats = @{$src2mtbf->{$pkg}};
		printf("MTTF:%6.1f, STP(12):%5.1f, MTTFl:%6.1f, STPl(12):%5.1f, Vuln:%3d, Pkg: %s\n",
		$stats[5],
		365/$stats[5],
		$stats[6],
		365/$stats[6],
		$stats[1],
		$pkg);
	}
}
	
## evaluation function wrapper
## parameter is package or path to status file or nil, in which
## case we process all pkgs with recorded vulnerabilities
sub aptsec_status_2010 {
	my $pkg = shift;
	my @stats;
	my @pkg = (keys %$src2dsa);
	my $year;

	my $num_dsa = keys %$dsatable;
	my $num_cve = keys %$cvetable;
	my $num_pkg = keys %$pkg2src;
	my $num_src = keys %$src2dsa;

	if (defined $pkg) {
		eval {
			my $srclist = resolvePkg2Src(parseStatus($pkg));
			@pkg = @$srclist;
			#printSystemStats($srclist);
		} or do {
		 	print "Interpreting parameter $pkg as packet..";
			@pkg = ($pkg);
		}
	}

	# individual package stats until end of given year
	$year=2009;
	print "\n Overall MTBF/MTTF until $year:\n";
	simulate_stats($_,$year) foreach (@pkg);
	
	# actual vulnerabilities for a given year
	$year=2010;
	print "\n Stats of year $year:\n";
	show_period($_,$year) foreach (@pkg);
}

sub show_period {
	my $pkg = shift;
	my $year = shift;
	#my $startdate = shift;
	#my $enddate = shift;
	my $start = parsedate("1.1.$year");
	my $end   = parsedate("31.12.$year");
	my @cvelist;
	my %cvestats;
	my $num=0;

	## @cvestats = (date base-score impact-score exploit-score)
	foreach my $dsa_id (@{$src2dsa->{$pkg}}) {
		foreach my $cve_id (@{$dsa2cve->{$dsa_id}}) {
			#my $yr = 1900 + (gmtime($cvetable->{$cve_id}[0]))[5];
			#if ($startdate < $yr && $enddate >= $yr) {
			if ($start < $cvetable->{$cve_id}[0] && $end > $cvetable->{$cve_id}[0]) {
				push @{$cvestats{$cvetable->{$cve_id}[0]}}, $cve_id;
				$num++;
			}
		}
	}
	# Ignore pkgs with less than two incidents
	return if ($num < 1);

	foreach my $date (sort (keys %cvestats)) {
		#print "Date: $date, CVEs: @{$cvestats{$date}}\n";
	}
	
	printf("  In %4d: MTBF: %3d, new vuln: %3d, Pkg:%s\n",
		$year, ($end-$start)/$secperday/$num, $num, $pkg);
	
	#foreach my $dsa_id (@{$src2dsa->{$pkg}}) {
	#	foreach my $cve_id (@{$dsa2cve->{$dsa_id}}) {
	#		my ($sec,$min,$hrs,$day,$mon,$yr) = gmtime($cvetable->{$cve_id}[0]);
	#		printf "%s: Base Score: %04.1f, %02d.%02d.%04d\n",
	#		$cve_id, $cvetable->{$cve_id}[2], $day, $mon+1, $yr+1900;
	#}
}

## evaluation helper
## compute stats until date given in $2, then compute stats
## for the next year to check accuracy of the prediction.
## @cvestats = (date base-score impact-score exploit-score)
sub simulate_stats {
	my $pkg = shift;
	my $year = shift;
	my $start = 0;
	my $end   = parsedate("31.12.$year");
	my $now   = $end;
	my @stats = ($now, 0, 0, 0, 0);
	my %cvestats;
	my $lambda = $config->{"lambda"};


	#unless (defined @{$src2dsa->{$pkg}}) {
	#	print "No vulnerability record for package $pkg\n";
	#	return;
	#}
	foreach my $dsa_id (@{$src2dsa->{$pkg}}) {
		foreach my $cve_id (@{$dsa2cve->{$dsa_id}}) {
			#my $yr = 1900 + (gmtime($cvetable->{$cve_id}[0]))[5];
			#if ($startdate <= $yr && $enddate > $yr) {
			if ($start < $cvetable->{$cve_id}[0] && $end > $cvetable->{$cve_id}[0]) {
				$cvestats{$cvetable->{$cve_id}[0]}++;
			
				$stats[1]++;
				$stats[2]+= $cvetable->{$cve_id}[1];
				$stats[3]+= $cvetable->{$cve_id}[2];
				if ($stats[4] < $cvetable->{$cve_id}[3]) {
					$stats[4] = $cvetable->{$cve_id}[3];
				}
			}
		}
	}

	# Ignore pkgs with less than two incidents
	return if ($stats[1] < 2);

	my $date;
 	my $prev_date=0;
 	my $delay;
	my $months;
	my $weight=0;
	my @dates = sort (keys %cvestats);
	$stats[0] = $dates[0];
 	$stats[5]=0;
 	$stats[6]=0;
	
	foreach $date (@dates) {
		#print "$cvestats{$date} $date\n";
		foreach (1..$cvestats{$date}) {
			if ($prev_date > 0) {
				$months = ($now - $date)/$secperday/30;
				$delay = ($date - $prev_date)/$secperday;
				#$delay = 0.0000001 if ($delay == 0);
				#print "delay: $delay, age: $months\n";
				$stats[5] += $delay;
				$stats[6] += $delay*exp(-$months/$lambda);
				$weight += exp(-$months/$lambda);
			}
			$prev_date = $date;
		}
	}

	## correct stats in case that last vuln. is so long ago that the
	## current reliability should be increased.
	$delay = ($now - $dates[$#dates])/$secperday;
	return if ($stats[1] == 1 && $delay < 50);
	if ($delay > $stats[5]/$stats[1] || $delay > $stats[6]/$weight) {
		$stats[5] += $delay;
		$stats[5] /= $stats[1];
		$stats[6] += $delay * exp(-0);
		$stats[6] /= $weight + exp(-0);
		#print "delay: $delay, age: 0, weight: 1\n";
	} else {
		#print "delay: $delay, age: 0, weight: 1\n";
		$stats[5] /= $stats[1]-1; # intervals = incidents-1
		$stats[6] /= $weight;
	}

	printf "  Til $year ";
	#printf("MTTF:%6.1f, STP(12):%5.1f,   MTTFl:%6.1f, STPl(12):%5.1f, MTRR:%6.1f,   Vuln:%4d, Pkg: %s\n",
	printf("MTTF:%6.1f, STP(12):%5.1f,    MTTFl:%6.1f, STPl(12):%5.1f,    Vuln:%3d, Pkg: %s\n",
		$stats[5],
		365/$stats[5],
		$stats[6],
		365/$stats[6],
		#$stats[2]/$stats[1]/$secperday,
		$stats[1],
		$pkg);
	
	return @stats;
}

## Use local system status(dpkg DB) for printing system status report
sub aptsec_status {
	my $path;
	$path	= shift or $path = "/var/lib/dpkg/status";
	my $srclist = resolvePkg2Src(parseStatus($path));

	printSystemStats($srclist);
}

## Print 'trustworthiness' of a set(system) of src packages
sub printSystemStats {
	my $srclist = shift;
	my $mtbf=0;
	my $mtrr=0;
	my $mttf=0;
	my $mttfl=0;
	my $num=0;
	
	# we can assume that pkgs are independent (right?)
	PKG: foreach my $pkg (@$srclist) {
		my $rstats = $src2mtbf->{$pkg} or next PKG;
		my @stats = @$rstats;
		
		$mtbf+=1/(($now-$stats[0])/$stats[1]/$secperday);
		$mttf+=1/$stats[5];
		$mttfl+=1/$stats[6];
		$mtrr+=$stats[2]/$stats[1]/$secperday;
		
		if ($verbosity > 0) {
			#printf("MTBF: %6.1f, MTTF: %6.1f, MTTFl: %6.1f, MTRR: %6.1f, \t%s\n",
			printf("MTTF: %6.1f, MTTFl: %6.1f,    Vuln: %3d, Pkg: %s\n",
				#($now-$stats[0])/$stats[1]/$secperday,
				$stats[5],
				$stats[6],
				#$stats[2]/$stats[1]/$secperday,
				$stats[1],
				$pkg);
		}
		$num++;
	}

	printf "\n";
	printf "Packages with past vulnerabilities installed: %d\n", $num;
	if ($num > 0) {
		#printf "System MTRR:  %5.1f days\n", $mtrr/$num;
		#printf "System MTBF:  %5.1f days per failure\n", 1/$mtbf;
		printf "System MTTF:  %7.1f days per failure\n", 1/$mttf;
		printf "System MTTFl: %7.1f days per failure\n", 1/$mttfl;
		printf "System STP(12) %6.1f failures per year\n", 365*$mttf;
		printf "System STPl(12) %5.1f failures per year\n", 365*$mttfl;
		printf "\n";
	}
}

## show info on a single src pkg, resolv to src if needed
sub aptsec_show {
	my $pkg = shift;
	my $ADV;
	my $lines;
	
	unless (defined $pkg) {
		aptsec_help();
		exit;
		
	}
	
	given ($state->{"vendor"}) {
		when ($_ eq "debian") { $ADV = "DSA-"; }
		when ($_ eq "ubuntu") { $ADV = "USN-"; }
		default               { die "Unsupported distribution $_"; }
	};

	if (!($src2dsa->{$pkg}) && $pkg2src->{$pkg}) {
		print "\nResolving $pkg to $pkg2src->{$pkg}\n";
		$pkg = $pkg2src->{$pkg};
	}

	print "\nThe following binary packages are created from $pkg:\n\n";
	$lines=0;
	foreach (keys %$pkg2src) {
		if ($pkg2src->{$_} eq $pkg) {
			print "$_\n";
			$lines++;
		}
	}
	print "-\n" if ($lines < 1);
	
	unless ($src2dsa->{$pkg} && $src2mtbf->{$pkg}) {
		print "\nNo vulnerabilities recorded for source package $pkg.\n";
		exit;
	}
	
	print "\nAdvisories on package $pkg:\n\n";
	
	foreach my $dsa_id (sort @{$src2dsa->{$pkg}}) {
		print "$ADV$dsa_id\n";
		foreach my $cve_id (@{$dsa2cve->{$dsa_id}}) {
			my ($sec,$min,$hrs,$day,$mon,$yr) = gmtime($cvetable->{$cve_id}[0]);
			printf "%s: Base Score: %04.1f, %02d.%02d.%04d\n",
		 	       $cve_id, $cvetable->{$cve_id}[2], $day, $mon+1, $yr+1900;
		}
	}
	my @stats = @{$src2mtbf->{$pkg}};
	my ($sec,$min,$hrs,$day,$mon,$yr) = gmtime($stats[0]);
	print  "\nOverall vulnerability stats:\n\n";
	printf "  First vulnerability:   %02d.%02d.%04d\n", $day, $mon+1, $yr+1900;
	printf "  Total vulnerabilities: %d\n", $stats[1];
	printf "  Average Base Score:    %04.2f/10\n", $stats[3]/$stats[1];
	printf "  Highest Impact Score:  %d/10\n", $stats[4];
#	printf "  MTBF  in days:         %.2f\n", ($now-$stats[0])/$stats[1]/$secperday;
	printf "  MTTF:         %.1f days/vuln\n", $stats[5];
	printf "  MTTFl:        %.1f days/vuln\n", $stats[6];
	printf "  STP(12):      %.1f vuln/yr\n", 365/$stats[5];
	printf "  STPl(12):     %.1f vuln/yr\n", 365/$stats[6];
#	printf "  MTRR  in days:         %.2f\n\n", $stats[2]/$stats[1]/$secperday;
}

sub aptsec_help {
	print "\n";
	print "Usage:\n";
	print "\n";
	print "help       This cruft\n";
	print "update     Update vulnerability databases\n";
	print "status     Compute expected failure rates for local system\n";
	print "show <pkg> Show failure rates and vulnerability statistics for <pkg>\n";
	print "\n";
}

## Print system status report from component(files) measurements (sha1sums)
## Expected input format is Linux IMA. We assume input was validated.
##
## Note: aptsec_status(), considers *reportedly installed* packages, while this
## one looks at *actually loaded* software that influenced the CPU since bootup.
sub aptsec_attest {
	my $sha1file = shift;
	my %tmp;
	my @pkglist;
	my @res;
	
	$sha1file = "/sys/kernel/security/ima/ascii_runtime_measurements" unless ($sha1file);
	
	# don't use Tie here since we don't need and sometimes don't have write access..
	open (SHA, "< $sha1file") or die "Unable to open file $sha1file";
	my @lines = <SHA>;
	LINE: foreach my $line (@lines) {
		
		if ($line =~ /[0-9]{2}\ \w{40}\ ima\ (\w+)\ (\S+)/) { # IMA format?
		} elsif ($line =~ /(\w{40})\ (\S+)/) { # '<sha1> <filename>' format?
		} else { print "Failed to parse attestation data input from $sha1file\n"; return; }
		
		unless (@res = getSHA1 $1) {
			print "Unknown measured file: $1 $2\n";
			next LINE;
		}

		# if measured hash is ambigious, print warning and over-approximate
		if ($res[2] =~ /,/) {
			print "Ambigious hash $res[0]: $res[2]\n";
			foreach my $pkg (split(/,/, $res[2])) {
				if ($src2dsa->{$pkg}) {
					print "\t$pkg has security record...\n"
				}
				$tmp{$pkg} = 1;
			}
		} else {
			$tmp{$res[2]} = 1;
		}
	}
	close(SHA);
	
	my @list = keys %tmp;
	my $srclist = \@list;

	printSystemStats($srclist);
}

my $action;
$action = shift or $action = "help";

load_state();
detect_distribution();
make_path($state->{"cache_dir"});
	
given ($action) {

	when ($_ eq "update") {
		load_DBs;
		load_sha1lists;
		aptsec_update();
		save_sha1lists;
		save_DBs;
		save_state;
	}
	when ($_ eq "status") { 
		load_DBs or die "Failed to load some cached file(s), please rebuild with 'apt-sec update'\n";
		aptsec_status(shift);
	}
	when ($_ eq "status2010") { 
		load_DBs or die "Failed to load some cached file(s), please rebuild with 'apt-sec update'\n";
		aptsec_status_2010(shift);
	}
	when ($_ eq "show")   {
		load_DBs or die "Failed to load some cached file(s), please rebuild with 'apt-sec update'\n";
		aptsec_show(shift);
	}
	when ($_ eq "attest")   {
		load_DBs or die "Failed to load some cached file(s), please rebuild with 'apt-sec update'\n";
		load_sha1lists;
		aptsec_attest(shift);
	}
#	when ($_ eq "altname") {
#		load_DBs or die "Failed to load some cached file(s), please rebuild with 'apt-sec update'\n";
#		altname(shift);
#	}
	when ($_ eq "hits")   {
		load_DBs or die "Failed to load some cached file(s), please rebuild with 'apt-sec update'\n";
		aptsec_hitlist();
	}
	when ($_ eq "about") {
		load_DBs or die "Failed to load some cached file(s), please rebuild with 'apt-sec update'\n";
		aptsec_about();
	}
	when ($_ eq "alt") {
		load_DBs or die "Failed to load some cached file(s), please rebuild with 'apt-sec update'\n";
		aptsec_alternatives(shift);
	}
	default {
		aptsec_help();
	}
};