Commit | Line | Data |
---|---|---|
99248ed2 MW |
1 | #! @PERL@ |
2 | ### -*-perl-*- | |
3 | ### | |
4 | ### Synchronize snapshot with remotely mounted filesystem | |
5 | ### | |
6 | ### (c) 2011 Mark Wooding | |
7 | ### | |
8 | ||
9 | ###----- Licensing notice --------------------------------------------------- | |
10 | ### | |
11 | ### This program is free software; you can redistribute it and/or modify | |
12 | ### it under the terms of the GNU General Public License as published by | |
13 | ### the Free Software Foundation; either version 2 of the License, or | |
14 | ### (at your option) any later version. | |
15 | ### | |
16 | ### This program is distributed in the hope that it will be useful, | |
17 | ### but WITHOUT ANY WARRANTY; without even the implied warranty of | |
18 | ### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the | |
19 | ### GNU General Public License for more details. | |
20 | ### | |
21 | ### You should have received a copy of the GNU General Public License | |
22 | ### along with this program; if not, write to the Free Software Foundation, | |
23 | ### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA. | |
24 | ||
25 | use Socket; | |
26 | ||
27 | ###-------------------------------------------------------------------------- | |
28 | ### Utilities. | |
29 | ||
30 | (our $QUIS = $0) =~ s:^.*/::; | |
31 | sub whine ($) { my ($msg) = @_; print STDERR "$QUIS: $msg\n"; } | |
32 | sub fail ($) { my ($msg) = @_; whine $msg; exit $! || ($? >> 8) || 255; } | |
33 | ||
34 | our @CLEANUP = (); | |
35 | sub cleanup (&) { my ($func) = @_; unshift @CLEAUP, $func; } | |
36 | END { local $?; for my $func (@CLEANUP) { &$func } } | |
37 | ||
38 | sub gripelist ($@) { | |
39 | my ($gripe, @things) = @_; | |
40 | fail "$gripe: " . join(", ", @things) if @things; | |
41 | } | |
42 | ||
43 | ###-------------------------------------------------------------------------- | |
44 | ### Parse command line. | |
45 | ||
46 | our $USAGE = "usage: $QUIS DEVICE [KEY=VALUE ...]"; | |
47 | sub version { print "$QUIS, version 1.0.0\n"; } | |
48 | sub help { | |
49 | print <<EOF; | |
50 | $USAGE | |
51 | ||
52 | Option keys: | |
53 | dir=MOUNTPT Mount point of filesystem on remote host [required]. | |
54 | host=[USER@]NAME Name or address of remote host [required]. | |
55 | op=OPERATION `snap' to create snapshot, or `unsnap' to remove. | |
56 | rfreezefs=PATH Location of `rfreezefs' program on remote host. | |
57 | ssh=PATH Location of remote-shell program on local host. | |
58 | subtype=TYPE Type of snapshot to create [required]. | |
59 | ||
60 | Other option keys are passed to the underlying snapshot TYPE. | |
61 | EOF | |
62 | } | |
63 | @ARGV >= 1 or do { print STDERR $USAGE, "\n"; exit 1; }; | |
64 | $ARGV[0] eq "-v" || $ARGV[0] eq "--version" and do { version; exit; }; | |
65 | $ARGV[0] eq "-h" || $ARGV[0] eq "--help" and do { version; help; exit; }; | |
66 | ||
67 | our $DEV = shift; | |
68 | our %OPT = ( dir => undef, | |
69 | host => undef, | |
70 | op => "snap", | |
71 | rfreezefs => "rfreezefs", | |
72 | ssh => "ssh", | |
73 | subtype => undef ); | |
74 | our @PASS = (); | |
75 | ||
76 | for my $i (@ARGV) { | |
77 | $i =~ /^([^\s=]+)=(.*)$/ or fail "malformed option `$i'"; | |
78 | my ($k, $v) = ($1, $2); | |
79 | if ($k =~ /^([^.]+)\.(.+)$/) { | |
80 | if ($2 eq "rfreezefs") { $k = $1; } | |
81 | } | |
82 | if (exists $OPT{$k}) { $OPT{$k} = $v; } | |
83 | else { push @PASS, $i; } | |
84 | } | |
85 | gripelist "missing arguments", grep { !defined $OPT{$_} } keys %OPT; | |
86 | ||
87 | (my $host = $OPT{host}) =~ s/^.*@//; | |
88 | my $addr = inet_aton $host or fail "failed to resolve `$OPT{host}'"; | |
89 | ||
90 | ###-------------------------------------------------------------------------- | |
91 | ### Remove a snapshot if requested. | |
92 | ||
93 | if ($OPT{op} eq "unsnap") { | |
94 | ||
95 | ## This doesn't require negotiation with the remote end. | |
96 | if ($OPT{unsnap}) { | |
97 | exec "snap.$OPT{subtype}", $DEV, "op=unsnap", @PASS; | |
98 | fail "exec snap.$OPT{subtype}: $!"; | |
99 | } | |
100 | ||
101 | } elsif ($OPT{op} ne "snap") { | |
102 | fail "unknown operation `$OPT{op}'"; | |
103 | } | |
104 | ||
105 | ###-------------------------------------------------------------------------- | |
106 | ### Run `rfreezefs' on the remote host and collect information. | |
107 | ||
108 | (my $dir = $OPT{dir}) =~ s/\'/'\\''/g; | |
109 | open SSH, "-|", $OPT{ssh}, $OPT{host}, "$OPT{rfreezefs} -n '$dir'" | |
110 | or fail "open(ssh): $!"; | |
111 | cleanup { close SSH }; | |
112 | ||
113 | our %INF = ( PORT => undef ); | |
114 | our %TOK = (); | |
115 | our %RTOK = (); | |
116 | our $PORT = undef; | |
117 | ||
118 | while (<SSH>) { | |
119 | my @f = split; | |
120 | if ($f[0] eq "PORT") { $INF{$f[0]} = $f[1]; } | |
121 | elsif ($f[1] eq "TOKEN") { $TOK{$f[1]} = $f[2]; $RTOK{$f[2]} = $f[1]; } | |
122 | elsif ($f[0] eq "READY") { last; } | |
123 | } | |
124 | ||
125 | gripelist "missing information", grep { !defined $INF{$_} } keys %INF; | |
126 | gripelist "missing tokens", | |
127 | grep { !exists $TOK{$_} } "FREEZE", "FROZEN", "THAW", "THAWED"; | |
128 | ||
129 | ###-------------------------------------------------------------------------- | |
130 | ### Create the snapshot. | |
131 | ||
132 | ## Connect to the socket. | |
133 | socket SK, PF_INET, SOCK_STREAM, 0 or fail "socket: $!"; | |
134 | cleanup { close SK }; | |
135 | select SK; $| = 1; | |
136 | connect SK, sockaddr_in($INF{PORT}, $addr) or fail "connect: $!"; | |
137 | ||
138 | ## Communication with the server. | |
139 | sub rffscmd ($;$) { | |
140 | my ($cmd, $rpl) = @_; | |
141 | print SK $TOK{$cmd}, "\n" or fail "write <$cmd>: $!"; | |
142 | if ($rpl) { | |
143 | chomp (my $line = <SK>); | |
144 | if ($line ne $TOK{$rpl}) { | |
145 | my $what = exists $RTOK{$line} ? "<$RTOK{$line}>" : "`$line'"; | |
146 | fail "unexpected response $what to <$cmd>"; | |
147 | } | |
148 | } | |
149 | } | |
150 | ||
151 | ## Freeze the remote filesystem. | |
152 | rffscmd(FREEZE, FROZEN); | |
153 | ||
154 | ## Create the snapshot locally using the appropriate mechanism. This will | |
155 | ## print the snapshot device name. | |
156 | my $rc = system "snap.$OPT{subtype}", $DEV, @PASS; | |
157 | $rc and fail "snap.$OPT{subtype} failed (rc = $rc)"; | |
158 | ||
159 | ## Discard the snapshot again if anything goes wrong. | |
160 | cleanup { | |
161 | if ($?) { | |
162 | my $rc = system "snap.$OPT{subtype}", $DEV, "unsnap", @PASS; | |
163 | $rc and | |
164 | whine "snap.$OPT{subtype} failed to unsnap (rc = $rc) " . | |
165 | "while recovering"; | |
166 | } | |
167 | }; | |
168 | ||
169 | ## Thaw the remote filesystem. | |
170 | rffscmd(THAW, THAWED); | |
171 | ||
172 | ###----- That's all, folks -------------------------------------------------- | |
173 | ||
174 | exit 0; |