#!/usr/bin/perl
# IBM_PROLOG_BEGIN_TAG 
# This is an automatically generated prolog. 
#  
# bos72X src/bos/usr/sbin/install/suma/lib/SUMA/GConfig.pm 1.11.1.4 
#  
# Licensed Materials - Property of IBM 
#  
# Restricted Materials of IBM 
#  
# COPYRIGHT International Business Machines Corp. 2004,2022 
# All Rights Reserved 
#  
# US Government Users Restricted Rights - Use, duplication or 
# disclosure restricted by GSA ADP Schedule Contract with IBM Corp. 
#  
# IBM_PROLOG_END_TAG 
# This module will actually die() on any serious failures.

# This implementation will maintain a sparse database.

package SUMA::GConfig;

=head1 NAME

SUMA::GConfig - Access to global configuration settings.

=head1 SYNOPSIS

  use SUMA::GConfig; # imports getGlobal and LVL_ macros
  use SUMA::GConfig qw/getGlobal setGlobal saveGlobals listGlobals printGlobals/;
  use SUMA::GConfig qw/LVL_OFF LVL_ERROR LVL_WARNING LVL_INFO LVL_VERBOSE LVL_DEBUG/;
  use SUMA::GConfig qw/:lvl/; # same
  use SUMA::GConfig qw/:all/;

  $fixserver_protocol = getGlobal('FIXSERVER_PROTOCOL');
  $screen_verb_mnem = getGlobal('SCREEN_VERBOSE', 1);

  $oldval = setGlobal(PATH => '/blah/foo:/usr/bin:.';

  saveGlobals() or die "Couldn't save configuration data";

  $h = &listGlobals(1);
  while(($k, $v) = each(%$h)) {
    ...
  }

  select STDOUT;
  printGlobals();

=head1 DESCRIPTION

Provides functions for accessing SUMA global configuration settings.
Maintains a sparse database at /var/suma/data/config.suma

=cut

use strict;

use constant LVL_OFF => -1;
use constant LVL_ERROR => 0;
use constant LVL_WARNING => 1;
use constant LVL_INFO => 2;
use constant LVL_VERBOSE => 3;
use constant LVL_DEBUG => 4;

require Exporter;
our @ISA = qw(Exporter);

my @lvl_macros = qw( LVL_OFF
                     LVL_ERROR 
                     LVL_WARNING
                     LVL_INFO
                     LVL_VERBOSE
                     LVL_DEBUG  );
                  
our @EXPORT = (@lvl_macros, qw(getGlobal));
our @EXPORT_OK = qw(setGlobal saveGlobals listGlobals printGlobals);
our %EXPORT_TAGS = ( all => [@EXPORT, @EXPORT_OK],
                     lvl => [@lvl_macros],
                     def => [@EXPORT]);

use lib qw(/usr/suma/lib);

$ENV{PATH} = "/usr/suma/bin:/usr/bin:/usr/sbin";
delete @ENV{qw/IFS CDPATH ENV BASH_ENV/};

my $lvl_re
    = join('|', LVL_OFF, LVL_ERROR, LVL_WARNING, LVL_INFO, LVL_VERBOSE, LVL_DEBUG,
           qw/  LVL_OFF  LVL_ERROR  LVL_WARNING  LVL_INFO  LVL_VERBOSE  LVL_DEBUG/);
# A hack:
sub RE_VERBOSITY() {
  return qr/^($lvl_re)$/oi;
}

use constant RE_PATH => qr!^([]/\w"#$%'+,-.:@[\\^{}~]+)$!o;
use constant RE_INTEGER => qr/^([1-9]\d*)$/o;
use constant RE_BOOL => qr/^(y(es)?|no?|0|1)$/oi;
use constant RE_NOMOD => qr!^This value cannot be changed$!; # Not ideal, but an okay double-check
use constant GCONFIG_PATH => '/var/suma/data/config.suma';
use constant RE_COMMENT => qr/^\s*#/o;
use constant RE_KVLINE => qr/^\s*(\w+)\s*=\s*(.*?)\s*$/o;
use constant RE_PROXYURL => qr/^(.*)$/o; # Make general, since protocol needs to be optional

my $validate = {
    FIXSERVER_PROTOCOL => {
      default => 'https',
      match   => qr/^(https)$/oi,
      seq     => "1_net_010",
    },
    DOWNLOAD_PROTOCOL => {
      default => 'http',
      match   => qr/^(https?)$/oi,
      seq     => "1_net_020",
    },
    DL_TIMEOUT_SEC => {
      default => 180,
      match   => RE_INTEGER,
      seq     => "1_net_110",
    },
    DL_RETRY => {
      default => 1,
      match   => RE_INTEGER,
      seq     => "1_net_120",
    },
#    MAX_CONCURRENT_DOWNLOADS => {
#      default => 5,
#      match   => qr/^(-1|unlimited|[1-9]\d*)$/oi,
#      seq     => "1_net_130",
#    },
    HTTP_PROXY => {
      default => '',
      match   => qr/^()$/oi,
      seq     => "1_net_210",
    },
    HTTPS_PROXY => {
      default => '',
      match   => qr/^()$/oi,
      seq     => "1_net_220",
    },
#    FTP_PROXY => {
#      default => '',
#      match   => RE_PROXYURL,
#      seq     => "1_net_230",
#    },
    REMOVE_CONFLICTING_UPDATES => {
      default => 'yes',
      match   => RE_BOOL,
      seq     => "5_lppmgr_010",
    },
    REMOVE_DUP_BASE_LEVELS => {
      default => 'yes',
      match   => RE_BOOL,
      seq     => "5_lppmgr_020",
    },
    REMOVE_SUPERSEDE => {
      default => 'yes',
      match   => RE_BOOL,
      seq     => "5_lppmgr_030",
    },
    USE_FIPS_PROVIDER => {
      default => 'no',
      match   => RE_BOOL,
      seq     => "1_net_250",
    },
    CHECK_CERTIFICATE_REVOCATION => {
      default => 'no',
      match   => RE_BOOL,
      seq     => "1_net_260",
    },
    USE_CC_CIPHERS => {
      default => 'no',
      match   => RE_BOOL,
      seq     => "1_net_270",
    },
    SCREEN_VERBOSE => {
      default => LVL_INFO,
      match   => RE_VERBOSITY,
      seq     => "3_output_010",
    },
    NOTIFY_VERBOSE => {
      default => LVL_INFO,
      match   => RE_VERBOSITY,
      seq     => "3_output_020",
    },
    LOGFILE_VERBOSE => {
      default => LVL_VERBOSE,
      match   => RE_VERBOSITY,
      seq     => "3_output_030",
    },
#     PATH => {
#       default => $ENV{PATH},
#       match   => RE_PATH,
#       seq     => "7_disk_010",
#     },
    TMPDIR => {
      default => '/var/suma/tmp',
      match   => RE_PATH,
      seq     => "7_disk_020",
    },
    MAXLOGSIZE_MB => {
      default => 1,
      match   => RE_INTEGER,
      seq     => "4_log_010",
    },
    POLICY_DB => {
      default => '/var/suma/data/policy.suma',
      match   => RE_NOMOD,
      seq     => "9_nomod_010",
    },
    NOTIFY_DB => {
      default => '/var/suma/data/notify.suma',
      match   => RE_NOMOD,
      seq     => "9_nomod_020",
    },
    MSG_MAPFILE_PATH => {
      default => '/usr/suma/lib/msg.map',
      match   => RE_NOMOD,
      seq     => "9_nomod_030",
    },
    BOOTSTRAP_URL => {
      default => 'http://www.ibm.com/servers/aix/os/sysman/suma_config.html',
      match   => RE_NOMOD,
      seq     => "9_nomod_035",
    },
#     FIXSERVER_URL => {
#       default => 'www14.software.ibm.com/webapp/set2/fixget',
#       match   => qr/^(.*)$/,
#       seq     => "9_nomod_040",
#     },
    LOGFILE => {
      default => '/var/adm/ras/suma.log',
      match   => RE_NOMOD,
      seq     => "9_nomod_050",
    },
    DL_HIST_LOGFILE => {
      default => '/var/adm/ras/suma_dl.log',
      match   => RE_NOMOD,
      seq     => "9_nomod_060",
    },
    WEB_IDENTITY_FILE => {
      default => '',
      match   => RE_PATH,
      seq     => "7_disk_030",
    },
};

# " Remove this comment

my $cache = {};
my $loaded = 0;

## Method getGlobal ##########################################

=head1 METHODS

=over 4

=item getGlobal KEY_STR

=item getGlobal KEY_STR MNEMONIC_BOOL

Retrieves and returns the global value associated with the specified key,
or C<undef> if the key is not valid.
If the MNEMONIC_BOOL argument evaluates to true, the mnemonic (if applicable)
is returned instead of the actual value.

=cut

sub getGlobal {
  shift if ref($_[0]) || $_[0]->isa(__PACKAGE__);
  my $tag = uc(shift);
  exists $validate->{$tag} or return undef;
  my $ret;
  if(exists($cache->{$tag})) {
    $ret = $cache->{$tag};
  }
  else {
    # Not in the cache - retrieve from the DB
    _load();
    $ret = exists($cache->{$tag}) ? $cache->{$tag} : $validate->{$tag}->{default};
  }
  my $mnemonic = shift;
  if($mnemonic) {
    # mnemonic conversions
    if($tag =~ /_VERBOSE$/) {
      require SUMA::GConfig;
      SUMA::GConfig->import(qw/LVL_OFF LVL_ERROR LVL_WARNING LVL_INFO LVL_VERBOSE LVL_DEBUG/);
      SWITCH: {
        if($ret <= LVL_OFF()    ) { $ret = 'LVL_OFF';     last SWITCH; }
        if($ret == LVL_ERROR()  ) { $ret = 'LVL_ERROR';   last SWITCH; }
        if($ret == LVL_WARNING()) { $ret = 'LVL_WARNING'; last SWITCH; }
        if($ret == LVL_INFO()   ) { $ret = 'LVL_INFO';    last SWITCH; }
        if($ret == LVL_VERBOSE()) { $ret = 'LVL_VERBOSE'; last SWITCH; }
        if($ret >= LVL_DEBUG()  ) { $ret = 'LVL_DEBUG';   last SWITCH; }
      }
    }
  }
  return $ret;
}

## Method setGlobal ##########################################

=item setGlobal KEY_STR, VALUE_STR

Sets the value of the specified key, returning the old value.
Returns undef (and does not set the value) if the key or value
is not valid.  This function does NOT write the value back to
the configuration file.  Use the C<saveGlobals> function to
make values set via C<setGlobal> persistent across invocations.

=cut

sub setGlobal($$) {
  shift if ref($_[0]) || $_[0]->isa(__PACKAGE__);
  my $tag = uc(shift);
  my $val = shift;
  _validate($tag, \$val) or return undef;
  my $oldval = getGlobal($tag);
  $cache->{$tag} = $val;
  return $oldval;
}

## Method saveGlobals ##########################################

=item saveGlobals

Saves configuration settings to permanent storage.  Anything
changed via C<setGlobal> will retain its new value for the next
invocation of this library.

=cut

sub saveGlobals() {
  _load();
  open(FH, '>' . GCONFIG_PATH) or die "Couldn't open global configuration file " . GCONFIG_PATH . " for writing: $!";
  chmod 0600, GCONFIG_PATH; # Failure not big deal with rw root umask. Only allow root rw access.
  while(my($k, $v) = each(%$cache)) {
    $v = '' unless defined $v;
    print FH "$k = $v\n";
  }
  close(FH);
}

## Method listGlobals ##########################################

=item listGlobals

=item listGlobals ALL_BOOL

Returns a reference to a hash containing configuration key/value pairs.
If C<ALL_BOOL> evaluates to C<true>, even "private" keys will be listed.
Otherwise, only modifiable values will be returned.  Modifying values
in the returned hash reference should NOT affect the settings themselves.

=cut

sub listGlobals {
  my $all = shift;
  my $ret = {};
  for(keys(%$validate)) {
    if($all || ($validate->{$_}->{match} ne RE_NOMOD)) {
      $ret->{$_} = getGlobal($_);
    }
  }
  return $ret;
}

## Method printGlobals ##########################################

=item printGlobals

=item printGlobals ALL_BOOL

Prints the global configuration values in a sensible order to the
currently-selected filehandle.
If C<ALL_BOOL> evaluates to C<true>, even "private" keys will be listed.
Otherwise, only modifiable values will be printed.

=cut

sub printGlobals {
  my $h = listGlobals(@_);
  for my $key (sort( { $validate->{$a}->{seq} cmp $validate->{$b}->{seq} } keys(%$h) )) {
    print("\t" . $key . '=' . getGlobal($key, 1) . "\n");
  }
}

# Pulls all the values from the DB, but does
# NOT overwrite values already in the cache.
sub _load {
  return 1 if $loaded;
  return 2 unless -e GCONFIG_PATH; # OK if the DB doesn't exist
  open(FH, GCONFIG_PATH) or die "Couldn't open global configuration file " . GCONFIG_PATH . " for reading: $!";
  my($k, $v);
  while(my $line = <FH>) {
    chomp $line;
    next if $line =~ RE_COMMENT;
    ($k, $v) = $line =~ RE_KVLINE;
    # Fix or blitz bogus values entered by hand
    unless(_validate($k, \$v)) {
      next unless exists $validate->{$k};
      $v = $validate->{$k}->{default};
    }
    next if defined $cache->{$k}; # Don't overwrite cached values
    $cache->{$k} = $v;
  }
  close(FH);
  $loaded = 1;
}

sub _validate {
  my($tag, $valref) = @_;
  $tag = uc($tag);
  return undef unless (
       exists $validate->{$tag}
    && defined $$valref
    && (($$valref) = $$valref =~ $validate->{$tag}->{match}) # taint clean
  );
  return undef if (($validate->{$tag}->{match} eq RE_NOMOD                    )
                && (                  $$valref ne $validate->{$tag}->{default}));
  # Wash the values as necessary.
  # Lenient in what we require, strict in what we provide.
  SWITCH: {
    if($validate->{$tag}->{match} eq RE_BOOL) {
      $$valref = ($$valref =~ /[y1]/oi) ? 'yes' : 'no';
      last SWITCH;
    }
    if($validate->{$tag}->{match} eq RE_VERBOSITY) {
      last SWITCH if $$valref =~ /^[+-]?\d+$/o; # integer-numeric
      $$valref = uc($$valref);
      VERBOSITY: {
        if($$valref eq 'LVL_OFF'    ) { $$valref = LVL_OFF    ; last VERBOSITY }
        if($$valref eq 'LVL_ERROR'  ) { $$valref = LVL_ERROR  ; last VERBOSITY }
        if($$valref eq 'LVL_WARNING') { $$valref = LVL_WARNING; last VERBOSITY }
        if($$valref eq 'LVL_INFO'   ) { $$valref = LVL_INFO   ; last VERBOSITY }
        if($$valref eq 'LVL_VERBOSE') { $$valref = LVL_VERBOSE; last VERBOSITY }
        if($$valref eq 'LVL_DEBUG'  ) { $$valref = LVL_DEBUG  ; last VERBOSITY }
        # else
        die "$$valref unexpectedly matched " . RE_VERBOSITY . " but isn't recognized.";
      }
      last SWITCH;
    }
#    if($tag eq 'MAX_CONCURRENT_DOWNLOADS' && $$valref =~ /unlimited/oi) {
#      $$valref = -1;
#      last SWITCH;
#    }
    if($tag =~ /_PROTOCOL$/) {
      $$valref = lc $$valref;
    }
  } # SWITCH
  return 1;
}

1;