annotate _test/read_repo.pl @ 0:93b83e3c38d6

initial commit
author cin
date Tue, 22 Oct 2013 05:26:56 +0400
parents
children 30a88ad2b2fd
Ignore whitespace changes - Everywhere: Within whitespace: At end of lines:
rev   line source
0
93b83e3c38d6 initial commit
cin
parents:
diff changeset
1 #!/usr/bin/perl
93b83e3c38d6 initial commit
cin
parents:
diff changeset
2 use strict;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
3 use warnings;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
4
93b83e3c38d6 initial commit
cin
parents:
diff changeset
5 use Digest;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
6 use File::Path qw(make_path);
93b83e3c38d6 initial commit
cin
parents:
diff changeset
7 use IMPL::require {
93b83e3c38d6 initial commit
cin
parents:
diff changeset
8 XMLReader => 'XML::LibXML::Reader',
93b83e3c38d6 initial commit
cin
parents:
diff changeset
9 UserAgent => 'LWP::UserAgent',
93b83e3c38d6 initial commit
cin
parents:
diff changeset
10 Request => 'HTTP::Request',
93b83e3c38d6 initial commit
cin
parents:
diff changeset
11 MDParser => 'Yours::Parsers::MDParser',
93b83e3c38d6 initial commit
cin
parents:
diff changeset
12 PMDParser => 'Yours::Parsers::PMDParser',
93b83e3c38d6 initial commit
cin
parents:
diff changeset
13 Dumper => 'Data::Dumper',
93b83e3c38d6 initial commit
cin
parents:
diff changeset
14 Uncompress => 'IO::Uncompress::AnyUncompress'
93b83e3c38d6 initial commit
cin
parents:
diff changeset
15 };
93b83e3c38d6 initial commit
cin
parents:
diff changeset
16
93b83e3c38d6 initial commit
cin
parents:
diff changeset
17 BEGIN {
93b83e3c38d6 initial commit
cin
parents:
diff changeset
18 XMLReader->import;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
19
93b83e3c38d6 initial commit
cin
parents:
diff changeset
20 }
93b83e3c38d6 initial commit
cin
parents:
diff changeset
21
93b83e3c38d6 initial commit
cin
parents:
diff changeset
22 my %digestTypes = (
93b83e3c38d6 initial commit
cin
parents:
diff changeset
23 sha512 => 'SHA-512',
93b83e3c38d6 initial commit
cin
parents:
diff changeset
24 sha384 => 'SHA-384',
93b83e3c38d6 initial commit
cin
parents:
diff changeset
25 sha256 => 'SHA-256',
93b83e3c38d6 initial commit
cin
parents:
diff changeset
26 sha1 => 'SHA-1',
93b83e3c38d6 initial commit
cin
parents:
diff changeset
27 md5 => 'MD5'
93b83e3c38d6 initial commit
cin
parents:
diff changeset
28 );
93b83e3c38d6 initial commit
cin
parents:
diff changeset
29
93b83e3c38d6 initial commit
cin
parents:
diff changeset
30 my $repoUrl =
93b83e3c38d6 initial commit
cin
parents:
diff changeset
31 'http://download.opensuse.org/repositories/Mono/openSUSE_12.3/';
93b83e3c38d6 initial commit
cin
parents:
diff changeset
32 my $repoDir = 'repo';
93b83e3c38d6 initial commit
cin
parents:
diff changeset
33
93b83e3c38d6 initial commit
cin
parents:
diff changeset
34 my $agent = UserAgent->new();
93b83e3c38d6 initial commit
cin
parents:
diff changeset
35 $agent->env_proxy();
93b83e3c38d6 initial commit
cin
parents:
diff changeset
36
93b83e3c38d6 initial commit
cin
parents:
diff changeset
37 # список файлов, которые должны быть в репозитарии, заполняется по мере загрузки/проверки целостности
93b83e3c38d6 initial commit
cin
parents:
diff changeset
38 my %files;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
39 # список каталогов, которые должны быть в репозитарии, заполняется по мере загрузки/проверки целостности
93b83e3c38d6 initial commit
cin
parents:
diff changeset
40 my %dirs;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
41
93b83e3c38d6 initial commit
cin
parents:
diff changeset
42 print "loading metadata\n";
93b83e3c38d6 initial commit
cin
parents:
diff changeset
43
93b83e3c38d6 initial commit
cin
parents:
diff changeset
44 make_path(File::Spec->catdir($repoDir,'repodata')) unless -d File::Spec->catdir($repoDir,'repodata');
93b83e3c38d6 initial commit
cin
parents:
diff changeset
45
93b83e3c38d6 initial commit
cin
parents:
diff changeset
46 # загружаем основные метаданные
93b83e3c38d6 initial commit
cin
parents:
diff changeset
47
93b83e3c38d6 initial commit
cin
parents:
diff changeset
48 my $mdLocation = "repodata/repomd.xml";
93b83e3c38d6 initial commit
cin
parents:
diff changeset
49 my $mdFile = MakeLocalName($mdLocation);
93b83e3c38d6 initial commit
cin
parents:
diff changeset
50
93b83e3c38d6 initial commit
cin
parents:
diff changeset
51 my @initial = (
93b83e3c38d6 initial commit
cin
parents:
diff changeset
52 $mdLocation,
93b83e3c38d6 initial commit
cin
parents:
diff changeset
53 "repodata/repomd.xml.asc",
93b83e3c38d6 initial commit
cin
parents:
diff changeset
54 "repodata/repomd.xml.key"
93b83e3c38d6 initial commit
cin
parents:
diff changeset
55 );
93b83e3c38d6 initial commit
cin
parents:
diff changeset
56
93b83e3c38d6 initial commit
cin
parents:
diff changeset
57 foreach my $initLocation (@initial) {
93b83e3c38d6 initial commit
cin
parents:
diff changeset
58 my $file = MakeLocalName($initLocation);
93b83e3c38d6 initial commit
cin
parents:
diff changeset
59 $files{$file} = { location => "${repoUrl}$initLocation"};
93b83e3c38d6 initial commit
cin
parents:
diff changeset
60 my $resp = $agent->get(
93b83e3c38d6 initial commit
cin
parents:
diff changeset
61 "${repoUrl}$initLocation",
93b83e3c38d6 initial commit
cin
parents:
diff changeset
62 ':content_file' => $file
93b83e3c38d6 initial commit
cin
parents:
diff changeset
63 );
93b83e3c38d6 initial commit
cin
parents:
diff changeset
64
93b83e3c38d6 initial commit
cin
parents:
diff changeset
65 die "failed to load metadata $initLocation: ", $resp->code, " ", $resp->message
93b83e3c38d6 initial commit
cin
parents:
diff changeset
66 unless $resp->is_success;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
67 }
93b83e3c38d6 initial commit
cin
parents:
diff changeset
68
93b83e3c38d6 initial commit
cin
parents:
diff changeset
69 my $parser = MDParser->new();
93b83e3c38d6 initial commit
cin
parents:
diff changeset
70 $parser->Parse( { location => $mdFile, no_blanks => 1 } );
93b83e3c38d6 initial commit
cin
parents:
diff changeset
71
93b83e3c38d6 initial commit
cin
parents:
diff changeset
72 # загружаем метаданные о пакетах
93b83e3c38d6 initial commit
cin
parents:
diff changeset
73 my %indexMd;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
74 foreach my $md (@{$parser->data->{data} || []}) {
93b83e3c38d6 initial commit
cin
parents:
diff changeset
75 $indexMd{$md->{type}} = $md;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
76
93b83e3c38d6 initial commit
cin
parents:
diff changeset
77 print "\t$md->{type}: $md->{location}\n";
93b83e3c38d6 initial commit
cin
parents:
diff changeset
78
93b83e3c38d6 initial commit
cin
parents:
diff changeset
79 my $file = MakeLocalName($md->{location});
93b83e3c38d6 initial commit
cin
parents:
diff changeset
80 $md->{file} = $file;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
81 $files{$file} = $md;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
82
93b83e3c38d6 initial commit
cin
parents:
diff changeset
83 unless (-f $file) {
93b83e3c38d6 initial commit
cin
parents:
diff changeset
84 my $resp = $agent->get(
93b83e3c38d6 initial commit
cin
parents:
diff changeset
85 "${repoUrl}$md->{location}",
93b83e3c38d6 initial commit
cin
parents:
diff changeset
86 ':content_file' => $file
93b83e3c38d6 initial commit
cin
parents:
diff changeset
87 );
93b83e3c38d6 initial commit
cin
parents:
diff changeset
88 die "failed to load $md->{location}: ", $resp->code, " ", $resp->message
93b83e3c38d6 initial commit
cin
parents:
diff changeset
89 unless $resp->is_success;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
90 }
93b83e3c38d6 initial commit
cin
parents:
diff changeset
91 }
93b83e3c38d6 initial commit
cin
parents:
diff changeset
92
93b83e3c38d6 initial commit
cin
parents:
diff changeset
93 my $primaryMd = $indexMd{primary}{file};
93b83e3c38d6 initial commit
cin
parents:
diff changeset
94
93b83e3c38d6 initial commit
cin
parents:
diff changeset
95 my $hdata = Uncompress->new($primaryMd)
93b83e3c38d6 initial commit
cin
parents:
diff changeset
96 or die "failed to uncompress $primaryMd";
93b83e3c38d6 initial commit
cin
parents:
diff changeset
97
93b83e3c38d6 initial commit
cin
parents:
diff changeset
98 print "processing contents\n";
93b83e3c38d6 initial commit
cin
parents:
diff changeset
99
93b83e3c38d6 initial commit
cin
parents:
diff changeset
100 PMDParser->new(sub {
93b83e3c38d6 initial commit
cin
parents:
diff changeset
101 my ($parser,$package) = @_;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
102 my $location = $package->{location};
93b83e3c38d6 initial commit
cin
parents:
diff changeset
103
93b83e3c38d6 initial commit
cin
parents:
diff changeset
104 my $file = MakeLocalName($location);
93b83e3c38d6 initial commit
cin
parents:
diff changeset
105 $files{$file} = $package;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
106
93b83e3c38d6 initial commit
cin
parents:
diff changeset
107
93b83e3c38d6 initial commit
cin
parents:
diff changeset
108
93b83e3c38d6 initial commit
cin
parents:
diff changeset
109 unless (-f $file) {
93b83e3c38d6 initial commit
cin
parents:
diff changeset
110 my $size = sprintf("%0.2fM",$package->{size}/(1024*1024));
93b83e3c38d6 initial commit
cin
parents:
diff changeset
111 print "\tfetch $location [${size}]\n";
93b83e3c38d6 initial commit
cin
parents:
diff changeset
112
93b83e3c38d6 initial commit
cin
parents:
diff changeset
113 $agent->get("${repoUrl}$location", ":content_file" => $file);
93b83e3c38d6 initial commit
cin
parents:
diff changeset
114 }
93b83e3c38d6 initial commit
cin
parents:
diff changeset
115 })->Parse({ IO => $hdata, no_blanks => 1 });
93b83e3c38d6 initial commit
cin
parents:
diff changeset
116
93b83e3c38d6 initial commit
cin
parents:
diff changeset
117 print "cleanup\n";
93b83e3c38d6 initial commit
cin
parents:
diff changeset
118
93b83e3c38d6 initial commit
cin
parents:
diff changeset
119 foreach my $dir (keys %dirs) {
93b83e3c38d6 initial commit
cin
parents:
diff changeset
120 print "\t$dir\n";
93b83e3c38d6 initial commit
cin
parents:
diff changeset
121 if (opendir(my $hdir, $dir)) {
93b83e3c38d6 initial commit
cin
parents:
diff changeset
122 while(my $file = readdir $hdir) {
93b83e3c38d6 initial commit
cin
parents:
diff changeset
123 next if $file eq '.' || $file eq '..';
93b83e3c38d6 initial commit
cin
parents:
diff changeset
124 my $fullPath = File::Spec->catfile($dir,$file);
93b83e3c38d6 initial commit
cin
parents:
diff changeset
125 next unless -f $fullPath;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
126
93b83e3c38d6 initial commit
cin
parents:
diff changeset
127 unless( $files{$fullPath} ){
93b83e3c38d6 initial commit
cin
parents:
diff changeset
128 print "\t\t- $file\n";
93b83e3c38d6 initial commit
cin
parents:
diff changeset
129 unlink $fullPath;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
130 }
93b83e3c38d6 initial commit
cin
parents:
diff changeset
131 }
93b83e3c38d6 initial commit
cin
parents:
diff changeset
132 }
93b83e3c38d6 initial commit
cin
parents:
diff changeset
133 }
93b83e3c38d6 initial commit
cin
parents:
diff changeset
134
93b83e3c38d6 initial commit
cin
parents:
diff changeset
135 print "validating\n";
93b83e3c38d6 initial commit
cin
parents:
diff changeset
136
93b83e3c38d6 initial commit
cin
parents:
diff changeset
137 while(my ($file,$md) = each %files) {
93b83e3c38d6 initial commit
cin
parents:
diff changeset
138 if (my $checksum = $md->{checksum}) {
93b83e3c38d6 initial commit
cin
parents:
diff changeset
139 if( my $type = $digestTypes{lc($checksum->{type})} ) {
93b83e3c38d6 initial commit
cin
parents:
diff changeset
140 if(open my $hfile, "<$file") {
93b83e3c38d6 initial commit
cin
parents:
diff changeset
141 binmode $hfile;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
142 my $digest = Digest->new($type)->addfile($hfile)->hexdigest;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
143 next if $digest eq $checksum->{value};
93b83e3c38d6 initial commit
cin
parents:
diff changeset
144
93b83e3c38d6 initial commit
cin
parents:
diff changeset
145 print "\t$file: $digest ne $checksum->{value}\n";
93b83e3c38d6 initial commit
cin
parents:
diff changeset
146 } else {
93b83e3c38d6 initial commit
cin
parents:
diff changeset
147 print "\t$file: ", -f $file ? "unable to open" : "missing","\n";
93b83e3c38d6 initial commit
cin
parents:
diff changeset
148 }
93b83e3c38d6 initial commit
cin
parents:
diff changeset
149 } else {
93b83e3c38d6 initial commit
cin
parents:
diff changeset
150 print "\t$file: unknown hash algorithm: $checksum->{type}\n";
93b83e3c38d6 initial commit
cin
parents:
diff changeset
151 }
93b83e3c38d6 initial commit
cin
parents:
diff changeset
152 }
93b83e3c38d6 initial commit
cin
parents:
diff changeset
153 }
93b83e3c38d6 initial commit
cin
parents:
diff changeset
154
93b83e3c38d6 initial commit
cin
parents:
diff changeset
155 print "files: ", scalar keys %files, "\n";
93b83e3c38d6 initial commit
cin
parents:
diff changeset
156 print "dirs: ", scalar keys %dirs, "\n";
93b83e3c38d6 initial commit
cin
parents:
diff changeset
157 getc;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
158
93b83e3c38d6 initial commit
cin
parents:
diff changeset
159 sub MakeLocalName {
93b83e3c38d6 initial commit
cin
parents:
diff changeset
160 my ($url) = @_;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
161
93b83e3c38d6 initial commit
cin
parents:
diff changeset
162 my @parts = split /\//, $url;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
163 my $file = pop @parts;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
164
93b83e3c38d6 initial commit
cin
parents:
diff changeset
165 my $dir = File::Spec->catdir($repoDir,@parts);
93b83e3c38d6 initial commit
cin
parents:
diff changeset
166
93b83e3c38d6 initial commit
cin
parents:
diff changeset
167 make_path($dir)
93b83e3c38d6 initial commit
cin
parents:
diff changeset
168 unless $dirs{$dir};
93b83e3c38d6 initial commit
cin
parents:
diff changeset
169 $dirs{$dir} = 1;
93b83e3c38d6 initial commit
cin
parents:
diff changeset
170
93b83e3c38d6 initial commit
cin
parents:
diff changeset
171 return File::Spec->catfile($dir,$file);
93b83e3c38d6 initial commit
cin
parents:
diff changeset
172 }