Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100755 313 lines (246 sloc) 8.767 kB
7527acd First prototype for backup-manager-purge
sukria authored
1 #!/usr/bin/perl
5c7cdf5 @kissifrot We're in 2010
kissifrot authored
2 # Copyright © 2005-2010 Alexis Sukrieh
81a97d6 2007-03-13 Alexis Sukrieh <sukria@backup-manager.org>
sukria authored
3 # See the AUTHORS file for details.
4 #
5 # This program is free software; you can redistribute it and/or
6 # modify it under the terms of the GNU General Public License
7 # as published by the Free Software Foundation; either version 2
8 # of the License, or (at your option) any later version.
9 #
10 # This program is distributed in the hope that it will be useful,
11 # but WITHOUT ANY WARRANTY; without even the implied warranty of
12 # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
13 # GNU General Public License for more details.
14 #
15 # You should have received a copy of the GNU General Public License
16 # along with this program; if not, write to the Free Software
17 # Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
7527acd First prototype for backup-manager-purge
sukria authored
18
19 use strict;
20 use warnings;
21
22 =pod
23
24 =head1 NAME
25
26 backup-manager-purge - backup-manager's wrapper for outdating files
27
28 =head1 SYNOPSIS
29
30 backup-manager-purge [TTL] <options>
31
32 =head1 DESCRIPTION
33
34 B<backup-manager-purge> is the only authorized entity that can say if an archive
35 should be purged or not. Any tasks used by backup-manager may have to know if
36 an archive is deprecated (eg: the purging phase of an upload method). This tool
37 is here to fulfill that need.
38
39 Given a I<time to live (TTL)> and a list of archives, B<backup-manager-purge>
40 will return another list of archives, corresponding to the ones that are
41 outdated by the TTL.
42
43 =head1 REQUIRED ARGS
44
45 =over 4
46
47 =item B<--ttl=>I<time-to-live>
48
49 Specify the time to live (in days) for the archives. Any archive that is older
50 than I<ttl> days will be outdated.
51
ac0d966 cleaning POD
sukria authored
52 =back
53
511f4c3 Some stuff:
sukria authored
54 =head1 OPTIONAL ARGS
55
7527acd First prototype for backup-manager-purge
sukria authored
56 =item B<--files-from=>file
57
58 A file containing a list of archives to parse, one archive per line.
511f4c3 Some stuff:
sukria authored
59 If this option is not used, STDIN will be used for catching the files to parse.
7527acd First prototype for backup-manager-purge
sukria authored
60
61 =back
62
63 =head1 RETURN
64
511f4c3 Some stuff:
sukria authored
65 B<backup-manager-purge> will return the list of outdated files on STDOUT, one
7527acd First prototype for backup-manager-purge
sukria authored
66 file per line.
67
68 =head1 ERROR CODES
69
70 If an error occurs, it will print the error message on stderr and will exit with
71 an error code greater than 0.
72
73 Here are the possible error codes:
74
75 =over 4
76
77 =item bad command line (wrong arguments) : 10
78
511f4c3 Some stuff:
sukria authored
79 =item internal error (should be reported as a bug) : 20
7527acd First prototype for backup-manager-purge
sukria authored
80
81 =back
82
83 =head1 SEE ALSO
84
85 backup-manager(8) backup-manager-upload(8)
86
87 =head1 AUTHORS
88
89 Concept and design by Alexis Sukrieh and Jan Metzger.
90
91 =cut
92
93 ##############################################################
94 # Uses
95 ##############################################################
96 use BackupManager::Config;
97 use BackupManager::Logger;
511f4c3 Some stuff:
sukria authored
98 use BackupManager::Dialog;
7527acd First prototype for backup-manager-purge
sukria authored
99 use POSIX qw(strftime);
100 use File::Basename;
173a94a First working version
sukria authored
101 use Data::Dumper;
7527acd First prototype for backup-manager-purge
sukria authored
102
103 ##############################################################
104 # Constants
105 ##############################################################
106 use constant E_SUCCESS => 0;
107 use constant E_INVALID => 10;
511f4c3 Some stuff:
sukria authored
108 use constant E_INTERNAL => 20;
7527acd First prototype for backup-manager-purge
sukria authored
109 use constant TRUE => 1;
110 use constant FALSE => 0;
173a94a First working version
sukria authored
111 use constant DIALOG_VERBOSE => 0;
511f4c3 Some stuff:
sukria authored
112 use constant MSG_INTERNAL => "Internal system error, please report the bug.";
7527acd First prototype for backup-manager-purge
sukria authored
113
114 ##############################################################
115 # Global variables
116 ##############################################################
117 my $g_ttl = undef;
118 my $g_filelist = undef;
511f4c3 Some stuff:
sukria authored
119 my @g_archives = ();
120 my @g_outdated = ();
121 my $g_fh = *STDIN;
173a94a First working version
sukria authored
122 my $g_rh_archives = {};
7527acd First prototype for backup-manager-purge
sukria authored
123
124 ##############################################################
125 # Command line parsing
126 ##############################################################
127 BackupManager::Config::getopt("$0 -ttl=<TTL> --files-from=<FILE>\n
128 --ttl|-t: the time to live for outdating files
129 --files-from|-f: a file that contains the list of archives to process",
130 'ttl|t=s' => \$g_ttl,
131 'files-from|f=s' => \$g_filelist,
132 );
133
511f4c3 Some stuff:
sukria authored
134 ##############################################################
135 # Subs
136 ##############################################################
137
138 # Takes an archive an returns all meta-data contained in its name
139 sub parse_archive ($)
140 {
141 my ($archive) = @_;
142 unless (defined $archive) {
143 print_error MSG_INTERNAL;
144 exit E_INTERNAL;
145 }
146 my ($prefix, $name, $date, $master, $filetype);
147 $archive = basename ($archive);
148
99f7c37 @kissifrot Added patch submitted by Nicolas Baradakis for Bug #246
kissifrot authored
149 if ($archive =~ m/^\s*($ENV{BM_ARCHIVE_PREFIX})-?(\S+)?\.?(\d{8})\.(master\.)?(\S+)\s*$/) {
dfa596e Applying patch for closing bug #170
sukria authored
150 ($prefix, $name, $date, $master, $filetype) = ($1, $2, $3, $4, $5);
151 $master = $master ? 1 : 0;
152 $name = "$prefix-md5" if $filetype eq 'md5' and not $name;
153 }
154
835a91e + Added support for md5 pattern in backup-manager-purge
sukria authored
155 # The archive pattern
dfa596e Applying patch for closing bug #170
sukria authored
156 elsif ($archive =~ /^\s*([^-]+)-(\S+)\.(\d{8})\.(\S+)\s*$/) {
511f4c3 Some stuff:
sukria authored
157 $prefix = $1;
158 $name = $2;
159 $date = $3;
160 my $suffix = $4;
161 if ($suffix =~ /master\.(\S+)/) {
162 $master = 1;
163 $filetype = $1;
164 }
165 elsif ($suffix =~ /\.?(.+)/) {
166 $master = 0;
167 $filetype = $1;
168 }
169 }
835a91e + Added support for md5 pattern in backup-manager-purge
sukria authored
170
171 # The md5 file pattern
172 elsif ($archive =~ /^\s*([^-]+)-(\d{8})\.md5\s*$/) {
173 $prefix = $1;
174 $name = "$prefix-md5";
175 $date = $2;
176 $filetype = "md5";
177 $master = 0;
178 }
179
180 # Unknown pattern
181 else {
182 return undef;
183 }
184
173a94a First working version
sukria authored
185 return { prefix => $prefix,
186 name => $name,
187 date => $date,
188 master => $master,
189 filetype => $filetype};
511f4c3 Some stuff:
sukria authored
190 }
191
192 # Takes a file handle and an array ref, parse the file's content
193 # and store in the array exiting filenames.
194 sub read_archives($$)
195 {
196 my ($ra_archives, $fh) = @_;
197
198 my $archive = "";
199 while (<$fh>) {
200 chomp();
201
202 if (/^\s*(\S+)\s*$/) {
203 $archive = $1;
204 }
173a94a First working version
sukria authored
205
206 my $rh_data = parse_archive ($archive);
207 next unless defined $rh_data;
208 next unless defined $rh_data->{date};
209
210 if ($rh_data->{master}) {
211 $g_rh_archives->{$rh_data->{name}}{pathByDateMasters}{$rh_data->{date}} = $archive;
511f4c3 Some stuff:
sukria authored
212 }
173a94a First working version
sukria authored
213 $g_rh_archives->{$rh_data->{name}}{pathByDate}{$rh_data->{date}} = $archive;
214 $g_rh_archives->{dataByPath}{$archive} = $rh_data;
215
511f4c3 Some stuff:
sukria authored
216 push @{$ra_archives}, $archive;
217 }
218 }
219
220
173a94a First working version
sukria authored
221 # Takes an archive and a meta-data hash ref
222 # and return 1 if the archive is outded according to $g_ttl,
223 # 0 else.
224 sub outdate_master_archive($$$$$)
225 {
226 my ($archive, $rh_meta, $purge_date,
227 $ra_archives, $ra_outdated) = @_;
228 }
229
230
511f4c3 Some stuff:
sukria authored
231 # Takes two array refs. Reads from the first one the list of archives
81a97d6 2007-03-13 Alexis Sukrieh <sukria@backup-manager.org>
sukria authored
232 # to process, and push in the second one the outdated archives.
511f4c3 Some stuff:
sukria authored
233 sub outdate_archives($$)
234 {
235 my ($ra_archives, $ra_outdated) = @_;
236 unless (defined $ra_archives and
237 defined $ra_outdated) {
238 exit E_INTERNAL;
239 }
240
173a94a First working version
sukria authored
241 my $purge_date = strftime ('%Y%m%d',
242 localtime(time() - $g_ttl * 24 * 3600));
243 print_info "Outdating archives made before $purge_date";
244
245 my %seen = ();
246 foreach my $archive (sort @{$ra_archives}) {
247 my $data = $g_rh_archives->{dataByPath}{$archive};
248 next unless defined $data;
249 next unless defined $data->{date};
250 next if $seen{$archive};
251 $seen{$archive} = 1;
252
253 # if the date of the archive is older than $purge_date, we may have to outdate it
254 # unless, nothing to do for that archive.
81a97d6 2007-03-13 Alexis Sukrieh <sukria@backup-manager.org>
sukria authored
255 next if ($data->{date} > $purge_date);
173a94a First working version
sukria authored
256
257 # we can outdate a master only if a younger master exists
258 if ($data->{master}) {
259 foreach my $master_date (
260 keys %{$g_rh_archives->{$data->{name}}{pathByDateMasters}}) {
261 if ($master_date > $data->{date}) {
262 push @{$ra_outdated}, $archive;
263 last;
264 }
265 }
266 }
511f4c3 Some stuff:
sukria authored
267
81a97d6 2007-03-13 Alexis Sukrieh <sukria@backup-manager.org>
sukria authored
268 # here the archive is deprecated, its date is < to $purge_date
173a94a First working version
sukria authored
269 else {
81a97d6 2007-03-13 Alexis Sukrieh <sukria@backup-manager.org>
sukria authored
270 # if BM_ARCHIVE_STRICTPURGE is true, we can only purge
271 # an archive prefixed with BM_ARCHIVE_PREFIX
272 next if (($ENV{BM_ARCHIVE_STRICTPURGE} eq "true") and
273 ($data->{prefix} ne $ENV{BM_ARCHIVE_PREFIX}));
274
275 # now, we're sure we can outdate the archive
173a94a First working version
sukria authored
276 push @{$ra_outdated}, $archive;
277 }
511f4c3 Some stuff:
sukria authored
278 }
279 }
280
281 ##############################################################
282 # Main
283 ##############################################################
284
173a94a First working version
sukria authored
285 # Init
511f4c3 Some stuff:
sukria authored
286 init_dialog (DIALOG_VERBOSE);
287
173a94a First working version
sukria authored
288 # Args check
183d0a2 [ backup-manager-upload ]
sukria authored
289 unless (defined $g_ttl) {
511f4c3 Some stuff:
sukria authored
290 print_error "No TTL given";
291 exit E_INVALID;
292 }
293
173a94a First working version
sukria authored
294 # In
511f4c3 Some stuff:
sukria authored
295 if (defined $g_filelist and -f $g_filelist) {
296 print_info "Reading archives from $g_filelist";
297 open $g_fh, $g_filelist or die "Unable to open $g_filelist";
298 }
299 else {
300 print_info "Reading archives from STDIN";
301 }
173a94a First working version
sukria authored
302 read_archives (\@g_archives, $g_fh);
511f4c3 Some stuff:
sukria authored
303
173a94a First working version
sukria authored
304 # Process
511f4c3 Some stuff:
sukria authored
305 outdate_archives (\@g_archives, \@g_outdated);
7527acd First prototype for backup-manager-purge
sukria authored
306
173a94a First working version
sukria authored
307 # Out
308 foreach my $archive (@g_outdated) {
309 print "$archive\n";
310 }
311
7527acd First prototype for backup-manager-purge
sukria authored
312 exit E_SUCCESS;
Something went wrong with that request. Please try again.