1# ex:ts=8 sw=4:
2# $OpenBSD: PackageInfo.pm,v 1.53 2010/12/29 13:03:05 espie Exp $
3#
4# Copyright (c) 2003-2007 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
21package OpenBSD::PackageInfo;
22require Exporter;
23our @ISA=qw(Exporter);
24our @EXPORT=qw(installed_packages installed_info installed_name info_names is_info_name installed_stems
25    lock_db unlock_db
26    add_installed delete_installed is_installed borked_package CONTENTS COMMENT DESC INSTALL DEINSTALL REQUIRE
27    REQUIRED_BY REQUIRING DISPLAY UNDISPLAY MTREE_DIRS);
28
29use OpenBSD::PackageName;
30use OpenBSD::Paths;
31use constant {
32	CONTENTS => '+CONTENTS',
33	COMMENT => '+COMMENT',
34	DESC => '+DESC',
35	INSTALL => '+INSTALL',
36	DEINSTALL => '+DEINSTALL',
37	REQUIRE => '+REQUIRE',
38	REQUIRED_BY => '+REQUIRED_BY',
39	REQUIRING => '+REQUIRING',
40	DISPLAY => '+DISPLAY',
41	UNDISPLAY => '+UNDISPLAY',
42	MTREE_DIRS => '+MTREE_DIRS' };
43
44use Fcntl qw/:flock/;
45my $pkg_db = $ENV{"PKG_DBDIR"} || OpenBSD::Paths->pkgdb;
46
47my ($list, $stemlist);
48
49our @info = (CONTENTS, COMMENT, DESC, REQUIRE, INSTALL, DEINSTALL, REQUIRED_BY, REQUIRING, DISPLAY, UNDISPLAY, MTREE_DIRS);
50
51our %info = ();
52for my $i (@info) {
53	my $j = $i;
54	$j =~ s/\+/F/o;
55	$info{$i} = $j;
56}
57
58sub _init_list
59{
60	$list = {};
61	$stemlist = OpenBSD::PackageName::compile_stemlist();
62
63	opendir(my $dir, $pkg_db) or die "Bad pkg_db: $!";
64	while (my $e = readdir($dir)) {
65		next if $e eq '.' or $e eq '..';
66		add_installed($e);
67	}
68	close($dir);
69}
70
71sub add_installed
72{
73	if (!defined $list) {
74		_init_list();
75	}
76	for my $p (@_) {
77		$list->{$p} = 1;
78		$stemlist->add($p);
79	}
80}
81
82sub delete_installed
83{
84	if (!defined $list) {
85		_init_list();
86	}
87	for my $p (@_) {
88		delete $list->{$p};
89		$stemlist->delete($p);
90
91	}
92}
93
94sub installed_stems
95{
96	if (!defined $list) {
97		_init_list();
98	}
99	return $stemlist;
100}
101
102sub installed_packages
103{
104	if (!defined $list) {
105		_init_list();
106	}
107	if ($_[0]) {
108		return grep { !/^\./o } keys %$list;
109	} else {
110		return keys %$list;
111	}
112}
113
114sub installed_info
115{
116	my $name =  shift;
117
118	# XXX remove the o if we allow pkg_db to change dynamically
119	if ($name =~ m|^\Q$pkg_db\E/?|o) {
120		return "$name/";
121	} else {
122		return "$pkg_db/$name/";
123	}
124}
125
126sub installed_contents
127{
128	return installed_info(shift).CONTENTS;
129}
130
131sub borked_package
132{
133	my $pkgname = shift;
134	$pkgname = "partial-$pkgname" unless $pkgname =~ m/^partial\-/;
135	unless (-e "$pkg_db/$pkgname") {
136		return $pkgname;
137	}
138	my $i = 1;
139
140	while (-e "$pkg_db/$pkgname.$i") {
141		$i++;
142	}
143	return "$pkgname.$i";
144}
145
146sub libs_package
147{
148	my $pkgname = shift;
149	$pkgname =~ s/^\.libs\d*\-//;
150	unless (-e "$pkg_db/.libs-$pkgname") {
151		return ".libs-$pkgname";
152	}
153	my $i = 1;
154
155	while (-e "$pkg_db/.libs$i-$pkgname") {
156		$i++;
157	}
158	return ".libs$i-$pkgname";
159}
160
161sub is_installed
162{
163	my $name = installed_name(shift);
164	if (!defined $list) {
165		installed_packages();
166	}
167	return defined $list->{$name};
168}
169
170sub installed_name
171{
172	require File::Spec;
173	my $name = File::Spec->canonpath(shift);
174	$name =~ s|/$||o;
175	# XXX remove the o if we allow pkg_db to change dynamically
176	$name =~ s|^\Q$pkg_db\E/?||o;
177	$name =~ s|/\+CONTENTS$||o;
178	return $name;
179}
180
181sub info_names()
182{
183	return @info;
184}
185
186sub is_info_name
187{
188	my $name = shift;
189	return $info{$name};
190}
191
192my $dlock;
193
194sub lock_db($;$)
195{
196	my ($shared, $state) = @_;
197	my $mode = $shared ? LOCK_SH : LOCK_EX;
198	open($dlock, '<', $pkg_db) or return;
199	if (flock($dlock, $mode | LOCK_NB)) {
200		return;
201	}
202	$state->errprint("Package database already locked... awaiting release... ")
203		if defined $state;
204	while (!flock($dlock, $mode)) {
205	}
206	$state->errsay("done!") if defined $state;
207	return;
208}
209
210sub unlock_db()
211{
212	if (defined $dlock) {
213		flock($dlock, LOCK_UN);
214		close($dlock);
215	}
216}
217
218
219sub solve_installed_names
220{
221	my ($old, $new, $msg, $state) = @_;
222
223	my $bad = 0;
224	my $seen = {};
225
226	for my $pkgname (@$old) {
227	    $pkgname =~ s/\.tgz$//o;
228	    if (is_installed($pkgname)) {
229	    	if (!$seen->{$pkgname}) {
230		    $seen->{$pkgname} = 1;
231		    push(@$new, installed_name($pkgname));
232		}
233	    } else {
234		if (OpenBSD::PackageName::is_stem($pkgname)) {
235		    require OpenBSD::Search;
236
237		    my $r = $state->repo->installed->match_locations(OpenBSD::Search::Stem->new($pkgname));
238		    if (@$r == 0) {
239			print "Can't resolve $pkgname to an installed package name\n";
240			$bad = 1;
241		    } elsif (@$r == 1) {
242			if (!$seen->{$r->[0]}) {
243			    $seen->{$r->[0]} = 1;
244			    push(@$new, $r->[0]->name);
245			}
246		    } else {
247		    	# try to see if we already solved the ambiguity
248			my $found = 0;
249			for my $p (@$r) {
250			    if ($seen->{$p}) {
251				$found = 1;
252				last;
253			    }
254			}
255			next if $found;
256
257			if ($state->defines('ambiguous')) {
258			    my @l = map {$_->name} @$r;
259			    $state->say("Ambiguous: #1 could be #2",
260				$pkgname, join(' ', @l));
261			    $state->say($msg);
262			    push(@$new, @l);
263			    for my $p (@$r) {
264			    	$seen->{$p} = 1;
265			    }
266			} else {
267			    my $result = $state->choose_location($pkgname, $r);
268			    if (defined $result) {
269			    	push(@$new, $result->name);
270				$seen->{$result} = 1;
271			    } else {
272				$bad = 1;
273			    }
274			}
275		    }
276		}
277	    }
278    	}
279	return $bad;
280}
281
2821;
283