File Coverage

blib/lib/Arepa/Repository.pm

Criterion	Covered	Total	%
statement	19	21	90.4
branch			n/a
condition			n/a
subroutine	7	7	100.0
pod			n/a
total	26	28	92.8

package Arepa::Repository;

use strict;
use warnings;

use Carp qw(croak);
use IO::Zlib;

use Parse::Debian::PackageDesc;
use Arepa::Config;
use Arepa::PackageDb;

sub new {
    my ($class, $config_path) = @_;

    my $config = Arepa::Config->new($config_path);
    my $self = bless {
        config_path => $config_path,
        config      => $config,
        package_db  => Arepa::PackageDb->new($config->get_key('package_db')),
    }, $class;

    return $self;
}

sub config_key_exists {
    my ($self, $key) = @_;
    return $self->{config}->key_exists($key);
}

sub get_config_key {
    my ($self, $key) = @_;
    return $self->{config}->get_key($key);
}

sub get_distributions {
    my ($self) = @_;

    my $repository_config_file = $self->get_config_key('repository:path');
    my $distributions_config_file = "$repository_config_file/conf/distributions";
    open F, $distributions_config_file or croak "Can't open configuration file ";
    my ($line, $repo_attrs, @repos);
    while ($line = ) {
        if ($line =~ /^\s*$/) {
            push @repos, $repo_attrs if (ref($repo_attrs) && %$repo_attrs);
            $repo_attrs = {};
        }
        elsif ($line =~ /^([^:]+):\s+(.+)/i) {
            $repo_attrs->{lc($1)} = $2;
        }
    }
    push @repos, $repo_attrs if (ref($repo_attrs) && %$repo_attrs);
    close F;
    return @repos;
}

sub get_architectures {
    my ($self) = @_;

    my @archs;
    foreach my $repo ($self->get_distributions) {
        foreach my $arch (split(/\s+/, $repo->{architectures})) {
            push @archs, $arch unless grep { $arch eq $_ }
                                           @archs;
        }
    }
    return @archs;
}

sub insert_source_package {
    my ($self, $dsc_file, $distro, %user_opts) = @_;

    use Parse::Debian::PackageDesc;
    my $parsed_dsc = Parse::Debian::PackageDesc->new($dsc_file);
    my @archs = $parsed_dsc->architecture;
    my $arch  = (scalar @archs > 1) ? 'any' : $archs[0];
    my %args = (name         => $parsed_dsc->name,
                full_version => $parsed_dsc->version,
                architecture => $arch,
                distribution => $distro);

    if (exists $user_opts{comments}) {
        $args{comments} = $user_opts{comments};
        delete $user_opts{comments};
    }

    my $canonical_distro = $distro;
    if ($user_opts{canonical_distro}) {
        $canonical_distro = $user_opts{canonical_distro};
        delete $user_opts{canonical_distro};
    }

    my $r = $self->_execute_reprepro('includedsc',
                                     $canonical_distro,
                                     $dsc_file,
                                     %user_opts);
    if ($r) {
        return $self->{package_db}->insert_source_package(%args);
    }
    else {
        return 0;
    }
}

sub insert_binary_package {
    my ($self, $deb_file, $distro) = @_;

    return $self->_execute_reprepro('includedeb',
                                    $distro,
                                    $deb_file);
}

sub _shell_escape {
    my ($self, $arg) = @_;
    if (defined $arg) {
        $arg =~ s/'/\\'/go;
        return "'$arg'";
    }

    return "";
}

sub last_cmd_output {
    my ($self) = @_;
    $self->{last_cmd_output};
}

sub _execute_reprepro {
    my ($self, $mode, $distro, $file_path, %extra_args) = @_;

    my $repo_path = $self->get_config_key("repository:path");
    $mode      = $self->_shell_escape($mode);
    $distro    = $self->_shell_escape($distro);
    $file_path = $self->_shell_escape($file_path);
    # Extra arguments
    my $extra = "";
    foreach my $arg (keys %extra_args) {
        if ($arg eq 'section') {
            $extra .= " --section " . $self->_shell_escape($extra_args{$arg});
        }
        elsif ($arg eq 'priority') {
            $extra .= " --priority " . $self->_shell_escape($extra_args{$arg})
        }
        else {
            croak "Don't know anything about argument '$arg'";
        }
    }
    # GNUPG home directory
    if ($self->config_key_exists('web_ui:gpg_homedir')) {
        my $gpg_homedir = $self->get_config_key('web_ui:gpg_homedir');
        if (defined $gpg_homedir && $gpg_homedir) {
            $extra .= " --gnupghome '$gpg_homedir'";
        }
    }

    my $cmd = "reprepro -b$repo_path $extra $mode $distro $file_path 2>&1";
    my $umask = umask;
    umask($umask & 0707);           # Always allow group permissions
    $self->{last_cmd_output} = `$cmd`;
    my $status = $?;
    umask $umask;
    if ($status == 0) {
        return 1;
    }
    else {
        print STDERR "Reprepro command failed: '$cmd'\n";
        return 0;
    }
}

sub get_package_list {
    my ($self) = @_;

    my %pkg_list;
    my $repo_path = $self->get_config_key("repository:path");
    foreach my $codename (map { $_->{codename} } $self->get_distributions) {
        my $cmd = "reprepro -b$repo_path list $codename";
        open PIPE, "$cmd |";
        while () {
            my ($distro, $comp, $arch, $pkg_name, $pkg_version) =
                /(.+)\|(.+)\|(.+): ([^ ]+) (.+)/;
            $pkg_list{$pkg_name}->{"$distro/$comp"}->{$pkg_version} ||= [];
            push @{$pkg_list{$pkg_name}->{"$distro/$comp"}->{$pkg_version}},
                 $arch;
        }
        close PIPE;
    }
    return %pkg_list;
}

sub get_source_package_information {
    my ($self, $package_name, $distro) = @_;

    my $repo_path = $self->get_config_key('repository:path');
    my $sources_file_path = File::Spec->catfile($repo_path,
                                                'dists',
                                                $distro,
                                                'main',
                                                'source',
                                                'Sources.gz');

    my $fh = new IO::Zlib;
    my $current_pkg = "";
    my %props;
    if ($fh->open($sources_file_path, "rb")) {
        while (<$fh>) {
            if (/^Package: (.+)/) {
                $current_pkg = $1;
            }
            elsif ($current_pkg eq $package_name) {
                if (/^([^:]+): (.+)/) {
                    $props{lc($1)} = $2;
                }
            }
        }
        $fh->close;
    }

    return %props;
}

sub get_binary_package_information {
    my ($self, $package_name, $distro, $arch) = @_;

    my $repo_path = $self->get_config_key('repository:path');
    my $packages_file_path = File::Spec->catfile($repo_path,
                                                 'dists',
                                                 $distro,
                                                 'main',
                                                 'binary-' . $arch,
                                                 'Packages');

    my $current_pkg = "";
    my %props;
    open F, $packages_file_path;
    while () {
        if (/^Package: (.+)/) {
            $current_pkg = $1;
        }
        elsif ($current_pkg eq $package_name) {
            if (/^([^:]+): (.+)/) {
                $props{lc($1)} = $2;
            }
        }
    }
    close F;

    return %props;
}

sub _all_names_for_distro {
    my ($self, %properties) = @_;

    my @aliases = ($properties{codename});
    if (defined $properties{suite}) {
        push @aliases, $properties{suite};
    }
    return @aliases;
}

sub add_distribution {
    my ($self, %properties) = @_;

    my $repository_path = $self->get_config_key('repository:path');
    my $distributions_config_file = "$repository_path/conf/distributions";


    if (! defined $properties{codename}) {
        return 0;
    }
    # Duplicate names of any kind
    my @new_distro_names = $self->_all_names_for_distro(%properties);
    my @existing_distro_names = map { $self->_all_names_for_distro(%$_) }
                                    $self->get_distributions;
    foreach my $distro_name (@new_distro_names) {
        if (grep { $_ eq $distro_name } @existing_distro_names) {
            return 0;
        }
    }

    # Everything seems alright, serialise the distribution properties
    my $serialised_distro = join("\n",
                                 map { ucfirst($_) . ": $properties{$_}"  }
                                     keys %properties);

    open F, ">>$distributions_config_file" or do {
        print STDERR "Can't open $distributions_config_file for writing\n";
        return 0;
    };
    print F <

$serialised_distro
EOD
    close F;

    # Now, update the repository with the new distro
    $self->_execute_reprepro('export', $properties{codename});
}

sub sign_distribution {
    my ($self, $distro_name) = @_;

    my $repo_path = $self->get_config_key('repository:path');
    my $release_file_path = File::Spec->catfile($repo_path,
                                                "dists",
                                                $distro_name,
                                                "Release");
    unlink "$release_file_path.gpg";

    my $extra_options = "";
    if ($self->config_key_exists('repository:signature:id')) {
        my $key_id = $self->get_config_key('repository:signature:id');
        $extra_options = " -u $key_id";
    }
    my $gpg_cmd = "gpg --batch -abs $extra_options -o $release_file_path.gpg $release_file_path >/dev/null";

    return (system($gpg_cmd) == 0);
}

sub sync_remote {
    my ($self) = @_;

    my $repo_path = $self->get_config_key('repository:path');
    if ($self->config_key_exists('repository:remote_path')) {
        my $remote_repo_path = $self->get_config_key('repository:remote_path');
        my $rsync_cmd = "rsync -avz --delete $repo_path $remote_repo_path";
        if (system($rsync_cmd) == 0) {
            return 1;
        }
        else {
            print STDERR "Command was '$rsync_cmd'\n";
            return 0;
        }
    }
    return 0;
}

sub is_synced {
    my ($self) = @_;

    my $repo_path = $self->get_config_key('repository:path');
    if ($self->config_key_exists('repository:remote_path')) {
        my $remote_repo_path = $self->get_config_key('repository:remote_path');
        my $rsync_cmd = "rsync -avz --delete --dry-run --out-format='AREPA_CHANGE %i' $repo_path $remote_repo_path";
        my $changes = 0;

        open RSYNCOUTPUT, "$rsync_cmd |";
        while () {
            next unless /^AREPA_CHANGE/;
            if (/^AREPA_CHANGE [^.]/) {
                $changes = 1;
            }
        }
        close RSYNCOUTPUT;

        return (! $changes);
    }
    return 0;
}

1;

__END__