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