166 |
rodolico |
1 |
#! /usr/bin/env perl
|
|
|
2 |
|
|
|
3 |
use strict;
|
|
|
4 |
use warnings;
|
|
|
5 |
|
|
|
6 |
use Data::Dumper;
|
|
|
7 |
|
|
|
8 |
my $source = shift;
|
|
|
9 |
my $target = shift;
|
|
|
10 |
|
|
|
11 |
die "Usage: replicate source target\n" unless $source && $target;
|
|
|
12 |
|
|
|
13 |
my $config = {
|
|
|
14 |
# compile the regex
|
|
|
15 |
'pattern' => qr/auto-\d{4}-\d{2}-\d{2}_\d{2}-\d{2}/
|
|
|
16 |
};
|
|
|
17 |
|
|
|
18 |
sub parseDataSet {
|
|
|
19 |
my $data = shift;
|
|
|
20 |
my %return;
|
|
|
21 |
my ( $server, $dataset ) = split( ':', $data );
|
|
|
22 |
if ( $dataset ) { # they passed a server:dataset
|
|
|
23 |
$return{'server'} = $server;
|
|
|
24 |
$return{'dataset'} = $dataset;
|
|
|
25 |
} else { # only passing in dataset, so assume localhost
|
|
|
26 |
$return{'server'} = '';
|
|
|
27 |
$return{'dataset'} = $server;
|
|
|
28 |
}
|
|
|
29 |
return \%return;
|
|
|
30 |
}
|
|
|
31 |
|
|
|
32 |
# runs a command, redirecting stderr to stdout (which it ignores)
|
|
|
33 |
# then returns 0 and $output on success.
|
|
|
34 |
# if error, returns error code and string describing error
|
|
|
35 |
sub run {
|
|
|
36 |
my $command = shift;
|
|
|
37 |
my $output = qx/$command 2>&1/;
|
|
|
38 |
if ($? == -1) {
|
|
|
39 |
return (-1,"failed to execute: $!");
|
|
|
40 |
} elsif ($? & 127) {
|
|
|
41 |
return ($?, sprintf "child died with signal %d, %s coredump",
|
|
|
42 |
($? & 127), ($? & 128) ? 'with' : 'without' );
|
|
|
43 |
} else {
|
|
|
44 |
return ($? >> 8, sprintf "child exited with value %d", $? >> 8 ) if $? >> 8;
|
|
|
45 |
}
|
|
|
46 |
return (0,$output);
|
|
|
47 |
}
|
|
|
48 |
|
|
|
49 |
|
|
|
50 |
sub getSnaps {
|
|
|
51 |
my ($config,$pattern) = @_;
|
|
|
52 |
my %return;
|
|
|
53 |
# actual command to run to get all snapshots, recursively, of the dataset
|
|
|
54 |
my $command = 'zfs list -r -t snap ' . $config->{'dataset'};
|
|
|
55 |
$command = "ssh $config->{server} '$command'" if $config->{'server'};
|
|
|
56 |
my ($error, $output ) = &run( $command );
|
|
|
57 |
die $output if $error;
|
|
|
58 |
my @snaps = split( "\n", $output );
|
|
|
59 |
chomp @snaps;
|
|
|
60 |
for (my $i = 0; $i < @snaps; $i++ ) {
|
|
|
61 |
# parse out the space delmited fields
|
|
|
62 |
my ($fullname, $used, $avail, $refer, $mount) = split( /\s+/, $snaps[$i] );
|
|
|
63 |
# break the name into dataset and snapname
|
|
|
64 |
my ($dataset, $snap) = split( '@', $fullname );
|
|
|
65 |
# remove the root dataset name
|
|
|
66 |
$dataset =~ s/^$config->{'dataset'}//;
|
|
|
67 |
# skip anything not matching our regex
|
|
|
68 |
next unless $pattern && $snap && $snap =~ m/$pattern/;
|
|
|
69 |
$return{$dataset}{'snaps'}{$snap}{'refer'} = $refer;
|
|
|
70 |
$return{$dataset}{'snaps'}{$snap}{'used'} = $used;
|
|
|
71 |
}
|
|
|
72 |
return \%return;
|
|
|
73 |
}
|
|
|
74 |
|
|
|
75 |
sub diffSnaps {
|
|
|
76 |
my ( $source, $target ) = @_;
|
|
|
77 |
my @source = sort keys %$source;
|
|
|
78 |
my @target = sort keys %$target;
|
|
|
79 |
# print "===Source\n" . join( "\n", @source ) . "\n===Target\n" . join( "\n", @target ) . "\n";
|
|
|
80 |
|
|
|
81 |
my $s = 0;
|
|
|
82 |
my $t = 0;
|
|
|
83 |
my %return;
|
|
|
84 |
$return{'deleteTarget'} = [];
|
|
|
85 |
$return{'addTarget'} = [];
|
|
|
86 |
$return{'lastMatch'} = 0;
|
|
|
87 |
$return{'finalSync'} = 0;
|
|
|
88 |
while ( $s < @source && $t < @target ) {
|
|
|
89 |
if ( $source[$s] eq $target[$t] ) { # matchies, just keep going
|
|
|
90 |
# print "Source $s [$source[$s]] matches target $t [$target[$t]]\n";
|
|
|
91 |
$return{'lastMatch'} = $source[$s]; # keep track of the largest match
|
|
|
92 |
$s++; $t++;
|
|
|
93 |
} elsif ( $target[$t] ne $source[$s] ) { # we are processing stuff that needs to be deleted on target
|
|
|
94 |
push @{$return{'deleteTarget'}}, $target[$t];
|
|
|
95 |
# print "Adding delete target $t [$target[$t]]\n";
|
|
|
96 |
$t++;
|
|
|
97 |
}
|
|
|
98 |
}
|
|
|
99 |
die "Could not reconcile snapshots, ran out of source too soon\n" if $s > @source;
|
|
|
100 |
# put a value into finalSync to make sure there is one. If we do not have any sync
|
|
|
101 |
# to do, final and lastMatch will be the same
|
|
|
102 |
$return{'finalSync'} = $return{'lastMatch'};
|
|
|
103 |
while ( $s < @source ) {
|
|
|
104 |
push @{$return{'addTarget'}}, $source[$s];
|
|
|
105 |
$return{'finalSync'} = $source[$s];
|
|
|
106 |
$s++;
|
|
|
107 |
}
|
|
|
108 |
# die Dumper( \%return );
|
|
|
109 |
return \%return;
|
|
|
110 |
}
|
|
|
111 |
|
|
|
112 |
sub arrayEquals {
|
|
|
113 |
my ($a, $b ) = @_;
|
|
|
114 |
return 0 unless @{$a} == @{$b}; # they are different sizes
|
|
|
115 |
for ( my $i = 0; $i < @$a; $i++ ) {
|
|
|
116 |
if ( $$a[$i] ne $$b[$i] ) {
|
|
|
117 |
print STDERR "No Match!\n" . join( "\t", @$a ) . "\n" . join( "\t", @$b ) . "\n";
|
|
|
118 |
return 0;
|
|
|
119 |
}
|
|
|
120 |
}
|
|
|
121 |
return 1;
|
|
|
122 |
}
|
|
|
123 |
|
|
|
124 |
sub createCommands {
|
|
|
125 |
my $config = shift;
|
|
|
126 |
my @return;
|
|
|
127 |
# check for new snapshots to sync
|
|
|
128 |
if ( $config->{'actions'}->{'lastMatch'} ne $config->{'actions'}->{'finalSync'} ) {
|
|
|
129 |
# first create the replicate command. The send command request recursion (-R)
|
|
|
130 |
# and the range of snapshots including all intermediate ones (-I)
|
|
|
131 |
my $sourceCommand = 'zfs send -RI ';
|
|
|
132 |
$sourceCommand .= $config->{'source'}->{'dataset'} . '@' . $config->{'actions'}->{'lastMatch'} . ' ';
|
|
|
133 |
$sourceCommand .= $config->{'source'}->{'dataset'} . '@' . $config->{'actions'}->{'finalSync'};
|
|
|
134 |
$sourceCommand = "ssh $config->{source}->{server} '$sourceCommand'" if $config->{'source'}->{'server'};
|
|
|
135 |
|
|
|
136 |
my $targetCommand = 'zfs receive -v ';
|
|
|
137 |
$targetCommand .= $config->{'target'}->{'dataset'};
|
|
|
138 |
$targetCommand = "ssh $config->{target}->{server} '$sourceCommand'" if $config->{'target'}->{'server'};
|
|
|
139 |
push @return, $sourceCommand . ' | ' . $targetCommand;
|
|
|
140 |
} else {
|
168 |
rodolico |
141 |
push @return, '# Nothing new to sync';
|
166 |
rodolico |
142 |
}
|
|
|
143 |
# now, check for snapshots to remove
|
|
|
144 |
if ( $config->{'actions'}->{'deleteTarget'} ) {
|
168 |
rodolico |
145 |
my $delete = $config->{'actions'}->{'deleteTarget'};
|
|
|
146 |
foreach my $ds ( @$delete ) {
|
|
|
147 |
push @return, "zfs destroy -r $config->{target}->{'dataset'}\@$ds";
|
166 |
rodolico |
148 |
}
|
168 |
rodolico |
149 |
} else {
|
|
|
150 |
push @return, "# No old snapshots to be removed";
|
166 |
rodolico |
151 |
}
|
|
|
152 |
return \@return;
|
|
|
153 |
}
|
|
|
154 |
|
|
|
155 |
|
|
|
156 |
|
|
|
157 |
sub calculate {
|
|
|
158 |
my $config = shift;
|
|
|
159 |
my $return;
|
|
|
160 |
my $allMatch;
|
|
|
161 |
my $lastMatch;
|
|
|
162 |
foreach my $dataset ( sort keys %{$config->{'source'}->{'snapshots'}} ) {
|
168 |
rodolico |
163 |
next unless exists $config->{'source'}->{'snapshots'}->{$dataset};
|
166 |
rodolico |
164 |
die "No matching target for $dataset\n" unless $config->{'target'}->{'snapshots'}->{$dataset};
|
|
|
165 |
$return->{$dataset} = &diffSnaps(
|
|
|
166 |
$config->{'source'}->{'snapshots'}->{$dataset}->{'snaps'},
|
|
|
167 |
$config->{'target'}->{'snapshots'}->{$dataset}->{'snaps'}
|
|
|
168 |
);
|
|
|
169 |
$allMatch = $return->{$dataset} unless $allMatch;
|
168 |
rodolico |
170 |
# die Dumper( $allMatch ) . "\n";
|
166 |
rodolico |
171 |
next;
|
|
|
172 |
unless (
|
|
|
173 |
&arrayEquals( $return->{'allMatch'}->{'deleteTarget'}, $return->{$dataset}->{'deleteTarget'} ) &&
|
|
|
174 |
&arrayEquals( $return->{'allMatch'}->{'addTarget'}, $return->{$dataset}->{'addTarget'} )
|
|
|
175 |
) {
|
|
|
176 |
warn "Warning: dataset $dataset does not match\n";
|
|
|
177 |
last;
|
|
|
178 |
}
|
|
|
179 |
}
|
|
|
180 |
#print Dumper( $allMatch );
|
|
|
181 |
$return->{'lastMatch'} = $allMatch->{'lastMatch'};
|
|
|
182 |
$return->{'finalSync'} = $allMatch->{'finalSync'};
|
168 |
rodolico |
183 |
# die Dumper( $allMatch->{'deleteTarget'} ) . "\n" ;
|
|
|
184 |
$return->{'deleteTarget'} = $allMatch->{'deleteTarget'};
|
|
|
185 |
# print Dumper( $return ) . "\n"; die;
|
166 |
rodolico |
186 |
return $return;
|
|
|
187 |
#print Dumper( $return ) . "\n"; die;
|
|
|
188 |
}
|
|
|
189 |
|
|
|
190 |
$config->{'source'} = &parseDataSet( $source );
|
|
|
191 |
$config->{'target'} = &parseDataSet( $target );
|
|
|
192 |
|
|
|
193 |
# both source and target can not have a server portion; one must be local
|
|
|
194 |
die "Source and Target can not both be remote\n" if $config->{'source'}->{'server'} && $config->{'target'}->{'server'};
|
|
|
195 |
|
|
|
196 |
$config->{'source'}->{'snapshots'} = &getSnaps( $config->{'source'}, $config->{'pattern'} );
|
|
|
197 |
$config->{'target'}->{'snapshots'} = &getSnaps( $config->{'target'}, $config->{'pattern'} );
|
|
|
198 |
|
|
|
199 |
$config->{'actions'} = &calculate( $config );
|
|
|
200 |
|
168 |
rodolico |
201 |
#print Dumper( $config ); die;
|
|
|
202 |
|
166 |
rodolico |
203 |
my $commands = &createCommands( $config );
|
|
|
204 |
for ( my $i = 0; $i < @{$commands}; $i++ ) {
|
168 |
rodolico |
205 |
print "$$commands[$i]\n";
|
169 |
rodolico |
206 |
print qx/$$commands[$i]/ if $$commands[$i] =~ m/^[a-zA-Z]/;
|
166 |
rodolico |
207 |
}
|
|
|
208 |
|
|
|
209 |
#print Dumper( $config );
|
|
|
210 |
|
|
|
211 |
1;
|