#!/usr/bin/perl -w

use strict;
use warnings;
use feature "say";

use Hash::Case::Lower;
use LWP::UserAgent;
use YAML::XS qw/LoadFile/;
use File::Temp qw/tempfile tempdir/;
use File::Basename;
use IPC::Open2;
use XML::Writer;
use DateTime::HiRes;

use lib join('/', dirname($0), "lib");

use ExtRepoData;

use feature 'signatures';
no warnings 'experimental::signatures';

my $ua = LWP::UserAgent->new;
$ua->env_proxy;
$ua->agent("extrepo-data-validator/1.0; see https://salsa.debian.org/extrepo-team/extrepo-data");

my $data;

my $dir = tempdir(CLEANUP => 1);

sub success($name, $file, $msg, $data=undef) {
	say $msg;
	my $rv = {result => 1, name => $name, msg => $msg, ts => DateTime::HiRes->now, file => $file};
	if(defined $data) {
		$rv->{data} = $data;
	}
	return $rv;
}

sub failure($name, $file, $msg) {
	say STDERR $msg;
	return {result => 0, name => $name, msg => $msg, ts => DateTime::HiRes->now, file => $file};
}

sub skipped($name, $file, $msg) {
	say "Skipping test: $msg";
	return {result => 77, skipped => 1, name => $name, msg => $msg, ts => DateTime::HiRes->now, file => $file};
}

sub get($name, $file, $url) {
	my $resp = $ua->get($url);
	if(!$resp->is_success) {
		return failure($name, $file, "Could not download $url: " . $resp->status_line);
	}
	if (defined $resp->decoded_content) {
		return success($name, $file, "retrieved $url", $resp->decoded_content);
	} else {
		return success($name, $file, "retrieved $url", $resp->content);
	}
}

sub url_exists($name, $file, $url) {
	my $resp =$ua->head($url);
	if($resp->is_success) {
		return success($name, $file, "found $url");
	}
	return failure($name, $file, "$url not found");
}

sub head_from_list($name, $file, @urls) {
	my $url;
	my $resp;

	foreach $url(@urls) {
		$resp = $ua->head($url);
		if($resp->is_success) {
			return success($name, $file, "found $url");
		} elsif($resp->code == 400) { # Bad Request, probably because HEAD is not supported
                        $resp = $ua->get($url);
                        if($resp->is_success) {
                                return success($name, $file, "found $url");
                        }
                }
	}
	$url = $urls[0];
	return failure($name, $file, "Could not find anything like $url: " . $resp->status_line);
}

my %algos;

sub parse_gpgv($pipe, $file, $url, $repostring) {
	my $expired = 0;
	my $found = 0;
	my $lines;

	while(<$pipe>) {
		$lines .= $_;
		if (/^\[GNUPG:\] EXPKEYSIG (?<keyid>[A-F0-9]+) (?<keyname>.*)$/) {
			$expired = 1;
		}
		if (/^\[GNUPG:\] GOODSIG (?<keyid>[A-F0-9]+) (?<keyname>.*)$/) {
			$expired = 0;
			$found++;
		}
		if (/VALIDSIG (?<fpr>[A-F0-9]+) (?<sigdate>[0-9]{4}-[0-9]{2}-[0-9]{2}) (?<sigts>\S+) (?<expts>\S+) (?<sigversion>[0-9]+) (?<reserved>[0-9]+) (?<pubkeyalg>[0-9]+) (?<hashalg>[0-9]+) (?<sigclass>[0-9]+)( (?<prikeyfpr>[A-F0-9]+))?/) {
			if($expired) {
				print "found valid signature by expired key " . $+{fpr} . " using algorithm " . $+{pubkeyalg} . "\n";
			} else {
				print "found good signature by key " . $+{fpr} . " using algorithm " . $+{pubkeyalg} . "\n";
				if(!exists($algos{$+{pubkeyalg}})) {
					$algos{$+{pubkeyalg}} = 0;
				}
				$algos{$+{pubkeyalg}}++;
			}
		}
		if(/ERRSIG (?<keyid>[A-F0-9]+) (?<pkgalg>[0-9]+) (?<hashalg>[0-9]+) (?<sigclass>[0-9]+) (?<time>(\S+) (?<rc>[0-9]+) (?<fpr>[A-F0-9]+))/) {
			print "found invalid signature by key " . $+{keyid} . " using algorithm " . $+{pkgalg} . "; rc = " . $+{rc} . "\n";
		}
	}
	if(!$found) {
		print STDERR "gpgv output:\n\n";
		print STDERR $lines;
		return failure("$repostring, signature", $file, "No good signature found for $url");
	}
	return success("$repostring, signature", $file, "found $found good signature(s)");
}

sub verify_inrelease($url, $file, $gpg, $repostring) {
	my $inrelease = get("$repostring, InRelease file", $file, $url);
	if(!$inrelease->{result}) {
		return $inrelease;
	}
	$inrelease = $inrelease->{data};
	unlink("$dir/Release.gpg");
	open RELEASE, ">", "$dir/Release" or die $!;
	my $pid = open2(">&RELEASE", my $child_in, "pgpainless-cli", "inline-detach", "--signatures-out=$dir/Release.gpg", "--stacktrace") or die $!;
	print $child_in $inrelease;
	close $child_in;
	close RELEASE;
	open my $inrelease_file, ">", "$dir/InRelease" or die $!;
	print $inrelease_file $inrelease;
	close $inrelease_file;
	# For some reason, the close above does not always reflect on
	# the file system immediately. Add a short delay as a workaround
	sleep 1;
	return verify_release_gpg($url, $file, $gpg, $repostring, 0);
}

sub verify_release_gpg($relurl, $file, $gpg, $repostring, $fetch=1) {
	my $gpgurl = "$relurl.gpg";
	my $relfilename;
	my $sigfilename;

	if($fetch) {
		my ($relfh, $sigfh);
		my $release = get("$repostring, Release file", $file, $relurl);
		if(!$release->{result}) {
			return $release;
		}
		$release = $release->{data};
		($relfh, $relfilename) = tempfile(DIR => $dir) or die $!;
		print $relfh $release;
		close $relfh;
		my $signature = get("$repostring, Release.gpg file", $file, $gpgurl);
		if (!$signature->{result}) {
			return $signature;
		}
		$signature = $signature->{data};
		($sigfh, $sigfilename) = tempfile(DIR => $dir) or die $!;
		print $sigfh $signature;
		close $sigfh;
	} else {
		$sigfilename = "$dir/Release.gpg";
		$relfilename = "$dir/Release";
	}
	my ($gpgfh, $gpgfilename) = tempfile(DIR => $dir);
	print $gpgfh $gpg;
	close $gpgfh;
	system("/usr/bin/gpg", "--dearmor", $gpgfilename);
	open my $validate, "gpgv --status-fd 1 --keyring $gpgfilename.gpg $sigfilename $relfilename 2>/dev/null|";
	return parse_gpgv($validate, $file, $relurl, $repostring);
}

my @invalids;
my $starttime = DateTime::HiRes->now;
my @testcases;
my $parallel_counter = 0;
if(exists($ENV{CI_NODE_INDEX})) {
	say "Running parallel job " . $ENV{CI_NODE_INDEX} . " of " . $ENV{CI_NODE_TOTAL};
} else {
	say "Not running in parallel";
}

foreach my $file(sort @ARGV) {
	die "invalid filename $file" unless $file =~ /\.yaml$/;

	if(! -f $file) {
		# ignore, probably a merge request that removes one or more file(s)
		print "$file does not exist -- ignoring\n";
		next;
	}
	$data = LoadFile($file);

	REPO:
	foreach my $repo(sort(keys %$data)) {
		next REPO if $repo =~ /^\./;
		if(exists($ENV{CI_NODE_INDEX})) {
			my $parallel_test = ($parallel_counter++ % $ENV{CI_NODE_TOTAL}) + 1;
			print "$parallel_test -> " . ($ENV{CI_NODE_INDEX}) . ": ";
			if ($parallel_test != ($ENV{CI_NODE_INDEX})) {
				say "skipping $repo: will run in different parallel job";
				next REPO;
			}
		}
		my $tieobj = tie my(%hash), 'ExtRepoData', $data->{$repo};
		$data->{$repo} = \%hash;

		if(exists($ENV{VALIDATE_ONIONS})) {
			next REPO unless exists($data->{$repo}{"onion-uris"});
			delete $data->{$repo}{source}{uris};
			$data->{$repo}{source}{uris} = $data->{$repo}{"onion-uris"};
		}

		if (exists($data->{$repo}{Disabled})) {
			push @testcases, skipped("check if repository $repo is enabled", $file, "$repo disabled");
			next REPO;
		}
		push @testcases, success("check if repository $repo is enabled", $file, "$repo enabled");

		my $printed = 0;

		my %types;
		foreach my $type(split(" ", $data->{$repo}{source}{types})) {
			$types{$type} = 1;
		}
		foreach my $ssuite(@{$data->{$repo}{suites}}) {
			$tieobj->suite(ExtRepoData::Suite->new($ssuite));
			foreach my $suite(split(" ", $data->{$repo}{source}{suites})) {
				my $vers = ExtRepoData::Suite::version_of($ssuite);
				$suite =~ s/<SUITE>/$ssuite/g;
				$suite =~ s/<VERSION>/$vers/g;
				my $repostring = "repo $repo, suite $suite";
				say $repostring . ", repository metadata";
				my $scomponents;
				my $urlbase;
				if(exists($data->{$repo}{source}{components})) {
					$urlbase = join("/", $data->{$repo}{source}{uris}, "dists", $suite);
				} else {
					$urlbase = join("/", $data->{$repo}{source}{uris}, $suite);
				}
				$urlbase =~ s/<SUITE>/$ssuite/g;
				$urlbase =~ s/<VERSION>/$vers/g;
				if(!exists($ENV{SKIP_INRELEASE}) && (url_exists("", $file, join("/", $urlbase, "InRelease")))->{result}) {
					push @testcases, verify_inrelease(join("/", $urlbase, "InRelease"), $file, $data->{$repo}{"gpg-key"}, $repostring);
				} elsif((url_exists("", $file, join("/", $urlbase, "Release")))->{result}) {
					push @testcases, verify_release_gpg(join("/", $urlbase, "Release"), $file, $data->{$repo}{"gpg-key"}, $repostring);
				} else {
					$urlbase = join("/", $data->{$repo}{source}{uris}, "dists", $suite);
					if(!exists($ENV{SKIP_INRELEASE}) && (url_exists("", $file, join("/", $urlbase, "InRelease")))->{result}) {
						push @testcases, verify_inrelease(join("/", $urlbase, "InRelease"), $file, $data->{$repo}{"gpg-key"}, $repostring);
					} elsif((url_exists("", $file, join("/", $urlbase, "Release"))->{result})) {
						push @testcases, verify_release_gpg(join("/", $urlbase, "Release"), $file, $data->{$repo}{"gpg-key"}, $repostring);
					} else {
						push @testcases, failure("$repostring, signature", $file, "Release file not found under $urlbase, cannot verify repository");
					}
				}
				if(!($testcases[-1]{result})) {
					say STDERR "FAILED -- " . $testcases[-1]{msg};
					push @invalids, "while validating repository $repo: " . $testcases[-1]{result};
					next REPO;
				}
				if(!exists($data->{$repo}{components})) {
					$scomponents = [ "<unspecified>" ];
				} else {
					$scomponents = $data->{$repo}{components};
				}
				foreach my $scomponent(@$scomponents) {
					my $components;
					if(exists($data->{$repo}{source}{"suite-$ssuite-components"})) {
						$components = $data->{$repo}{source}{"suite-$ssuite-components"};
					} elsif(exists($data->{$repo}{source}{components})) {
						$components = $data->{$repo}{source}{components};
					} else {
						$components = ".";
					}
					foreach my $component(split(" ", $components)) {
						$component =~ s/<SUITE>/$ssuite/g;
						$component =~ s/<VERSION>/$vers/g;
						$component =~ s/<COMPONENTS>/$scomponent/g;
						$repostring = "repo $repo, suite $ssuite, component $component";
						my $urlsuite = join("/", $urlbase, $component);
						$urlsuite =~ s/<COMPONENTS>/$scomponent/g;
						say $repostring;

						if($types{"deb-src"}) {
							my $srcurl;
							if($component ne ".") {
								$srcurl = join("/", $urlsuite, "source", "Sources");
							} else {
								$srcurl = join("/", $urlsuite, "Sources");
							}
							my @sources = ($srcurl, "$srcurl.gz", "$srcurl.xz");
							push @testcases, head_from_list("$repostring, source metadata", $file, @sources);
							if(!$testcases[-1]{result}) {
								say STDERR "FAILED -- " . $testcases[-1]{msg};
								push @invalids, "while validating $repostring:" . $testcases[-1]{result};
								next REPO;
							}
						}
						next REPO unless $types{deb};
						my $architectures;
						if(exists($data->{$repo}{source}{"suite-$ssuite-architectures"})) {
							$architectures = $data->{$repo}{source}{"suite-$ssuite-architectures"};
						} elsif(!exists($data->{$repo}{source}{architectures})) {
							print STDERR "WARNING: no Architectures key in $repo:source:. This is not recommended.\n" unless $printed;
							$printed = 1;
							next REPO;
						} else {
							$architectures = $data->{$repo}{source}{architectures};
						}
						foreach my $arch(split(" ", $architectures)) {
							my $burl;
							if($component ne ".") {
								$burl = join("/", $urlsuite, "binary-$arch", "Packages");
							} else {
								$burl = join("/", $urlsuite, "Packages");
							}
							my @burls = ($burl, "$burl.gz", "$burl.xz");
							push @testcases, head_from_list("$repostring, Packages file for architecture $arch", $file, @burls);
							if(!$testcases[-1]{result}) {
								say STDERR "FAILED -- " . $testcases[-1]{msg};
								push @invalids, "while validating repository $repostring, architecture $arch: " . $testcases[-1]{msg};
								next REPO;
							}
						}
					}
				}
			}
		}
	}
}

my $exit = 0;

foreach my $invalid(@invalids) {
	print "\n\nvalidation failed:\n" unless $exit;
	print "$invalid\n";
	$exit = 1;
}

print "Signatures found per algorithm:\n";
foreach my $algo(keys %algos) {
	print "$algo: $algos{$algo}\n";
}

open my $junitfile, ">", "validate-repo-junit.xml";

my $junit = XML::Writer->new(OUTPUT => $junitfile);

my $total = scalar(@testcases);
my $failed = grep({$_->{result} == 0} @testcases);
my $skipped = grep({exists($_->{skipped})} @testcases);

$junit->startTag("testsuites", time => (DateTime::HiRes->now->hires_epoch - $starttime->hires_epoch), tests => $total, failures => $failed, skipped => $skipped);
$junit->startTag("testsuite", name => "validate-repo", id => "validate-repo", timestamp => $starttime->iso8601);
my $prevtime = $starttime;
foreach my $case(@testcases) {
	$junit->startTag("testcase", time => $case->{ts}->hires_epoch - $prevtime->hires_epoch, name => $case->{name}, file => $case->{file});
        $prevtime = $case->{ts};
	if(exists($case->{skipped})) {
		$junit->startTag("skipped", message => $case->{msg});
		$junit->endTag("skipped");
	} elsif(!$case->{result}) {
		$junit->startTag("failure", message => $case->{msg});
		$junit->endTag("failure");
	} else {
		$junit->startTag("system-out");
		$junit->characters($case->{msg});
		$junit->endTag("system-out");
	}
	$junit->endTag("testcase");
}
$junit->endTag("testsuite");
$junit->endTag("testsuites");
$junit->end;

close $junitfile;

exit $exit;