Subversion Repositories

package DebPool::Release;

###

#

# DebPool::Release - Module for generating and installing Release files

#

# Copyright 2003-2004 Joel Aelwyn. All rights reserved.

# 

# Redistribution and use in source and binary forms, with or without

# modification, are permitted provided that the following conditions

# are met:

# 1. Redistributions of source code must retain the above copyright

#    notice, this list of conditions and the following disclaimer.

# 2. Redistributions in binary form must reproduce the above copyright

#    notice, this list of conditions and the following disclaimer in the

#    documentation and/or other materials provided with the distribution.

# 3. Neither the name of the Author nor the names of any contributors

#    may be used to endorse or promote products derived from this software

#    without specific prior written permission.

# 

# THIS SOFTWARE IS PROVIDED BY THE AUTHOR AND CONTRIBUTORS ``AS IS'' AND

# ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE

# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE

# ARE DISCLAIMED.  IN NO EVENT SHALL THE AUTHOR OR CONTRIBUTORS BE LIABLE

# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL

# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS

# OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION)

# HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT

# LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY

# OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF

# SUCH DAMAGE.

#

# $Id: Release.pm 27 2004-11-07 03:06:59Z joel $

#

###

# We use 'our', so we must have at least Perl 5.6

require 5.006_000;

# Always good ideas.

use strict;

use warnings;

use POSIX; # strftime

use File::Temp qw(tempfile);

# We need the Digest modules so that we can calculate the proper checksums.

use Digest::MD5;

use Digest::SHA1;

### Module setup

BEGIN {

    use Exporter ();

    our ($VERSION, @ISA, @EXPORT, @EXPORT_OK, %EXPORT_TAGS);

    # Version checking

    $VERSION = '0.1.5';

    @ISA = qw(Exporter);

    @EXPORT = qw(

    );

    @EXPORT_OK = qw(

        &Generate_Release_Triple

        &Install_Release

    );

    %EXPORT_TAGS = (

        'functions' => [qw(&Generate_Release_Triple &Install_Release)],

        'vars' => [qw()],

    );

}

### Exported package globals

### Non-exported package globals

# Thread-safe? What's that? Package global error value. We don't export

# this directly, because it would conflict with other modules.

our($Error);

# Magic filenames - these are files we want to include hashes for in a

# Release file.

my(@SigFiles) = (

    'Packages',

    'Sources',

    'Packages.gz',

    'Sources.gz',

);

### File lexicals

# None

### Constant functions

# None

### Meaningful functions

# Compute_Checksums($basepath, $filename)

#

# Compute MD5 and SHA1 checksums of a file. The checksums are stored,

# together with the filename and the file size, in a hash, a reference

# to which is returned.

#

# Returns undef on error.

sub Compute_Checksums {

    my($basepath, $filename) = @_;

    my($fh);

    # Open the file and read in the contents. This could be a very

    # large amount of data, but unfortunately, both Digets routines

    # require the entire thing at once.

    unless (open($fh, '<', "$basepath/$filename") && binmode($fh)) {

        $Error = "Couldn't open file '$basepath/$filename' for reading.";

        return undef;

    }

    # Grab the filesize from stat()

    my(@stat) = stat($fh);

    my $ret = {

        'File' => $filename,

        'Size' => $stat[7],

    };

    my %digesters = ('MD5Sum' => new Digest::MD5,

                     'SHA1' => new Digest::SHA1);

    # Now calculate the checksums and put them into the hashes.

    while (my ($algo, $dig) = each %digesters) {

        eval {

            seek $fh, 0, 0 or die $!;

            $ret->{$algo} = $dig->addfile($fh)->hexdigest;

        };

        if ($@) {

            $Error = "Failed to compute $algo for '$basepath/$filename': $@";

            close $fh;

            return undef;

        }

    }

    return $ret;

}

# Generate_Release_Triple($archive, $component, $architecture, $version)

#

# Generate a Release file for a specific dist/component/arch, in the

# temp/working area, and return the filename.

#

# Returns undef (and sets $Error) on error.

sub Generate_Release_Triple {

    use DebPool::Config qw(:vars);

    use DebPool::Dirs qw(:functions);

    my($archive, $component, $architecture, $version) = @_;

    my(@Checksums);

    # Before we bother to do much else, generate the MD5 and SHA1 checksums

    # we'll need later. This is mostly so that we can catch errors before

    # ever bothering to open a tempfile.

    # First, grab a list of files from the directory.

    my($dirpath) = "${Options{'dists_dir'}}/";

    $dirpath .= Archfile($archive, $component, $architecture, 1);

    if (!opendir(RELDIR, $dirpath)) {

        $Error = "Couldn't open directory '$dirpath'.";

        return undef;

    }

    my(@dirfiles) = readdir(RELDIR);

    close(RELDIR);

    # Now, for each file, generate MD5 and SHA1 checksums, and put them

    # into Checksums for later use (assuming it's a file we care about).

    foreach my $ck_file (@dirfiles) {

        if (0 == grep(/^$ck_file$/, @SigFiles)) { # We don't care about it.

            next;

        }

        my $checksum = Compute_Checksums($dirpath, $ck_file) or return undef;

        push @Checksums, $checksum;

    }

    # Open a secure tempfile, and write the headers to it.

    my($tmpfile_handle, $tmpfile_name) = tempfile();

    print $tmpfile_handle "Archive: $archive\n";

    print $tmpfile_handle "Component: $component\n";

    print $tmpfile_handle "Version: $version\n";

    print $tmpfile_handle "Origin: $Options{'release_origin'}\n";

    print $tmpfile_handle "Label: $Options{'release_label'}\n";

    print $tmpfile_handle "Architecture: $architecture\n";

    # If the archive (aka distribution) appears in release_noauto, print

    # the appropriate directive.

    if (0 != grep(/^$archive$/, @{$Options{'release_noauto'}})) {

        print $tmpfile_handle "NotAutomatic: yes\n";

    }

    print $tmpfile_handle "Description: $Options{'release_description'}\n";

    # Now print MD5 and SHA1 checksum lists.

    foreach my $algo ('MD5Sum', 'SHA1') {

        print $tmpfile_handle "$algo:\n";

        foreach my $checksum (@Checksums) {

            printf $tmpfile_handle " %s %8d %s\n", $checksum->{$algo},

            $checksum->{'Size'}, $checksum->{'File'};

        }

    }

    close($tmpfile_handle);

    return $tmpfile_name;

}

# Generate_Release_Dist($archive, $version, @files)

#

# Generate top-level Release file for a specific distribution, covering the

# given files, in the temp/working area, and return the filename.

#

# Filenames in @files should be relative to <dists_dir>/<archive>, with no

# leading slash (ie, main/binary-i386/Packages).

#

# Returns undef (and sets $Error) on error.

sub Generate_Release_Dist {

    use DebPool::Config qw(:vars);

    my($archive) = shift(@_);

    my($version) = shift(@_);

    my(@files) = @_;

    my(@Checksums);

    my($dists_dir) = $Options{'dists_dir'};

    # Before we bother to do much else, generate the MD5 and SHA1 checksums

    # we'll need later. This is mostly so that we can catch errors before

    # ever bothering to open a tempfile.

    my($file);

    for $file (@files) {

        # Now, for each file, generate MD5 and SHA1 checksums, and put them

        # into Checksums for later use (assuming it's a file we care about).

        my $checksum = Compute_Checksums("${dists_dir}/${archive}", $file) or return undef;

        push @Checksums, $checksum;

    }

    # Open a secure tempfile, and set up some variables.

    my($tmpfile_handle, $tmpfile_name) = tempfile();

    my($now_822) = strftime('%a, %d %b %Y %H:%M:%S %Z', localtime());

    my(@archs) = grep(!/^source$/, @{$Options{'archs'}});

    my($suite) = $Options{'reverse_dists'}->{$archive};

    # Write the headers into the Release tempfile

    print $tmpfile_handle "Origin: ${Options{'release_origin'}}\n";

    print $tmpfile_handle "Label: ${Options{'release_label'}}\n";

    print $tmpfile_handle "Suite: ${suite}\n";

    print $tmpfile_handle "Codename: ${archive}\n";

    print $tmpfile_handle "Date: ${now_822}\n";

    print $tmpfile_handle "Architectures: " . join(' ', @archs) . "\n";

    print $tmpfile_handle "Components: " . join(' ', @{$Options{'sections'}}) . "\n";

    print $tmpfile_handle "Description: $Options{'release_description'}\n";

    # Now print MD5 and SHA1 checksum lists.

    foreach my $algo ('MD5Sum', 'SHA1') {

        print $tmpfile_handle "$algo:\n";

        foreach my $checksum (@Checksums) {

            printf $tmpfile_handle " %s %8d %s\n", $checksum->{$algo},

            $checksum->{'Size'}, $checksum->{'File'};

        }

    }

    close($tmpfile_handle);

    return $tmpfile_name;

}

# Install_Release($archive, $component, $architecture, $release, $signature)

#

# Installs a release file and an optional signature file to the

# distribution directory specified by the ($archive, $component,

# $architecture) triple, or $archive if $component and $architecture are

# undefined. Returns 0 (and sets $Error) on failure, 1 on

# success.

sub Install_Release {

    use DebPool::Config qw(:vars);

    use DebPool::Util qw(:functions);

    my($archive, $component, $architecture, $release, $signature) = @_;

    my($dists_file_mode) = $Options{'dists_file_mode'};

    my($inst_dir);

    if (defined($architecture) && defined($component)) {

        $inst_dir = "${Options{'dists_dir'}}/";

        $inst_dir .= Archfile($archive, $component, $architecture, 1);

    } else {

        $inst_dir = "${Options{'dists_dir'}}/${archive}";

    }

    # Now install the file(s) into the appropriate place(s).

    if (!Move_File($release, "${inst_dir}/Release", $dists_file_mode)) {

        $Error = "Couldn't install Release file '${release}' to ";

        $Error .= "'${inst_dir}': ${DebPool::Util::Error}";

        return 0;

    }

    if (defined($signature) && !Move_File($signature, "${inst_dir}/Release.gpg",

            $dists_file_mode)) {

        $Error = "Couldn't install Signature file '${signature}' to ";

        $Error .= "'${inst_dir}': ${DebPool::Util::Error}";

        return 0;

    }

    return 1;

}

END {}

1;

__END__

# vim:set tabstop=4 expandtab: