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