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