View file File name : debsums Content :#!/usr/bin/perl # # Check installed files against package md5sums or debs. # use strict; use warnings; use File::Find 'find'; use File::Temp 'tempdir'; use File::Path 'rmtree'; use File::Copy 'copy'; use Fcntl qw/O_RDONLY O_NONBLOCK O_NOATIME/; use Getopt::Long qw/:config bundling/; use Digest::MD5; use constant ELF_MAGIC => "\177ELF"; use Errno; use POSIX; use File::Basename; use File::Spec; use Dpkg::Conf; use File::FnMatch qw(:fnmatch); sub version { my $changelog = File::Spec->catfile(dirname($0), "debian", "changelog"); my $cmd; if (-f $changelog) { $cmd = qq(dpkg-parsechangelog -SVersion '-l$changelog'); } else { $cmd = q(dpkg-query -W -f '${Version}' debsums); } my $res = `$cmd`; chomp($res); if ($res !~ /^[0-9.~a-z+]+$/) { $res = ""; } return $res; } (my $self = $0) =~ s!.*/!!; sub version_info { my $version_number = version(); my $version = <<"EOT"; $self $version_number Copyright (c) 2002, 2004, 2005, 2006, 2007 Brendan O'Dea <bod\@debian.org> This is free software, licensed under the terms of the GNU General Public License. There is NO warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. Written by Brendan O'Dea <bod\@debian.org>, based on a program by Christoph Lameter <clameter\@debian.org> and Petr Cech <cech\@debian.org>. EOT return $version; } my $help = <<"EOT"; $self checks the MD5 sums of installed debian packages. Usage: $self [OPTIONS] [PACKAGE|DEB] ... Options: -a, --all check configuration files (normally excluded) -e, --config check only configuration files -c, --changed report changed files (implies -s) -l, --list-missing list packages which don't have an md5sums file -s, --silent only report errors -m, --md5sums=FILE read list of deb checksums from FILE -x, --report-mismatches report errors and print the md5sums mismatch -r, --root=DIR root directory to check (default /) -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 --no-locale-purge report missing locale files even if localepurge is configured --no-prelink report changed ELF files even if prelink is configured --ignore-obsolete ignore obsolete conffiles. --help print this help, then exit --version print version number, then exit EOT my $gen_opt; GetOptions ( 'a|all' => \my $all, 'e|config' => \my $config, 'c|changed' => \my $changed, 'l|list-missing' => \my $missing, 's|silent' => \my $silent, 'x|report-mismatches' => \my $report, 'm|md5sums=s' => \my $md5sums, 'r|root=s' => \my $root, 'd|admindir=s' => \my $admindir, 'p|deb-path=s' => \my $debpath, 'generate=s' => \$gen_opt, 'locale-purge!' => \my $localepurge, 'prelink!' => \my $prelink, 'ignore-permissions' => \my $ignore_permissions, 'ignore-obsolete!' => \my $ignore_obsolete, g => sub { $gen_opt = 'missing' }, help => sub { print $help; exit }, version => sub { print version_info(); exit }, ) or die "Try '$self --help' for more information.\n"; sub can_ignore { return $!{EACCES} && $ignore_permissions && getuid(); } my $my_noatime = 0; eval { $my_noatime = O_NOATIME }; sub warn_or_die { if (can_ignore()) { unless ($silent) { warn $_[0]; } } else { die $_[0]; } } sub parse_dpkg { my ($command_cb, $field_names) = @_; local $/ = "\n\n"; # Separator that cannot appear in dpkg status format my @command = &$command_cb('--showformat=' . (join '', map {"\${$_}$/"} @$field_names)); open DPKG, '-|', @command 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; } close DPKG or die "$self: @command failed (", $! ? $! : $? >> 8 ? "exit status " . ($? >> 8) : "signal " . ($? & 127), ")\n"; return @ret; } $root ||= ''; $admindir ||= '/var/lib/dpkg'; my $DPKG = $root . $admindir; my $is_path_pattern_opt = sub { return shift =~ /^--path-(?:exclude|include)=/; }; 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"))) { if (-f $_) { my $name = "$_"; $dpkg_conf->load($name); } } $dpkg_conf->filter(keep => $is_path_pattern_opt); my @dpkg_opts = $dpkg_conf->get_options; my @dpkg_patterns = (); foreach my $opt(@dpkg_opts) { my @res = ($opt =~ /^--path-(exclude|include)=(.+)/); push @dpkg_patterns, \@res; } sub excluded_by_dpkg { my $file = "/" . shift; my $excluded = 0; foreach my $rule(@dpkg_patterns) { my ($type, $pattern) = @{$rule}; if (fnmatch($pattern, $file)) { $excluded = $type eq 'exclude' ? 1 : 0; } } return $excluded; } my %locales; my $nopurge = '/etc/locale.nopurge'; # default is to ignore purged locale files if /etc/locale.nopurge exists $localepurge = -e $nopurge unless defined $localepurge; if ($localepurge and -e $nopurge) { open L, $nopurge or die "$self: can't open $nopurge ($!)\n"; while (<L>) { $locales{$1}++ if /^(\w.+)/; } close L; } # default is to use prelink to fetch the original checksums if installed if (!defined $prelink or $prelink) { # use the binary in preference to the wrapper which asks questions # interactively ($prelink) = grep -x, map +("$_.bin", $_), '/usr/sbin/prelink'; } $silent++ if $changed; my @debpath = '.'; @debpath = map +(length) ? $_ : '.', split /:/, $debpath, -1 if $debpath; my $arch; chomp ($arch = `/usr/bin/dpkg --print-architecture`); my %generate; if ($gen_opt) { for (split /,/, $gen_opt) { 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}; $generate{missing}++ unless $generate{all} or $generate{missing}; # ensure generated files are world readable umask 022; } 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} =~ /\s(installed|half-configured)$/; $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]+)!, grep { not ($ignore_obsolete and / obsolete$/) } 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"}; } } } my %diversion; 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!; } my %debsum; if ($md5sums) { 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; } close F; } } my $digest = Digest::MD5->new; my $tmp; my $status = 0; @ARGV = sort keys %installed unless @ARGV; sub dpkg_cmp { my $ver = shift; my ($op, $testver) = split ' ', shift; $op .= '=' if $op =~ /^[<>]$/; # convert old <, > return 0 unless grep $op eq $_, qw/<< <= = => >>/; return $op =~ /=/ if $ver eq $testver; # short cut equivalence !system '/usr/bin/dpkg', '--compare-versions', $ver, $op, $testver; } sub md5sums_path { # Calling dpkg-query --control-path for every package is too slow, # so we cheat a little bit. my ($pack) = @_; my $path = ''; if (-e "$DPKG/info/$pack.list") { $path = "$DPKG/info/$pack.md5sums"; } elsif ($pack !~ /:/ and -e "$DPKG/info/$pack:$arch.list") { $path = "$DPKG/info/$pack:$arch.md5sums"; } elsif ($pack =~ /^(.*):/ and -e "$DPKG/info/$1.list") { $path = "$DPKG/info/$1.md5sums"; } else { die "Cannot find md5sums path for $pack\n"; } if (-e $path and -z _) { # Empty .md5sums file: check if that's ok, either print a warning my $list_file = $path; $list_file =~ s/md5sums$/list/; unless (-e $list_file) { warn "$path is empty and $list_file does not exist!\n"; $status |= 2; } else { my $rc = open(my $lffd, '<', $list_file); unless ($rc) { warn "Couldn't open $list_file for reading: $!"; $status |= 2; } else { my $found_a_file = 0; while (my $line = <$lffd>) { chomp($line); next if -l "$root$line"; next if -d _; if (-f _) { warn "$path is empty but shouldn't!\n"; $status |= 2; last; } } close($lffd); } } } return $path; } sub is_replaced { my ($pack, $path, $sum) = @_; unless ($installed{$pack}{ReplacedBy}) { (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; 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; } 0; } sub is_localepurge_file { my $path = shift; my $locale = ""; if ($path =~ m!usr/share/(locale|man|gnome/help|omf|doc/kde/HTML|tcltk|aptitude|calendar|cups/templates|cups/locale|cups/doc-root|help|vim/vim[^/]+/lang)/!) { my $type = $1; if ($type eq "man" || $type eq "locale" || $type eq "doc/kde/HTML") { $path =~ m!^usr/share/(?:man|locale|doc/kde/HTML)/([^/]+)/!; $locale = $1; } elsif ($type eq "gnome/help") { $path =~ m!^usr/share/gnome/help/[^/]+/([^/]+)/!; $locale = $1; } elsif ($type eq "omf") { $path =~ m!^usr/share/omf/([^/]+)/\1-([^/]+).omf$!; $locale = $2; } elsif ($type eq "tcltk") { $path =~ m!^usr/share/tcltk/t[^/]+/msgs/([^/]+).msg$!; $locale = $1; } elsif ($type eq "aptitude") { $path =~ m!^usr/share/aptitude/aptitude-defaults\.(.+)$!; $locale = $1; } elsif ($type eq "calendar") { $path =~ m!^usr/share/calendar/([\w]{2}_.+)$!; $locale = $1; } elsif ($type eq "cups/locale") { $path =~ m!^usr/share/cups/locale/([^/]+)!; $locale = $1; } elsif ($type eq "cups/templates") { $path =~ m!^usr/share/cups/templates/([^/]+)/!; $locale = $1; } elsif ($type eq "cups/doc-root") { $path =~ m!^usr/share/cups/doc-root/([^/]+)/!; $locale = $1; } elsif ($type eq "help") { $path =~ m!^usr/share/help/([^/]+)$!; $locale = $1; } elsif ($type =~ /^vim/) { $path =~ m!^usr/share/vim/vim[^/]+/lang/([^/]+)/LC_MESSAGES/vim\.mo$!; $locale = $1; } } return length($locale) && !$locales{$locale}; } # resolve symlinks without escaping $root sub resolve_path { my $path = shift; my $package = shift; my @tokens = split(/\//, $path); my @parts = (); my %seen; 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 ($seen{$fp}) { # better die now with a clear error message then later # with a sysopen fails die "$self: Error: symlink loop detected in path '$path'. ", "Please file a bug against $package.\n"; } $seen{$fp} = 1; if (-l $fp) { my $link = readlink($fp); @parts = () if $link =~ /^\//; unshift @tokens, split(/\//, $link); } else { push @parts, $token; } } return join('/', @parts); } { my $width = ($ENV{COLUMNS} || 80) - 3; $width = 6 if $width < 6; sub check { my ($pack, $path, $sum) = @_; $path = $diversion{$path}[0] if exists $diversion{$path} and $diversion{$path}[1] ne $pack and $diversion{$path}[1] ne $pack =~ s/:.*//r; my $resolved = resolve_path($path,$pack); if ((!sysopen F, "$root/$resolved", O_RDONLY|O_NONBLOCK|$my_noatime) && (!sysopen F, "$root/$resolved", O_RDONLY|O_NONBLOCK)) { 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"; if (can_ignore()) { warn $err unless ($silent); return 0; } else { if ($!{ENOENT}) { warn "$self: missing file $root/$path (from $pack package)\n"; } else { warn $err; } 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; } } # Good cases if ($s eq $sum) { printf "%-*s OK\n", $width, "$root/$path" unless ($silent || $report); return 0; } if (is_replaced $pack, $path, $s) { printf "%-*s REPLACED\n", $width - 6, "$root/$path" unless ($silent || $report); 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; } # Bad cases if ($changed) { print "$root/$path\n"; return 2; } if ($report) { warn "$self: changed file $root/$path (observed:$s expected:$sum) (from $pack package)\n"; return 2; } if ($silent) { warn "$self: changed file $root/$path (from $pack package)\n"; return 2; } printf "%-*s FAILED\n", $width - 4, "$root/$path"; return 2; } } for (@ARGV) { my $sums; my $pack; my $conffiles; # 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; } 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"; if (fileno(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"; if (fileno(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}) { warn "$self: the --generate=keep option has been removed and does nothing." } } next if $generate{nocheck}; $conffiles = $installed{$pack}{Conffiles} || {} unless $conffiles; unless ($config) { 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; } } next unless ($all or $config) and %$conffiles; while (my ($path, $sum) = each %$conffiles) { $status |= check $pack, $path, $sum; } } exit $status;