File Coverage

File:Dpkg/Shlibs/SymbolFile.pm
Coverage:78.8%

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::SymbolFile;
18
19
2
2
2
6
2
50
use strict;
20
2
2
2
4
2
66
use warnings;
21
22our $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
37my %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
67for 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
77sub 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
94sub 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
107sub get_arch {
108
46959
0
24403
    my $self = shift;
109
46959
43290
    return $self->{arch};
110}
111
112sub clear {
113
41
0
27
    my $self = shift;
114
41
52
    $self->{objects} = {};
115}
116
117sub 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
126sub get_sonames {
127
51
0
52
    my $self = shift;
128
51
51
47
119
    return keys %{$self->{objects}};
129}
130
131sub 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
145sub 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.
163sub 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
177sub 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
201sub _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.
207sub 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
279sub 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
288sub 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).
353sub 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.
404sub 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
492sub is_empty {
493
0
0
0
    my $self = shift;
494
0
0
0
0
    return scalar(keys %{$self->{objects}}) ? 0 : 1;
495}
496
497sub has_object {
498
56
0
59
    my ($self, $soname) = @_;
499
56
106
    return exists $self->{objects}{$soname};
500}
501
502sub get_object {
503
70035
0
41073
    my ($self, $soname) = @_;
504
70035
55585
    return ref($soname) ? $soname : $self->{objects}{$soname};
505}
506
507sub 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
521sub 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
527sub 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
545sub get_dependencies {
546
30
0
34
    my ($self, $soname) = @_;
547
30
30
28
38
    return @{$self->get_object($soname)->{deps}};
548}
549
550sub 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.
562sub 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.
582sub 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.
617sub 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
626sub 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
677sub get_lost_symbols {
678
13
0
28
    my ($self, $ref, %opts) = @_;
679
13
23
    return $ref->get_new_symbols($self, %opts);
680}
681
682
683sub 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
692sub get_lost_libs {
693
0
0
    my ($self, $ref) = @_;
694
0
    return $ref->get_new_libs($self);
695}
696
6971;