1# ex:ts=8 sw=4:
2# $OpenBSD: SharedLibs.pm,v 1.40 2009/11/29 10:32:58 espie Exp $
3#
4# Copyright (c) 2003-2005 Marc Espie <espie@openbsd.org>
5#
6# Permission to use, copy, modify, and distribute this software for any
7# purpose with or without fee is hereby granted, provided that the above
8# copyright notice and this permission notice appear in all copies.
9#
10# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
11# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
12# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
13# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
14# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
15# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
16# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
17
18use strict;
19use warnings;
20
21use OpenBSD::Paths;
22package OpenBSD::PackingElement;
23
24sub mark_available_lib
25{
26}
27
28package OpenBSD::PackingElement::Lib;
29
30sub mark_available_lib
31{
32	my ($self, $pkgname) = @_;
33	OpenBSD::SharedLibs::register_lib($self->fullname, $pkgname);
34}
35
36package OpenBSD::SharedLibs;
37use File::Basename;
38use OpenBSD::Error;
39
40my $path;
41my @ldconfig = (OpenBSD::Paths->ldconfig);
42
43
44sub init_path($)
45{
46	my $destdir = shift;
47	$path={};
48	if ($destdir ne '') {
49		unshift @ldconfig, OpenBSD::Paths->chroot, $destdir;
50	}
51	open my $fh, "-|", @ldconfig, "-r";
52	if (defined $fh) {
53		my $_;
54		while (<$fh>) {
55			if (m/^\s*search directories:\s*(.*?)\s*$/o) {
56				for my $d (split(/\:/o, $1)) {
57					$path->{$d} = 1;
58				}
59				last;
60			}
61		}
62		close($fh);
63	} else {
64		print STDERR "Can't find ldconfig\n";
65	}
66}
67
68sub mark_ldconfig_directory
69{
70	my ($name, $destdir) = @_;
71	if (!defined $path) {
72		init_path($destdir);
73	}
74	my $d = dirname($name);
75	if ($path->{$d}) {
76		$OpenBSD::PackingElement::Lib::todo = 1;
77	}
78}
79
80sub ensure_ldconfig
81{
82	my $state = shift;
83	$state->vsystem(@ldconfig, "-R") unless $state->{not};
84	$OpenBSD::PackingElement::Lib::todo = 0;
85}
86
87our $registered_libs = {};
88
89sub register_lib
90{
91	my ($name, $pkgname) = @_;
92	my ($stem, $major, $minor, $dir) =
93	    OpenBSD::PackingElement::Lib->parse($name);
94	if (defined $stem) {
95		push(@{$registered_libs->{$stem}->{$dir}->{$major}},
96		    [$minor, $pkgname]);
97	}
98}
99
100my $done_plist = {};
101
102sub system_dirs
103{
104	return OpenBSD::Paths->library_dirs;
105}
106
107sub add_libs_from_system
108{
109	my ($destdir) = @_;
110	return if $done_plist->{'system'};
111	$done_plist->{'system'} = 1;
112	for my $dirname (system_dirs()) {
113		opendir(my $dir, $destdir.$dirname."/lib") or next;
114		while (my $d = readdir($dir)) {
115			register_lib("$dirname/lib/$d", 'system');
116		}
117		closedir($dir);
118	}
119}
120
121sub add_libs_from_installed_package
122{
123	my $pkgname = shift;
124	return if $done_plist->{$pkgname};
125	$done_plist->{$pkgname} = 1;
126	my $plist = OpenBSD::PackingList->from_installation($pkgname,
127	    \&OpenBSD::PackingList::LibraryOnly);
128	return if !defined $plist;
129
130	$plist->mark_available_lib($pkgname);
131}
132
133sub add_libs_from_plist
134{
135	my $plist = shift;
136	my $pkgname = $plist->pkgname;
137	return if $done_plist->{$pkgname};
138	$done_plist->{$pkgname} = 1;
139	$plist->mark_available_lib($pkgname);
140}
141
142sub normalize_dir_and_spec
143{
144	my ($base, $libspec) = @_;
145	if ($libspec =~ m/^(.*)\/([^\/]+)$/o) {
146		return ("$base/$1", $2);
147	} else {
148		return ("$base/lib", $libspec);
149	}
150}
151
152sub parse_spec
153{
154	my $spec = shift;
155	if ($spec =~ m/^(.*)\.(\d+)\.(\d+)$/o) {
156		return ($1, $2, $3);
157	} else {
158		return undef;
159	}
160}
161
162sub lookup_libspec
163{
164	my ($dir, $spec) = normalize_dir_and_spec(@_);
165	my @r = ();
166	my ($libname, $major, $minor) = parse_spec($spec);
167	if (defined $libname) {
168		my $exists = $registered_libs->{$libname}->{$dir}->{$major};
169		if (defined $exists) {
170			for my $e (@$exists) {
171				if ($e->[0] >= $minor) {
172					push(@r, $e->[1]);
173				}
174			}
175		}
176	}
177	return @r;
178}
179
180sub entry_string
181{
182	my ($stem, $M, $m) = @_;
183	return "lib$stem.so.$M.$m";
184}
185
186sub why_is_this_bad
187{
188	my ($base, $name, $d1, $d2, $M1, $M2, $m1, $m2, $pkgname) = @_;
189	if ($d1 ne $d2 && !($pkgname eq 'system' && $d1 eq "$base/lib")) {
190		return "bad directory";
191	}
192	if ($M1 != $M2) {
193		return "bad major";
194	}
195	if ($m1 > $m2) {
196		return "minor not large enough";
197	}
198	return "$pkgname not reachable";
199}
200
201my $printed = {};
202
203sub report_problem
204{
205	my ($state, $p) = @_;
206	my $base = $state->{localbase};
207	my ($dir, $name) = normalize_dir_and_spec($base, $p);
208	my ($stem, $major, $minor) = parse_spec($name);
209
210	return unless defined $stem;
211	return unless defined $registered_libs->{$stem};
212
213	my $r = "";
214	while (my ($d, $v) = each %{$registered_libs->{$stem}}) {
215		my @l = ();
216		while (my ($M, $w) = each %$v) {
217			for my $e (@$w) {
218				push(@l, entry_string($stem, $M, $e->[0]).
219				    " (".why_is_this_bad($base, $name, $dir,
220				    $d, $major, $M, $minor, $e->[0], $e->[1]).
221				    ")");
222			}
223		}
224		if (@l > 0) {
225			$r .= "| in $d: ". join(", ", sort @l). "\n";
226		}
227	}
228	if (!defined $printed->{$name} || $printed->{$name} ne $r) {
229		$printed->{$name} = $r;
230		$state->errsay("|library $name not found");
231		$state->print($r);
232	}
233}
234
2351;
236