xref: /openbsd/usr.sbin/pkg_add/OpenBSD/PkgInfo.pm (revision 905646f0) 
1#! /usr/bin/perl
2# ex:ts=8 sw=4:
3# $OpenBSD: PkgInfo.pm,v 1.50 2020/02/19 14:23:26 espie Exp $
4#
5# Copyright (c) 2003-2014 Marc Espie <espie@openbsd.org>
6#
7# Permission to use, copy, modify, and distribute this software for any
8# purpose with or without fee is hereby granted, provided that the above
9# copyright notice and this permission notice appear in all copies.
10#
11# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
12# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
13# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
14# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
15# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
16# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
17# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.
18
19use strict;
20use warnings;
21
22use OpenBSD::State;
23
24package OpenBSD::PackingElement;
25sub dump_file
26{
27}
28
29sub hunt_file
30{
31}
32
33sub sum_up
34{
35	my ($self, $rsize) = @_;
36	if (defined $self->{size}) {
37		$$rsize += $self->{size};
38	}
39}
40
41package OpenBSD::PackingElement::FileBase;
42sub dump_file
43{
44	my ($item, $opt_K) = @_;
45	if ($opt_K) {
46		print '@', $item->keyword, " ";
47	}
48	print $item->fullname, "\n";
49}
50
51package OpenBSD::PackingElement::FileObject;
52sub hunt_file
53{
54	my ($item, $h, $pkgname, $l) = @_;
55	my $fname = $item->fullname;
56	if (defined $h->{$fname}) {
57		push(@{$h->{$fname}}, $pkgname);
58		push(@$l, $pkgname);
59	}
60}
61
62package OpenBSD::PkgInfo::State;
63our @ISA = qw(OpenBSD::State);
64
65use OpenBSD::PackageInfo;
66
67sub lock
68{
69	my $state = shift;
70	return if $state->{locked};
71	return if $state->{subst}->value('nolock');
72	lock_db(1, $state->opt('q') ? undef : $state);
73	$state->{locked} = 1;
74}
75
76sub banner
77{
78	my ($state, @args) = @_;
79	return if $state->opt('q');
80	$state->print("#1", $state->opt('l')) if $state->opt('l');
81	$state->say(@args);
82}
83
84sub header
85{
86	my ($state, $handle) = @_;
87	return if $state->{terse} || $state->opt('q');
88	my $url = $handle->url;
89	return if $state->{header_done}{$url};
90	$state->{header_done}{$url} = 1;
91	$state->banner("Information for #1\n", $url);
92}
93
94sub footer
95{
96	my ($state, $handle) = @_;
97	return if $state->opt('q') || $state->{terse};
98	return unless $state->{header_done}{$handle->url};
99	if ($state->opt('l')) {
100		$state->say("#1", $state->opt('l'));
101	} else {
102		$state->say;
103	}
104}
105
106sub printfile
107{
108	my ($state, $filename) = @_;
109
110	open my $fh, '<', $filename or return;
111	while(<$fh>) {
112		chomp;
113		$state->say("#1", $_);
114	}
115	close $fh;
116	$state->say;
117}
118
119sub printfile_sorted
120{
121	my ($state, $filename) = @_;
122
123	open my $fh, '<', $filename or return;
124	my @lines = (<$fh>);
125	close $fh;
126	foreach my $line (sort @lines) {
127		chomp $line;
128		$state->say("#1", $line);
129	}
130	$state->say;
131}
132
133sub print_description
134{
135	my ($state, $dir) = @_;
136
137	open my $fh, '<', $dir.DESC or return;
138	$_ = <$fh>; # zap COMMENT
139	while(<$fh>) {
140		chomp;
141		$state->say("#1", $_);
142	}
143	close $fh;
144	$state->say;
145}
146
147sub hasanyopt
148{
149	my ($self, $string) = @_;
150	for my $i (split //, $string) {
151		if ($self->opt($i)) {
152			return 1;
153		}
154	}
155	return 0;
156}
157
158sub setopts
159{
160	my ($self, $string) = @_;
161	for my $i (split //, $string) {
162		$self->{opt}{$i} = 1;
163	}
164}
165
166sub log
167{
168	my $self = shift;
169	if (@_ == 0) {
170		return $self;
171	} else {
172		$self->say(@_);
173	}
174}
175
176package OpenBSD::PkgInfo;
177use OpenBSD::PackageInfo;
178use OpenBSD::PackageName;
179use OpenBSD::Getopt;
180use OpenBSD::Error;
181
182
183my $total_size = 0;
184my $pkgs = 0;
185
186sub find_pkg_in
187{
188	my ($self, $state, $repo, $pkgname, $code) = @_;
189
190	if (OpenBSD::PackageName::is_stem($pkgname)) {
191		require OpenBSD::Search;
192		my $l = $repo->match_locations(OpenBSD::Search::Stem->new($pkgname));
193		if (@$l != 0) {
194			for my $pkg (sort {$a->name cmp $b->name} @$l) {
195				&$code($pkg->name, $pkg);
196				$pkg->close_now;
197				$pkg->wipe_info;
198			}
199			return 1;
200		}
201	}
202	# okay, so we're actually a spec in disguise
203	if ($pkgname =~ m/[\*\<\>\=]/) {
204		require OpenBSD::Search;
205		my $s = OpenBSD::Search::PkgSpec->new($pkgname);
206		if (!$s->is_valid) {
207			$state->errsay("Invalid spec: #1", $pkgname);
208			return 0;
209		}
210		my $r = $repo->match_locations($s);
211		if (@$r == 0) {
212			return 0;
213		} else {
214			for my $pkg (@$r) {
215				&$code($pkg->name, $pkg);
216				$pkg->close_now;
217				$pkg->wipe_info;
218			}
219			return 1;
220		}
221	} else {
222		my $pkg = $repo->find($pkgname);
223		if (defined $pkg) {
224			&$code($pkgname, $pkg);
225			$pkg->close_now;
226			$pkg->wipe_info;
227			return 1;
228		}
229		return 0;
230	}
231}
232
233sub find_pkg
234{
235	my ($self, $state, $pkgname, $code) = @_;
236
237	if ($self->find_pkg_in($state, $state->repo->installed, $pkgname,
238	    $code)) {
239		return 1;
240	}
241	my $repo;
242
243	if ($pkgname =~ m/[\/\:]/o) {
244		($repo, $pkgname) = $state->repo->path_parse($pkgname);
245	} else {
246		$repo = $state->repo;
247	}
248
249	return $self->find_pkg_in($state, $repo, $pkgname, $code);
250}
251
252sub get_line
253{
254	open my $fh, '<', shift or return "";
255	my $c = <$fh>;
256	chomp($c);
257	close $fh;
258	return $c;
259}
260
261sub get_comment
262{
263	my $d = shift;
264	return get_line($d.DESC);
265}
266
267sub find_by_spec
268{
269	my ($pat, $state) = @_;
270
271	require OpenBSD::Search;
272
273	my $s = OpenBSD::Search::PkgSpec->new($pat);
274	if (!$s->is_valid) {
275		$state->errsay("Invalid spec: #1", $pat);
276		return ();
277	} else {
278		my $r = $state->repo->installed->match_locations($s);
279
280		return sort {$a->name cmp $b->name} @$r;
281	}
282}
283
284sub filter_files
285{
286	my ($self, $state, $search, @args) = @_;
287	require OpenBSD::PackingList;
288
289	my @k = ();
290	for my $file (keys %$search) {
291		my $k = $file;
292		if ($file =~ m|^.*/(.*?)$|) {
293			$k = $1;
294		}
295		push(@k, quotemeta($k));
296	}
297	my $re = join('|', @k);
298
299	my @result = ();
300	for my $arg (@args) {
301		$self->find_pkg($state, $arg,
302		    sub {
303		    	my ($pkgname, $handle) = @_;
304
305			if (-f $handle->info.CONTENTS) {
306				my $maybe = 0;
307				open(my $fh, '<', $handle->info.CONTENTS);
308				while (<$fh>) {
309					if (m/$re/) {
310						$maybe = 1;
311						last;
312					}
313				}
314				close($fh);
315				return if !$maybe;
316			}
317			my $plist = $handle->plist(\&OpenBSD::PackingList::FilesOnly);
318
319			$plist->hunt_file($search, $pkgname, \@result);
320		    });
321	}
322	return @result;
323}
324
325sub manual_filter
326{
327	my ($self, $state, @args) = @_;
328	require OpenBSD::PackingList;
329
330	my @result = ();
331	for my $arg (@args) {
332		$self->find_pkg($state, $arg,
333		    sub {
334		    	my ($pkgname, $handle) = @_;
335
336			my $plist = $handle->plist(\&OpenBSD::PackingList::ConflictOnly);
337
338			push(@result, $pkgname) if $plist->has('manual-installation');
339		    });
340	}
341	return @result;
342}
343
344my $path_info;
345
346sub add_to_path_info
347{
348	my ($path, $pkgname) = @_;
349
350	push(@{$path_info->{$path}}, $pkgname);
351}
352
353sub find_by_path
354{
355	my $pat = shift;
356
357	if (!defined $path_info) {
358		require OpenBSD::PackingList;
359
360		$path_info = {};
361		for my $pkg (installed_packages(1)) {
362			my $plist =
363				OpenBSD::PackingList->from_installation($pkg,
364				    \&OpenBSD::PackingList::ExtraInfoOnly);
365			next if !defined $plist;
366			if (defined $plist->fullpkgpath) {
367				add_to_path_info($plist->fullpkgpath,
368				    $plist->pkgname);
369			}
370			if ($plist->has('pkgpath')) {
371				for my $p (@{$plist->{pkgpath}}) {
372					add_to_path_info($p->name,
373					    $plist->pkgname);
374				}
375			}
376		}
377	}
378	if (defined $path_info->{$pat}) {
379		return @{$path_info->{$pat}};
380	} else {
381		return ();
382	}
383}
384
385sub print_info
386{
387	my ($self, $state, $pkg, $handle) = @_;
388	unless (defined $handle) {
389		$state->errsay("Error printing info for #1: no info ?", $pkg);
390		return;
391	}
392	my $plist;
393	if ($state->opt('z')) {
394		$plist = $handle->plist(\&OpenBSD::PackingList::ExtraInfoOnly);
395		# firmware don't belong
396		if ($plist->has('firmware')) {
397			return;
398		}
399		my $name = OpenBSD::PackageName->new_from_string($plist->pkgname);
400		my $stem = $name->{stem};
401		my $compose = $stem."--".join('-', sort keys %{$name->{flavors}});
402		if ($plist->has('is-branch')) {
403			if ($plist->fullpkgpath =~ m/\/([^\/]+?)(,.*)?$/) {
404				$compose .= "%$1";
405			}
406		}
407		$state->say("#1", $compose);
408	} elsif ($state->opt('I')) {
409		if ($state->opt('q')) {
410			$state->say("#1", $pkg);
411		} else {
412			my $l = 20 - length($pkg);
413			$l = 1 if $l <= 0;
414			$state->say("#1#2#3", $pkg, " "x$l,
415			    get_comment($handle->info));
416		}
417	} else {
418		if ($state->opt('c')) {
419			$state->header($handle);
420			$state->banner("Comment:");
421			$state->say("#1\n", get_comment($handle->info));
422		}
423		if ($state->opt('R') && -f $handle->info.REQUIRED_BY) {
424			$state->header($handle);
425			$state->banner("Required by:");
426			$state->printfile_sorted($handle->info.REQUIRED_BY);
427		}
428		if ($state->opt('d')) {
429			$state->header($handle);
430			$state->banner("Description:");
431			$state->print_description($handle->info);
432		}
433		if ($state->opt('M') && -f $handle->info.DISPLAY) {
434			$state->header($handle);
435			$state->banner("Install notice:");
436			$state->printfile($handle->info.DISPLAY);
437		}
438		if ($state->opt('U') && -f $handle->info.UNDISPLAY) {
439			$state->header($handle);
440			$state->banner("Deinstall notice:");
441			$state->printfile($handle->info.UNDISPLAY);
442		}
443		my $needplist = $state->hasanyopt('fsSC');
444		if ($needplist || $state->opt('L')) {
445			require OpenBSD::PackingList;
446
447			if ($needplist) {
448				$plist //= $handle->plist;
449			} else {
450				$plist //= $handle->plist(\&OpenBSD::PackingList::FilesOnly);
451			}
452			$state->fatal("bad packing-list for #1", $handle->url)
453			    unless defined $plist;
454		}
455		if ($state->opt('L')) {
456			$state->header($handle);
457			$state->banner("Files:");
458			$plist->dump_file($state->opt('K'));
459			$state->say;
460		}
461		if ($state->opt('C')) {
462			$state->header($handle);
463			if ($plist->is_signed) {
464				my $sig = $plist->get('digital-signature');
465				if ($sig->{key} eq 'signify2') {
466					$state->say("reportedly signed by #1",
467					    $plist->get('signer')->name);
468				} else {
469					$state->say("\@digital-signature #1: no currently supported signature",
470					    $sig->{key});
471				}
472			} else {
473				$state->banner("No digital signature");
474			}
475		}
476		if ($state->opt('s')) {
477			$state->header($handle);
478			my $size = 0;
479			$plist->sum_up(\$size);
480			$state->say(
481			    ($state->opt('q') ? "#1": "Size: #1"), $size);
482			$total_size += $size;
483			$pkgs++;
484		}
485		if ($state->opt('S')) {
486			$state->header($handle);
487			$state->say(
488			    ($state->opt('q') ? "#1": "Signature: #1"),
489			    $plist->signature->string);
490		}
491		if ($state->opt('P')) {
492			require OpenBSD::PackingList;
493
494			my $plist = $handle->plist(
495			    \&OpenBSD::PackingList::ExtraInfoOnly);
496			$state->header($handle);
497			$state->banner("Pkgpath:");
498			if (defined $plist->fullpkgpath) {
499				$state->say("#1", $plist->fullpkgpath);
500			} else {
501				$state->errsay("#1 has no FULLPKGPATH", $plist->pkgname);
502				$state->say;
503			}
504		}
505
506		if ($state->opt('f')) {
507			$state->header($handle);
508			$state->banner("Packing-list:");
509			$plist->write(\*STDOUT);
510			$state->say;
511		}
512		$state->footer($handle);
513	}
514}
515
516sub handle_query
517{
518	my ($self, $state) = @_;
519
520	require OpenBSD::Search;
521
522	$state->say("PKG_PATH=#1", $ENV{PKG_PATH} // "<undefined>")
523		if $state->verbose;
524	my $partial = OpenBSD::Search::PartialStem->new($state->opt('Q'));
525	if ($state->opt('a')) {
526		$partial->keep_all;
527	}
528	my $r = $state->repo->match_locations($partial);
529
530	for my $pkg (sort {$a->name cmp $b->name} @$r) {
531		my $p = $pkg->name;
532		if ($state->hasanyopt('cdfMqs')) {
533			$self->print_info($state, $p, $pkg);
534		} else {
535			$state->say(
536			    is_installed($p) ? "#1 (installed)" : "#1", $p);
537		}
538	}
539}
540
541sub parse_and_run
542{
543	my ($self, $cmd) = @_;
544	my $exit_code = 0;
545	my @sought_files;
546	my $error_e = 0;
547	my $state = OpenBSD::PkgInfo::State->new($cmd);
548	my @extra;
549	$state->{opt} =
550	    {
551	    	'e' =>
552		    sub {
553			    my $pat = shift;
554			    my @list;
555			    if ($pat =~ m/\//o) {
556				    $state->lock;
557				    @list = find_by_path($pat);
558				    push(@ARGV, @list);
559			    } else {
560				    @list = find_by_spec($pat, $state);
561				    push(@extra, @list);
562			    }
563			    if (@list == 0) {
564				    $exit_code = 1;
565				    $error_e = 1;
566			    }
567			    $state->{terse} = 1;
568		    },
569	     'E' =>
570		    sub {
571			    require File::Spec;
572
573			    push(@sought_files, File::Spec->rel2abs(shift));
574
575		    }
576	    };
577	$state->{no_exports} = 1;
578	$state->handle_options('cCdfF:hIKLmPQ:qr:RsSUe:E:Ml:aAtz',
579	    '[-AaCcdfIKLMmPqRSstUvz] [-D nolock][-E filename] [-e pkg-name] ',
580	    '[-l str] [-Q query] [-r pkgspec] [pkg-name ...]');
581
582	if ($state->opt('r')) {
583
584		require OpenBSD::PkgSpec;
585
586		my $pattern = $state->opt('r');
587		my $s = OpenBSD::PkgSpec->new($pattern);
588		if (!$s->is_valid) {
589			$state->errsay("Invalid pkgspec: #1", $pattern);
590			return 1;
591		}
592		my @l = $s->match_ref(\@ARGV);
593		unless ($state->opt('q')) {
594			$state->say("Pkgspec #1 matched #2", $pattern,
595			    join(' ', @l));
596		}
597		if (@l == 0) {
598			$exit_code += 2;
599		}
600		if (@extra == 0) {
601			return $exit_code;
602		} else {
603			@ARGV = ();
604		}
605	}
606
607	$state->lock;
608
609	my $nonames = @ARGV == 0 && @extra == 0;
610
611	unless ($state->hasanyopt('cMUdfILRsSP') || $state->{terse}) {
612		if ($nonames) {
613			if ($state->opt('Q')) {
614				$state->setopts('I');
615			} else {
616				$state->setopts('Ia');
617			}
618		} else {
619			$state->setopts('cdMR');
620		}
621	}
622
623	if ($state->opt('Q')) {
624		$self->handle_query($state);
625		return 0;
626	}
627
628	if ($state->verbose) {
629		$state->setopts('cdfMURsS');
630	}
631
632	if ($state->opt('K') && !$state->opt('L')) {
633		$state->usage("-K only makes sense with -L");
634	}
635
636	my $all = $state->opt('a') || $state->opt('A');
637
638	if ($nonames && !$all) {
639		$state->usage("Missing package name(s)") unless $state->{terse} || $state->opt('q');
640	}
641
642	if (!$nonames && $state->hasanyopt('aAtm')) {
643		$state->usage("Can't specify package name(s) with [-aAtm]");
644	}
645
646
647	if ($nonames && !$error_e) {
648		@ARGV = sort(installed_packages($state->opt('A') ? 0 : 1));
649		if ($state->opt('t')) {
650			require OpenBSD::RequiredBy;
651			@ARGV = grep { OpenBSD::RequiredBy->new($_)->list == 0 } @ARGV;
652		}
653	}
654
655	if (@sought_files) {
656		my %hash = map { ($_, []) }  @sought_files;
657		@ARGV = $self->filter_files($state, \%hash, @ARGV);
658		for my $f (@sought_files) {
659			my $l = $hash{$f};
660			if (@$l) {
661				$state->say("#1: #2", $f, join(',', @$l))
662				    unless $state->opt('q');
663			} else {
664				$exit_code = 1;
665			}
666		}
667	}
668
669	if ($state->opt('m')) {
670		@ARGV = $self->manual_filter($state, @ARGV);
671	}
672
673	for my $pkg (@ARGV) {
674		if ($state->{terse}) {
675			$state->banner('#1', $pkg);
676		}
677		if (!$self->find_pkg($state, $pkg,
678		    sub {
679			$self->print_info($state, @_);
680		})) {
681			$exit_code = 1;
682		}
683	}
684	for my $extra (@extra) {
685		if ($state->{terse}) {
686			$state->banner('#1', $extra->url);
687		}
688		$self->print_info($state, $extra->url, $extra);
689	}
690
691	if ($pkgs > 1) {
692		$state->say("Total size: #1", $total_size);
693	}
694	return $exit_code;
695}
696
6971;
698