#! /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);