#!/usr/bin/perl

=head1 NAME

dh_strip - strip executables, shared libraries, and some static libraries

=cut

use strict;
use warnings;
use File::Find;
use Debian::Debhelper::Dh_Lib;

=head1 SYNOPSIS

B<dh_strip> [S<I<debhelper options>>] [B<-X>I<item>] [B<--dbg-package=>I<package>] [B<--keep-debug>]

=head1 DESCRIPTION

B<dh_strip> is a debhelper program that is responsible for stripping
executables, shared libraries, and static libraries that are not used for
debugging.

This program examines your package build directories and works out what
to strip on its own. It uses L<file(1)> and file permissions and filenames
to figure out what files are shared libraries (F<*.so>), executable binaries,
and static (F<lib*.a>) and debugging libraries (F<lib*_g.a>, F<debug/*.so>), and
strips each as much as is possible. (Which is not at all for debugging
libraries.) In general it seems to make very good guesses, and will do the
right thing in almost all cases.

Since it is very hard to automatically guess if a file is a
module, and hard to determine how to strip a module, B<dh_strip> does not
currently deal with stripping binary modules such as F<.o> files.

=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
stripped. You may use this option multiple times to build up a list of
things to exclude.

=item B<--dbg-package=>I<package>

=begin comment

B<This option is a now special purpose option that you normally do not
need>.  In most cases, there should be little reason to use this
option for new source packages as debhelper generates automatic debug
packages ("ddebs").  B<If you have a manual --dbg-package> that you
want to migrate to the automatic ddeb, please see the
B<--ddeb-migration> option.

=end comment

Causes B<dh_strip> to save debug symbols stripped from the packages it acts on
as independent files in the package build directory of the specified debugging
package.

For example, if your packages are libfoo and foo and you want to include a
I<foo-dbg> package with debugging symbols, use B<dh_strip --dbg-package=>I<foo-dbg>.

Note that this option behaves significantly different in debhelper
compatibility levels 4 and below. Instead of specifying the name of a debug
package to put symbols in, it specifies a package (or packages) which
should have separated debug symbols, and the separated symbols are placed
in packages with B<-dbg> added to their name.

This option implies B<--no-ddebs> and I<cannot> be used with B<--ddeb>
or B<--ddeb-migration>.

=item B<-k>, B<--keep-debug>

Debug symbols will be retained, but split into an independent
file in F<usr/lib/debug/> in the package build directory. B<--dbg-package>
is easier to use than this option, but this option is more flexible.

This option implies B<--no-ddebs> and I<cannot> be used with
B<--ddebs>.

=item B<--ddeb-migration=>I<package-relation>

This option is used to migrate from a manual "-dbg" package (created
with B<--dbg-package>) to the automatic "ddebs".  The value of this
option should describe a valid B<Replaces>- and B<Breaks>-relation,
which will be added to the ddebs to avoid file conflicts with the (now
obsolete) -dbg package.

This option implies B<--ddebs> and I<cannot> be used with
B<--keep-debug>, B<--dbg-package> or B<--no-ddebs>.

Examples:

  dh_strip --ddeb-migration='libfoo-dbg (<< 2.1-3~)'

  dh_strip --ddeb-migration='libfoo-tools-dbg (<< 2.1-3~), libfoo2-dbg (<< 2.1-3~)'

=item B<--ddebs>, B<--no-ddebs>

Control whether B<dh_strip> should be creating ddebs when possible.

Once the Debian archive supports ddebs, debhelper will generate ddebs
by default.  Until then, this option does nothing except to allow you to
pre-emptively disable ddebs if you know the generated ddebs will not
work for your package.

If you want to test the ddebs feature, you can set the environment
variable I<DH_BUILD_DDEBS> to 1.  Keep in mind that the Debian archive
does B<not> accept them yet.  This variable is only a temporary
safeguard and will be removed once the archive is ready to accept
ddebs.

=back

=head1 NOTES

If the B<DEB_BUILD_OPTIONS> environment variable contains B<nostrip>, nothing
will be stripped, in accordance with Debian policy (section 10.1
"Binaries").  This will also inhibit the creation of automatic "ddebs".

The creation of automatic "ddebs" can also be prevented by adding
B<noddebs> to the B<DEB_BUILD_OPTIONS> environment variable.

=head1 CONFORMS TO

Debian policy, version 3.0.1

=cut

init(options => {
	"keep-debug"       => \$dh{K_FLAG},
	'ddeb-migration=s' => \$dh{MIGRATE_DDEB},
	'ddebs!'           => \$dh{ENABLE_DDEBS},
});

if ($dh{K_FLAG} and $dh{MIGRATE_DDEB}) {
	error("--keep-debug and --ddeb-migration are mutually exclusive");
}
if ($dh{DEBUGPACKAGES} and $dh{MIGRATE_DDEB}) {
	error("--dbg-package and --ddeb-migration are mutually exclusive");
}

if ($dh{ENABLE_DDEBS} and $dh{ENABLE_DDEBS} ne 'auto') {
	if ($dh{K_FLAG}) {
		error("--keep-debug and explicit --ddebs are mutually exclusive");
	}
	if ($dh{DEBUGPACKAGES}) {
		error("--dbg-package and explicit --ddebs are mutually exclusive");
	}
}

$dh{ENABLE_DDEBS} = 1 if not defined($dh{ENABLE_DDEBS});

if ($dh{MIGRATE_DDEB} and not $dh{ENABLE_DDEBS}) {
	error("--ddeb-migration and --no-ddebs are mutually exclusive");
}

$dh{ENABLE_DDEBS} = 0 if not $ENV{'DH_BUILD_DDEBS'};

# This variable can be used to turn off stripping (see Policy).
if (get_buildoption('nostrip')) {
	exit;
}

my $objcopy = cross_command("objcopy");
my $strip = cross_command("strip");
$dh{ENABLE_DDEBS} = 0 if get_buildoption('noddebs');

# I could just use `file $_[0]`, but this is safer
sub get_file_type {
	my $file=shift;
	open (FILE, '-|') # handle all filenames safely
		|| exec('file', $file)
		|| die "can't exec file: $!";
	my $type=<FILE>;
	close FILE;
	return $type;
}

# Check if a file is an elf binary, shared library, or static library,
# for use by File::Find. It'll fill the 3 first arrays with anything
# it finds.  The @build_ids will be the collected build-ids (if any)
my (@shared_libs, @executables, @static_libs, @build_ids);
sub testfile {
	return if -l $_ or -d $_; # Skip directories and symlinks always.
	
	# See if we were asked to exclude this file.
	# Note that we have to test on the full filename, including directory.
	my $fn="$File::Find::dir/$_";
	foreach my $f (@{$dh{EXCLUDE}}) {
		return if ($fn=~m/\Q$f\E/);
	}

	# Is it a debug library in a debug subdir?
	return if $fn=~m/debug\/.*\.so/;

	# Does its filename look like a shared library?
	#  - *.cmxs are OCaml native code shared libraries
	#  - *.node are also native ELF binaries (for node-js)
	if (m/.*\.(?:so.*?|cmxs|node)$/) {
		# Ok, do the expensive test.
		my $type=get_file_type($_);
		if ($type=~m/.*ELF.*shared.*/) {
			push @shared_libs, $fn;
			return;
		}
	}
	
	# Is it executable? -x isn't good enough, so we need to use stat.
	my (undef,undef,$mode,undef)=stat(_);
	if ($mode & 0111) {
		# Ok, expensive test.
		my $type=get_file_type($_);
		if ($type=~m/.*ELF.*(executable|shared).*/) {
			push @executables, $fn;
			return;
		}
	}
	
	# Is it a static library, and not a debug library?
	if (m/lib.*\.a$/ && ! m/.*_g\.a$/) {
		# Is it a binary file, or something else (maybe a linker
		# script on Hurd, for example? I don't use file, because
		# file returns a variety of things on static libraries.
		if (-B $_) {
			push @static_libs, $fn;
			return;
		}
	}
}

sub make_debug {
	my ($file, $tmp, $desttmp, $use_build_id, $package) = @_;

	# Don't try to copy debug symbols out if the file is already
	# stripped.
	return unless get_file_type($file) =~ /not stripped/;

	my ($base_file)=$file=~/^\Q$tmp\E(.*)/;
	my ($debug_path, $debug_build_id);

	if ($use_build_id &&
	    `LC_ALL=C readelf -n $file`=~ /^\s+Build ID: ([0-9a-f]{2})([0-9a-f]+)$/m) {
		$debug_path=$desttmp."/usr/lib/debug/.build-id/$1/$2.debug";
		$debug_build_id="${1}${2}";
	}
	elsif ($use_build_id > 1) {
		# For ddebs, we need build-id (else it will not be co-installable).
		return;
	}
	else {
		$debug_path=$desttmp."/usr/lib/debug/".$base_file;
	}
	my $debug_dir=dirname($debug_path);
	if (! -d $debug_dir) {
		install_dir($debug_dir);
	}
	if (compat(8) && $use_build_id < 2) {
		doit($objcopy, "--only-keep-debug", $file, $debug_path);
	}
	else {
		# Compat 9 OR a ddeb.
		doit($objcopy, "--only-keep-debug", "--compress-debug-sections", $file, $debug_path);
	}

	if ($use_build_id) {
		push(@build_ids, $debug_build_id);
	}

	# No reason for this to be executable.
	doit("chmod", "0644", $debug_path);
	return $debug_path;
}

sub attach_debug {
	my $file=shift;
	my $debug_path=shift;
	doit($objcopy, "--add-gnu-debuglink", $debug_path, $file);
}

my %all_packages = map { $_ => 1 } getpackages();

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

	# Support for keeping the debugging symbols in a detached file.
	my $keep_debug=$dh{K_FLAG};
	my $debugtmp=$tmp;
	my $use_build_id = compat(8) ? 0 : 1;
	if (! compat(4)) {
		if (ref $dh{DEBUGPACKAGES}) {
			$keep_debug=1;
			# Note that it's only an array for the v4 stuff;
			# for v5 only one value is used.
			my $debugpackage=@{$dh{DEBUGPACKAGES}}[0];
			if (!$all_packages{$debugpackage}) {
				error("debug package $debugpackage is not listed in the control file");
			}
			$debugtmp=tmpdir($debugpackage);
		}
	}
	else {
		if (ref $dh{DEBUGPACKAGES} && grep { $_ eq $package } @{$dh{DEBUGPACKAGES}}) {
			$keep_debug=1;
			$debugtmp=tmpdir($package."-dbg");
		}
	}
	if ($dh{ENABLE_DDEBS} and not $keep_debug and package_arch($package) ne 'all') {
		# Avoid creating a ddeb that would clash with a registered package
		# or looks like a manual -dbg package.
		if (!$all_packages{"${package}-dbgsym"} or $package =~ m/-dbg$/) {
			$debugtmp = "debian/.debhelper/${package}/ddeb-root";
			$keep_debug = 1;
			$use_build_id = 2;
		}
	}
	@shared_libs=@executables=@static_libs=@build_ids=();
	find(\&testfile,$tmp);

	foreach (@shared_libs) {
		my $debug_path = make_debug($_, $tmp, $debugtmp, $use_build_id, $package) if $keep_debug;
		# Note that all calls to strip on shared libs
		# *must* include the --strip-unneeded.
		doit($strip,"--remove-section=.comment",
			"--remove-section=.note","--strip-unneeded",$_);
		attach_debug($_, $debug_path) if defined $debug_path;
	}
	
	foreach (@executables) {
		my $debug_path = make_debug($_, $tmp, $debugtmp, $use_build_id, $package) if $keep_debug;
		doit($strip,"--remove-section=.comment",
			"--remove-section=.note",$_);
 		attach_debug($_, $debug_path) if defined $debug_path;
	}

	if (@static_libs) {
		my $strip_help = qx{$strip 2>&1};
		my @opts = ('--strip-debug', '--remove-section=.comment',
			'--remove-section=.note');
		if (index($strip_help, '--enable-deterministic-archives') > -1) {
			# NB: The short variant (-D) is broken in Jessie
			# (binutils/2.25-3)
			push(@opts, '--enable-deterministic-archives');
		}
		foreach (@static_libs) {
			doit($strip, @opts, $_);
		}
	}
	if ($use_build_id > 1 and -d $debugtmp) {
		my $ddeb_docdir = "${debugtmp}/usr/share/doc";
		my $doc_symlink = "${ddeb_docdir}/${package}-dbgsym";
		if ( not -l $doc_symlink and not -e $doc_symlink ) {
			install_dir($ddeb_docdir) if not -d $ddeb_docdir;
			doit('ln', '-s', $package, $doc_symlink);
		}
		if ($dh{MIGRATE_DDEB}) {
			my $path = "debian/.debhelper/${package}/ddeb-migration";
			open(my $fd, '>', $path) or error("open $path failed: $!");
			print {$fd} "$dh{MIGRATE_DDEB}\n";
			close($fd) or error("close $path failed: $!");
		}
	}
	if (@build_ids && ($use_build_id > 1 || ref($dh{DEBUGPACKAGES}))) {
		my ($dir, $path);
		if ($use_build_id > 1) {
			$dir = "debian/.debhelper/${package}";
		} else {
			my $dbg_pkg = @{$dh{DEBUGPACKAGES}}[0];
			$dir = "debian/.debhelper/${dbg_pkg}";
		}
		$path = "${dir}/ddeb-build-ids";
		install_dir($dir) if ! -d $dir;
		open(my $fd, '>>', $path) or error("open $path failed: $!");
		print {$fd} join(q{ }, sort(@build_ids)) . "\n";
		close($fd) or error("close $path failed: $!");
	}
}

=head1 SEE ALSO

L<debhelper(7)>

This program is a part of debhelper.

=head1 AUTHOR

Joey Hess <joeyh@debian.org>

=cut

# Local Variables:
# indent-tabs-mode: t
# tab-width: 4
# cperl-indent-level: 4
# End: