From: Frank Lichtenheld <frank@lichtenheld.de>
Date: Fri, 25 Apr 2008 20:15:19 +0000 (+0200)
Subject: Packages::Release: Module for parsing and checking Release file
X-Git-Url: https://git.deb.at/w?a=commitdiff_plain;h=b375462e9421444b9cb5d9027615b897572a453f;p=deb%2Fpackages.git

Packages::Release: Module for parsing and checking Release file
---

diff --git a/lib/Packages/Release.pm b/lib/Packages/Release.pm
new file mode 100644
index 0000000..488233d
--- /dev/null
+++ b/lib/Packages/Release.pm
@@ -0,0 +1,215 @@
+package Packages::Release;
+
+use strict;
+use warnings;
+
+use Date::Parse;
+
+sub new {
+    my $classname = shift;
+    my $config = shift || {};
+
+    my $self = {};
+    bless( $self, $classname );
+
+    $self->{config} = $config;
+    if ($config->{file}) {
+	$self->parse;
+    }
+
+    return $self;
+}
+
+sub parse {
+    my ($self, $file, $config) = @_;
+
+    $self->config(%$config) if $config;
+
+    $self->{config}{file} = $file if $file;
+    return unless $self->{config}{file};
+
+    local $/ = undef;
+
+    open(my $rf, '<', $self->{config}{file})
+	or die "$self->{config}{file}: $!\n";
+
+    my @content = <$rf>;
+    die "too many paragraphs in release file $self->{config}{file})"
+	if @content > 1;
+    return unless @content && $content[0] !~ /^\s*$/;
+
+    my %data = ();
+    $_ = $content[0];
+    chomp;
+    s/\n /\377/g;
+    while (/^(\S+):\s*(.*)\s*$/mg) {
+	my ($key, $value) = ($1, $2);
+	$value =~ s/\377/\n /g;
+	$key =~ tr [A-Z] [a-z];
+	$data{$key} = $value;
+    }
+
+    $data{components} = [ split(/\s+/, $data{components}||'') ];
+    $data{architectures} = [ split(/\s+/, $data{architectures}||'') ];
+    $data{timestamp} = str2time($data{date}) if $data{date};
+
+    read_files_field( \%data, 'md5sum' );
+    read_files_field( \%data, 'sha1' );
+    read_files_field( \%data, 'sha256' );
+
+    $self->{data} = \%data;
+}
+
+sub read_files_field {
+    my ($data, $fieldname) = @_;
+
+    return unless $data->{$fieldname};
+    my @lines = split /\n/, $data->{$fieldname};
+
+    foreach (@lines) {
+	next if /^\s*$/;
+	chomp;
+	s/^\s+//;
+
+#	warn "line=$_ ";
+	my ($checksum, $size, $name) = split /\s+/, $_, 3;
+#	warn "($checksum, $size, $name)\n";
+
+	(my $basename = $name) =~ s/\.(gz|bz2)$//o;
+	my $ext = 'uncompressed';
+	if ($basename ne $name) {
+	    $ext = $1;
+	}
+
+	if ($data->{files}{$basename}{$ext}{size}
+	    and $data->{files}{$basename}{$ext}{size} != $size) {
+	    die "conflicting sizes for $name: $data->{files}{$basename}{$ext}{size} != $size\n";
+	}
+	$data->{files}{$basename}{$ext}{size} = $size;
+	$data->{files}{$basename}{$ext}{$fieldname} = $checksum;
+
+    }
+    delete($data->{$fieldname});
+}
+
+sub check {
+    my ($self, $base, $config) = @_;
+
+    $self->config(%$config) if $config;
+
+    return unless $self->{config}{file};
+    my $sigfile = "$self->{config}{file}.gpg";
+
+    if ($self->{config}{keyring}) {
+	$self->_v("checking signature\n");
+
+	die "$self->{config}{keyring} not readable\n"
+	    unless -r $self->{config}{keyring};
+
+	if (system('gpg',
+		   '--trust-model', 'always', '--no-default-keyring',
+		   '--keyring', $self->{config}{keyring}, '--verify',
+		   $sigfile, $self->{config}{file})) {
+	    die "signature check failed.\n";
+	}
+    }
+
+    $self->{config}{base} = $base if $base;
+    return unless $self->{config}{base};
+    return unless -d $self->{config}{base};
+    return unless $self->{data}{files};
+
+    foreach my $f (sort keys %{$self->{data}{files}}) {
+	$self->_v("checking file $f:\n");
+
+	$self->_check_file($f);
+	$self->_check_file($f, 'gz');
+	$self->_check_file($f, 'bz2');
+    }
+}
+
+sub _check_file {
+    my ($self, $file, $ext) = @_;
+
+    my $f = "$self->{config}{base}/$file";
+    $f .= ".$ext" if $ext;
+    $ext ||= 'uncompressed';
+
+    return unless exists $self->{data}{files}{$file}{$ext};
+
+    unless (-f $f) {
+	warn "\t$f doesn't exist or is not a file\n"
+	    unless $self->{config}{ignoremissing};
+	return;
+    }
+
+    my $size = -s _;
+    $self->_v("\t$ext: ");
+    if ($size == $self->{data}{files}{$file}{$ext}{size}) {
+	$self->_v('size ok');
+    } else {
+	$self->_ce("$f size NOT OK: $size != $self->{data}{files}{$file}{$ext}{size}");
+	$self->{errors}{$file}{$ext}{size} = $size;
+	return;
+    }
+
+    my %checksums = %{ get_checksums($f) };
+
+    foreach (qw(md5sum sha1 sha256)) {
+	$self->_v(' ');
+	if (!exists $self->{data}{files}{$file}{$ext}{$_}) {
+	    $self->_v("$_ not available");
+	} elsif ($checksums{$_} eq $self->{data}{files}{$file}{$ext}{$_}) {
+	    $self->_v("$_ ok");
+	} else {
+	    $self->_ce("$f $_ NOT OK: $checksums{$_} ne $self->{data}{files}{$file}{$ext}{$_}");
+	    $self->{errors}{$file}{$ext}{$_} = $checksums{$_};
+	    return;
+	}
+    }
+    $self->_v("\n");
+}
+
+sub get_checksums {
+    my ($file) = @_;
+
+    my %checksums;
+
+    $checksums{md5sum} = `md5sum $file 2>/dev/null`;
+    $checksums{sha1} = `sha1sum $file 2>/dev/null`;
+    $checksums{sha256} = `sha256sum $file 2>/dev/null`;
+
+    foreach (qw(md5sum sha1 sha256)) {
+	chomp $checksums{$_};
+	$checksums{$_} = (split(/\s+/, $checksums{$_}, 2))[0];
+    }
+
+    return \%checksums;
+}
+
+sub _v {
+    my ($self, @text) = @_;
+
+    print(STDERR @text)  if $self->{config}{verbose};
+}
+
+sub _ce {
+    my ($self, @text) = @_;
+
+    if ($self->{config}{dieoncheckerror}) {
+	die(@text,"\n");
+    } else {
+	warn(@text,"\n");
+    }
+}
+
+sub config {
+    my ($self, %config) = @_;
+
+    while (my ($k, $v) = each %config) {
+	$self->{config}{$k} = $v;
+
+    }
+}
+
+1;