Subversion Repositories zfs_utils

Rev

Rev 35 | Rev 38 | Go to most recent revision | Details | Compare with Previous | Last modification | View Log | RSS feed

Rev Author Line No. Line
34 rodolico 1
# Simplified BSD License (FreeBSD License)
2
#
3
# Copyright (c) 2025, Daily Data Inc.
4
# All rights reserved.
5
#
6
# Redistribution and use in source and binary forms, with or without
7
# modification, are permitted provided that the following conditions are met:
8
#
9
# 1. Redistributions of source code must retain the above copyright notice, this
10
#    list of conditions and the following disclaimer.
11
#
12
# 2. Redistributions in binary form must reproduce the above copyright notice,
13
#    this list of conditions and the following disclaimer in the documentation
14
#    and/or other materials provided with the distribution.
15
#
16
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
17
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
18
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
19
# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
20
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
21
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
22
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
23
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
24
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
25
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
26
 
24 rodolico 27
package ZFS_Utils;
28
 
29
use strict;
30
use warnings;
31
use Exporter 'import';
32
use Data::Dumper;
33
use POSIX qw(strftime);
34
use File::Path qw(make_path);
35
 
34 rodolico 36
# library of ZFS related utility functions
37
# Copyright 2024 Daily Data Inc. <rodo@dailydata.net>
38
 
39
# currently used for sneakernet scripts, but plans to expand to other ZFS related tasks
40
# functions include:
41
#   runCmd: execute a command and return its output
42
#   shredFile: securely delete a file using gshred
43
#   logMsg: log messages to a log file and optionally to console
44
#   mountDriveByLabel: find and mount a drive by its GPT label
45
#   loadConfig: load a YAML configuration file into a hashref
46
#   mountGeli: decrypt and mount a GELI encrypted ZFS pool
47
#   makeGeliKey: create a GELI key by XOR'ing a remote binary keyfile and a local hex key
48
#   decryptAndMountGeli: decrypt GELI disks and mount the ZFS pool
49
#   findGeliDisks: find available disks for GELI/ZFS use
50
#   makeReplicateCommands: create zfs send commands for replication based on snapshot lists
51
 
52
 
53
# Exported functions and variables
54
 
37 rodolico 55
our @EXPORT_OK = qw(loadConfig shredFile mountDriveByLabel mountGeli logMsg runCmd makeReplicateCommands sendReport $logFileName $displayLogsOnConsole $lastRunError);
24 rodolico 56
 
57
 
34 rodolico 58
our $VERSION = '0.2';
24 rodolico 59
our $logFileName = '/tmp/zfs_utils.log'; # this can be overridden by the caller, and turned off with empty string
34 rodolico 60
our $displayLogsOnConsole = 1; # if non-zero, log messages are also printed to console
27 rodolico 61
our $merge_stderr = 0; # if set to 1, stderr is captured in runCmd
37 rodolico 62
our $lastRunError = 0; # tracks the last error code from runCmd
24 rodolico 63
 
25 rodolico 64
# Execute a command and return its output.
65
# If called in scalar context, returns the full output as a single string.
66
# If called in list context, returns the output split into lines.
67
# If $merge_stderr is true (default), stderr is merged into stdout (only for scalar commands).
34 rodolico 68
# returns undef on failure and logs failure message.
25 rodolico 69
sub runCmd {
33 rodolico 70
   my $cmd = join( ' ', @_ );
25 rodolico 71
   $merge_stderr = 1 unless defined $merge_stderr;
72
   my $output = '';
73
 
34 rodolico 74
   logMsg( "Running command [$cmd]" );
75
   $cmd .= ' 2>&1' if $merge_stderr;
76
   $output = `$cmd`;
37 rodolico 77
   $lastRunError = $?;
78
   if ( $lastRunError ) {
79
      if ($? == -1) {
80
         logMsg( "failed to execute: $!");
81
         return '';
82
      } elsif ($? & 127) { # fatal error, exit program
83
         logMsg( sprintf( "child died with signal %d, %s coredump\n", ($? & 127),  ($? & 128) ? 'with' : 'without' ) );
84
         die;
85
      } elsif ($? >> 8) { # it had some return code other than 0
86
         logMsg( sprintf( "child exited with value %d\n", $? >> 8 ) );
87
      }
34 rodolico 88
   }
25 rodolico 89
   $output //= '';
90
 
91
   if (wantarray) {
92
      return $output eq '' ? () : split(/\n/, $output);
93
   } else {
94
      return $output;
95
   }
96
}
97
 
24 rodolico 98
# this calls gshred which will overwrite the file 3 times, then
99
# remove it.
100
# NOTE: this will not work on ZFS, since ZFS is CopyOnWrite (COW)
101
# so assuming file is on something without COW (ramdisk, UFS, etc)
102
sub shredFile {
103
   my $filename = shift;
104
   `/usr/local/bin/gshred -u -f -s 32 $filename` if -e $filename;
105
}
106
 
107
sub logMsg {
108
    my $msg = shift;
109
    my $filename = shift // $logFileName;
110
    my $timeStampFormat = shift // '%Y-%m-%d %H:%M:%S';
111
    my $timestamp = strftime($timeStampFormat, localtime());
112
    if (defined $filename && $filename ne '' ) {
113
       open my $logfh, '>>', $filename or die "Could not open log file $filename: $!\n";
114
       print $logfh "$timestamp\t$msg\n";
115
       close $logfh;
116
    }
117
    print "$timestamp\t$msg\n" if ($displayLogsOnConsole);
118
}
119
 
35 rodolico 120
# find a drive by it's label by scanning /dev/gpt/
121
# driveInfo is a hashref with the following keys:
122
# label - the GPT label of the drive (required)
123
# filesystem - the filesystem type (default: ufs)
124
# mountPath - where to mount the drive (default: /mnt/label)
125
# timeout - how long to wait for the drive (default: 600 seconds)
126
# check_interval - how often to check for the drive (default: 15 seconds)
24 rodolico 127
# If the drive is found, mount it on mountPath and return the mountPath.
128
# If not found, return empty string.
129
sub mountDriveByLabel {
35 rodolico 130
   my ( $driveInfo ) = @_;
131
   unless ($driveInfo->{label}) {
132
      logMsg("mountDriveByLabel: No drive label provided");
24 rodolico 133
      return '';
134
   }
35 rodolico 135
   unless ( $driveInfo->{label} =~ /^[a-zA-Z0-9_\-]+$/ ) {
136
      logMsg("mountDriveByLabel: Invalid label '$driveInfo->{label}'");
24 rodolico 137
      return '';
138
   }
139
 
35 rodolico 140
   logMsg("mountDriveByLabel: Looking for drive with label '$driveInfo->{label}'");
24 rodolico 141
   # default to /mnt/label if not provided
35 rodolico 142
   $driveInfo->{mountPath} //= "/mnt/$driveInfo->{label}"; # this is where we'll mount it if we find it
143
   $driveInfo->{filesystem} //= 'ufs'; # default to mounting ufs
34 rodolico 144
   # The location for the label depends on filesystem. Only providing access to ufs and msdos here for safety.
145
   # gpt labeled drives for ufs are in /dev/gpt/, for msdosfs in /dev/msdosfs/
37 rodolico 146
   $driveInfo->{label} = $driveInfo->{filesystem} eq 'msdos' ? "/dev/msdosfs/$driveInfo->{label}" : "/dev/gpt/$driveInfo->{label}"; 
31 rodolico 147
   # drive already mounted, just return the path
37 rodolico 148
   my $output = runCmd( "mount | grep '$driveInfo->{mountPath}'" );
149
   return $driveInfo->{mountPath} if ( $lastRunError == 0 ); # grep found it for us
24 rodolico 150
   # default to 10 minutes (600 seconds) if not provided
35 rodolico 151
   $driveInfo->{timeout} //= 600;
24 rodolico 152
   # default to checking every minute if not provided
35 rodolico 153
   $driveInfo->{check_interval} //= 15;
24 rodolico 154
   # wait up to $timeout seconds for device to appear, checking every 10 seconds
35 rodolico 155
   while ( $driveInfo->{timeout} > 0 ) {
156
      if ( -e "$driveInfo->{label}" ) {
24 rodolico 157
         last;
158
      } else {
37 rodolico 159
         print "Waiting for drive labeled $driveInfo->{label}\n";
35 rodolico 160
         sleep $driveInfo->{check_interval};
161
         $driveInfo->{timeout} -= $driveInfo->{check_interval};
24 rodolico 162
      }
163
    }
164
    # if we found it, mount and return mount path
35 rodolico 165
    if ( -e "$driveInfo->{label}" ) {
24 rodolico 166
       # ensure mount point
35 rodolico 167
       unless ( -d $driveInfo->{mountPath} || make_path($driveInfo->{mountPath}) ) {
168
         logMsg("Failed to create $driveInfo->{mountPath}: $!");
24 rodolico 169
         return '';
170
       }
37 rodolico 171
       # mount device
172
       runCmd( "mount -t $driveInfo->{filesystem} $driveInfo->{label} $driveInfo->{mountPath}" );
173
       if ( $lastRunError ) {
35 rodolico 174
         logMsg("Failed to mount $driveInfo->{label} on $driveInfo->{mountPath}: $!");
24 rodolico 175
         return '';
176
       }
35 rodolico 177
       return $driveInfo->{mountPath};
24 rodolico 178
    } else {
179
       return '';
180
    }
181
}
182
 
183
## Load a YAML configuration file into a hashref.
184
## If the file does not exist, and a default hashref is provided,
185
## create the file by dumping the default to YAML, then return the default.
186
sub loadConfig {
187
    my ($filename, $default) = @_;
188
 
189
    # If no filename was provided, return default or empty hashref
190
    die "No filename provided to loadConfig\n" unless defined $filename;
191
 
192
    # If file doesn't exist but a default hashref was provided, try to
193
    # create the file by dumping the default to YAML, then return the default.
194
    unless (-e $filename) {
195
      logMsg("Config file $filename does not exist. Creating it with default values.");
196
      if ($default && ref $default eq 'HASH') {
197
         my $wrote = 0;
198
         eval {
199
               require YAML::XS;
200
               YAML::XS->import();
201
               YAML::XS::DumpFile($filename, $default);
202
               $wrote = 1;
203
               1;
204
         } or do {
205
               eval {
206
                  require YAML::Tiny;
207
                  YAML::Tiny->import();
208
                  my $yt = YAML::Tiny->new($default);
209
                  $yt->write($filename);
210
                  $wrote = 1;
211
                  1;
212
               } or do {
213
                  logMsg("No YAML writer available (YAML::XS or YAML::Tiny). Could not create $filename");
214
               };
215
         };
216
 
217
         die "Failed to write default config to $filename:$!\n" unless $wrote;
218
        }
219
 
220
        # No default provided; nothing to create
221
        return {};
222
    }
223
 
224
    my $yaml;
225
 
226
    # Try YAML::XS first, fall back to YAML::Tiny
227
    eval {
228
        require YAML::XS;
229
        YAML::XS->import();
230
        $yaml = YAML::XS::LoadFile($filename);
231
        logMsg("using YAML::XS to load $filename");
232
        1;
233
    } or do {
234
        eval {
235
            require YAML::Tiny;
236
            YAML::Tiny->import();
237
            $yaml = YAML::Tiny->read($filename);
238
            $yaml = $yaml->[0] if $yaml;  # YAML::Tiny returns an arrayref of documents
239
            logMsg("using YAML::Tiny to load $filename");
240
            1;
241
        } or do {
242
            logMsg("No YAML parser installed (YAML::XS or YAML::Tiny). Skipping config load from $filename");
243
            return ($default && ref $default eq 'HASH') ? $default : {};
244
        };
245
    };
246
    # Ensure we have a hashref
247
    die "Config file $filename did not produce a HASH.\n" unless (defined $yaml && ref $yaml eq 'HASH');
248
 
249
    return $yaml;
250
}
251
 
252
 
253
 
254
sub mountGeli {
255
   my $geliConfig = shift;
30 rodolico 256
   unless ( $geliConfig->{'localKey'} ) {
257
      logMsg "Could not find local key in configuration file\n";
24 rodolico 258
      return '';
259
   }
260
   # find the keyfile disk and mount it
261
   my $path = mountDriveByLabel( $geliConfig->{'keydiskname'} );
262
   unless ( $path ne '' and -e "$path/" . $geliConfig->{'keyfile'} ) {
263
      logMsg "Could not find or mount keyfile disk with label: " . $geliConfig->{'keydiskname'} . "\n";
264
      return '';
265
   }
266
   # create the combined geli keyfile in target location
267
   unless ( makeGeliKey( "$path/" . $geliConfig->{'keyfile'}, $geliConfig->{'localKey'}, $geliConfig->{'target'} ) ) {
268
         logMsg "Could not create geli keyfile\n";
269
         return '';
270
      }
271
   # decrypt and mount the geli disks and zfs pool
272
   my $poolname = decryptAndMountGeli( $geliConfig );
273
   return $poolname;
274
 
275
}
276
 
30 rodolico 277
# find all disks which are candidates for use with geli/zfs
278
# Grabs all disks on the system, then removes those with partitions
279
# and those already used in zpools.
280
sub findGeliDisks {
281
   logMsg("Finding available disks for GELI/ZFS use");
282
   # get all disks in system
283
   my %allDisks = map{ chomp $_ ; $_ => 1 } runCmd( "geom disk list | grep 'Geom name:' | rev | cut -d' ' -f1 | rev" );
284
   # get the disks with partitions
285
   my @temp = runCmd( "gpart show -p | grep '^=>'");  # -p prints just the disks without partitions
286
   # remove them from the list
287
   foreach my $disk ( @temp ) {
288
      $allDisks{$1} = 0 if ( $disk =~ m/^=>[\t\s0-9]+([a-z][a-z0-9]+)/ ) ;
289
   }
290
 
291
   # get disk which are currently used for zpools
292
   @temp = runCmd( "zpool status -LP | grep '/dev/'" );
293
   foreach my $disk ( @temp ) {
294
      $allDisks{$1} = 0 if  $disk =~ m|/dev/([a-z]+\d+)|;
295
   }
296
 
297
   # return only the disks which are free (value 1)
298
   return grep{ $allDisks{$_} == 1 } keys %allDisks;
299
}
300
 
24 rodolico 301
## Decrypt each GELI disk from $geliConfig->{'diskList'} using the keyfile,
302
## then import and mount the ZFS pool specified in $geliConfig->{'poolname'}.
303
##
304
## Returns the pool name on success, empty on error.
305
sub decryptAndMountGeli {
306
   my ($geliConfig) = @_;
30 rodolico 307
 
308
   # Can't continue at all if no pool name
24 rodolico 309
   die "No pool name specified in config\n" unless $geliConfig->{'poolname'};
30 rodolico 310
   # if no list of disks provided, try to find them
311
   $geliConfig->{'diskList'} //= findGeliDisks();
312
 
24 rodolico 313
   my $diskList = $geliConfig->{'diskList'};
314
   my $poolname = $geliConfig->{'poolname'};
315
   my $keyfile = $geliConfig->{'target'};
316
   unless ( -e $keyfile ) {
317
      logMsg "GELI keyfile $keyfile does not exist\n";
318
      return '';
319
   }
320
 
321
   my @decrypted_devices;
322
 
323
   # Decrypt each disk in the list
30 rodolico 324
   foreach my $disk (@{$geliConfig->{'diskList'}}) {
24 rodolico 325
      unless ( -e $disk ) {
326
         logMsg "Disk $disk does not exist\n";
327
         return '';
328
      }
329
 
330
      # Derive the decrypted device name (.eli suffix on FreeBSD)
331
      my $decrypted = $disk . '.eli';
332
 
333
      # Decrypt using geli attach with the keyfile
334
      logMsg("Decrypting $disk with keyfile $keyfile");
30 rodolico 335
      if ( my $result = system('geli', 'attach', '-k', $geliConfig->{'target'}, $disk) == 0 ) {
24 rodolico 336
         logMsg "Failed to decrypt $disk (exit $result)\n";
30 rodolico 337
         next; # ignore failed disks and continue to see if we can import the pool
24 rodolico 338
      }
339
 
340
      unless ( -e $decrypted ) {
341
         logMsg "Decrypted device $decrypted does not exist after geli attach\n";
342
         return '';
343
      }
344
      push @decrypted_devices, $decrypted;
345
   }
346
 
347
   # Import the ZFS pool
348
   logMsg("Importing ZFS pool $poolname");
349
   my @import_cmd = ('zpool', 'import');
350
   # If decrypted devices exist, add their directories to -d list
30 rodolico 351
   #foreach my $dev (@decrypted_devices) {
352
   #   my $dir = $dev;
353
   #   $dir =~ s!/[^/]+$!!;  # Remove filename to get directory
354
   #   push @import_cmd, '-d', $dir;
355
   #}
356
 
24 rodolico 357
   push @import_cmd, $poolname;
358
 
359
   my $result = system(@import_cmd);
360
   unless ( $result == 0 ) {
361
      logMsg("Failed to import zfs pool $poolname (exit $result)\n");
362
      return '';
363
   }
364
 
365
   # Mount the ZFS pool (zfs mount -a mounts all filesystems in the pool)
366
   logMsg("Mounting ZFS pool $poolname");
367
   $result = system('zfs', 'mount', '-a');
368
   unless ( $result == 0 ) {
369
      logMsg("Failed to mount zfs pool $poolname (exit $result)\n");
370
      return '';
371
   }
372
 
373
   logMsg("Successfully decrypted and mounted pool $poolname");
374
   return $poolname;
375
}
376
 
377
## Create a GELI key by XOR'ing a remote binary keyfile and a local key (hex string).
378
##
379
## Arguments:
380
##   $remote_keyfile - path to binary keyfile (32 bytes)
381
##   $localKeyHexOrPath - hex string (64 hex chars) or path to file containing hex
382
##   $target - path to write the resulting 32-byte binary key
383
##
384
## Returns true on success, dies on fatal error.
385
sub makeGeliKey {
386
   my ($remote_keyfile, $localKeyHexOrPath, $target) = @_;
387
 
388
   die "remote keyfile not provided" unless defined $remote_keyfile;
389
   die "local key not provided" unless defined $localKeyHexOrPath;
390
   die "target not provided" unless defined $target;
391
 
392
   die "Remote keyfile $remote_keyfile does not exist\n" unless -e $remote_keyfile;
393
 
394
   # Read remote binary key
395
   open my $rh, '<:raw', $remote_keyfile or die "Unable to open $remote_keyfile: $!\n";
396
   my $rbuf;
397
   my $read = read($rh, $rbuf, 32);
398
   close $rh;
399
   die "Failed to read 32 bytes from $remote_keyfile (got $read)\n" unless defined $read && $read == 32;
400
 
401
   # Get local hex string (either direct string or file contents)
402
   my $hex;
403
   if (-e $localKeyHexOrPath) {
404
      open my $lh, '<', $localKeyHexOrPath or die "Unable to open local key file $localKeyHexOrPath: $!\n";
405
      local $/ = undef;
406
      $hex = <$lh>;
407
      close $lh;
408
   } else {
409
      $hex = $localKeyHexOrPath;
410
   }
411
   # clean hex (remove whitespace/newlines and optional 0x)
412
   $hex =~ s/0x//g;
413
   $hex =~ s/[^0-9a-fA-F]//g;
414
 
415
   die "Local key must be 64 hex characters (256-bit)\n" unless length($hex) == 64;
416
 
417
   my $lbuf = pack('H*', $hex);
418
   die "Local key decoded to unexpected length " . length($lbuf) . "\n" unless length($lbuf) == 32;
419
 
420
   # XOR the two buffers
421
   my $out = '';
422
   for my $i (0 .. 31) {
423
      $out .= chr( ord(substr($rbuf, $i, 1)) ^ ord(substr($lbuf, $i, 1)) );
424
   }
425
 
426
   # Ensure target directory exists
427
   my ($vol, $dirs, $file) = ($target =~ m{^(/?)(.*/)?([^/]+)$});
428
   if ($dirs) {
429
      my $dir = $dirs;
430
      $dir =~ s{/$}{};
431
      unless (-d $dir) {
432
         require File::Path;
433
         File::Path::make_path($dir) or die "Failed to create directory $dir: $!\n";
434
      }
435
   }
436
 
437
   # Write out binary key and protect permissions
438
   open my $oh, '>:raw', $target or die "Unable to open $target for writing: $!\n";
439
   print $oh $out or die "Failed to write to $target: $!\n";
440
   close $oh;
441
   chmod 0600, $target;
442
 
443
   return 1;
444
}
445
 
25 rodolico 446
sub makeReplicateCommands {
447
   my ($sourceSnapsRef, $statusRef, $newStatusRef) = @_;
448
   $sourceSnapsRef ||= [];
449
   $statusRef     ||= [];
450
   $newStatusRef  ||= [];
451
 
452
   # parse snapshots: each line is expected to have snapshot fullname as first token: pool/fs@snap ...
453
   my %snaps_by_fs;
454
   foreach my $line (@$sourceSnapsRef) {
455
      next unless defined $line && $line =~ /\S/;
456
      my ($tok) = split /\s+/, $line;
457
      next unless $tok && $tok =~ /@/;
458
      my ($fs, $snap) = split /@/, $tok, 2;
459
      push @{ $snaps_by_fs{$fs} }, $snap;
460
   }
461
 
462
   # nothing to do
463
   return [] unless keys %snaps_by_fs;
464
 
465
   # figure root filesystem: first snapshot line's fs is the requested root
466
   my ($first_line) = grep { defined $_ && $_ =~ /\S/ } @$sourceSnapsRef;
467
   my ($root_fs) = $first_line ? (split(/\s+/, $first_line))[0] =~ /@/ ? (split(/@/, (split(/\s+/, $first_line))[0]))[0] : undef : undef;
468
   $root_fs ||= (sort keys %snaps_by_fs)[0];
469
 
470
   # helper: find last status entry for a filesystem (status lines contain full snapshot names pool/fs@snap)
471
   my %last_status_for;
472
   for my $s (@$statusRef) {
473
      next unless $s && $s =~ /@/;
474
      my ($fs, $snap) = split /@/, $s, 2;
475
      $last_status_for{$fs} = $snap;    # later entries override earlier ones -> last occurrence kept
476
   }
477
 
478
   # build per-filesystem "from" and "to"
479
   my %from_for;
480
   my %to_for;
481
   foreach my $fs (keys %snaps_by_fs) {
482
      my $arr = $snaps_by_fs{$fs};
483
      next unless @$arr;
484
      $to_for{$fs} = $arr->[-1];
485
      $from_for{$fs} = $last_status_for{$fs};    # may be undef -> full send required
486
   }
487
 
488
   # decide if we can do a single recursive send:
489
   # condition: all 'to' snapshot names are identical
490
   my %to_names = map { $_ => 1 } values %to_for;
491
   my $single_to_name = (keys %to_names == 1) ? (keys %to_names)[0] : undef;
492
 
31 rodolico 493
   my %commands;
25 rodolico 494
 
495
   if ($single_to_name) {
496
      # check whether any from is missing
497
      my @from_values = map { $from_for{$_} } sort keys %from_for;
498
      my $any_from_missing = grep { !defined $_ } @from_values;
499
      my %from_names = map { $_ => 1 } grep { defined $_ } @from_values;
500
      my $single_from_name = (keys %from_names == 1) ? (keys %from_names)[0] : undef;
501
 
502
      if ($any_from_missing) {
503
         # full recursive send from root
37 rodolico 504
         $commands{$root_fs} = sprintf('zfs send -R %s@%s', $root_fs, $single_to_name);
25 rodolico 505
      }
506
      elsif ($single_from_name) {
31 rodolico 507
         # incremental recursive send, but don't do it if they are the same
508
         $commands{$root_fs} = sprintf('zfs send -R -I %s@%s %s@%s',
509
                           $root_fs, $single_from_name, $root_fs, $single_to_name)
510
                           unless $single_from_name eq $single_to_name;
25 rodolico 511
      }
512
      else {
513
         # from snapshots differ across children -> fall back to per-filesystem sends
514
         foreach my $fs (sort keys %to_for) {
515
            my $to  = $to_for{$fs};
516
            my $from = $from_for{$fs};
517
            if ($from) {
31 rodolico 518
               # if from and to are different, add it
519
               $commands{$fs} = sprintf('zfs send -I %s@%s %s@%s', $fs, $from, $fs, $to)
520
                  unless $from eq $to;
25 rodolico 521
            } else {
31 rodolico 522
               $commands{$fs} = sprintf('zfs send %s@%s', $fs, $to);
25 rodolico 523
            }
524
         }
525
      }
526
 
527
      # update new status: record newest snap for every filesystem
528
      foreach my $fs (keys %to_for) {
529
         push @$newStatusRef, sprintf('%s@%s', $fs, $to_for{$fs});
530
      }
531
   } else {
532
      # not all children share same newest snap -> per-filesystem sends
533
      foreach my $fs (sort keys %to_for) {
534
         my $to  = $to_for{$fs};
535
         my $from = $from_for{$fs};
536
         if ($from) {
31 rodolico 537
            $commands{$fs} = sprintf('zfs send -I %s@%s %s@%s', $fs, $from, $fs, $to);
25 rodolico 538
         } else {
31 rodolico 539
            $commands{$fs} = sprintf('zfs send %s@%s', $fs, $to);
25 rodolico 540
         }
541
         push @$newStatusRef, sprintf('%s@%s', $fs, $to);
542
      }
543
   }
544
 
545
   # return arrayref of commands (caller can iterate or join with pipes)
31 rodolico 546
   return \%commands;
25 rodolico 547
}
548
 
35 rodolico 549
# Send report via email and/or copy to target drive.
550
# $reportConfig is a hashref with optional keys:
551
#   email - email address to send report to
552
#   targetDrive - hashref with keys:
553
#       label - GPT or msdosfs label of the target drive
554
#       mount_point - optional mount point to use (if not provided, /mnt/label is used)
555
# $subject is the email subject
556
# $logFile is the path to the log file to send/copy
557
sub sendReport {
558
   my ( $reportConfig, $subject, $logFile ) = @_;
559
   return unless defined $reportConfig;
37 rodolico 560
   logMsg( "Beginning sendReport" );
561
   # if they have set an e-mail address, try to e-mail the report
35 rodolico 562
   if ( defined $reportConfig->{email} && $reportConfig->{email} ne '' ) {
37 rodolico 563
      logMsg( "Sending report via e-mail to $reportConfig->{email}");
35 rodolico 564
      sendEmailReport( $reportConfig->{email}, $subject, $logFile );
565
   }
37 rodolico 566
   # if targetDrive defined and there is a valid label for it, try to mount it and write the report there
567
   if ( defined $reportConfig->{targetDrive} && defined $reportConfig->{targetDrive}->{label} && $reportConfig->{targetDrive}->{label} ) {
568
      logMsg( "Saving report to disk with label $reportConfig->{targetDrive}->{label}" );
35 rodolico 569
      my $mountPoint = mountDriveByLabel( $reportConfig->{targetDrive}->{label}, $reportConfig->{targetDrive}->{mount_point}, 300 );
37 rodolico 570
      if ( defined $mountPoint && $mountPoint ) {
35 rodolico 571
         copyReportToDrive( $logFile, $mountPoint );
572
         `umount $mountPoint`;
573
         rmdir $mountPoint;
574
      } else {
575
         logMsg( "Warning: could not mount report target drive with label '$reportConfig->{targetDrive}->{label}'" );
576
      }
577
   }
578
}
25 rodolico 579
 
35 rodolico 580
# Copy the report log file to the specified mount point.
581
# $logFile is the path to the log file to copy.
582
# $mountPoint is the mount point of the target drive.
583
# Does nothing if log file or mount point are invalid.
584
sub copyReportToDrive {
585
   my ( $logFile, $mountPoint ) = @_;
586
   return unless defined $logFile && -e $logFile;
587
   return unless defined $mountPoint && -d $mountPoint;
588
 
589
   my $targetFile = "$mountPoint/" . ( split( /\//, $logFile ) )[-1];
590
   logMsg( "Copying report log file $logFile to drive at $mountPoint" );
591
   unless ( copy( $logFile, $targetFile ) ) {
592
      logMsg( "Could not copy report log file to target drive: $!" );
593
   }
594
}
595
 
596
# Send an email report with the contents of the log file.
597
# $to is the recipient email address.
598
# $subject is the email subject.
599
# $logFile is the path to the log file to send.
600
# Does nothing if any parameter is invalid.
601
sub sendEmailReport {
602
   my ( $to, $subject, $logFile ) = @_;
603
   return unless defined $to && $to ne '';
37 rodolico 604
   $subject //= 'Sneakernet Replication Report from ' . `hostname`;
605
   $logFile //= '';
35 rodolico 606
 
607
   logMsg( "Sending email report to $to with subject '$subject'" );
608
   open my $mailfh, '|-', '/usr/sbin/sendmail -t' or do {
609
      logMsg( "Could not open sendmail: $!" );
610
      return;
611
   };
612
   print $mailfh "To: $to\n";
613
   print $mailfh "Subject: $subject\n";
614
   print $mailfh "MIME-Version: 1.0\n";
615
   print $mailfh "Content-Type: text/plain; charset=\"utf-8\"\n";
616
   print $mailfh "\n"; # end of headers
37 rodolico 617
 
618
   print $mailfh "Following is the report for replication\n\n";
35 rodolico 619
 
37 rodolico 620
   if ( -e $logFile && open my $logfh, '<', $logFile ) {
621
      while ( my $line = <$logfh> ) {
622
         print $mailfh $line;
623
      }
624
      close $logfh;
625
   } else {
626
      logMsg( "Could not open log file [$logFile] for reading: $!" );
35 rodolico 627
   };
37 rodolico 628
 
35 rodolico 629
   close $mailfh;
630
}  
631
 
24 rodolico 632
1;