chiark - git - mdw - distorted-backup/blob - lvm-rmsnap.in

   1 #! @PERL@
   2 ###
   3 ### Remove an LVM snapshot, without falling foul of LVM bugs
   4 ###
   5 ### (c) 2011 Mark Wooding
   6 ###
   7
   8 ###----- Licensing notice ---------------------------------------------------
   9 ###
  10 ### This file is part of the distorted.org.uk backup suite.
  11 ###
  12 ### distorted-backup is free software; you can redistribute it and/or modify
  13 ### it under the terms of the GNU General Public License as published by
  14 ### the Free Software Foundation; either version 2 of the License, or
  15 ### (at your option) any later version.
  16 ###
  17 ### distorted-backup is distributed in the hope that it will be useful,
  18 ### but WITHOUT ANY WARRANTY; without even the implied warranty of
  19 ### MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  20 ### GNU General Public License for more details.
  21 ###
  22 ### You should have received a copy of the GNU General Public License along
  23 ### with distorted-backup; if not, write to the Free Software Foundation,
  24 ### Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
  25
  26 use Cwd qw(realpath);
  27 use Errno qw(:POSIX);
  28 use Fcntl qw(:mode);
  29 use File::stat;
  30 use Getopt::Long qw(:config gnu_compat bundling no_ignore_case);
  31 use IO::Handle;
  32 use Time::HiRes qw(time);
  33
  34 our $VERSION = "@VERSION@";
  35
  36 ###--------------------------------------------------------------------------
  37 ### Utilities.
  38
  39 ## Error handling and reporting.
  40 (our $QUIS = $0) =~ s:^.*/::;
  41 our $DEBUG = 0;
  42 sub whine ($) { my ($msg) = @_; print STDERR "$QUIS: $msg\n"; }
  43 sub burble ($) { my ($msg) = @_; whine $msg if $DEBUG; }
  44 sub fail ($) { my ($msg) = @_; whine $msg; exit $! || ($? >> 8) || 255; }
  45
  46 ## Cleanups.  Call `cleanup BLOCK' to arrange to have BLOCK executed at the
  47 ## end of the program.
  48 our @CLEANUP = ();
  49 sub runcleanups { for my $f (@CLEANUP) { &$f } }
  50 END { runcleanups; }
  51 $SIG{INT} = $SIG{TERM} = sub {
  52   my $sig = shift;
  53   runcleanups;
  54   $SIG{$sig} = 'DEFAULT';
  55   kill $sig => $$;
  56 };
  57 sub cleanup (&) { unshift @CLEANUP, $_[0]; }
  58
  59 sub fixint ($) { my ($x) = @_; return $x =~ /^0/ ? oct $x : $x + 0; }
  60
  61 ###--------------------------------------------------------------------------
  62 ### Device fiddling.
  63
  64 sub devsys ($) {
  65   ## devsys DEV
  66   ##
  67   ## Return a sysfs path for a device DEV.
  68
  69   my ($dev) = @_;
  70   my $st = stat $dev or fail "stat ($dev): $!";
  71   my $kind;
  72   if (S_ISBLK($st->mode)) { $kind = "block"; }
  73   elsif (S_ISCHR($st->mode)) { $kind = "char"; }
  74   else { fail "$dev is not a device"; }
  75   my ($maj, $min) = (($st->rdev >> 8) & 0xff, $st->rdev & 0xff);
  76   (my $whole = realpath "/sys/dev/$kind/$maj:$min") =~ s:^/sys/:/:;
  77   return $whole;
  78 }
  79
  80 our %DMTAB = ();
  81
  82 sub dmtable_update () {
  83   ## dmtable_update
  84   ##
  85   ## Update the device-mapper table in %DMTAB.
  86
  87   burble "re-read device-mapper table";
  88   %DMTAB = ();
  89   open my $dt, "-|", "dmsetup", "table" or fail "open (dm table): $!";
  90   while (my $line = $dt->getline) {
  91     my ($dev, $rest) = split /[:\s]+/, $line, 2;
  92     push @{$DMTAB{$dev}}, [split ' ', $rest];
  93   }
  94   close $dt or fail "dmsetup table failed (rc = $?)";
  95 }
  96
  97 sub dmname ($) {
  98   ## dmname SYSPATH
  99   ##
 100   ## Return the device-mapper node name for the sysfs path SYSPATH.
 101
 102   my ($sys) = @_;
 103   open my $f, "<", "/sys$sys/dm/name" or fail "open ($sys/dm/name): $!";
 104   chomp (my $name = $f->getline);
 105   close $f;
 106   return $name;
 107 }
 108
 109 ###--------------------------------------------------------------------------
 110 ### I/O utilities.
 111
 112 sub sel ($;$$$) {
 113   ## sel TIMEOUT, [READS, WRITES, EXCEPTIONS]
 114   ##
 115   ## Wait for at most TIMEOUT seconds (indefinitely if TIMEOUT is `undef').
 116   ## Each of READS, WRITES and EXCEPTIONS is a listref containing FILE => SUB
 117   ## pairs: if the FILE is readable (writable, has an exceptional condition)
 118   ## then the SUB is invoked.
 119
 120   my ($t, $r, $w, $x) = @_;
 121   my ($vr, $vw, $vx);
 122   my (%r, %w, %x);
 123
 124   ## Read the arguments and build a data structure.
 125   for my $i ([$r, \$vr, \%r], [$w, \$vw, \%w], [$x, \$vx, \%x]) {
 126     my ($a, $v, $h) = @$i;
 127     next unless $a;
 128     my @a = @$a;
 129     while (@a) {
 130       my ($f, $g) = splice @a, 0, 2;
 131       my $fd = $f->fileno;
 132       $h->{$fd} = $g;
 133       vec($$v, $fd, 1) = 1;
 134     }
 135   }
 136
 137   ## Do the wait and sift through the results.
 138   defined select $vr, $vw, $vx, $t or fail "select: $!";
 139   for my $i ([$vr, \%r], [$vw, \%w], [$vx, \%x]) {
 140     my ($v, $h) = @$i;
 141     while (my ($f, $g) = each %$h) {
 142       if (vec $v, $f, 1) { &$g; }
 143     }
 144   }
 145 }
 146
 147 sub doread ($;$) {
 148   ## doread FILE, [LEN]
 149   ##
 150   ## Read LEN bytes (or a default amount) from FILE.  If the file ends,
 151   ## return undef.  If reading would block then return an empty string.
 152   ## Otherwise return he stuff.
 153
 154   my ($f, $n) = @_;
 155   $n = sysread $f, my $buf, $n // 4096;
 156   if (!defined $n) { return "" if $! == EAGAIN; fail "read: $!"; }
 157   elsif (!$n) { return undef; }
 158   else { return $buf; }
 159 }
 160
 161 sub run ($$@) {
 162   ## run WHAT, PROG, ARGS...
 163   ##
 164   ## Run PROG, passing it ARGS.  Fails if PROG exits nonzero.
 165
 166   my ($what, $prog, @args) = @_;
 167   system($prog, @args) == 0 or fail "$prog ($what) failed (rc = $?)";
 168 }
 169
 170 sub capture ($@) {
 171   ## capture PROG, ARGS...
 172   ##
 173   ## Run PROG, passing it ARGS.  Returns exit status, stdout, and stderr, as
 174   ## strings.
 175
 176   my ($prog, @args) = @_;
 177   my ($out, $err) = ("", "");
 178   my ($outpipe_in, $outpipe_out, $errpipe_in, $errpipe_out);
 179   pipe $outpipe_in, $outpipe_out or fail "pipe ($prog out): $!";
 180   pipe $errpipe_in, $errpipe_out or fail "pipe ($prog err): $!";
 181   defined (my $kid = fork) or fail "fork ($prog): $!";
 182   if ($kid == 0) {
 183     close $outpipe_in
 184       and close $errpipe_in
 185       and open STDOUT, ">&", $outpipe_out
 186       and open STDERR, ">&", $errpipe_out
 187       and exec $prog, @args
 188       or fail "exec $prog: $!";
 189   }
 190   close $outpipe_out;
 191   close $errpipe_out;
 192   for (;;) {
 193     my @r = ();
 194     for my $i ([\$outpipe_in, \$out, "out"],
 195                [\$errpipe_in, \$err, "err"]) {
 196       my ($p, $b, $w) = @$i;
 197       push @r, $$p => sub {
 198         my $buf = doread $$p;
 199         if (defined $buf) { $$b .= $buf; }
 200         else { close $$p; $$p = undef; }
 201       } if $$p;
 202     }
 203     last unless @r;
 204     sel undef, \@r;
 205   }
 206   waitpid $kid, 0 or fail "waitpid ($prog): $!";
 207   return $?, $out, $err;
 208 }
 209
 210 ###--------------------------------------------------------------------------
 211 ### Monitoring udev events.
 212
 213 sub umon_create (@) {
 214   ## umon_create ARGS...
 215   ##
 216   ## Create a udev monitor, with the given `udevadm monitor' arguments, and
 217   ## return an object.  We always select only kernel events.  We try to wait
 218   ## for the monitor to start up before returning.  Don't trust this: use
 219   ## `umon_sync' anyway.
 220
 221   my @args = @_;
 222   my $u = {};
 223
 224   ## Start the monitor process.
 225   $u->{KID} = open($u->{PIPE}, "-|",
 226                    "stdbuf", "-o0",
 227                    "udevadm", "monitor", "--kernel", "--property", @args)
 228     or fail "open (umon): $!";
 229   cleanup { kill 9, $u->{KID} };
 230   $u->{PIPE}->blocking(0) or fail "set non-blocking (umon): $!";
 231
 232   ## Wait for the end of the preamble, indicated by the first blank line.
 233   ## From observation with strace(1), this means that the monitor has
 234   ## successfully attached itself to its netlink socket and is ready to fetch
 235   ## events.
 236   my $ok = 0;
 237   my $buf = "";
 238   my $now = time;
 239   my $end = $now + 5;
 240   while (!$ok) {
 241     sel
 242       $end - $now,
 243       [ $u->{PIPE} => sub {
 244           defined (my $b = doread $u->{PIPE}) or fail "read (umon): eof";
 245           $buf .= $b;
 246           if ($buf =~ /\n\n(.*)$/) { $ok = 1; $buf = $1; }
 247         }
 248       ];
 249     $now = time;
 250     if ($now >= $end) { fail "umon timeout"; }
 251   }
 252   $u->{BUF} = $buf;
 253
 254   ## Done.
 255   return $u;
 256 }
 257
 258 sub umon_read ($) {
 259   ## umon_read UMON
 260   ##
 261   ## Read events from UMON, as a list of hash references mapping properties
 262   ## to their values.
 263
 264   my ($u) = @_;
 265   my @s = ();
 266   for (;;) {
 267     defined (my $buf = doread $u->{PIPE}) or fail "read (umon): end of file";
 268     $buf eq "" and last;
 269     $buf = $u->{BUF} . $buf;
 270     my @r = split /\n\n/, $buf, -1;
 271     $u->{BUF} = pop @r;
 272     for my $r (@r) {
 273       push @s, { map { /^(\w+)=(.*)$/ } split /\n/, $r };
 274     }
 275   }
 276   return @s;
 277 }
 278
 279 sub umon_sync ($$) {
 280   ## umon_sync UMON, DEV
 281   ##
 282   ## Wait for UMON to report an event about the device DEV (without its
 283   ## `/dev/' prefix), triggering periodically just in case it missed one.
 284   ## This is useful for synchronizing.  Returns the list of events which
 285   ## weren't interesting.
 286
 287   my ($u, $dev) = @_;
 288   my $now = time;
 289   my $retry = 0;
 290   my $done = 0;
 291   my @ev = ();
 292   burble "sync with udev";
 293
 294   until ($done) {
 295
 296     ## Too late.  Trigger a change event and try again.
 297     if ($now >= $retry) {
 298       $retry = $now + 2;
 299       run "trigger $dev", "udevadm", "trigger", "--sysname-match=$dev";
 300     }
 301
 302     ## Now read events and see what happens.
 303     sel
 304       $retry - $now,
 305       [ $u->{PIPE} => sub {
 306           my @e = umon_read $u;
 307           while (@e) {
 308             my $e = shift @e;
 309             if ($e->{DEVNAME} eq $dev) { $done = 1; push @ev, @e; last; }
 310             else { push @ev, $e; }
 311           }
 312         }
 313       ];
 314     $now = time;
 315   }
 316
 317   return @ev;
 318 }
 319
 320 ###--------------------------------------------------------------------------
 321 ### Main code.
 322
 323 ## Parse the command line.
 324 our $USAGE = "usage: $QUIS VGNAME/LVNAME";
 325 sub version { print "$QUIS, version $VERSION\n"; }
 326 sub help {
 327   print <<EOF;
 328 $USAGE
 329
 330 Options:
 331   -h, --help            Show this help text.
 332   -v, --version         Show the program version number.
 333   -d, --debug           Show debugging information.
 334   -n, --no-act          Don't take corrective actions.
 335 EOF
 336 }
 337
 338 our $NOACT = 0;
 339 GetOptions('help|h|?'           => sub { version; help; exit; },
 340            'version|v'          => sub { version; exit; },
 341            'debug|d'            => \$DEBUG,
 342            'noact|n'            => \$NOACT)
 343   and @ARGV == 1
 344   and @ARGV[0] =~ m:(.+)/(.+):
 345   or do { print STDERR $USAGE, "\n"; exit 1; };
 346 our ($VG, $LV) = ($1, $2);
 347
 348 ## Check that the volume in question actually exists, and is a device-mapper
 349 ## device, before we wheel out the big guns.
 350 dmtable_update;
 351 our $SYS = devsys "/dev/$VG/$LV";
 352 burble "sysfs name is $SYS";
 353 my $t = $DMTAB{dmname $SYS}
 354   or fail "/dev/$VG/$LV isn't a device-mapper device";
 355 if ($DEBUG) {
 356   burble "found table...";
 357   burble "\t" . join " ", @$_ foreach @$t;
 358 }
 359 $t->[0][2] eq "snapshot" or fail "/dev/$VG/$LV isn't a snapshot";
 360
 361 ## Create a udev monitor.  We're only interested in disk-shaped block
 362 ## devices.  (If we use some other device kind for synchronization then this
 363 ## filter will have to be broadened.)
 364 my $u = umon_create "--subsystem-match=block/disk";
 365
 366 ## Prepare for the awful synchronization hack.  We need to make sure, below,
 367 ## that we've read all of the interesting events resulting from an `lvremove'
 368 ## call.  To do this, we wait for an event on a different device -- but we
 369 ## must avoid being fooled by spurious events on this device.  As an attempt
 370 ## to minimize the probability of this going wrong, acquire a pet device
 371 ## which nobody else is using.  The best idea seems to be a loopback device.
 372 open my $lopipe, "-|", "losetup", "--show", "--find", "/etc/motd"
 373   or fail "open (losetup attach)";
 374 chomp (my $lo = $lopipe->getline);
 375 { local $/ = undef; <$lopipe>; }
 376 $lo =~ s:^/dev/::;
 377 $lopipe->close or fail "wait (losetup attach): $!";
 378 cleanup { system "losetup", "--detach", "/dev/$lo" };
 379
 380 ## Initial synchronization, to make sure stuff works.
 381 umon_sync $u, $lo;
 382
 383 ## Try to remove the snapshot.  Capture stdout and stderr, and relay them if
 384 ## nothing serious went wrong.
 385 burble "initial attempt to remove snapshot";
 386 my ($rc, $out, $err) = capture "lvremove", "--force", "$VG/$LV";
 387 if ($rc != 0x500) {
 388   print STDOUT $out;
 389   print STDERR $err;
 390   burble "lvremove didn't explode (rc = $rc): we're done here";
 391   if ($rc >> 8) { $rc >>= 8 }
 392   elsif ($rc & 255) { $rc += 128 }
 393   exit $rc;
 394 }
 395 burble "initial lvremove failed";
 396
 397 ## OK, stuff went wrong.  First see if there was a udev cookie left over, and
 398 ## if so try to release it.  It's important to know that we've read all of
 399 ## the relevant uevents, so synchronize again.
 400 my @e = umon_sync $u, $lo;
 401 my %c = ();
 402 for my $e (@e) {
 403   $c{($e->{DM_COOKIE} & 0xffff) | 0xd4d0000} = 1
 404     if $e->{DEVPATH} eq $SYS && exists $e->{DM_COOKIE};
 405 }
 406 burble "cookies used: " . join ", ", map { sprintf "0x%x", $_ } keys %c;
 407
 408 ## Find the used cookies which are still extant, and release them.
 409 open $uc, "-|", "dmsetup", "udevcookies" or fail "open (cookies): $!";
 410 $uc->getline;
 411 my @leak = ();
 412 while (my $l = $uc->getline) {
 413   my @f = split ' ', $l;
 414   push @leak, $f[0] if $c{fixint $f[0]};
 415 }
 416 close $uc or fail "udevcookies failed (rc = $?)";
 417 for my $c (@leak) {
 418   burble "release leaked cookie $c";
 419   run "release cookie", "dmsetup", "udevreleasecookie", $c unless $NOACT;
 420 }
 421
 422 ## If we're very unlucky, the origin volume may still be suspended.  Resume
 423 ## it now, or the next attempt will get stuck.  (Resuming is idempotent, so
 424 ## we don't need to check whether it's already running.)  Finding the origin
 425 ## is annoying: search the device-mapper table for a device with a
 426 ## `snapshot-origin' table referencing the same backing store as the
 427 ## snapshot.
 428 my $back = $DMTAB{dmname $SYS}[0][3];
 429 my $orig = undef;
 430 burble "backend device $back";
 431 for my $dm (keys %DMTAB) {
 432   my $t = $DMTAB{$dm};
 433   next unless @$t == 1 &&
 434     $t->[0][2] eq "snapshot-origin" &&
 435     $t->[0][3] eq $back;
 436   defined $orig and fail "snapshot appears to have multiple origins";
 437   $orig = $dm;
 438 }
 439 defined $orig or fail "couldn't find snapshot origin device";
 440 burble "found origin volume $orig; resuming...";
 441 run "resume origin $orig", "dmsetup", "resume", $orig unless $NOACT;
 442
 443 ## See whether removing the snapshot again helps any.
 444 burble "retry snapshot removal";
 445 run "retry", "lvremove", "--force", "$VG/$LV" unless $NOACT;
 446
 447 ## OK, we're on the way to recovery.  The origin device may now be not a
 448 ## snapshot-origin any more.  Refresh the device-mapper table and inspect it.
 449 dmtable_update;
 450 if (-d "/sys/dev/block/$back") {
 451   my $backdm = dmname "/dev/block/$back";
 452   if ($DMTAB{$orig}[0][2] ne "snapshot-origin") {
 453     burble "origin released but backend $backdm still exists: remove";
 454     run "remove backend $backdm", "dmsetup", "remove", $backdm
 455       unless $NOACT;
 456   }
 457 }
 458
 459 ## All done.  There, that wasn't so bad, was it?
 460 burble "completed successfully";
 461 exit 0;
 462
 463 ###----- That's all, folks --------------------------------------------------