#!/usr/bin/perl

=head1 NAME

dh_setup_copyright - extract source file names from DWARF debug information in ELF binaries via dwarf2sources

=cut

use strict;
use warnings;
use Digest::SHA;
use File::Find;
use File::Basename;
use File::Copy;
use File::Path;
use File::Spec;
use JSON::PP;
use Debian::Debhelper::Dh_Lib;

our $VERSION = DH_BUILTIN_VERSION;

=head1 SYNOPSIS

B<dh_setup_copyright> [S<I<debhelper options>>] [B<-X>I<item>] [S<B<--> I<params>>]

=head1 DESCRIPTION

B<dh_setup_copyright> is a debhelper program that generates the list for source
file names used to build every binary and pulls the licenses from any sources
part of other packages. The source file list is extracted from DWARF debug
information by running L<dwarf2sources(1)> on every ELF binaries in the package
and saving the output to /usr/share/doc/<package>.

=head1 OPTIONS

=over 4

=item B<-X>I<item>, B<--exclude=>I<item>

Exclude files that contain I<item> anywhere in their filename from being
extracted. You may use this option multiple times to build up a list of
things to exclude.

=back

=head1 NOTES

If the B<DEB_BUILD_OPTIONS> environment variable contains B<nodwarf2sources>,
this procedure is skipped.

=cut

init();

# This variable can be used to turn off file name extraction.
exit 0 if get_buildoption('nodwarf2sources');

my %external_files_to_packages_cache = ();
my %packages_to_srcpackages_cache = ();

my $canonical_json = JSON::PP->new->utf8->canonical;

my @find_results = ();
my %find_exclude_stat = ();

sub find_is_excluded {
	my ($fn) = @_;
	return 1 if excludefile($fn);

	my ($dev, $ino) = stat $fn;
	return defined $find_exclude_stat{$dev,$ino};
}

sub find_test {
	my $fn = $_;
	return if -l $fn; # Always skip symlinks.

	# See if we were asked to exclude this file.
	# Note that we have to test on the full filename, including directory.
	if (find_is_excluded($fn)) {
		$File::Find::prune = 1 if -d _;
		return;
	}
	return if -d _;
	push(@find_results, $fn);
	return;
}

# Wrapper over `find` that avoids callers needing to interact with any globals
# and adds the ability to exclude extra locations.
sub find_local {
	my ($dir, $options) = @_;

	@find_results = ();
	%find_exclude_stat = ();
	if (defined $options) {
		my $exclude = $options->{'exclude'} || [];
		foreach my $path (@$exclude) {
			my ($dev, $ino) = stat $path;
			$find_exclude_stat{$dev, $ino} = 1;
		}
	}
	find({
		wanted => \&find_test,
		no_chdir => 1,
	}, $dir);

	return @find_results;
}

sub extract_filenames {
	my ($fname_list, $tmpfolder, @binaries) = @_;
	# In order to have the list of file names as will be find in the rootfs
	# generate the file name relative to tmpdir($package), execute the command
	# in chdir and save the output to $tmp_fname_list file
	doit_noerror({chdir => $tmpfolder}, "rm", "-f", $fname_list);
	print "Extracting source file names to $fname_list from @binaries in tmp folder $tmpfolder\n";
	doit_noerror({chdir => $tmpfolder}, "dwarf2sources", "-o", $fname_list, @binaries);
}

sub find_package_providing_path {
	my ($path) = @_;

	use constant PATH_HAS_NO_PACKAGE => '';

	# rust-coreutils uses a different place for the registry
	# making it difficult to find the source package based on the path
	# so replace the file path with the expected one
	$path =~ s!^.*/debian/cargo_registry/!/usr/share/cargo/registry/!g;

	my $package = $external_files_to_packages_cache{$path};
	if (defined $package) {
		return $package eq PATH_HAS_NO_PACKAGE ? undef : $package;
	}

	# Skip non-existent files, since dpkg-query only works on installed packages
	# anyway.
	if (-e $path) {
		($package) = `dpkg-query -S "$path" 2>/dev/null` =~ /^([^\s:]+):(?:[^\s:]+:)? /;
	}
	if (!defined $package) {
		$external_files_to_packages_cache{$path} = PATH_HAS_NO_PACKAGE;
		print STDERR "WARNING: $path was not found in any package\n";
		return undef;
	}

	# Most likely there will be more files from this package, so cache its
	# contents for lookup later.
	foreach my $pkgfile (split "\n", `dpkg -L "$package"`) {
		# Exclude directorieso to avoid filling up the cache with directories
		# like '/' that will be in multiple packages and thus trip up the
		# checks below.
		next if -d $pkgfile;

		my $existing = $external_files_to_packages_cache{$pkgfile};
		if (defined $existing) {
			print STDERR "WARNING: $pkgfile is in multiple packages:",
				" '$existing' and '$package'\n";
		} else {
			$external_files_to_packages_cache{$pkgfile} = $package;
		}
	}

	$package;
}

sub find_source_package_for_package {
	my ($package) = @_;

	my $cached = $packages_to_srcpackages_cache{$package};
	return @$cached if defined $cached;

	my ($version, $srcpackage, $srcversion) =
		`dpkg-query -f '\${Version} \${Source}' -W '$package'`
		# Note that the source version *might* be in the Source field, so make
		# sure to extract it if so.
		=~ /(\S+) (\S+)(?: \((.*)\))?/;
	$srcpackage ||= $package;
	$srcversion ||= $version;
	return undef if !defined $srcversion;

	# Strip off the build suffix.
	$srcversion =~ s/${\Debian::Debhelper::Dh_Lib::BUILD_SUFFIX_RE}//;

	$packages_to_srcpackages_cache{$package} = [$srcpackage, $srcversion];
	($srcpackage, $srcversion);
}

sub copy_external_package_copyright {
	my ($fname_external_dir, $package) = @_;

	print "Importing copyright from: $package\n";

	my @report_filenames = (
		'copyright', 'copyright.gz',
		'copyright_report', 'copyright_report.gz',
	);

	for my $filename (@report_filenames) {
		my $src = "/usr/share/doc/$package/$filename";
		my $dst = "$fname_external_dir/$package.$filename";
		next if ! -e $src || -e $dst;

		mkpath $fname_external_dir;
		copy $src, $dst;
	}
}

sub add_referenced_srcpackage {
	my ($metadata, $srcpackage, $srcversion, $origin) = @_;

	my $referenced_source_packages = $metadata->{'referenced_source_packages'};
	my $dest = $referenced_source_packages->{$srcpackage};
	if (defined $dest) {
		return 0 if grep /^$origin$/, @{$dest->{'origins'}};
		push @{$dest->{'origins'}}, $origin;
	} else {
		$referenced_source_packages->{$srcpackage} = {
			'version' => $srcversion,
			'origins' => [$origin],
		};
	}

	1;
}

sub process_external_sources {
	my ($fname_list, $fname_external_dir, $metadata) = @_;

	if (! -e $fname_list) {
		print STDERR "WARNING: $fname_list is missing, dwarf2sources extraction failed\n";
		return;
	}

	print "Scanning external source files\n";

	open my $sources_handle, '<', $fname_list or die "Failed to open $fname_list: $!";
	my $sources_data = do { local $/; <$sources_handle> };
	close $sources_handle;

	my $external_sources_to_packages = $metadata->{'external_sources_to_packages'};
	my $added_referenced_srcpackages = 0;

	my $sources = decode_json $sources_data;
	my $sources_changed = 0;

	while (my ($file, $info) = each %$sources) {
		foreach my $unit (@{$info->{'units'}}) {
			if (($unit->{'comp_name'} =~ s|/@/.*||) && !$sources_changed) {
				print "Stripping trailing '/@/...' from Rust compilation units\n";
				$sources_changed = 1;
			}

			my $comp_dir = $unit->{'comp_dir'};
			my $comp_name = $unit->{'comp_name'};

			if ($comp_name =~ /^\//) {
				# Absolute path means it was likely a globally installed source file,
				# if so, find its copyright and install it.
				next if defined $external_sources_to_packages->{$comp_name};

				my $package = find_package_providing_path $comp_name;
				next if !defined $package;

				$external_sources_to_packages->{$comp_name} = $package;
				copy_external_package_copyright $fname_external_dir, $package;
			}
		}

		foreach my $external_file (@{$info->{'external_files'}}) {
			my $package = find_package_providing_path $external_file;
			next if !defined $package;

			my ($srcpackage, $srcversion) = find_source_package_for_package $package;
			next if !defined $srcpackage;

			$added_referenced_srcpackages += add_referenced_srcpackage $metadata,
				$srcpackage, $srcversion, 'external_files';
		}
	}

	if ($sources_changed) {
		print "Saving edited dwarf2sources output\n";
		open my $sources_handle, '>', $fname_list or die "Failed to open $fname_list: $!";
		print $sources_handle $canonical_json->encode($sources);
		close $sources_handle;
	}

	if (%$external_sources_to_packages) {
		my $count = scalar %$external_sources_to_packages;
		print "Adding metadata for $count external source file(s)\n";
	}
	if ($added_referenced_srcpackages) {
		print "Adding metadata for $added_referenced_srcpackages source package(s)",
			" from external_files\n";
	}
}

sub scan_binary_shlibs {
	my ($tmpdir, $binaries, $metadata) = @_;

	my $added_referenced_srcpackages = 0;

	foreach my $binary (@$binaries) {
		foreach my $shlib (`LD_PRELOAD= ldd "$tmpdir/$binary"` =~ /=> (\/\S+)/g) {
			# Ignore shlibs part of this package.
			next if -e "$tmpdir/$shlib";

			my $package = find_package_providing_path $shlib;
			next if !defined $package;

			my ($srcpackage, $srcversion) = find_source_package_for_package $package;
			next if !defined $srcpackage;

			$added_referenced_srcpackages += add_referenced_srcpackage $metadata,
				  $srcpackage, $srcversion, 'shared_libraries';
		}
	}

	if ($added_referenced_srcpackages) {
		print "Adding metadata for $added_referenced_srcpackages source package(s)",
			" from shared library scanning\n";
	}
}

sub collect_sources_by_basename {
	my @sources = find_local('.', { 'exclude' => ['debian'] });
	my %sources_by_basename = ();
	foreach my $source (@sources) {
		# Clean up stuff like `./`.
		$source = File::Spec->canonpath($source);

		my $with_basename = $sources_by_basename{basename $source} ||= [];
		push @$with_basename, $source;
	}

	\%sources_by_basename
}

# Returns the number of path components shared between the tails of the two
# arguments.
#
# common_path_suffix_length('a/b/c', 'b/c') # => 2 (for 'b/c')
sub common_path_suffix_length {
	my ($a, $b) = @_;
	my @parts_a = reverse split '/', $a;
	my @parts_b = reverse split '/', $b;

	my $min_len = @parts_a < @parts_b ? @parts_a : @parts_b;
	my $i = 0;
	for (; $i < $min_len; $i++) {
		last if $parts_a[$i] ne $parts_b[$i];
	}
	return $i;
}

sub build_copied_sources_map {
	my ($tmpdir, $others, $sources_by_basename, $metadata) = @_;

	my $copied_sources = $metadata->{'copied_sources'};

	foreach my $file (@$others) {
		my $unscored_matches = $sources_by_basename->{basename $file};
		next if !defined $unscored_matches;

		# Assign a "score" to each matching file based on the number of path
		# components in common, so that we'll be more likely to match e.g.
		# "/usr/include/test" as "src/include/test" than "examples/test".
		my @matches = map {
			my $score = common_path_suffix_length $file, $_;
			[$score, $_]
		} @$unscored_matches;

		my $file_sha256 = Digest::SHA->new('256')->addfile("$tmpdir/$file", 'b')->hexdigest;
		# Skip if...
		next if (
			# ...the file was empty...
			$file_sha256 eq "e3b0c44298fc1c149afbf4c8996fb92427ae41e4649b934ca495991b7852b855"
			# ...or a single blank line.
			|| $file_sha256 eq "01ba4719c80b6fe911b091a7c05124b64eeece964e09c058ef8f9805daca546b"
		);

		# b is on the left, so this will sort in the reverse / descending direction,
		# so higher-scored files will come first.
		@matches = sort { $b->[0] <=> $a->[0] } @matches;

		foreach my $match (@matches) {
			my $source = $match->[1];
			my $source_sha256 = Digest::SHA->new('256')->addfile($source, 'b')->hexdigest;
			if ($file_sha256 eq $source_sha256) {
				$copied_sources->{$file} = $source;
				last;
			}
		}
	}

	if (%$copied_sources) {
		print "Adding metadata for @{[scalar %$copied_sources]} copied source(s)\n";
	}
}

for my $package (@{$dh{DOPACKAGES}}) {
	my $tmp = tmpdir($package);

	print "Processing package $package for source file name extraction\n";
	my $fname_dir = "usr/share/doc/" . $package;
	if (-l "$tmp/$fname_dir") {
		my $target = readlink "$tmp/$fname_dir";
		my $package_doc = basename($target);
		$fname_dir = "usr/share/doc/$package_doc";
	}
	my $arch = package_binary_arch($package);
	my $fname_list = "$fname_dir/" . $package . "_bin2sources_" . $arch . ".json";
	my $fname_external_dir = "$fname_dir/external_copyrights";
	my $fname_metadata = "$fname_dir/${package}_metadata_${arch}.json";

	print "Checking file $fname_list\n";
	if (-e "$tmp/$fname_list") {
		print "File $tmp/$fname_list already exists, skipping\n";
		next;
	}

	my @pkg_files = sort(find_local($tmp));

	my @binaries = ();
	my @others = ();
	foreach my $file (@pkg_files) {
		my $relative_file = substr($file, length($tmp) + 1);
		if (is_so_or_exec_elf_file($file)) {
			push(@binaries, $relative_file);
		} else {
			push(@others, $relative_file);
		}
	}

	if (!@binaries && !@others) {
		print "Package $package has no files to check, skipping\n";
		next;
	}

	print "Checking $fname_dir\n";
	if (not -e "$tmp/$fname_dir") {
		print "Folder $tmp/$fname_dir does not exists, creating it\n";
		mkpath("$tmp/$fname_dir");
	}

	my %metadata = (
		external_sources_to_packages => {},
		referenced_source_packages => {},
		copied_sources => {},
	);

	extract_filenames($fname_list, $tmp, @binaries);
	process_external_sources("$tmp/$fname_list", "$tmp/$fname_external_dir", \%metadata);
	scan_binary_shlibs($tmp, \@binaries, \%metadata);

	my $sources_by_basename = collect_sources_by_basename;
	build_copied_sources_map($tmp, \@others, $sources_by_basename, \%metadata);

	if (%metadata) {
		open my $meta_handle, '>', "$tmp/$fname_metadata" or die "Failed to open $fname_metadata: $!";
		print $meta_handle $canonical_json->encode(\%metadata);
		close $meta_handle;
	}
}

=head1 SEE ALSO

L<debhelper(7)>

This program is a part of debhelper.

=head1 AUTHOR

Walter Lozano <walter.lozano@collabora.com>

=cut
