1# ex:ts=8 sw=4:
2# $OpenBSD: PackageInfo.pm,v 1.65 2023/06/13 09:07:17 espie Exp $
3#
4# Copyright (c) 2003-2014 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 v5.36;
19
20package OpenBSD::PackageInfo;
21require Exporter;
22our @ISA=qw(Exporter);
23our @EXPORT=qw(installed_packages installed_info installed_name info_names is_info_name installed_stems
24    lock_db unlock_db
25    add_installed delete_installed is_installed borked_package
26    CONTENTS DESC REQUIRED_BY REQUIRING DISPLAY UNDISPLAY);
27
28use OpenBSD::PackageName;
29use OpenBSD::Paths;
30use constant {
31	CONTENTS => '+CONTENTS',
32	DESC => '+DESC',
33	REQUIRED_BY => '+REQUIRED_BY',
34	REQUIRING => '+REQUIRING',
35	DISPLAY => '+DISPLAY',
36	UNDISPLAY => '+UNDISPLAY'};
37
38use Fcntl qw/:flock/;
39my $pkg_db = $ENV{"PKG_DBDIR"} || OpenBSD::Paths->pkgdb;
40
41my ($list, $stemlist);
42
43our @info = (CONTENTS, DESC, REQUIRED_BY, REQUIRING, DISPLAY, UNDISPLAY);
44
45our %info = ();
46for my $i (@info) {
47	my $j = $i;
48	$j =~ s/\+/F/o;
49	$info{$i} = $j;
50}
51
52sub _init_list()
53{
54	$list = {};
55	$stemlist = OpenBSD::PackageName::compile_stemlist();
56
57	opendir(my $dir, $pkg_db) or die "Bad pkg_db: $!";
58	while (my $e = readdir($dir)) {
59		next if $e eq '.' or $e eq '..';
60		add_installed($e);
61	}
62	closedir($dir);
63}
64
65sub add_installed(@p)
66{
67	if (!defined $list) {
68		_init_list();
69	}
70	for my $p (@p) {
71		$list->{$p} = 1;
72		$stemlist->add($p);
73	}
74}
75
76sub delete_installed(@p)
77{
78	if (!defined $list) {
79		_init_list();
80	}
81	for my $p (@p) {
82		delete $list->{$p};
83		$stemlist->delete($p);
84
85	}
86}
87
88sub installed_stems()
89{
90	if (!defined $list) {
91		_init_list();
92	}
93	return $stemlist;
94}
95
96sub installed_packages($all = 0)
97{
98	if (!defined $list) {
99		_init_list();
100	}
101	if ($all) {
102		return grep { !/^\./o } keys %$list;
103	} else {
104		return keys %$list;
105	}
106}
107
108sub installed_info($name)
109{
110	# XXX remove the o if we allow pkg_db to change dynamically
111	if ($name =~ m|^\Q$pkg_db\E/?|o) {
112		return "$name/";
113	} else {
114		return "$pkg_db/$name/";
115	}
116}
117
118sub installed_contents($name)
119{
120	return installed_info($name).CONTENTS;
121}
122
123sub borked_package($pkgname)
124{
125	$pkgname = "partial-$pkgname" unless $pkgname =~ m/^partial\-/;
126	unless (-e "$pkg_db/$pkgname") {
127		return $pkgname;
128	}
129	my $i = 1;
130
131	while (-e "$pkg_db/$pkgname.$i") {
132		$i++;
133	}
134	return "$pkgname.$i";
135}
136
137sub libs_package($pkgname)
138{
139	$pkgname =~ s/^\.libs\d*\-//;
140	unless (-e "$pkg_db/.libs-$pkgname") {
141		return ".libs-$pkgname";
142	}
143	my $i = 1;
144
145	while (-e "$pkg_db/.libs$i-$pkgname") {
146		$i++;
147	}
148	return ".libs$i-$pkgname";
149}
150
151sub is_installed($p)
152{
153	my $name = installed_name($p);
154	if (!defined $list) {
155		installed_packages();
156	}
157	return defined $list->{$name};
158}
159
160sub installed_name($p)
161{
162	require File::Spec;
163	my $name = File::Spec->canonpath($p);
164	$name =~ s|/$||o;
165	# XXX remove the o if we allow pkg_db to change dynamically
166	$name =~ s|^\Q$pkg_db\E/?||o;
167	$name =~ s|/\+CONTENTS$||o;
168	return $name;
169}
170
171sub info_names()
172{
173	return @info;
174}
175
176sub is_info_name($name)
177{
178	return $info{$name};
179}
180
181my $dlock;
182
183sub lock_db($shared = 0, $state = undef)
184{
185	my $mode = $shared ? LOCK_SH : LOCK_EX;
186	open($dlock, '<', $pkg_db) or return;
187	if (flock($dlock, $mode | LOCK_NB)) {
188		return;
189	}
190	if (!defined $state) {
191		require OpenBSD::BaseState;
192		$state = 'OpenBSD::BaseState';
193	}
194	$state->errprint("Package database already locked... awaiting release... ");
195	while (!flock($dlock, $mode)) {
196	}
197	$state->errsay("done!");
198	return;
199}
200
201sub unlock_db()
202{
203	if (defined $dlock) {
204		flock($dlock, LOCK_UN);
205		close($dlock);
206	}
207}
208
2091;
210