line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
1
|
|
|
|
|
|
|
package Brackup::Target; |
2
|
|
|
|
|
|
|
|
3
|
13
|
|
|
13
|
|
102
|
use strict; |
|
13
|
|
|
|
|
30
|
|
|
13
|
|
|
|
|
520
|
|
4
|
13
|
|
|
13
|
|
78
|
use warnings; |
|
13
|
|
|
|
|
29
|
|
|
13
|
|
|
|
|
591
|
|
5
|
13
|
|
|
13
|
|
7699
|
use Brackup::InventoryDatabase; |
|
13
|
|
|
|
|
44
|
|
|
13
|
|
|
|
|
538
|
|
6
|
13
|
|
|
13
|
|
11227
|
use Brackup::TargetBackupStatInfo; |
|
13
|
|
|
|
|
42
|
|
|
13
|
|
|
|
|
401
|
|
7
|
13
|
|
|
13
|
|
91
|
use Brackup::Util 'tempfile'; |
|
13
|
|
|
|
|
30
|
|
|
13
|
|
|
|
|
724
|
|
8
|
13
|
|
|
13
|
|
79
|
use Brackup::DecryptedFile; |
|
13
|
|
|
|
|
31
|
|
|
13
|
|
|
|
|
340
|
|
9
|
13
|
|
|
13
|
|
68
|
use Carp qw(croak); |
|
13
|
|
|
|
|
25
|
|
|
13
|
|
|
|
|
28082
|
|
10
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
sub new { |
12
|
7
|
|
|
7
|
0
|
20
|
my ($class, $confsec) = @_; |
13
|
7
|
|
|
|
|
27
|
my $self = bless {}, $class; |
14
|
7
|
|
|
|
|
51
|
$self->{name} = $confsec->name; |
15
|
7
|
50
|
|
|
|
358
|
$self->{name} =~ s/^TARGET:// |
16
|
|
|
|
|
|
|
or die "No target found matching " . $confsec->name; |
17
|
7
|
50
|
|
|
|
126
|
die "Target name must be only a-z, A-Z, 0-9, and _." |
18
|
|
|
|
|
|
|
unless $self->{name} =~ /^\w+/; |
19
|
|
|
|
|
|
|
|
20
|
7
|
|
|
|
|
42
|
$self->{keep_backups} = $confsec->value("keep_backups"); |
21
|
7
|
|
33
|
|
|
36
|
$self->{inv_db} = |
22
|
|
|
|
|
|
|
Brackup::InventoryDatabase->new($confsec->value("inventorydb_file") || |
23
|
|
|
|
|
|
|
$confsec->value("inventory_db") || |
24
|
|
|
|
|
|
|
"$ENV{HOME}/.brackup-target-$self->{name}.invdb", |
25
|
|
|
|
|
|
|
$confsec); |
26
|
|
|
|
|
|
|
|
27
|
7
|
|
|
|
|
55
|
return $self; |
28
|
|
|
|
|
|
|
} |
29
|
|
|
|
|
|
|
|
30
|
|
|
|
|
|
|
sub name { |
31
|
8
|
|
|
8
|
0
|
29
|
my $self = shift; |
32
|
8
|
|
|
|
|
57
|
return $self->{name}; |
33
|
|
|
|
|
|
|
} |
34
|
|
|
|
|
|
|
|
35
|
|
|
|
|
|
|
# return hashref of key/value pairs you want returned to you during a restore |
36
|
|
|
|
|
|
|
# you should include anything you need to restore. |
37
|
|
|
|
|
|
|
# keys must match /^\w+$/ |
38
|
|
|
|
|
|
|
sub backup_header { |
39
|
|
|
|
|
|
|
return {} |
40
|
0
|
|
|
0
|
0
|
0
|
} |
41
|
|
|
|
|
|
|
|
42
|
|
|
|
|
|
|
# returns bool |
43
|
|
|
|
|
|
|
sub has_chunk { |
44
|
0
|
|
|
0
|
0
|
0
|
my ($self, $chunk) = @_; |
45
|
0
|
|
|
|
|
0
|
die "ERROR: has_chunk not implemented in sub-class $self"; |
46
|
|
|
|
|
|
|
} |
47
|
|
|
|
|
|
|
|
48
|
|
|
|
|
|
|
# returns true on success, or returns false or dies otherwise. |
49
|
|
|
|
|
|
|
sub store_chunk { |
50
|
0
|
|
|
0
|
0
|
0
|
my ($self, $chunk) = @_; |
51
|
0
|
|
|
|
|
0
|
die "ERROR: store_chunk not implemented in sub-class $self"; |
52
|
|
|
|
|
|
|
} |
53
|
|
|
|
|
|
|
|
54
|
|
|
|
|
|
|
# returns true on success, or returns false or dies otherwise. |
55
|
|
|
|
|
|
|
sub delete_chunk { |
56
|
0
|
|
|
0
|
0
|
0
|
my ($self, $chunk) = @_; |
57
|
0
|
|
|
|
|
0
|
die "ERROR: delete_chunk not implemented in sub-class $self"; |
58
|
|
|
|
|
|
|
} |
59
|
|
|
|
|
|
|
|
60
|
|
|
|
|
|
|
# returns a list of names of all chunks |
61
|
|
|
|
|
|
|
sub chunks { |
62
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
63
|
0
|
|
|
|
|
0
|
die "ERROR: chunks not implemented in sub-class $self"; |
64
|
|
|
|
|
|
|
} |
65
|
|
|
|
|
|
|
|
66
|
|
|
|
|
|
|
sub inventory_db { |
67
|
236
|
|
|
236
|
0
|
1288
|
my $self = shift; |
68
|
236
|
|
|
|
|
1439
|
return $self->{inv_db}; |
69
|
|
|
|
|
|
|
} |
70
|
|
|
|
|
|
|
|
71
|
|
|
|
|
|
|
sub add_to_inventory { |
72
|
81
|
|
|
81
|
0
|
606
|
my ($self, $pchunk, $schunk) = @_; |
73
|
81
|
|
|
|
|
1519
|
my $key = $pchunk->inventory_key; |
74
|
81
|
|
|
|
|
331
|
my $db = $self->inventory_db; |
75
|
81
|
|
|
|
|
1206
|
$db->set($key => $schunk->inventory_value); |
76
|
|
|
|
|
|
|
} |
77
|
|
|
|
|
|
|
|
78
|
|
|
|
|
|
|
# return stored chunk, given positioned chunk, or undef. no |
79
|
|
|
|
|
|
|
# need to override this, unless you have a good reason. |
80
|
|
|
|
|
|
|
sub stored_chunk_from_inventory { |
81
|
144
|
|
|
144
|
0
|
1262
|
my ($self, $pchunk) = @_; |
82
|
144
|
|
|
|
|
1589
|
my $key = $pchunk->inventory_key; |
83
|
144
|
|
|
|
|
8822
|
my $db = $self->inventory_db; |
84
|
144
|
100
|
|
|
|
3085
|
my $invval = $db->get($key) |
85
|
|
|
|
|
|
|
or return undef; |
86
|
23
|
|
|
|
|
515
|
return Brackup::StoredChunk->new_from_inventory_value($pchunk, $invval); |
87
|
|
|
|
|
|
|
} |
88
|
|
|
|
|
|
|
|
89
|
|
|
|
|
|
|
# return a list of TargetBackupStatInfo objects representing the |
90
|
|
|
|
|
|
|
# stored backup metafiles on this target. |
91
|
|
|
|
|
|
|
sub backups { |
92
|
0
|
|
|
0
|
0
|
0
|
my ($self) = @_; |
93
|
0
|
|
|
|
|
0
|
die "ERROR: backups method not implemented in sub-class $self"; |
94
|
|
|
|
|
|
|
} |
95
|
|
|
|
|
|
|
|
96
|
|
|
|
|
|
|
# downloads the given backup name to the current directory (with |
97
|
|
|
|
|
|
|
# *.brackup extension) |
98
|
|
|
|
|
|
|
sub get_backup { |
99
|
0
|
|
|
0
|
0
|
0
|
my ($self, $name) = @_; |
100
|
0
|
|
|
|
|
0
|
die "ERROR: get_backup method not implemented in sub-class $self"; |
101
|
|
|
|
|
|
|
} |
102
|
|
|
|
|
|
|
|
103
|
|
|
|
|
|
|
# deletes the given backup from this target |
104
|
|
|
|
|
|
|
sub delete_backup { |
105
|
0
|
|
|
0
|
0
|
0
|
my ($self, $name) = @_; |
106
|
0
|
|
|
|
|
0
|
die "ERROR: delete_backup method not implemented in sub-class $self"; |
107
|
|
|
|
|
|
|
} |
108
|
|
|
|
|
|
|
|
109
|
|
|
|
|
|
|
# removes old metafiles from this target |
110
|
|
|
|
|
|
|
sub prune { |
111
|
1
|
|
|
1
|
0
|
6
|
my ($self, %opt) = @_; |
112
|
|
|
|
|
|
|
|
113
|
1
|
50
|
33
|
|
|
8
|
my $keep_backups = $opt{keep_backups} || $self->{keep_backups} |
114
|
|
|
|
|
|
|
or die "ERROR: keep_backups option not set\n"; |
115
|
1
|
50
|
|
|
|
6
|
die "ERROR: keep_backups option must be at least 1\n" |
116
|
|
|
|
|
|
|
unless $keep_backups > 0; |
117
|
|
|
|
|
|
|
|
118
|
|
|
|
|
|
|
# select backups to delete |
119
|
1
|
|
|
|
|
3
|
my (%backups, @backups_to_delete) = (); |
120
|
1
|
|
|
|
|
6
|
foreach my $backup_name (map {$_->filename} $self->backups) { |
|
2
|
|
|
|
|
8
|
|
121
|
2
|
|
|
|
|
9
|
$backup_name =~ /^(.+)-\d+$/; |
122
|
2
|
|
100
|
|
|
19
|
$backups{$1} ||= []; |
123
|
2
|
|
|
|
|
4
|
push @{ $backups{$1} }, $backup_name; |
|
2
|
|
|
|
|
8
|
|
124
|
|
|
|
|
|
|
} |
125
|
1
|
|
|
|
|
7
|
foreach my $source (keys %backups) { |
126
|
1
|
50
|
33
|
|
|
6
|
next if $opt{source} && $source ne $opt{source}; |
127
|
1
|
|
|
|
|
3
|
my @b = reverse sort @{ $backups{$source} }; |
|
1
|
|
|
|
|
9
|
|
128
|
1
|
50
|
|
|
|
9
|
push @backups_to_delete, splice(@b, ($keep_backups > $#b+1) ? $#b+1 : $keep_backups); |
129
|
|
|
|
|
|
|
} |
130
|
|
|
|
|
|
|
|
131
|
1
|
0
|
|
|
|
5
|
warn ($opt{dryrun} ? "Pruning:\n" : "Pruned:\n") if $opt{verbose}; |
|
|
50
|
|
|
|
|
|
132
|
1
|
|
|
|
|
3
|
foreach my $backup_name (@backups_to_delete) { |
133
|
1
|
50
|
|
|
|
6
|
warn " $backup_name\n" if $opt{verbose}; |
134
|
1
|
50
|
|
|
|
10
|
$self->delete_backup($backup_name) unless $opt{dryrun}; |
135
|
|
|
|
|
|
|
} |
136
|
1
|
|
|
|
|
7
|
return scalar @backups_to_delete; |
137
|
|
|
|
|
|
|
} |
138
|
|
|
|
|
|
|
|
139
|
|
|
|
|
|
|
# removes orphaned chunks in the target |
140
|
|
|
|
|
|
|
sub gc { |
141
|
2
|
|
|
2
|
0
|
633
|
my ($self, %opt) = @_; |
142
|
|
|
|
|
|
|
|
143
|
|
|
|
|
|
|
# get all chunks and then loop through metafiles to detect |
144
|
|
|
|
|
|
|
# referenced ones |
145
|
2
|
|
|
|
|
13
|
my %chunks = map {$_ => 1} $self->chunks; |
|
34
|
|
|
|
|
167
|
|
146
|
2
|
|
|
|
|
13
|
my $total_chunks = scalar keys %chunks; |
147
|
2
|
|
|
|
|
16
|
my $tempfile = +(tempfile())[1]; |
148
|
2
|
|
|
|
|
37
|
my @backups = $self->backups; |
149
|
2
|
|
|
|
|
10
|
BACKUP: foreach my $i (0 .. $#backups) { |
150
|
2
|
|
|
|
|
4
|
my $backup = $backups[$i]; |
151
|
2
|
50
|
|
|
|
9
|
warn sprintf "Collating chunks from backup %s [%d/%d]\n", |
152
|
|
|
|
|
|
|
$backup->filename, $i+1, scalar(@backups) |
153
|
|
|
|
|
|
|
if $opt{verbose}; |
154
|
2
|
|
|
|
|
13
|
$self->get_backup($backup->filename, $tempfile); |
155
|
2
|
|
|
|
|
24
|
my $decrypted_backup = new Brackup::DecryptedFile(filename => $tempfile); |
156
|
2
|
|
|
|
|
13
|
my $parser = Brackup::Metafile->open($decrypted_backup->name); |
157
|
2
|
|
|
|
|
9
|
$parser->readline; # skip header |
158
|
2
|
|
|
|
|
7
|
ITEM: while (my $it = $parser->readline) { |
159
|
30
|
100
|
|
|
|
83
|
next ITEM unless $it->{Chunks}; |
160
|
24
|
|
50
|
|
|
81
|
my @item_chunks = map { (split /;/)[3] } grep { $_ } split(/\s+/, $it->{Chunks} || ""); |
|
28
|
|
|
|
|
113
|
|
|
28
|
|
|
|
|
53
|
|
161
|
24
|
|
|
|
|
196
|
delete $chunks{$_} for (@item_chunks); |
162
|
|
|
|
|
|
|
} |
163
|
|
|
|
|
|
|
} |
164
|
2
|
|
|
|
|
12
|
my @orphaned_chunks = keys %chunks; |
165
|
|
|
|
|
|
|
|
166
|
|
|
|
|
|
|
# report orphaned chunks |
167
|
2
|
50
|
33
|
|
|
20
|
if (@orphaned_chunks && $opt{verbose} && $opt{verbose} >= 2) { |
|
|
|
33
|
|
|
|
|
168
|
0
|
|
|
|
|
0
|
warn "Orphaned chunks:\n"; |
169
|
0
|
|
|
|
|
0
|
warn " $_\n" for (@orphaned_chunks); |
170
|
|
|
|
|
|
|
} |
171
|
|
|
|
|
|
|
|
172
|
|
|
|
|
|
|
# remove orphaned chunks |
173
|
2
|
50
|
33
|
|
|
16
|
if (@orphaned_chunks && ! $opt{dryrun}) { |
174
|
2
|
|
|
|
|
4
|
my $confirm = 'y'; |
175
|
2
|
50
|
|
|
|
6
|
if ($opt{interactive}) { |
176
|
0
|
|
|
|
|
0
|
printf "Run gc, removing %d/%d orphaned chunks? [y/N] ", |
177
|
|
|
|
|
|
|
scalar @orphaned_chunks, $total_chunks; |
178
|
0
|
|
|
|
|
0
|
$confirm = <>; |
179
|
|
|
|
|
|
|
} |
180
|
|
|
|
|
|
|
|
181
|
2
|
50
|
|
|
|
12
|
if (lc substr($confirm,0,1) eq 'y') { |
182
|
2
|
50
|
|
|
|
8
|
warn "Removing orphaned chunks\n" if $opt{verbose}; |
183
|
2
|
|
|
|
|
18
|
$self->delete_chunk($_) for (@orphaned_chunks); |
184
|
|
|
|
|
|
|
|
185
|
|
|
|
|
|
|
# delete orphaned chunks from inventory |
186
|
2
|
|
|
|
|
11
|
my $inventory_db = $self->inventory_db; |
187
|
2
|
|
|
|
|
14
|
while (my ($k, $v) = $inventory_db->each) { |
188
|
27
|
|
|
|
|
117
|
$v =~ s/ .*$//; # strip value back to hash |
189
|
27
|
100
|
|
|
|
128
|
$inventory_db->delete($k) if exists $chunks{$v}; |
190
|
|
|
|
|
|
|
} |
191
|
|
|
|
|
|
|
} |
192
|
|
|
|
|
|
|
} |
193
|
|
|
|
|
|
|
|
194
|
2
|
50
|
|
|
|
44
|
return wantarray ? ( scalar @orphaned_chunks, $total_chunks ) : scalar @orphaned_chunks; |
195
|
|
|
|
|
|
|
} |
196
|
|
|
|
|
|
|
|
197
|
|
|
|
|
|
|
|
198
|
|
|
|
|
|
|
|
199
|
|
|
|
|
|
|
1; |
200
|
|
|
|
|
|
|
|
201
|
|
|
|
|
|
|
__END__ |