#!/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 File::Find;
use File::Basename;
use File::Copy;
use File::Path;
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 @elf_files;

sub testfile {
	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 (excludefile($fn)) {
		$File::Find::prune = 1 if -d _;
		return;
	}
	return if -d _;
	if (is_so_or_exec_elf_file($fn)) {
		push(@elf_files, $fn);
	}
	return;
}

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) = @_;
	my ($package) = `dpkg-query -S "$path" 2>/dev/null` =~ /^([^\s:]+):(?:[^\s:]+:)? /;
	$package;
}

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 copy_external_source_copyrights {
	my ($fname_list, $fname_external_dir, $metadata) = @_;

	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 %index = ();
	my %unknown_files = ();

	my $sources = decode_json $sources_data;
	while (my ($file, $units) = each %$sources) {
		foreach my $unit (@{$units->{'units'}}) {
			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 $index{$comp_name} || defined $unknown_files{$comp_name};

				my $package = find_package_providing_path $comp_name;
				if (!defined $package) {
					$unknown_files{$comp_name} = 1;
					next;
				}

				$index{$comp_name} = $package;
				copy_external_package_copyright $fname_external_dir, $package;
			}
		}
	}

	if (%index) {
		print "Adding metadata for @{[scalar %index]} external source file(s)\n";
		$metadata->{'external_sources_to_packages'} = \%index;
	}
}

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

	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;
	}

	@elf_files = ();
	find({
			wanted => \&testfile,
			no_chdir => 1,
		 }, $tmp);

	if (not @elf_files) {
		print "Package $package has no binaries to check, skipping\n";
		next;
	}

	# Consistent order;
	@elf_files = sort(@elf_files);
	my ($unique_files, $hardlinks) = find_hardlinks(@elf_files);

	foreach (@elf_files) {
		my $file = substr($_, length($tmp) + 1);
		push(@binaries, $file);
	}

	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 = ();

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

	if (%metadata) {
		open my $meta_handle, '>', "$tmp/$fname_metadata" or die "Failed to open $fname_metadata: $!";
		print $meta_handle encode_json(\%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