252 lines
6.1 KiB
Perl
Executable File
252 lines
6.1 KiB
Perl
Executable File
#!/usr/bin/perl
|
|
|
|
# $OpenBSD: out-of-date,v 1.6 2013/09/15 09:17:25 rpe Exp $
|
|
#
|
|
# Copyright (c) 2005 Bernd Ahlers <bernd@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::Getopt;
|
|
use OpenBSD::Error;
|
|
use OpenBSD::PackageInfo;
|
|
use OpenBSD::PackingList;
|
|
use OpenBSD::PackageName;
|
|
use File::Temp;
|
|
use OpenBSD::AddCreateDelete;
|
|
|
|
our $opt_q;
|
|
my $state = OpenBSD::AddCreateDelete::State->new("out-of-date");
|
|
$state->handle_options('q', "[-mvxq]");
|
|
|
|
sub collect_installed
|
|
{
|
|
my $pkg = {};
|
|
|
|
$state->progress->for_list("Collecting installed packages",
|
|
[installed_packages(1)], sub {
|
|
my $name = shift;
|
|
my ($stem, $version) = OpenBSD::PackageName::splitname($name);
|
|
my $plist = OpenBSD::PackingList->from_installation($name,
|
|
\&OpenBSD::PackingList::UpdateInfoOnly);
|
|
if (!defined $plist or !defined $plist->{extrainfo}->{subdir}) {
|
|
$state->errsay("Package #1 has no valid packing-list",
|
|
$name);
|
|
return;
|
|
}
|
|
|
|
my $subdir = $plist->{extrainfo}->{subdir};
|
|
$subdir =~ s/mystuff\///;
|
|
$subdir =~ s/\/usr\/ports\///;
|
|
|
|
$pkg->{$subdir}->{name} = $name;
|
|
$pkg->{$subdir}->{stem} = $stem;
|
|
$pkg->{$subdir}->{version} = $version;
|
|
my $sig = $plist->signature;
|
|
if (ref($sig)) { $sig = $sig->string; }
|
|
$pkg->{$subdir}->{signature} = $sig;
|
|
if (defined $plist->{'always-update'}) {
|
|
$pkg->{$subdir}->{signature} = 'always-update';
|
|
}
|
|
});
|
|
return $pkg;
|
|
}
|
|
|
|
sub open_cmd
|
|
{
|
|
my $cmd = shift;
|
|
open my $fh, "-|", $cmd;
|
|
# my $old = select $fh;
|
|
# $| = 1;
|
|
# select $old;
|
|
return $fh;
|
|
}
|
|
|
|
sub collect_port_versions
|
|
{
|
|
my ($pkg, $portsdir, $notfound) = @_;
|
|
|
|
my @subdirs = ();
|
|
for my $subdir (keys %$pkg) {
|
|
my ($dir) = split(/,/, $subdir);
|
|
if (-d "$portsdir/$dir") {
|
|
push(@subdirs, $subdir);
|
|
} else {
|
|
push(@$notfound, $subdir);
|
|
}
|
|
}
|
|
|
|
my $cmd = "cd $portsdir && SUBDIR=\"".join(' ', @subdirs)
|
|
."\" FULLPATH=Yes REPORT_PROBLEM=true make ".'show=FULLPKGNAME\${SUBPACKAGE} '
|
|
."2>&1";
|
|
|
|
my $port = {};
|
|
my $error = {};
|
|
my $count = 0;
|
|
my $total = scalar @subdirs;
|
|
|
|
$state->progress->set_header("Collecting port versions");
|
|
my $fh = open_cmd($cmd);
|
|
my $subdir = "";
|
|
while (<$fh>) {
|
|
chomp;
|
|
if (/^\=\=\=\>\s+(\S+)/) {
|
|
$subdir = $1;
|
|
$count++;
|
|
$state->progress->show($count, $total);
|
|
next;
|
|
}
|
|
next unless $_ or $subdir;
|
|
next if defined $error->{$subdir};
|
|
if (/^(Fatal\:|\s+\()/) {
|
|
push(@{$error->{$subdir}}, $_);
|
|
next;
|
|
} elsif (/^(Stop|\*\*\*)/) {
|
|
next;
|
|
}
|
|
$port->{$subdir}->{name} = $_;
|
|
my ($stem, $version) = OpenBSD::PackageName::splitname($_);
|
|
$port->{$subdir}->{stem} = $stem;
|
|
$port->{$subdir}->{version} = $version;
|
|
}
|
|
close($fh);
|
|
$state->progress->next;
|
|
|
|
return $port, $error;
|
|
}
|
|
|
|
sub collect_port_signatures
|
|
{
|
|
my $pkg = shift;
|
|
my $port = shift;
|
|
my $portsdir = shift;
|
|
my $output = shift;
|
|
|
|
my @subdirs = ();
|
|
for my $dir (keys %$port) {
|
|
if ($pkg->{$dir}->{name} eq $port->{$dir}->{name}) {
|
|
push(@subdirs, $dir);
|
|
}
|
|
}
|
|
|
|
my $TMPDIR = $ENV{'TMPDIR'} || "/tmp";
|
|
my $tempdir = File::Temp::tempdir("libcache.XXXXXXXXXX", DIR => $TMPDIR, CLEANUP => 1);
|
|
$ENV{'_DEPENDS_CACHE'} = $tempdir;
|
|
my $cmd = "cd $portsdir && FULLPATH=Yes SUBDIR=\"".join(' ', @subdirs)
|
|
."\" REPORT_PROBLEM=true make print-package-signature";
|
|
|
|
my $count = 0;
|
|
my $total = scalar @subdirs;
|
|
$state->progress->set_header("Collecting port signatures");
|
|
my $fh = open_cmd($cmd);
|
|
my $subdir = "";
|
|
while (<$fh>) {
|
|
chomp;
|
|
if (/^\=\=\=\>\s+(\S+)/) {
|
|
$subdir = $1;
|
|
$count++;
|
|
$state->progress->show($count, $total);
|
|
next;
|
|
}
|
|
next unless $_ or $subdir;
|
|
$port->{$subdir}->{signature} = $_;
|
|
}
|
|
$state->progress->next;
|
|
}
|
|
|
|
sub split_sig
|
|
{
|
|
my $sig = shift;
|
|
my $ret = {};
|
|
|
|
for my $item (split(/,/, $sig)) {
|
|
$ret->{$item} = 1;
|
|
}
|
|
|
|
return $ret;
|
|
}
|
|
|
|
sub diff_sig
|
|
{
|
|
my ($dir, $pkg, $port) = @_;
|
|
|
|
my $old = split_sig($pkg->{$dir}->{signature});
|
|
my $new = split_sig($port->{$dir}->{signature});
|
|
|
|
for my $key (keys %$old) {
|
|
if (defined $new->{$key}) {
|
|
delete $old->{$key};
|
|
delete $new->{$key};
|
|
}
|
|
}
|
|
|
|
return join(',', sort keys %$old), join(',', sort keys %$new);
|
|
}
|
|
|
|
sub find_outdated
|
|
{
|
|
my ($pkg, $port, $output) = @_;
|
|
|
|
for my $dir (keys %$pkg) {
|
|
next unless $port->{$dir};
|
|
if ($pkg->{$dir}->{name} ne $port->{$dir}->{name}) {
|
|
push(@$output, sprintf("%-30s # %s -> %s\n", $dir,
|
|
$pkg->{$dir}->{version}, $port->{$dir}->{version}));
|
|
next;
|
|
}
|
|
next if $opt_q;
|
|
if ($pkg->{$dir}->{signature} ne $port->{$dir}->{signature}) {
|
|
push(@$output, sprintf("%-30s # %s -> %s\n", $dir,
|
|
diff_sig($dir, $pkg, $port)));
|
|
}
|
|
}
|
|
}
|
|
|
|
my $portsdir = $ENV{PORTSDIR} || "/usr/ports";
|
|
|
|
|
|
my $pkg = collect_installed();
|
|
|
|
my @output = ();
|
|
my @notfound = ();
|
|
my ($port, $errors) = collect_port_versions($pkg, $portsdir, \@notfound);
|
|
|
|
collect_port_signatures($pkg, $port, $portsdir, \@output) unless $opt_q;
|
|
find_outdated($pkg, $port, \@output);
|
|
|
|
$state->errsay("Outdated ports:\n");
|
|
$state->print("#1", $_) for sort @output;
|
|
|
|
if ($opt_q) {
|
|
$state->errsay("\nWARNING: You've used the -q option. With this,\n"
|
|
. "out-of-date only looks for changed package names\nbut not "
|
|
. "for changed package signatures. If you\nwant to see ALL "
|
|
. "of your outdated packages,\ndon't use -q.");
|
|
}
|
|
|
|
if (@notfound > 0) {
|
|
$state->errsay("\nPorts that can't be found in the official "
|
|
. "ports tree:");
|
|
for (sort @notfound) {
|
|
$state->errsay("#1", $_);
|
|
}
|
|
}
|
|
if ((keys %$errors) > 0) {
|
|
$state->errsay("\nErrors:");
|
|
for (sort keys %$errors) {
|
|
$state->errsay(" #1", $_);
|
|
$state->errsay(" #1", $_) for @{$errors->{$_}};
|
|
}
|
|
}
|