#!/usr/bin/env perl

# Copyright (c) 2026, rodolico
# All rights reserved.
#
# Redistribution and use in source and binary forms, with or without
# modification, are permitted provided that the following conditions are met:
#
# 1. Redistributions of source code must retain the above copyright notice, this
#    list of conditions and the following disclaimer.
#
# 2. Redistributions in binary form must reproduce the above copyright notice,
#    this list of conditions and the following disclaimer in the documentation
#    and/or other materials provided with the distribution.
#
# THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS"
# AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE
# IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
# DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE
# FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
# DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR
# SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER
# CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY,
# OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
# OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
#
# scrubZFS - ZFS pool integrity verification via scrubbing
#
# PURPOSE:
#   Initiates and monitors scrub operations on all imported ZFS pools to verify
#   data integrity and detect potential corruption. Scrubs are performed sequentially
#   with progress monitoring until completion.
#
# USAGE:
#   Standalone: ./scrubZFS
#   From sneakernet: Executed automatically during cleanup phase on target server
#   From Perl script: my $results = eval { do './scrubZFS' };
#
# EXECUTION CONTEXT:
#   When executed by sneakernet on the target server:
#   - Script is read from transport drive, decrypted, and executed via eval()
#   - Progress messages sent to STDERR for real-time monitoring
#   - Summary results returned via return statement for logging
#   - When run standalone, prints results to STDOUT
#
# BEHAVIOR:
#   1. Discovers all imported ZFS pools on the system
#   2. Skips pools that are not imported (unavailable)
#   3. Initiates scrub operation on each pool
#   4. Monitors scrub progress with periodic status checks (15-second intervals)
#   5. Reports completion status and any errors detected
#   6. Returns summary of scrub results for all pools
#
# SCRUB DURATION:
#   Scrub time varies significantly based on:
#   - Pool size and data volume
#   - Disk speed and pool configuration
#   - System load and I/O activity
#   Typical range: Minutes to several hours for large pools
#
# REQUIREMENTS:
#   - ZFS utilities (zpool command)
#   - Root/sudo privileges for pool operations
#   - Pools must be imported to be processed
#
# OUTPUT:
#   Real-time: Progress messages to STDERR during scrub operations
#   Summary: Scrub completion status and errors detected (return value or STDOUT)
#
# Author: rodolico
# Version: 1.0
# Updated: 2026-01-16

use strict;
use warnings;

# Get list of all ZFS pools
sub getPools {
   my @pools;
   open(my $fh, '-|', 'zpool list -H -o name') or die "Cannot execute zpool list: $!\n";
   while (my $line = <$fh>) {
      chomp $line;
      push @pools, $line;
   }
   close($fh);
   return @pools;
}

# Start scrub on a pool
sub startScrub {
   my ($pool) = @_;
   print "Starting scrub on pool: $pool\n";
   system("zpool scrub $pool");
}

# Check if scrub is in progress
sub isScrubbing {
   my ($pool) = @_;
   my $status = `zpool status $pool`;
   return $status =~ /scrub in progress/i;
}

# Get scrub status
sub getScrubStatus {
   my ($pool) = @_;
   my $status = `zpool status $pool`;
   return $status;
}

# Main execution
my @pools = getPools();
my @results;
my @errorMessages = ();

if (@pools == 0) {
   push @errorMessages, "No ZFS pools found on this system";
   if (caller()) {
      return ( "", join("\n", @errorMessages) );
   } else {
      print "No ZFS pools found on this system.\n";
      exit 0;
   }
}

print STDERR "Found " . scalar(@pools) . " pool(s): " . join(', ', @pools) . "\n\n";

# Start scrub on all pools
foreach my $pool (@pools) {
   startScrub($pool);
}

print STDERR "\nWaiting for scrubs to complete...\n";

# Wait for all scrubs to complete
my $allDone = 0;
while (!$allDone) {
   sleep 10;
   $allDone = 1;
   foreach my $pool (@pools) {
      if (isScrubbing($pool)) {
         $allDone = 0;
         last;
      }
   }
}

print STDERR "\nAll scrubs completed. Results:\n";
print STDERR "=" x 60 . "\n";

# Report results
foreach my $pool (@pools) {
   print STDERR "\nPool: $pool\n";
   print STDERR "-" x 60 . "\n";
   my $status = getScrubStatus($pool);

   # Extract scrub-related lines
   my @lines = split(/\n/, $status);
   my $inScrubSection = 0;
   foreach my $line (@lines) {
      if ($line =~ /scrub/i || $inScrubSection) {
         print STDERR "$line\n";
         $inScrubSection = 1 if $line =~ /scrub/i;
         last if $inScrubSection && $line =~ /^\s*$/;
      }
   }
}

print STDERR "\n" . "=" x 60 . "\n";
print STDERR "Scrub report complete.\n";

# Prepare summary results for return
foreach my $pool (@pools) {
   my $status = getScrubStatus($pool);
   # as of ZFS 2.1, the scrub status line may vary, so check for common patterns
   if ($status =~ /errors:(\s+0\s+data errors)|(errors: No known data errors)/i) {
      push @results, "Pool $pool\tSCRUB PASSED - No errors found.";
      push @results, $1 if$status =~ m/scan:(scrub repaired.*)$/m;
   } else {
      push @results, "Pool $pool\tSCRUB FAILED - Errors detected!";
      push @errorMessages, "Pool $pool\tSCRUB FAILED - Errors detected!";
   }
}

# Return or print results depending on context
if (caller()) { # called from another script
   return ( 
      join( "\n", @results ) . "\n",
      @errorMessages ? join("\n", @errorMessages) : ""
   );
} else { # run standalone
   print "Results Summary:\n";
   print join( "\n", @results ) . "\n";
   if (@errorMessages) {
      print "\n=== CLEANUP SCRIPT ERRORS ===\n";
      print join("\n", @errorMessages) . "\n";
   }
}
# End of script