File Coverage

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

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