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     my $sigfile = "$self->{config}{file}.gpg";
 102
 103     if ($self->{config}{keyring}) {
 104         $self->_v("checking signature\n");
 105
 106         die "$self->{config}{keyring} not readable\n"
 107             unless -r $self->{config}{keyring};
 108
 109         if (system('gpg',
 110                    '--trust-model', 'always', '--no-default-keyring',
 111                    '--keyring', $self->{config}{keyring}, '--verify',
 112                    $sigfile, $self->{config}{file})) {
 113             die "signature check failed.\n";
 114         }
 115     }
 116
 117     $self->{config}{base} = $base if $base;
 118     return unless $self->{config}{base};
 119     return unless -d $self->{config}{base};
 120     return unless $self->{data}{files};
 121
 122     foreach my $f (sort keys %{$self->{data}{files}}) {
 123         $self->_v("checking file $f:\n");
 124
 125         $self->_check_file($f);
 126         $self->_check_file($f, 'gz');
 127         $self->_check_file($f, 'bz2');
 128     }
 129 }
 130
 131 sub _check_file {
 132     my ($self, $file, $ext) = @_;
 133
 134     my $f = "$self->{config}{base}/$file";
 135     $f .= ".$ext" if $ext;
 136     $ext ||= 'uncompressed';
 137
 138     return unless exists $self->{data}{files}{$file}{$ext};
 139
 140     unless (-f $f) {
 141         warn "\t$f doesn't exist or is not a file\n"
 142             unless $self->{config}{ignoremissing};
 143         return;
 144     }
 145
 146     my $size = -s _;
 147     $self->_v("\t$ext: ");
 148     if ($size == $self->{data}{files}{$file}{$ext}{size}) {
 149         $self->_v('size ok');
 150     } else {
 151         $self->_ce("$f size NOT OK: $size != $self->{data}{files}{$file}{$ext}{size}");
 152         $self->{errors}{$file}{$ext}{size} = $size;
 153         return;
 154     }
 155
 156     my %checksums = %{ get_checksums($f) };
 157
 158     foreach (qw(md5sum sha1 sha256)) {
 159         $self->_v(' ');
 160         if (!exists $self->{data}{files}{$file}{$ext}{$_}) {
 161             $self->_v("$_ not available");
 162         } elsif ($checksums{$_} eq $self->{data}{files}{$file}{$ext}{$_}) {
 163             $self->_v("$_ ok");
 164         } else {
 165             $self->_ce("$f $_ NOT OK: $checksums{$_} ne $self->{data}{files}{$file}{$ext}{$_}");
 166             $self->{errors}{$file}{$ext}{$_} = $checksums{$_};
 167             return;
 168         }
 169     }
 170     $self->_v("\n");
 171 }
 172
 173 sub get_checksums {
 174     my ($file) = @_;
 175
 176     my %checksums;
 177
 178     $checksums{md5sum} = `md5sum $file 2>/dev/null`;
 179     $checksums{sha1} = `sha1sum $file 2>/dev/null`;
 180     $checksums{sha256} = `sha256sum $file 2>/dev/null`;
 181
 182     foreach (qw(md5sum sha1 sha256)) {
 183         chomp $checksums{$_};
 184         $checksums{$_} = (split(/\s+/, $checksums{$_}, 2))[0];
 185     }
 186
 187     return \%checksums;
 188 }
 189
 190 sub _v {
 191     my ($self, @text) = @_;
 192
 193     print(STDERR @text)  if $self->{config}{verbose};
 194 }
 195
 196 sub _ce {
 197     my ($self, @text) = @_;
 198
 199     if ($self->{config}{dieoncheckerror}) {
 200         die(@text,"\n");
 201     } else {
 202         warn(@text,"\n");
 203     }
 204 }
 205
 206 sub config {
 207     my ($self, %config) = @_;
 208
 209     while (my ($k, $v) = each %config) {
 210         $self->{config}{$k} = $v;
 211
 212     }
 213 }
 214
 215 1;