Mercurial > pub > Yours
diff _test/read_repo.pl @ 0:93b83e3c38d6
initial commit
author | cin |
---|---|
date | Tue, 22 Oct 2013 05:26:56 +0400 |
parents | |
children | 30a88ad2b2fd |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/_test/read_repo.pl Tue Oct 22 05:26:56 2013 +0400 @@ -0,0 +1,172 @@ +#!/usr/bin/perl +use strict; +use warnings; + +use Digest; +use File::Path qw(make_path); +use IMPL::require { + XMLReader => 'XML::LibXML::Reader', + UserAgent => 'LWP::UserAgent', + Request => 'HTTP::Request', + MDParser => 'Yours::Parsers::MDParser', + PMDParser => 'Yours::Parsers::PMDParser', + Dumper => 'Data::Dumper', + Uncompress => 'IO::Uncompress::AnyUncompress' +}; + +BEGIN { + XMLReader->import; + +} + +my %digestTypes = ( + sha512 => 'SHA-512', + sha384 => 'SHA-384', + sha256 => 'SHA-256', + sha1 => 'SHA-1', + md5 => 'MD5' +); + +my $repoUrl = + 'http://download.opensuse.org/repositories/Mono/openSUSE_12.3/'; +my $repoDir = 'repo'; + +my $agent = UserAgent->new(); +$agent->env_proxy(); + +# список файлов, которые должны быть в репозитарии, заполняется по мере загрузки/проверки целостности +my %files; +# список каталогов, которые должны быть в репозитарии, заполняется по мере загрузки/проверки целостности +my %dirs; + +print "loading metadata\n"; + +make_path(File::Spec->catdir($repoDir,'repodata')) unless -d File::Spec->catdir($repoDir,'repodata'); + +# загружаем основные метаданные + +my $mdLocation = "repodata/repomd.xml"; +my $mdFile = MakeLocalName($mdLocation); + +my @initial = ( + $mdLocation, + "repodata/repomd.xml.asc", + "repodata/repomd.xml.key" +); + +foreach my $initLocation (@initial) { + my $file = MakeLocalName($initLocation); + $files{$file} = { location => "${repoUrl}$initLocation"}; + my $resp = $agent->get( + "${repoUrl}$initLocation", + ':content_file' => $file + ); + + die "failed to load metadata $initLocation: ", $resp->code, " ", $resp->message + unless $resp->is_success; +} + +my $parser = MDParser->new(); +$parser->Parse( { location => $mdFile, no_blanks => 1 } ); + +# загружаем метаданные о пакетах +my %indexMd; +foreach my $md (@{$parser->data->{data} || []}) { + $indexMd{$md->{type}} = $md; + + print "\t$md->{type}: $md->{location}\n"; + + my $file = MakeLocalName($md->{location}); + $md->{file} = $file; + $files{$file} = $md; + + unless (-f $file) { + my $resp = $agent->get( + "${repoUrl}$md->{location}", + ':content_file' => $file + ); + die "failed to load $md->{location}: ", $resp->code, " ", $resp->message + unless $resp->is_success; + } +} + +my $primaryMd = $indexMd{primary}{file}; + +my $hdata = Uncompress->new($primaryMd) + or die "failed to uncompress $primaryMd"; + +print "processing contents\n"; + +PMDParser->new(sub { + my ($parser,$package) = @_; + my $location = $package->{location}; + + my $file = MakeLocalName($location); + $files{$file} = $package; + + + + unless (-f $file) { + my $size = sprintf("%0.2fM",$package->{size}/(1024*1024)); + print "\tfetch $location [${size}]\n"; + + $agent->get("${repoUrl}$location", ":content_file" => $file); + } +})->Parse({ IO => $hdata, no_blanks => 1 }); + +print "cleanup\n"; + +foreach my $dir (keys %dirs) { + print "\t$dir\n"; + if (opendir(my $hdir, $dir)) { + while(my $file = readdir $hdir) { + next if $file eq '.' || $file eq '..'; + my $fullPath = File::Spec->catfile($dir,$file); + next unless -f $fullPath; + + unless( $files{$fullPath} ){ + print "\t\t- $file\n"; + unlink $fullPath; + } + } + } +} + +print "validating\n"; + +while(my ($file,$md) = each %files) { + if (my $checksum = $md->{checksum}) { + if( my $type = $digestTypes{lc($checksum->{type})} ) { + if(open my $hfile, "<$file") { + binmode $hfile; + my $digest = Digest->new($type)->addfile($hfile)->hexdigest; + next if $digest eq $checksum->{value}; + + print "\t$file: $digest ne $checksum->{value}\n"; + } else { + print "\t$file: ", -f $file ? "unable to open" : "missing","\n"; + } + } else { + print "\t$file: unknown hash algorithm: $checksum->{type}\n"; + } + } +} + +print "files: ", scalar keys %files, "\n"; +print "dirs: ", scalar keys %dirs, "\n"; +getc; + +sub MakeLocalName { + my ($url) = @_; + + my @parts = split /\//, $url; + my $file = pop @parts; + + my $dir = File::Spec->catdir($repoDir,@parts); + + make_path($dir) + unless $dirs{$dir}; + $dirs{$dir} = 1; + + return File::Spec->catfile($dir,$file); +} \ No newline at end of file