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;