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

package library;

use warnings;
use strict;

# modified 20190419 RWR
# changed cleanup to remove encapsulating quotes
#
# 20200220 RWR v1.4.1
# added trim
# 20200224 RWR v1.4.2
# Added tableToHash
# 20250327 RWR v1.4.3
# Created new sub checkOS which is passed a hash with the keys containing the operating systems we need
# modified getOS to return the lower case of $^O. getOS is now deprecated in favor or checkOS, but left for
# backwards compatibility
# modified validCommandOnSystem to be compatible with Win32
# 20261011 Copilot v1.5.0
# Added normaliseUUID, placeholder checks, and runCommand for v3.8.0 framework identity handling
# 20261012 Copilot v1.5.1
# P1 review fixes: restored descriptive comments and license block
# (remaining r275 comments in tableToHash, validCommandOnSystem, checkDate restored by Claude, R1 follow-up)
# 20261012 Copilot v1.6.0
# Added discoverDisks and smartScan for v3.8.0 sensor disk discovery/controller parsing
# (Claude, F2a: transport inferred from subsystems/driver name, is_virtual, logical_volume, Linux rotation_rpm)
# (Claude, F2b: smartDeviceArgs and smartDiskKey, shared by the storage sensors and all_smart)
# (Claude, 2026-10-13: runCommand skips a missing command quietly and sets $? to -1)
# (Claude, 2026-10-18, bug 210: storage section (localDiskInventory, resolvers, collectHealth, health and disk
#  line builders, fileReadable) and identity section (status and selection rules, identityReport) moved here
#  from unix_storage and unix_identity, shared by the split sensors; version unchanged, not yet committed)


# Description: Library used by modules. Do NOT enable

use version;
our $VERSION = version->declare('v1.6.0');

use POSIX qw(strftime);

use Exporter 'import';
our @ISA = qw(Exporter);
our @EXPORT_OK = qw(
   tableToHash
   cleanUp
   trim
   validCommandOnSystem
   checkOS
   getOS
   getSysctlParameter
   checkDate
   normaliseUUID
   isPlaceholderUUID
   isPlaceholderSerial
   runCommand
   discoverDisks
   smartScan
   smartDeviceArgs
   smartDiskKey
   fileReadable
   decodeJson
   emitStorageDisks
   parseHealthJson
   healthLines
   buildLinuxResolver
   buildBsdResolver
   resolveMember
   memberLines
   partitionLines
   haveCommand
   collectHealth
   localDiskInventory
   determineUuidStatus
   determineSerialStatus
   selectEffectiveUuid
   selectEffectiveSerial
   buildIdentityLines
   identityReport
);
our %EXPORT_TAGS = (
   all => [@EXPORT_OK],
   default => [@EXPORT_OK],
);

# set of libraries to be used by these modules

# parameters
# $report - a reference to a report array (one line per row)
# $headerRegex - optional regex to locate the first (header) line.
# $delimiter - optional delimiter used between header columns
# if $headerRegex is not defined, assumes first line is the headers
# if delimiter is not defined, assumes space is the delimitere
#
# Determines the field widths based on the header line
# processes each line in turn, returning an array ref, where each
# row is a hash ref. The hash ref has the key from the header, and
# the value found in the row.

#######################################################
#
# tableToHash( $report, $headerRegex, $delimiter )
#
# Parses fixed-width table output into an array of hash rows
# keyed by header values.
#
# Parameters:
#   $report      - array reference of table lines
#   $headerRegex - optional regex to find header row
#   $delimiter   - reserved/unused compatibility parameter
#
# Returns:
#   array reference of hash references (one per data row)
#
# Side Effects:
#   none
#
#######################################################
sub tableToHash {
   my ($report, $headerRegex, $delimiter) = @_;
   my @return;
   my %headers;

   # get rid of any line returns at the end.
   chomp @{$report};
   my $lineNum = 0;
   # bypass all the header information, if $headerRegex is defined
   if ($headerRegex) {
      for ($lineNum = 0; $lineNum < @{$report} && ${$report}[$lineNum] !~ m/$headerRegex/; $lineNum++) {
      }
   }

   if ($lineNum < @{$report}) { # did we get an actual report? some drives will not give us one
      # first, process the header line and get the start position and the length
      my $char = 0;
      while ($char < length(${$report}[$lineNum])) {
         substr(${$report}[$lineNum], $char) =~ m/^([^ ]+\s*)/;
         my $header = $1;
         my $start = $char;
         my $length = length($header);
         if ($header = trim($header)) {
            $headers{$header}{'start'} = $start;
            # note that if this is the last header, we do NOT want a lenght attribute
            $headers{$header}{'length'} = $length - 1 if $length + $char < length(${$report}[$lineNum]);
         }
         $char += $length;
      }

      # now, get the data from all the following lines
      while (++$lineNum < @{$report}) {
         last unless ${$report}[$lineNum]; # first blank line bails
         my %thisLine;
         foreach my $thisHeader (keys %headers) {
            $thisLine{$thisHeader} = trim(
               defined($headers{$thisHeader}{'length'})
               ? substr(${$report}[$lineNum], $headers{$thisHeader}{'start'}, $headers{$thisHeader}{'length'})
               : # if no length defined, grab everything to the end of the line
                 substr(${$report}[$lineNum], $headers{$thisHeader}{'start'})
            );
         }
         push @return, \%thisLine;
      }
   }

   return \@return;
}

# cleanUp - passed a delimiter and a string, does the following (delimiter can be '')
#           chomps the string (removes trailing newlines)
#           removes all text BEFORE the delimiter, the delimiter, and any whitespace
#           thus, the string 'xxI Am x  a weird string' with a newline will become
#           'a weird string' with no newline
# will also look for single and double quotes surrounding entire string and remove them
# if they exist

#######################################################
#
# cleanUp( $delimiter, $text )
#
# Trims line endings and removes optional prefix content
# before delimiter and any wrapping quotes.
#
# Parameters:
#   $delimiter - optional delimiter that marks value start
#   $text      - source text to clean
#
# Returns:
#   scalar cleaned text value
#
# Side Effects:
#   none
#
#######################################################
## cleanUp
# Trims line endings and removes optional prefix and wrapping quotes.
sub cleanUp {
   my ($delimiter, $text) = @_;
   chomp $text;
   if ($delimiter && $text =~ m/[^$delimiter]*$delimiter\s*(.*)/) {
      $text = $1;
   }
   if ($text =~ m/^'(.*)'$/) {
      $text = $1;
   }
   if ($text =~ m/^"(.*)"$/) {
      $text = $1;
   }
   return $text;
}

# remove leading and trailing spaces from string

#######################################################
#
# trim( $value )
#
# Removes leading and trailing whitespace from one scalar.
#
# Parameters:
#   $value - scalar text
#
# Returns:
#   scalar trimmed text
#
# Side Effects:
#   none
#
#######################################################
## trim
# Removes leading and trailing whitespace.
sub trim {
   my $value = shift;
   $value =~ s/^\s+|\s+$//g if defined $value;
   return $value;
}

# checks if a command is valid on this system. If so, returns the full path to it
# else, returns empty string. Theoretically valid for Unix and Windows systems (tested Win10, Server 2019)

#######################################################
#
# validCommandOnSystem( $commandList )
#
# Verifies required commands exist and replaces each hash
# value with discovered executable path.
#
# Parameters:
#   $commandList - hash reference of command names
#
# Returns:
#   boolean true when all commands are found
#
# Side Effects:
#   mutates values in $commandList to resolved command paths
#
#######################################################
sub validCommandOnSystem {
   my $commandList = shift;
   my $ok = 1;
   foreach my $command (keys %{$commandList}) {
      # Windows uses 'where' while Unix uses which. Tested only on Windows Server
      $commandList->{$command} = lc($^O) eq 'mswin32' ? `where $command 2> nul` : `which $command 2> /dev/null`;
      chomp $commandList->{$command};
      $ok = 0 unless $commandList->{$command};
   }
   return $ok;
   #chomp $command;
   #return -x $command ? $command : '';
}

# when passed a hashref containing the lower case of operating systems
# which can be used as keys, will return true if the operating system
# we are on is there.
#
# exit unless &checkOS( { 'linux' => undef, 'freebsd' => 1, 'mswin32' => undef } );
# the value can be anything, defined only checks for the key. For maximum
# efficiency, use undef as it uses a lot less space than any value

#######################################################
#
# checkOS( $valid )
#
# Checks current operating system against supported key list.
#
# Parameters:
#   $valid - hash reference of allowed OS names
#
# Returns:
#   boolean true when current OS is present
#
# Side Effects:
#   none
#
#######################################################
## checkOS
# Returns true if current OS is present as a key in the provided hash.
sub checkOS {
   my $valid = shift;
   return exists $valid->{lc $^O};
}

#######################################################
#
# getOS()
#
# Returns lower-case Perl operating system name.
#
# Parameters:
#   none
#
# Returns:
#   scalar OS name
#
# Side Effects:
#   none
#
#######################################################
## getOS
# Returns lower-case Perl OS name.
sub getOS {
   return lc $^O;
}

#######################################################
#
# getSysctlParameter( $sysctl, $parameter )
#
# Executes sysctl query command and strips key prefix from
# result value.
#
# Parameters:
#   $sysctl    - sysctl executable path/command
#   $parameter - parameter name to query
#
# Returns:
#   scalar parameter value text
#
# Side Effects:
#   executes external command
#
#######################################################
## getSysctlParameter
# Reads and cleans a single sysctl parameter value.
sub getSysctlParameter {
   my ($sysctl, $parameter) = @_;
   my $result = qx($sysctl $parameter);
   chomp $result;
   $result =~ s/$parameter:\s*//;
   return $result;
}

# simple function to return true if the current date is the first of the week, month or year
# parameter passed in is 'w' (weekly), 'm' (monthly) or 'y' (yearly)
# to have a test run only weekly, place
# exit 1 unless &checkDate( 'w' );

#######################################################
#
# checkDate( $frequency )
#
# Determines whether a periodic sensor is due to run by
# checking first-run override and calendar boundaries.
#
# Parameters:
#   $frequency - w, m, or y for weekly/monthly/yearly
#
# Returns:
#   boolean true when run should proceed
#
# Side Effects:
#   reads /tmp/sysinfo.firstrun marker state
#
#######################################################
sub checkDate {
   return 1 if -e '/tmp/sysinfo.firstrun';
   my $frequency = lc shift;
   my (undef, undef, undef, $mday, undef, undef, $wday, $yday, undef) = localtime(time);
   return $mday == 1 if $frequency eq 'm'; # monthly
   return $wday == 1 if $frequency eq 'w'; # weekly
   return $yday == 1 if $frequency eq 'y'; # yearly
   return 0; # we failed
}

#######################################################
#
# normaliseUUID( $value )
#
# Normalizes UUID text by stripping non-hex characters and
# validating canonical 32-hex form.
#
# Parameters:
#   $value - UUID text input
#
# Returns:
#   scalar 32-hex lowercase UUID, or empty string
#
# Side Effects:
#   none
#
#######################################################
## normaliseUUID
# Normalises UUID text to 32 lower-case hex characters, or returns empty string.
sub normaliseUUID {
   my $value = shift;
   return '' unless defined $value;
   $value =~ s/[^0-9A-Fa-f]//g;
   $value = lc $value;
   return '' unless $value =~ /^[0-9a-f]{32}$/;
   return $value;
}

#######################################################
#
# isPlaceholderUUID( $value )
#
# Determines if a UUID is missing, malformed, or known
# placeholder content.
#
# Parameters:
#   $value - UUID text input
#
# Returns:
#   boolean true when value is placeholder
#
# Side Effects:
#   none
#
#######################################################
## isPlaceholderUUID
# Returns true when a UUID value is missing, invalid, or known placeholder content.
sub isPlaceholderUUID {
   my $value = shift;
   return 1 unless defined $value;
   my $trimmed = trim($value);
   return 1 if $trimmed eq '';
   return 1 if lc($trimmed) eq 'not settable' || lc($trimmed) eq 'not present';

   my $normal = normaliseUUID($trimmed);
   return 1 unless $normal;
   return 1 if $normal =~ /^0{32}$/;
   return 1 if $normal =~ /^f{32}$/;
   return 1 if $normal eq '03000200040005000006000700080009';
   return 1 if $normal eq '00020003000400050006000700080009';
   return 0;
}

#######################################################
#
# isPlaceholderSerial( $value )
#
# Determines if serial value matches known placeholder or
# empty patterns.
#
# Parameters:
#   $value - serial text input
#
# Returns:
#   boolean true when serial is placeholder
#
# Side Effects:
#   none
#
#######################################################
## isPlaceholderSerial
# Returns true when serial text matches known placeholder values.
sub isPlaceholderSerial {
   my $value = shift;
   return 1 unless defined $value;
   my $trimmed = trim($value);
   return 1 if $trimmed eq '';

   my $pattern = qr/^(1234567890|0123456789|0+|NotSpecified|Not Specified|Not Settable|None|N\/A|Default string|To Be Filled By O\.E\.M\.|System Serial Number|Chassis Serial Number|0123456789ABCDEF|Unknown|\.+)$/i;
   return $trimmed =~ $pattern ? 1 : 0;
}

#######################################################
#
# runCommand( @command )
#
# Executes a command using list-form process invocation and
# captures stdout output. A command that is not installed is
# skipped quietly (no "Can't exec" warning on STDERR), since
# sensors probe for optional tools such as xl, virsh or ipmitool.
#
# Parameters:
#   @command - command and argv parts
#
# Returns:
#   scalar stdout text, or empty string on failure
#
# Side Effects:
#   spawns subprocess; sets $? to -1 when the command is not
#   found, otherwise close() leaves the child's status in $?
#
#######################################################
sub runCommand {
   my @command = @_;
   return '' unless @command;

   # look the command up first: a missing executable would make
   # open() print a warning that ends up as the sensor's message
   my $name = $command[0];
   my $found = 0;
   if ($name =~ m{/}) {
      $found = -f $name && -x _;
   } else {
      foreach my $dir (split(/:/, defined($ENV{'PATH'}) ? $ENV{'PATH'} : '')) {
         next if $dir eq '';
         if (-f "$dir/$name" && -x _) {
            $found = 1;
            last;
         }
      }
   }
   unless ($found) {
      $? = -1;
      return '';
   }

   my $pid = open(my $childOut, '-|', @command);
   return '' unless defined $pid;
   my $output = do { local $/; <$childOut> };
   close($childOut);
   return defined $output ? $output : '';
}

#######################################################
#
# discoverDisks( $args )
#
# Normalizes per-platform disk inventory data into one
# shared structure for storage and smart sensors.
#
# Parameters:
#   $args - hash reference with keys:
#           os         => optional explicit OS name
#           lsblkJson  => optional JSON text from lsblk -J
#           kernDisks  => optional text from sysctl kern.disks
#           geomDisks  => optional text from geom disk list
#
# Returns:
#   hash reference keyed by short disk id (sda, da0, ...)
#
# Side Effects:
#   none
#
#######################################################
sub discoverDisks {
   my $args = shift;
   $args = {} unless ref($args) eq 'HASH';

   my $os = exists($args->{'os'}) ? lc($args->{'os'}) : getOS();
   my %disks;

   if ($os eq 'linux') {
      my $jsonText = $args->{'lsblkJson'};
      if (!defined($jsonText) || $jsonText eq '') {
         $jsonText = runCommand('lsblk', '-J', '-b', '-O');
         if (!defined($jsonText) || $jsonText eq '') {
            $jsonText = runCommand('lsblk', '-J', '-b', '-o', 'NAME,KNAME,TYPE,SIZE,MODEL,SERIAL,WWN,VENDOR,REV,TRAN,ROTA,LOG-SEC,PHY-SEC,PKNAME');
         }
      }

      if (defined($jsonText) && $jsonText =~ /\S/) {
         eval {
            require JSON::PP;
            my $parsed = JSON::PP::decode_json($jsonText);
            my $block = $parsed->{'blockdevices'};
            if (ref($block) eq 'ARRAY') {
               foreach my $entry (@{$block}) {
                  next unless ref($entry) eq 'HASH';
                  next unless defined($entry->{'type'}) && $entry->{'type'} eq 'disk';
                  my $name = defined($entry->{'kname'}) && $entry->{'kname'} ne '' ? $entry->{'kname'} : $entry->{'name'};
                  next unless defined($name) && $name ne '';

                  my $skip = 0;
                  $skip = 1 if $name =~ /^(loop|zram|nbd|rbd|sr|cd|ses|dm-|md)/;
                  $skip = 1 if defined($entry->{'tran'}) && lc($entry->{'tran'}) eq 'iscsi';
                  my $vendor = defined($entry->{'vendor'}) ? trim($entry->{'vendor'}) : '';
                  my $model = defined($entry->{'model'}) ? trim($entry->{'model'}) : '';
                  $skip = 1 if uc($vendor) eq 'CTL' || uc($model) eq 'CTLDISK';
                  next if $skip;

                  $disks{$name} = {
                     'device' => '/dev/' . $name,
                     'name' => $name,
                     'serial' => defined($entry->{'serial'}) ? trim($entry->{'serial'}) : undef,
                     'wwn' => defined($entry->{'wwn'}) ? trim($entry->{'wwn'}) : undef,
                     'vendor' => $vendor ne '' ? $vendor : undef,
                     'model' => $model ne '' ? $model : undef,
                     'transport' => _diskTransport($name, $entry->{'tran'}, $entry->{'subsystems'}),
                     'size_bytes' => defined($entry->{'size'}) && $entry->{'size'} =~ /^\d+$/ ? 0 + $entry->{'size'} : undef,
                     'logical_sector_bytes' => defined($entry->{'log-sec'}) && $entry->{'log-sec'} =~ /^\d+$/ ? 0 + $entry->{'log-sec'} : undef,
                     'physical_sector_bytes' => defined($entry->{'phy-sec'}) && $entry->{'phy-sec'} =~ /^\d+$/ ? 0 + $entry->{'phy-sec'} : undef,
                     'rota' => defined($entry->{'rota'}) ? $entry->{'rota'} : undef,
                  };
                  # a non-rotating disk is 0 rpm; a rotating one has an unknown speed, so no key
                  $disks{$name}{'rotation_rpm'} = 0 if defined($entry->{'rota'}) && $entry->{'rota'} =~ /^(0|false)$/;
                  _diskFlags($disks{$name});
               }
            }
         };
      }
   } elsif ($os eq 'freebsd') {
      my $kernDisks = $args->{'kernDisks'};
      my $geomDisks = $args->{'geomDisks'};
      $kernDisks = runCommand('sysctl', '-n', 'kern.disks') if !defined($kernDisks) || $kernDisks eq '';
      $geomDisks = runCommand('geom', 'disk', 'list') if !defined($geomDisks) || $geomDisks eq '';

      my %allowed;
      if (defined($kernDisks)) {
         foreach my $disk (split(/\s+/, $kernDisks)) {
            next unless $disk =~ /^[a-zA-Z][a-zA-Z0-9]+$/;
            next if $disk =~ /^(cd|ses)/;
            $allowed{$disk} = 1;
         }
      }

      my %geomByName;
      if (defined($geomDisks)) {
         my @lines = split(/\n/, $geomDisks);
         my $current;
         foreach my $line (@lines) {
            if ($line =~ /^Geom name:\s*(\S+)/) {
               $current = $1;
               $geomByName{$current} = {};
               next;
            }
            next unless defined($current);
            if ($line =~ /^\s*Mediasize:\s*([0-9]+)/) {
               $geomByName{$current}{'size_bytes'} = 0 + $1;
            } elsif ($line =~ /^\s*Sectorsize:\s*([0-9]+)/) {
               $geomByName{$current}{'logical_sector_bytes'} = 0 + $1;
            } elsif ($line =~ /^\s*Stripesize:\s*([0-9]+)/) {
               $geomByName{$current}{'physical_sector_bytes'} = 0 + $1;
            } elsif ($line =~ /^\s*descr:\s*(.*)$/) {
               my $v = trim($1);
               $geomByName{$current}{'model'} = $v if $v ne '';
            } elsif ($line =~ /^\s*ident:\s*(.*)$/) {
               my $v = trim($1);
               $geomByName{$current}{'serial'} = $v if $v ne '';
            } elsif ($line =~ /^\s*lunid:\s*(.*)$/) {
               my $v = trim($1);
               $geomByName{$current}{'wwn'} = $v if $v ne '';
            } elsif ($line =~ /^\s*rotationrate:\s*([0-9]+)/) {
               $geomByName{$current}{'rotation_rpm'} = 0 + $1;
            }
         }
      }

      foreach my $name (sort keys %allowed) {
         my $meta = exists($geomByName{$name}) ? $geomByName{$name} : {};
         next if defined($meta->{'model'}) && $meta->{'model'} =~ /CTLDISK/; # iSCSI/CTL LUN
         $disks{$name} = {
            'device' => '/dev/' . $name,
            'name' => $name,
            'serial' => $meta->{'serial'},
            'wwn' => $meta->{'wwn'},
            'model' => $meta->{'model'},
            'transport' => _diskTransport($name, undef, undef),
            'size_bytes' => $meta->{'size_bytes'},
            'logical_sector_bytes' => $meta->{'logical_sector_bytes'},
            'physical_sector_bytes' => $meta->{'physical_sector_bytes'},
            'rotation_rpm' => $meta->{'rotation_rpm'},
         };
         _diskFlags($disks{$name});
      }
   }

   return \%disks;
}

#######################################################
#
# _diskTransport( $name, $tran, $subsystems )
#
# Internal helper. Returns the transport word for a disk: the lsblk
# tran value when present, else inferred from the lsblk subsystems
# (Linux) or from the kernel driver name (FreeBSD da, ada, nda ...).
#
# Parameters:
#   $name       - kernel disk name (sda, da0, nvme0n1)
#   $tran       - lsblk tran value or undef
#   $subsystems - lsblk subsystems value (block:virtio:pci) or undef
#
# Returns:
#   one of sata, sas, nvme, usb, virtio, xen, scsi, unknown (or other lsblk tran)
#
# Side Effects:
#   none
#
#######################################################
sub _diskTransport {
   my ($name, $tran, $subsystems) = @_;
   return lc(trim($tran)) if defined($tran) && trim($tran) ne '';
   $subsystems = defined($subsystems) ? lc($subsystems) : '';
   return 'virtio' if $subsystems =~ /virtio/ || $name =~ /^(vd[a-z]|vtbd\d)/;
   return 'xen' if $subsystems =~ /xen/ || $name =~ /^(xvd[a-z]|xbd\d)/;
   return 'nvme' if $name =~ /^(nvme|nvd\d|nda\d)/ || $subsystems =~ /nvme/;
   return 'usb' if $subsystems =~ /usb/;
   return 'sata' if $name =~ /^ada\d/;
   return 'scsi' if $name =~ /^da\d/ || $subsystems =~ /scsi/;
   return 'unknown';
}

#######################################################
#
# _diskFlags( $disk )
#
# Internal helper. Sets is_virtual and logical_volume (0/1) on a disk
# record from its transport, vendor and model (Spec 1.4).
#
# Parameters:
#   $disk - disk hash reference built by discoverDisks
#
# Returns:
#   none
#
# Side Effects:
#   mutates $disk
#
#######################################################
sub _diskFlags {
   my $disk = shift;
   my $vendor = defined($disk->{'vendor'}) ? $disk->{'vendor'} : '';
   my $model = defined($disk->{'model'}) ? $disk->{'model'} : '';
   my $id = "$vendor $model";
   $disk->{'is_virtual'} = ($disk->{'transport'} =~ /^(virtio|xen)$/
      || $id =~ /QEMU|VBOX|VMware|Hyper-V|Virtual (?:HD|disk)/i) ? 1 : 0;
   $disk->{'logical_volume'} = ($vendor =~ /DELL|LSI|AVAGO|BROADCOM|^HP/i
      && $model =~ /PERC|\bMR|MegaRAID|LOGICAL VOLUME/i) ? 1 : 0;
}

#######################################################
#
# smartScan( $scanText )
#
# Parses smartctl --scan or smartctl -j --scan output into
# per-device scan definitions with controller key mapping.
#
# Parameters:
#   $scanText - smartctl scan output text
#
# Returns:
#   hash reference keyed by discovered device key
#
# Side Effects:
#   none
#
#######################################################
sub smartScan {
   my $scanText = shift;
   my %found;
   return \%found unless defined($scanText) && $scanText =~ /\S/;

   my $parsedJson;
   if ($scanText =~ /^\s*\{/s || $scanText =~ /^\s*\[/s) {
      eval {
         require JSON::PP;
         $parsedJson = JSON::PP::decode_json($scanText);
      };
   }

   if (ref($parsedJson) eq 'HASH' && ref($parsedJson->{'devices'}) eq 'ARRAY') {
      foreach my $entry (@{$parsedJson->{'devices'}}) {
         next unless ref($entry) eq 'HASH';
         my $name = $entry->{'name'};
         next unless defined($name) && $name ne '';
         my $devType = defined($entry->{'type'}) ? $entry->{'type'} : '';
         my $scanLine = $name . ($devType ne '' ? " -d $devType" : '');
         _addSmartScanEntry(\%found, $scanLine);
      }
      return \%found;
   }

   foreach my $line (split(/\n/, $scanText)) {
      next unless $line =~ /\S/;
      _addSmartScanEntry(\%found, $line);
   }
   return \%found;
}

#######################################################
#
# _addSmartScanEntry( $found, $line )
#
# Internal helper that parses one smartctl --scan line and
# stores normalized controller metadata.
#
# Parameters:
#   $found - hash reference of parsed scan entries
#   $line  - one scan line
#
# Returns:
#   none
#
# Side Effects:
#   mutates $found
#
#######################################################
sub _addSmartScanEntry {
   my ($found, $line) = @_;
   return unless ref($found) eq 'HASH';

   my $work = $line;
   $work =~ s/#.*$//;
   $work = trim($work);
   return unless $work =~ /\S/;

   my ($device) = ($work =~ m{^(\/dev\/\S+)});
   return unless defined($device);

   my $type = '';
   if ($work =~ /\s+-d\s+([^\s]+)/) {
      $type = $1;
   }

   my $base = $device;
   $base =~ s{^/dev/}{};
   my $key = $base;
   my $behind;

   if ($type =~ /^(sat\+megaraid|megaraid|cciss|3ware|areca),(\d+)/) {
      my $ctrl = $1;
      my $slot = $2;
      $behind = $ctrl;
      my $safe = $ctrl;
      $safe =~ s/\+/_/g;
      $safe =~ s/[^a-zA-Z0-9_]+/_/g;
      $key = $base . '_' . $safe . '_' . $slot;
   }

   $found->{$key} = {
      'device' => $device,
      'type' => $type,
      'key' => $key,
      'base' => $base,
      'behind_controller' => $behind,
   };
}

#######################################################
#
# smartDeviceArgs( $type )
#
# Returns the smartctl -d arguments for a device type taken from
# smartctl --scan. As v3.7.1 all_smart, a type containing 'scsi' is
# dropped so smartctl auto-detects: a SATA disk behind a SAS HBA is
# scanned as '-d scsi' but only reports ATA data (model family, the
# attribute table, device statistics) without it.
#
# Parameters:
#   $type - scan type ('scsi', 'sat', 'megaraid,4', '-d scsi ', ...)
#
# Returns:
#   list of arguments, empty when smartctl should auto-detect
#
# Side Effects:
#   none
#
#######################################################
sub smartDeviceArgs {
   my $type = shift;
   $type = '' unless defined $type;
   $type =~ s/^\s*-d\s+//;
   $type = trim($type);
   return () if $type eq '' || $type =~ m/scsi/;
   return ('-d', $type);
}

#######################################################
#
# smartDiskKey( $scanEntry, $disks, $serial )
#
# Returns the storage.disks key for one smartctl scan entry (Spec 1.4),
# so the storage sensors and all_smart agree. A disk behind a RAID controller
# keeps its controller key (sda_megaraid_4). Otherwise the scan name is
# used when discoverDisks knows it; else a discovered disk with the same
# serial number (an NVMe controller /dev/nvme0 is disk nda0 or nvme0n1);
# else the scan name.
#
# Parameters:
#   $scanEntry - one value from smartScan
#   $disks     - hash reference from discoverDisks
#   $serial    - optional serial number reported by smartctl
#
# Returns:
#   scalar disk key
#
# Side Effects:
#   none
#
#######################################################
sub smartDiskKey {
   my ($scanEntry, $disks, $serial) = @_;
   $disks = {} unless ref($disks) eq 'HASH';
   return $scanEntry->{'key'} if defined($scanEntry->{'behind_controller'});
   return $scanEntry->{'base'} if exists($disks->{$scanEntry->{'base'}});
   if (defined($serial) && trim($serial) ne '') {
      foreach my $dev (sort keys %{$disks}) {
         return $dev if defined($disks->{$dev}{'serial'}) && $disks->{$dev}{'serial'} eq trim($serial);
      }
   }
   return $scanEntry->{'base'};
}

#######################################################################
#
# Storage section (bug 210): code shared by linux_storage,
# freebsd_storage, linux_mdadm, linux_lvm, all_zfs and all_smart.
# Moved from unix_storage; see localDiskInventory.
#
#######################################################################

my $CATEGORY = 'storage';

#######################################################
#
# fileReadable( $path )
#
# True when a file is readable. A separate function so the offline
# test harness can stub it (-r cannot be stubbed).
#
# Parameters:
#   $path - file name
#
# Returns:
#   boolean
#
# Side Effects:
#   none
#
#######################################################
sub fileReadable {
   my $path = shift;
   return -r $path ? 1 : 0;
}

#######################################################
#
# decodeJson( $text )
#
# Decodes JSON text, returning undef instead of dying.
#
# Parameters:
#   $text - JSON text
#
# Returns:
#   decoded reference or undef
#
# Side Effects:
#   none
#
#######################################################
sub decodeJson {
   my $text = shift;
   return undef unless defined($text) && $text =~ /^\s*[\{\[]/;
   my $decoded;
   eval {
      require JSON::PP;
      $decoded = JSON::PP::decode_json($text);
   };
   return $decoded;
}

#######################################################
#
# emitStorageDisks( $disks, $slots )
#
# Emits storage.disks.* lines from discoverDisks metadata.
#
# Parameters:
#   $disks - hash reference from library::discoverDisks
#   $slots - optional hash reference dev => enclosure slot
#
# Returns:
#   array reference of storage lines
#
# Side Effects:
#   none
#
#######################################################
sub emitStorageDisks {
   my ($disks, $slots) = @_;
   $slots = {} unless ref($slots) eq 'HASH';
   my @out;

   foreach my $dev (sort keys %{$disks}) {
      my $d = $disks->{$dev};
      next unless ref($d) eq 'HASH';
      foreach my $key ('device', 'serial', 'wwn', 'vendor', 'model', 'transport', 'size_bytes',
         'logical_sector_bytes', 'physical_sector_bytes', 'rotation_rpm', 'is_virtual', 'logical_volume',
         'behind_controller') {
         push @out, "$CATEGORY\tdisks\t$dev\t$key\t$d->{$key}" if defined($d->{$key}) && $d->{$key} ne '';
      }
      push @out, "$CATEGORY\tdisks\t$dev\tslot\t$slots->{$dev}" if defined($slots->{$dev});
   }

   return \@out;
}

#######################################################
#
# parseHealthJson( $json )
#
# Extracts the daily health keys from decoded smartctl -j -H -A output.
#
# Parameters:
#   $json - decoded JSON hash reference
#
# Returns:
#   hash reference of health keys (source = json)
#
# Side Effects:
#   none
#
#######################################################
sub parseHealthJson {
   my $json = shift;
   my %health = ('source' => 'json');
   return \%health unless ref($json) eq 'HASH';

   if (ref($json->{'smart_status'}) eq 'HASH' && defined($json->{'smart_status'}{'passed'})) {
      $health{'passed'} = $json->{'smart_status'}{'passed'} ? 1 : 0;
   }
   my %ataNames = (5 => 'reallocated_sectors', 197 => 'pending_sectors', 198 => 'offline_uncorrectable');
   if (ref($json->{'ata_smart_attributes'}) eq 'HASH' && ref($json->{'ata_smart_attributes'}{'table'}) eq 'ARRAY') {
      foreach my $attr (@{$json->{'ata_smart_attributes'}{'table'}}) {
         next unless ref($attr) eq 'HASH' && defined($attr->{'id'}) && exists($ataNames{$attr->{'id'}});
         next unless ref($attr->{'raw'}) eq 'HASH' && defined($attr->{'raw'}{'value'});
         $health{$ataNames{$attr->{'id'}}} = $attr->{'raw'}{'value'};
      }
   }
   my $nvme = $json->{'nvme_smart_health_information_log'};
   if (ref($nvme) eq 'HASH') {
      $health{'media_errors'} = $nvme->{'media_errors'} if defined($nvme->{'media_errors'});
      $health{'critical_warning'} = $nvme->{'critical_warning'} if defined($nvme->{'critical_warning'});
   }
   $health{'grown_defects'} = $json->{'scsi_grown_defect_list'} if defined($json->{'scsi_grown_defect_list'});
   return \%health;
}

#######################################################
#
# healthLines( $dev, $health )
#
# Converts a health hash to storage.disks.<dev>.health lines.
#
# Parameters:
#   $dev    - disk key
#   $health - hash reference from parseHealthJson, or undef (source none)
#
# Returns:
#   array reference of lines
#
# Side Effects:
#   none
#
#######################################################
sub healthLines {
   my ($dev, $health) = @_;
   $health = {'source' => 'none'} unless ref($health) eq 'HASH';
   my @out;
   foreach my $key (sort keys %{$health}) {
      push @out, "$CATEGORY\tdisks\t$dev\thealth\t$key\t$health->{$key}";
   }
   return \@out;
}

#######################################################
#
# buildLinuxResolver( $lsblkJson )
#
# Builds the member-resolution tables from lsblk -J -b -O: disks,
# partitions (with their disk and size) and md devices.
#
# Parameters:
#   $lsblkJson - lsblk JSON text
#
# Returns:
#   hash reference with keys disks, parts, partSize, md, labels
#
# Side Effects:
#   none
#
#######################################################
sub buildLinuxResolver {
   my $lsblkJson = shift;
   my %res = ('disks' => {}, 'parts' => {}, 'partSize' => {}, 'md' => {}, 'labels' => {});
   my $parsed = decodeJson($lsblkJson);
   return \%res unless ref($parsed) eq 'HASH' && ref($parsed->{'blockdevices'}) eq 'ARRAY';

   my $walk;
   $walk = sub {
      my ($node, $parentDisk) = @_;
      return unless ref($node) eq 'HASH';
      my $name = defined($node->{'kname'}) && $node->{'kname'} ne '' ? $node->{'kname'} : $node->{'name'};
      my $type = defined($node->{'type'}) ? $node->{'type'} : '';
      my $disk = $parentDisk;
      if ($type eq 'disk') {
         $res{'disks'}{$name} = 1;
         $disk = $name;
      } elsif ($type eq 'part' && defined($parentDisk)) {
         $res{'parts'}{$name} = $parentDisk;
         $res{'partSize'}{$name} = $node->{'size'} if defined($node->{'size'}) && $node->{'size'} =~ /^\d+$/;
      } elsif ($type =~ /^raid|^linear/ && $name =~ /^md/) {
         $res{'md'}{$name} = 1;
      }
      # device-mapper names (/dev/mapper/<name>) resolve to their kernel name
      $res{'labels'}{"mapper/$node->{'name'}"} = $name if $name =~ /^dm-/ && defined($node->{'name'});
      if (ref($node->{'children'}) eq 'ARRAY') {
         $walk->($_, $disk) foreach @{$node->{'children'}};
      }
   };
   $walk->($_, undef) foreach @{$parsed->{'blockdevices'}};
   return \%res;
}

#######################################################
#
# buildBsdResolver( $kernDisks, $geomPartList, $glabelStatus )
#
# Builds the member-resolution tables on FreeBSD: disks from
# kern.disks, partitions (disk and size) from geom part list, and
# labels (gpt/..., gptid/..., diskid/...) from glabel status.
#
# Parameters:
#   $kernDisks    - sysctl -n kern.disks text
#   $geomPartList - geom part list text
#   $glabelStatus - glabel status text
#
# Returns:
#   hash reference with keys disks, parts, partSize, md, labels
#
# Side Effects:
#   none
#
#######################################################
sub buildBsdResolver {
   my ($kernDisks, $geomPartList, $glabelStatus) = @_;
   my %res = ('disks' => {}, 'parts' => {}, 'partSize' => {}, 'md' => {}, 'labels' => {});

   foreach my $disk (split(/\s+/, defined($kernDisks) ? $kernDisks : '')) {
      $res{'disks'}{$disk} = 1 if $disk ne '';
   }

   my ($geom, $part);
   foreach my $line (split(/\n/, defined($geomPartList) ? $geomPartList : '')) {
      if ($line =~ /^Geom name:\s*(\S+)/) {
         $geom = $1;
         $part = undef;
      } elsif ($line =~ /^\d+\.\s+Name:\s*(\S+)/) {
         $part = $1;
         $res{'parts'}{$part} = $geom if defined($geom);
      } elsif ($line =~ /^Consumers:/) {
         $part = undef;
      } elsif (defined($part) && $line =~ /^\s+Mediasize:\s*(\d+)/) {
         $res{'partSize'}{$part} = $1;
      }
   }

   foreach my $line (split(/\n/, defined($glabelStatus) ? $glabelStatus : '')) {
      my @f = split(' ', $line);
      next unless @f >= 3 && $f[0] ne 'Name';
      $res{'labels'}{$f[0]} = $f[2];
   }
   return \%res;
}

#######################################################
#
# resolveMember( $name, $res, $realPaths )
#
# Resolves an md/zpool/PV member name to its disk (and partition or md).
#
# Parameters:
#   $name      - member name or path (/dev/da0p2, sdc1, gpt/zfs1)
#   $res       - resolver from buildLinuxResolver / buildBsdResolver
#   $realPaths - optional hash reference path => readlink -f result
#
# Returns:
#   hash reference with disk, partition, md, or disk_unresolved => 1
#
# Side Effects:
#   none
#
#######################################################
sub resolveMember {
   my ($name, $res, $realPaths) = @_;
   $realPaths = {} unless ref($realPaths) eq 'HASH';
   my $n = $name;
   $n = $realPaths->{$n} if defined($realPaths->{$n});
   $n =~ s{^/dev/}{};
   # follow labels (glabel, /dev/mapper) at most a few levels
   for (my $i = 0; $i < 4 && defined($res->{'labels'}{$n}); $i++) {
      $n = $res->{'labels'}{$n};
   }
   return {'disk' => $n} if $res->{'disks'}{$n};
   return {'disk' => $res->{'parts'}{$n}, 'partition' => $n} if defined($res->{'parts'}{$n});
   return {'md' => $n} if $res->{'md'}{$n} || $n =~ /^md\d+$/;
   return {'disk_unresolved' => 1};
}

#######################################################
#
# memberLines( $prefix, $resolved )
#
# Converts a resolveMember result to lines under a key prefix.
#
# Parameters:
#   $prefix   - tab-joined key path (without the category)
#   $resolved - hash reference from resolveMember
#
# Returns:
#   array of lines
#
# Side Effects:
#   none
#
#######################################################
sub memberLines {
   my ($prefix, $resolved) = @_;
   my @out;
   foreach my $key ('disk', 'partition', 'md', 'disk_unresolved') {
      push @out, "$CATEGORY\t$prefix\t$key\t$resolved->{$key}" if defined($resolved->{$key});
   }
   return @out;
}

#######################################################
#
# partitionLines( $res )
#
# Emits storage.partitions.<part>.disk|size_bytes.
#
# Parameters:
#   $res - resolver
#
# Returns:
#   array reference of lines
#
# Side Effects:
#   none
#
#######################################################
sub partitionLines {
   my $res = shift;
   my @out;
   foreach my $part (sort keys %{$res->{'parts'}}) {
      push @out, "$CATEGORY\tpartitions\t$part\tdisk\t$res->{'parts'}{$part}";
      push @out, "$CATEGORY\tpartitions\t$part\tsize_bytes\t$res->{'partSize'}{$part}" if defined($res->{'partSize'}{$part});
   }
   return \@out;
}

#######################################################
#
# haveCommand( $name )
#
# True when a command is on the PATH.
#
# Parameters:
#   $name - command name
#
# Returns:
#   boolean
#
# Side Effects:
#   runs which
#
#######################################################
sub haveCommand {
   my $name = shift;
   return validCommandOnSystem({$name => undef});
}

#######################################################
#
# collectHealth( $disks )
#
# Runs smartctl -j -i -H -A for each scanned device and returns health
# keyed by storage.disks key; adds controller disks to $disks. -i is
# added to the Spec command only to get the serial number, which maps
# an NVMe controller (/dev/nvme0) to its disk (nda0, nvme0n1).
#
# Parameters:
#   $disks - hash reference from discoverDisks (mutated)
#
# Returns:
#   hash reference dev => health hash
#
# Side Effects:
#   runs smartctl; adds controller entries to $disks
#
#######################################################
sub collectHealth {
   my $disks = shift;
   my %health;
   return \%health unless haveCommand('smartctl');
   my $scan = smartScan(runCommand('smartctl', '--scan'));
   foreach my $scanKey (sort keys %{$scan}) {
      my $entry = $scan->{$scanKey};
      next if $entry->{'base'} =~ /^(ses|cd|sr|pass)\d/;
      my $json = decodeJson(runCommand('smartctl', '-j', '-i', '-H', '-A', $entry->{'device'}, smartDeviceArgs($entry->{'type'})));
      next unless ref($json) eq 'HASH' && defined($json->{'json_format_version'});
      my $dev = smartDiskKey($entry, $disks, $json->{'serial_number'});
      if (defined($entry->{'behind_controller'}) && !exists($disks->{$dev})) {
         $disks->{$dev} = {'device' => $entry->{'device'}, 'behind_controller' => $entry->{'behind_controller'}};
         $disks->{$dev}{'serial'} = $json->{'serial_number'} if defined($json->{'serial_number'});
         $disks->{$dev}{'model'} = $json->{'model_name'} if defined($json->{'model_name'});
      }
      $health{$dev} = parseHealthJson($json);
   }
   return \%health;
}

#######################################################
#
# localDiskInventory()
#
# Runs lsblk (Linux) or sysctl and geom (FreeBSD) and returns the
# local disk inventory used by every storage sensor.
#
# Parameters:
#   none
#
# Returns:
#   hash reference with keys:
#     os       - lower case OS name
#     disks    - hash reference from discoverDisks
#     resolver - member resolver (buildLinuxResolver / buildBsdResolver)
#     raw      - hash reference of the command texts (lsblkJson, or
#                kernDisks and geomDisks)
#     missing  - name of a required tool that is not installed, else undef
#                (disks and resolver are then empty)
#
# Side Effects:
#   runs lsblk, or sysctl, geom and glabel
#
#######################################################
sub localDiskInventory {
   my $os = getOS();
   my %inv = (
      'os' => $os, 'disks' => {}, 'raw' => {}, 'missing' => undef,
      'resolver' => {'disks' => {}, 'parts' => {}, 'partSize' => {}, 'md' => {}, 'labels' => {}},
   );
   foreach my $tool ($os eq 'linux' ? ('lsblk') : ('geom', 'sysctl')) {
      unless (validCommandOnSystem({ $tool => undef })) {
         $inv{'missing'} = $tool;
         return \%inv;
      }
   }
   if ($os eq 'linux') {
      my $lsblk = runCommand('lsblk', '-J', '-b', '-O');
      $inv{'raw'} = {'lsblkJson' => $lsblk};
      $inv{'disks'} = discoverDisks({'os' => 'linux', 'lsblkJson' => $lsblk});
      $inv{'resolver'} = buildLinuxResolver($lsblk);
   } elsif ($os eq 'freebsd') {
      my $kernDisks = runCommand('sysctl', '-n', 'kern.disks');
      my $geomDisks = runCommand('geom', 'disk', 'list');
      $inv{'raw'} = {'kernDisks' => $kernDisks, 'geomDisks' => $geomDisks};
      $inv{'disks'} = discoverDisks({'os' => 'freebsd', 'kernDisks' => $kernDisks, 'geomDisks' => $geomDisks});
      $inv{'resolver'} = buildBsdResolver($kernDisks, runCommand('geom', 'part', 'list'),
         haveCommand('glabel') ? runCommand('glabel', 'status') : '');
   }
   return \%inv;
}


#######################################################################
#
# Identity section (bug 210): the UUID/serial rules shared by
# linux_identity and freebsd_identity. Moved from unix_identity.
#
#######################################################################

#######################################################
#
# determineUuidStatus( $raw )
#
# Returns UUID status per spec rule P.
#
# Parameters:
#   $raw - raw UUID text
#
# Returns:
#   scalar status string
#
# Side Effects:
#   none
#
#######################################################
sub determineUuidStatus {
   my $raw = shift;
   return 'missing' if !defined($raw) || trim($raw) eq '';
   return isPlaceholderUUID($raw) ? 'placeholder' : 'ok';
}

#######################################################
#
# determineSerialStatus( $raw )
#
# Returns serial placeholder status per spec rule P.
#
# Parameters:
#   $raw - raw serial text
#
# Returns:
#   scalar status string
#
# Side Effects:
#   none
#
#######################################################
sub determineSerialStatus {
   my $raw = shift;
   return 'missing' if !defined($raw) || trim($raw) eq '';
   return isPlaceholderSerial($raw) ? 'placeholder' : 'ok';
}

#######################################################
#
# selectEffectiveUuid( $serverInfoUuid, $dmiUuid, $configUuid )
#
# Selects effective UUID and source by precedence and validity.
#
# Parameters:
#   $serverInfoUuid - UUID from server.info env
#   $dmiUuid        - UUID from live platform probes
#   $configUuid     - UUID from config env
#
# Returns:
#   array (uuid, source)
#
# Side Effects:
#   none
#
#######################################################
sub selectEffectiveUuid {
   my ($serverInfoUuid, $dmiUuid, $configUuid) = @_;
   my @candidates = (
      ['server_info', $serverInfoUuid],
      ['dmi', $dmiUuid],
      ['config', $configUuid],
   );

   foreach my $candidate (@candidates) {
      my ($source, $raw) = @{$candidate};
      next if !defined($raw) || trim($raw) eq '';
      next if isPlaceholderUUID($raw);
      my $norm = normaliseUUID($raw);
      next if $norm eq '';
      return ($norm, $source);
   }

   return ('', '');
}

#######################################################
#
# selectEffectiveSerial( $serverInfo, $dmi, $config, $virt, $uuid )
#
# Selects effective serial and source by precedence and VM rule.
#
# Parameters:
#   $serverInfo - serial from server.info env
#   $dmi        - serial from live platform probes
#   $config     - serial from config env
#   $virt       - virtualization state string
#   $uuid       - effective UUID
#
# Returns:
#   array (serial, source)
#
# Side Effects:
#   none
#
#######################################################
sub selectEffectiveSerial {
   my ($serverInfo, $dmi, $config, $virt, $uuid) = @_;
   my @candidates = (
      ['server_info', $serverInfo],
      ['dmi', $dmi],
      ['config', $config],
   );

   foreach my $candidate (@candidates) {
      my ($source, $raw) = @{$candidate};
      next if !defined($raw) || trim($raw) eq '';
      next if isPlaceholderSerial($raw);
      return (trim($raw), $source);
   }

   if (defined($virt) && $virt ne '' && $virt ne 'none' && defined($uuid) && $uuid ne '') {
      return ($uuid, 'uuid');
   }

   return ('', '');
}

#######################################################
#
# buildIdentityLines( $data )
#
# Converts normalized identity hash to tab-delimited lines.
#
# Parameters:
#   $data - hash reference of identity keys and values
#
# Returns:
#   array reference of output lines
#
# Side Effects:
#   none
#
#######################################################
sub buildIdentityLines {
   my $data = shift;
   my @out;
   foreach my $k (sort keys %{$data}) {
      next unless defined($data->{$k});
      next if $data->{$k} eq '';
      push @out, "identity\t$k\t$data->{$k}";
   }
   return \@out;
}

#######################################################
#
# identityReport( $probe )
#
# Applies the identity rules to the values a sensor probed and
# returns the identity lines. The configured and server_info values
# come from the SYSINFO_* environment variables.
#
# Parameters:
#   $probe - hash reference with keys rawUuid, rawSerial, boardSerial,
#            maker, product, machineId, virt, and optional extra (hash
#            reference of additional identity keys, e.g. os_version)
#
# Returns:
#   array reference of output lines
#
# Side Effects:
#   none
#
#######################################################
sub identityReport {
   my $probe = shift;
   my $configuredUuid = $ENV{'SYSINFO_CONFIGURED_UUID'} // '';
   my $configuredSerial = $ENV{'SYSINFO_CONFIGURED_SERIAL'} // '';
   my $serverInfoUuid = $ENV{'SYSINFO_SERVERINFO_UUID'} // '';
   my $serverInfoSerial = $ENV{'SYSINFO_SERVERINFO_SERIAL'} // '';

   my %data = (
      'configured_uuid' => $configuredUuid,
      'configured_serial' => $configuredSerial,
      'server_info_uuid' => $serverInfoUuid,
      'server_info_serial' => $serverInfoSerial,
   );
   if (ref($probe->{'extra'}) eq 'HASH') {
      $data{$_} = $probe->{'extra'}{$_} foreach keys %{$probe->{'extra'}};
   }

   $data{'system_uuid_raw'} = $probe->{'rawUuid'};
   $data{'system_uuid'} = normaliseUUID($probe->{'rawUuid'});
   $data{'system_uuid_status'} = determineUuidStatus($probe->{'rawUuid'});
   $data{'system_serial'} = $probe->{'rawSerial'};
   $data{'system_serial_status'} = determineSerialStatus($probe->{'rawSerial'});
   $data{'board_serial'} = $probe->{'boardSerial'};
   $data{'system_manufacturer'} = $probe->{'maker'};
   $data{'system_product'} = $probe->{'product'};
   $data{'machine_id'} = $probe->{'machineId'};
   $data{'virtualization'} = $probe->{'virt'};

   my ($uuid, $uuidSource) = selectEffectiveUuid($serverInfoUuid, $probe->{'rawUuid'}, $configuredUuid);
   $data{'uuid'} = $uuid;
   $data{'uuid_source'} = $uuidSource;

   my ($serial, $serialSource) = selectEffectiveSerial($serverInfoSerial, $probe->{'rawSerial'}, $configuredSerial, $probe->{'virt'}, $uuid);
   $data{'serial'} = $serial;
   $data{'serial_source'} = $serialSource;

   return buildIdentityLines(\%data);
}


1;