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