#!/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.

# linux_mdadm
# Linux MD (RAID) arrays: storage.md keys with member resolution, and the old
# diskinfo md keys (replaces all_mdadm). Runs only when /proc/mdstat lists an array.
#
# Revision History:
# 2026-10-18 Claude v1.0.0 new sensor, split from unix_storage (bug 210)

package linux_mdadm;

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';
#######################################################
#
# parseMdstat( $text )
#
# Parses /proc/mdstat into one record per array.
#
# Parameters:
#   $text - /proc/mdstat contents
#
# Returns:
#   array reference of hashes: name, words (after the colon), blocks
#
# Side Effects:
#   none
#
#######################################################
sub parseMdstat {
   my $text = shift;
   my @arrays;
   foreach my $line (split(/\n/, defined($text) ? $text : '')) {
      if ($line =~ m/^(md\d+)\s+:\s+(.*)$/) {
         push @arrays, {'name' => $1, 'words' => [split(/\s+/, $2)]};
      } elsif (@arrays && !defined($arrays[-1]{'blocks'}) && $line =~ /^\s+(\d+)\s+blocks/) {
         $arrays[-1]{'blocks'} = $1;
      }
   }
   return \@arrays;
}

#######################################################
#
# oldMdLines( $arrays )
#
# Old diskinfo md keys, as v3.7.1 all_mdadm: the word after the state
# is the level, the remaining words are the components, the size is
# the array size in KiB (mdadm --detail "Array Size", which equals the
# /proc/mdstat block count).
#
# Parameters:
#   $arrays - array reference from parseMdstat
#
# Returns:
#   array reference of lines
#
# Side Effects:
#   none
#
#######################################################
sub oldMdLines {
   my $arrays = shift;
   my @out;
   foreach my $md (@{$arrays}) {
      my @components = @{$md->{'words'}};
      shift @components;
      push @out, "$OLD_CATEGORY\t$md->{'name'}\tlevel\t" . (@components ? shift(@components) : '');
      push @out, "$OLD_CATEGORY\t$md->{'name'}\tcomponents\t" . join(' ', @components);
      push @out, "$OLD_CATEGORY\t$md->{'name'}\tsize\t" . (defined($md->{'blocks'}) ? $md->{'blocks'} : '');
   }
   return \@out;
}

#######################################################
#
# mdLines( $arrays, $details, $res, $realPaths )
#
# storage.md keys for each array.
#
# Parameters:
#   $arrays  - array reference from parseMdstat
#   $details - hash reference md => { export => mdadm --detail --export text,
#              array_state => text, degraded => text }
#   $res       - resolver
#   $realPaths - optional hash reference path => readlink -f result
#
# Returns:
#   array reference of lines
#
# Side Effects:
#   none
#
#######################################################
sub mdLines {
   my ($arrays, $details, $res, $realPaths) = @_;
   my @out;
   foreach my $md (@{$arrays}) {
      my $name = $md->{'name'};
      my $d = ref($details->{$name}) eq 'HASH' ? $details->{$name} : {};
      my %export;
      foreach my $line (split(/\n/, defined($d->{'export'}) ? $d->{'export'} : '')) {
         $export{$1} = $2 if $line =~ /^(\w+)=(.*)$/;
      }
      my $level = defined($export{'MD_LEVEL'}) ? $export{'MD_LEVEL'} : $md->{'words'}[1];
      push @out, "$CATEGORY\tmd\t$name\tlevel\t$level" if defined($level);
      foreach my $file ('array_state', 'degraded') {
         my $value = defined($d->{$file}) ? trim($d->{$file}) : '';
         push @out, "$CATEGORY\tmd\t$name\t" . ($file eq 'array_state' ? 'state' : 'degraded') . "\t$value" if $value ne '';
      }
      push @out, "$CATEGORY\tmd\t$name\tsize_bytes\t" . ($md->{'blocks'} * 1024) if defined($md->{'blocks'});
      push @out, "$CATEGORY\tmd\t$name\traid_devices\t$export{'MD_DEVICES'}" if defined($export{'MD_DEVICES'});

      my %activeSlots;
      foreach my $key (sort keys %export) {
         next unless $key =~ /^MD_DEVICE_(\w+)_ROLE$/;
         my $tag = $1;
         my $role = $export{$key};
         my $dev = $export{"MD_DEVICE_${tag}_DEV"};
         next unless defined($dev);
         my $member = $dev;
         $member =~ s{^/dev/}{};
         my $prefix = "md\t$name\tmembers\t$member";
         if ($role =~ /^\d+$/) {
            push @out, "$CATEGORY\t$prefix\trole\tactive", "$CATEGORY\t$prefix\tslot\t$role";
            $activeSlots{$role} = 1;
         } elsif ($role eq 'faulty') {
            push @out, "$CATEGORY\t$prefix\trole\tfailed";
         } else {
            push @out, "$CATEGORY\t$prefix\trole\t$role";
         }
         push @out, memberLines($prefix, resolveMember($dev, $res, $realPaths));
      }
      # a slot with no device is a missing member; it has no device to resolve
      if (defined($export{'MD_DEVICES'}) && $export{'MD_DEVICES'} =~ /^\d+$/ && %activeSlots) {
         for (my $slot = 0; $slot < $export{'MD_DEVICES'}; $slot++) {
            next if $activeSlots{$slot};
            push @out, "$CATEGORY\tmd\t$name\tmembers\tmissing_$slot\trole\tmissing",
               "$CATEGORY\tmd\t$name\tmembers\tmissing_$slot\tslot\t$slot",
               "$CATEGORY\tmd\t$name\tmembers\tmissing_$slot\tdisk_unresolved\t1";
         }
      }
   }
   return \@out;
}

#######################################################
#
# main()
#
# Emits storage.md and old diskinfo md keys.
#
# Parameters:
#   none
#
# Returns:
#   integer exit status (1 wrong OS, 2 not applicable)
#
# Side Effects:
#   runs cat, mdadm, readlink and lsblk, writes STDOUT/STDERR
#
#######################################################
sub main {
   if (!checkOS({ 'linux' => undef })) {
      print STDERR "unsupported os\n";
      return 1;
   }
   my $arrays = parseMdstat(fileReadable('/proc/mdstat') ? runCommand('cat', '/proc/mdstat') : '');
   unless (@{$arrays}) {
      print STDERR "no md arrays\n";
      return 2;
   }
   my $inv = localDiskInventory();
   if (defined($inv->{'missing'})) {
      print STDERR "$inv->{'missing'} not found\n";
      return 2;
   }
   my (%details, %realPaths);
   foreach my $md (@{$arrays}) {
      my $name = $md->{'name'};
      $details{$name} = {
         'export' => haveCommand('mdadm') ? runCommand('mdadm', '--detail', '--export', "/dev/$name") : '',
         'array_state' => runCommand('cat', "/sys/block/$name/md/array_state"),
         'degraded' => runCommand('cat', "/sys/block/$name/md/degraded"),
      };
      # mdadm members named by a symlink resolve through readlink -f
      foreach my $line (split(/\n/, $details{$name}{'export'})) {
         next unless $line =~ /^MD_DEVICE_\w+_DEV=(\S+)$/;
         my $real = runCommand('readlink', '-f', $1);
         chomp $real;
         $realPaths{$1} = $real if $real ne '' && $real ne $1;
      }
   }
   my @out;
   push @out, @{oldMdLines($arrays)};
   push @out, @{mdLines($arrays, \%details, $inv->{'resolver'}, \%realPaths)};
   print join("\n", @out), "\n";
   return 0;
}

exit main() unless caller;
1;