tlp-readconfs.in

#!/usr/bin/perl
# tlp-readconfs - read all of TLP's config files
#
# Copyright (c) 2021 Thomas Koch <linrunner at gmx.net> and others.
# This software is licensed under the GPL v2 or later.

# Cmdline options
#   --outfile <FILE>: filepath to contain merged configuration
#   --notrace: disable trace
#
# Return codes
#   0: ok
#   5: tlp.conf missing
#   6: defaults.conf missing

package tlp_readconfs;
use strict;
use warnings;

# --- Modules
use File::Basename;
use Getopt::Long;

# --- Constants
use constant CONF_USR => "@TLP_CONFUSR@";
use constant CONF_DIR => "@TLP_CONFDIR@";
use constant CONF_DEF => "@TLP_CONFDEF@";
use constant CONF_REN => "@TLP_CONFREN@";
use constant CONF_OLD => "@TLP_CONF@";

# --- Global vars
my @config_val = ();  # 2-dim array: parameter name, value, source
my %config_idx = ();  # hash: parameter name => index into the name-value array

my %rename = ();      # hash: OLD_PARAMETER => NEW_PARAMETER
my $renrex;           # compiled regex for renaming parameters
my $do_rename = 0;    # enable renaming (when $renrex not empty)

my $notrace = 0;
my $debug   = 0;

# --- Subroutines

# Format and write debug message
# @_: printf arguments including format string
sub printf_debug {
    if ( not $notrace and $debug ) {
        open (my $logpipe, "|-", "logger -p debug -t \"tlp\" --id=\$\$ --") or return 1;
        printf {$logpipe} @_;
        close ($logpipe);
    }

    return 0;
}

# Store parameter name, value, source in array/hash
# $_[0]: parameter name  (non-null string)
# $_[1]: parameter value (maybe null string)
# $_[2]: 0=replace/1=append parameter value
# $_[3]: parameter source e.g. filepath + line no.
# return: 0=new name/1=known name
sub store_name_value_source {
    my $name = $_[0];
    my $value = $_[1];
    my $append = $_[2];
    my $source = $_[3];

    $debug = 1 if ( $name eq "TLP_DEBUG" ) && ( $value =~ /\bcfg\b/ );

    if ( defined $config_idx{$name} ) {
        # existing name
        if ( $append ) {
            # append value, source
            $config_val[$config_idx{$name}][1] .= " $value";
            $config_val[$config_idx{$name}][2] .= " & $source";
        } else {
            # replace value, source
            $config_val[$config_idx{$name}][1] = $value;
            $config_val[$config_idx{$name}][2] = $source;
        }

        printf_debug ("tlp-readconfs.replace [%s]: %s=\"%s\" %s\n", $config_idx{$name}, $name, $value, $source);
    } else {
        # new name --> store name, value, source and hash name
        push(@config_val, [$name, $value, $source]);
        $config_idx{$name} = $#config_val;

        printf_debug ("tlp-readconfs.insert  [%s]: %s=\"%s\" %s\n", $#config_val, $name, $value, $source);
    }

    return 0;
}

# Parse whole config file and store parameters
# $_[0]: filepath
# $_[1]: 0=no change/1=rename parameters
# return: 0=ok/1=file non-existent
sub parse_configfile {
    my $fname  = $_[0];
    my $do_ren = $_[1];
    my $source;
    if ( $fname eq CONF_DEF ) {
        $source = basename ($fname);
    } else {
        $source = $fname;
    }

    open (my $cf, "<", $fname) or return 1;

    my $ln = 0;
    while ( my $line = <$cf> ) {
        chomp $line;
        $ln += 1;
        # select lines with format 'PARAMETER=value' or 'PARAMETER="value"'
        if ( $line =~ /^(?<name>[A-Z_]+[0-9]*)(?<op>(=|\+=))(?:(?<val_bare>[0-9a-zA-Z_\-:\.]*)|"(?<val_dquoted>[0-9a-zA-Z _\-:\.]*)")\s*$/ ) {
            my $name = $+{name};
            if ( $do_ren ) {
                # rename PARAMETER
                $name =~ s/$renrex/$rename{$1}/;
            }
            my $value = $+{val_dquoted} // $+{val_bare};
            my $append = $+{op} eq "+=";
            store_name_value_source ($name, $value, $append, $source . " L" . sprintf ("%04d", $ln) );
        }
    }
    close ($cf);

    return 0;
}

# Output all stored parameter name, value to a file
# or parameter name, value, source to stdout
# $_[0]: filepath (without argument the output will be written to stdout)
# return: 0=ok/1=file open error
sub write_runconf {
    my $fname = $_[0];

    my $runconf;
    if ( not $fname ) {
        $runconf = *STDOUT;
    } else {
        open ($runconf, ">", $fname) or return 1;
    }

    foreach ( @config_val ) {
	my ($name, $value, $source) = @$_;
        if ( $runconf eq *STDOUT ) {
            printf {$runconf} "%s: %s=\"%s\"\n", $source, $name, $value;
        } else  {
            printf {$runconf} "%s=\"%s\"\n", $name, $value;
        }
    }
    close ($runconf);

    return 0
}

# Parse parameter renaming rules from file
# $_[0]: rules file
# return: 0=ok/1=file non-existent
sub parse_renfile {
    my $fname = $_[0];

    open (my $rf, "<", $fname) or return 1;

    # accumulate renaming
    while ( my $line = <$rf> ) {
        chomp $line;
        # select lines with format 'OLD_PARAMETER<whitespace>NEW_PARAMETER'
        if ( $line =~ /^(?<old_name>[A-Z_]+[0-9]*)\s+(?<new_name>[A-Z_]+[0-9]*)\s*$/ ) {
            my $old_name = $+{old_name};
            my $new_name = $+{new_name};
            $rename{$old_name} = $new_name;
        }
    }
    close ($rf);

    if ( keys %rename > 0 ) {
        # renaming hash not empty --> compile OLD_PARAMETER keys to match regex
        $renrex = qr/^(@{[join '|', map { quotemeta($_) } keys %rename]})$/;
        # enable renaming
        $do_rename = 1;
    }

    return 0;
}

# --- MAIN
my $outfile = '';

# parse arguments
GetOptions ('outfile=s' => \$outfile, 'notrace' => \$notrace);

# read parameter renaming rules
parse_renfile (CONF_REN);

# 1. read intrinsic defaults (no renaming)
parse_configfile (CONF_DEF, 0) == 0 or exit 6;

# 2. read customization (with renaming)
foreach my $conffile ( grep { -f $_ } glob CONF_DIR . "/*.conf" ) {
    parse_configfile ($conffile, $do_rename);
}

# 3. read user settings (with renaming)
parse_configfile (CONF_USR, $do_rename) == 0
    or parse_configfile (CONF_OLD, $do_rename) == 0 or exit 5;

# save result
write_runconf ($outfile);

exit 0;