Subversion Repositories zfs_utils

Rev

Rev 25 | Go to most recent revision | Blame | Compare with Previous | Last modification | View Log | Download | RSS feed

package ZFS_Utils;

use strict;
use warnings;
use Exporter 'import';
use Data::Dumper;
use POSIX qw(strftime);
use File::Path qw(make_path);

our @EXPORT_OK = qw(loadConfig shredFile mountDriveByLabel mountGeli logMsg $logFileName $displayLogsOnConsole);


our $VERSION = '0.1';
our $logFileName = '/tmp/zfs_utils.log'; # this can be overridden by the caller, and turned off with empty string
our $displayLogsOnConsole = 1;

# this calls gshred which will overwrite the file 3 times, then
# remove it.
# NOTE: this will not work on ZFS, since ZFS is CopyOnWrite (COW)
# so assuming file is on something without COW (ramdisk, UFS, etc)
sub shredFile {
   my $filename = shift;
   `/usr/local/bin/gshred -u -f -s 32 $filename` if -e $filename;
}

sub logMsg {
    my $msg = shift;
    my $filename = shift // $logFileName;
    my $timeStampFormat = shift // '%Y-%m-%d %H:%M:%S';
    my $timestamp = strftime($timeStampFormat, localtime());
    if (defined $filename && $filename ne '' ) {
       open my $logfh, '>>', $filename or die "Could not open log file $filename: $!\n";
       print $logfh "$timestamp\t$msg\n";
       close $logfh;
    }
    print "$timestamp\t$msg\n" if ($displayLogsOnConsole);
}

# find a drive by it's label by scanning /dev/gpt/ for $timeout seconds.
# If the drive is found, mount it on mountPath and return the mountPath.
# If not found, return empty string.
sub mountDriveByLabel {
   my ($label, $mountPath, $timeout, $checkEvery ) = @_;
   unless ($label) {
      logMsg("mountDriveByLabel: No label provided");
      return '';
   }
   unless ( $label =~ /^[a-zA-Z0-9_\-]+$/ ) {
      logMsg("mountDriveByLabel: Invalid label '$label'");
      return '';
   }

   logMsg("mountDriveByLabel: Looking for drive with label '$label'");
   # default to /mnt/label if not provided
   $mountPath //= "/mnt/$label"; # this is where we'll mount it if we find it
   $label = "/dev/gpt/$label"; #  this is where FreeBSD puts gpt labeled drives
   # default to 10 minutes (600 seconds) if not provided
   $timeout //= 600;
   # default to checking every minute if not provided
   $checkEvery //= 60;
   # wait up to $timeout seconds for device to appear, checking every 10 seconds
   while ( $timeout > 0 ) {
      if ( -e "$label" ) {
         last;
      } else {
         sleep $checkEvery;
         $timeout -= $checkEvery;
      }
    }
    # if we found it, mount and return mount path
    if ( -e "$label" ) {
       # ensure mount point
       unless ( -d $mountPath || make_path($mountPath) ) {
         logMsg("Failed to create $mountPath: $!");
         return '';
       }
       # mount device (let mount detect filesystem)
       unless ( system('mount', $label, $mountPath) == 0 ) {
         logMsg("Failed to mount $label on $mountPath: $!");
         return '';
       }
       return $mountPath;
    } else {
       return '';
    }
}

## Load a YAML configuration file into a hashref.
## If the file does not exist, and a default hashref is provided,
## create the file by dumping the default to YAML, then return the default.
sub loadConfig {
    my ($filename, $default) = @_;

    # If no filename was provided, return default or empty hashref
    die "No filename provided to loadConfig\n" unless defined $filename;

    # If file doesn't exist but a default hashref was provided, try to
    # create the file by dumping the default to YAML, then return the default.
    unless (-e $filename) {
      logMsg("Config file $filename does not exist. Creating it with default values.");
      if ($default && ref $default eq 'HASH') {
         my $wrote = 0;
         eval {
               require YAML::XS;
               YAML::XS->import();
               YAML::XS::DumpFile($filename, $default);
               $wrote = 1;
               1;
         } or do {
               eval {
                  require YAML::Tiny;
                  YAML::Tiny->import();
                  my $yt = YAML::Tiny->new($default);
                  $yt->write($filename);
                  $wrote = 1;
                  1;
               } or do {
                  logMsg("No YAML writer available (YAML::XS or YAML::Tiny). Could not create $filename");
               };
         };

         die "Failed to write default config to $filename:$!\n" unless $wrote;
        }

        # No default provided; nothing to create
        return {};
    }

    my $yaml;

    # Try YAML::XS first, fall back to YAML::Tiny
    eval {
        require YAML::XS;
        YAML::XS->import();
        $yaml = YAML::XS::LoadFile($filename);
        logMsg("using YAML::XS to load $filename");
        1;
    } or do {
        eval {
            require YAML::Tiny;
            YAML::Tiny->import();
            $yaml = YAML::Tiny->read($filename);
            $yaml = $yaml->[0] if $yaml;  # YAML::Tiny returns an arrayref of documents
            logMsg("using YAML::Tiny to load $filename");
            1;
        } or do {
            logMsg("No YAML parser installed (YAML::XS or YAML::Tiny). Skipping config load from $filename");
            return ($default && ref $default eq 'HASH') ? $default : {};
        };
    };

    # Ensure we have a hashref
    die "Config file $filename did not produce a HASH.\n" unless (defined $yaml && ref $yaml eq 'HASH');

    return $yaml;
}



sub mountGeli {
   my $geliConfig = shift;
   unless ( -e $geliConfig->{'localKey'} ) {
      logMsg "Could not find local key file: " . $geliConfig->{'localKey'} . "\n";
      return '';
   }
   # find the keyfile disk and mount it
   my $path = mountDriveByLabel( $geliConfig->{'keydiskname'} );
   unless ( $path ne '' and -e "$path/" . $geliConfig->{'keyfile'} ) {
      logMsg "Could not find or mount keyfile disk with label: " . $geliConfig->{'keydiskname'} . "\n";
      return '';
   }
   # create the combined geli keyfile in target location
   unless ( makeGeliKey( "$path/" . $geliConfig->{'keyfile'}, $geliConfig->{'localKey'}, $geliConfig->{'target'} ) ) {
         logMsg "Could not create geli keyfile\n";
         return '';
      }
   # decrypt and mount the geli disks and zfs pool
   my $poolname = decryptAndMountGeli( $geliConfig );
   return $poolname;
                                                
}

## Decrypt each GELI disk from $geliConfig->{'diskList'} using the keyfile,
## then import and mount the ZFS pool specified in $geliConfig->{'poolname'}.
##
## Returns the pool name on success, empty on error.
sub decryptAndMountGeli {
   my ($geliConfig) = @_;
   # these are configuration sanity checks, so die if they fail
   die "No disk list found in GELI config\n" unless $geliConfig->{'diskList'};
   die "No pool name specified in config\n" unless $geliConfig->{'poolname'};

   my $diskList = $geliConfig->{'diskList'};
   my $poolname = $geliConfig->{'poolname'};
   my $keyfile = $geliConfig->{'target'};
   unless ( -e $keyfile ) {
      logMsg "GELI keyfile $keyfile does not exist\n";
      return '';
   }

   my @decrypted_devices;

   # Decrypt each disk in the list
   foreach my $disk (@{$diskList}) {
      unless ( -e $disk ) {
         logMsg "Disk $disk does not exist\n";
         return '';
      }

      # Derive the decrypted device name (.eli suffix on FreeBSD)
      my $decrypted = $disk . '.eli';

      # Decrypt using geli attach with the keyfile
      logMsg("Decrypting $disk with keyfile $keyfile");
      if ( my $result = system('geli', 'attach', '-k', $keyfile, $disk) == 0 ) {
         logMsg "Failed to decrypt $disk (exit $result)\n";
         return '';
      }

      unless ( -e $decrypted ) {
         logMsg "Decrypted device $decrypted does not exist after geli attach\n";
         return '';
      }
      push @decrypted_devices, $decrypted;
   }

   # Import the ZFS pool
   logMsg("Importing ZFS pool $poolname");
   my @import_cmd = ('zpool', 'import');
   # If decrypted devices exist, add their directories to -d list
   foreach my $dev (@decrypted_devices) {
      my $dir = $dev;
      $dir =~ s!/[^/]+$!!;  # Remove filename to get directory
      push @import_cmd, '-d', $dir;
   }
   push @import_cmd, $poolname;

   my $result = system(@import_cmd);
   unless ( $result == 0 ) {
      logMsg("Failed to import zfs pool $poolname (exit $result)\n");
      return '';
   }

   # Mount the ZFS pool (zfs mount -a mounts all filesystems in the pool)
   logMsg("Mounting ZFS pool $poolname");
   $result = system('zfs', 'mount', '-a');
   unless ( $result == 0 ) {
      logMsg("Failed to mount zfs pool $poolname (exit $result)\n");
      return '';
   }

   logMsg("Successfully decrypted and mounted pool $poolname");
   return $poolname;
}

## Create a GELI key by XOR'ing a remote binary keyfile and a local key (hex string).
##
## Arguments:
##   $remote_keyfile - path to binary keyfile (32 bytes)
##   $localKeyHexOrPath - hex string (64 hex chars) or path to file containing hex
##   $target - path to write the resulting 32-byte binary key
##
## Returns true on success, dies on fatal error.
sub makeGeliKey {
   my ($remote_keyfile, $localKeyHexOrPath, $target) = @_;

   die "remote keyfile not provided" unless defined $remote_keyfile;
   die "local key not provided" unless defined $localKeyHexOrPath;
   die "target not provided" unless defined $target;

   die "Remote keyfile $remote_keyfile does not exist\n" unless -e $remote_keyfile;

   # Read remote binary key
   open my $rh, '<:raw', $remote_keyfile or die "Unable to open $remote_keyfile: $!\n";
   my $rbuf;
   my $read = read($rh, $rbuf, 32);
   close $rh;
   die "Failed to read 32 bytes from $remote_keyfile (got $read)\n" unless defined $read && $read == 32;

   # Get local hex string (either direct string or file contents)
   my $hex;
   if (-e $localKeyHexOrPath) {
      open my $lh, '<', $localKeyHexOrPath or die "Unable to open local key file $localKeyHexOrPath: $!\n";
      local $/ = undef;
      $hex = <$lh>;
      close $lh;
   } else {
      $hex = $localKeyHexOrPath;
   }
   # clean hex (remove whitespace/newlines and optional 0x)
   $hex =~ s/0x//g;
   $hex =~ s/[^0-9a-fA-F]//g;

   die "Local key must be 64 hex characters (256-bit)\n" unless length($hex) == 64;

   my $lbuf = pack('H*', $hex);
   die "Local key decoded to unexpected length " . length($lbuf) . "\n" unless length($lbuf) == 32;

   # XOR the two buffers
   my $out = '';
   for my $i (0 .. 31) {
      $out .= chr( ord(substr($rbuf, $i, 1)) ^ ord(substr($lbuf, $i, 1)) );
   }

   # Ensure target directory exists
   my ($vol, $dirs, $file) = ($target =~ m{^(/?)(.*/)?([^/]+)$});
   if ($dirs) {
      my $dir = $dirs;
      $dir =~ s{/$}{};
      unless (-d $dir) {
         require File::Path;
         File::Path::make_path($dir) or die "Failed to create directory $dir: $!\n";
      }
   }

   # Write out binary key and protect permissions
   open my $oh, '>:raw', $target or die "Unable to open $target for writing: $!\n";
   print $oh $out or die "Failed to write to $target: $!\n";
   close $oh;
   chmod 0600, $target;

   return 1;
}

1;