File: | Dpkg/Shlibs/SymbolFile.pm |
Coverage: | 78.8% |
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 | package Dpkg::Shlibs::SymbolFile; | ||||||
18 | |||||||
19 | 2 2 2 | 6 2 50 | use strict; | ||||
20 | 2 2 2 | 4 2 66 | use warnings; | ||||
21 | |||||||
22 | our $VERSION = '0.01'; | ||||||
23 | |||||||
24 | 2 2 2 | 6 2 66 | use Dpkg::Gettext; | ||||
25 | 2 2 2 | 4 2 62 | use Dpkg::ErrorHandling; | ||||
26 | 2 2 2 | 1076 2 68 | use Dpkg::Version; | ||||
27 | 2 2 2 | 1076 0 82 | use Dpkg::Control::Fields; | ||||
28 | 2 2 2 | 1104 2 32 | use Dpkg::Shlibs::Symbol; | ||||
29 | 2 2 2 | 10 2 40 | use Dpkg::Arch qw(get_host_arch); | ||||
30 | |||||||
31 | 2 2 2 | 4 0 4 | use parent qw(Dpkg::Interface::Storable); | ||||
32 | |||||||
33 | # Needed by the deprecated key, which is a correct use. | ||||||
34 | 2 | 3754 | no if $Dpkg::Version::VERSION ge '1.02', | ||||
35 | 2 2 | 52 2 | warnings => qw(Dpkg::Version::semantic_change::overload::bool); | ||||
36 | |||||||
37 | my %internal_symbol = ( | ||||||
38 | __bss_end__ => 1, # arm | ||||||
39 | __bss_end => 1, # arm | ||||||
40 | _bss_end__ => 1, # arm | ||||||
41 | __bss_start => 1, # ALL | ||||||
42 | __bss_start__ => 1, # arm | ||||||
43 | __data_start => 1, # arm | ||||||
44 | __do_global_ctors_aux => 1, # ia64 | ||||||
45 | __do_global_dtors_aux => 1, # ia64 | ||||||
46 | __do_jv_register_classes => 1, # ia64 | ||||||
47 | _DYNAMIC => 1, # ALL | ||||||
48 | _edata => 1, # ALL | ||||||
49 | _end => 1, # ALL | ||||||
50 | __end__ => 1, # arm | ||||||
51 | __exidx_end => 1, # armel | ||||||
52 | __exidx_start => 1, # armel | ||||||
53 | _fbss => 1, # mips, mipsel | ||||||
54 | _fdata => 1, # mips, mipsel | ||||||
55 | _fini => 1, # ALL | ||||||
56 | _ftext => 1, # mips, mipsel | ||||||
57 | _GLOBAL_OFFSET_TABLE_ => 1, # hppa, mips, mipsel | ||||||
58 | __gmon_start__ => 1, # hppa | ||||||
59 | __gnu_local_gp => 1, # mips, mipsel | ||||||
60 | _gp => 1, # mips, mipsel | ||||||
61 | _init => 1, # ALL | ||||||
62 | _PROCEDURE_LINKAGE_TABLE_ => 1, # sparc, alpha | ||||||
63 | _SDA2_BASE_ => 1, # powerpc | ||||||
64 | _SDA_BASE_ => 1, # powerpc | ||||||
65 | ); | ||||||
66 | |||||||
67 | for my $i (14 .. 31) { | ||||||
68 | # Many powerpc specific symbols | ||||||
69 | $internal_symbol{"_restfpr_$i"} = 1; | ||||||
70 | $internal_symbol{"_restfpr_$i\_x"} = 1; | ||||||
71 | $internal_symbol{"_restgpr_$i"} = 1; | ||||||
72 | $internal_symbol{"_restgpr_$i\_x"} = 1; | ||||||
73 | $internal_symbol{"_savefpr_$i"} = 1; | ||||||
74 | $internal_symbol{"_savegpr_$i"} = 1; | ||||||
75 | } | ||||||
76 | |||||||
77 | sub symbol_is_internal { | ||||||
78 | 18206 | 0 | 10452 | my ($symbol, $include_groups) = @_; | |||
79 | |||||||
80 | 18206 | 12764 | return 1 if exists $internal_symbol{$symbol}; | ||||
81 | |||||||
82 | # The ARM Embedded ABI spec states symbols under this namespace as | ||||||
83 | # possibly appearing in output objects. | ||||||
84 | 18107 18107 | 8116 23385 | return 1 if not ${$include_groups}{aeabi} and $symbol =~ /^__aeabi_/; | ||||
85 | |||||||
86 | # The GNU implementation of the OpenMP spec, specifies symbols under | ||||||
87 | # this namespace as possibly appearing in output objects. | ||||||
88 | 18099 | 22205 | return 1 if not ${$include_groups}{gomp} | ||||
89 | 18099 | 8876 | and $symbol =~ /^\.gomp_critical_user_/; | ||||
90 | |||||||
91 | 18091 | 11898 | return 0; | ||||
92 | } | ||||||
93 | |||||||
94 | sub new { | ||||||
95 | 41 | 0 | 126 | my ($this, %opts) = @_; | |||
96 | 41 | 119 | my $class = ref($this) || $this; | ||||
97 | 41 | 29 | my $self = \%opts; | ||||
98 | 41 | 56 | bless $self, $class; | ||||
99 | 41 | 122 | $self->{arch} //= get_host_arch(); | ||||
100 | 41 | 66 | $self->clear(); | ||||
101 | 41 | 43 | if (exists $self->{file}) { | ||||
102 | 41 | 302 | $self->load($self->{file}) if -e $self->{file}; | ||||
103 | } | ||||||
104 | 41 | 2304 | return $self; | ||||
105 | } | ||||||
106 | |||||||
107 | sub get_arch { | ||||||
108 | 46959 | 0 | 24403 | my $self = shift; | |||
109 | 46959 | 43290 | return $self->{arch}; | ||||
110 | } | ||||||
111 | |||||||
112 | sub clear { | ||||||
113 | 41 | 0 | 27 | my $self = shift; | |||
114 | 41 | 52 | $self->{objects} = {}; | ||||
115 | } | ||||||
116 | |||||||
117 | sub clear_except { | ||||||
118 | 0 | 0 | 0 | my ($self, @ids) = @_; | |||
119 | |||||||
120 | 0 0 | 0 0 | my %has = map { $_ => 1 } @ids; | ||||
121 | 0 0 | 0 0 | foreach my $objid (keys %{$self->{objects}}) { | ||||
122 | 0 | 0 | delete $self->{objects}{$objid} unless exists $has{$objid}; | ||||
123 | } | ||||||
124 | } | ||||||
125 | |||||||
126 | sub get_sonames { | ||||||
127 | 51 | 0 | 52 | my $self = shift; | |||
128 | 51 51 | 47 119 | return keys %{$self->{objects}}; | ||||
129 | } | ||||||
130 | |||||||
131 | sub get_symbols { | ||||||
132 | 88 | 0 | 85 | my ($self, $soname) = @_; | |||
133 | 88 | 85 | if (defined $soname) { | ||||
134 | 88 | 94 | my $obj = $self->get_object($soname); | ||||
135 | 88 88 | 82 3358 | return (defined $obj) ? values %{$obj->{syms}} : (); | ||||
136 | } else { | ||||||
137 | 0 | 0 | my @syms; | ||||
138 | 0 | 0 | foreach my $soname ($self->get_sonames()) { | ||||
139 | 0 | 0 | push @syms, $self->get_symbols($soname); | ||||
140 | } | ||||||
141 | 0 | 0 | return @syms; | ||||
142 | } | ||||||
143 | } | ||||||
144 | |||||||
145 | sub get_patterns { | ||||||
146 | 59 | 0 | 58 | my ($self, $soname) = @_; | |||
147 | 59 | 41 | my @patterns; | ||||
148 | 59 | 54 | if (defined $soname) { | ||||
149 | 59 | 59 | my $obj = $self->get_object($soname); | ||||
150 | 59 59 | 45 95 | foreach my $alias (values %{$obj->{patterns}{aliases}}) { | ||||
151 | 36 | 62 | push @patterns, values %$alias; | ||||
152 | } | ||||||
153 | 59 59 | 45 1357 | return (@patterns, @{$obj->{patterns}{generic}}); | ||||
154 | } else { | ||||||
155 | 0 | 0 | foreach my $soname ($self->get_sonames()) { | ||||
156 | 0 | 0 | push @patterns, $self->get_patterns($soname); | ||||
157 | } | ||||||
158 | 0 | 0 | return @patterns; | ||||
159 | } | ||||||
160 | } | ||||||
161 | |||||||
162 | # Create a symbol from the supplied string specification. | ||||||
163 | sub create_symbol { | ||||||
164 | 5245 | 0 | 4855 | my ($self, $spec, %opts) = @_; | |||
165 | my $symbol = (exists $opts{base}) ? $opts{base} : | ||||||
166 | 5245 | 4036 | Dpkg::Shlibs::Symbol->new(); | ||||
167 | |||||||
168 | 5245 | 4831 | my $ret = $opts{dummy} ? $symbol->parse_symbolspec($spec, default_minver => 0) : | ||||
169 | $symbol->parse_symbolspec($spec); | ||||||
170 | 5245 | 3803 | if ($ret) { | ||||
171 | 5245 | 3716 | $symbol->initialize(arch => $self->get_arch()); | ||||
172 | 5245 | 4444 | return $symbol; | ||||
173 | } | ||||||
174 | 0 | 0 | return; | ||||
175 | } | ||||||
176 | |||||||
177 | sub add_symbol { | ||||||
178 | 14433 | 0 | 8574 | my ($self, $symbol, $soname) = @_; | |||
179 | 14433 | 9190 | my $object = $self->get_object($soname); | ||||
180 | |||||||
181 | 14433 | 10547 | if ($symbol->is_pattern()) { | ||||
182 | 79 | 61 | if (my $alias_type = $symbol->get_alias_type()) { | ||||
183 | 46 | 87 | $object->{patterns}{aliases}{$alias_type} //= {}; | ||||
184 | # Alias hash for matching. | ||||||
185 | 46 | 35 | my $aliases = $object->{patterns}{aliases}{$alias_type}; | ||||
186 | 46 | 37 | $aliases->{$symbol->get_symbolname()} = $symbol; | ||||
187 | } else { | ||||||
188 | # Otherwise assume this is a generic sequential pattern. This | ||||||
189 | # should be always safe. | ||||||
190 | 33 33 | 28 28 | push @{$object->{patterns}{generic}}, $symbol; | ||||
191 | } | ||||||
192 | 79 | 111 | return 'pattern'; | ||||
193 | } else { | ||||||
194 | # invalidate the minimum version cache | ||||||
195 | 14354 | 8918 | $object->{minver_cache} = []; | ||||
196 | 14354 | 10423 | $object->{syms}{$symbol->get_symbolname()} = $symbol; | ||||
197 | 14354 | 12080 | return 'sym'; | ||||
198 | } | ||||||
199 | } | ||||||
200 | |||||||
201 | sub _new_symbol { | ||||||
202 | 5242 | 7611 | my $base = shift || 'Dpkg::Shlibs::Symbol'; | ||||
203 | 5242 | 5113 | return (ref $base) ? $base->clone(@_) : $base->new(@_); | ||||
204 | } | ||||||
205 | |||||||
206 | # Option state is only used for recursive calls. | ||||||
207 | sub parse { | ||||||
208 | 53 | 1 | 86 | my ($self, $fh, $file, %opts) = @_; | |||
209 | 53 | 112 | my $state = $opts{state} //= {}; | ||||
210 | |||||||
211 | 53 | 56 | if (exists $state->{seen}) { | ||||
212 | 18 | 22 | return if exists $state->{seen}{$file}; # Avoid include loops | ||||
213 | } else { | ||||||
214 | 35 | 36 | $self->{file} = $file; | ||||
215 | 35 | 46 | $state->{seen} = {}; | ||||
216 | } | ||||||
217 | 51 | 56 | $state->{seen}{$file} = 1; | ||||
218 | |||||||
219 | 51 | 51 | if (not ref $state->{obj_ref}) { # Init ref to name of current object/lib | ||||
220 | 35 35 | 31 39 | ${$state->{obj_ref}} = undef; | ||||
221 | } | ||||||
222 | |||||||
223 | 51 | 86 | while (<$fh>) { | ||||
224 | 5323 | 3196 | chomp; | ||||
225 | |||||||
226 | 5323 | 5714 | if (/^(?:\s+|#(?:DEPRECATED|MISSING): ([^#]+)#\s*)(.*)/) { | ||||
227 | 5236 5236 | 2759 4023 | if (not defined ${$state->{obj_ref}}) { | ||||
228 | 0 | 0 | error(g_('symbol information must be preceded by a header (file %s, line %s)'), $file, $.); | ||||
229 | } | ||||||
230 | # Symbol specification | ||||||
231 | 5236 | 4043 | my $deprecated = ($1) ? Dpkg::Version->new($1) : 0; | ||||
232 | 5236 | 4262 | my $sym = _new_symbol($state->{base_symbol}, deprecated => $deprecated); | ||||
233 | 5236 | 4431 | if ($self->create_symbol($2, base => $sym)) { | ||||
234 | 5236 5236 | 2848 4112 | $self->add_symbol($sym, ${$state->{obj_ref}}); | ||||
235 | } else { | ||||||
236 | 0 | 0 | warning(g_('failed to parse line in %s: %s'), $file, $_); | ||||
237 | } | ||||||
238 | } elsif (/^(\(.*\))?#include\s+"([^"]+)"/) { | ||||||
239 | 18 | 12 | my $tagspec = $1; | ||||
240 | 18 | 18 | my $filename = $2; | ||||
241 | 18 | 20 | my $dir = $file; | ||||
242 | 18 | 16 | my $old_base_symbol = $state->{base_symbol}; | ||||
243 | 18 | 4 | my $new_base_symbol; | ||||
244 | 18 | 22 | if (defined $tagspec) { | ||||
245 | 6 | 6 | $new_base_symbol = _new_symbol($old_base_symbol); | ||||
246 | 6 | 8 | $new_base_symbol->parse_tagspec($tagspec); | ||||
247 | } | ||||||
248 | 18 | 18 | $state->{base_symbol} = $new_base_symbol; | ||||
249 | 18 | 34 | $dir =~ s{[^/]+$}{}; # Strip filename | ||||
250 | 18 | 50 | $self->load("$dir$filename", %opts); | ||||
251 | 18 | 44 | $state->{base_symbol} = $old_base_symbol; | ||||
252 | } elsif (/^#|^$/) { | ||||||
253 | # Skip possible comments and empty lines | ||||||
254 | } elsif (/^\|\s*(.*)$/) { | ||||||
255 | # Alternative dependency template | ||||||
256 | 14 14 14 | 14 14 36 | push @{$self->{objects}{${$state->{obj_ref}}}{deps}}, "$1"; | ||||
257 | } elsif (/^\*\s*([^:]+):\s*(.*\S)\s*$/) { | ||||||
258 | # Add meta-fields | ||||||
259 | 4 4 | 4 6 | $self->{objects}{${$state->{obj_ref}}}{fields}{field_capitalize($1)} = $2; | ||||
260 | } elsif (/^(\S+)\s+(.*)$/) { | ||||||
261 | # New object and dependency template | ||||||
262 | 41 41 | 28 60 | ${$state->{obj_ref}} = $1; | ||||
263 | 41 41 | 35 45 | if (exists $self->{objects}{${$state->{obj_ref}}}) { | ||||
264 | # Update/override infos only | ||||||
265 | 2 2 | 2 6 | $self->{objects}{${$state->{obj_ref}}}{deps} = [ "$2" ]; | ||||
266 | } else { | ||||||
267 | # Create a new object | ||||||
268 | 39 39 | 27 78 | $self->create_object(${$state->{obj_ref}}, "$2"); | ||||
269 | } | ||||||
270 | } else { | ||||||
271 | 0 | 0 | warning(g_('failed to parse a line in %s: %s'), $file, $_); | ||||
272 | } | ||||||
273 | } | ||||||
274 | 51 | 112 | delete $state->{seen}{$file}; | ||||
275 | } | ||||||
276 | |||||||
277 | # Beware: we reuse the data structure of the provided symfile so make | ||||||
278 | # sure to not modify them after having called this function | ||||||
279 | sub merge_object_from_symfile { | ||||||
280 | 0 | 0 | 0 | my ($self, $src, $objid) = @_; | |||
281 | 0 | 0 | if (not $self->has_object($objid)) { | ||||
282 | 0 | 0 | $self->{objects}{$objid} = $src->get_object($objid); | ||||
283 | } else { | ||||||
284 | 0 | 0 | warning(g_('tried to merge the same object (%s) twice in a symfile'), $objid); | ||||
285 | } | ||||||
286 | } | ||||||
287 | |||||||
288 | sub output { | ||||||
289 | 30 | 1 | 46 | my ($self, $fh, %opts) = @_; | |||
290 | 30 | 110 | $opts{template_mode} //= 0; | ||||
291 | 30 | 96 | $opts{with_deprecated} //= 1; | ||||
292 | 30 | 88 | $opts{with_pattern_matches} //= 0; | ||||
293 | 30 | 44 | my $res = ''; | ||||
294 | 30 | 46 | foreach my $soname (sort $self->get_sonames()) { | ||||
295 | 30 | 54 | my @deps = $self->get_dependencies($soname); | ||||
296 | 30 | 36 | my $dep_first = shift @deps; | ||||
297 | 30 | 66 | if (exists $opts{package} and not $opts{template_mode}) { | ||||
298 | 2 | 14 | $dep_first =~ s/#PACKAGE#/$opts{package}/g; | ||||
299 | } | ||||||
300 | 30 14 | 34 56 | print { $fh } "$soname $dep_first\n" if defined $fh; | ||||
301 | 30 | 108 | $res .= "$soname $dep_first\n" if defined wantarray; | ||||
302 | |||||||
303 | 30 | 24 | foreach my $dep_next (@deps) { | ||||
304 | 18 | 48 | if (exists $opts{package} and not $opts{template_mode}) { | ||||
305 | 2 | 2 | $dep_next =~ s/#PACKAGE#/$opts{package}/g; | ||||
306 | } | ||||||
307 | 18 10 | 24 20 | print { $fh } "| $dep_next\n" if defined $fh; | ||||
308 | 18 | 28 | $res .= "| $dep_next\n" if defined wantarray; | ||||
309 | } | ||||||
310 | 30 | 36 | my $f = $self->{objects}{$soname}{fields}; | ||||
311 | 30 30 | 18 46 | foreach my $field (sort keys %{$f}) { | ||||
312 | 2 | 8 | my $value = $f->{$field}; | ||||
313 | 2 | 10 | if (exists $opts{package} and not $opts{template_mode}) { | ||||
314 | 2 | 6 | $value =~ s/#PACKAGE#/$opts{package}/g; | ||||
315 | } | ||||||
316 | 2 2 | 4 6 | print { $fh } "* $field: $value\n" if defined $fh; | ||||
317 | 2 | 4 | $res .= "* $field: $value\n" if defined wantarray; | ||||
318 | } | ||||||
319 | |||||||
320 | 30 | 20 | my @symbols; | ||||
321 | 30 | 32 | if ($opts{template_mode}) { | ||||
322 | # Exclude symbols matching a pattern, but include patterns themselves | ||||||
323 | 4 104 | 8 80 | @symbols = grep { not $_->get_pattern() } $self->get_symbols($soname); | ||||
324 | 4 | 6 | push @symbols, $self->get_patterns($soname); | ||||
325 | } else { | ||||||
326 | 26 | 40 | @symbols = $self->get_symbols($soname); | ||||
327 | } | ||||||
328 | 30 135516 | 130 90048 | foreach my $sym (sort { $a->get_symboltempl() cmp | ||||
329 | $b->get_symboltempl() } @symbols) { | ||||||
330 | 13980 | 12658 | next if $sym->{deprecated} and not $opts{with_deprecated}; | ||||
331 | # Do not dump symbols from foreign arch unless dumping a template. | ||||||
332 | next if not $opts{template_mode} and | ||||||
333 | 13980 | 14170 | not $sym->arch_is_concerned($self->get_arch()); | ||||
334 | # Dump symbol specification. Dump symbol tags only in template mode. | ||||||
335 | 13896 4672 | 9680 3852 | print { $fh } $sym->get_symbolspec($opts{template_mode}), "\n" if defined $fh; | ||||
336 | 13896 | 28898 | $res .= $sym->get_symbolspec($opts{template_mode}) . "\n" if defined wantarray; | ||||
337 | # Dump pattern matches as comments (if requested) | ||||||
338 | 13896 | 12308 | if ($opts{with_pattern_matches} && $sym->is_pattern()) { | ||||
339 | 0 0 | 0 0 | for my $match (sort { $a->get_symboltempl() cmp | ||||
340 | $b->get_symboltempl() } $sym->get_pattern_matches()) | ||||||
341 | { | ||||||
342 | 0 0 | 0 0 | print { $fh } '#MATCH:', $match->get_symbolspec(0), "\n" if defined $fh; | ||||
343 | 0 | 0 | $res .= '#MATCH:' . $match->get_symbolspec(0) . "\n" if defined wantarray; | ||||
344 | } | ||||||
345 | } | ||||||
346 | } | ||||||
347 | } | ||||||
348 | 30 | 262 | return $res; | ||||
349 | } | ||||||
350 | |||||||
351 | # Tries to match a symbol name and/or version against the patterns defined. | ||||||
352 | # Returns a pattern which matches (if any). | ||||||
353 | sub find_matching_pattern { | ||||||
354 | 9632 | 0 | 6209 | my ($self, $refsym, $sonames, $inc_deprecated) = @_; | |||
355 | 9632 | 5914 | $inc_deprecated //= 0; | ||||
356 | 9632 | 6028 | my $name = (ref $refsym) ? $refsym->get_symbolname() : $refsym; | ||||
357 | |||||||
358 | my $pattern_ok = sub { | ||||||
359 | 339 | 194 | my $p = shift; | ||||
360 | 339 | 712 | return defined $p && ($inc_deprecated || !$p->{deprecated}) && | ||||
361 | $p->arch_is_concerned($self->get_arch()); | ||||||
362 | 9632 | 9779 | }; | ||||
363 | |||||||
364 | 9632 | 6940 | foreach my $soname ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) { | ||||
365 | 9632 | 5783 | my $obj = $self->get_object($soname); | ||||
366 | 9632 | 5222 | my ($type, $pattern); | ||||
367 | 9632 | 6437 | next unless defined $obj; | ||||
368 | |||||||
369 | 9632 | 5326 | my $all_aliases = $obj->{patterns}{aliases}; | ||||
370 | 9632 | 6203 | for my $type (Dpkg::Shlibs::Symbol::ALIAS_TYPES) { | ||||
371 | 19223 545 | 14511 739 | if (exists $all_aliases->{$type} && keys(%{$all_aliases->{$type}})) { | ||||
372 | 545 | 355 | my $aliases = $all_aliases->{$type}; | ||||
373 | 545 | 544 | my $converter = $aliases->{(keys %$aliases)[0]}; | ||||
374 | 545 | 514 | if (my $alias = $converter->convert_to_alias($name)) { | ||||
375 | 544 | 1132 | if ($alias && exists $aliases->{$alias}) { | ||||
376 | 72 | 49 | $pattern = $aliases->{$alias}; | ||||
377 | 72 | 58 | last if $pattern_ok->($pattern); | ||||
378 | 0 | 0 | $pattern = undef; # otherwise not found yet | ||||
379 | } | ||||||
380 | } | ||||||
381 | } | ||||||
382 | } | ||||||
383 | |||||||
384 | # Now try generic patterns and use the first that matches | ||||||
385 | 9631 | 6427 | if (not defined $pattern) { | ||||
386 | 9559 9559 | 4941 6525 | for my $p (@{$obj->{patterns}{generic}}) { | ||||
387 | 267 | 194 | if ($pattern_ok->($p) && $p->matches_rawname($name)) { | ||||
388 | 123 | 64 | $pattern = $p; | ||||
389 | 123 | 89 | last; | ||||
390 | } | ||||||
391 | } | ||||||
392 | } | ||||||
393 | 9631 | 6915 | if (defined $pattern) { | ||||
394 | 195 | 392 | return (wantarray) ? | ||||
395 | ( symbol => $pattern, soname => $soname ) : $pattern; | ||||||
396 | } | ||||||
397 | } | ||||||
398 | 9436 | 9858 | return; | ||||
399 | } | ||||||
400 | |||||||
401 | # merge_symbols($object, $minver) | ||||||
402 | # Needs $Objdump->get_object($soname) as parameter | ||||||
403 | # Do not merge symbols found in the list of (arch-specific) internal symbols. | ||||||
404 | sub merge_symbols { | ||||||
405 | 33 | 0 | 50 | my ($self, $object, $minver) = @_; | |||
406 | |||||||
407 | 33 | 40 | my $soname = $object->{SONAME}; | ||||
408 | 33 | 45 | error(g_('cannot merge symbols from objects without SONAME')) | ||||
409 | unless $soname; | ||||||
410 | |||||||
411 | 33 | 25 | my %include_groups = (); | ||||
412 | 33 | 55 | my $groups = $self->get_field($soname, 'Allow-Internal-Symbol-Groups'); | ||||
413 | 33 | 43 | if (not defined $groups) { | ||||
414 | 31 | 22 | $groups = $self->get_field($soname, 'Ignore-Blacklist-Groups'); | ||||
415 | 31 | 35 | if (defined $groups) { | ||||
416 | 0 | 0 | warnings::warnif('deprecated', | ||||
417 | 'symbols file field "Ignore-Blacklist-Groups" is deprecated, ' . | ||||||
418 | 'use "Allow-Internal-Symbol-Groups" instead'); | ||||||
419 | } | ||||||
420 | } | ||||||
421 | 33 | 32 | if (defined $groups) { | ||||
422 | 2 | 6 | $include_groups{$_} = 1 foreach (split ' ', $groups); | ||||
423 | } | ||||||
424 | |||||||
425 | 33 | 25 | my %dynsyms; | ||||
426 | 33 | 86 | foreach my $sym ($object->get_exported_dynamic_symbols()) { | ||||
427 | my $name = $sym->{name} . '@' . | ||||||
428 | 18206 | 18738 | ($sym->{version} ? $sym->{version} : 'Base'); | ||||
429 | 18206 | 11206 | my $symobj = $self->lookup_symbol($name, $soname); | ||||
430 | 18206 | 11458 | if (symbol_is_internal($sym->{name}, \%include_groups)) { | ||||
431 | 115 | 114 | next unless defined $symobj; | ||||
432 | |||||||
433 | 16 | 10 | if ($symobj->has_tag('allow-internal')) { | ||||
434 | # Allow the symbol. | ||||||
435 | } elsif ($symobj->has_tag('ignore-blacklist')) { | ||||||
436 | # Allow the symbol and warn. | ||||||
437 | 0 | 0 | warnings::warnif('deprecated', | ||||
438 | 'symbol tag "ignore-blacklist" is deprecated, ' . | ||||||
439 | 'use "allow-internal" instead'); | ||||||
440 | } else { | ||||||
441 | # Ignore the symbol. | ||||||
442 | 8 | 8 | next; | ||||
443 | } | ||||||
444 | } | ||||||
445 | 18099 | 13380 | $dynsyms{$name} = $sym; | ||||
446 | } | ||||||
447 | |||||||
448 | 33 | 413 | unless ($self->has_object($soname)) { | ||||
449 | 4 | 10 | $self->create_object($soname, ''); | ||||
450 | } | ||||||
451 | # Scan all symbols provided by the objects | ||||||
452 | 33 | 36 | my $obj = $self->get_object($soname); | ||||
453 | # invalidate the minimum version cache - it is not sufficient to | ||||||
454 | # invalidate in add_symbol, since we might change a minimum | ||||||
455 | # version for a particular symbol without adding it | ||||||
456 | 33 | 38 | $obj->{minver_cache} = []; | ||||
457 | 33 | 1392 | foreach my $name (keys %dynsyms) { | ||||
458 | 18026 | 8896 | my $sym; | ||||
459 | 18026 | 13165 | if ($sym = $self->lookup_symbol($name, $obj, 1)) { | ||||
460 | # If the symbol is already listed in the file | ||||||
461 | 8830 | 6679 | $sym->mark_found_in_library($minver, $self->get_arch()); | ||||
462 | } else { | ||||||
463 | # The exact symbol is not present in the file, but it might match a | ||||||
464 | # pattern. | ||||||
465 | 9196 | 6040 | my $pattern = $self->find_matching_pattern($name, $obj, 1); | ||||
466 | 9195 | 5480 | if (defined $pattern) { | ||||
467 | 195 | 150 | $pattern->mark_found_in_library($minver, $self->get_arch()); | ||||
468 | 195 | 193 | $sym = $pattern->create_pattern_match(symbol => $name); | ||||
469 | } else { | ||||||
470 | # Symbol without any special info as no pattern matched | ||||||
471 | 9000 | 6994 | $sym = Dpkg::Shlibs::Symbol->new(symbol => $name, | ||||
472 | minver => $minver); | ||||||
473 | } | ||||||
474 | 9195 | 6359 | $self->add_symbol($sym, $obj); | ||||
475 | } | ||||||
476 | } | ||||||
477 | |||||||
478 | # Process all symbols which could not be found in the library. | ||||||
479 | 32 | 796 | foreach my $sym ($self->get_symbols($soname)) { | ||||
480 | 18191 | 10887 | if (not exists $dynsyms{$sym->get_symbolname()}) { | ||||
481 | 166 | 116 | $sym->mark_not_found_in_library($minver, $self->get_arch()); | ||||
482 | } | ||||||
483 | } | ||||||
484 | |||||||
485 | # Deprecate patterns which didn't match anything | ||||||
486 | 32 44 | 248 36 | for my $pattern (grep { $_->get_pattern_matches() == 0 } | ||||
487 | $self->get_patterns($soname)) { | ||||||
488 | 4 | 4 | $pattern->mark_not_found_in_library($minver, $self->get_arch()); | ||||
489 | } | ||||||
490 | } | ||||||
491 | |||||||
492 | sub is_empty { | ||||||
493 | 0 | 0 | 0 | my $self = shift; | |||
494 | 0 0 | 0 0 | return scalar(keys %{$self->{objects}}) ? 0 : 1; | ||||
495 | } | ||||||
496 | |||||||
497 | sub has_object { | ||||||
498 | 56 | 0 | 59 | my ($self, $soname) = @_; | |||
499 | 56 | 106 | return exists $self->{objects}{$soname}; | ||||
500 | } | ||||||
501 | |||||||
502 | sub get_object { | ||||||
503 | 70035 | 0 | 41073 | my ($self, $soname) = @_; | |||
504 | 70035 | 55585 | return ref($soname) ? $soname : $self->{objects}{$soname}; | ||||
505 | } | ||||||
506 | |||||||
507 | sub create_object { | ||||||
508 | 43 | 0 | 70 | my ($self, $soname, @deps) = @_; | |||
509 | 43 | 189 | $self->{objects}{$soname} = { | ||||
510 | syms => {}, | ||||||
511 | fields => {}, | ||||||
512 | patterns => { | ||||||
513 | aliases => {}, | ||||||
514 | generic => [], | ||||||
515 | }, | ||||||
516 | deps => [ @deps ], | ||||||
517 | minver_cache => [] | ||||||
518 | }; | ||||||
519 | } | ||||||
520 | |||||||
521 | sub get_dependency { | ||||||
522 | 0 | 0 | 0 | my ($self, $soname, $dep_id) = @_; | |||
523 | 0 | 0 | $dep_id //= 0; | ||||
524 | 0 | 0 | return $self->get_object($soname)->{deps}[$dep_id]; | ||||
525 | } | ||||||
526 | |||||||
527 | sub get_smallest_version { | ||||||
528 | 4 | 0 | 6 | my ($self, $soname, $dep_id) = @_; | |||
529 | 4 | 12 | $dep_id //= 0; | ||||
530 | 4 | 4 | my $so_object = $self->get_object($soname); | ||||
531 | return $so_object->{minver_cache}[$dep_id] | ||||||
532 | 4 | 6 | if defined $so_object->{minver_cache}[$dep_id]; | ||||
533 | 4 | 4 | my $minver; | ||||
534 | 4 | 4 | foreach my $sym ($self->get_symbols($so_object)) { | ||||
535 | 16 | 16 | next if $dep_id != $sym->{dep_id}; | ||||
536 | 14 | 18 | $minver //= $sym->{minver}; | ||||
537 | 14 | 16 | if (version_compare($minver, $sym->{minver}) > 0) { | ||||
538 | 4 | 4 | $minver = $sym->{minver}; | ||||
539 | } | ||||||
540 | } | ||||||
541 | 4 | 6 | $so_object->{minver_cache}[$dep_id] = $minver; | ||||
542 | 4 | 8 | return $minver; | ||||
543 | } | ||||||
544 | |||||||
545 | sub get_dependencies { | ||||||
546 | 30 | 0 | 34 | my ($self, $soname) = @_; | |||
547 | 30 30 | 28 38 | return @{$self->get_object($soname)->{deps}}; | ||||
548 | } | ||||||
549 | |||||||
550 | sub get_field { | ||||||
551 | 64 | 0 | 70 | my ($self, $soname, $name) = @_; | |||
552 | 64 | 61 | if (my $obj = $self->get_object($soname)) { | ||||
553 | 56 | 97 | if (exists $obj->{fields}{$name}) { | ||||
554 | 2 | 4 | return $obj->{fields}{$name}; | ||||
555 | } | ||||||
556 | } | ||||||
557 | 62 | 61 | return; | ||||
558 | } | ||||||
559 | |||||||
560 | # Tries to find a symbol like the $refsym and returns its descriptor. | ||||||
561 | # $refsym may also be a symbol name. | ||||||
562 | sub lookup_symbol { | ||||||
563 | 45604 | 0 | 31083 | my ($self, $refsym, $sonames, $inc_deprecated) = @_; | |||
564 | 45604 | 43300 | $inc_deprecated //= 0; | ||||
565 | 45604 | 29669 | my $name = (ref $refsym) ? $refsym->get_symbolname() : $refsym; | ||||
566 | |||||||
567 | 45604 | 31052 | foreach my $so ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) { | ||||
568 | 45604 | 27291 | if (my $obj = $self->get_object($so)) { | ||||
569 | 37024 | 25732 | my $sym = $obj->{syms}{$name}; | ||||
570 | 37024 | 47319 | if ($sym and ($inc_deprecated or not $sym->{deprecated})) | ||||
571 | { | ||||||
572 | 26591 | 23360 | return (wantarray) ? | ||||
573 | ( symbol => $sym, soname => $so ) : $sym; | ||||||
574 | } | ||||||
575 | } | ||||||
576 | } | ||||||
577 | 19013 | 11218 | return; | ||||
578 | } | ||||||
579 | |||||||
580 | # Tries to find a pattern like the $refpat and returns its descriptor. | ||||||
581 | # $refpat may also be a pattern spec. | ||||||
582 | sub lookup_pattern { | ||||||
583 | 88 | 0 | 69 | my ($self, $refpat, $sonames, $inc_deprecated) = @_; | |||
584 | 88 | 79 | $inc_deprecated //= 0; | ||||
585 | # If $refsym is a string, we need to create a dummy ref symbol. | ||||||
586 | 88 | 74 | $refpat = $self->create_symbol($refpat, dummy => 1) if ! ref($refpat); | ||||
587 | |||||||
588 | 88 | 102 | if ($refpat && $refpat->is_pattern()) { | ||||
589 | 88 | 73 | foreach my $soname ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) { | ||||
590 | 88 | 62 | if (my $obj = $self->get_object($soname)) { | ||||
591 | 88 | 44 | my $pat; | ||||
592 | 88 | 69 | if (my $type = $refpat->get_alias_type()) { | ||||
593 | 41 | 44 | if (exists $obj->{patterns}{aliases}{$type}) { | ||||
594 | 41 | 39 | $pat = $obj->{patterns}{aliases}{$type}{$refpat->get_symbolname()}; | ||||
595 | } | ||||||
596 | } elsif ($refpat->get_pattern_type() eq 'generic') { | ||||||
597 | 47 47 | 27 46 | for my $p (@{$obj->{patterns}{generic}}) { | ||||
598 | 120 | 208 | if (($inc_deprecated || !$p->{deprecated}) && | ||||
599 | $p->equals($refpat, versioning => 0)) | ||||||
600 | { | ||||||
601 | 47 | 23 | $pat = $p; | ||||
602 | 47 | 36 | last; | ||||
603 | } | ||||||
604 | } | ||||||
605 | } | ||||||
606 | 88 | 159 | if ($pat && ($inc_deprecated || !$pat->{deprecated})) { | ||||
607 | 86 | 136 | return (wantarray) ? | ||||
608 | (symbol => $pat, soname => $soname) : $pat; | ||||||
609 | } | ||||||
610 | } | ||||||
611 | } | ||||||
612 | } | ||||||
613 | 2 | 3 | return; | ||||
614 | } | ||||||
615 | |||||||
616 | # Get symbol object reference either by symbol name or by a reference object. | ||||||
617 | sub get_symbol_object { | ||||||
618 | 0 | 0 | 0 | my ($self, $refsym, $soname) = @_; | |||
619 | 0 | 0 | my $sym = $self->lookup_symbol($refsym, $soname, 1); | ||||
620 | 0 | 0 | if (! defined $sym) { | ||||
621 | 0 | 0 | $sym = $self->lookup_pattern($refsym, $soname, 1); | ||||
622 | } | ||||||
623 | 0 | 0 | return $sym; | ||||
624 | } | ||||||
625 | |||||||
626 | sub get_new_symbols { | ||||||
627 | 21 | 0 | 35 | my ($self, $ref, %opts) = @_; | |||
628 | my $with_optional = (exists $opts{with_optional}) ? | ||||||
629 | 21 | 32 | $opts{with_optional} : 0; | ||||
630 | 21 | 24 | my @res; | ||||
631 | 21 | 32 | foreach my $soname ($self->get_sonames()) { | ||||
632 | 21 | 26 | next if not $ref->has_object($soname); | ||||
633 | |||||||
634 | # Scan raw symbols first. | ||||||
635 | 21 9485 | 30 9905 | foreach my $sym (grep { ($with_optional || ! $_->is_optional()) | ||||
636 | && $_->is_legitimate($self->get_arch()) } | ||||||
637 | $self->get_symbols($soname)) | ||||||
638 | { | ||||||
639 | 9301 | 6691 | my $refsym = $ref->lookup_symbol($sym, $soname, 1); | ||||
640 | 9301 | 4961 | my $isnew; | ||||
641 | 9301 | 5267 | if (defined $refsym) { | ||||
642 | # If the symbol exists in the $ref symbol file, it might | ||||||
643 | # still be new if $refsym is not legitimate. | ||||||
644 | 8823 | 5832 | $isnew = not $refsym->is_legitimate($self->get_arch()); | ||||
645 | } else { | ||||||
646 | # If the symbol does not exist in the $ref symbol file, it does | ||||||
647 | # not mean that it's new. It might still match a pattern in the | ||||||
648 | # symbol file. However, due to performance reasons, first check | ||||||
649 | # if the pattern that the symbol matches (if any) exists in the | ||||||
650 | # ref symbol file as well. | ||||||
651 | 478 | 379 | $isnew = not ( | ||||
652 | ($sym->get_pattern() and $ref->lookup_pattern($sym->get_pattern(), $soname, 1)) or | ||||||
653 | $ref->find_matching_pattern($sym, $soname, 1) | ||||||
654 | ); | ||||||
655 | } | ||||||
656 | 9301 | 8134 | push @res, { symbol => $sym, soname => $soname } if $isnew; | ||||
657 | } | ||||||
658 | |||||||
659 | # Now scan patterns | ||||||
660 | 21 49 | 482 66 | foreach my $p (grep { ($with_optional || ! $_->is_optional()) | ||||
661 | && $_->is_legitimate($self->get_arch()) } | ||||||
662 | $self->get_patterns($soname)) | ||||||
663 | { | ||||||
664 | 35 | 35 | my $refpat = $ref->lookup_pattern($p, $soname, 0); | ||||
665 | # If reference pattern was not found or it is not legitimate, | ||||||
666 | # considering current one as new. | ||||||
667 | 35 | 43 | if (not defined $refpat or | ||||
668 | not $refpat->is_legitimate($self->get_arch())) | ||||||
669 | { | ||||||
670 | 2 | 5 | push @res, { symbol => $p , soname => $soname }; | ||||
671 | } | ||||||
672 | } | ||||||
673 | } | ||||||
674 | 21 | 171 | return @res; | ||||
675 | } | ||||||
676 | |||||||
677 | sub get_lost_symbols { | ||||||
678 | 13 | 0 | 28 | my ($self, $ref, %opts) = @_; | |||
679 | 13 | 23 | return $ref->get_new_symbols($self, %opts); | ||||
680 | } | ||||||
681 | |||||||
682 | |||||||
683 | sub get_new_libs { | ||||||
684 | 0 | 0 | my ($self, $ref) = @_; | ||||
685 | 0 | my @res; | |||||
686 | 0 | foreach my $soname ($self->get_sonames()) { | |||||
687 | 0 | push @res, $soname if not $ref->get_object($soname); | |||||
688 | } | ||||||
689 | 0 | return @res; | |||||
690 | } | ||||||
691 | |||||||
692 | sub get_lost_libs { | ||||||
693 | 0 | 0 | my ($self, $ref) = @_; | ||||
694 | 0 | return $ref->get_new_libs($self); | |||||
695 | } | ||||||
696 | |||||||
697 | 1; |