#!/usr/bin/perl
# Get list of debug symbol packages relevant for a core file or ELF
# program/library.
#
# Copyright (C) 2017 Stefan Fritsch <sf@debian.org>
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
use strict;
use warnings FATAL => 'all';
use autodie qw(:all);
use v5.14;
use IPC::System::Simple qw(capture);
$ENV{LC_ALL} = 'C';
if (scalar @ARGV == 0 or $ARGV[0] eq '--help' or $ARGV[0] eq '-h') {
usage();
}
my %pkgs;
foreach my $arg (@ARGV) {
my %build_ids;
if ($arg =~ /^\d+$/) {
%build_ids = get_build_ids_from_pid($arg);
} else {
%build_ids = get_build_ids_from_core($arg);
}
foreach my $id (keys %build_ids) {
my $name = $build_ids{$id};
next if $name =~ /^linux-vdso[.]so[.]/;
my @p = get_debs_from_id($id);
if (scalar @p == 0) {
warn "Cannot find debug package for $name ($id)\n";
} elsif (scalar @p > 1) {
warn "Multiple packages for $name ($id): @p\n";
}
foreach my $p (@p) {
$pkgs{$p} = 1;
}
}
}
say join(" ", sort keys %pkgs);
exit 0;
#### sub routines ####
sub parse_eu_unstrip
{
my ($output) = @_;
my %ids;
foreach my $line (split(/\n/, $output)) {
chomp $line;
# 0x7fa9b8017000+0x39e9a0 79450f6e36287865d093ea209b85a222209925ff@0x7fa9b8017280 /lib/x86_64-linux-gnu/libc.so.6 /usr/lib/debug/.build-id/79/450f6e36287865d093ea209b85a222209925ff.debug libc.so.6
# 0x7f7f7235e000+0x17000 - /usr/share/locale/de/LC_MESSAGES/bash.mo - /usr/share/locale/de/LC_MESSAGES/bash.mo
# 0x7ffd4098a000+0x2000 de7dac2df9f596f46fa94a387858ef25170603ec@0x7ffd4098a7d0 . - [vdso: 1740]
if ($line =~ m{^(?:0 | 0x[[:xdigit:]]+)
[+]
0x[[:xdigit:]]+
\s+
([[:xdigit:]]{40} [@] 0x[[:xdigit:]]+ | - )
\s+
\S+
\s+
\S+
\s+
(\S.*)
$}ix) {
my $id = $1;
my $name = $2;
if ($name =~ /\[vdso: \d+\]/) {
next;
}
if ($id eq '-') {
warn "No build-ID for $name\n";
next;
} elsif ($id =~ /^([[:xdigit:]]{40})[@]/) {
$id = $1;
} else {
die "BUG: id='$id'";
}
$ids{$id} = $name;
} else {
warn "Cannot parse eu-unstrip output: '$line'\n";
}
}
return (%ids);
}
sub get_build_ids_from_core
{
my ($filename) = @_;
my $output = capture("eu-unstrip -n --core=\Q$filename\E");
return parse_eu_unstrip($output);
}
sub get_build_ids_from_pid
{
my ($pid) = @_;
my $output = capture("eu-unstrip -n -p \Q$pid\E");
chomp $output;
return parse_eu_unstrip($output);
}
sub get_debs_from_id
{
my ($id) = @_;
my $output;
eval {
$output = capture("grep-aptavail -s Package -F Build-IDs \Q$id\E");
};
if ($@) {
return;
}
my %pkgs;
foreach my $line (split(/\n/, $output)) {
chomp $line;
if ($line =~ /^Package:\s*(\S+)$/) {
$pkgs{$1} = 1;
} else {
warn "Cannot parse grep-aptavail output: '$line'\n";
}
}
return sort keys %pkgs;
}
sub is_core_file
{
my ($filename) = (@_);
# warn qq{eu-readelf -n \Q$filename\E};
my $output = capture("eu-readelf -h \Q$filename\E");
if ($output =~ /^\s*Type:\s*CORE/m) {
return 1;
}
return;
}
sub usage
{
print << "EOF";
usage:
$0 <core file or PID> [ ... ]
You must already have the correct debug lines in your sources.list and have
executed 'apt-get update'.
$0 requires the elfutils and dctrl-tools packages to be installed.
EOF
exit 1;
}
# vim: syntax=perl sw=4 sts=4 sr et