view release on metacpan or  search on metacpan

lib/Arepa/Repository.pm  view on Meta::CPAN

        $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 (<PIPE>) {
            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;

lib/Arepa/Repository.pm  view on Meta::CPAN

    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 <<EOD;

$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 (<RSYNCOUTPUT>) {
            next unless /^AREPA_CHANGE/;
            if (/^AREPA_CHANGE [^.]/) {
                $changes = 1;
            }
        }
        close RSYNCOUTPUT;

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

1;

__END__

=head1 NAME

Arepa::Repository - Arepa repository access class

=head1 SYNOPSIS

 my $repo = Arepa::Repository->new('path/to/config.yml');
 my $value = $repo->get_config_key('repository:path');
 my @distros = $repo->get_distributions;
 my @archs = $repo->get_architectures;
 my $bool = $repo->insert_source_package($dsc_file, $distro);
 my $bool = $repo->insert_source_package($dsc_file, $distro,
                                         priority => 'optional',