path: root/usr.sbin/pkg_add/pkg_info

#! /usr/bin/perl
# ex:ts=8 sw=4:
# $OpenBSD: pkg_info,v 1.21 2004/11/15 12:58:48 espie Exp $
#
# Copyright (c) 2003-2004 Marc Espie <espie@openbsd.org>
#
# Permission to use, copy, modify, and distribute this software for any
# purpose with or without fee is hereby granted, provided that the above
# copyright notice and this permission notice appear in all copies.
#
# THE SOFTWARE IS PROVIDED "AS IS" AND THE AUTHOR DISCLAIMS ALL WARRANTIES
# WITH REGARD TO THIS SOFTWARE INCLUDING ALL IMPLIED WARRANTIES OF
# MERCHANTABILITY AND FITNESS. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR
# ANY SPECIAL, DIRECT, INDIRECT, OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES
# WHATSOEVER RESULTING FROM LOSS OF USE, DATA OR PROFITS, WHETHER IN AN
# ACTION OF CONTRACT, NEGLIGENCE OR OTHER TORTIOUS ACTION, ARISING OUT OF
# OR IN CONNECTION WITH THE USE OR PERFORMANCE OF THIS SOFTWARE.

use strict;
use warnings;
use OpenBSD::PackageInfo;
use OpenBSD::PackageName;
use OpenBSD::Getopt;
use OpenBSD::Error;

my $total_size = 0;
my $pkgs = 0;


sub find_pkg
{
	my ($pkg, $code) = @_;
	if (is_installed($pkg)) {
		&$code($pkg, installed_info($pkg));
		return;
	}
	if (OpenBSD::PackageName::is_stem($pkg)) {
		my @l = sort (OpenBSD::PackageName::findstem($pkg, installed_packages()));
		if (@l != 0) {
			for my $p (@l) {
				&$code($p, installed_info($p));
			}
			return;
		}
	}
				
	require OpenBSD::PackageLocator;

	my $true_package = OpenBSD::PackageLocator->find($pkg);
	return unless $true_package;
	my $dir = $true_package->info();
	&$code($pkg, $dir);
	$true_package->close();
}
sub printfile
{
	my $filename = shift;
	local $_;

	open my $fh, '<', $filename or return;
	while(<$fh>) {
		print;
	}
	close $fh;
}

sub get_line
{
	open my $fh, '<', shift or return "";
	my $c = <$fh>;
	chomp($c);
	close $fh;
	return $c;
}

sub find_by_spec
{
	my $pat = shift;

	require OpenBSD::PkgSpec;

	return sort(OpenBSD::PkgSpec::match($pat, installed_packages()));
}

sub filter_files
{
	require OpenBSD::PackingOld;
	require OpenBSD::PackingList;

	my $search = shift;
	my @result = ();
	for my $arg (@_) {
		find_pkg($arg,
		    sub {
		    	my ($pkg, $dir) = @_;
				
			my $plist = OpenBSD::PackingList->fromfile($dir.CONTENTS,
			    \&OpenBSD::PackingList::FilesOnly);
			for my $item (@{$plist->{items}}) {
				next unless $item->IsFile();
				my $fname = $item->fullname();
				if (defined $search->{"$fname"}) {
					push(@{$search->{$fname}}, $pkg);
					push(@result, $pkg);
				}
			}
			$plist->forget();
		    });
	}
	return @result;
}

my $all_plists;

sub find_by_path
{
	my $pat = shift;

	if (!defined $all_plists) {
		require OpenBSD::PackingOld;
		require OpenBSD::PackingList;

		$all_plists = [];
		for my $pkg (installed_packages()) {
			push(@$all_plists, 
				OpenBSD::PackingList->from_installation($pkg,
				    \&OpenBSD::PackingList::ExtraInfoOnly));
		}
	}
	my @result = ();
	for my $plist (@$all_plists) {
		if ($plist->{extrainfo}->{subdir} eq $pat) {
			push(@result, $plist->pkgname());
		}
	}
	return @result;
}

our ($opt_c, $opt_D, $opt_d, $opt_f, $opt_I, $opt_i, $opt_k, $opt_K, $opt_L, 
    $opt_m, $opt_p, $opt_q, $opt_R, $opt_r, $opt_s, $opt_v, $opt_h, $opt_l, 
    $opt_a, $opt_M, $opt_U, $opt_A);
my $terse = 0;
my $exit_code = 0;
my @sought_files;

sub print_info
{
	my ($pkg, $dir) = @_;
	unless (-d $dir) {
		print STDERR "Error printing info for $pkg: no info ?\n";
	}
	if ($opt_I) {
		my $l = 20 - length($pkg);
		$l = 1 if $l <= 0;
		print $pkg, " "x$l, get_line($dir.COMMENT), "\n";
	} else {
		if ($terse) {
			print $opt_l, $pkg, "\n" unless $opt_q;
		} else {
			print $opt_l, "Information for ", $pkg, "\n\n" unless $opt_q;
		}
		if ($opt_c) {
			print $opt_l, "Comment:\n" unless $opt_q;
			printfile($dir.COMMENT);
			print "\n";
		}
		if ($opt_R && -f $dir.REQUIRED_BY) {
			print $opt_l, "Required by:\n" unless $opt_q;
			printfile($dir.REQUIRED_BY);
			print "\n";
		}
		if ($opt_d) {
			print $opt_l, "Description:\n" unless $opt_q;
			printfile($dir.DESC);
			print "\n";
		}
		if ($opt_M && -f $dir.DISPLAY) {
			print $opt_l, "Install notice:\n" unless $opt_q;
			printfile($dir.DISPLAY);
			print "\n";
		}
		if ($opt_U && -f $dir.UNDISPLAY) {
			print $opt_l, "Deinstall notice:\n" unless $opt_q;
			printfile($dir.UNDISPLAY);
			print "\n";
		}
		if ($opt_i && -f $dir.INSTALL) {
			print $opt_l, "Install script:\n" unless $opt_q;
			printfile($dir.INSTALL);
			print "\n";
		}
		if ($opt_k && -f $dir.DEINSTALL) {
			print $opt_l, "De-Install script:\n" unless $opt_q;
			printfile($dir.DEINSTALL, \*STDOUT);
			print "\n";
		}
		if ($opt_r && -f $dir.REQUIRE) {
			print $opt_l, "Require script:\n" unless $opt_q;
			printfile($dir.REQUIRE, \*STDOUT);
			print "\n";
		}
		my $plist;
		if ($opt_f || $opt_L || $opt_s) {
			require OpenBSD::PackingOld;
			require OpenBSD::PackingList;

			if ($opt_f || $opt_s) {
				$plist = OpenBSD::PackingList->fromfile($dir.CONTENTS);
			} else {
				$plist = OpenBSD::PackingList->fromfile($dir.CONTENTS, \&OpenBSD::PackingList::FilesOnly);
			}
			Fatal "Bad packing list" unless defined $plist;
		}
		if ($opt_L) {
			print $opt_l, "Files:\n" unless $opt_q;
			for my $item (@{$plist->{items}}) {
				next unless $item->IsFile();
				if ($opt_K) {
					print '@', $item->keyword(), " ";
				}
				print $item->fullname(), "\n";
			}
			print "\n";
		}
		if ($opt_s) {
			my $size = 0;
			for my $item (@{$plist->{items}}) {
				next unless $item->IsFile();
				if (defined $item->{size}) {
					$size += $item->{size};
				}
			}
			print "Size: $size\n";
			$total_size += $size;
			$pkgs++;
		}

		if ($opt_f) {
			print $opt_l, "Packing list:\n" unless $opt_q;
			$plist->write(\*STDOUT);
			print "\n";
		}
		print $opt_l, "\n" unless $opt_q || $terse;
	}
}

getopts('cDdfIikKLmpqRrsvhe:E:MU:l:aA',
	{'e' =>
		sub {
			my $pat = shift;
			my @list;
			if ($pat =~ m/\//) {
				@list = find_by_path($pat);
			} else {
				@list = find_by_spec($pat);
			}
			if (@list == 0) {
				$exit_code = 1;
			}
			push(@ARGV, @list);
			$terse = 1;
		},
	 'E' =>
	 	sub {
			require File::Spec;

			push(@sought_files, File::Spec->rel2abs(shift));

		}
	});

if ($opt_D) {
	$opt_M = 1;
}

unless ($opt_c || $opt_M || $opt_U || $opt_d || $opt_f || $opt_I || $opt_i ||
	$opt_k || $opt_L || $opt_m || $opt_p || $opt_R || $opt_r || $opt_s || $terse) {
	if (@ARGV == 0) {
		$opt_I = $opt_a = 1;
	} else {
		$opt_c = $opt_d = $opt_R = 1;
	}
}

if ($opt_v) {
	$opt_c = $opt_d = $opt_f = $opt_i = $opt_k = $opt_r = $opt_M =
	    $opt_U = $opt_m = $opt_R = $opt_s = 1;
}

if (!defined $opt_l) {
	$opt_l = "";
}

if ($opt_K && !$opt_L) {
	Fatal "-K only makes sense with -L";
}

if (@ARGV == 0 && !$opt_a && !$opt_A) {
	Fatal "Missing package name(s)" unless $terse && $opt_q;
}

if (@ARGV > 0 && ($opt_a || $opt_A)) {
	Fatal "Can't specify package name(s) with -a";
}

if (@ARGV == 0) {
	@ARGV = sort(installed_packages(defined $opt_A ? 0 : 1));
}

if (@sought_files) {
	my %hash = map { ($_, []) }  @sought_files;
	@ARGV = filter_files(\%hash, @ARGV);
	for my $f (@sought_files) {
		my $l = $hash{$f};
		if (@$l) {
			print "$f: ", join(',', @$l), "\n" unless $opt_q;
		} else {
			$exit_code = 1;
		}
	}
}

for my $pkg (@ARGV) {
	find_pkg($pkg, \&print_info);
}
if ($pkgs > 1) {
	print "Total size: $total_size\n";
}
exit($exit_code);