File Coverage

File:Dpkg/Shlibs/Symbol.pm
Coverage:80.4%

linestmtbrancondsubpodtimecode
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 - 30
=head1 NAME

Dpkg::Shlibs::Symbol - represent an object file symbol

=head1 DESCRIPTION

This module provides a class to handle symbols from an executable or
shared object file.

B<Note>: This is a private module, its API can change at any time.

=cut
31
32package Dpkg::Shlibs::Symbol 0.01;
33
34
6
6
6
6
22
10
158
use strict;
35
6
6
6
6
18
12
242
use warnings;
36
37
6
6
6
6
18
4
72
use Storable ();
38
6
6
6
6
12
4
306
use List::Util qw(any);
39
40
6
6
6
6
22
4
218
use Dpkg::Gettext;
41
6
6
6
6
14
6
298
use Dpkg::ErrorHandling;
42
6
6
6
6
16
12
236
use Dpkg::Arch qw(debarch_is_concerned debarch_to_abiattrs);
43
6
6
6
6
18
6
244
use Dpkg::Version;
44
6
6
6
6
6040
8
272
use Dpkg::Shlibs::Cppfilt;
45
46# Supported alias types in the order of matching preference
47
6
9292
use constant ALIAS_TYPES => qw(
48    c++
49    symver
50
6
6
6
28
6
);
51
52sub new {
53
42813
42813
0
53998
    my ($this, %args) = @_;
54
42813
33
80189
    my $class = ref($this) || $this;
55
42813
126582
    my $self = bless {
56        symbol => undef,
57        symbol_templ => undef,
58        minver => undef,
59        dep_id => 0,
60        deprecated => 0,
61        tags => {},
62        tagorder => [],
63    }, $class;
64
42813
70441
    $self->{$_} = $args{$_} foreach keys %args;
65
42813
56793
    return $self;
66}
67
68# Deep clone
69sub clone {
70
711
711
0
1515
    my ($self, %args) = @_;
71
711
32704
    my $clone = Storable::dclone($self);
72
711
2458
    $clone->{$_} = $args{$_} foreach keys %args;
73
711
1247
    return $clone;
74}
75
76sub parse_tagspec {
77
15753
15753
0
13383
    my ($self, $tagspec) = @_;
78
79
15753
50
67
23624
    if ($tagspec =~ /^\s*\((.*?)\)(.*)$/ && $1) {
80        # (tag1=t1 value|tag2|...|tagN=tNp)
81        # Symbols ()|= cannot appear in the tag names and values
82
699
858
        $tagspec = $1;
83
699
100
1212
        my $rest = ($2) ? $2 : '';
84
699
1297
        my @tags = split(/\|/, $tagspec);
85
86        # Parse each tag
87
699
901
        for my $tag (@tags) {
88
1002
100
1615
            if ($tag =~ /^(.*)=(.*)$/) {
89                # Tag with value
90
522
704
                $self->add_tag($1, $2);
91            } else {
92                # Tag without value
93
480
753
                $self->add_tag($tag, undef);
94            }
95        }
96
699
1366
        return $rest;
97    }
98
15054
33250
    return;
99}
100
101sub parse_symbolspec {
102
15735
15735
0
14249
    my ($self, $symbolspec, %opts) = @_;
103
15735
20883
    my $symbol;
104    my $symbol_templ;
105
15735
0
    my $symbol_quoted;
106
15735
0
    my $rest;
107
108
15735
100
50
16269
    if (defined($symbol = $self->parse_tagspec($symbolspec))) {
109        # (tag1=t1 value|tag2|...|tagN=tNp)"Foo::Bar::foobar()"@Base 1.0 1
110        # Symbols ()|= cannot appear in the tag names and values
111
112        # If the tag specification exists symbol name template might be quoted too
113
681
100
50
67
4723
        if ($symbol =~ /^(['"])/ && $symbol =~ /^($1)(.*?)$1(.*)$/) {
114
177
317
            $symbol_quoted = $1;
115
177
286
            $symbol_templ = $2;
116
177
204
            $symbol = $2;
117
177
327
            $rest = $3;
118        } elsif ($symbol =~ m/^(\S+)(.*)$/) {
119
504
622
            $symbol_templ = $1;
120
504
540
            $symbol = $1;
121
504
604
            $rest = $2;
122        }
123
681
50
1002
        error(g_('symbol name unspecified: %s'), $symbolspec) if (!$symbol);
124    } elsif ($symbolspec =~ m/^(\S+)(.*)$/) {
125        # No tag specification. Symbol name is up to the first space
126        # foobarsymbol@Base 1.0 1
127
15054
13619
        $symbol = $1;
128
15054
13701
        $rest = $2;
129    } else {
130
0
0
        return 0;
131    }
132
15735
14006
    $self->{symbol} = $symbol;
133
15735
11312
    $self->{symbol_templ} = $symbol_templ;
134
15735
100
16020
    $self->{symbol_quoted} = $symbol_quoted if ($symbol_quoted);
135
136    # Now parse "the rest" (minver and dep_id)
137
15735
100
50
23459
    if ($rest =~ /^\s(\S+)(?:\s(\d+))?/) {
138
15732
15947
        $self->{minver} = $1;
139
15732
100
36086
        $self->{dep_id} = $2 // 0;
140    } elsif (defined $opts{default_minver}) {
141
3
11
        $self->{minver} = $opts{default_minver};
142
3
7
        $self->{dep_id} = 0;
143    } else {
144
0
0
        return 0;
145    }
146
15735
17030
    return 1;
147}
148
149# A hook for symbol initialization (typically processing of tags). The code
150# here may even change symbol name. Called from
151# Dpkg::Shlibs::SymbolFile::create_symbol().
152sub initialize {
153
15735
15735
0
11145
    my $self = shift;
154
155    # Look for tags marking symbol patterns. The pattern may match multiple
156    # real symbols.
157
15735
10908
    my $type;
158
15735
100
16771
    if ($self->has_tag('c++')) {
159        # Raw symbol name is always demangled to the same alias while demangled
160        # symbol name cannot be reliably converted back to raw symbol name.
161        # Therefore, we can use hash for mapping.
162
213
235
        $type = 'alias-c++';
163    }
164
165    # Support old style wildcard syntax. That's basically a symver
166    # with an optional tag.
167
15735
100
16868
    if ($self->get_symbolname() =~ /^\*@(.*)$/) {
168
9
50
16
        $self->add_tag('symver') unless $self->has_tag('symver');
169
9
50
15
        $self->add_tag('optional') unless $self->has_tag('optional');
170
9
12
        $self->{symbol} = $1;
171    }
172
173
15735
100
15606
    if ($self->has_tag('symver')) {
174        # Each symbol is matched against its version rather than full
175        # name@version string.
176
81
100
150
        $type = (defined $type) ? 'generic' : 'alias-symver';
177
81
50
117
        if ($self->get_symbolname() =~ /@/) {
178
0
0
            warning(g_('symver tag with versioned symbol will not match: %s'),
179                    $self->get_symbolspec(1));
180        }
181
81
50
97
        if ($self->get_symbolname() eq 'Base') {
182
0
0
            error(g_("you can't use symver tag to catch unversioned symbols: %s"),
183                  $self->get_symbolspec(1));
184        }
185    }
186
187    # As soon as regex is involved, we need to match each real
188    # symbol against each pattern (aka 'generic' pattern).
189
15735
100
14803
    if ($self->has_tag('regex')) {
190
75
76
        $type = 'generic';
191        # Pre-compile regular expression for better performance.
192
75
85
        my $regex = $self->get_symbolname();
193
75
1722
        $self->{pattern}{regex} = qr/$regex/;
194    }
195
15735
100
19955
    if (defined $type) {
196
258
403
        $self->init_pattern($type);
197    }
198}
199
200sub get_symbolname {
201
185154
185154
0
116546
    my $self = shift;
202
203
185154
248946
    return $self->{symbol};
204}
205
206sub get_symboltempl {
207
814758
814758
0
461778
    my $self = shift;
208
209
814758
67
1306101
    return $self->{symbol_templ} || $self->{symbol};
210}
211
212sub set_symbolname {
213
585
585
0
861
    my ($self, $name, $templ, $quoted) = @_;
214
215
585
33
2184
    $name //= $self->{symbol};
216
585
50
33
2184
    if (!defined $templ && $name =~ /\s/) {
217
0
0
        $templ = $name;
218    }
219
585
50
25
1648
    if (!defined $quoted && defined $templ && $templ =~ /\s/) {
220
0
0
        $quoted = '"';
221    }
222
585
700
    $self->{symbol} = $name;
223
585
657
    $self->{symbol_templ} = $templ;
224
585
50
730
    if ($quoted) {
225
0
0
        $self->{symbol_quoted} = $quoted;
226    } else {
227
585
861
        delete $self->{symbol_quoted};
228    }
229}
230
231sub has_tags {
232
486
486
0
330
    my $self = shift;
233
486
486
361
745
    return scalar (@{$self->{tagorder}});
234}
235
236sub add_tag {
237
1020
1020
0
1936
    my ($self, $tagname, $tagval) = @_;
238
1020
100
1467
    if (exists $self->{tags}{$tagname}) {
239
18
24
        $self->{tags}{$tagname} = $tagval;
240
18
28
        return 0;
241    } else {
242
1002
1529
        $self->{tags}{$tagname} = $tagval;
243
1002
1002
893
1412
        push @{$self->{tagorder}}, $tagname;
244    }
245
1002
1152
    return 1;
246}
247
248sub delete_tag {
249
18
18
0
38
    my ($self, $tagname) = @_;
250
18
100
30
    if (exists $self->{tags}{$tagname}) {
251
6
14
        delete $self->{tags}{$tagname};
252
6
6
6
8
12
12
        $self->{tagorder} = [ grep { $_ ne $tagname } @{$self->{tagorder}} ];
253
6
10
        return 1;
254    }
255
12
20
    return 0;
256}
257
258sub has_tag {
259
75918
75918
0
55898
    my ($self, $tag) = @_;
260
75918
130041
    return exists $self->{tags}{$tag};
261}
262
263sub get_tag_value {
264
0
0
0
0
    my ($self, $tag) = @_;
265
0
0
    return $self->{tags}{$tag};
266}
267
268# Checks if the symbol is equal to another one (by name and optionally,
269# tag sets, versioning info (minver and depid))
270sub equals {
271
348
348
0
440
    my ($self, $other, %opts) = @_;
272
348
100
393
    $opts{versioning} //= 1;
273
348
50
818
    $opts{tags} //= 1;
274
275
348
100
736
    return 0 if $self->{symbol} ne $other->{symbol};
276
277
144
100
209
    if ($opts{versioning}) {
278
3
50
9
        return 0 if $self->{minver} ne $other->{minver};
279
3
50
7
        return 0 if $self->{dep_id} ne $other->{dep_id};
280    }
281
282
144
50
176
    if ($opts{tags}) {
283
144
144
144
50
117
169
186
        return 0 if scalar(@{$self->{tagorder}}) != scalar(@{$other->{tagorder}});
284
285
144
144
134
234
        for my $i (0 .. scalar(@{$self->{tagorder}}) - 1) {
286
297
293
            my $tag = $self->{tagorder}->[$i];
287
297
50
357
            return 0 if $tag ne $other->{tagorder}->[$i];
288
297
50
50
33
33
1093
            if (defined $self->{tags}{$tag} && defined $other->{tags}{$tag}) {
289
0
0
0
                return 0 if $self->{tags}{$tag} ne $other->{tags}{$tag};
290            } elsif (defined $self->{tags}{$tag} || defined $other->{tags}{$tag}) {
291
0
0
                return 0;
292            }
293        }
294    }
295
296
144
333
    return 1;
297}
298
299
300sub is_optional {
301
28623
28623
0
18104
    my $self = shift;
302
28623
24414
    return $self->has_tag('optional');
303}
304
305sub is_arch_specific {
306
0
0
0
0
    my $self = shift;
307
0
0
    return $self->has_tag('arch');
308}
309
310sub arch_is_concerned {
311
124280
124280
0
102028
    my ($self, $arch) = @_;
312
124280
102963
    my $arches = $self->{tags}{arch};
313
314
124280
100
75
264083
    return 0 if defined $arch && defined $arches &&
315                !debarch_is_concerned($arch, split /[\s,]+/, $arches);
316
317
123974
141418
    my ($bits, $endian) = debarch_to_abiattrs($arch);
318    return 0 if defined $bits && defined $self->{tags}{'arch-bits'} &&
319
123974
100
75
276635
                $bits ne $self->{tags}{'arch-bits'};
320    return 0 if defined $endian && defined $self->{tags}{'arch-endian'} &&
321
123848
100
75
252241
                $endian ne $self->{tags}{'arch-endian'};
322
323
123734
253443
    return 1;
324}
325
326# Get reference to the pattern the symbol matches (if any)
327sub get_pattern {
328
1878
1878
0
1399
    my $self = shift;
329
330
1878
5154
    return $self->{matching_pattern};
331}
332
333### NOTE: subroutines below require (or initialize) $self to be a pattern ###
334
335# Initializes this symbol as a pattern of the specified type.
336sub init_pattern {
337
258
258
0
296
    my ($self, $type) = @_;
338
339
258
448
    $self->{pattern}{type} = $type;
340    # To be filled with references to symbols matching this pattern.
341
258
433
    $self->{pattern}{matches} = [];
342}
343
344# Is this symbol a pattern or not?
345sub is_pattern {
346
72035
72035
0
51753
    my $self = shift;
347
348
72035
90751
    return exists $self->{pattern};
349}
350
351# Get pattern type if this symbol is a pattern.
352sub get_pattern_type {
353
2280
2280
0
2195
    my $self = shift;
354
355
2280
50
18860
    return $self->{pattern}{type} // '';
356}
357
358# Get (sub)type of the alias pattern. Returns empty string if current
359# pattern is not alias.
360sub get_alias_type {
361
2139
2139
0
2183
    my $self = shift;
362
363
2139
100
2795
    return ($self->get_pattern_type() =~ /^alias-(.+)/ && $1) || '';
364}
365
366# Get a list of symbols matching this pattern if this symbol is a pattern
367sub get_pattern_matches {
368
159
159
0
140
    my $self = shift;
369
370
159
159
124
2536
    return @{$self->{pattern}{matches}};
371}
372
373# Create a new symbol based on the pattern (i.e. $self)
374# and add it to the pattern matches list.
375sub create_pattern_match {
376
585
585
0
601
    my $self = shift;
377
585
50
766
    return unless $self->is_pattern();
378
379    # Leave out 'pattern' subfield while deep-cloning
380
585
702
    my $pattern_stuff = $self->{pattern};
381
585
994
    delete $self->{pattern};
382
585
1255
    my $newsym = $self->clone(@_);
383
585
814
    $self->{pattern} = $pattern_stuff;
384
385    # Clean up symbol name related internal fields
386
585
1153
    $newsym->set_symbolname();
387
388    # Set newsym pattern reference, add to pattern matches list
389
585
694
    $newsym->{matching_pattern} = $self;
390
585
585
537
1150
    push @{$self->{pattern}{matches}}, $newsym;
391
585
1000
    return $newsym;
392}
393
394### END of pattern subroutines ###
395
396# Given a raw symbol name the call returns its alias according to the rules of
397# the current pattern ($self). Returns undef if the supplied raw name is not
398# transformable to alias.
399sub convert_to_alias {
400
2688
2688
0
3498
    my ($self, $rawname, $type) = @_;
401
2688
100
4626
    $type = $self->get_alias_type() unless $type;
402
403
2688
50
3224
    if ($type) {
404
2688
100
50
33
7267
        if ($type eq 'symver') {
405            # In case of symver, alias is symbol version. Extract it from the
406            # rawname.
407
1335
50
5999
            return "$1" if ($rawname =~ /\@([^@]+)$/);
408        } elsif ($rawname =~ /^_Z/ && $type eq 'c++') {
409
1353
2570
            return cppfilt_demangle_cpp($rawname);
410        }
411    }
412
0
0
    return;
413}
414
415sub get_tagspec {
416
120
120
0
103
    my $self = shift;
417
120
50
126
    if ($self->has_tags()) {
418
120
109
        my @tags;
419
120
120
106
165
        for my $tagname (@{$self->{tagorder}}) {
420
168
271
            my $tagval = $self->{tags}{$tagname};
421
168
100
166
            if (defined $tagval) {
422
84
138
                push @tags, $tagname . '='  . $tagval;
423            } else {
424
84
120
                push @tags, $tagname;
425            }
426        }
427
120
304
        return '(' . join('|', @tags) . ')';
428    }
429
0
0
    return '';
430}
431
432sub get_symbolspec {
433
41700
41700
0
29603
    my $self = shift;
434
41700
25611
    my $template_mode = shift;
435
41700
26517
    my $spec = '';
436
41700
100
37851
    $spec .= "#MISSING: $self->{deprecated}#" if $self->{deprecated};
437
41700
31556
    $spec .= ' ';
438
41700
100
32587
    if ($template_mode) {
439
366
100
465
        if ($self->has_tags()) {
440            $spec .= sprintf('%s%3$s%s%3$s', $self->get_tagspec(),
441
120
100
179
                $self->get_symboltempl(), $self->{symbol_quoted} // '');
442        } else {
443
246
264
            $spec .= $self->get_symboltempl();
444        }
445    } else {
446
41334
37274
        $spec .= $self->get_symbolname();
447    }
448
41700
39965
    $spec .= " $self->{minver}";
449
41700
100
36527
    $spec .= " $self->{dep_id}" if $self->{dep_id};
450
41700
47711
    return $spec;
451}
452
453# Sanitize the symbol when it is confirmed to be found in
454# the respective library.
455sub mark_found_in_library {
456
27086
27086
0
28585
    my ($self, $minver, $arch) = @_;
457
458
27086
100
50
59608
    if ($self->{deprecated}) {
459        # Symbol reappeared somehow
460
9
19
        $self->{deprecated} = 0;
461
9
100
26
        $self->{minver} = $minver if (not $self->is_optional());
462    } elsif (version_compare($minver, $self->{minver}) < 0) {
463        # We assume that the right dependency information is already
464        # there.
465
0
0
        $self->{minver} = $minver;
466    }
467    # Never remove arch tags from patterns
468
27086
100
43229
    if (not $self->is_pattern()) {
469
26501
100
35712
        if (not $self->arch_is_concerned($arch)) {
470            # Remove arch tags because they are incorrect.
471
6
34
            $self->delete_tag('arch');
472
6
8
            $self->delete_tag('arch-bits');
473
6
12
            $self->delete_tag('arch-endian');
474        }
475    }
476}
477
478# Sanitize the symbol when it is confirmed to be NOT found in
479# the respective library.
480# Mark as deprecated those that are no more provided (only if the
481# minver is later than the version where the symbol was introduced)
482sub mark_not_found_in_library {
483
510
510
0
693
    my ($self, $minver, $arch) = @_;
484
485    # Ignore symbols from foreign arch
486
510
100
821
    return if not $self->arch_is_concerned($arch);
487
488
342
100
50
911
    if ($self->{deprecated}) {
489        # Bump deprecated if the symbol is optional so that it
490        # keeps reappearing in the diff while it's missing
491
6
50
16
        $self->{deprecated} = $minver if $self->is_optional();
492    } elsif (version_compare($minver, $self->{minver}) > 0) {
493
336
1378
        $self->{deprecated} = $minver;
494    }
495}
496
497# Checks if the symbol (or pattern) is legitimate as a real symbol for the
498# specified architecture.
499sub is_legitimate {
500
54954
54954
0
41340
    my ($self, $arch) = @_;
501    return ! $self->{deprecated} &&
502
54954
100
86956
           $self->arch_is_concerned($arch);
503}
504
505# Determine whether a supplied raw symbol name matches against current ($self)
506# symbol or pattern.
507sub matches_rawname {
508
801
801
0
1065
    my ($self, $rawname) = @_;
509
801
844
    my $target = $rawname;
510
801
767
    my $ok = 1;
511
801
722
    my $do_eq_match = 1;
512
513
801
50
1129
    if ($self->is_pattern()) {
514        # Process pattern tags in the order they were specified.
515
801
801
658
1309
        for my $tag (@{$self->{tagorder}}) {
516
1719
2637
100
100
2637
4522
3515
            if (any { $tag eq $_ } ALIAS_TYPES) {
517
1053
1395
                $ok = not not ($target = $self->convert_to_alias($target, $tag));
518            } elsif ($tag eq 'regex') {
519                # Symbol name is a regex. Match it against the target
520
549
577
                $do_eq_match = 0;
521
549
3064
                $ok = ($target =~ $self->{pattern}{regex});
522            }
523
1719
100
3625
            last if not $ok;
524        }
525    }
526
527    # Equality match by default
528
801
100
100
2197
    if ($ok && $do_eq_match) {
529
252
591
        $ok = $target eq $self->get_symbolname();
530    }
531
801
2621
    return $ok;
532}
533
534 - 540
=head1 CHANGES

=head2 Version 0.xx

This is a private module.

=cut
541
5421;