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