File Coverage

File:Dpkg/Shlibs/SymbolFile.pm
Coverage:78.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
17=encoding utf8
18
19 - 29
=head1 NAME

Dpkg::Shlibs::SymbolFile - represent a symbols file

=head1 DESCRIPTION

This module provides a class to handle symbols files.

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

=cut
30
31package Dpkg::Shlibs::SymbolFile 0.01;
32
33
6
6
6
92
10
612
use strict;
34
6
6
6
20
10
448
use warnings;
35
36
6
6
6
28
4
402
use Dpkg::Gettext;
37
6
6
6
30
6
290
use Dpkg::ErrorHandling;
38
6
6
6
16
6
322
use Dpkg::Version;
39
6
6
6
5298
8
426
use Dpkg::Control::Fields;
40
6
6
6
4894
8
150
use Dpkg::Shlibs::Symbol;
41
6
6
6
18
8
196
use Dpkg::Arch qw(get_host_arch);
42
43
6
6
6
14
4
24
use parent qw(Dpkg::Interface::Storable);
44
45my %internal_symbol = (
46    __bss_end__ => 1,                   # arm
47    __bss_end => 1,                     # arm
48    _bss_end__ => 1,                    # arm
49    __bss_start => 1,                   # ALL
50    __bss_start__ => 1,                 # arm
51    __data_start => 1,                  # arm
52    __do_global_ctors_aux => 1,         # ia64
53    __do_global_dtors_aux => 1,         # ia64
54    __do_jv_register_classes => 1,      # ia64
55    _DYNAMIC => 1,                      # ALL
56    _edata => 1,                        # ALL
57    _end => 1,                          # ALL
58    __end__ => 1,                       # arm
59    __exidx_end => 1,                   # armel
60    __exidx_start => 1,                 # armel
61    _fbss => 1,                         # mips, mipsel
62    _fdata => 1,                        # mips, mipsel
63    _fini => 1,                         # ALL
64    _ftext => 1,                        # mips, mipsel
65    _GLOBAL_OFFSET_TABLE_ => 1,         # hppa, mips, mipsel
66    __gmon_start__ => 1,                # hppa
67    __gnu_local_gp => 1,                # mips, mipsel
68    _gp => 1,                           # mips, mipsel
69    _init => 1,                         # ALL
70    _PROCEDURE_LINKAGE_TABLE_ => 1,     # sparc, alpha
71    _SDA2_BASE_ => 1,                   # powerpc
72    _SDA_BASE_ => 1,                    # powerpc
73);
74
75for my $i (14 .. 31) {
76    # Many powerpc specific symbols
77    $internal_symbol{"_restfpr_$i"} = 1;
78    $internal_symbol{"_restfpr_$i\_x"} = 1;
79    $internal_symbol{"_restgpr_$i"} = 1;
80    $internal_symbol{"_restgpr_$i\_x"} = 1;
81    $internal_symbol{"_savefpr_$i"} = 1;
82    $internal_symbol{"_savegpr_$i"} = 1;
83}
84
85sub symbol_is_internal {
86
54618
0
46206
    my ($symbol, $include_groups) = @_;
87
88
54618
58286
    return 1 if exists $internal_symbol{$symbol};
89
90    # The ARM Embedded ABI spec states symbols under this namespace as
91    # possibly appearing in output objects.
92
54321
54321
32906
119197
    return 1 if not ${$include_groups}{aeabi} and $symbol =~ /^__aeabi_/;
93
94    # The GNU implementation of the OpenMP spec, specifies symbols under
95    # this namespace as possibly appearing in output objects.
96
54297
103088
    return 1 if not ${$include_groups}{gomp}
97
54297
36676
                and $symbol =~ /^\.gomp_critical_user_/;
98
99
54273
53428
    return 0;
100}
101
102sub new {
103
123
0
589
    my ($this, %opts) = @_;
104
123
645
    my $class = ref($this) || $this;
105
123
160
    my $self = \%opts;
106
123
177
    bless $self, $class;
107
123
806
    $self->{arch} //= get_host_arch();
108
123
255
    $self->clear();
109
123
235
    if (exists $self->{file}) {
110
123
1569
        $self->load($self->{file}) if -e $self->{file};
111    }
112
123
11284
    return $self;
113}
114
115sub get_arch {
116
140888
0
100870
    my $self = shift;
117
140888
208238
    return $self->{arch};
118}
119
120sub clear {
121
123
0
138
    my $self = shift;
122
123
232
    $self->{objects} = {};
123}
124
125sub clear_except {
126
0
0
0
    my ($self, @ids) = @_;
127
128
0
0
0
0
    my %has = map { $_ => 1 } @ids;
129
0
0
0
0
    foreach my $objid (keys %{$self->{objects}}) {
130
0
0
        delete $self->{objects}{$objid} unless exists $has{$objid};
131    }
132}
133
134sub get_sonames {
135
153
0
169
    my $self = shift;
136
153
153
175
555
    return keys %{$self->{objects}};
137}
138
139sub get_symbols {
140
264
0
456
    my ($self, $soname) = @_;
141
264
418
    if (defined $soname) {
142
264
459
        my $obj = $self->get_object($soname);
143
264
264
466
16273
        return (defined $obj) ? values %{$obj->{syms}} : ();
144    } else {
145
0
0
        my @syms;
146
0
0
        foreach my $soname ($self->get_sonames()) {
147
0
0
            push @syms, $self->get_symbols($soname);
148        }
149
0
0
        return @syms;
150    }
151}
152
153sub get_patterns {
154
177
0
365
    my ($self, $soname) = @_;
155
177
540
    my @patterns;
156
177
462
    if (defined $soname) {
157
177
328
        my $obj = $self->get_object($soname);
158
177
177
226
480
        foreach my $alias (values %{$obj->{patterns}{aliases}}) {
159
108
262
            push @patterns, values %$alias;
160        }
161
177
177
266
7686
        return (@patterns, @{$obj->{patterns}{generic}});
162    } else {
163
0
0
        foreach my $soname ($self->get_sonames()) {
164
0
0
            push @patterns, $self->get_patterns($soname);
165        }
166
0
0
        return @patterns;
167    }
168}
169
170# Create a symbol from the supplied string specification.
171sub create_symbol {
172
15735
0
23351
    my ($self, $spec, %opts) = @_;
173    my $symbol = (exists $opts{base}) ? $opts{base} :
174
15735
18213
        Dpkg::Shlibs::Symbol->new();
175
176
15735
23074
    my $ret = $opts{dummy} ? $symbol->parse_symbolspec($spec, default_minver => 0) :
177        $symbol->parse_symbolspec($spec);
178
15735
16390
    if ($ret) {
179
15735
18469
        $symbol->initialize(arch => $self->get_arch());
180
15735
19807
        return $symbol;
181    }
182
0
0
    return;
183}
184
185sub add_symbol {
186
43299
0
37479
    my ($self, $symbol, $soname) = @_;
187
43299
42088
    my $object = $self->get_object($soname);
188
189
43299
49190
    if ($symbol->is_pattern()) {
190
237
415
        if (my $alias_type = $symbol->get_alias_type()) {
191
138
560
            $object->{patterns}{aliases}{$alias_type} //= {};
192            # Alias hash for matching.
193
138
176
            my $aliases = $object->{patterns}{aliases}{$alias_type};
194
138
247
            $aliases->{$symbol->get_symbolname()} = $symbol;
195        } else {
196            # Otherwise assume this is a generic sequential pattern. This
197            # should be always safe.
198
99
99
106
172
            push @{$object->{patterns}{generic}}, $symbol;
199        }
200
237
662
        return 'pattern';
201    } else {
202        # invalidate the minimum version cache
203
43062
38921
        $object->{minver_cache} = [];
204
43062
49022
        $object->{syms}{$symbol->get_symbolname()} = $symbol;
205
43062
59529
        return 'sym';
206    }
207}
208
209sub _new_symbol {
210
15726
35927
    my $base = shift || 'Dpkg::Shlibs::Symbol';
211
15726
26494
    return (ref $base) ? $base->clone(@_) : $base->new(@_);
212}
213
214# Option state is only used for recursive calls.
215sub parse {
216
159
1
400
    my ($self, $fh, $file, %opts) = @_;
217
159
559
    my $state = $opts{state} //= {};
218
219
159
249
    if (exists $state->{seen}) {
220
54
144
        return if exists $state->{seen}{$file}; # Avoid include loops
221    } else {
222
105
154
        $self->{file} = $file;
223
105
175
        $state->{seen} = {};
224    }
225
153
287
    $state->{seen}{$file} = 1;
226
227
153
255
    if (not ref $state->{obj_ref}) { # Init ref to name of current object/lib
228
105
105
96
176
        ${$state->{obj_ref}} = undef;
229    }
230
231
153
415
    while (<$fh>) {
232
15969
14850
        chomp;
233
234
15969
30816
        if (/^(?:\s+|#(?:DEPRECATED|MISSING): ([^#]+)#\s*)(.*)/) {
235
15708
15708
10246
17111
            if (not defined ${$state->{obj_ref}}) {
236
0
0
                error(g_('symbol information must be preceded by a header (file %s, line %s)'), $file, $.);
237            }
238            # Symbol specification
239
15708
16957
            my $deprecated = ($1) ? Dpkg::Version->new($1) : 0;
240
15708
21124
            my $sym = _new_symbol($state->{base_symbol}, deprecated => $deprecated);
241
15708
21590
            if ($self->create_symbol($2, base => $sym)) {
242
15708
15708
11563
18028
                $self->add_symbol($sym, ${$state->{obj_ref}});
243            } else {
244
0
0
                warning(g_('failed to parse line in %s: %s'), $file, $_);
245            }
246        } elsif (/^(\(.*\))?#include\s+"([^"]+)"/) {
247
54
90
            my $tagspec = $1;
248
54
94
            my $filename = $2;
249
54
78
            my $dir = $file;
250
54
94
            my $old_base_symbol = $state->{base_symbol};
251
54
70
            my $new_base_symbol;
252
54
118
            if (defined $tagspec) {
253
18
38
                $new_base_symbol = _new_symbol($old_base_symbol);
254
18
40
                $new_base_symbol->parse_tagspec($tagspec);
255            }
256
54
72
            $state->{base_symbol} = $new_base_symbol;
257
54
278
            $dir =~ s{[^/]+$}{}; # Strip filename
258
54
336
            $self->load("$dir$filename", %opts);
259
54
288
            $state->{base_symbol} = $old_base_symbol;
260        } elsif (/^#|^$/) {
261            # Skip possible comments and empty lines
262        } elsif (/^\|\s*(.*)$/) {
263            # Alternative dependency template
264
42
42
42
54
70
172
            push @{$self->{objects}{${$state->{obj_ref}}}{deps}}, "$1";
265        } elsif (/^\*\s*([^:]+):\s*(.*\S)\s*$/) {
266            # Add meta-fields
267
12
12
14
42
            $self->{objects}{${$state->{obj_ref}}}{fields}{field_capitalize($1)} = $2;
268        } elsif (/^(\S+)\s+(.*)$/) {
269            # New object and dependency template
270
123
123
151
304
            ${$state->{obj_ref}} = $1;
271
123
123
174
250
            if (exists $self->{objects}{${$state->{obj_ref}}}) {
272                # Update/override infos only
273
6
6
20
24
                $self->{objects}{${$state->{obj_ref}}}{deps} = [ "$2" ];
274            } else {
275                # Create a new object
276
117
117
128
423
                $self->create_object(${$state->{obj_ref}}, "$2");
277            }
278        } else {
279
0
0
            warning(g_('failed to parse a line in %s: %s'), $file, $_);
280        }
281    }
282
153
815
    delete $state->{seen}{$file};
283}
284
285# Beware: we reuse the data structure of the provided symfile so make
286# sure to not modify them after having called this function
287sub merge_object_from_symfile {
288
0
0
0
    my ($self, $src, $objid) = @_;
289
0
0
    if (not $self->has_object($objid)) {
290
0
0
        $self->{objects}{$objid} = $src->get_object($objid);
291    } else {
292
0
0
        warning(g_('tried to merge the same object (%s) twice in a symfile'), $objid);
293    }
294}
295
296sub output {
297
90
1
210
    my ($self, $fh, %opts) = @_;
298
90
418
    $opts{template_mode} //= 0;
299
90
356
    $opts{with_deprecated} //= 1;
300
90
280
    $opts{with_pattern_matches} //= 0;
301
90
106
    my $res = '';
302
90
192
    foreach my $soname (sort $self->get_sonames()) {
303
90
230
        my @deps = $self->get_dependencies($soname);
304
90
140
        my $dep_first = shift @deps;
305
90
294
        if (exists $opts{package} and not $opts{template_mode}) {
306
6
76
            $dep_first =~ s/#PACKAGE#/$opts{package}/g;
307        }
308
90
42
124
232
        print { $fh } "$soname $dep_first\n" if defined $fh;
309
90
500
        $res .= "$soname $dep_first\n" if defined wantarray;
310
311
90
152
        foreach my $dep_next (@deps) {
312
54
214
            if (exists $opts{package} and not $opts{template_mode}) {
313
6
24
                $dep_next =~ s/#PACKAGE#/$opts{package}/g;
314            }
315
54
30
128
132
            print { $fh } "| $dep_next\n" if defined $fh;
316
54
212
            $res .= "| $dep_next\n" if defined wantarray;
317        }
318
90
150
        my $f = $self->{objects}{$soname}{fields};
319
90
90
96
168
        foreach my $field (sort keys %{$f}) {
320
6
16
            my $value = $f->{$field};
321
6
88
            if (exists $opts{package} and not $opts{template_mode}) {
322
6
16
                $value =~ s/#PACKAGE#/$opts{package}/g;
323            }
324
6
6
22
20
            print { $fh } "* $field: $value\n" if defined $fh;
325
6
14
            $res .= "* $field: $value\n" if defined wantarray;
326        }
327
328
90
94
        my @symbols;
329
90
150
        if ($opts{template_mode}) {
330            # Exclude symbols matching a pattern, but include patterns themselves
331
12
312
36
240
            @symbols = grep { not $_->get_pattern() } $self->get_symbols($soname);
332
12
42
            push @symbols, $self->get_patterns($soname);
333        } else {
334
78
194
            @symbols = $self->get_symbols($soname);
335        }
336
90
407196
710
374030
        foreach my $sym (sort { $a->get_symboltempl() cmp
337                                $b->get_symboltempl() } @symbols) {
338
41940
62884
            next if $sym->{deprecated} and not $opts{with_deprecated};
339            # Do not dump symbols from foreign arch unless dumping a template.
340            next if not $opts{template_mode} and
341
41940
67536
                    not $sym->arch_is_concerned($self->get_arch());
342            # Dump symbol specification. Dump symbol tags only in template mode.
343
41688
14016
42180
18178
            print { $fh } $sym->get_symbolspec($opts{template_mode}), "\n" if defined $fh;
344
41688
130328
            $res .= $sym->get_symbolspec($opts{template_mode}) . "\n" if defined wantarray;
345            # Dump pattern matches as comments (if requested)
346
41688
55934
            if ($opts{with_pattern_matches} && $sym->is_pattern()) {
347
0
0
0
0
                for my $match (sort { $a->get_symboltempl() cmp
348                                      $b->get_symboltempl() } $sym->get_pattern_matches())
349                {
350
0
0
0
0
                    print { $fh } '#MATCH:', $match->get_symbolspec(0), "\n" if defined $fh;
351
0
0
                    $res .= '#MATCH:' . $match->get_symbolspec(0) . "\n" if defined wantarray;
352                }
353            }
354        }
355    }
356
90
1104
    return $res;
357}
358
359# Tries to match a symbol name and/or version against the patterns defined.
360# Returns a pattern which matches (if any).
361sub find_matching_pattern {
362
28896
0
25722
    my ($self, $refsym, $sonames, $inc_deprecated) = @_;
363
28896
25812
    $inc_deprecated //= 0;
364
28896
25982
    my $name = (ref $refsym) ? $refsym->get_symbolname() : $refsym;
365
366    my $pattern_ok = sub {
367
1017
1030
        my $p = shift;
368
1017
4952
        return defined $p && ($inc_deprecated || !$p->{deprecated}) &&
369               $p->arch_is_concerned($self->get_arch());
370
28896
58016
    };
371
372
28896
33236
    foreach my $soname ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) {
373
28896
25388
        my $obj = $self->get_object($soname);
374
28896
21276
        my ($type, $pattern);
375
28896
26279
        next unless defined $obj;
376
377
28896
23260
        my $all_aliases = $obj->{patterns}{aliases};
378
28896
32388
        for my $type (Dpkg::Shlibs::Symbol::ALIAS_TYPES) {
379
57669
1635
64527
4232
            if (exists $all_aliases->{$type} && keys(%{$all_aliases->{$type}})) {
380
1635
1574
                my $aliases = $all_aliases->{$type};
381
1635
3346
                my $converter = $aliases->{(keys %$aliases)[0]};
382
1635
3235
                if (my $alias = $converter->convert_to_alias($name)) {
383
1632
6845
                    if ($alias && exists $aliases->{$alias}) {
384
216
301
                        $pattern = $aliases->{$alias};
385
216
401
                        last if $pattern_ok->($pattern);
386
0
0
                        $pattern = undef; # otherwise not found yet
387                    }
388                }
389            }
390        }
391
392        # Now try generic patterns and use the first that matches
393
28893
26063
        if (not defined $pattern) {
394
28677
28677
18079
28686
            for my $p (@{$obj->{patterns}{generic}}) {
395
801
1227
                if ($pattern_ok->($p) && $p->matches_rawname($name)) {
396
369
460
                    $pattern = $p;
397
369
461
                    last;
398                }
399            }
400        }
401
28893
30868
        if (defined $pattern) {
402
585
2583
            return (wantarray) ?
403                ( symbol => $pattern, soname => $soname ) : $pattern;
404        }
405    }
406
28308
50252
    return;
407}
408
409# merge_symbols($object, $minver)
410# Needs $Objdump->get_object($soname) as parameter
411# Do not merge symbols found in the list of (arch-specific) internal symbols.
412sub merge_symbols {
413
99
0
211
    my ($self, $object, $minver) = @_;
414
415
99
180
    my $soname = $object->{SONAME};
416
99
149
    error(g_('cannot merge symbols from objects without SONAME'))
417        unless $soname;
418
419
99
147
    my %include_groups = ();
420
99
277
    my $groups = $self->get_field($soname, 'Allow-Internal-Symbol-Groups');
421
99
184
    if (not defined $groups) {
422
93
118
        $groups = $self->get_field($soname, 'Ignore-Blacklist-Groups');
423
93
205
        if (defined $groups) {
424
0
0
            warnings::warnif('deprecated',
425                'symbols file field "Ignore-Blacklist-Groups" is deprecated, ' .
426                'use "Allow-Internal-Symbol-Groups" instead');
427        }
428    }
429
99
166
    if (defined $groups) {
430
6
16
        $include_groups{$_} = 1 foreach (split ' ', $groups);
431    }
432
433
99
118
    my %dynsyms;
434
99
325
    foreach my $sym ($object->get_exported_dynamic_symbols()) {
435        my $name = $sym->{name} . '@' .
436
54618
101962
                   ($sym->{version} ? $sym->{version} : 'Base');
437
54618
50656
        my $symobj = $self->lookup_symbol($name, $soname);
438
54618
51752
        if (symbol_is_internal($sym->{name}, \%include_groups)) {
439
345
492
            next unless defined $symobj;
440
441
48
72
            if ($symobj->has_tag('allow-internal')) {
442                # Allow the symbol.
443            } elsif ($symobj->has_tag('ignore-blacklist')) {
444                # Allow the symbol and warn.
445
0
0
                warnings::warnif('deprecated',
446                    'symbol tag "ignore-blacklist" is deprecated, ' .
447                    'use "allow-internal" instead');
448            } else {
449                # Ignore the symbol.
450
24
30
                next;
451            }
452        }
453
54297
64914
        $dynsyms{$name} = $sym;
454    }
455
456
99
3243
    unless ($self->has_object($soname)) {
457
12
36
        $self->create_object($soname, '');
458    }
459    # Scan all symbols provided by the objects
460
99
213
    my $obj = $self->get_object($soname);
461    # invalidate the minimum version cache - it is not sufficient to
462    # invalidate in add_symbol, since we might change a minimum
463    # version for a particular symbol without adding it
464
99
235
    $obj->{minver_cache} = [];
465
99
8154
    foreach my $name (keys %dynsyms) {
466
54089
38298
        my $sym;
467
54089
69433
        if ($sym = $self->lookup_symbol($name, $obj, 1)) {
468            # If the symbol is already listed in the file
469
26501
38595
            $sym->mark_found_in_library($minver, $self->get_arch());
470        } else {
471            # The exact symbol is not present in the file, but it might match a
472            # pattern.
473
27588
27649
            my $pattern = $self->find_matching_pattern($name, $obj, 1);
474
27585
24503
            if (defined $pattern) {
475
585
986
                $pattern->mark_found_in_library($minver, $self->get_arch());
476
585
1502
                $sym = $pattern->create_pattern_match(symbol => $name);
477            } else {
478                # Symbol without any special info as no pattern matched
479
27000
33806
                $sym = Dpkg::Shlibs::Symbol->new(symbol => $name,
480                                                 minver => $minver);
481            }
482
27585
30188
            $self->add_symbol($sym, $obj);
483        }
484    }
485
486    # Process all symbols which could not be found in the library.
487
96
4957
    foreach my $sym ($self->get_symbols($soname)) {
488
54573
51765
        if (not exists $dynsyms{$sym->get_symbolname()}) {
489
498
780
            $sym->mark_not_found_in_library($minver, $self->get_arch());
490        }
491    }
492
493    # Deprecate patterns which didn't match anything
494
96
132
2866
174
    for my $pattern (grep { $_->get_pattern_matches() == 0 }
495                          $self->get_patterns($soname)) {
496
12
33
        $pattern->mark_not_found_in_library($minver, $self->get_arch());
497    }
498}
499
500sub is_empty {
501
0
0
0
    my $self = shift;
502
0
0
0
0
    return scalar(keys %{$self->{objects}}) ? 0 : 1;
503}
504
505sub has_object {
506
168
0
310
    my ($self, $soname) = @_;
507
168
538
    return exists $self->{objects}{$soname};
508}
509
510sub get_object {
511
210116
0
169655
    my ($self, $soname) = @_;
512
210116
262291
    return ref($soname) ? $soname : $self->{objects}{$soname};
513}
514
515sub create_object {
516
129
0
278
    my ($self, $soname, @deps) = @_;
517
129
1069
    $self->{objects}{$soname} = {
518        syms => {},
519        fields => {},
520        patterns => {
521            aliases => {},
522            generic => [],
523        },
524        deps => [ @deps ],
525        minver_cache => []
526    };
527}
528
529sub get_dependency {
530
0
0
0
    my ($self, $soname, $dep_id) = @_;
531
0
0
    $dep_id //= 0;
532
0
0
    return $self->get_object($soname)->{deps}[$dep_id];
533}
534
535sub get_smallest_version {
536
12
0
26
    my ($self, $soname, $dep_id) = @_;
537
12
76
    $dep_id //= 0;
538
12
30
    my $so_object = $self->get_object($soname);
539    return $so_object->{minver_cache}[$dep_id]
540
12
36
        if defined $so_object->{minver_cache}[$dep_id];
541
12
18
    my $minver;
542
12
34
    foreach my $sym ($self->get_symbols($so_object)) {
543
48
124
        next if $dep_id != $sym->{dep_id};
544
42
128
        $minver //= $sym->{minver};
545
42
110
        if (version_compare($minver, $sym->{minver}) > 0) {
546
12
48
            $minver = $sym->{minver};
547        }
548    }
549
12
36
    $so_object->{minver_cache}[$dep_id] = $minver;
550
12
48
    return $minver;
551}
552
553sub get_dependencies {
554
90
0
122
    my ($self, $soname) = @_;
555
90
90
74
166
    return @{$self->get_object($soname)->{deps}};
556}
557
558sub get_field {
559
192
0
269
    my ($self, $soname, $name) = @_;
560
192
264
    if (my $obj = $self->get_object($soname)) {
561
168
1073
        if (exists $obj->{fields}{$name}) {
562
6
10
            return $obj->{fields}{$name};
563        }
564    }
565
186
221
    return;
566}
567
568# Tries to find a symbol like the $refsym and returns its descriptor.
569# $refsym may also be a symbol name.
570sub lookup_symbol {
571
136823
0
146113
    my ($self, $refsym, $sonames, $inc_deprecated) = @_;
572
136823
194109
    $inc_deprecated //= 0;
573
136823
133876
    my $name = (ref $refsym) ? $refsym->get_symbolname() : $refsym;
574
575
136823
142793
    foreach my $so ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) {
576
136823
127191
        if (my $obj = $self->get_object($so)) {
577
111083
118188
            my $sym = $obj->{syms}{$name};
578
111083
239405
            if ($sym and ($inc_deprecated or not $sym->{deprecated}))
579            {
580
79784
106957
                return (wantarray) ?
581                    ( symbol => $sym, soname => $so ) : $sym;
582            }
583        }
584    }
585
57039
49409
    return;
586}
587
588# Tries to find a pattern like the $refpat and returns its descriptor.
589# $refpat may also be a pattern spec.
590sub lookup_pattern {
591
264
0
344
    my ($self, $refpat, $sonames, $inc_deprecated) = @_;
592
264
380
    $inc_deprecated //= 0;
593    # If $refsym is a string, we need to create a dummy ref symbol.
594
264
345
    $refpat = $self->create_symbol($refpat, dummy => 1) if ! ref($refpat);
595
596
264
576
    if ($refpat && $refpat->is_pattern()) {
597
264
374
        foreach my $soname ((ref($sonames) eq 'ARRAY') ? @$sonames : $sonames) {
598
264
326
            if (my $obj = $self->get_object($soname)) {
599
264
221
                my $pat;
600
264
337
                if (my $type = $refpat->get_alias_type()) {
601
123
233
                    if (exists $obj->{patterns}{aliases}{$type}) {
602
123
206
                        $pat = $obj->{patterns}{aliases}{$type}{$refpat->get_symbolname()};
603                    }
604                } elsif ($refpat->get_pattern_type() eq 'generic') {
605
141
141
118
217
                    for my $p (@{$obj->{patterns}{generic}}) {
606
360
955
                        if (($inc_deprecated || !$p->{deprecated}) &&
607                            $p->equals($refpat, versioning => 0))
608                        {
609
141
119
                            $pat = $p;
610
141
141
                            last;
611                        }
612                    }
613                }
614
264
910
                if ($pat && ($inc_deprecated || !$pat->{deprecated})) {
615
258
620
                    return (wantarray) ?
616                        (symbol => $pat, soname => $soname) : $pat;
617                }
618            }
619        }
620    }
621
6
10
    return;
622}
623
624# Get symbol object reference either by symbol name or by a reference object.
625sub get_symbol_object {
626
0
0
0
    my ($self, $refsym, $soname) = @_;
627
0
0
    my $sym = $self->lookup_symbol($refsym, $soname, 1);
628
0
0
    if (! defined $sym) {
629
0
0
        $sym = $self->lookup_pattern($refsym, $soname, 1);
630    }
631
0
0
    return $sym;
632}
633
634sub get_new_symbols {
635
63
0
151
    my ($self, $ref, %opts) = @_;
636    my $with_optional = (exists $opts{with_optional}) ?
637
63
190
        $opts{with_optional} : 0;
638
63
83
    my @res;
639
63
131
    foreach my $soname ($self->get_sonames()) {
640
63
144
        next if not $ref->has_object($soname);
641
642        # Scan raw symbols first.
643
63
28455
129
47178
        foreach my $sym (grep { ($with_optional || ! $_->is_optional())
644                                && $_->is_legitimate($self->get_arch()) }
645                              $self->get_symbols($soname))
646        {
647
27903
27940
            my $refsym = $ref->lookup_symbol($sym, $soname, 1);
648
27903
18214
            my $isnew;
649
27903
20809
            if (defined $refsym) {
650                # If the symbol exists in the $ref symbol file, it might
651                # still be new if $refsym is not legitimate.
652
26469
25273
                $isnew = not $refsym->is_legitimate($self->get_arch());
653            } else {
654                # If the symbol does not exist in the $ref symbol file, it does
655                # not mean that it's new. It might still match a pattern in the
656                # symbol file. However, due to performance reasons, first check
657                # if the pattern that the symbol matches (if any) exists in the
658                # ref symbol file as well.
659
1434
1789
                $isnew = not (
660                    ($sym->get_pattern() and $ref->lookup_pattern($sym->get_pattern(), $soname, 1)) or
661                    $ref->find_matching_pattern($sym, $soname, 1)
662                );
663            }
664
27903
36683
            push @res, { symbol => $sym, soname => $soname } if $isnew;
665        }
666
667        # Now scan patterns
668
63
147
2848
346
        foreach my $p (grep { ($with_optional || ! $_->is_optional())
669                              && $_->is_legitimate($self->get_arch()) }
670                            $self->get_patterns($soname))
671        {
672
105
178
            my $refpat = $ref->lookup_pattern($p, $soname, 0);
673            # If reference pattern was not found or it is not legitimate,
674            # considering current one as new.
675
105
260
            if (not defined $refpat or
676                not $refpat->is_legitimate($self->get_arch()))
677            {
678
6
25
                push @res, { symbol => $p , soname => $soname };
679            }
680        }
681    }
682
63
1082
    return @res;
683}
684
685sub get_lost_symbols {
686
39
0
102
    my ($self, $ref, %opts) = @_;
687
39
138
    return $ref->get_new_symbols($self, %opts);
688}
689
690
691sub get_new_libs {
692
0
0
    my ($self, $ref) = @_;
693
0
    my @res;
694
0
    foreach my $soname ($self->get_sonames()) {
695
0
        push @res, $soname if not $ref->get_object($soname);
696    }
697
0
    return @res;
698}
699
700sub get_lost_libs {
701
0
0
    my ($self, $ref) = @_;
702
0
    return $ref->get_new_libs($self);
703}
704
705 - 711
=head1 CHANGES

=head2 Version 0.xx

This is a private module.

=cut
712
7131;