]> git.deb.at Git - deb/packages.git/blob - lib/Packages/Release.pm
Merge branch 'master' into debian-master
[deb/packages.git] / lib / Packages / Release.pm
1 package Packages::Release;
2
3 use strict;
4 use warnings;
5
6 use Date::Parse;
7
8 sub new {
9     my $classname = shift;
10     my $config = shift || {};
11
12     my $self = {};
13     bless( $self, $classname );
14
15     $self->{config} = $config;
16     if ($config->{file}) {
17         $self->parse;
18     }
19
20     return $self;
21 }
22
23 sub parse {
24     my ($self, $file, $config) = @_;
25
26     $self->config(%$config) if $config;
27
28     $self->{config}{file} = $file if $file;
29     return unless $self->{config}{file};
30
31     local $/ = undef;
32
33     open(my $rf, '<', $self->{config}{file})
34         or die "$self->{config}{file}: $!\n";
35
36     my @content = <$rf>;
37     die "too many paragraphs in release file $self->{config}{file})"
38         if @content > 1;
39     return unless @content && $content[0] !~ /^\s*$/;
40
41     my %data = ();
42     $_ = $content[0];
43     chomp;
44     s/\n /\377/g;
45     while (/^(\S+):\s*(.*)\s*$/mg) {
46         my ($key, $value) = ($1, $2);
47         $value =~ s/\377/\n /g;
48         $key =~ tr [A-Z] [a-z];
49         $data{$key} = $value;
50     }
51
52     $data{components} = [ split(/\s+/, $data{components}||'') ];
53     $data{architectures} = [ split(/\s+/, $data{architectures}||'') ];
54     $data{timestamp} = str2time($data{date}) if $data{date};
55
56     read_files_field( \%data, 'md5sum' );
57     read_files_field( \%data, 'sha1' );
58     read_files_field( \%data, 'sha256' );
59
60     $self->{data} = \%data;
61 }
62
63 sub read_files_field {
64     my ($data, $fieldname) = @_;
65
66     return unless $data->{$fieldname};
67     my @lines = split /\n/, $data->{$fieldname};
68
69     foreach (@lines) {
70         next if /^\s*$/;
71         chomp;
72         s/^\s+//;
73
74 #       warn "line=$_ ";
75         my ($checksum, $size, $name) = split /\s+/, $_, 3;
76 #       warn "($checksum, $size, $name)\n";
77
78         (my $basename = $name) =~ s/\.(gz|bz2)$//o;
79         my $ext = 'uncompressed';
80         if ($basename ne $name) {
81             $ext = $1;
82         }
83
84         if ($data->{files}{$basename}{$ext}{size}
85             and $data->{files}{$basename}{$ext}{size} != $size) {
86             die "conflicting sizes for $name: $data->{files}{$basename}{$ext}{size} != $size\n";
87         }
88         $data->{files}{$basename}{$ext}{size} = $size;
89         $data->{files}{$basename}{$ext}{$fieldname} = $checksum;
90
91     }
92     delete($data->{$fieldname});
93 }
94
95 sub check {
96     my ($self, $base, $config) = @_;
97
98     $self->config(%$config) if $config;
99
100     return unless $self->{config}{file};
101     $self->_v("checking Release file $self->{config}{file}\n");
102     my $sigfile = "$self->{config}{file}.gpg";
103
104     if ($self->{config}{keyring}) {
105         $self->_v("\tchecking signature\n");
106
107         die "$self->{config}{keyring} not readable\n"
108             unless -r $self->{config}{keyring};
109
110         if (system('gpg',
111                    '--trust-model', 'always', '--no-default-keyring',
112                    '--keyring', $self->{config}{keyring}, '--verify',
113                    $sigfile, $self->{config}{file})) {
114             die "signature check failed.\n";
115         }
116     }
117
118     $self->{config}{base} = $base if $base;
119     return unless $self->{config}{base};
120     return unless -d $self->{config}{base};
121     return unless $self->{data}{files};
122
123     foreach my $f (sort keys %{$self->{data}{files}}) {
124         $self->_v("checking file $f:\n");
125
126         $self->_check_file($f);
127         $self->_check_file($f, 'gz');
128         $self->_check_file($f, 'bz2');
129     }
130 }
131
132 sub _check_file {
133     my ($self, $file, $ext) = @_;
134
135     my $f = "$self->{config}{base}/$file";
136     $f .= ".$ext" if $ext;
137     $ext ||= 'uncompressed';
138
139     return unless exists $self->{data}{files}{$file}{$ext};
140
141     unless (-f $f) {
142         warn "\t$f doesn't exist or is not a file\n"
143             unless $self->{config}{ignoremissing};
144         return;
145     }
146
147     my $size = -s _;
148     $self->_v("\t$ext: ");
149     if ($size == $self->{data}{files}{$file}{$ext}{size}) {
150         $self->_v('size ok');
151     } else {
152         $self->_ce("$f size NOT OK: $size != $self->{data}{files}{$file}{$ext}{size}");
153         $self->{errors}{$file}{$ext}{size} = $size;
154         return;
155     }
156
157     my %checksums = %{ get_checksums($f) };
158
159     foreach (qw(md5sum sha1 sha256)) {
160         $self->_v(' ');
161         if (!exists $self->{data}{files}{$file}{$ext}{$_}) {
162             $self->_v("$_ not available");
163         } elsif ($checksums{$_} eq $self->{data}{files}{$file}{$ext}{$_}) {
164             $self->_v("$_ ok");
165         } else {
166             $self->_ce("$f $_ NOT OK: $checksums{$_} ne $self->{data}{files}{$file}{$ext}{$_}");
167             $self->{errors}{$file}{$ext}{$_} = $checksums{$_};
168             return;
169         }
170     }
171     $self->_v("\n");
172 }
173
174 sub get_checksums {
175     my ($file) = @_;
176
177     my %checksums;
178
179     $checksums{md5sum} = `md5sum $file 2>/dev/null`;
180     $checksums{sha1} = `sha1sum $file 2>/dev/null`;
181     $checksums{sha256} = `sha256sum $file 2>/dev/null`;
182
183     foreach (qw(md5sum sha1 sha256)) {
184         chomp $checksums{$_};
185         $checksums{$_} = (split(/\s+/, $checksums{$_}, 2))[0];
186     }
187
188     return \%checksums;
189 }
190
191 sub _v {
192     my ($self, @text) = @_;
193
194     print(STDERR @text)  if $self->{config}{verbose};
195 }
196
197 sub _ce {
198     my ($self, @text) = @_;
199
200     if ($self->{config}{dieoncheckerror}) {
201         die(@text,"\n");
202     } else {
203         warn(@text,"\n");
204     }
205 }
206
207 sub config {
208     my ($self, %config) = @_;
209
210     while (my ($k, $v) = each %config) {
211         $self->{config}{$k} = $v;
212
213     }
214 }
215
216 1;