index : pacman | |
Archlinux32 fork of pacman | gitolite user |
summaryrefslogtreecommitdiff |
author | Allan McRae <allan@archlinux.org> | 2016-10-09 22:52:27 +1000 |
---|---|---|
committer | Allan McRae <allan@archlinux.org> | 2016-10-10 10:38:05 +1000 |
commit | 0c99eabd50752310f42ec808c8734a338122ec86 (patch) | |
tree | 499801a8c046001ddab0b11439e9e948b257d726 /contrib/verify-pacman-repo-db.pl | |
parent | 2e76c184aac74c4848fa5ee092fe54c9954c4054 (diff) |
-rwxr-xr-x | contrib/verify-pacman-repo-db.pl | 259 |
diff --git a/contrib/verify-pacman-repo-db.pl b/contrib/verify-pacman-repo-db.pl deleted file mode 100755 index e0a54106..00000000 --- a/contrib/verify-pacman-repo-db.pl +++ /dev/null @@ -1,259 +0,0 @@ -#!/usr/bin/perl -T -use warnings; -use strict; - - -# This is used for the usage output -=pod - -=head1 SYNOPSIS - -verify-pacman-repo-db.pl [options] <database file> ... - - Options: - --help, -h Show short help message - --debug Enable debug output - --checksum, -c Verify checksums of packages - --thread, -t <num> Use num threads to verify packages. Default: 1 - NOTE: Each thread uses up to approx. 128MiB of memory - -=cut - -package main; -use Getopt::Long; -use Pod::Usage; - -exit main(); - -sub main { - my %opts = ( - threads => 1, - ); - - Getopt::Long::Configure ("bundling"); - pod2usage(-verbose => 0) if (@ARGV== 0); - GetOptions(\%opts, "help|h", "debug", "threads|t=i", "checksum|c") or pod2usage(2); - pod2usage(0) if $opts{help}; - - my $verifier = Verifier->new(\%opts); - - for my $repodb (@ARGV) { - $verifier->check_repodb($repodb); - } - - $verifier->finalize(); - return $verifier->get_error_status(); -} - -package Verifier; -use Archive::Tar; -use Digest::MD5; -use Digest::SHA; -use File::Basename; -use threads; -use threads::shared; -use Thread::Queue; - -sub new { - my $class = shift; - my $opts = shift; - - my $self :shared = shared_clone({ - opts => \%{$opts}, - package_queue => Thread::Queue->new(), - output_queue => Thread::Queue->new(), - workers => [], - errors => 0, - }); - - bless $self, $class; - $self->start_workers(); - return $self; -} - -sub start_workers { - my $self = shift; - - threads->new(\&_worker_output_queue, $self); - - for (my $i = 0; $i < $self->{opts}->{threads}; $i++) { - my $thr :shared = shared_clone(threads->new(\&_worker_package_queue, $self)); - push @{$self->{workers}}, $thr; - } -} - -sub _worker_package_queue { - my $self = shift; - while (my $workpack = $self->{package_queue}->dequeue()) { - my $dbdata = $self->_parse_db_entry($workpack->{db_desc_content}); - $self->{errors} += $self->_verify_db_entry($workpack->{dirname}, $dbdata); - } -} - -sub _worker_output_queue { - my $self = shift; - while (my $output = $self->{output_queue}->dequeue()) { - print STDERR $output; - } -} - -sub finalize { - my $self = shift; - - $self->{package_queue}->end(); - $self->_join_threads($self->{workers}); - - $self->{output_queue}->end(); - $self->_join_threads([threads->list]); -} - -sub _join_threads { - my $self = shift; - my $threads = shift; - - for my $thr (@{$threads}) { - if ($thr->tid && !threads::equal($thr, threads->self)) { - print "waiting for thread ".$thr->tid()." to finish\n" if $self->{opts}->{debug}; - $thr->join; - } - } -} - -sub get_error_status { - my $self = shift; - - return $self->{errors} > 0; -} - -sub check_repodb { - my $self = shift; - my $repodb = shift; - - my $db = Archive::Tar->new(); - $db->read($repodb); - - my $dirname = dirname($repodb); - my $pkgcount = 0; - - my @files = $db->list_files(); - for my $file_object ($db->get_files()) { - if ($file_object->name =~ m/^([^\/]+)\/desc$/) { - my $package = $1; - $self->{package_queue}->enqueue({ - package => $package, - db_desc_content => $file_object->get_content(), - dirname => $dirname, - }); - $pkgcount++; - } - } - - $self->_debug(sprintf("Queued %d package(s) from database '%s'\n", $pkgcount, $repodb)); -} - -sub _parse_db_entry { - my $self = shift; - my $content = shift; - my %db; - my $key; - - for my $line (split /\n/, $content) { - if ($line eq '') { - $key = undef; - } elsif ($key) { - push @{$db{$key}}, $line; - } elsif ($line =~ m/^%(.+)%$/) { - $key = $1; - } else { - die "\$key not set. Is the db formatted incorrectly?" unless $key; - } - } - return \%db; -} - -sub _output { - my $self = shift; - my $output = shift; - - return if $output eq ""; - - $output = sprintf("Thread %s: %s", threads->self->tid(), $output); - $self->{output_queue}->enqueue($output); -} - -sub _debug { - my $self = shift; - my $output = shift; - $self->_output($output) if $self->{opts}->{debug}; -} - -sub _verify_db_entry { - my $self = shift; - my $basedir = shift; - my $dbdata = shift; - my $ret = 0; - my $output = ""; - - # verify package exists - my $pkgfile = $basedir.'/'.$dbdata->{FILENAME}[0]; - $self->_debug(sprintf("Checking package %s\n", $dbdata->{FILENAME}[0])); - unless (-e $pkgfile) { - $self->_output(sprintf("Package file missing: %s\n", $pkgfile)); - return 1; - } - - $ret += $self->_verify_package_size($dbdata, $pkgfile); - $ret += $self->_verify_package_checksum($dbdata, $pkgfile) if $self->{opts}->{checksum}; - - return $ret; -} - -sub _verify_package_size { - my $self = shift; - my $dbdata = shift; - my $pkgfile = shift; - - my $csize = $dbdata->{CSIZE}[0]; - my $filesize = (stat($pkgfile))[7]; - unless ($csize == $filesize) { - $self->_output(sprintf("Package file has incorrect size: %d vs %d: %s\n", $csize, $filesize, $pkgfile)); - return 1; - } - return 0; -} - -sub _verify_package_checksum { - my $self = shift; - my $dbdata = shift; - my $pkgfile = shift; - - my $md5 = Digest::MD5->new; - my $sha = Digest::SHA->new(256); - - my $content; - # 128MiB to keep random IO low when using multiple threads (only works for large packages though) - my $chunksize = 1024*1024*128; - open my $fh, "<", $pkgfile; - while (read($fh, $content, $chunksize)) { - $md5->add($content); - $sha->add($content); - } - - my $expected_sha = $dbdata->{SHA256SUM}[0]; - my $expected_md5 = $dbdata->{MD5SUM}[0]; - my $got_md5 = $md5->hexdigest; - my $got_sha = $sha->hexdigest; - - unless ($expected_sha eq $got_sha and $expected_md5 eq $got_md5) { - my $output; - $output .= sprintf "Package file has incorrect checksum: %s\n", $pkgfile; - $output .= sprintf "expected: SHA %s\n", $expected_sha; - $output .= sprintf "got: SHA %s\n", $got_sha; - $output .= sprintf "expected: MD5 %s\n", $expected_md5; - $output .= sprintf "got: MD5 %s\n", $got_md5; - $self->_output($output); - return 1; - } - return 0; -} - |