File Coverage

File:Dpkg/Shlibs.pm
Coverage:71.6%

linestmtbrancondsubpodtimecode
1# Copyright © 2007, 2016 Raphaël Hertzog <hertzog@debian.org>
2# Copyright © 2007-2008, 2012-2015 Guillem Jover <guillem@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;
18
19
2
2
2
2
4
2
24
use strict;
20
2
2
2
2
4
0
48
use warnings;
21
2
2
2
2
4
2
100
use feature qw(state);
22
23our $VERSION = '0.03';
24our @EXPORT_OK = qw(
25    blank_library_paths
26    setup_library_paths
27    get_library_paths
28    add_library_dir
29    find_library
30);
31
32
2
2
2
2
4
2
24
use Exporter qw(import);
33
2
2
2
2
4
2
50
use List::Util qw(none);
34
2
2
2
2
2
2
30
use File::Spec;
35
36
2
2
2
2
1064
0
50
use Dpkg::Gettext;
37
2
2
2
2
1140
2
62
use Dpkg::ErrorHandling;
38
2
2
2
2
1136
2
74
use Dpkg::Shlibs::Objdump;
39
2
2
2
2
8
2
66
use Dpkg::Path qw(resolve_symlink canonpath);
40
2
2
2
2
6
2
166
use Dpkg::Arch qw(get_build_arch get_host_arch :mappers);
41
42
2
70
use constant DEFAULT_LIBRARY_PATH =>
43
2
2
2
4
2
    qw(/lib /usr/lib);
44# XXX: Deprecated multilib paths.
45
2
1114
use constant DEFAULT_MULTILIB_PATH =>
46
2
2
2
4
0
    qw(/lib32 /usr/lib32 /lib64 /usr/lib64);
47
48# Library paths set by the user.
49my @custom_librarypaths;
50# Library paths from the system.
51my @system_librarypaths;
52my $librarypaths_init;
53
54sub parse_ldso_conf {
55
20
20
0
8
    my $file = shift;
56
20
14
    state %visited;
57
20
6
    local $_;
58
59
20
50
158
    open my $fh, '<', $file or syserr(g_('cannot open %s'), $file);
60
20
26
    $visited{$file}++;
61
20
76
    while (<$fh>) {
62
50
100
52
        next if /^\s*$/;
63
42
28
        chomp;
64
42
34
        s{/+$}{};
65
42
100
100
58
        if (/^include\s+(\S.*\S)\s*$/) {
66
10
140
            foreach my $include (glob($1)) {
67                parse_ldso_conf($include) if -e $include
68
18
100
67
76
                    && !$visited{$include};
69            }
70        } elsif (m{^\s*/}) {
71
22
12
            s/^\s+//;
72
22
12
            my $libdir = $_;
73
22
96
50
96
30
48
            if (none { $_ eq $libdir } (@custom_librarypaths, @system_librarypaths)) {
74
22
70
                push @system_librarypaths, $libdir;
75            }
76        }
77    }
78
20
62
    close $fh;
79}
80
81sub blank_library_paths {
82
2
2
0
0
    @custom_librarypaths = ();
83
2
2
    @system_librarypaths = ();
84
2
2
    $librarypaths_init = 1;
85}
86
87sub setup_library_paths {
88
2
2
0
2
    @custom_librarypaths = ();
89
2
2
    @system_librarypaths = ();
90
91    # XXX: Deprecated. Update library paths with LD_LIBRARY_PATH.
92
2
50
2
    if ($ENV{LD_LIBRARY_PATH}) {
93
2
4
        require Cwd;
94
2
10
        my $cwd = Cwd::getcwd;
95
96
2
2
        foreach my $path (split /:/, $ENV{LD_LIBRARY_PATH}) {
97
2
4
            $path =~ s{/+$}{};
98
99
2
28
            my $realpath = Cwd::realpath($path);
100
2
50
2
            next unless defined $realpath;
101
2
50
16
            if ($realpath =~ m/^\Q$cwd\E/) {
102
0
0
                warning(g_('deprecated use of LD_LIBRARY_PATH with private ' .
103                           'library directory which interferes with ' .
104                           'cross-building, please use -l option instead'));
105            }
106
107            # XXX: This should be added to @custom_librarypaths, but as this
108            # is deprecated we do not care as the code will go away.
109
2
2
            push @system_librarypaths, $path;
110        }
111    }
112
113    # Adjust set of directories to consider when we're in a situation of a
114    # cross-build or a build of a cross-compiler.
115
2
2
    my $multiarch;
116
117    # Detect cross compiler builds.
118
2
50
33
2
    if ($ENV{DEB_TARGET_GNU_TYPE} and
119        ($ENV{DEB_TARGET_GNU_TYPE} ne $ENV{DEB_BUILD_GNU_TYPE}))
120    {
121
0
0
        $multiarch = gnutriplet_to_multiarch($ENV{DEB_TARGET_GNU_TYPE});
122    }
123    # Host for normal cross builds.
124
2
50
4
    if (get_build_arch() ne get_host_arch()) {
125
0
0
        $multiarch = debarch_to_multiarch(get_host_arch());
126    }
127    # Define list of directories containing crossbuilt libraries.
128
2
50
2
    if ($multiarch) {
129
0
0
        push @system_librarypaths, "/lib/$multiarch", "/usr/lib/$multiarch";
130    }
131
132
2
0
    push @system_librarypaths, DEFAULT_LIBRARY_PATH;
133
134    # Update library paths with ld.so config.
135
2
50
12
    parse_ldso_conf('/etc/ld.so.conf') if -e '/etc/ld.so.conf';
136
137
2
4
    push @system_librarypaths, DEFAULT_MULTILIB_PATH;
138
139
2
2
    $librarypaths_init = 1;
140}
141
142sub add_library_dir {
143
4
4
0
0
    my $dir = shift;
144
145
4
100
6
    setup_library_paths() if not $librarypaths_init;
146
147
4
4
    push @custom_librarypaths, $dir;
148}
149
150sub get_library_paths {
151
6
50
6
0
6
    setup_library_paths() if not $librarypaths_init;
152
153
6
8
    return (@custom_librarypaths, @system_librarypaths);
154}
155
156# find_library ($soname, \@rpath, $format, $root)
157sub find_library {
158
0
0
0
    my ($lib, $rpath, $format, $root) = @_;
159
160
0
0
    setup_library_paths() if not $librarypaths_init;
161
162
0
0
    my @librarypaths = (@{$rpath}, @custom_librarypaths, @system_librarypaths);
163
0
    my @libs;
164
165
0
0
    $root //= '';
166
0
    $root =~ s{/+$}{};
167
0
    foreach my $dir (@librarypaths) {
168
0
        my $checkdir = "$root$dir";
169
0
0
        if (-e "$checkdir/$lib") {
170
0
            my $libformat = Dpkg::Shlibs::Objdump::get_format("$checkdir/$lib");
171
0
0
0
            if (not defined $libformat) {
172
0
                warning(g_("unknown executable format in file '%s'"), "$checkdir/$lib");
173            } elsif ($format eq $libformat) {
174
0
                push @libs, canonpath("$checkdir/$lib");
175            } else {
176
0
                debug(1, "Skipping lib $checkdir/$lib, libabi=0x%s != objabi=0x%s",
177                      unpack('H*', $libformat), unpack('H*', $format));
178            }
179        }
180    }
181
0
    return @libs;
182}
183
1841;