Subversion Repositories zfs_utils

Rev

Rev 24 | Rev 27 | Go to most recent revision | Show entire file | Ignore whitespace | Details | Blame | Last modification | View Log | RSS feed

Rev 24 Rev 25
Line 5... Line 5...
5
use Exporter 'import';
5
use Exporter 'import';
6
use Data::Dumper;
6
use Data::Dumper;
7
use POSIX qw(strftime);
7
use POSIX qw(strftime);
8
use File::Path qw(make_path);
8
use File::Path qw(make_path);
9
 
9
 
10
our @EXPORT_OK = qw(loadConfig shredFile mountDriveByLabel mountGeli logMsg $logFileName $displayLogsOnConsole);
10
our @EXPORT_OK = qw(loadConfig shredFile mountDriveByLabel mountGeli logMsg runCmd makeReplicateCommands $logFileName $displayLogsOnConsole);
11
 
11
 
12
 
12
 
13
our $VERSION = '0.1';
13
our $VERSION = '0.1';
14
our $logFileName = '/tmp/zfs_utils.log'; # this can be overridden by the caller, and turned off with empty string
14
our $logFileName = '/tmp/zfs_utils.log'; # this can be overridden by the caller, and turned off with empty string
15
our $displayLogsOnConsole = 1;
15
our $displayLogsOnConsole = 1;
16
 
16
 
-
 
17
# Execute a command and return its output.
-
 
18
# If called in scalar context, returns the full output as a single string.
-
 
19
# If called in list context, returns the output split into lines.
-
 
20
# If $merge_stderr is true (default), stderr is merged into stdout (only for scalar commands).
-
 
21
# returns empty string or empty list on failure and logs failure message.
-
 
22
sub runCmd {
-
 
23
   my ($cmd, $merge_stderr) = @_;
-
 
24
   $merge_stderr = 1 unless defined $merge_stderr;
-
 
25
 
-
 
26
   my $output = '';
-
 
27
 
-
 
28
   if (ref $cmd eq 'ARRAY') {
-
 
29
      # Execute without a shell (safer). Note: stderr is not merged in this path.
-
 
30
      open my $fh, '-|', @{$cmd} or do {
-
 
31
         logMsg("runCmd: failed to exec '@{$cmd}': $!");
-
 
32
         return wantarray ? () : '';
-
 
33
      };
-
 
34
      local $/ = undef;
-
 
35
      $output = <$fh>;
-
 
36
      close $fh;
-
 
37
   } else {
-
 
38
      # Scalar command runs via the shell; optionally merge stderr into stdout.
-
 
39
      my $c = $cmd;
-
 
40
      $c .= ' 2>&1' if $merge_stderr;
-
 
41
      $output = `$c`;
-
 
42
   }
-
 
43
 
-
 
44
   $output //= '';
-
 
45
 
-
 
46
   if (wantarray) {
-
 
47
      return $output eq '' ? () : split(/\n/, $output);
-
 
48
   } else {
-
 
49
      return $output;
-
 
50
   }
-
 
51
}
-
 
52
 
17
# this calls gshred which will overwrite the file 3 times, then
53
# this calls gshred which will overwrite the file 3 times, then
18
# remove it.
54
# remove it.
19
# NOTE: this will not work on ZFS, since ZFS is CopyOnWrite (COW)
55
# NOTE: this will not work on ZFS, since ZFS is CopyOnWrite (COW)
20
# so assuming file is on something without COW (ramdisk, UFS, etc)
56
# so assuming file is on something without COW (ramdisk, UFS, etc)
21
sub shredFile {
57
sub shredFile {
Line 320... Line 356...
320
   chmod 0600, $target;
356
   chmod 0600, $target;
321
 
357
 
322
   return 1;
358
   return 1;
323
}
359
}
324
 
360
 
-
 
361
sub makeReplicateCommands {
-
 
362
   my ($sourceSnapsRef, $statusRef, $newStatusRef) = @_;
-
 
363
   $sourceSnapsRef ||= [];
-
 
364
   $statusRef     ||= [];
-
 
365
   $newStatusRef  ||= [];
-
 
366
 
-
 
367
   # parse snapshots: each line is expected to have snapshot fullname as first token: pool/fs@snap ...
-
 
368
   my %snaps_by_fs;
-
 
369
   foreach my $line (@$sourceSnapsRef) {
-
 
370
      next unless defined $line && $line =~ /\S/;
-
 
371
      my ($tok) = split /\s+/, $line;
-
 
372
      next unless $tok && $tok =~ /@/;
-
 
373
      my ($fs, $snap) = split /@/, $tok, 2;
-
 
374
      push @{ $snaps_by_fs{$fs} }, $snap;
-
 
375
   }
-
 
376
 
-
 
377
   # nothing to do
-
 
378
   return [] unless keys %snaps_by_fs;
-
 
379
 
-
 
380
   # figure root filesystem: first snapshot line's fs is the requested root
-
 
381
   my ($first_line) = grep { defined $_ && $_ =~ /\S/ } @$sourceSnapsRef;
-
 
382
   my ($root_fs) = $first_line ? (split(/\s+/, $first_line))[0] =~ /@/ ? (split(/@/, (split(/\s+/, $first_line))[0]))[0] : undef : undef;
-
 
383
   $root_fs ||= (sort keys %snaps_by_fs)[0];
-
 
384
 
-
 
385
   # helper: find last status entry for a filesystem (status lines contain full snapshot names pool/fs@snap)
-
 
386
   my %last_status_for;
-
 
387
   for my $s (@$statusRef) {
-
 
388
      next unless $s && $s =~ /@/;
-
 
389
      my ($fs, $snap) = split /@/, $s, 2;
-
 
390
      $last_status_for{$fs} = $snap;    # later entries override earlier ones -> last occurrence kept
-
 
391
   }
-
 
392
 
-
 
393
   # build per-filesystem "from" and "to"
-
 
394
   my %from_for;
-
 
395
   my %to_for;
-
 
396
   foreach my $fs (keys %snaps_by_fs) {
-
 
397
      my $arr = $snaps_by_fs{$fs};
-
 
398
      next unless @$arr;
-
 
399
      $to_for{$fs} = $arr->[-1];
-
 
400
      $from_for{$fs} = $last_status_for{$fs};    # may be undef -> full send required
-
 
401
   }
-
 
402
 
-
 
403
   # decide if we can do a single recursive send:
-
 
404
   # condition: all 'to' snapshot names are identical
-
 
405
   my %to_names = map { $_ => 1 } values %to_for;
-
 
406
   my $single_to_name = (keys %to_names == 1) ? (keys %to_names)[0] : undef;
-
 
407
 
-
 
408
   my @commands;
-
 
409
 
-
 
410
   if ($single_to_name) {
-
 
411
      # check whether any from is missing
-
 
412
      my @from_values = map { $from_for{$_} } sort keys %from_for;
-
 
413
      my $any_from_missing = grep { !defined $_ } @from_values;
-
 
414
      my %from_names = map { $_ => 1 } grep { defined $_ } @from_values;
-
 
415
      my $single_from_name = (keys %from_names == 1) ? (keys %from_names)[0] : undef;
-
 
416
 
-
 
417
      if ($any_from_missing) {
-
 
418
         # full recursive send from root
-
 
419
         push @commands, sprintf('zfs send -R %s@%s', $root_fs, $single_to_name);
-
 
420
      }
-
 
421
      elsif ($single_from_name) {
-
 
422
         # incremental recursive send
-
 
423
         push @commands, sprintf('zfs send -R -I %s@%s %s@%s',
-
 
424
                           $root_fs, $single_from_name, $root_fs, $single_to_name);
-
 
425
      }
-
 
426
      else {
-
 
427
         # from snapshots differ across children -> fall back to per-filesystem sends
-
 
428
         foreach my $fs (sort keys %to_for) {
-
 
429
            my $to  = $to_for{$fs};
-
 
430
            my $from = $from_for{$fs};
-
 
431
            if ($from) {
-
 
432
               push @commands, sprintf('zfs send -I %s@%s %s@%s', $fs, $from, $fs, $to);
-
 
433
            } else {
-
 
434
               push @commands, sprintf('zfs send %s@%s', $fs, $to);
-
 
435
            }
-
 
436
         }
-
 
437
      }
-
 
438
 
-
 
439
      # update new status: record newest snap for every filesystem
-
 
440
      foreach my $fs (keys %to_for) {
-
 
441
         push @$newStatusRef, sprintf('%s@%s', $fs, $to_for{$fs});
-
 
442
      }
-
 
443
   } else {
-
 
444
      # not all children share same newest snap -> per-filesystem sends
-
 
445
      foreach my $fs (sort keys %to_for) {
-
 
446
         my $to  = $to_for{$fs};
-
 
447
         my $from = $from_for{$fs};
-
 
448
         if ($from) {
-
 
449
            push @commands, sprintf('zfs send -I %s@%s %s@%s', $fs, $from, $fs, $to);
-
 
450
         } else {
-
 
451
            push @commands, sprintf('zfs send %s@%s', $fs, $to);
-
 
452
         }
-
 
453
         push @$newStatusRef, sprintf('%s@%s', $fs, $to);
-
 
454
      }
-
 
455
   }
-
 
456
 
-
 
457
   # return arrayref of commands (caller can iterate or join with pipes)
-
 
458
   return \@commands;
-
 
459
}
-
 
460
 
-
 
461
 
325
1;
462
1;