summaryrefslogtreecommitdiffstats
path: root/files/reprepro/snapshots/time_based/tails-update-time-based-apt-snapshots
blob: 54a9fb48c62289d5bb73ced9206e6ad56df2a0da (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
#! /usr/bin/perl

# Example usage:
#
#    $0 ftp-master.debian.org \
#       /srv/apt-snapshots/time-based \
#       "$(date -u '+%Y%m%d')01"

# Dependencies:
#
#    libcarp-assert-perl libcarp-assert-more-perl libipc-system-simple-perl
#    libpath-tiny-perl libtry-tiny-perl

use strict;
use warnings;
use 5.10.0;

use autodie qw{:all};
use Carp;
use Carp::Assert;
use Carp::Assert::More;
use English qw{-no_match_vars};
use Path::Tiny;
use IPC::System::Simple qw{systemx $EXITVAL};
use Try::Tiny;

### Functions

sub reprepro {
    my $args = shift;
    my $opts = shift;

    assert_listref($args);
    assert_exists($opts, 'basedir', q{basedir option is set});

    systemx(
        '/usr/bin/reprepro',
        ($ENV{VERBOSE} ? '--verbose' : ()),
        ($ENV{SILENT}  ? '--silent'  : ()),
        '--basedir', $opts->{basedir}, @$args
    );
}

sub reprepro_config_file_lines {
    my $basedir  = shift;
    my $filename = shift;

    path($basedir, 'conf', $filename)->lines_utf8({chomp => 1});
}

sub distributions {
   my $basedir = shift;

   my @distributions;
   foreach my $line (reprepro_config_file_lines($basedir, 'distributions')) {
       if (my ($codename) = ($line =~ /^Codename:\s+(.*)$/)) {
           push @distributions, $codename;
       }
   }
   return @distributions;
}

sub update_mirrors {
    my $basedir = shift;

    reprepro(['update'], { basedir => $basedir });
}

sub generate_snapshots {
   my $basedir = shift;
   my $serial  = shift;

   foreach my $codename (distributions($basedir)) {
       reprepro(['gensnapshot', $codename, $serial], { basedir => $basedir });
   }
}

sub update_trace_file {
    my $archive = shift;
    my $basedir = shift;
    my $serial  = shift;

    my $trace_file = path($basedir, 'project', 'trace', $archive);
    $trace_file->parent->mkpath;
    $trace_file->spew_utf8("Archive serial: $serial\n");
}

sub clean {
    my $basedir = shift;

    reprepro(['--delete', 'clearvanished'], { basedir => $basedir });
}

### Parse and check command-line

my $USAGE = "Usage: $PROGRAM_NAME ARCHIVE BASEDIR SERIAL";

assert(@ARGV == 3, $USAGE);

my ($ARCHIVE, $BASEDIR, $SERIAL) = @ARGV;

assert_nonblank($ARCHIVE, q{ARCHIVE is not blank});
assert_nonblank($BASEDIR, q{BASEDIR is not blank});
assert(-d $BASEDIR, "BASEDIR ('$BASEDIR') is a directory");
assert_nonblank($SERIAL, q{SERIAL is not blank});
assert_like($SERIAL, qr/^\d{10}$/, q{Serial is well formed});

### Main

umask 0022;
clean($BASEDIR);
update_mirrors($BASEDIR);
generate_snapshots($BASEDIR, $SERIAL);
update_trace_file($ARCHIVE, $BASEDIR, $SERIAL);