OLD | NEW |
| (Empty) |
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::Symbol; | |
18 | |
19 use strict; | |
20 use warnings; | |
21 | |
22 our $VERSION = '0.01'; | |
23 | |
24 use Dpkg::Gettext; | |
25 use Dpkg::Deps; | |
26 use Dpkg::ErrorHandling; | |
27 use Dpkg::Util qw(:list); | |
28 use Dpkg::Version; | |
29 use Storable (); | |
30 use Dpkg::Shlibs::Cppfilt; | |
31 | |
32 # Supported alias types in the order of matching preference | |
33 use constant ALIAS_TYPES => qw(c++ symver); | |
34 | |
35 sub new { | |
36 my $this = shift; | |
37 my $class = ref($this) || $this; | |
38 my %args = @_; | |
39 my $self = bless { | |
40 symbol => undef, | |
41 symbol_templ => undef, | |
42 minver => undef, | |
43 dep_id => 0, | |
44 deprecated => 0, | |
45 tags => {}, | |
46 tagorder => [], | |
47 }, $class; | |
48 $self->{$_} = $args{$_} foreach keys %args; | |
49 return $self; | |
50 } | |
51 | |
52 # Deep clone | |
53 sub clone { | |
54 my $self = shift; | |
55 my $clone = Storable::dclone($self); | |
56 if (@_) { | |
57 my %args=@_; | |
58 $clone->{$_} = $args{$_} foreach keys %args; | |
59 } | |
60 return $clone; | |
61 } | |
62 | |
63 sub parse_tagspec { | |
64 my ($self, $tagspec) = @_; | |
65 | |
66 if ($tagspec =~ /^\s*\((.*?)\)(.*)$/ && $1) { | |
67 # (tag1=t1 value|tag2|...|tagN=tNp) | |
68 # Symbols ()|= cannot appear in the tag names and values | |
69 my $tagspec = $1; | |
70 my $rest = ($2) ? $2 : ''; | |
71 my @tags = split(/\|/, $tagspec); | |
72 | |
73 # Parse each tag | |
74 for my $tag (@tags) { | |
75 if ($tag =~ /^(.*)=(.*)$/) { | |
76 # Tag with value | |
77 $self->add_tag($1, $2); | |
78 } else { | |
79 # Tag without value | |
80 $self->add_tag($tag, undef); | |
81 } | |
82 } | |
83 return $rest; | |
84 } | |
85 return; | |
86 } | |
87 | |
88 sub parse_symbolspec { | |
89 my ($self, $symbolspec, %opts) = @_; | |
90 my $symbol; | |
91 my $symbol_templ; | |
92 my $symbol_quoted; | |
93 my $rest; | |
94 | |
95 if (defined($symbol = $self->parse_tagspec($symbolspec))) { | |
96 # (tag1=t1 value|tag2|...|tagN=tNp)"Foo::Bar::foobar()"@Base 1.0 1 | |
97 # Symbols ()|= cannot appear in the tag names and values | |
98 | |
99 # If the tag specification exists symbol name template might be quoted t
oo | |
100 if ($symbol =~ /^(['"])/ && $symbol =~ /^($1)(.*?)$1(.*)$/) { | |
101 $symbol_quoted = $1; | |
102 $symbol_templ = $2; | |
103 $symbol = $2; | |
104 $rest = $3; | |
105 } else { | |
106 if ($symbol =~ m/^(\S+)(.*)$/) { | |
107 $symbol_templ = $1; | |
108 $symbol = $1; | |
109 $rest = $2; | |
110 } | |
111 } | |
112 error(_g('symbol name unspecified: %s'), $symbolspec) if (!$symbol); | |
113 } else { | |
114 # No tag specification. Symbol name is up to the first space | |
115 # foobarsymbol@Base 1.0 1 | |
116 if ($symbolspec =~ m/^(\S+)(.*)$/) { | |
117 $symbol = $1; | |
118 $rest = $2; | |
119 } else { | |
120 return 0; | |
121 } | |
122 } | |
123 $self->{symbol} = $symbol; | |
124 $self->{symbol_templ} = $symbol_templ; | |
125 $self->{symbol_quoted} = $symbol_quoted if ($symbol_quoted); | |
126 | |
127 # Now parse "the rest" (minver and dep_id) | |
128 if ($rest =~ /^\s(\S+)(?:\s(\d+))?/) { | |
129 $self->{minver} = $1; | |
130 $self->{dep_id} = defined($2) ? $2 : 0; | |
131 } elsif (defined $opts{default_minver}) { | |
132 $self->{minver} = $opts{default_minver}; | |
133 $self->{dep_id} = 0; | |
134 } else { | |
135 return 0; | |
136 } | |
137 return 1; | |
138 } | |
139 | |
140 # A hook for symbol initialization (typically processing of tags). The code | |
141 # here may even change symbol name. Called from | |
142 # Dpkg::Shlibs::SymbolFile::create_symbol(). | |
143 sub initialize { | |
144 my $self = shift; | |
145 | |
146 # Look for tags marking symbol patterns. The pattern may match multiple | |
147 # real symbols. | |
148 my $type; | |
149 if ($self->has_tag('c++')) { | |
150 # Raw symbol name is always demangled to the same alias while demangled | |
151 # symbol name cannot be reliably converted back to raw symbol name. | |
152 # Therefore, we can use hash for mapping. | |
153 $type = 'alias-c++'; | |
154 } | |
155 | |
156 # Support old style wildcard syntax. That's basically a symver | |
157 # with an optional tag. | |
158 if ($self->get_symbolname() =~ /^\*@(.*)$/) { | |
159 $self->add_tag('symver') unless $self->has_tag('symver'); | |
160 $self->add_tag('optional') unless $self->has_tag('optional'); | |
161 $self->{symbol} = $1; | |
162 } | |
163 | |
164 if ($self->has_tag('symver')) { | |
165 # Each symbol is matched against its version rather than full | |
166 # name@version string. | |
167 $type = (defined $type) ? 'generic' : 'alias-symver'; | |
168 if ($self->get_symbolname() eq 'Base') { | |
169 error(_g("you can't use symver tag to catch unversioned symbols: %s"
), | |
170 $self->get_symbolspec(1)); | |
171 } | |
172 } | |
173 | |
174 # As soon as regex is involved, we need to match each real | |
175 # symbol against each pattern (aka 'generic' pattern). | |
176 if ($self->has_tag('regex')) { | |
177 $type = 'generic'; | |
178 # Pre-compile regular expression for better performance. | |
179 my $regex = $self->get_symbolname(); | |
180 $self->{pattern}{regex} = qr/$regex/; | |
181 } | |
182 if (defined $type) { | |
183 $self->init_pattern($type); | |
184 } | |
185 } | |
186 | |
187 sub get_symbolname { | |
188 return $_[0]->{symbol}; | |
189 } | |
190 | |
191 sub get_symboltempl { | |
192 return $_[0]->{symbol_templ} || $_[0]->{symbol}; | |
193 } | |
194 | |
195 sub set_symbolname { | |
196 my ($self, $name, $templ, $quoted) = @_; | |
197 unless (defined $name) { | |
198 $name = $self->{symbol}; | |
199 } | |
200 if (!defined $templ && $name =~ /\s/) { | |
201 $templ = $name; | |
202 } | |
203 if (!defined $quoted && defined $templ && $templ =~ /\s/) { | |
204 $quoted = '"'; | |
205 } | |
206 $self->{symbol} = $name; | |
207 $self->{symbol_templ} = $templ; | |
208 if ($quoted) { | |
209 $self->{symbol_quoted} = $quoted; | |
210 } else { | |
211 delete $self->{symbol_quoted}; | |
212 } | |
213 } | |
214 | |
215 sub has_tags { | |
216 my $self = shift; | |
217 return scalar (@{$self->{tagorder}}); | |
218 } | |
219 | |
220 sub add_tag { | |
221 my ($self, $tagname, $tagval) = @_; | |
222 if (exists $self->{tags}{$tagname}) { | |
223 $self->{tags}{$tagname} = $tagval; | |
224 return 0; | |
225 } else { | |
226 $self->{tags}{$tagname} = $tagval; | |
227 push @{$self->{tagorder}}, $tagname; | |
228 } | |
229 return 1; | |
230 } | |
231 | |
232 sub delete_tag { | |
233 my ($self, $tagname) = @_; | |
234 if (exists $self->{tags}{$tagname}) { | |
235 delete $self->{tags}{$tagname}; | |
236 $self->{tagorder} = [ grep { $_ ne $tagname } @{$self->{tagorder}} ]; | |
237 return 1; | |
238 } | |
239 return 0; | |
240 } | |
241 | |
242 sub has_tag { | |
243 my ($self, $tag) = @_; | |
244 return exists $self->{tags}{$tag}; | |
245 } | |
246 | |
247 sub get_tag_value { | |
248 my ($self, $tag) = @_; | |
249 return $self->{tags}{$tag}; | |
250 } | |
251 | |
252 # Checks if the symbol is equal to another one (by name and optionally, | |
253 # tag sets, versioning info (minver and depid)) | |
254 sub equals { | |
255 my ($self, $other, %opts) = @_; | |
256 $opts{versioning} = 1 unless exists $opts{versioning}; | |
257 $opts{tags} = 1 unless exists $opts{tags}; | |
258 | |
259 return 0 if $self->{symbol} ne $other->{symbol}; | |
260 | |
261 if ($opts{versioning}) { | |
262 return 0 if $self->{minver} ne $other->{minver}; | |
263 return 0 if $self->{dep_id} ne $other->{dep_id}; | |
264 } | |
265 | |
266 if ($opts{tags}) { | |
267 return 0 if scalar(@{$self->{tagorder}}) != scalar(@{$other->{tagorder}}
); | |
268 | |
269 for my $i (0 .. scalar(@{$self->{tagorder}}) - 1) { | |
270 my $tag = $self->{tagorder}->[$i]; | |
271 return 0 if $tag ne $other->{tagorder}->[$i]; | |
272 if (defined $self->{tags}{$tag} && defined $other->{tags}{$tag}) { | |
273 return 0 if $self->{tags}{$tag} ne $other->{tags}{$tag}; | |
274 } elsif (defined $self->{tags}{$tag} || defined $other->{tags}{$tag}
) { | |
275 return 0; | |
276 } | |
277 } | |
278 } | |
279 | |
280 return 1; | |
281 } | |
282 | |
283 | |
284 sub is_optional { | |
285 my $self = shift; | |
286 return $self->has_tag('optional'); | |
287 } | |
288 | |
289 sub is_arch_specific { | |
290 my $self = shift; | |
291 return $self->has_tag('arch'); | |
292 } | |
293 | |
294 sub arch_is_concerned { | |
295 my ($self, $arch) = @_; | |
296 my $arches = $self->{tags}{arch}; | |
297 | |
298 if (defined $arch && defined $arches) { | |
299 my $dep = Dpkg::Deps::Simple->new(); | |
300 my @arches = split(/[\s,]+/, $arches); | |
301 $dep->{package} = 'dummy'; | |
302 $dep->{arches} = \@arches; | |
303 return $dep->arch_is_concerned($arch); | |
304 } | |
305 | |
306 return 1; | |
307 } | |
308 | |
309 # Get reference to the pattern the symbol matches (if any) | |
310 sub get_pattern { | |
311 return $_[0]->{matching_pattern}; | |
312 } | |
313 | |
314 ### NOTE: subroutines below require (or initialize) $self to be a pattern ### | |
315 | |
316 # Initializes this symbol as a pattern of the specified type. | |
317 sub init_pattern { | |
318 my ($self, $type) = @_; | |
319 | |
320 $self->{pattern}{type} = $type; | |
321 # To be filled with references to symbols matching this pattern. | |
322 $self->{pattern}{matches} = []; | |
323 } | |
324 | |
325 # Is this symbol a pattern or not? | |
326 sub is_pattern { | |
327 return exists $_[0]->{pattern}; | |
328 } | |
329 | |
330 # Get pattern type if this symbol is a pattern. | |
331 sub get_pattern_type { | |
332 return $_[0]->{pattern}{type} || ''; | |
333 } | |
334 | |
335 # Get (sub)type of the alias pattern. Returns empty string if current | |
336 # pattern is not alias. | |
337 sub get_alias_type { | |
338 return ($_[0]->get_pattern_type() =~ /^alias-(.+)/ && $1) || ''; | |
339 } | |
340 | |
341 # Get a list of symbols matching this pattern if this symbol is a pattern | |
342 sub get_pattern_matches { | |
343 return @{$_[0]->{pattern}{matches}}; | |
344 } | |
345 | |
346 # Create a new symbol based on the pattern (i.e. $self) | |
347 # and add it to the pattern matches list. | |
348 sub create_pattern_match { | |
349 my $self = shift; | |
350 return unless $self->is_pattern(); | |
351 | |
352 # Leave out 'pattern' subfield while deep-cloning | |
353 my $pattern_stuff = $self->{pattern}; | |
354 delete $self->{pattern}; | |
355 my $newsym = $self->clone(@_); | |
356 $self->{pattern} = $pattern_stuff; | |
357 | |
358 # Clean up symbol name related internal fields | |
359 $newsym->set_symbolname(); | |
360 | |
361 # Set newsym pattern reference, add to pattern matches list | |
362 $newsym->{matching_pattern} = $self; | |
363 push @{$self->{pattern}{matches}}, $newsym; | |
364 return $newsym; | |
365 } | |
366 | |
367 ### END of pattern subroutines ### | |
368 | |
369 # Given a raw symbol name the call returns its alias according to the rules of | |
370 # the current pattern ($self). Returns undef if the supplied raw name is not | |
371 # transformable to alias. | |
372 sub convert_to_alias { | |
373 my ($self, $rawname, $type) = @_; | |
374 $type = $self->get_alias_type() unless $type; | |
375 | |
376 if ($type) { | |
377 if ($type eq 'symver') { | |
378 # In case of symver, alias is symbol version. Extract it from the | |
379 # rawname. | |
380 return "$1" if ($rawname =~ /\@([^@]+)$/); | |
381 } elsif ($rawname =~ /^_Z/ && $type eq 'c++') { | |
382 return cppfilt_demangle_cpp($rawname); | |
383 } | |
384 } | |
385 return; | |
386 } | |
387 | |
388 sub get_tagspec { | |
389 my ($self) = @_; | |
390 if ($self->has_tags()) { | |
391 my @tags; | |
392 for my $tagname (@{$self->{tagorder}}) { | |
393 my $tagval = $self->{tags}{$tagname}; | |
394 if (defined $tagval) { | |
395 push @tags, $tagname . '=' . $tagval; | |
396 } else { | |
397 push @tags, $tagname; | |
398 } | |
399 } | |
400 return '(' . join('|', @tags) . ')'; | |
401 } | |
402 return ''; | |
403 } | |
404 | |
405 sub get_symbolspec { | |
406 my $self = shift; | |
407 my $template_mode = shift; | |
408 my $spec = ''; | |
409 $spec .= "#MISSING: $self->{deprecated}#" if $self->{deprecated}; | |
410 $spec .= ' '; | |
411 if ($template_mode) { | |
412 if ($self->has_tags()) { | |
413 $spec .= sprintf('%s%3$s%s%3$s', $self->get_tagspec(), | |
414 $self->get_symboltempl(), $self->{symbol_quoted} || ''); | |
415 } else { | |
416 $spec .= $self->get_symboltempl(); | |
417 } | |
418 } else { | |
419 $spec .= $self->get_symbolname(); | |
420 } | |
421 $spec .= " $self->{minver}"; | |
422 $spec .= " $self->{dep_id}" if $self->{dep_id}; | |
423 return $spec; | |
424 } | |
425 | |
426 # Sanitize the symbol when it is confirmed to be found in | |
427 # the respective library. | |
428 sub mark_found_in_library { | |
429 my ($self, $minver, $arch) = @_; | |
430 | |
431 if ($self->{deprecated}) { | |
432 # Symbol reappeared somehow | |
433 $self->{deprecated} = 0; | |
434 $self->{minver} = $minver if (not $self->is_optional()); | |
435 } else { | |
436 # We assume that the right dependency information is already | |
437 # there. | |
438 if (version_compare($minver, $self->{minver}) < 0) { | |
439 $self->{minver} = $minver; | |
440 } | |
441 } | |
442 # Never remove arch tags from patterns | |
443 if (not $self->is_pattern()) { | |
444 if (not $self->arch_is_concerned($arch)) { | |
445 # Remove arch tag because it is incorrect. | |
446 $self->delete_tag('arch'); | |
447 } | |
448 } | |
449 } | |
450 | |
451 # Sanitize the symbol when it is confirmed to be NOT found in | |
452 # the respective library. | |
453 # Mark as deprecated those that are no more provided (only if the | |
454 # minver is later than the version where the symbol was introduced) | |
455 sub mark_not_found_in_library { | |
456 my ($self, $minver, $arch) = @_; | |
457 | |
458 # Ignore symbols from foreign arch | |
459 return if not $self->arch_is_concerned($arch); | |
460 | |
461 if ($self->{deprecated}) { | |
462 # Bump deprecated if the symbol is optional so that it | |
463 # keeps reappering in the diff while it's missing | |
464 $self->{deprecated} = $minver if $self->is_optional(); | |
465 } elsif (version_compare($minver, $self->{minver}) > 0) { | |
466 $self->{deprecated} = $minver; | |
467 } | |
468 } | |
469 | |
470 # Checks if the symbol (or pattern) is legitimate as a real symbol for the | |
471 # specified architecture. | |
472 sub is_legitimate { | |
473 my ($self, $arch) = @_; | |
474 return ! $self->{deprecated} && | |
475 $self->arch_is_concerned($arch); | |
476 } | |
477 | |
478 # Determine whether a supplied raw symbol name matches against current ($self) | |
479 # symbol or pattern. | |
480 sub matches_rawname { | |
481 my ($self, $rawname) = @_; | |
482 my $target = $rawname; | |
483 my $ok = 1; | |
484 my $do_eq_match = 1; | |
485 | |
486 if ($self->is_pattern()) { | |
487 # Process pattern tags in the order they were specified. | |
488 for my $tag (@{$self->{tagorder}}) { | |
489 if (any { $tag eq $_ } ALIAS_TYPES) { | |
490 $ok = not not ($target = $self->convert_to_alias($target, $tag))
; | |
491 } elsif ($tag eq 'regex') { | |
492 # Symbol name is a regex. Match it against the target | |
493 $do_eq_match = 0; | |
494 $ok = ($target =~ $self->{pattern}{regex}); | |
495 } | |
496 last if not $ok; | |
497 } | |
498 } | |
499 | |
500 # Equality match by default | |
501 if ($ok && $do_eq_match) { | |
502 $ok = $target eq $self->get_symbolname(); | |
503 } | |
504 return $ok; | |
505 } | |
506 | |
507 1; | |
OLD | NEW |