1# ex:ts=8 sw=4:
2# $OpenBSD: PackingList.pm,v 1.153 2023/11/23 09:44:08 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::PackingList::State;
21my $dot = '.';
22
23sub new($class)
24{
25	bless { default_owner=>'root',
26	     default_group=>'bin',
27	     default_mode=> 0444,
28	     owners => {},
29	     groups => {},
30	     cwd=>\$dot}, $class;
31}
32
33sub cwd($self)
34{
35	return ${$self->{cwd}};
36}
37
38sub set_cwd($self, $p)
39{
40	require File::Spec;
41
42	$p = File::Spec->canonpath($p);
43	$self->{cwd} = \$p;
44}
45
46package OpenBSD::PackingList::hashpath;
47sub match($h, $plist)
48{
49	my $f = $plist->fullpkgpath2;
50	if (!defined $f) {
51		return 0;
52	}
53	for my $i (@{$h->{$f->{dir}}}) {
54		if ($i->match($f)) {
55			return 1;
56		}
57	}
58	return 0;
59}
60
61sub partial_match($h, $subdir)
62{
63	for my $dir (keys %$h) {
64		return 1 if $dir =~ m/\b\Q$subdir\E\b/;
65	}
66	return 0;
67}
68
69package OpenBSD::Composite;
70
71# convert call to $self->sub(@args) into $self->visit(sub, @args)
72sub AUTOLOAD
73{
74	our $AUTOLOAD;
75	my $fullsub = $AUTOLOAD;
76	(my $sub = $fullsub) =~ s/.*:://o;
77	return if $sub eq 'DESTROY'; # special case
78	my $self = $_[0];
79	# verify it makes sense
80	if ($self->element_class->can($sub)) {
81		no strict "refs";
82		# create the sub to avoid regenerating further calls
83		*$fullsub = sub {
84			my $self = shift;
85			$self->visit($sub, @_);
86		};
87		# and jump to it
88		goto &$fullsub;
89	} else {
90		die "Can't call $sub on ".ref($self);
91	}
92}
93
94package OpenBSD::PackingList;
95our @ISA = qw(OpenBSD::Composite);
96
97use OpenBSD::PackingElement;
98use OpenBSD::PackageInfo;
99
100sub element_class($) { "OpenBSD::PackingElement" }
101
102sub new($class)
103{
104	my $plist = bless {state => OpenBSD::PackingList::State->new,
105		infodir => \(my $d)}, $class;
106	OpenBSD::PackingElement::File->add($plist, CONTENTS);
107	return $plist;
108}
109
110sub set_infodir($self, $dir)
111{
112	$dir .= '/' unless $dir =~ m/\/$/o;
113	${$self->{infodir}} = $dir;
114}
115
116sub make_shallow_copy($plist, $h)
117{
118	my $copy = ref($plist)->new;
119	$copy->set_infodir($plist->infodir);
120	$plist->copy_shallow_if($copy, $h);
121	return $copy;
122}
123
124sub make_deep_copy($plist, $h)
125{
126	my $copy = ref($plist)->new;
127	$copy->set_infodir($plist->infodir);
128	$plist->copy_deep_if($copy, $h);
129	return $copy;
130}
131
132sub infodir($self)
133{
134	return ${$self->{infodir}};
135}
136
137sub zap_wrong_annotations($self)
138{
139	my $pkgname = $self->pkgname;
140	if (defined $pkgname && $pkgname =~ m/^(?:\.libs\d*|partial)\-/) {
141		delete $self->{'manual-installation'};
142		delete $self->{'firmware'};
143		delete $self->{'digital-signature'};
144		delete $self->{'signer'};
145	}
146}
147
148sub conflict_list($self)
149{
150	require OpenBSD::PkgCfl;
151
152	return OpenBSD::PkgCfl->make_conflict_list($self);
153}
154
155sub read($a, $u, $code = \&defaultCode)
156{
157	$code //= \&defaultCode; # XXX callers may pass undef for now
158	my $plist;
159	if (ref $a) {
160		$plist = $a;
161	} else {
162		$plist = $a->new;
163	}
164	&$code($u,
165		sub($line) {
166			return if $line =~ m/^\s*$/o;
167			OpenBSD::PackingElement->create($line, $plist);
168		});
169	$plist->zap_wrong_annotations;
170	return $plist;
171}
172
173sub defaultCode($fh, $cont)
174{
175	while (<$fh>) {
176		&$cont($_);
177	}
178}
179
180sub SharedItemsOnly($fh, $cont)
181{
182	while (<$fh>) {
183		next unless m/^\@(?:cwd|dir|fontdir|ghost|mandir|newuser|newgroup|name)\b/o || m/^\@(?:sample|extra)\b.*\/$/o || m/^[^\@].*\/$/o;
184		&$cont($_);
185	}
186}
187
188sub UpdatePlistOnly($fh, $cont)
189{
190	while (<$fh>) {
191		next unless m/^\@(?:cwd|dir|fontdir|ghost|mandir|depend)\b/o || m/^\@(?:sample|extra)\b.*\/$/o || m/^[^\@].*\/$/o;
192		&$cont($_);
193	}
194}
195
196sub DirrmOnly	# forwarder
197{
198	&OpenBSD::PackingList::SharedItemsOnly;
199}
200
201sub LibraryOnly($fh, $cont)
202{
203	while (<$fh>) {
204		next unless m/^\@(?:cwd|lib|name|comment\s+subdir\=)\b/o;
205		&$cont($_);
206	}
207}
208
209sub FilesOnly($fh, $cont)
210{
211	while (<$fh>) {
212	    	next unless m/^\@(?:cwd|name|info|man|file|lib|shell|sample|bin|rcscript|so|static-lib)\b/o || !m/^\@/o;
213		&$cont($_);
214	}
215}
216
217sub PrelinkStuffOnly($fh, $cont)
218{
219	while (<$fh>) {
220		next unless m/^\@(?:cwd|bin|lib|name|define-tag|libset|depend|wantlib|comment\s+ubdir\=)\b/o;
221		&$cont($_);
222	}
223}
224
225sub DependOnly($fh, $cont)
226{
227	while (<$fh>) {
228		if (m/^\@(?:libset|depend|wantlib|define-tag)\b/o) {
229			&$cont($_);
230		# XXX optimization
231		} elsif (m/^\@(?:newgroup|newuser|cwd)\b/o) {
232			last;
233		}
234	}
235}
236
237sub ExtraInfoOnly($fh, $cont)
238{
239	while (<$fh>) {
240		if (m/^\@(?:name|pkgpath|comment\s+(?:subdir|pkgpath)\=|option)\b/o) {
241			&$cont($_);
242		# XXX optimization
243		} elsif (m/^\@(?:libset|depend|wantlib|newgroup|newuser|cwd)\b/o) {
244			last;
245		}
246	}
247}
248
249sub UpdateInfoOnly($fh, $cont)
250{
251	while (<$fh>) {
252		# if old alwaysupdate, all info is sig
253		# if new, we don't need the rest
254		if (m/^\@option\s+always-update$/o) {
255		    &$cont($_);
256		    while (<$fh>) {
257			    &$cont($_);
258		    }
259		    return;
260		}
261		if (m/^\@(?:name|libset|depend|wantlib|conflict|option|pkgpath|url|version|arch|comment\s+(?:subdir|pkgpath)\=)\b/o) {
262			&$cont($_);
263		# XXX optimization
264		} elsif (m/^\@(?:newgroup|newuser|cwd)\b/o) {
265			last;
266		}
267	}
268}
269
270sub ConflictOnly($fh, $cont)
271{
272	while (<$fh>) {
273		if (m/^\@(?:name|conflict|option)\b/o) {
274			&$cont($_);
275		# XXX optimization
276		} elsif (m/^\@(?:libset|depend|wantlib|newgroup|newuser|cwd)\b/o) {
277			last;
278		}
279	}
280}
281
282sub fromfile($a, $fname, $code = \&defaultCode)
283{
284	open(my $fh, '<', $fname) or return;
285	my $plist;
286	eval {
287		$plist = $a->read($fh, $code);
288	};
289	if ($@) {
290		chomp $@;
291		$@ =~ s/\.$/,/o;
292		die "$@ in $fname, ";
293	}
294	close($fh);
295	return $plist;
296}
297
298sub tofile($self, $fname)
299{
300	open(my $fh, '>', $fname) or return;
301	$self->zap_wrong_annotations;
302	$self->write($fh);
303	close($fh) or return;
304	return 1;
305}
306
307sub save($self)
308{
309	$self->tofile($self->infodir.CONTENTS);
310}
311
312sub add2list($plist, $object)
313{
314	my $category = $object->category;
315	push @{$plist->{$category}}, $object;
316}
317
318sub addunique($plist, $object)
319{
320	my $category = $object->category;
321	if (defined $plist->{$category}) {
322		die "Duplicate $category in plist ".($plist->pkgname // "?");
323	}
324	$plist->{$category} = $object;
325}
326
327sub has($plist, $name)
328{
329	return defined $plist->{$name};
330}
331
332sub get($plist, $name)
333{
334	return $plist->{$name};
335}
336
337sub set_pkgname($self, $name)
338{
339	if (defined $self->{name}) {
340		$self->{name}->set_name($name);
341	} else {
342		OpenBSD::PackingElement::Name->add($self, $name);
343	}
344}
345
346sub pkgname($self)
347{
348	if (defined $self->{name}) {
349		return $self->{name}->name;
350	} else {
351		return undef;
352	}
353}
354
355sub localbase($self)
356{
357	if (defined $self->{localbase}) {
358		return $self->{localbase}->name;
359	} else {
360		return '/usr/local';
361	}
362}
363
364sub is_signed($self)
365{
366	return defined $self->{'digital-signature'};
367}
368
369sub fullpkgpath($self)
370{
371	if (defined $self->{extrainfo} && $self->{extrainfo}{subdir} ne '') {
372		return $self->{extrainfo}{subdir};
373	} else {
374		return undef;
375	}
376}
377
378sub fullpkgpath2($self)
379{
380	if (defined $self->{extrainfo} && $self->{extrainfo}{subdir} ne '') {
381		return $self->{extrainfo}{path};
382	} else {
383		return undef;
384	}
385}
386
387sub pkgpath($self)
388{
389	if (!defined $self->{_hashpath}) {
390		my $h = $self->{_hashpath} =
391		    bless {}, "OpenBSD::PackingList::hashpath";
392		my $f = $self->fullpkgpath2;
393		if (defined $f) {
394			push(@{$h->{$f->{dir}}}, $f);
395		}
396		if (defined $self->{pkgpath}) {
397			for my $i (@{$self->{pkgpath}}) {
398				push(@{$h->{$i->{path}{dir}}}, $i->{path});
399			}
400		}
401	}
402	return $self->{_hashpath};
403}
404
405sub match_pkgpath($self, $plist2)
406{
407	return $self->pkgpath->match($plist2) ||
408	    $plist2->pkgpath->match($self);
409}
410
411our @unique_categories =
412    (qw(name url version signer digital-signature no-default-conflict manual-installation firmware always-update updatedb is-branch extrainfo localbase arch));
413
414our @list_categories =
415    (qw(conflict pkgpath ask-update libset depend
416    	wantlib define-tag groups users items));
417
418our @cache_categories =
419    (qw(libset depend wantlib));
420
421sub visit($self, $method, @l)
422{
423	if (defined $self->{cvstags}) {
424		for my $item (@{$self->{cvstags}}) {
425			$item->$method(@l) unless $item->{deleted};
426		}
427	}
428
429	# XXX unique and info files really get deleted, so there's no need
430	# to remove them later.
431	for my $unique_item (@unique_categories) {
432		$self->{$unique_item}->$method(@l)
433		    if defined $self->{$unique_item};
434	}
435
436	for my $special (OpenBSD::PackageInfo::info_names()) {
437		$self->{$special}->$method(@l) if defined $self->{$special};
438	}
439
440	for my $listname (@list_categories) {
441		if (defined $self->{$listname}) {
442			for my $item (@{$self->{$listname}}) {
443				$item->$method(@l) if !$item->{deleted};
444			}
445		}
446	}
447}
448
449my $plist_cache = {};
450
451sub from_installation($o, $pkgname, $code = \&defaultCode)
452{
453	require OpenBSD::PackageInfo;
454
455	$code //= \&defaultCode;
456	if ($code == \&DependOnly && defined $plist_cache->{$pkgname}) {
457	    return $plist_cache->{$pkgname};
458	}
459	my $filename = OpenBSD::PackageInfo::installed_contents($pkgname);
460	my $plist = $o->fromfile($filename, $code);
461	if (defined $plist && $code == \&DependOnly) {
462		$plist_cache->{$pkgname} = $plist;
463	}
464	if (defined $plist) {
465		$plist->set_infodir(OpenBSD::PackageInfo::installed_info($pkgname));
466	}
467	if (!defined $plist) {
468		print STDERR "Warning: couldn't read packing-list from installed package $pkgname\n";
469		unless (-e $filename) {
470			print STDERR "File $filename does not exist\n";
471		}
472	}
473	return $plist;
474}
475
476sub to_cache($self)
477{
478	return if defined $plist_cache->{$self->pkgname};
479	my $plist = OpenBSD::PackingList->new;
480	for my $c (@cache_categories) {
481		if (defined $self->{$c}) {
482			$plist->{$c} = $self->{$c};
483		}
484	}
485	$plist_cache->{$self->pkgname} = $plist;
486}
487
488sub to_installation($self)
489{
490	require OpenBSD::PackageInfo;
491
492	return if $main::not;
493
494	$self->tofile(OpenBSD::PackageInfo::installed_contents($self->pkgname));
495}
496
497sub signature($self)
498{
499	require OpenBSD::Signature;
500	return OpenBSD::Signature->from_plist($self);
501}
502
5031;
504