#!/usr/bin/perl

# check inlet temp every minute, hddtemp every minute (ensuring
# doesn't spinup spundown disks), and sensors every few seconds, and
# adjust individual fans according to own threshold curves, overriding
# iDrac settings with fallback

# background information:
# https://www.dell.com/community/PowerEdge-Hardware-General/T130-Fan-Speed-Algorithm/td-p/5052692
# https://serverfault.com/questions/715387/how-do-i-stop-dell-r730xd-fans-from-going-full-speed-when-broadcom-qlogic-netxtr/733064#733064

use strict;
use warnings;
use List::MoreUtils qw( apply );
use File::Temp qw(tempfile);
use JSON;
use Data::Dumper;
use POSIX ":sys_wait_h"; # for nonblocking read
use Time::HiRes qw (sleep);

my $static_speed_low;
my $static_speed_high;   # This is the speed value at 100% demand
                         # ie what we consider the point we don't
                         # really want to get hotter but still
                         # tolerate
my ($ipmi_inlet_sensorname, $ipmi_exhaust_sensorname);

my $default_exhaust_threshold; # The exhaust temperature we use, set
                               # from above, which we fail back to
                               # letting the drac control the fans
my $base_temp;           # No fans when below this temp
my $desired_temp1;       # Aim to keep the temperature below this
my $desired_temp2;       # Really ramp up fans above this
my $desired_temp3;       # Really ramp up fans above this
my $demand1;             # Prescaled (not taking into effect static_speed_low/high) demand at temp1
my $demand2;             # Prescaled (not taking into effect static_speed_low/high) demand at temp2
my $demand3;             # Prescaled (not taking into effect static_speed_low/high) demand at temp3

my $hysteresis;          # Don't ramp up velocity unless demand
                         # difference is greater than this.  Ramp
                         # down ASAP however, to bias quietness, and
                         # thus end up removing noise changes for
                         # just small changes in computing

my $fans;                # which fans are being controlled by this daemon?  0xff = all fans,
                         # 0x00 to 0x05 for individual fans

sub custom_temperature_calculation;

# Every 20 minutes (enough to establish spin-down), invalidate the
# cache of the slowly changing hdd temperatures to allow them to be
# refreshed
my $hdd_poll_interval=1200;
# Raid controller is less expensive to poll, but also should't change
# overly rapidly
my $raid_controller_poll_interval=30;
# Every 60 seconds, invalidate the cache of the slowly changing
# ambient temperatures to allow them to be refreshed
my $ambient_poll_interval=60;
my $exhaust_poll_interval=60;
# And put fan back under our control once per minute if someone
# slipped it back into idrac mode, if all conditions are correct
my $manual_mode_reset_interval=60;
my $cpu_poll_interval=3;

my $sensors_ref;
my $temperature_calculation_sub;

my $current_mode;
my $lastfan;

my $quiet=0;          # whether to print stats at all
my $print_stats = 1;  # whether to print stats this run

my $tempfilename;
my @daemons;
my %children;
my $started;
my $signame;

sub print_usage {
  print STDERR "Usage: poweredge-fand.pl [-q] [-f <conf_file>]\n";
  exit 1;
}

my %included_conf_file;
sub include {
  # http://www.perlmonks.org/?node_id=393426 but a bit different to
  # the version you can see there now in 2025, or maybe this was the
  # version I found that works when you're not trying to write a
  # module...?  Their code wants &include to be defined as
  # &module::include, and circa 2025, I was now seeing scope issues
  # without that, but removed `package DB; # causes eval to evaluate
  # the string in the caller's scope` and the code started to work
  # again.  So let's go with that...
  my ($filename) = @_;

  my $code;
  {
    open my $fh, '<', $filename or die "Cannot open $filename: $!";
    local $/; # Temporarily undefine the input record separator
    $code = <$fh>;
    close $fh;
  }

  $code = qq[#line 1 "$filename"\n] .
    $code;
  #  print "evaling code: $code\n";
  if (!defined $included_conf_file{$filename}
      or $included_conf_file{$filename} ne $code) {
    print "(re)Parsing file $filename\n";
    eval $code;
    $included_conf_file{$filename} = $code;
  }
  if ("$@" ne "") {
    die "Can't eval $filename: $@";
  }
  #  print "done...\n";
}

# to get reentrant signal handler, we set a flag.  To be as responsive
# as possible to that flag, check before and after every time we
# deliberately sleep as part of a loop
sub sleep_and_check_for_exit {
  my (@args) = (@_);

  if ($signame) {
    exit;
  }
  sleep @args;
  if ($signame) {
    exit;
  }
}

# Only test true in one of the daemons, for the first fan (or the
# daemon that's controlling all fans simultaneously)
sub perform_only_once {
  return ($fans == 0 or $fans == 0xff);
}

# Only print out the stats in one of the daemons, for the first
# fan (or the daemon that's controlling all fans simultaneously)
sub print_stats_once {
  my $res=($print_stats and
    perform_only_once());
  return $res;
}

sub is_num {
  my ($val) = @_;
  if ( $val =~ /^[-+]?(\d*\.?\d+|\d+\.?\d*)+$/ ) {
    return 1;
  }
  print "is_num($val)=0\n"; # should probably warn about failures to parse values, but if you don't care about a particular error, perhaps add this clause: if !$quiet;
  return 0;
}

# returns undef if there are no inputs, and ignores inputs that are
# undef
sub average {
  my (@v) = (@_);

  my $div = 0;
  my $tot = 0;
  foreach my $v (@v) {
    if (defined $v && is_num($v)) {
      $tot += $v;
      $div++;
    }
  }
  my $avg=undef;
  if ($div > 0) {
    $avg = sprintf "%.2f", $tot/$div;
  }
  return $avg;
}

# calculates the weighted averages
# (i,a, j,b, k,c, ....) as
# i*a, j*b, k*c etc, where i,j,k etc are integers>=1
# It still handles ignoring elements that are null
sub weighted_average {
  my (@v) = (@_);

  my (@vp) = ();

  for (my $i=0; $i<@v; $i+=2) {
    my $integer_weight=$v[$i];
    my $value=$v[$i+1];
    for (my $j=0; $j<$integer_weight; $j++) {
      push @vp, $value;
    }
  }
  my $a = average(@vp);
  # print "weighted average @v -> @vp -> $a\n";
  return $a;
}

# returns undef if there are no inputs, and ignores inputs that are
# undef
sub max {
  my (@v) = (@_);
  my $max=undef;
  foreach my $v (@v) {
    if (defined $v) {
      if (!defined $max or $v > $max) {
        $max = $v;
      }
    }
  }
  return $max;
}

my %hdd_cache_temp;
my %hdd_cache_time;
# FIXME: should we use /usr/local/bin/megaclisas-status for all temps?  How does it handle drives in sleep mode?
sub hddtemp {
  my ($device)=(@_);

  # FIXME: if user supplies a parameter of the form of [32:13], interpret it as "Slot ID" form output by megaclisas-status
  return if ! -e $device;

  if (!defined $hdd_cache_time{$device} or
      $hdd_cache_time{$device} > $hdd_poll_interval) {
    # could just be a simple pipe, but hddtemp has a strong posibility
    # to be stuck in a D state, and hold STDERR open despite a kill
    # -9, so instead just send it to a tempfile, and read from that tempfile

    # Some HDDs will be spun down, so they return "not available".
    # Treat them as if they weren't there.
    system("timeout -k 1 20 /usr/local/bin/hddtemp --no-device --numeric $device | grep -v 'not available' > $tempfilename");

    my $val = `cat < $tempfilename`; chomp $val;
    if ($val ne "") {
      $hdd_cache_temp{$device} = $val;
      $hdd_cache_time{$device} = time;
    }
  }

  return $hdd_cache_temp{$device};
}

my $raid_controller_cache_temp;
my $raid_controller_cache_time;
sub raid_controller_temp {
  if (!defined $raid_controller_cache_time or
      $raid_controller_cache_time > $raid_controller_poll_interval) {
    # could just be a simple pipe, but protect against something
    # getting stuck in the D state, holding STDERR open despite a kill
    # -9, so instead just send it to a tempfile, and read from that
    # tempfile
    system("timeout -k 1 20 /opt/MegaRAID/MegaCli/MegaCli64 -AdpAllInfo -aALL -NoLog | grep -i ^ROC.temperature | awk '{print \$4}' > $tempfilename");

    my $val = `cat < $tempfilename`; chomp $val;
    if ($val ne "") {
      $raid_controller_cache_temp = $val;
      $raid_controller_cache_time = time;
    }
  }

  return $raid_controller_cache_temp;
}

my $raid_controller_battery_temp;
my $raid_controller_battery_time;
sub raid_controller_battery_temp {
  if (!defined $raid_controller_battery_time or
      $raid_controller_battery_time > $raid_controller_poll_interval) {
    # could just be a simple pipe, but protect against something
    # getting stuck in the D state, holding STDERR open despite a kill
    # -9, so instead just send it to a tempfile, and read from that
    # tempfile
    system("timeout -k 1 20 /opt/MegaRAID/MegaCli/MegaCli64 -AdpBbuCmd -GetBbuStatus -aALL -NoLog | grep -i ^ROC.temperature | awk '{print \$4}' > $tempfilename");

    my $val = `cat < $tempfilename`; chomp $val;
    if ($val ne "") {
      $raid_controller_battery_temp = $val;
      $raid_controller_battery_time = time;
    }
  }

  return $raid_controller_battery_temp;
}

my $ambient_cache_temp = 20;
my $ambient_cache_time;
sub ambient_temp {
  if (!defined $ambient_cache_time or
      $ambient_cache_time > $ambient_poll_interval) {
    system("timeout -k 1 20 ipmitool sdr type temperature | grep '$ipmi_inlet_sensorname' | grep [0-9] > $tempfilename");

    my @ambient_ipmitemps = `cat < $tempfilename`;
    # apply from List::MoreUtils
    @ambient_ipmitemps = apply { s/.*\| ([^ ]*) degrees C.*/$1/ } @ambient_ipmitemps;

    if (@ambient_ipmitemps) {
      # ipmitool often fails - just keep using the previous result til
      # it succeeds
      $ambient_cache_temp = average(@ambient_ipmitemps);
      $ambient_cache_time = time;
    }
  }

  return $ambient_cache_temp;
}

my $exhaust_cache_temp = 30;
my $exhaust_cache_time;
sub exhaust_temp {
  if (!defined $exhaust_cache_time or
      $exhaust_cache_time > $exhaust_poll_interval) {
    system("timeout -k 1 20 ipmitool sdr type temperature | grep '$ipmi_exhaust_sensorname' | grep [0-9] > $tempfilename");

    my @exhaust_ipmitemps = `cat < $tempfilename`;
    # apply from List::MoreUtils
    @exhaust_ipmitemps = apply { s/.*\| ([^ ]*) degrees C.*/$1/ } @exhaust_ipmitemps;

    if (@exhaust_ipmitemps) {
      # ipmitool often fails - just keep using the previous result til
      # it succeeds
      $exhaust_cache_temp = average(@exhaust_ipmitemps);
      $exhaust_cache_time = time;
    }
  }

  return $exhaust_cache_temp;
}

sub set_fans_default {
  if (!defined $current_mode or $current_mode ne "default") {
    $current_mode="default";
    $lastfan=undef;
    # this is an abnormal condition, so always warn about it, even in
    # quiet mode
    if (perform_only_once) {
      print " --> enable dynamic (idrac automatic) fan control\n";
    }
    # any one of the daemons is allowed to independently call
    # set_fans_default, so we have to run it for each of them:
    foreach my $attempt (1..10) {
      # ipmitool routinely fails, so try up to 10 times since we are
      # already the failure path, so need to be reliable ourselves
      if (system("ipmitool raw 0x30 0x30 0x01 0x01") == 0) {
        return 1;
      }
      sleep_and_check_for_exit 1;
      print "  Retrying dynamic control $attempt\n";
    }
    print "Retries of dynamic control all failed\n";
    return 0;
  }
  return 1;
}

sub set_fans_servo {
  my $weighted_temp = custom_temperature_calculation();

  if ((!defined $weighted_temp) or ($weighted_temp == 0)) {
    print "Error reading all temperatures! Fallback to idrac control\n";
    set_fans_default();
    return 0;  # we always failed, even if set_fans_default succeeded
  }
  my $ambient_temp = ambient_temp();
  my $exhaust_temp = exhaust_temp();
  print "ambient_temp $ambient_temp ; exhaust_temp $exhaust_temp" if print_stats_once;

  # All fan controllers have to agree to take the fan control out of
  # idrac control (or, more correctly, any of the controllers can put
  # it back into auto-mode), so we only do the manual invocation from
  # one of the controllers, in order not to flood the logs and run
  # ipmitool more often than necessary (the reset is done once per
  # minute anyway if someone did slip it back into idrac control, but
  # then didn't have the authority to move it back under manual
  # control)
  if (perform_only_once) {
    if ((!defined $current_mode) or ($current_mode ne "set")) {
      if ($print_stats or
          !((defined $current_mode) and ($current_mode eq "reset"))) {
         print " --> enable our manual fan control\n";
      }
    } else {
      print "\n" if $print_stats;
    }
    # ipmitool routinely fails; that's OK, if this fails, want to
    # return telling caller not to think we've made a change
    if (system("ipmitool raw 0x30 0x30 0x01 0x00") != 0) {
      return 0;
    }
    $current_mode="set";
  }
  my $demand = 0; # sort of starts off with a range roughly 0-255,
                  # which we multiply later to be ranged roughly
                  # between 0-100% of
                  # ($static_speed_low - $static_speed_high)
  if (($weighted_temp > $base_temp) and
      ($weighted_temp < $desired_temp1)) {
    # slope m = (y2-y1)/(x2-x1)
    # y - y1 = (x-x1)(y2-y1)/(x2-x1)
    # y1 = 0 ; x1 = base_temp ; y2 = demand1 ; x2 = desired_temp1
    # x = weighted_temp
    $demand = 0        + ($weighted_temp - $base_temp    ) * ($demand1 - 0       )/($desired_temp1 - $base_temp    );
  } elsif (($weighted_temp >= $desired_temp1) and
           ($weighted_temp < $desired_temp2)) {
    # y1 = demand1 ; x1 = desired_temp1 ; y2 = demand2 ; x2 = desired_temp2
    $demand = $demand1 + ($weighted_temp - $desired_temp1) * ($demand2 - $demand1)/($desired_temp2 - $desired_temp1);
  } elsif ($weighted_temp >= $desired_temp2) {
    # y1 = demand2 ; x1 = desired_temp2 ; y2 = demand3 ; x2 = desired_temp3
    # demand will increase above $demand3 for temps above $desired_temp3, linearly, until we cap it below
    $demand = $demand2 + ($weighted_temp - $desired_temp2) * ($demand3 - $demand2)/($desired_temp3 - $desired_temp2);
  } else {
    # the only possibility left is $weighted_temp < $base_temp
    # which we've already decided is demand=0
  }

  my $demand_out = int($static_speed_low + $demand/100*($static_speed_high-$static_speed_low));
  if ($demand_out>255) {
    $demand_out=255;
  }
  my $stats_to_print=sprintf "weighted_temp($fans) = %6.2f ; demand($fans)=%6.2f -> %3i", $weighted_temp, $demand, $demand_out;
  $demand = $demand_out;

  # ramp down the fans quickly upon lack of demand, don't ramp them up
  # to tiny spikes of 1 fan unit.  FIXME: But should implement long
  # term smoothing of +/- 1 fan unit
  my $demand_has_changed = !defined $lastfan or
    ($demand < $lastfan) or
    ($demand > $lastfan + $hysteresis);
  if ($print_stats or
      $demand_has_changed) {
    if ($demand_has_changed) {
      $lastfan = $demand;
    }
    $demand = sprintf("0x%02x", $demand);
    # print "demand = $demand\n";

    # allowed to print out of minute-printing cycle if the demand
    # actually changes
    print "$stats_to_print --> ipmitool raw 0x30 0x30 0x02 $fans $demand\n";
    # ipmitool routinely fails; that's OK, if this fails, want to
    # return telling caller not to think we've made a change
    if (system("ipmitool raw 0x30 0x30 0x02 $fans $demand") != 0) {
      return 0;
    }
  }
  return 1;
}

my $parent_pid=$$;

sub we_are_parent {
  return ($$ == $parent_pid);
}

# from man perlipc
sub child_handler {
  # don't change $! and $? outside handler
  local ($!, $?);
  while ( (my $pid = waitpid(-1, WNOHANG)) > 0 ) {
    delete $children{$pid};
    # cleanup_child($pid, $?);
  }
};

sub signal_handler {
  $signame = shift;
  print "poweredge-fand(", (we_are_parent() ? "" : "$parent_pid -> " ), "$$): Recieved signal $signame\n";
  $SIG{$signame} = "DEFAULT";
  exit;
};
END {
  # handler for internal errors (floating point, die, etc) that don't
  # cause signals
  my $exit = $?;
  if (we_are_parent()) {
    if ($started) {
      # we're the parent, and need to kill all our children and reset
      # fans back to default
      my (@children) = keys %children;
      print "Killing children: @children\n";
      kill "TERM", @children;
      my $children_left;
      for my $checks (1..100) {
        if ( (my $pid = waitpid(-1, WNOHANG)) > 0) {
          delete $children{$pid};
          (@children) = keys %children;
        }
        $children_left = kill 0, @children;
        if ($children_left) {
          print "Still waiting for $children_left children to die: @children\n"
        } else {
          last;
        }
        sleep 0.03
      }
      if ($children_left) {
        print "Not all children died. $children_left children were left, which may contain: @children\n"
      }
      print "Resetting fans back to default\n";
      my $saved_signame=$signame;
      $signame=undef;
      set_fans_default;
      $signame=$saved_signame;
    }
  } else {
    # we're a child daemon, and need to unlink our temporary file
    unlink $tempfilename if defined $tempfilename;
    print "Child fan $fans dying: $$\n";
  }
  if ($signame) {
    $SIG{$signame} = "DEFAULT";
    kill $signame, $$;
    exit 130;  # fallback since seems to be ignoring SIGINT
  } else {
    $? = $exit;
  }
}

my $conf_file="/etc/poweredge-fand.conf";

while (@ARGV > 0) {
  if ($ARGV[0] eq "-q") {
    $quiet=1;
    $print_stats=0;
  } elsif ($ARGV[0] eq "-f") {
    $conf_file=$ARGV[1];
    shift @ARGV;
  } else {
    print_usage;
  }
  shift @ARGV;
}

include $conf_file;
$started=1;
$SIG{TERM} = $SIG{HUP} = $SIG{INT} = \&signal_handler;

my $first_child=1;
foreach my $loop_fan (@daemons) {
  my $pid;
  if ($pid=fork) {
    #parent;
    $children{$pid}=1;
    if ($first_child) {
      sleep 20;  # give time for the first daemon to gather all
                 # ambient, hdd etc stats
    }
    $first_child=0;
    # keep looping
  } elsif ($pid==0) {
    #child;
    $fans=$loop_fan;
    print "Forked child $parent_pid -> $$ for fan $fans\n";
    last;
  } else {
    die "could not fork: #!";
  }
}

# if we are the parent, wait for the first child to die, then kill all
# our children (or just delegate the killing to systemd?)
if (we_are_parent()) {
  $SIG{CHLD} = \&child_handler;
  wait;   # wait for the first child to die, then exit, killing all
          # the rest (to signal to systemd that we died)

  print "One of our children died with $?, so we're exiting\n";
  exit $?;
}

my $tempfh;
($tempfh, $tempfilename) = tempfile("poweredge-fand.temp.XXXXX", TMPDIR => 1);

my $last_print_stats=time;
while () {
  # Let's parse the file everytime, and detect changes, so we can
  # quickly debug new curves without waiting for the restart sequence:
  include $conf_file;

  my $sensors_json = `timeout -k 1 20 sensors -j 2>/dev/null`;  # discard errors, annoyingly, but we do need to suppress things like
                                                                # "ERROR: Can't get value of subfeature fan1_input: Can't read"

  $sensors_ref = decode_json $sensors_json;

  # my $ambient_temp = ambient_temp();
  # if ($ambient_temp > $default_threshold) {
  my $exhaust_temp = exhaust_temp();
  if ($exhaust_temp > $default_exhaust_threshold) {
    if (perform_only_once) {
      #print "fallback because of high ambient temperature $ambient_temp > $default_threshold\n";
      print "fallback because of high exhaust temperature $exhaust_temp > $default_exhaust_threshold\n";
    }
    if (!set_fans_default()) {
      # return for next loop without resetting timers and delta change
      # if that fails
      goto nextpoll;
    }
  } else {
    if (!set_fans_servo()) {
      # return for next loop without resetting timers and delta change
      # if that fails
      goto nextpoll;
    }
  }

  $print_stats = 0;
  if (time - $last_print_stats > $manual_mode_reset_interval) {
    $current_mode="reset"; # just in case the RAC has rebooted, it
                           # will go back into default control, so
                           # make sure we set it appropriately once
                           # per minute
    $last_print_stats=time;
    $print_stats = 1 if !$quiet;
  }
 nextpoll:
  sleep_and_check_for_exit $cpu_poll_interval;
}