perl: Fold if into previous else
[dpkg.git] / scripts / dpkg-gensymbols.pl
blobd005acb5bf24e8b7c1fa1f6948289e66b8d5b868
1 #!/usr/bin/perl
3 # dpkg-gensymbols
5 # Copyright © 2007 Raphaël Hertzog
6 # Copyright © 2007-2013 Guillem Jover <guillem@debian.org>
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.
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.
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/>.
21 use strict;
22 use warnings;
24 use Dpkg ();
25 use Dpkg::Arch qw(get_host_arch);
26 use Dpkg::Package;
27 use Dpkg::BuildAPI qw(get_build_api);
28 use Dpkg::Shlibs qw(get_library_paths);
29 use Dpkg::Shlibs::Objdump;
30 use Dpkg::Shlibs::SymbolFile;
31 use Dpkg::Gettext;
32 use Dpkg::ErrorHandling;
33 use Dpkg::Control::Info;
34 use Dpkg::Changelog::Parse;
35 use Dpkg::Path qw(check_files_are_the_same find_command);
37 textdomain('dpkg-dev');
39 my $packagebuilddir = 'debian/tmp';
41 my $sourceversion;
42 my $stdout;
43 my $oppackage;
44 my $compare = 1; # Bail on missing symbols by default
45 my $quiet = 0;
46 my $input;
47 my $output;
48 my $template_mode = 0; # non-template mode by default
49 my $verbose_output = 0;
50 my $debug = 0;
51 my $host_arch = get_host_arch();
53 sub version {
54 printf g_("Debian %s version %s.\n"), $Dpkg::PROGNAME, $Dpkg::PROGVERSION;
56 printf g_('
57 This is free software; see the GNU General Public License version 2 or
58 later for copying conditions. There is NO warranty.
59 ');
62 sub usage {
63 printf g_(
64 'Usage: %s [<option>...]')
65 . "\n\n" . g_(
66 'Options:
67 -l<library-path> add directory to private shared library search list.
68 -p<package> generate symbols file for package.
69 -P<package-build-dir> temporary build directory instead of debian/tmp.
70 -e<library> explicitly list libraries to scan.
71 -v<version> version of the packages (defaults to
72 version extracted from debian/changelog).
73 -c<level> compare generated symbols file with the reference
74 template in the debian directory and fail if
75 difference is too important; level goes from 0 for
76 no check, to 4 for all checks (default level is 1).
77 -q keep quiet and never emit any warnings or
78 generate a diff between generated symbols
79 file and the reference template.
80 -I<file> force usage of <file> as reference symbols
81 file instead of the default file.
82 -O[<file>] write to stdout (or <file>), not .../DEBIAN/symbols.
83 -t write in template mode (tags are not
84 processed and included in output).
85 -V verbose output; write deprecated symbols and pattern
86 matching symbols as comments (in template mode only).
87 -a<arch> assume <arch> as host architecture when processing
88 symbol files.
89 -d display debug information during work.
90 -?, --help show this help message.
91 --version show the version.
92 '), $Dpkg::PROGNAME;
95 my @files;
96 while (@ARGV) {
97 $_ = shift(@ARGV);
98 if (m/^-p/p) {
99 $oppackage = ${^POSTMATCH};
100 my $err = pkg_name_is_illegal($oppackage);
101 error(g_("illegal package name '%s': %s"), $oppackage, $err) if $err;
102 } elsif (m/^-l(.*)$/) {
103 Dpkg::Shlibs::add_library_dir($1);
104 } elsif (m/^-c(\d)?$/) {
105 $compare = $1 // 1;
106 } elsif (m/^-q$/) {
107 $quiet = 1;
108 } elsif (m/^-d$/) {
109 $debug = 1;
110 } elsif (m/^-v(.+)$/) {
111 $sourceversion = $1;
112 } elsif (m/^-e(.+)$/) {
113 my $file = $1;
114 if (-e $file) {
115 push @files, $file;
116 } else {
117 my @to_add = glob($file);
118 push @files, @to_add;
119 warning(g_("pattern '%s' did not match any file"), $file)
120 unless scalar(@to_add);
122 } elsif (m/^-P(.+)$/) {
123 $packagebuilddir = $1;
124 $packagebuilddir =~ s{/+$}{};
125 } elsif (m/^-O$/) {
126 $stdout = 1;
127 } elsif (m/^-I(.+)$/) {
128 $input = $1;
129 } elsif (m/^-O(.+)$/) {
130 $output = $1;
131 } elsif (m/^-t$/) {
132 $template_mode = 1;
133 } elsif (m/^-V$/) {
134 $verbose_output = 1;
135 } elsif (m/^-a(.+)$/) {
136 $host_arch = $1;
137 } elsif (m/^-(?:\?|-help)$/) {
138 usage();
139 exit(0);
140 } elsif (m/^--version$/) {
141 version();
142 exit(0);
143 } else {
144 usageerr(g_("unknown option '%s'"), $_);
148 report_options(debug_level => $debug);
150 umask 0022; # ensure sane default permissions for created files
152 if (exists $ENV{DPKG_GENSYMBOLS_CHECK_LEVEL}) {
153 $compare = $ENV{DPKG_GENSYMBOLS_CHECK_LEVEL};
156 if (not defined($sourceversion)) {
157 my $changelog = changelog_parse();
158 $sourceversion = $changelog->{'Version'};
160 my $control = Dpkg::Control::Info->new();
161 # Initialize the build API level.
162 get_build_api($control);
163 if (not defined($oppackage)) {
164 my @packages = map { $_->{'Package'} } $control->get_packages();
165 if (@packages == 0) {
166 error(g_('no package stanza found in control info'));
167 } elsif (@packages > 1) {
168 error(g_('must specify package since control info has many (%s)'),
169 "@packages");
171 $oppackage = $packages[0];
174 my $symfile = Dpkg::Shlibs::SymbolFile->new(arch => $host_arch);
175 my $ref_symfile = Dpkg::Shlibs::SymbolFile->new(arch => $host_arch);
176 my @source_symbol_files = (
177 $input,
178 $output,
179 "debian/$oppackage.symbols.$host_arch",
180 "debian/symbols.$host_arch",
181 "debian/$oppackage.symbols",
182 'debian/symbols',
185 # Load source-provided symbol information
186 foreach my $file (@source_symbol_files) {
187 if (defined $file and -e $file) {
188 debug(1, "Using references symbols from $file");
189 $symfile->load($file);
190 $ref_symfile->load($file) if $compare || ! $quiet;
191 last;
195 # Scan package build dir looking for libraries
196 if (not scalar @files) {
197 PATH: foreach my $path (get_library_paths()) {
198 my $libdir = "$packagebuilddir$path";
199 $libdir =~ s{/+}{/}g;
200 lstat $libdir;
201 next if not -d _;
202 next if -l _; # Skip directories which are symlinks
203 # Skip any directory _below_ a symlink as well
204 my $updir = $libdir;
205 while (($updir =~ s{/[^/]*$}{}) and
206 not check_files_are_the_same($packagebuilddir, $updir)) {
207 next PATH if -l $updir;
209 opendir(my $libdir_dh, "$libdir")
210 or syserr(g_("can't read directory %s: %s"), $libdir, $!);
211 push @files, grep {
212 /(\.so\.|\.so$)/ && -f &&
213 Dpkg::Shlibs::Objdump::is_elf($_);
214 } map { "$libdir/$_" } readdir($libdir_dh);
215 closedir $libdir_dh;
219 # Merge symbol information
220 my $od = Dpkg::Shlibs::Objdump->new();
221 foreach my $file (@files) {
222 debug(1, "Scanning $file for symbol information");
223 my $objid = $od->analyze($file);
224 unless (defined($objid) && $objid) {
225 warning(g_("Dpkg::Shlibs::Objdump couldn't parse %s\n"), $file);
226 next;
228 my $object = $od->get_object($objid);
229 if ($object->{SONAME}) { # Objects without soname are of no interest
230 debug(1, "Merging symbols from $file as $object->{SONAME}");
231 if (not $symfile->has_object($object->{SONAME})) {
232 $symfile->create_object($object->{SONAME}, "$oppackage #MINVER#");
234 $symfile->merge_symbols($object, $sourceversion);
235 } else {
236 debug(1, "File $file doesn't have a soname. Ignoring.");
239 $symfile->clear_except(keys %{$od->{objects}});
241 # Write out symbols files
242 if ($stdout) {
243 $output = g_('<standard output>');
244 $symfile->output(\*STDOUT, package => $oppackage,
245 template_mode => $template_mode,
246 with_pattern_matches => $verbose_output,
247 with_deprecated => $verbose_output);
248 } else {
249 unless (defined($output)) {
250 unless ($symfile->is_empty()) {
251 $output = "$packagebuilddir/DEBIAN/symbols";
252 mkdir("$packagebuilddir/DEBIAN") if not -e "$packagebuilddir/DEBIAN";
255 if (defined($output)) {
256 debug(1, "Storing symbols in $output.");
257 $symfile->save($output, package => $oppackage,
258 template_mode => $template_mode,
259 with_pattern_matches => $verbose_output,
260 with_deprecated => $verbose_output);
261 } else {
262 debug(1, 'No symbol information to store.');
266 # Check if generated files differs from reference file
267 my $exitcode = 0;
269 sub compare_problem
271 my ($level, $msg, @args) = @_;
273 if ($compare >= $level) {
274 errormsg($msg, @args);
275 $exitcode = $level;
276 } else {
277 warning($msg, @args) unless $quiet;
281 if ($compare || ! $quiet) {
282 # Compare
283 if (my @libs = $symfile->get_new_libs($ref_symfile)) {
284 compare_problem(4, g_('new libraries appeared in the symbols file: %s'), "@libs");
286 if (my @libs = $symfile->get_lost_libs($ref_symfile)) {
287 compare_problem(3, g_('some libraries disappeared in the symbols file: %s'), "@libs");
289 if ($symfile->get_new_symbols($ref_symfile)) {
290 compare_problem(2, g_('some new symbols appeared in the symbols file: %s'),
291 g_('see diff output below'));
293 if ($symfile->get_lost_symbols($ref_symfile)) {
294 compare_problem(1, g_('some symbols or patterns disappeared in the symbols file: %s'),
295 g_('see diff output below'))
299 unless ($quiet) {
300 require File::Temp;
301 require File::Compare;
303 my $file_label;
305 # Compare template symbols files before and after
306 my $before = File::Temp->new(TEMPLATE => 'dpkg-gensymbolsXXXXXX');
307 my $after = File::Temp->new(TEMPLATE => 'dpkg-gensymbolsXXXXXX');
308 if ($ref_symfile->{file}) {
309 $file_label = $ref_symfile->{file};
310 } else {
311 $file_label = 'new_symbol_file';
313 $ref_symfile->output($before, package => $oppackage, template_mode => 1);
314 $symfile->output($after, package => $oppackage, template_mode => 1);
316 seek $before, 0, 0;
317 seek $after, 0, 0;
319 # Output diffs between symbols files if any
320 if (File::Compare::compare($before, $after) != 0) {
321 if (not defined($output)) {
322 warning(g_('the generated symbols file is empty'));
323 } elsif (defined($ref_symfile->{file})) {
324 warning(g_("%s doesn't match completely %s"),
325 $output, $ref_symfile->{file});
326 } else {
327 warning(g_('no debian/symbols file used as basis for generating %s'),
328 $output);
330 my ($a, $b) = ($before->filename, $after->filename);
331 my $diff_label = sprintf('%s (%s_%s_%s)', $file_label, $oppackage,
332 $sourceversion, $host_arch);
333 system('diff', '-u', '-L', $diff_label, $a, $b) if find_command('diff');
336 exit($exitcode);