#!/usr/bin/env perl

# Copyright (c) 2025, R. W. 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.

# all_zfs
# ZFS pools: storage.zfs keys (pool health and sizes, vdev trees with members
# resolved to disks), and the old diskinfo ZFS keys (replaces all_zfs). Runs
# only when zpool is installed and lists a pool.
#
# Revision History:
# 2026-10-18 Claude v1.0.0 new sensor, split from unix_storage (bug 210)

package all_zfs;

use strict;
use warnings;
use version;
our $VERSION = version->declare('v1.0.0');

use FindBin;
use File::Spec;
use lib File::Spec->catdir($FindBin::Bin), File::Spec->catdir("$FindBin::Bin/..");
use library qw(:all);

my $CATEGORY = 'storage';
my $OLD_CATEGORY = 'diskinfo';
#######################################################
#
# parseZpoolList( $text )
#
# Parses zpool list -pH -o name,size,alloc,free,health.
#
# Parameters:
#   $text - command output
#
# Returns:
#   array reference of hashes: name, size, alloc, free, health
#
# Side Effects:
#   none
#
#######################################################
sub parseZpoolList {
   my $text = shift;
   my @pools;
   foreach my $line (split(/\n/, defined($text) ? $text : '')) {
      my ($name, $size, $alloc, $free, $health) = split(/\t/, $line);
      next unless defined($health) && $size =~ /^\d+$/;
      push @pools, {'name' => $name, 'size' => $size, 'alloc' => $alloc, 'free' => $free, 'health' => $health};
   }
   return \@pools;
}

#######################################################
#
# oldZfsLines( $pools, $verbose )
#
# Old diskinfo ZFS keys, as v3.7.1 all_zfs: size and used in KiB (size
# not truncated, used truncated), level = the first vdev, components =
# the second field of every later zpool list -pHv line. Section headers
# (dedup, logs, cache ...) are printed with spaces, not tabs, so they
# have no second field and are left out, which gives the flattened string.
#
# Parameters:
#   $pools   - array reference from parseZpoolList
#   $verbose - hash reference pool => zpool list -pHv <pool> text
#
# Returns:
#   array reference of lines
#
# Side Effects:
#   none
#
#######################################################
sub oldZfsLines {
   my ($pools, $verbose) = @_;
   my @out;
   foreach my $pool (@{$pools}) {
      my $name = $pool->{'name'};
      my $size = $pool->{'size'} / 1024;
      my $allocated = int($pool->{'alloc'} / 1024);
      push @out, "$OLD_CATEGORY\t$name\tfstype\tzfs";
      push @out, "$OLD_CATEGORY\t$name\tsize\t$size";
      push @out, "$OLD_CATEGORY\t$name\tused\t$allocated";

      my @lines = split(/\n/, defined($verbose->{$name}) ? $verbose->{$name} : '');
      next unless @lines;
      shift @lines; # the pool line
      my @first = split("\t", defined($lines[0]) ? $lines[0] : '');
      push @out, "$OLD_CATEGORY\t$name\tlevel\t" . (defined($first[1]) ? $first[1] : '');
      shift @lines;
      my @components;
      foreach my $line (@lines) {
         my @fields = split("\t", $line);
         push @components, $fields[1] if defined $fields[1];
      }
      push @out, "$OLD_CATEGORY\t$name\tcomponents\t" . join(' ', @components);
   }
   return \@out;
}

#######################################################
#
# zfsPoolLines( $pools )
#
# storage.zfs.<pool> health and sizes.
#
# Parameters:
#   $pools - array reference from parseZpoolList
#
# Returns:
#   array reference of lines
#
# Side Effects:
#   none
#
#######################################################
sub zfsPoolLines {
   my $pools = shift;
   my @out;
   foreach my $pool (@{$pools}) {
      my $p = "$CATEGORY\tzfs\t$pool->{'name'}";
      push @out, "$p\thealth\t$pool->{'health'}", "$p\tsize_bytes\t$pool->{'size'}",
         "$p\tallocated_bytes\t$pool->{'alloc'}", "$p\tfree_bytes\t$pool->{'free'}";
   }
   return \@out;
}

#######################################################
#
# vdevType( $name, $isLeaf )
#
# Returns the vdev type word for a top-level vdev name.
#
# Parameters:
#   $name   - vdev name (mirror-1, raidz2-0, draid2:4d:8c:0s-0, da5)
#   $isLeaf - true when the vdev has no children (a single disk)
#
# Returns:
#   mirror, raidz1, raidz2, raidz3, draid..., disk, or the name stem
#
# Side Effects:
#   none
#
#######################################################
sub vdevType {
   my ($name, $isLeaf) = @_;
   return 'disk' if $isLeaf;
   return 'mirror' if $name =~ /^mirror(-\d+)?$/;
   return "raidz$1" if $name =~ /^raidz([123])(-\d+)?$/;
   return 'raidz1' if $name =~ /^raidz(-\d+)?$/;
   if ($name =~ /^(draid.*?)(-\d+)?$/) {
      return $1;
   }
   my $stem = $name;
   $stem =~ s/-\d+$//;
   return $stem;
}

#######################################################
#
# parseZpoolStatus( $text, $res )
#
# storage.zfs.<pool>.vdevs tree from zpool status -P, parsed by
# indentation. Section headers (logs, cache, spares, special, dedup)
# set the class of the vdevs that follow; leaves under a vdev are its
# members, with state and error counts, resolved to disks.
#
# Parameters:
#   $text - zpool status -P output (one or more pools)
#   $res  - resolver
#
# Returns:
#   array reference of lines
#
# Side Effects:
#   none
#
#######################################################
sub parseZpoolStatus {
   my ($text, $res) = @_;
   my %classOf = ('logs' => 'log', 'cache' => 'cache', 'spares' => 'spare', 'special' => 'special', 'dedup' => 'dedup');
   my @out;

   # collect the config rows of each pool: depth, name, state, read, write, cksum
   my (%rows, @poolOrder, $pool, $inConfig);
   foreach my $line (split(/\n/, defined($text) ? $text : '')) {
      if ($line =~ /^\s*pool:\s*(\S+)/) {
         $pool = $1;
         push @poolOrder, $pool;
         $rows{$pool} = [];
         $inConfig = 0;
      } elsif ($line =~ /^\s*config:/) {
         $inConfig = 1;
      } elsif ($line =~ /^\s*errors:/) {
         $inConfig = 0;
      } elsif ($inConfig && defined($pool) && $line =~ /^\t( *)(\S+)\s*(.*?)\s*$/) {
         my ($indent, $name, $rest) = ($1, $2, $3);
         next if $name eq 'NAME';
         my @f = split(/\s+/, $rest);
         push @{$rows{$pool}}, {'depth' => int(length($indent) / 2), 'name' => $name,
            'state' => $f[0], 'read' => $f[1], 'write' => $f[2], 'cksum' => $f[3]};
      }
   }

   foreach my $p (@poolOrder) {
      my @r = @{$rows{$p}};
      my $class = 'data';
      my $vdev;
      for (my $i = 0; $i < @r; $i++) {
         my $row = $r[$i];
         my $nextDepth = $i + 1 < @r ? $r[$i + 1]{'depth'} : 0;
         my $isLeaf = $nextDepth <= $row->{'depth'};
         if ($row->{'depth'} == 0) {
            # the pool itself, or a section header
            $class = exists($classOf{$row->{'name'}}) ? $classOf{$row->{'name'}} : 'data' unless $row->{'name'} eq $p;
            $vdev = undef;
            next;
         }
         if ($row->{'depth'} == 1) {
            $vdev = $row->{'name'};
            $vdev =~ s{^/dev/}{};
            my $prefix = "$CATEGORY\tzfs\t$p\tvdevs\t$vdev";
            push @out, "$prefix\tclass\t$class", "$prefix\ttype\t" . vdevType($vdev, $isLeaf);
            push @out, "$prefix\tstate\t$row->{'state'}" if defined($row->{'state'});
            next unless $isLeaf;
         } elsif (!$isLeaf) {
            next; # interior vdev such as replacing-0 or spare-1
         }
         next unless defined($vdev);
         my $member = $row->{'name'};
         $member =~ s{^/dev/}{};
         my $prefix = "zfs\t$p\tvdevs\t$vdev\tmembers\t$member";
         push @out, memberLines($prefix, resolveMember($row->{'name'}, $res));
         push @out, "$CATEGORY\t$prefix\tstate\t$row->{'state'}" if defined($row->{'state'});
         push @out, "$CATEGORY\t$prefix\tread_errors\t$row->{'read'}" if defined($row->{'read'});
         push @out, "$CATEGORY\t$prefix\twrite_errors\t$row->{'write'}" if defined($row->{'write'});
         push @out, "$CATEGORY\t$prefix\tchecksum_errors\t$row->{'cksum'}" if defined($row->{'cksum'});
      }
   }
   return \@out;
}

#######################################################
#
# main()
#
# Emits storage.zfs and old diskinfo ZFS keys.
#
# Parameters:
#   none
#
# Returns:
#   integer exit status (1 wrong OS, 2 not applicable)
#
# Side Effects:
#   runs zpool, lsblk or geom, writes STDOUT/STDERR
#
#######################################################
sub main {
   if (!checkOS({ 'linux' => undef, 'freebsd' => undef })) {
      print STDERR "unsupported os\n";
      return 1;
   }
   unless (haveCommand('zpool')) {
      print STDERR "zpool not found\n";
      return 2;
   }
   my $pools = parseZpoolList(runCommand('zpool', 'list', '-pH', '-o', 'name,size,alloc,free,health'));
   unless (@{$pools}) {
      print STDERR "no zfs pools\n";
      return 2;
   }
   my $inv = localDiskInventory();
   my %verbose = map { $_->{'name'} => runCommand('zpool', 'list', '-pHv', $_->{'name'}) } @{$pools};
   my @out;
   push @out, @{oldZfsLines($pools, \%verbose)};
   push @out, @{zfsPoolLines($pools)};
   push @out, @{parseZpoolStatus(runCommand('zpool', 'status', '-P'), $inv->{'resolver'})};
   print join("\n", @out), "\n";
   return 0;
}

exit main() unless caller;
1;