[debsums] 183/184: debsums: Whitespace cleanup, wrapping long lines
Axel Beckert
abe at deuxchevaux.org
Mon Mar 2 21:21:31 UTC 2015
This is an automated email from the git hooks/post-receive script.
abe pushed a commit to branch master
in repository debsums.
commit da212c5b90d3baf423a9999ed9679cbe579ce078
Author: Axel Beckert <abe at deuxchevaux.org>
Date: Sat Feb 7 01:10:39 2015 +0100
debsums: Whitespace cleanup, wrapping long lines
---
debian/changelog | 3 +-
debsums | 832 ++++++++++++++++++++++++++++---------------------------
2 files changed, 424 insertions(+), 411 deletions(-)
diff --git a/debian/changelog b/debian/changelog
index 74da973..dab0f6b 100644
--- a/debian/changelog
+++ b/debian/changelog
@@ -24,10 +24,11 @@ debsums (2.1~dev) UNRELEASED; urgency=medium
+ Remove obsolete CVS keywords.
+ Quote HERE document delimiters to ease syntax highlighting and
please perlcritic.
+ + Whitespace cleanup, wrapping long lines.
* debsums.1:
+ Remove mentioning of /etc/apt/apt.conf.d/90debsums (Closes: #737240)
* rdebsums:
- + Whitespace cleanup
+ + Whitespace cleanup.
+ Exit with highest exit code of any of its child debsums processes
exited. (Closes: #711560)
diff --git a/debsums b/debsums
index 2374006..3115f65 100755
--- a/debsums
+++ b/debsums
@@ -70,7 +70,7 @@ Options:
-d, --admindir=DIR dpkg admin directory (default /var/lib/dpkg)
-p, --deb-path=DIR[:DIR...] search path for debs
-g, --generate=[all][,keep[,nocheck]]
- generate md5sums from deb contents
+ generate md5sums from deb contents
--no-locale-purge report missing locale files even if localepurge
is configured
--no-prelink report changed ELF files even if prelink is
@@ -121,16 +121,16 @@ sub parse_dpkg {
local $/ = "\n\n"; # Separator that cannot appear in dpkg status format
my @command = &$command_cb('--showformat=' .
- (join '', map {"\${$_}$/"} @$field_names));
+ (join '', map {"\${$_}$/"} @$field_names));
open DPKG, '-|', @command
- or die "$self: can't run " . $command[0] . " ($!)\n";
+ or die "$self: can't run " . $command[0] . " ($!)\n";
my @ret;
while (!eof DPKG)
{
- my %field = map {$_, scalar <DPKG>} @$field_names;
- chomp @field{@$field_names};
- push @ret, \%field;
+ my %field = map {$_, scalar <DPKG>} @$field_names;
+ chomp @field{@$field_names};
+ push @ret, \%field;
}
close DPKG or die "$self: @command failed (",
@@ -149,7 +149,8 @@ my $is_path_pattern_opt = sub {
my $dpkg_conf = Dpkg::Conf->new();
-foreach((glob($root . "/etc/dpkg/dpkg.cfg.d/[0-9a-zA-Z_-]*"), ($root . "/etc/dpkg/dpkg.cfg", $root . glob("~/.dpkg.cfg")))) {
+foreach((glob($root . "/etc/dpkg/dpkg.cfg.d/[0-9a-zA-Z_-]*"),
+ ($root . "/etc/dpkg/dpkg.cfg", $root . glob("~/.dpkg.cfg")))) {
if(-f $_) {
my $name = "$_";
$dpkg_conf->load($name);
@@ -187,7 +188,7 @@ if ($localepurge and -e $nopurge)
open L, $nopurge or die "$self: can't open $nopurge ($!)\n";
while (<L>)
{
- $locales{$1}++ if /^(\w.+)/;
+ $locales{$1}++ if /^(\w.+)/;
}
close L;
@@ -214,18 +215,18 @@ if ($gen_opt)
{
for (split /,/, $gen_opt)
{
- if (/^(missing|all|keep|nocheck)$/)
- {
- $generate{$1}++;
- }
- else
- {
- die "$self: invalid --generate value '$_'\n";
- }
+ if (/^(missing|all|keep|nocheck)$/)
+ {
+ $generate{$1}++;
+ }
+ else
+ {
+ die "$self: invalid --generate value '$_'\n";
+ }
}
die "$self: --generate values 'all' and 'missing' are mutually exclusive\n"
- if $generate{all} and $generate{missing};
+ if $generate{all} and $generate{missing};
$generate{missing}++ unless $generate{all} or $generate{missing};
@@ -237,34 +238,40 @@ my %installed;
my %package_name;
my %replaced;
{
- for my $fields (parse_dpkg(sub {'dpkg-query', "--admindir=$DPKG", @_, '--show'},
- [qw(Package PackageSpec binary:Package Version Status Conffiles Replaces)])) {
- my %field = %$fields;
- $field{"binary:Package"} = $field{PackageSpec} if $field{"binary:Package"} eq '';
- $field{"binary:Package"} = $field{Package} if $field{"binary:Package"} eq '';
- next unless $field{"binary:Package"} ne ''
- and $field{Version} ne ''
- and $field{Status} =~ /\sinstalled$/;
-
- $installed{$field{"binary:Package"}}{Version} = $field{Version};
- if($field{"binary:Package"} ne $field{"Package"} && $field{"binary:Package"} eq ($field{"Package"} . ":" . $arch)) {
- $package_name{$field{"Package"}} = $field{"binary:Package"};
- }
- $installed{$field{"binary:Package"}}{Conffiles} = {
- map m!^\s*/(\S+)\s+([\da-f]+)!, split /\n/, $field{Conffiles}
- } if $field{Conffiles};
-
- for (split /,\s*/, $field{Replaces})
- {
- my ($pack, $ver) = /^(\S+)(?:\s+\(([^)]+)\))?$/;
- unless ($pack)
- {
- warn "$self: invalid Replaces for " . $field{"binary:Package"} . " '$_'\n";
- next;
- }
-
- push @{$replaced{$pack}{$ver || 'all'}}, $field{"binary:Package"};
- }
+ for my $fields (parse_dpkg(
+ sub {'dpkg-query', "--admindir=$DPKG", @_, '--show'},
+ [qw(Package PackageSpec binary:Package Version
+ Status Conffiles Replaces)])) {
+ my %field = %$fields;
+ $field{"binary:Package"} = $field{PackageSpec}
+ if $field{"binary:Package"} eq '';
+ $field{"binary:Package"} = $field{Package}
+ if $field{"binary:Package"} eq '';
+ next unless $field{"binary:Package"} ne ''
+ and $field{Version} ne ''
+ and $field{Status} =~ /\sinstalled$/;
+
+ $installed{$field{"binary:Package"}}{Version} = $field{Version};
+ if($field{"binary:Package"} ne $field{"Package"} &&
+ $field{"binary:Package"} eq ($field{"Package"} . ":" . $arch)) {
+ $package_name{$field{"Package"}} = $field{"binary:Package"};
+ }
+ $installed{$field{"binary:Package"}}{Conffiles} = {
+ map m!^\s*/(\S+)\s+([\da-f]+)!, split /\n/, $field{Conffiles}
+ } if $field{Conffiles};
+
+ for (split /,\s*/, $field{Replaces})
+ {
+ my ($pack, $ver) = /^(\S+)(?:\s+\(([^)]+)\))?$/;
+ unless ($pack)
+ {
+ warn "$self: invalid Replaces for " .
+ $field{"binary:Package"} . " '$_'\n";
+ next;
+ }
+
+ push @{$replaced{$pack}{$ver || 'all'}}, $field{"binary:Package"};
+ }
}
}
@@ -273,18 +280,19 @@ for (`LC_ALL=C dpkg-divert --list --admindir $DPKG`)
{
my ($by) = /^(local) diversion/ ? $1 : / by (\S+)$/;
$diversion{$1} = [$2, $by]
- if m!diversion of /(.*) to /(.*?)\s!;
+ if m!diversion of /(.*) to /(.*?)\s!;
}
my %debsum;
if ($md5sums)
{
- open F, $md5sums or warn_or_die "$self: can't open sums file '$md5sums' ($!)\n";
+ open F, $md5sums
+ or warn_or_die "$self: can't open sums file '$md5sums' ($!)\n";
if(fileno(F)) {
while (<F>)
{
- my ($sum, $deb) = split;
- $debsum{$deb} = $sum;
+ my ($sum, $deb) = split;
+ $debsum{$deb} = $sum;
}
close F;
}
@@ -314,13 +322,13 @@ sub md5sums_path
my ($pack) = @_;
if (-e "$DPKG/info/$pack.list") {
- return "$DPKG/info/$pack.md5sums";
+ return "$DPKG/info/$pack.md5sums";
} elsif ($pack !~ /:/ and -e "$DPKG/info/$pack:$arch.list") {
- return "$DPKG/info/$pack:$arch.md5sums";
+ return "$DPKG/info/$pack:$arch.md5sums";
} elsif ($pack =~ /^(.*):/ and -e "$DPKG/info/$1.list") {
- return "$DPKG/info/$1.md5sums";
+ return "$DPKG/info/$1.md5sums";
} else {
- die "Cannot find md5sums path for $pack\n";
+ die "Cannot find md5sums path for $pack\n";
}
}
@@ -330,31 +338,31 @@ sub is_replaced
unless ($installed{$pack}{ReplacedBy})
{
- (my $name = $pack) =~ s/:[^:]*$//;
- return 0 unless $replaced{$name};
+ (my $name = $pack) =~ s/:[^:]*$//;
+ return 0 unless $replaced{$name};
- while (my ($ver, $p) = each %{$replaced{$name}})
- {
- next unless $ver eq 'all'
- or dpkg_cmp $installed{$pack}{Version}, $ver;
+ while (my ($ver, $p) = each %{$replaced{$name}})
+ {
+ next unless $ver eq 'all'
+ or dpkg_cmp $installed{$pack}{Version}, $ver;
- push @{$installed{$pack}{ReplacedBy}}, @$p;
- }
+ push @{$installed{$pack}{ReplacedBy}}, @$p;
+ }
}
for my $p (@{$installed{$pack}{ReplacedBy} || []})
{
- open S, md5sums_path($p) or next;
- while (<S>)
- {
- if ($_ eq "$sum $path\n")
- {
- close S;
- return 1;
- }
- }
-
- close S;
+ open S, md5sums_path($p) or next;
+ while (<S>)
+ {
+ if ($_ eq "$sum $path\n")
+ {
+ close S;
+ return 1;
+ }
+ }
+
+ close S;
}
0;
@@ -385,20 +393,20 @@ sub resolve_path {
my @tokens = split(/\//, $path);
my @parts = ();
while (@tokens) {
- my $token = shift @tokens;
- next if $token eq '.' || $token eq '';
- if ($token eq '..') {
- pop @parts;
- next;
- }
- my $fp = $root . '/' . join('/', @parts) . '/' . $token;
- if (-l $fp) {
- my $link = readlink($fp);
- @parts = () if $link =~ /^\//;
- unshift @tokens, split(/\//, $link);
- } else {
- push @parts, $token;
- }
+ my $token = shift @tokens;
+ next if $token eq '.' || $token eq '';
+ if ($token eq '..') {
+ pop @parts;
+ next;
+ }
+ my $fp = $root . '/' . join('/', @parts) . '/' . $token;
+ if (-l $fp) {
+ my $link = readlink($fp);
+ @parts = () if $link =~ /^\//;
+ unshift @tokens, split(/\//, $link);
+ } else {
+ push @parts, $token;
+ }
}
return join('/', @parts);
}
@@ -409,20 +417,20 @@ sub resolve_path {
sub check
{
- my ($pack, $path, $sum) = @_;
+ my ($pack, $path, $sum) = @_;
- $path = $diversion{$path}[0] if exists $diversion{$path}
- and $diversion{$path}[1] ne $pack;
+ $path = $diversion{$path}[0] if exists $diversion{$path}
+ and $diversion{$path}[1] ne $pack;
- my $resolved = resolve_path($path);
- if ((!sysopen F, "$root/$resolved", O_RDONLY|O_NONBLOCK|$my_noatime) &&
+ my $resolved = resolve_path($path);
+ if ((!sysopen F, "$root/$resolved", O_RDONLY|O_NONBLOCK|$my_noatime) &&
(!sysopen F, "$root/$resolved", O_RDONLY|O_NONBLOCK))
- {
- return 0 if $localepurge
+ {
+ return 0 if $localepurge
and is_localepurge_file($path);
return 0 if excluded_by_dpkg($path);
- my $err = "$self: can't open $pack file $root/$path ($!)\n";
+ my $err = "$self: can't open $pack file $root/$path ($!)\n";
if(can_ignore()) {
warn $err unless($silent);
return 0;
@@ -434,80 +442,81 @@ sub resolve_path {
}
return 2;
}
- }
-
- unless (-f F)
- {
- warn "$self: can't check $pack file $root/$path ",
- "(not a regular file)\n";
-
- close F;
- return 2;
- }
-
- my $magic = '';
- eval {
- defined read F, $magic, length ELF_MAGIC or die $!;
- $digest->add($magic);
- $digest->addfile(\*F);
- };
-
- close F;
-
- if ($@)
- {
- $@ =~ s/ at \S+ line.*\n//;
- warn "$self: can't check $pack file $root/$path ($@)\n";
- return 2;
- }
-
- my $s = $digest->hexdigest;
-
- if ($s ne $sum and $prelink and $magic eq ELF_MAGIC)
- {
- if (open P, '-|', $prelink, '--verify', '--md5', "$root/$path")
- {
- my ($prelink_s) = map /^([\da-f]{32})\s/, <P>;
- close P;
- $s = $prelink_s if $prelink_s;
- }
- }
-
- if ($s eq $sum)
- {
- printf "%-*s OK\n", $width, "$root/$path" unless $silent;
- return 0;
- }
-
- if (is_replaced $pack, $path, $s)
- {
- printf "%-*s REPLACED\n", $width - 6, "$root/$path" unless $silent;
- return 0;
- }
-
- my $correct_package = `dpkg-query "--admindir=$DPKG" -S "/$path" | awk -F': ' '{print \$1}'`;
- chomp($correct_package);
- if ($pack ne $correct_package) {
- #print "$pack != $correct_package\n";
- return 0;
- }
-
- if ($changed)
- {
- print $root, "/", $path, "\n";
- return 2;
- }
-
- if ($silent)
- {
+ }
+
+ unless (-f F)
+ {
+ warn "$self: can't check $pack file $root/$path ",
+ "(not a regular file)\n";
+
+ close F;
+ return 2;
+ }
+
+ my $magic = '';
+ eval {
+ defined read F, $magic, length ELF_MAGIC or die $!;
+ $digest->add($magic);
+ $digest->addfile(\*F);
+ };
+
+ close F;
+
+ if ($@)
+ {
+ $@ =~ s/ at \S+ line.*\n//;
+ warn "$self: can't check $pack file $root/$path ($@)\n";
+ return 2;
+ }
+
+ my $s = $digest->hexdigest;
+
+ if ($s ne $sum and $prelink and $magic eq ELF_MAGIC)
+ {
+ if (open P, '-|', $prelink, '--verify', '--md5', "$root/$path")
+ {
+ my ($prelink_s) = map /^([\da-f]{32})\s/, <P>;
+ close P;
+ $s = $prelink_s if $prelink_s;
+ }
+ }
+
+ if ($s eq $sum)
+ {
+ printf "%-*s OK\n", $width, "$root/$path" unless $silent;
+ return 0;
+ }
+
+ if (is_replaced $pack, $path, $s)
+ {
+ printf "%-*s REPLACED\n", $width - 6, "$root/$path" unless $silent;
+ return 0;
+ }
+
+ my $correct_package =
+ `dpkg-query "--admindir=$DPKG" -S "/$path" | awk -F': ' '{print \$1}'`;
+ chomp($correct_package);
+ if ($pack ne $correct_package) {
+ #print "$pack != $correct_package\n";
+ return 0;
+ }
+
+ if ($changed)
+ {
+ print $root, "/", $path, "\n";
+ return 2;
+ }
+
+ if ($silent)
+ {
warn "$self: changed file $root/$path (from $pack package)\n";
- }
- else
- {
- printf "%-*s FAILED\n", $width - 4, "$root/$path";
- }
+ }
+ else
+ {
+ printf "%-*s FAILED\n", $width - 4, "$root/$path";
+ }
- return 2;
+ return 2;
}
}
@@ -520,275 +529,278 @@ for (@ARGV)
# looks like a package name
unless (/[^a-z\d+.:-]/ or /\.deb$/)
{
- $pack = $_;
- unless (exists $installed{$pack})
- {
- if(exists $package_name{$pack}) {
- $pack = $package_name{$pack};
- }
- unless (exists $installed{$pack})
- {
- warn "$self: package $pack is not installed\n";
- $status |= 1;
- next;
- }
- }
-
- my $deb;
- if (%generate)
- {
- my @v = $installed{$pack}{Version};
- if ($v[0] =~ s/(\d+):/$1%3a/)
- {
- push @v, $installed{$pack}{Version};
- $v[1] =~ s/\d+://;
- }
-
- for my $dir (@debpath)
- {
- # look for <pack>_<ver>_<arch>.deb or <pack>_<ver>.deb
- # where <ver> may or may not contain an epoch
- my ($debname, $debarch);
- ($debname, $debarch) = ($pack =~ /^(.*):([^:]*)$/)
- or ($debname, $debarch) = ($pack, $arch);
- if (($deb) = grep -f, map +(glob "$dir/${debname}_$_.deb"),
- map +("${_}_$debarch", "${_}_all", $_), @v)
- {
- $deb =~ s!^\./+!!;
- last;
- }
- }
- }
-
- if ($generate{all})
- {
- unless ($deb)
- {
- warn "$self: no deb available for $pack\n";
- $status |= 1;
- next;
- }
-
- $_ = $deb;
- }
- else
- {
- $sums = md5sums_path($pack);
- unless (-f $sums or $config)
- {
- if ($missing)
- {
- print "$pack\n";
- next;
- }
-
- unless ($generate{missing})
- {
- warn "$self: no md5sums for $pack\n";
- next;
- }
-
- unless ($deb)
- {
- warn "$self: no md5sums for $pack and no deb available\n"
- unless $generate{nocheck} and $silent;
-
- next;
- }
-
- undef $sums;
- $_ = $deb;
- }
- }
-
- next if $missing;
+ $pack = $_;
+ unless (exists $installed{$pack})
+ {
+ if(exists $package_name{$pack}) {
+ $pack = $package_name{$pack};
+ }
+ unless (exists $installed{$pack})
+ {
+ warn "$self: package $pack is not installed\n";
+ $status |= 1;
+ next;
+ }
+ }
+
+ my $deb;
+ if (%generate)
+ {
+ my @v = $installed{$pack}{Version};
+ if ($v[0] =~ s/(\d+):/$1%3a/)
+ {
+ push @v, $installed{$pack}{Version};
+ $v[1] =~ s/\d+://;
+ }
+
+ for my $dir (@debpath)
+ {
+ # look for <pack>_<ver>_<arch>.deb or <pack>_<ver>.deb
+ # where <ver> may or may not contain an epoch
+ my ($debname, $debarch);
+ ($debname, $debarch) = ($pack =~ /^(.*):([^:]*)$/)
+ or ($debname, $debarch) = ($pack, $arch);
+ if (($deb) = grep -f, map +(glob "$dir/${debname}_$_.deb"),
+ map +("${_}_$debarch", "${_}_all", $_), @v)
+ {
+ $deb =~ s!^\./+!!;
+ last;
+ }
+ }
+ }
+
+ if ($generate{all})
+ {
+ unless ($deb)
+ {
+ warn "$self: no deb available for $pack\n";
+ $status |= 1;
+ next;
+ }
+
+ $_ = $deb;
+ }
+ else
+ {
+ $sums = md5sums_path($pack);
+ unless (-f $sums or $config)
+ {
+ if ($missing)
+ {
+ print "$pack\n";
+ next;
+ }
+
+ unless ($generate{missing})
+ {
+ warn "$self: no md5sums for $pack\n";
+ next;
+ }
+
+ unless ($deb)
+ {
+ warn "$self: no md5sums for $pack and no deb available\n"
+ unless $generate{nocheck} and $silent;
+
+ next;
+ }
+
+ undef $sums;
+ $_ = $deb;
+ }
+ }
+
+ next if $missing;
}
unless ($sums)
{
- unless (-f and /\.deb$/)
- {
- warn "$self: invalid package name '$_'\n";
- $status |= 1;
- next;
- }
-
- my $deb = $_;
- my ($fields) = parse_dpkg(sub {'dpkg-deb', @_, '--show', $deb},
- [qw(Package PackageSpec binary:Package Version Conffiles)])
- or do {
- warn "$self: $deb does not seem to be a valid debian archive\n";
- $status |= 1;
- next;
- };
- my %field = %$fields;
- $field{"binary:Package"} = $field{PackageSpec} if $field{"binary:Package"} eq '';
- $field{"binary:Package"} = $field{Package} if $field{"binary:Package"} eq '';
-
- unless ($field{"binary:Package"} ne '' and $field{Version} ne '')
- {
- warn "$self: $deb does not seem to be a valid debian archive\n";
- $status |= 1;
- next;
- }
-
- $pack = $field{"binary:Package"};
- unless (exists $installed{$pack})
- {
- if(exists $package_name{$pack}) {
- $pack = $package_name{$pack};
- }
- unless (exists $installed{$pack})
- {
- warn "$self: package $pack is not installed\n";
- $status |= 1;
- next;
- }
- }
-
- unless ($installed{$pack}{Version} eq $field{Version})
- {
- warn "$self: package $pack version $field{Version} !=",
- " installed version $installed{$pack}{Version}\n";
-
- $status |= 1;
- next;
- }
-
- if ($md5sums)
- {
- if (exists $debsum{$deb})
- {
- open F, $deb or warn_or_die "$self: can't open $deb ($!)\n";
+ unless (-f and /\.deb$/)
+ {
+ warn "$self: invalid package name '$_'\n";
+ $status |= 1;
+ next;
+ }
+
+ my $deb = $_;
+ my ($fields) = parse_dpkg(sub {'dpkg-deb', @_, '--show', $deb},
+ [qw(Package PackageSpec binary:Package
+ Version Conffiles)])
+ or do {
+ warn "$self: $deb does not seem to be a valid debian archive\n";
+ $status |= 1;
+ next;
+ };
+ my %field = %$fields;
+ $field{"binary:Package"} = $field{PackageSpec}
+ if $field{"binary:Package"} eq '';
+ $field{"binary:Package"} = $field{Package}
+ if $field{"binary:Package"} eq '';
+
+ unless ($field{"binary:Package"} ne '' and $field{Version} ne '')
+ {
+ warn "$self: $deb does not seem to be a valid debian archive\n";
+ $status |= 1;
+ next;
+ }
+
+ $pack = $field{"binary:Package"};
+ unless (exists $installed{$pack})
+ {
+ if(exists $package_name{$pack}) {
+ $pack = $package_name{$pack};
+ }
+ unless (exists $installed{$pack})
+ {
+ warn "$self: package $pack is not installed\n";
+ $status |= 1;
+ next;
+ }
+ }
+
+ unless ($installed{$pack}{Version} eq $field{Version})
+ {
+ warn "$self: package $pack version $field{Version} !=",
+ " installed version $installed{$pack}{Version}\n";
+
+ $status |= 1;
+ next;
+ }
+
+ if ($md5sums)
+ {
+ if (exists $debsum{$deb})
+ {
+ open F, $deb or warn_or_die "$self: can't open $deb ($!)\n";
if(fileno(F)) {
- $digest->addfile(\*F);
- close F;
+ $digest->addfile(\*F);
+ close F;
}
- unless ($digest->hexdigest eq $debsum{$deb})
- {
- warn "$self: checksum mismatch for $deb; not checked\n";
- $status |= 2;
- next;
- }
- }
- else
- {
- warn "$self: no checksum available for $deb\n";
- }
- }
-
- unless ($tmp)
- {
- my $catch = sub { exit 1 };
- $SIG{$_} = $catch for qw/HUP INT QUIT TERM/;
-
- $tmp = tempdir CLEANUP => 1
- or die "$self: can't create temporary directory ($!)\n";
- }
-
- my $control = "$tmp/DEBIAN";
- $sums = "$control/md5sums";
- rmtree ($control, {safe => 1}) if -d $control;
-
- system 'dpkg', '--control', $deb, $control
- and die "$self: can't extract control info from $deb\n";
-
- if ($missing)
- {
- print "$deb\n" unless -s $sums;
- next;
- }
-
- my %conf;
- if (open F, "$control/conffiles")
- {
- while (<F>)
- {
- chomp;
- $conf{$1}++ if m!^/?(.+)!;
- }
-
- close F;
- }
-
- if (!-s $sums)
- {
- my $unpacked = "$tmp/$pack";
- print "Generating missing md5sums for $deb..." unless $silent;
- system 'dpkg', '--extract', $deb, $unpacked
- and die "$self: can't unpack $deb\n";
-
- $conffiles = {};
- open SUMS, ">$sums" or die "$self: can't create $sums ($!)\n";
- my $skip = (length $unpacked) + 1;
-
- find sub {
- return if -l or ! -f;
- open F, $_ or warn_or_die "$self: can't open $_ ($!)\n";
+ unless ($digest->hexdigest eq $debsum{$deb})
+ {
+ warn "$self: checksum mismatch for $deb; not checked\n";
+ $status |= 2;
+ next;
+ }
+ }
+ else
+ {
+ warn "$self: no checksum available for $deb\n";
+ }
+ }
+
+ unless ($tmp)
+ {
+ my $catch = sub { exit 1 };
+ $SIG{$_} = $catch for qw/HUP INT QUIT TERM/;
+
+ $tmp = tempdir CLEANUP => 1
+ or die "$self: can't create temporary directory ($!)\n";
+ }
+
+ my $control = "$tmp/DEBIAN";
+ $sums = "$control/md5sums";
+ rmtree ($control, {safe => 1}) if -d $control;
+
+ system 'dpkg', '--control', $deb, $control
+ and die "$self: can't extract control info from $deb\n";
+
+ if ($missing)
+ {
+ print "$deb\n" unless -s $sums;
+ next;
+ }
+
+ my %conf;
+ if (open F, "$control/conffiles")
+ {
+ while (<F>)
+ {
+ chomp;
+ $conf{$1}++ if m!^/?(.+)!;
+ }
+
+ close F;
+ }
+
+ if (!-s $sums)
+ {
+ my $unpacked = "$tmp/$pack";
+ print "Generating missing md5sums for $deb..." unless $silent;
+ system 'dpkg', '--extract', $deb, $unpacked
+ and die "$self: can't unpack $deb\n";
+
+ $conffiles = {};
+ open SUMS, ">$sums" or die "$self: can't create $sums ($!)\n";
+ my $skip = (length $unpacked) + 1;
+
+ find sub {
+ return if -l or ! -f;
+ open F, $_ or warn_or_die "$self: can't open $_ ($!)\n";
if(fileno(F)) {
- $digest->addfile(\*F);
- close F;
+ $digest->addfile(\*F);
+ close F;
}
- my $md5 = $digest->hexdigest;
- my $path = substr $File::Find::name, $skip;
- if (delete $conf{$path})
- {
- $conffiles->{$path} = $md5;
- }
- else
- {
- print SUMS "$md5 $path\n";
- }
- }, $unpacked;
-
- close SUMS;
- rmtree ($unpacked, {safe => 1});
-
- print "done.\n" unless $silent;
-
- warn "$self: extra conffiles listed in $deb: (",
- (join ', ', keys %conf), ")\n" if %conf;
- }
-
- if ($generate{keep})
- {
+ my $md5 = $digest->hexdigest;
+ my $path = substr $File::Find::name, $skip;
+ if (delete $conf{$path})
+ {
+ $conffiles->{$path} = $md5;
+ }
+ else
+ {
+ print SUMS "$md5 $path\n";
+ }
+ }, $unpacked;
+
+ close SUMS;
+ rmtree ($unpacked, {safe => 1});
+
+ print "done.\n" unless $silent;
+
+ warn "$self: extra conffiles listed in $deb: (",
+ (join ', ', keys %conf), ")\n" if %conf;
+ }
+
+ if ($generate{keep})
+ {
warn "$self: the --generate=keep option has been removed and does nothing."
- }
+ }
}
next if $generate{nocheck};
$conffiles = $installed{$pack}{Conffiles} || {}
- unless $conffiles;
+ unless $conffiles;
unless ($config)
{
- open SUMS, $sums or warn_or_die "$self: can't open $sums ($!)\n";
+ open SUMS, $sums or warn_or_die "$self: can't open $sums ($!)\n";
if(fileno(SUMS)) {
- while (<SUMS>)
- {
- chomp;
- my ($sum, $path) = split ' ', $_, 2;
- unless ($path and $sum =~ /^[0-9a-f]{32}$/)
- {
- warn "$self: invalid line ($.) in md5sums for $pack: $_\n";
- next;
- }
-
- $path =~ s!^\./!!;
- next if exists $conffiles->{$path};
- $status |= check $pack, $path, $sum;
- }
-
- close SUMS;
+ while (<SUMS>)
+ {
+ chomp;
+ my ($sum, $path) = split ' ', $_, 2;
+ unless ($path and $sum =~ /^[0-9a-f]{32}$/)
+ {
+ warn "$self: invalid line ($.) in md5sums for $pack: $_\n";
+ next;
+ }
+
+ $path =~ s!^\./!!;
+ next if exists $conffiles->{$path};
+ $status |= check $pack, $path, $sum;
+ }
+
+ close SUMS;
}
}
next unless ($all or $config) and %$conffiles;
while (my ($path, $sum) = each %$conffiles)
{
- $status |= check $pack, $path, $sum;
+ $status |= check $pack, $path, $sum;
}
}
--
Alioth's /usr/local/bin/git-commit-notice on /srv/git.debian.org/git/pkg-perl/packages/debsums.git
More information about the Pkg-perl-cvs-commits
mailing list