File: | Dpkg/Shlibs/SymbolFile.pm |
Coverage: | 78.7% |
line | stmt | bran | cond | sub | pod | time | code |
---|---|---|---|---|---|---|---|
1 | # Copyright © 2007 Raphaël Hertzog <hertzog@debian.org> | ||||||
2 | # Copyright © 2009-2010 Modestas Vainius <modax@debian.org> | ||||||
3 | # | ||||||
4 | # This program is free software; you can redistribute it and/or modify | ||||||
5 | # it under the terms of the GNU General Public License as published by | ||||||
6 | # the Free Software Foundation; either version 2 of the License, or | ||||||
7 | # (at your option) any later version. | ||||||
8 | # | ||||||
9 | # This program is distributed in the hope that it will be useful, | ||||||
10 | # but WITHOUT ANY WARRANTY; without even the implied warranty of | ||||||
11 | # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | ||||||
12 | # GNU General Public License for more details. | ||||||
13 | # | ||||||
14 | # You should have received a copy of the GNU General Public License | ||||||
15 | # along with this program. If not, see <https://www.gnu.org/licenses/>. | ||||||
16 | |||||||
17 | =encoding utf8 | ||||||
18 | |||||||
19 - 29 | =head1 NAME Dpkg::Shlibs::SymbolFile - represent a symbols file =head1 DESCRIPTION This module provides a class to handle symbols files. B<Note>: This is a private module, its API can change at any time. =cut | ||||||
30 | |||||||
31 | package Dpkg::Shlibs::SymbolFile 0.01; | ||||||
32 | |||||||
33 | 6 6 6 | 92 10 612 | use strict; | ||||
34 | 6 6 6 | 20 10 448 | use warnings; | ||||
35 | |||||||
36 | 6 6 6 | 28 4 402 | use Dpkg::Gettext; | ||||
37 | 6 6 6 | 30 6 290 | use Dpkg::ErrorHandling; | ||||
38 | 6 6 6 | 16 6 322 | use Dpkg::Version; | ||||
39 | 6 6 6 | 5298 8 426 | use Dpkg::Control::Fields; | ||||
40 | 6 6 6 | 4894 8 150 | use Dpkg::Shlibs::Symbol; | ||||
41 | 6 6 6 | 18 8 196 | use Dpkg::Arch qw(get_host_arch); | ||||
42 | |||||||
43 | 6 6 6 | 14 4 24 | use parent qw(Dpkg::Interface::Storable); | ||||
44 | |||||||
45 | my %internal_symbol = ( | ||||||
46 | __bss_end__ => 1, # arm | ||||||
47 | __bss_end => 1, # arm | ||||||
48 | _bss_end__ => 1, # arm | ||||||
49 | __bss_start => 1, # ALL | ||||||
50 | __bss_start__ => 1, # arm | ||||||
51 | __data_start => 1, # arm | ||||||
52 | __do_global_ctors_aux => 1, # ia64 | ||||||
53 | __do_global_dtors_aux => 1, # ia64 | ||||||
54 | __do_jv_register_classes => 1, # ia64 | ||||||
55 | _DYNAMIC => 1, # ALL | ||||||
56 | _edata => 1, # ALL | ||||||
57 | _end => 1, # ALL | ||||||
58 | __end__ => 1, # arm | ||||||
59 | __exidx_end => 1, # armel | ||||||
60 | __exidx_start => 1, # armel | ||||||
61 | _fbss => 1, # mips, mipsel | ||||||
62 | _fdata => 1, # mips, mipsel | ||||||
63 | _fini => 1, # ALL | ||||||
64 | _ftext => 1, # mips, mipsel | ||||||
65 | _GLOBAL_OFFSET_TABLE_ => 1, # hppa, mips, mipsel | ||||||
66 | __gmon_start__ => 1, # hppa | ||||||
67 | __gnu_local_gp => 1, # mips, mipsel | ||||||
68 | _gp => 1, # mips, mipsel | ||||||
69 | _init => 1, # ALL | ||||||
70 | _PROCEDURE_LINKAGE_TABLE_ => 1, # sparc, alpha | ||||||
71 | _SDA2_BASE_ => 1, # powerpc | ||||||
72 | _SDA_BASE_ => 1, # powerpc | ||||||
73 | ); | ||||||
74 | |||||||
75 | for my $i (14 .. 31) { | ||||||
76 | # Many powerpc specific symbols | ||||||
77 | $internal_symbol{"_restfpr_$i"} = 1; | ||||||
78 | $internal_symbol{"_restfpr_$i\_x"} = 1; | ||||||
79 | $internal_symbol{"_restgpr_$i"} = 1; | ||||||
80 | $internal_symbol{"_restgpr_$i\_x"} = 1; | ||||||
81 | $internal_symbol{"_savefpr_$i"} = 1; | ||||||
82 | $internal_symbol{"_savegpr_$i"} = 1; | ||||||
83 | } | ||||||
84 | |||||||
85 | sub symbol_is_internal { | ||||||
86 | 54618 | 0 | 46206 | my ($symbol, $include_groups) = @_; | |||
87 | |||||||
88 | 54618 | 58286 | return 1 if exists $internal_symbol{$symbol}; | ||||
89 | |||||||
90 | # The ARM Embedded ABI spec states symbols under this namespace as | ||||||
91 | # possibly appearing in output objects. | ||||||
92 | 54321 54321 | 32906 119197 | return 1 if not ${$include_groups}{aeabi} and $symbol =~ /^__aeabi_/; | ||||
93 | |||||||
94 | # The GNU implementation of the OpenMP spec, specifies symbols under | ||||||
95 | # this namespace as possibly appearing in output objects. | ||||||
96 | 54297 | 103088 | return 1 if not ${$include_groups}{gomp} | ||||
97 | 54297 | 36676 | and $symbol =~ /^\.gomp_critical_user_/; | ||||
98 | |||||||
99 | 54273 | 53428 | return 0; | ||||
100 | } | ||||||
101 | |||||||
102 | sub new { | ||||||
103 | 123 | 0 | 589 | my ($this, %opts) = @_; | |||
104 | 123 | 645 | my $class = ref($this) || $this; | ||||
105 | 123 | 160 | my $self = \%opts; | ||||
106 | 123 | 177 | bless $self, $class; | ||||
107 | 123 | 806 | $self->{arch} //= get_host_arch(); | ||||
108 | 123 | 255 | $self->clear(); | ||||
109 | 123 | 235 | if (exists $self->{file}) { | ||||
110 | 123 | 1569 | $self->load($self->{file}) if -e $self->{file}; | ||||
111 | } | ||||||
112 | 123 | 11284 | return $self; | ||||
113 | } | ||||||
114 | |||||||
115 | sub get_arch { | ||||||
116 | 140888 | 0 | 100870 | my $self = shift; | |||
117 | 140888 | 208238 | return $self->{arch}; | ||||
118 | } | ||||||
119 | |||||||
120 | sub clear { | ||||||
121 | 123 | 0 | 138 | my $self = shift; | |||
122 | 123 | 232 | $self->{objects} = {}; | ||||
123 | } | ||||||
124 | |||||||
125 | sub clear_except { | ||||||
126 | 0 | 0 | 0 | my ($self, @ids) = @_; | |||
127 | |||||||
128 | 0 0 | 0 0 | my %has = map { $_ => 1 } @ids; | ||||
129 | 0 0 | 0 0 | foreach my $objid (keys %{$self->{objects}}) { | ||||
130 | 0 | 0 | delete $self->{objects}{$objid} unless exists $has{$objid}; | ||||
131 | } | ||||||
132 | } | ||||||
133 | |||||||
134 | sub get_sonames { | ||||||
135 | 153 | 0 | 169 | my $self = shift; | |||
136 | 153 153 | 175 555 | return keys %{$self->{objects}}; | ||||
137 | } | ||||||
138 | |||||||
139 | sub get_symbols { | ||||||
140 | 264 | 0 | 456 | my ($self, $soname) = @_; | |||
141 | 264 | 418 | if (defined $soname) { | ||||
142 | 264 | 459 | my $obj = $self->get_object($soname); | ||||
143 | 264 264 | 466 16273 | return (defined $obj) ? values %{$obj->{syms}} : (); | ||||
144 | } else { | ||||||
145 | 0 | 0 | my @syms; | ||||
146 | 0 | 0 | foreach my $soname ($self->get_sonames()) { | ||||
147 | 0 | 0 | push @syms, $self->get_symbols($soname); | ||||
148 | } | ||||||
149 | 0 | 0 | return @syms; | ||||
150 | } | ||||||
151 | } | ||||||
152 | |||||||
153 | sub get_patterns { | ||||||
154 | 177 | 0 | 365 | my ($self, $soname) = @_; | |||
155 | 177 | 540 | my @patterns; | ||||
156 | 177 | 462 | if (defined $soname) { | ||||
157 | 177 | 328 | my $obj = $self->get_object($soname); | ||||
158 | 177 177 | 226 480 | foreach my $alias (values %{$obj->{patterns}{aliases}}) { | ||||
159 | 108 | 262 | push @patterns, values %$alias; | ||||
160 | } | ||||||
161 | 177 177 | 266 7686 | return (@patterns, @{$obj->{patterns}{generic}}); | ||||
162 | } else { | ||||||
163 | 0 | 0 | foreach my $soname ($self->get_sonames()) { | ||||
164 | 0 | 0 | push @patterns, $self->get_patterns($soname); | ||||
165 | } | ||||||
166 | 0 | 0 | return @patterns; | ||||
167 | } | ||||||
168 | } | ||||||
169 | |||||||
170 | # Create a symbol from the supplied string specification. | ||||||
171 | sub create_symbol { | ||||||
172 | 15735 | 0 | 23351 | my ($self, $spec, %opts) = @_; | |||
173 | my $symbol = (exists $opts{base}) ? $opts{base} : | ||||||
174 | 15735 | 18213 | Dpkg::Shlibs::Symbol->new(); | ||||
175 | |||||||
176 | 15735 | 23074 | my $ret = $opts{dummy} ? $symbol->parse_symbolspec($spec, default_minver => 0) : | ||||
177 | $symbol->parse_symbolspec($spec); | ||||||
178 | 15735 | 16390 | if ($ret) { | ||||
179 | 15735 | 18469 | $symbol->initialize(arch => $self->get_arch()); | ||||
180 | 15735 | 19807 | return $symbol; | ||||
181 | } | ||||||
182 | 0 | 0 | return; | ||||
183 | } | ||||||
184 | |||||||
185 | sub add_symbol { | ||||||
186 | 43299 | 0 | 37479 | my ($self, $symbol, $soname) = @_; | |||
187 | 43299 | 42088 | my $object = $self->get_object($soname); | ||||
188 | |||||||
189 | 43299 | 49190 | if ($symbol->is_pattern()) { | ||||
190 | 237 | 415 | if (my $alias_type = $symbol->get_alias_type()) { | ||||
191 | 138 | 560 | $object->{patterns}{aliases}{$alias_type} //= {}; | ||||
192 | # Alias hash for matching. | ||||||
193 | 138 | 176 | my $aliases = $object->{patterns}{aliases}{$alias_type}; | ||||
194 | 138 | 247 | $aliases->{$symbol->get_symbolname()} = $symbol; | ||||
195 | } else { | ||||||
196 | # Otherwise assume this is a generic sequential pattern. This | ||||||
197 | # should be always safe. | ||||||
198 | 99 99 | 106 172 | push @{$object->{patterns}{generic}}, $symbol; | ||||
199 | } | ||||||
200 | 237 | 662 | return 'pattern'; | ||||
201 | } else { | ||||||
202 | # invalidate the minimum version cache | ||||||
203 | 43062 | 38921 | $object->{minver_cache} = []; | ||||
204 | 43062 | 49022 | $object->{syms}{$symbol->get_symbolname()} = $symbol; | ||||
205 | 43062 | 59529 | return 'sym'; | ||||
206 | } | ||||||
207 | } | ||||||
208 | |||||||
209 | sub _new_symbol { | ||||||
210 | 15726 | 35927 | my $base = shift || 'Dpkg::Shlibs::Symbol'; | ||||
211 | 15726 | 26494 | return (ref $base) ? $base->clone(@_) : $base->new(@_); | ||||
212 | } | ||||||
213 | |||||||
214 | # Option state is only used for recursive calls. | ||||||
215 | sub parse { | ||||||
216 | 159 | 1 | 400 | my ($self, $fh, $file, %opts) = @_; | |||
217 | 159 | 559 | my $state = $opts{state} //= {}; | ||||
218 | |||||||
219 | 159 | 249 | if (exists $state->{seen}) { | ||||
220 | 54 | 144 | return if exists $state->{seen}{$file}; # Avoid include loops | ||||
221 | } else { | ||||||
222 | 105 | 154 | $self->{file} = $file; | ||||
223 | 105 | 175 | $state->{seen} = {}; | ||||
224 | } | ||||||
225 | 153 | 287 | $state->{seen}{$file} = 1; | ||||
226 | |||||||
227 | 153 | 255 | if (not ref $state->{obj_ref}) { # Init ref to name of current object/lib | ||||
228 | 105 105 | 96 176 | ${$state->{obj_ref}} = undef; | ||||
229 | } | ||||||
230 | |||||||
231 | 153 | 415 | while (<$fh>) { | ||||
232 | 15969 | 14850 | chomp; | ||||
233 | |||||||
234 | 15969 | 30816 | if (/^(?:\s+|#(?:DEPRECATED|MISSING): ([^#]+)#\s*)(.*)/) { | ||||
235 | 15708 15708 | 10246 17111 | if (not defined ${$state->{obj_ref}}) { | ||||
236 | 0 | 0 | error(g_('symbol information must be preceded by a header (file %s, line %s)'), $file, $.); | ||||
237 | } | ||||||
238 | # Symbol specification | ||||||
239 | 15708 | 16957 | my $deprecated = ($1) ? Dpkg::Version->new($1) : 0; | ||||
240 | 15708 | 21124 | my $sym = _new_symbol($state->{base_symbol}, deprecated => $deprecated); | ||||
241 | 15708 | 21590 | if ($self->create_symbol($2, base => $sym)) { | ||||
242 | 15708 15708 | 11563 18028 | $self->add_symbol($sym, ${$state->{obj_ref}}); | ||||
243 | } else { | ||||||
244 | 0 | 0 | warning(g_('failed to parse line in %s: %s'), $file, $_); | ||||
245 | } | ||||||
246 | } elsif (/^(\(.*\))?#include\s+"([^"]+)"/) { | ||||||
247 | 54 | 90 | my $tagspec = $1; | ||||
248 | 54 | 94 | my $filename = $2; | ||||
249 | 54 | 78 | my $dir = $file; | ||||
250 | 54 | 94 | my $old_base_symbol = $state->{base_symbol}; | ||||
251 | 54 | 70 | my $new_base_symbol; | ||||
252 | 54 | 118 | if (defined $tagspec) { | ||||
253 | 18 | 38 | $new_base_symbol = _new_symbol($old_base_symbol); | ||||
254 | 18 | 40 | $new_base_symbol->parse_tagspec($tagspec); | ||||
255 | } | ||||||
256 | 54 | 72 | $state->{base_symbol} = $new_base_symbol; | ||||
257 | 54 | 278 | $dir =~ s{[^/]+$}{}; # Strip filename | ||||
258 | 54 | 336 | $self->load("$dir$filename", %opts); | ||||
259 | 54 | 288 | $state->{base_symbol} = $old_base_symbol; | ||||
260 | } elsif (/^#|^$/) { | ||||||
261 | # Skip possible comments and empty lines | ||||||
262 | } elsif (/^\|\s*(.*)$/) { | ||||||
263 | # Alternative dependency template | ||||||
264 | 42 42 42 | 54 70 172 | push @{$self->{objects}{${$state->{obj_ref}}}{deps}}, "$1"; | ||||
265 | } elsif (/^\*\s*([^:]+):\s*(.*\S)\s*$/) { | ||||||
266 | # Add meta-fields | ||||||
267 | 12 12 | 14 42 | $self->{objects}{${$state->{obj_ref}}}{fields}{field_capitalize($1)} = $2; | ||||
268 | } elsif (/^(\S+)\s+(.*)$/) { | ||||||
269 | # New object and dependency template | ||||||
270 | 123 123 | 151 304 | ${$state->{obj_ref}} = $1; | ||||
271 | 123 123 | 174 250 | if (exists $self->{objects}{${$state->{obj_ref}}}) { | ||||
272 | # Update/override infos only | ||||||
273 | 6 6 | 20 24 | $self->{objects}{${$state->{obj_ref}}}{deps} = [ "$2" ]; | ||||
274 | } else { | ||||||
275 | # Create a new object | ||||||
276 | 117 117 | 128 423 | $self->create_object(${$state->{obj_ref}}, "$2"); | ||||
277 | } | ||||||
278 | } else { | ||||||
279 | 0 | 0 | warning(g_('failed to parse a line in %s: %s'), $file, $_); | ||||
280 | } | ||||||
281 | } | ||||||
282 | 153 | 815 | delete $state->{seen}{$file}; | ||||
283 | } | ||||||
284 | |||||||
285 | # Beware: we reuse the data structure of the provided symfile so make | ||||||
286 | # sure to not modify them after having called this function | ||||||
287 | sub merge_object_from_symfile { | ||||||
288 | 0 | 0 | 0 | my ($self, $src, $objid) = @_; | |||
289 | 0 | 0 | if (not $self->has_object($objid)) { | ||||
290 | 0 | 0 | $self->{objects}{$objid} = $src->get_object($objid); | ||||
291 | } else { | ||||||
292 | 0 | 0 | warning(g_('tried to merge the same object (%s) twice in a symfile'), $objid); | ||||
293 | } | ||||||
294 | } | ||||||
295 | |||||||
296 | sub output { | ||||||
297 | 90 | 1 | 210 | my ($self, $fh, %opts) = @_; | |||
298 | 90 | 418 | $opts{template_mode} //= 0; | ||||
299 | 90 | 356 | $opts{with_deprecated} //= 1; | ||||
300 | 90 | 280 | $opts{with_pattern_matches} //= 0; | ||||
301 | 90 | 106 | my $res = ''; | ||||
302 | 90 | 192 | foreach my $soname (sort $self->get_sonames()) { | ||||
303 | 90 | 230 | my @deps = $self->get_dependencies($soname); | ||||
304 | 90 | 140 | my $dep_first = shift @deps; | ||||
305 | 90 | 294 | if (exists $opts{package} and not $opts{template_mode}) { | ||||
306 | 6 | 76 | $dep_first =~ s/#PACKAGE#/$opts{package}/g; | ||||
307 | } | ||||||
308 | 90 42 | 124 232 | print { $fh } "$soname $dep_first\n" if defined $fh; | ||||
309 | 90 | 500 | $res .= "$soname $dep_first\n" if defined wantarray; | ||||
310 | |||||||
311 | 90 | 152 | foreach my $dep_next (@deps) { | ||||
312 | 54 | 214 | if (exists $opts{package} and not $opts{template_mode}) { | ||||
313 | 6 | 24 | $dep_next =~ s/#PACKAGE#/$opts{package}/g; | ||||
314 | } | ||||||
315 | 54 30 | 128 132 | print { $fh } "| $dep_next\n" if defined $fh; | ||||
316 | 54 | 212 | $res .= "| $dep_next\n" if defined wantarray; | ||||
317 | } | ||||||
318 | 90 | 150 | my $f = $self->{objects}{$soname}{fields}; | ||||
319 | 90 90 | 96 168 | foreach my $field (sort keys %{$f}) { | ||||
320 | 6 | 16 | my $value = $f->{$field}; | ||||
321 | 6 | 88 | if (exists $opts{package} and not $opts{template_mode}) { | ||||
322 | 6 | 16 | $value =~ s/#PACKAGE#/$opts{package}/g; | ||||
323 | } | ||||||
324 | 6 6 | 22 20 | print { $fh } "* $field: $value\n" if defined $fh; | ||||
325 | 6 | 14 | $res .= "* $field: $value\n" if defined wantarray; | ||||
326 | } | ||||||
327 | |||||||
328 | 90 | 94 | my @symbols; | ||||
329 | 90 | 150 | if ($opts{template_mode}) { | ||||
330 | # Exclude symbols matching a pattern, but include patterns themselves | ||||||
331 | 12 312 | 36 240 | @symbols = grep { not $_->get_pattern() } $self->get_symbols($soname); | ||||
332 | 12 | 42 | push @symbols, $self->get_patterns($soname); | ||||
333 | } else { | ||||||
334 | 78 | 194 | @symbols = $self->get_symbols($soname); | ||||
335 | } | ||||||
336 | 90 407196 | 710 374030 | foreach my $sym (sort { $a->get_symboltempl() cmp | ||||
337 | $b->get_symboltempl() } @symbols) { | ||||||
338 | 41940 | 62884 | next if $sym->{deprecated} and not $opts{with_deprecated}; | ||||
339 | # Do not dump symbols from foreign arch unless dumping a template. | ||||||
340 | next if not $opts{template_mode} and | ||||||
341 | 41940 | 67536 | not $sym->arch_is_concerned($self->get_arch()); | ||||
342 | # Dump symbol specification. Dump symbol tags only in template mode. | ||||||
343 | 41688 14016 | 42180 18178 | print { $fh } $sym->get_symbolspec($opts{template_mode}), "\n" if defined $fh; | ||||
344 | 41688 | 130328 | $res .= $sym->get_symbolspec($opts{template_mode}) . "\n" if defined wantarray; | ||||
345 | # Dump pattern matches as comments (if requested) | ||||||
346 | 41688 | 55934 | if ($opts{with_pattern_matches} && $sym->is_pattern()) { | ||||
347 | 0 0 | 0 0 | for my $match (sort { $a->get_symboltempl() cmp | ||||
348 | $b->get_symboltempl() } $sym->get_pattern_matches()) | ||||||
349 | { | ||||||
350 | 0 0 | 0 0 | print { $fh } '#MATCH:', $match->get_symbolspec(0), "\n" if defined $fh; | ||||
351 | 0 | 0 | $res .= '#MATCH:' . $match->get_symbolspec(0) . "\n" if defined wantarray; | ||||
352 | } | ||||||
353 | } | ||||||
354 | } | ||||||
355 | } | ||||||
356 | 90 | 1104 | return $res; | ||||
357 | } | ||||||
358 | |||||||
359 | # Tries to match a symbol name and/or version against the patterns defined. | ||||||
360 | # Returns a pattern which matches (if any). | ||||||
361 | sub find_matching_pattern { | ||||||
362 | 28896 | 0 | 25722 | my ($self, $refsym, $sonames, $inc_deprecated) = @_; | |||
363 | 28896 | 25812 | $inc_deprecated //= 0; | ||||
364 | 28896 | 25982 | my $name = (ref $refsym) ? $refsym->get_symbolname() : $refsym; | ||||
365 | |||||||
366 | my $pattern_ok = sub { | ||||||
367 | 1017 | 1030 | my $p = shift; | ||||
368 | 1017 | 4952 | return defined $p && ($inc_deprecated || !$p->{deprecated}) && | ||||
369 | $p->arch_is_concerned($self->get_arch()); | ||||||
370 | 28896 | 58016 | }; | ||||
371 | |||||||
372 | 28896 | 33236 | foreach my $soname ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) { | ||||
373 | 28896 | 25388 | my $obj = $self->get_object($soname); | ||||
374 | 28896 | 21276 | my ($type, $pattern); | ||||
375 | 28896 | 26279 | next unless defined $obj; | ||||
376 | |||||||
377 | 28896 | 23260 | my $all_aliases = $obj->{patterns}{aliases}; | ||||
378 | 28896 | 32388 | for my $type (Dpkg::Shlibs::Symbol::ALIAS_TYPES) { | ||||
379 | 57669 1635 | 64527 4232 | if (exists $all_aliases->{$type} && keys(%{$all_aliases->{$type}})) { | ||||
380 | 1635 | 1574 | my $aliases = $all_aliases->{$type}; | ||||
381 | 1635 | 3346 | my $converter = $aliases->{(keys %$aliases)[0]}; | ||||
382 | 1635 | 3235 | if (my $alias = $converter->convert_to_alias($name)) { | ||||
383 | 1632 | 6845 | if ($alias && exists $aliases->{$alias}) { | ||||
384 | 216 | 301 | $pattern = $aliases->{$alias}; | ||||
385 | 216 | 401 | last if $pattern_ok->($pattern); | ||||
386 | 0 | 0 | $pattern = undef; # otherwise not found yet | ||||
387 | } | ||||||
388 | } | ||||||
389 | } | ||||||
390 | } | ||||||
391 | |||||||
392 | # Now try generic patterns and use the first that matches | ||||||
393 | 28893 | 26063 | if (not defined $pattern) { | ||||
394 | 28677 28677 | 18079 28686 | for my $p (@{$obj->{patterns}{generic}}) { | ||||
395 | 801 | 1227 | if ($pattern_ok->($p) && $p->matches_rawname($name)) { | ||||
396 | 369 | 460 | $pattern = $p; | ||||
397 | 369 | 461 | last; | ||||
398 | } | ||||||
399 | } | ||||||
400 | } | ||||||
401 | 28893 | 30868 | if (defined $pattern) { | ||||
402 | 585 | 2583 | return (wantarray) ? | ||||
403 | ( symbol => $pattern, soname => $soname ) : $pattern; | ||||||
404 | } | ||||||
405 | } | ||||||
406 | 28308 | 50252 | return; | ||||
407 | } | ||||||
408 | |||||||
409 | # merge_symbols($object, $minver) | ||||||
410 | # Needs $Objdump->get_object($soname) as parameter | ||||||
411 | # Do not merge symbols found in the list of (arch-specific) internal symbols. | ||||||
412 | sub merge_symbols { | ||||||
413 | 99 | 0 | 211 | my ($self, $object, $minver) = @_; | |||
414 | |||||||
415 | 99 | 180 | my $soname = $object->{SONAME}; | ||||
416 | 99 | 149 | error(g_('cannot merge symbols from objects without SONAME')) | ||||
417 | unless $soname; | ||||||
418 | |||||||
419 | 99 | 147 | my %include_groups = (); | ||||
420 | 99 | 277 | my $groups = $self->get_field($soname, 'Allow-Internal-Symbol-Groups'); | ||||
421 | 99 | 184 | if (not defined $groups) { | ||||
422 | 93 | 118 | $groups = $self->get_field($soname, 'Ignore-Blacklist-Groups'); | ||||
423 | 93 | 205 | if (defined $groups) { | ||||
424 | 0 | 0 | warnings::warnif('deprecated', | ||||
425 | 'symbols file field "Ignore-Blacklist-Groups" is deprecated, ' . | ||||||
426 | 'use "Allow-Internal-Symbol-Groups" instead'); | ||||||
427 | } | ||||||
428 | } | ||||||
429 | 99 | 166 | if (defined $groups) { | ||||
430 | 6 | 16 | $include_groups{$_} = 1 foreach (split ' ', $groups); | ||||
431 | } | ||||||
432 | |||||||
433 | 99 | 118 | my %dynsyms; | ||||
434 | 99 | 325 | foreach my $sym ($object->get_exported_dynamic_symbols()) { | ||||
435 | my $name = $sym->{name} . '@' . | ||||||
436 | 54618 | 101962 | ($sym->{version} ? $sym->{version} : 'Base'); | ||||
437 | 54618 | 50656 | my $symobj = $self->lookup_symbol($name, $soname); | ||||
438 | 54618 | 51752 | if (symbol_is_internal($sym->{name}, \%include_groups)) { | ||||
439 | 345 | 492 | next unless defined $symobj; | ||||
440 | |||||||
441 | 48 | 72 | if ($symobj->has_tag('allow-internal')) { | ||||
442 | # Allow the symbol. | ||||||
443 | } elsif ($symobj->has_tag('ignore-blacklist')) { | ||||||
444 | # Allow the symbol and warn. | ||||||
445 | 0 | 0 | warnings::warnif('deprecated', | ||||
446 | 'symbol tag "ignore-blacklist" is deprecated, ' . | ||||||
447 | 'use "allow-internal" instead'); | ||||||
448 | } else { | ||||||
449 | # Ignore the symbol. | ||||||
450 | 24 | 30 | next; | ||||
451 | } | ||||||
452 | } | ||||||
453 | 54297 | 64914 | $dynsyms{$name} = $sym; | ||||
454 | } | ||||||
455 | |||||||
456 | 99 | 3243 | unless ($self->has_object($soname)) { | ||||
457 | 12 | 36 | $self->create_object($soname, ''); | ||||
458 | } | ||||||
459 | # Scan all symbols provided by the objects | ||||||
460 | 99 | 213 | my $obj = $self->get_object($soname); | ||||
461 | # invalidate the minimum version cache - it is not sufficient to | ||||||
462 | # invalidate in add_symbol, since we might change a minimum | ||||||
463 | # version for a particular symbol without adding it | ||||||
464 | 99 | 235 | $obj->{minver_cache} = []; | ||||
465 | 99 | 8154 | foreach my $name (keys %dynsyms) { | ||||
466 | 54089 | 38298 | my $sym; | ||||
467 | 54089 | 69433 | if ($sym = $self->lookup_symbol($name, $obj, 1)) { | ||||
468 | # If the symbol is already listed in the file | ||||||
469 | 26501 | 38595 | $sym->mark_found_in_library($minver, $self->get_arch()); | ||||
470 | } else { | ||||||
471 | # The exact symbol is not present in the file, but it might match a | ||||||
472 | # pattern. | ||||||
473 | 27588 | 27649 | my $pattern = $self->find_matching_pattern($name, $obj, 1); | ||||
474 | 27585 | 24503 | if (defined $pattern) { | ||||
475 | 585 | 986 | $pattern->mark_found_in_library($minver, $self->get_arch()); | ||||
476 | 585 | 1502 | $sym = $pattern->create_pattern_match(symbol => $name); | ||||
477 | } else { | ||||||
478 | # Symbol without any special info as no pattern matched | ||||||
479 | 27000 | 33806 | $sym = Dpkg::Shlibs::Symbol->new(symbol => $name, | ||||
480 | minver => $minver); | ||||||
481 | } | ||||||
482 | 27585 | 30188 | $self->add_symbol($sym, $obj); | ||||
483 | } | ||||||
484 | } | ||||||
485 | |||||||
486 | # Process all symbols which could not be found in the library. | ||||||
487 | 96 | 4957 | foreach my $sym ($self->get_symbols($soname)) { | ||||
488 | 54573 | 51765 | if (not exists $dynsyms{$sym->get_symbolname()}) { | ||||
489 | 498 | 780 | $sym->mark_not_found_in_library($minver, $self->get_arch()); | ||||
490 | } | ||||||
491 | } | ||||||
492 | |||||||
493 | # Deprecate patterns which didn't match anything | ||||||
494 | 96 132 | 2866 174 | for my $pattern (grep { $_->get_pattern_matches() == 0 } | ||||
495 | $self->get_patterns($soname)) { | ||||||
496 | 12 | 33 | $pattern->mark_not_found_in_library($minver, $self->get_arch()); | ||||
497 | } | ||||||
498 | } | ||||||
499 | |||||||
500 | sub is_empty { | ||||||
501 | 0 | 0 | 0 | my $self = shift; | |||
502 | 0 0 | 0 0 | return scalar(keys %{$self->{objects}}) ? 0 : 1; | ||||
503 | } | ||||||
504 | |||||||
505 | sub has_object { | ||||||
506 | 168 | 0 | 310 | my ($self, $soname) = @_; | |||
507 | 168 | 538 | return exists $self->{objects}{$soname}; | ||||
508 | } | ||||||
509 | |||||||
510 | sub get_object { | ||||||
511 | 210116 | 0 | 169655 | my ($self, $soname) = @_; | |||
512 | 210116 | 262291 | return ref($soname) ? $soname : $self->{objects}{$soname}; | ||||
513 | } | ||||||
514 | |||||||
515 | sub create_object { | ||||||
516 | 129 | 0 | 278 | my ($self, $soname, @deps) = @_; | |||
517 | 129 | 1069 | $self->{objects}{$soname} = { | ||||
518 | syms => {}, | ||||||
519 | fields => {}, | ||||||
520 | patterns => { | ||||||
521 | aliases => {}, | ||||||
522 | generic => [], | ||||||
523 | }, | ||||||
524 | deps => [ @deps ], | ||||||
525 | minver_cache => [] | ||||||
526 | }; | ||||||
527 | } | ||||||
528 | |||||||
529 | sub get_dependency { | ||||||
530 | 0 | 0 | 0 | my ($self, $soname, $dep_id) = @_; | |||
531 | 0 | 0 | $dep_id //= 0; | ||||
532 | 0 | 0 | return $self->get_object($soname)->{deps}[$dep_id]; | ||||
533 | } | ||||||
534 | |||||||
535 | sub get_smallest_version { | ||||||
536 | 12 | 0 | 26 | my ($self, $soname, $dep_id) = @_; | |||
537 | 12 | 76 | $dep_id //= 0; | ||||
538 | 12 | 30 | my $so_object = $self->get_object($soname); | ||||
539 | return $so_object->{minver_cache}[$dep_id] | ||||||
540 | 12 | 36 | if defined $so_object->{minver_cache}[$dep_id]; | ||||
541 | 12 | 18 | my $minver; | ||||
542 | 12 | 34 | foreach my $sym ($self->get_symbols($so_object)) { | ||||
543 | 48 | 124 | next if $dep_id != $sym->{dep_id}; | ||||
544 | 42 | 128 | $minver //= $sym->{minver}; | ||||
545 | 42 | 110 | if (version_compare($minver, $sym->{minver}) > 0) { | ||||
546 | 12 | 48 | $minver = $sym->{minver}; | ||||
547 | } | ||||||
548 | } | ||||||
549 | 12 | 36 | $so_object->{minver_cache}[$dep_id] = $minver; | ||||
550 | 12 | 48 | return $minver; | ||||
551 | } | ||||||
552 | |||||||
553 | sub get_dependencies { | ||||||
554 | 90 | 0 | 122 | my ($self, $soname) = @_; | |||
555 | 90 90 | 74 166 | return @{$self->get_object($soname)->{deps}}; | ||||
556 | } | ||||||
557 | |||||||
558 | sub get_field { | ||||||
559 | 192 | 0 | 269 | my ($self, $soname, $name) = @_; | |||
560 | 192 | 264 | if (my $obj = $self->get_object($soname)) { | ||||
561 | 168 | 1073 | if (exists $obj->{fields}{$name}) { | ||||
562 | 6 | 10 | return $obj->{fields}{$name}; | ||||
563 | } | ||||||
564 | } | ||||||
565 | 186 | 221 | return; | ||||
566 | } | ||||||
567 | |||||||
568 | # Tries to find a symbol like the $refsym and returns its descriptor. | ||||||
569 | # $refsym may also be a symbol name. | ||||||
570 | sub lookup_symbol { | ||||||
571 | 136823 | 0 | 146113 | my ($self, $refsym, $sonames, $inc_deprecated) = @_; | |||
572 | 136823 | 194109 | $inc_deprecated //= 0; | ||||
573 | 136823 | 133876 | my $name = (ref $refsym) ? $refsym->get_symbolname() : $refsym; | ||||
574 | |||||||
575 | 136823 | 142793 | foreach my $so ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) { | ||||
576 | 136823 | 127191 | if (my $obj = $self->get_object($so)) { | ||||
577 | 111083 | 118188 | my $sym = $obj->{syms}{$name}; | ||||
578 | 111083 | 239405 | if ($sym and ($inc_deprecated or not $sym->{deprecated})) | ||||
579 | { | ||||||
580 | 79784 | 106957 | return (wantarray) ? | ||||
581 | ( symbol => $sym, soname => $so ) : $sym; | ||||||
582 | } | ||||||
583 | } | ||||||
584 | } | ||||||
585 | 57039 | 49409 | return; | ||||
586 | } | ||||||
587 | |||||||
588 | # Tries to find a pattern like the $refpat and returns its descriptor. | ||||||
589 | # $refpat may also be a pattern spec. | ||||||
590 | sub lookup_pattern { | ||||||
591 | 264 | 0 | 344 | my ($self, $refpat, $sonames, $inc_deprecated) = @_; | |||
592 | 264 | 380 | $inc_deprecated //= 0; | ||||
593 | # If $refsym is a string, we need to create a dummy ref symbol. | ||||||
594 | 264 | 345 | $refpat = $self->create_symbol($refpat, dummy => 1) if ! ref($refpat); | ||||
595 | |||||||
596 | 264 | 576 | if ($refpat && $refpat->is_pattern()) { | ||||
597 | 264 | 374 | foreach my $soname ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) { | ||||
598 | 264 | 326 | if (my $obj = $self->get_object($soname)) { | ||||
599 | 264 | 221 | my $pat; | ||||
600 | 264 | 337 | if (my $type = $refpat->get_alias_type()) { | ||||
601 | 123 | 233 | if (exists $obj->{patterns}{aliases}{$type}) { | ||||
602 | 123 | 206 | $pat = $obj->{patterns}{aliases}{$type}{$refpat->get_symbolname()}; | ||||
603 | } | ||||||
604 | } elsif ($refpat->get_pattern_type() eq 'generic') { | ||||||
605 | 141 141 | 118 217 | for my $p (@{$obj->{patterns}{generic}}) { | ||||
606 | 360 | 955 | if (($inc_deprecated || !$p->{deprecated}) && | ||||
607 | $p->equals($refpat, versioning => 0)) | ||||||
608 | { | ||||||
609 | 141 | 119 | $pat = $p; | ||||
610 | 141 | 141 | last; | ||||
611 | } | ||||||
612 | } | ||||||
613 | } | ||||||
614 | 264 | 910 | if ($pat && ($inc_deprecated || !$pat->{deprecated})) { | ||||
615 | 258 | 620 | return (wantarray) ? | ||||
616 | (symbol => $pat, soname => $soname) : $pat; | ||||||
617 | } | ||||||
618 | } | ||||||
619 | } | ||||||
620 | } | ||||||
621 | 6 | 10 | return; | ||||
622 | } | ||||||
623 | |||||||
624 | # Get symbol object reference either by symbol name or by a reference object. | ||||||
625 | sub get_symbol_object { | ||||||
626 | 0 | 0 | 0 | my ($self, $refsym, $soname) = @_; | |||
627 | 0 | 0 | my $sym = $self->lookup_symbol($refsym, $soname, 1); | ||||
628 | 0 | 0 | if (! defined $sym) { | ||||
629 | 0 | 0 | $sym = $self->lookup_pattern($refsym, $soname, 1); | ||||
630 | } | ||||||
631 | 0 | 0 | return $sym; | ||||
632 | } | ||||||
633 | |||||||
634 | sub get_new_symbols { | ||||||
635 | 63 | 0 | 151 | my ($self, $ref, %opts) = @_; | |||
636 | my $with_optional = (exists $opts{with_optional}) ? | ||||||
637 | 63 | 190 | $opts{with_optional} : 0; | ||||
638 | 63 | 83 | my @res; | ||||
639 | 63 | 131 | foreach my $soname ($self->get_sonames()) { | ||||
640 | 63 | 144 | next if not $ref->has_object($soname); | ||||
641 | |||||||
642 | # Scan raw symbols first. | ||||||
643 | 63 28455 | 129 47178 | foreach my $sym (grep { ($with_optional || ! $_->is_optional()) | ||||
644 | && $_->is_legitimate($self->get_arch()) } | ||||||
645 | $self->get_symbols($soname)) | ||||||
646 | { | ||||||
647 | 27903 | 27940 | my $refsym = $ref->lookup_symbol($sym, $soname, 1); | ||||
648 | 27903 | 18214 | my $isnew; | ||||
649 | 27903 | 20809 | if (defined $refsym) { | ||||
650 | # If the symbol exists in the $ref symbol file, it might | ||||||
651 | # still be new if $refsym is not legitimate. | ||||||
652 | 26469 | 25273 | $isnew = not $refsym->is_legitimate($self->get_arch()); | ||||
653 | } else { | ||||||
654 | # If the symbol does not exist in the $ref symbol file, it does | ||||||
655 | # not mean that it's new. It might still match a pattern in the | ||||||
656 | # symbol file. However, due to performance reasons, first check | ||||||
657 | # if the pattern that the symbol matches (if any) exists in the | ||||||
658 | # ref symbol file as well. | ||||||
659 | 1434 | 1789 | $isnew = not ( | ||||
660 | ($sym->get_pattern() and $ref->lookup_pattern($sym->get_pattern(), $soname, 1)) or | ||||||
661 | $ref->find_matching_pattern($sym, $soname, 1) | ||||||
662 | ); | ||||||
663 | } | ||||||
664 | 27903 | 36683 | push @res, { symbol => $sym, soname => $soname } if $isnew; | ||||
665 | } | ||||||
666 | |||||||
667 | # Now scan patterns | ||||||
668 | 63 147 | 2848 346 | foreach my $p (grep { ($with_optional || ! $_->is_optional()) | ||||
669 | && $_->is_legitimate($self->get_arch()) } | ||||||
670 | $self->get_patterns($soname)) | ||||||
671 | { | ||||||
672 | 105 | 178 | my $refpat = $ref->lookup_pattern($p, $soname, 0); | ||||
673 | # If reference pattern was not found or it is not legitimate, | ||||||
674 | # considering current one as new. | ||||||
675 | 105 | 260 | if (not defined $refpat or | ||||
676 | not $refpat->is_legitimate($self->get_arch())) | ||||||
677 | { | ||||||
678 | 6 | 25 | push @res, { symbol => $p , soname => $soname }; | ||||
679 | } | ||||||
680 | } | ||||||
681 | } | ||||||
682 | 63 | 1082 | return @res; | ||||
683 | } | ||||||
684 | |||||||
685 | sub get_lost_symbols { | ||||||
686 | 39 | 0 | 102 | my ($self, $ref, %opts) = @_; | |||
687 | 39 | 138 | return $ref->get_new_symbols($self, %opts); | ||||
688 | } | ||||||
689 | |||||||
690 | |||||||
691 | sub get_new_libs { | ||||||
692 | 0 | 0 | my ($self, $ref) = @_; | ||||
693 | 0 | my @res; | |||||
694 | 0 | foreach my $soname ($self->get_sonames()) { | |||||
695 | 0 | push @res, $soname if not $ref->get_object($soname); | |||||
696 | } | ||||||
697 | 0 | return @res; | |||||
698 | } | ||||||
699 | |||||||
700 | sub get_lost_libs { | ||||||
701 | 0 | 0 | my ($self, $ref) = @_; | ||||
702 | 0 | return $ref->get_new_libs($self); | |||||
703 | } | ||||||
704 | |||||||
705 - 711 | =head1 CHANGES =head2 Version 0.xx This is a private module. =cut | ||||||
712 | |||||||
713 | 1; |