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