Commit | Line | Data |
---|---|---|
1479465f GJ |
1 | #!/usr/bin/perl |
2 | # | |
3 | # dpkg-gensymbols | |
4 | # | |
5 | # Copyright © 2007 Raphaël Hertzog | |
6 | # Copyright © 2007-2013 Guillem Jover <guillem@debian.org> | |
7 | # | |
8 | # This program is free software; you can redistribute it and/or modify | |
9 | # it under the terms of the GNU General Public License as published by | |
10 | # the Free Software Foundation; either version 2 of the License, or | |
11 | # (at your option) any later version. | |
12 | # | |
13 | # This program is distributed in the hope that it will be useful, | |
14 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
15 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
16 | # GNU General Public License for more details. | |
17 | # | |
18 | # You should have received a copy of the GNU General Public License | |
19 | # along with this program. If not, see <https://www.gnu.org/licenses/>. | |
20 | ||
21 | use strict; | |
22 | use warnings; | |
23 | ||
24 | use Dpkg (); | |
25 | use Dpkg::Arch qw(get_host_arch); | |
26 | use Dpkg::Package; | |
27 | use Dpkg::Shlibs qw(get_library_paths); | |
28 | use Dpkg::Shlibs::Objdump; | |
29 | use Dpkg::Shlibs::SymbolFile; | |
30 | use Dpkg::Gettext; | |
31 | use Dpkg::ErrorHandling; | |
32 | use Dpkg::Control::Info; | |
33 | use Dpkg::Changelog::Parse; | |
34 | use Dpkg::Path qw(check_files_are_the_same find_command); | |
35 | ||
36 | textdomain('dpkg-dev'); | |
37 | ||
38 | my $packagebuilddir = 'debian/tmp'; | |
39 | ||
40 | my $sourceversion; | |
41 | my $stdout; | |
42 | my $oppackage; | |
43 | my $compare = 1; # Bail on missing symbols by default | |
44 | my $quiet = 0; | |
45 | my $input; | |
46 | my $output; | |
47 | my $template_mode = 0; # non-template mode by default | |
48 | my $verbose_output = 0; | |
49 | my $debug = 0; | |
50 | my $host_arch = get_host_arch(); | |
51 | ||
52 | sub version { | |
53 | printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION; | |
54 | ||
55 | printf g_(' | |
56 | This is free software; see the GNU General Public License version 2 or | |
57 | later for copying conditions. There is NO warranty. | |
58 | '); | |
59 | } | |
60 | ||
61 | sub usage { | |
62 | printf g_( | |
63 | 'Usage: %s [<option>...]') | |
64 | . "\n\n" . g_( | |
65 | 'Options: | |
66 | -p<package> generate symbols file for package. | |
67 | -P<package-build-dir> temporary build directory instead of debian/tmp. | |
68 | -e<library> explicitly list libraries to scan. | |
69 | -v<version> version of the packages (defaults to | |
70 | version extracted from debian/changelog). | |
71 | -c<level> compare generated symbols file with the reference | |
72 | template in the debian directory and fail if | |
73 | difference is too important; level goes from 0 for | |
74 | no check, to 4 for all checks (default level is 1). | |
75 | -q keep quiet and never emit any warnings or | |
76 | generate a diff between generated symbols | |
77 | file and the reference template. | |
78 | -I<file> force usage of <file> as reference symbols | |
79 | file instead of the default file. | |
80 | -O[<file>] write to stdout (or <file>), not .../DEBIAN/symbols. | |
81 | -t write in template mode (tags are not | |
82 | processed and included in output). | |
83 | -V verbose output; write deprecated symbols and pattern | |
84 | matching symbols as comments (in template mode only). | |
85 | -a<arch> assume <arch> as host architecture when processing | |
86 | symbol files. | |
87 | -d display debug information during work. | |
88 | -?, --help show this help message. | |
89 | --version show the version. | |
90 | '), $Dpkg::PROGNAME; | |
91 | } | |
92 | ||
93 | my @files; | |
94 | while (@ARGV) { | |
95 | $_ = shift(@ARGV); | |
96 | if (m/^-p/p) { | |
97 | $oppackage = ${^POSTMATCH}; | |
98 | my $err = pkg_name_is_illegal($oppackage); | |
99 | error(g_("illegal package name '%s': %s"), $oppackage, $err) if $err; | |
100 | } elsif (m/^-c(\d)?$/) { | |
101 | $compare = $1 // 1; | |
102 | } elsif (m/^-q$/) { | |
103 | $quiet = 1; | |
104 | } elsif (m/^-d$/) { | |
105 | $debug = 1; | |
106 | } elsif (m/^-v(.+)$/) { | |
107 | $sourceversion = $1; | |
108 | } elsif (m/^-e(.+)$/) { | |
109 | my $file = $1; | |
110 | if (-e $file) { | |
111 | push @files, $file; | |
112 | } else { | |
113 | my @to_add = glob($file); | |
114 | push @files, @to_add; | |
115 | warning(g_("pattern '%s' did not match any file"), $file) | |
116 | unless scalar(@to_add); | |
117 | } | |
118 | } elsif (m/^-P(.+)$/) { | |
119 | $packagebuilddir = $1; | |
120 | $packagebuilddir =~ s{/+$}{}; | |
121 | } elsif (m/^-O$/) { | |
122 | $stdout = 1; | |
123 | } elsif (m/^-I(.+)$/) { | |
124 | $input = $1; | |
125 | } elsif (m/^-O(.+)$/) { | |
126 | $output = $1; | |
127 | } elsif (m/^-t$/) { | |
128 | $template_mode = 1; | |
129 | } elsif (m/^-V$/) { | |
130 | $verbose_output = 1; | |
131 | } elsif (m/^-a(.+)$/) { | |
132 | $host_arch = $1; | |
133 | } elsif (m/^-(?:\?|-help)$/) { | |
134 | usage(); | |
135 | exit(0); | |
136 | } elsif (m/^--version$/) { | |
137 | version(); | |
138 | exit(0); | |
139 | } else { | |
140 | usageerr(g_("unknown option '%s'"), $_); | |
141 | } | |
142 | } | |
143 | ||
144 | report_options(debug_level => $debug); | |
145 | ||
146 | umask 0022; # ensure sane default permissions for created files | |
147 | ||
148 | if (exists $ENV{DPKG_GENSYMBOLS_CHECK_LEVEL}) { | |
149 | $compare = $ENV{DPKG_GENSYMBOLS_CHECK_LEVEL}; | |
150 | } | |
151 | ||
152 | if (not defined($sourceversion)) { | |
153 | my $changelog = changelog_parse(); | |
154 | $sourceversion = $changelog->{'Version'}; | |
155 | } | |
156 | if (not defined($oppackage)) { | |
157 | my $control = Dpkg::Control::Info->new(); | |
158 | my @packages = map { $_->{'Package'} } $control->get_packages(); | |
159 | if (@packages == 0) { | |
160 | error(g_('no package stanza found in control info')); | |
161 | } elsif (@packages > 1) { | |
162 | error(g_('must specify package since control info has many (%s)'), | |
163 | "@packages"); | |
164 | } | |
165 | $oppackage = $packages[0]; | |
166 | } | |
167 | ||
168 | my $symfile = Dpkg::Shlibs::SymbolFile->new(arch => $host_arch); | |
169 | my $ref_symfile = Dpkg::Shlibs::SymbolFile->new(arch => $host_arch); | |
170 | # Load source-provided symbol information | |
171 | foreach my $file ($input, $output, "debian/$oppackage.symbols.$host_arch", | |
172 | "debian/symbols.$host_arch", "debian/$oppackage.symbols", | |
173 | 'debian/symbols') | |
174 | { | |
175 | if (defined $file and -e $file) { | |
176 | debug(1, "Using references symbols from $file"); | |
177 | $symfile->load($file); | |
178 | $ref_symfile->load($file) if $compare || ! $quiet; | |
179 | last; | |
180 | } | |
181 | } | |
182 | ||
183 | # Scan package build dir looking for libraries | |
184 | if (not scalar @files) { | |
185 | PATH: foreach my $path (get_library_paths()) { | |
186 | my $libdir = "$packagebuilddir$path"; | |
187 | $libdir =~ s{/+}{/}g; | |
188 | lstat $libdir; | |
189 | next if not -d _; | |
190 | next if -l _; # Skip directories which are symlinks | |
191 | # Skip any directory _below_ a symlink as well | |
192 | my $updir = $libdir; | |
193 | while (($updir =~ s{/[^/]*$}{}) and | |
194 | not check_files_are_the_same($packagebuilddir, $updir)) { | |
195 | next PATH if -l $updir; | |
196 | } | |
197 | opendir(my $libdir_dh, "$libdir") | |
198 | or syserr(g_("can't read directory %s: %s"), $libdir, $!); | |
199 | push @files, grep { | |
200 | /(\.so\.|\.so$)/ && -f && | |
201 | Dpkg::Shlibs::Objdump::is_elf($_); | |
202 | } map { "$libdir/$_" } readdir($libdir_dh); | |
203 | closedir $libdir_dh; | |
204 | } | |
205 | } | |
206 | ||
207 | # Merge symbol information | |
208 | my $od = Dpkg::Shlibs::Objdump->new(); | |
209 | foreach my $file (@files) { | |
210 | debug(1, "Scanning $file for symbol information"); | |
211 | my $objid = $od->analyze($file); | |
212 | unless (defined($objid) && $objid) { | |
213 | warning(g_("Dpkg::Shlibs::Objdump couldn't parse %s\n"), $file); | |
214 | next; | |
215 | } | |
216 | my $object = $od->get_object($objid); | |
217 | if ($object->{SONAME}) { # Objects without soname are of no interest | |
218 | debug(1, "Merging symbols from $file as $object->{SONAME}"); | |
219 | if (not $symfile->has_object($object->{SONAME})) { | |
220 | $symfile->create_object($object->{SONAME}, "$oppackage #MINVER#"); | |
221 | } | |
222 | $symfile->merge_symbols($object, $sourceversion); | |
223 | } else { | |
224 | debug(1, "File $file doesn't have a soname. Ignoring."); | |
225 | } | |
226 | } | |
227 | $symfile->clear_except(keys %{$od->{objects}}); | |
228 | ||
229 | # Write out symbols files | |
230 | if ($stdout) { | |
231 | $output = g_('<standard output>'); | |
232 | $symfile->output(\*STDOUT, package => $oppackage, | |
233 | template_mode => $template_mode, | |
234 | with_pattern_matches => $verbose_output, | |
235 | with_deprecated => $verbose_output); | |
236 | } else { | |
237 | unless (defined($output)) { | |
238 | unless ($symfile->is_empty()) { | |
239 | $output = "$packagebuilddir/DEBIAN/symbols"; | |
240 | mkdir("$packagebuilddir/DEBIAN") if not -e "$packagebuilddir/DEBIAN"; | |
241 | } | |
242 | } | |
243 | if (defined($output)) { | |
244 | debug(1, "Storing symbols in $output."); | |
245 | $symfile->save($output, package => $oppackage, | |
246 | template_mode => $template_mode, | |
247 | with_pattern_matches => $verbose_output, | |
248 | with_deprecated => $verbose_output); | |
249 | } else { | |
250 | debug(1, 'No symbol information to store.'); | |
251 | } | |
252 | } | |
253 | ||
254 | # Check if generated files differs from reference file | |
255 | my $exitcode = 0; | |
256 | if ($compare || ! $quiet) { | |
257 | # Compare | |
258 | if (my @libs = $symfile->get_new_libs($ref_symfile)) { | |
259 | warning(g_('new libraries appeared in the symbols file: %s'), "@libs") | |
260 | unless $quiet; | |
261 | $exitcode = 4 if ($compare >= 4); | |
262 | } | |
263 | if (my @libs = $symfile->get_lost_libs($ref_symfile)) { | |
264 | warning(g_('some libraries disappeared in the symbols file: %s'), "@libs") | |
265 | unless $quiet; | |
266 | $exitcode = 3 if ($compare >= 3); | |
267 | } | |
268 | if ($symfile->get_new_symbols($ref_symfile)) { | |
269 | warning(g_('some new symbols appeared in the symbols file: %s'), | |
270 | g_('see diff output below')) unless $quiet; | |
271 | $exitcode = 2 if ($compare >= 2); | |
272 | } | |
273 | if ($symfile->get_lost_symbols($ref_symfile)) { | |
274 | warning(g_('some symbols or patterns disappeared in the symbols file: %s'), | |
275 | g_('see diff output below')) unless $quiet; | |
276 | $exitcode = 1 if ($compare >= 1); | |
277 | } | |
278 | } | |
279 | ||
280 | unless ($quiet) { | |
281 | require File::Temp; | |
282 | require Digest::MD5; | |
283 | ||
284 | my $file_label; | |
285 | ||
286 | # Compare template symbols files before and after | |
287 | my $before = File::Temp->new(TEMPLATE=>'dpkg-gensymbolsXXXXXX'); | |
288 | my $after = File::Temp->new(TEMPLATE=>'dpkg-gensymbolsXXXXXX'); | |
289 | if ($ref_symfile->{file}) { | |
290 | $file_label = $ref_symfile->{file}; | |
291 | } else { | |
292 | $file_label = 'new_symbol_file'; | |
293 | } | |
294 | $ref_symfile->output($before, package => $oppackage, template_mode => 1); | |
295 | $symfile->output($after, package => $oppackage, template_mode => 1); | |
296 | ||
297 | seek $before, 0, 0; | |
298 | seek $after, 0, 0; | |
299 | my ($md5_before, $md5_after) = (Digest::MD5->new(), Digest::MD5->new()); | |
300 | $md5_before->addfile($before); | |
301 | $md5_after->addfile($after); | |
302 | ||
303 | # Output diffs between symbols files if any | |
304 | if ($md5_before->hexdigest() ne $md5_after->hexdigest()) { | |
305 | if (not defined($output)) { | |
306 | warning(g_('the generated symbols file is empty')); | |
307 | } elsif (defined($ref_symfile->{file})) { | |
308 | warning(g_("%s doesn't match completely %s"), | |
309 | $output, $ref_symfile->{file}); | |
310 | } else { | |
311 | warning(g_('no debian/symbols file used as basis for generating %s'), | |
312 | $output); | |
313 | } | |
314 | my ($a, $b) = ($before->filename, $after->filename); | |
315 | my $diff_label = sprintf('%s (%s_%s_%s)', $file_label, $oppackage, | |
316 | $sourceversion, $host_arch); | |
317 | system('diff', '-u', '-L', $diff_label, $a, $b) if find_command('diff'); | |
318 | } | |
319 | } | |
320 | exit($exitcode); |