find-dbgsym-packages: New tool to get list of dbgsym packages from core dump or PID
Closes: #871620
Stefan Fritsch authored 6 years ago
Axel Beckert committed 6 years ago
| 0 | #!/usr/bin/perl | |
| 1 | ||
| 2 | # Get list of debug symbol packages relevant for a core file or ELF | |
| 3 | # program/library. | |
| 4 | # | |
| 5 | # Copyright (C) 2017 Stefan Fritsch <sf@debian.org> | |
| 6 | # | |
| 7 | # This program is free software; you can redistribute it and/or modify | |
| 8 | # it under the terms of the GNU General Public License as published by | |
| 9 | # the Free Software Foundation; either version 2 of the License, or | |
| 10 | # (at your option) any later version. | |
| 11 | # | |
| 12 | # This program is distributed in the hope that it will be useful, | |
| 13 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
| 14 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
| 15 | # GNU General Public License for more details. | |
| 16 | # | |
| 17 | # You should have received a copy of the GNU General Public License along | |
| 18 | # with this program; if not, write to the Free Software Foundation, Inc., | |
| 19 | # 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA. | |
| 20 | ||
| 21 | use strict; | |
| 22 | use warnings FATAL => 'all'; | |
| 23 | use autodie qw(:all); | |
| 24 | use v5.14; | |
| 25 | use IPC::System::Simple qw(capture); | |
| 26 | ||
| 27 | $ENV{LC_ALL} = 'C'; | |
| 28 | ||
| 29 | if (scalar @ARGV == 0) { | |
| 30 | usage(); | |
| 31 | } | |
| 32 | ||
| 33 | my %pkgs; | |
| 34 | foreach my $arg (@ARGV) { | |
| 35 | my %build_ids; | |
| 36 | if ($arg =~ /^\d+$/) { | |
| 37 | %build_ids = get_build_ids_from_pid($arg); | |
| 38 | } else { | |
| 39 | %build_ids = get_build_ids_from_core($arg); | |
| 40 | } | |
| 41 | ||
| 42 | foreach my $id (keys %build_ids) { | |
| 43 | my $name = $build_ids{$id}; | |
| 44 | ||
| 45 | next if $name =~ /^linux-vdso[.]so[.]/; | |
| 46 | ||
| 47 | my @p = get_debs_from_id($id); | |
| 48 | if (scalar @p == 0) { | |
| 49 | warn "Cannot find debug package for $name ($id)\n"; | |
| 50 | } elsif (scalar @p > 1) { | |
| 51 | warn "Multiple packages for $name ($id): @p\n"; | |
| 52 | } | |
| 53 | foreach my $p (@p) { | |
| 54 | $pkgs{$p} = 1; | |
| 55 | } | |
| 56 | } | |
| 57 | } | |
| 58 | ||
| 59 | say join(" ", sort keys %pkgs); | |
| 60 | ||
| 61 | exit 0; | |
| 62 | ||
| 63 | #### sub routines #### | |
| 64 | ||
| 65 | sub parse_eu_unstrip | |
| 66 | { | |
| 67 | my ($output) = @_; | |
| 68 | ||
| 69 | my %ids; | |
| 70 | ||
| 71 | foreach my $line (split(/\n/, $output)) { | |
| 72 | chomp $line; | |
| 73 | # 0x7fa9b8017000+0x39e9a0 79450f6e36287865d093ea209b85a222209925ff@0x7fa9b8017280 /lib/x86_64-linux-gnu/libc.so.6 /usr/lib/debug/.build-id/79/450f6e36287865d093ea209b85a222209925ff.debug libc.so.6 | |
| 74 | # 0x7f7f7235e000+0x17000 - /usr/share/locale/de/LC_MESSAGES/bash.mo - /usr/share/locale/de/LC_MESSAGES/bash.mo | |
| 75 | # 0x7ffd4098a000+0x2000 de7dac2df9f596f46fa94a387858ef25170603ec@0x7ffd4098a7d0 . - [vdso: 1740] | |
| 76 | if ($line =~ m{^(?:0 | 0x[[:xdigit:]]+) | |
| 77 | [+] | |
| 78 | 0x[[:xdigit:]]+ | |
| 79 | \s+ | |
| 80 | ([[:xdigit:]]{40} [@] 0x[[:xdigit:]]+ | - ) | |
| 81 | \s+ | |
| 82 | \S+ | |
| 83 | \s+ | |
| 84 | \S+ | |
| 85 | \s+ | |
| 86 | (\S.*) | |
| 87 | $}ix) { | |
| 88 | my $id = $1; | |
| 89 | my $name = $2; | |
| 90 | if ($name =~ /\[vdso: \d+\]/) { | |
| 91 | next; | |
| 92 | } | |
| 93 | if ($id eq '-') { | |
| 94 | warn "No build-ID for $name\n"; | |
| 95 | next; | |
| 96 | } elsif ($id =~ /^([[:xdigit:]]{40})[@]/) { | |
| 97 | $id = $1; | |
| 98 | } else { | |
| 99 | die "BUG: id='$id'"; | |
| 100 | } | |
| 101 | $ids{$id} = $name; | |
| 102 | } else { | |
| 103 | warn "Cannot parse eu-unstrip output: '$line'\n"; | |
| 104 | } | |
| 105 | } | |
| 106 | return (%ids); | |
| 107 | } | |
| 108 | ||
| 109 | sub get_build_ids_from_core | |
| 110 | { | |
| 111 | my ($filename) = @_; | |
| 112 | my $output = capture("eu-unstrip -n --core=\Q$filename\E"); | |
| 113 | ||
| 114 | return parse_eu_unstrip($output); | |
| 115 | } | |
| 116 | ||
| 117 | sub get_build_ids_from_pid | |
| 118 | { | |
| 119 | my ($pid) = @_; | |
| 120 | my $output = capture("eu-unstrip -n -p \Q$pid\E"); | |
| 121 | chomp $output; | |
| 122 | ||
| 123 | return parse_eu_unstrip($output); | |
| 124 | } | |
| 125 | ||
| 126 | sub get_debs_from_id | |
| 127 | { | |
| 128 | my ($id) = @_; | |
| 129 | ||
| 130 | my $output; | |
| 131 | eval { | |
| 132 | $output = capture("grep-aptavail -s Package -F Build-IDs \Q$id\E"); | |
| 133 | }; | |
| 134 | if ($@) { | |
| 135 | return; | |
| 136 | } | |
| 137 | ||
| 138 | my %pkgs; | |
| 139 | foreach my $line (split(/\n/, $output)) { | |
| 140 | chomp $line; | |
| 141 | if ($line =~ /^Package:\s*(\S+)$/) { | |
| 142 | $pkgs{$1} = 1; | |
| 143 | } else { | |
| 144 | warn "Cannot parse grep-aptavail output: '$line'\n"; | |
| 145 | } | |
| 146 | } | |
| 147 | return sort keys %pkgs; | |
| 148 | } | |
| 149 | ||
| 150 | sub is_core_file | |
| 151 | { | |
| 152 | my ($filename) = (@_); | |
| 153 | # warn qq{eu-readelf -n \Q$filename\E}; | |
| 154 | my $output = capture("eu-readelf -h \Q$filename\E"); | |
| 155 | if ($output =~ /^\s*Type:\s*CORE/m) { | |
| 156 | return 1; | |
| 157 | } | |
| 158 | return; | |
| 159 | } | |
| 160 | ||
| 161 | sub usage | |
| 162 | { | |
| 163 | print << "EOF"; | |
| 164 | usage: | |
| 165 | $0 <core file or PID> [ ... ] | |
| 166 | ||
| 167 | You must already have the correct debug lines in your sources.list and have | |
| 168 | executed 'apt-get update'. | |
| 169 | ||
| 170 | $0 requires the elfutils and dctrl-tools packages to be installed. | |
| 171 | EOF | |
| 172 | ||
| 173 | exit 1; | |
| 174 | } | |
| 175 | ||
| 176 | # vim: syntax=perl sw=4 sts=4 sr et |