OLD | NEW |
| (Empty) |
1 # Copyright © 2007 Raphaël Hertzog <hertzog@debian.org> | |
2 # | |
3 # This program is free software; you can redistribute it and/or modify | |
4 # it under the terms of the GNU General Public License as published by | |
5 # the Free Software Foundation; either version 2 of the License, or | |
6 # (at your option) any later version. | |
7 # | |
8 # This program is distributed in the hope that it will be useful, | |
9 # but WITHOUT ANY WARRANTY; without even the implied warranty of | |
10 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
11 # GNU General Public License for more details. | |
12 # | |
13 # You should have received a copy of the GNU General Public License | |
14 # along with this program. If not, see <https://www.gnu.org/licenses/>. | |
15 | |
16 package Dpkg::Shlibs; | |
17 | |
18 use strict; | |
19 use warnings; | |
20 | |
21 our $VERSION = '0.02'; | |
22 | |
23 use Exporter qw(import); | |
24 our @EXPORT_OK = qw(add_library_dir get_library_paths reset_library_paths | |
25 find_library); | |
26 | |
27 | |
28 use File::Spec; | |
29 | |
30 use Dpkg::Gettext; | |
31 use Dpkg::ErrorHandling; | |
32 use Dpkg::Shlibs::Objdump; | |
33 use Dpkg::Util qw(:list); | |
34 use Dpkg::Path qw(resolve_symlink canonpath); | |
35 use Dpkg::Arch qw(debarch_to_gnutriplet get_build_arch get_host_arch | |
36 gnutriplet_to_multiarch debarch_to_multiarch); | |
37 | |
38 use constant DEFAULT_LIBRARY_PATH => | |
39 qw(/lib /usr/lib /lib32 /usr/lib32 /lib64 /usr/lib64 | |
40 /emul/ia32-linux/lib /emul/ia32-linux/usr/lib); | |
41 | |
42 # Adjust set of directories to consider when we're in a situation of a | |
43 # cross-build or a build of a cross-compiler | |
44 my @crosslibrarypaths; | |
45 my ($crossprefix, $multiarch); | |
46 # Detect cross compiler builds | |
47 if ($ENV{GCC_TARGET}) { | |
48 $crossprefix = debarch_to_gnutriplet($ENV{GCC_TARGET}); | |
49 $multiarch = debarch_to_multiarch($ENV{GCC_TARGET}); | |
50 } | |
51 if ($ENV{DEB_TARGET_GNU_TYPE} and | |
52 ($ENV{DEB_TARGET_GNU_TYPE} ne $ENV{DEB_BUILD_GNU_TYPE})) | |
53 { | |
54 $crossprefix = $ENV{DEB_TARGET_GNU_TYPE}; | |
55 $multiarch = gnutriplet_to_multiarch($ENV{DEB_TARGET_GNU_TYPE}); | |
56 } | |
57 # host for normal cross builds. | |
58 if (get_build_arch() ne get_host_arch()) { | |
59 $crossprefix = debarch_to_gnutriplet(get_host_arch()); | |
60 $multiarch = debarch_to_multiarch(get_host_arch()); | |
61 } | |
62 # Define list of directories containing crossbuilt libraries | |
63 if ($crossprefix) { | |
64 push @crosslibrarypaths, "/lib/$multiarch", "/usr/lib/$multiarch", | |
65 "/$crossprefix/lib", "/usr/$crossprefix/lib", | |
66 "/$crossprefix/lib32", "/usr/$crossprefix/lib32", | |
67 "/$crossprefix/lib64", "/usr/$crossprefix/lib64"; | |
68 } | |
69 | |
70 my @librarypaths = (DEFAULT_LIBRARY_PATH, @crosslibrarypaths); | |
71 | |
72 # XXX: Deprecated. Update library paths with LD_LIBRARY_PATH | |
73 if ($ENV{LD_LIBRARY_PATH}) { | |
74 foreach my $path (reverse split( /:/, $ENV{LD_LIBRARY_PATH} )) { | |
75 $path =~ s{/+$}{}; | |
76 add_library_dir($path); | |
77 } | |
78 } | |
79 | |
80 # Update library paths with ld.so config | |
81 parse_ldso_conf('/etc/ld.so.conf') if -e '/etc/ld.so.conf'; | |
82 | |
83 my %visited; | |
84 sub parse_ldso_conf { | |
85 my $file = shift; | |
86 open my $fh, '<', $file or syserr(_g('cannot open %s'), $file); | |
87 $visited{$file}++; | |
88 while (<$fh>) { | |
89 next if /^\s*$/; | |
90 chomp; | |
91 s{/+$}{}; | |
92 if (/^include\s+(\S.*\S)\s*$/) { | |
93 foreach my $include (glob($1)) { | |
94 parse_ldso_conf($include) if -e $include | |
95 && !$visited{$include}; | |
96 } | |
97 } elsif (m{^\s*/}) { | |
98 s/^\s+//; | |
99 my $libdir = $_; | |
100 if (none { $_ eq $libdir } @librarypaths) { | |
101 push @librarypaths, $libdir; | |
102 } | |
103 } | |
104 } | |
105 close $fh; | |
106 } | |
107 | |
108 sub add_library_dir { | |
109 my ($dir) = @_; | |
110 unshift @librarypaths, $dir; | |
111 } | |
112 | |
113 sub get_library_paths { | |
114 return @librarypaths; | |
115 } | |
116 | |
117 sub reset_library_paths { | |
118 @librarypaths = (); | |
119 } | |
120 | |
121 # find_library ($soname, \@rpath, $format, $root) | |
122 sub find_library { | |
123 my ($lib, $rpath, $format, $root) = @_; | |
124 $root //= ''; | |
125 $root =~ s{/+$}{}; | |
126 my @rpath = @{$rpath}; | |
127 foreach my $dir (@rpath, @librarypaths) { | |
128 my $checkdir = "$root$dir"; | |
129 # If the directory checked is a symlink, check if it doesn't | |
130 # resolve to another public directory (which is then the canonical | |
131 # directory to use instead of this one). Typical example | |
132 # is /usr/lib64 -> /usr/lib on amd64. | |
133 if (-l $checkdir) { | |
134 my $newdir = resolve_symlink($checkdir); | |
135 if (any { "$root$_" eq "$newdir" } (@rpath, @librarypaths)) { | |
136 $checkdir = $newdir; | |
137 } | |
138 } | |
139 if (-e "$checkdir/$lib") { | |
140 my $libformat = Dpkg::Shlibs::Objdump::get_format("$checkdir/$lib"); | |
141 if ($format eq $libformat) { | |
142 return canonpath("$checkdir/$lib"); | |
143 } | |
144 } | |
145 } | |
146 return; | |
147 } | |
148 | |
149 1; | |
OLD | NEW |