tlp-readconfs.in

#!/usr/bin/perl
# tlp-readconfs - read all of TLP's config files
#
# Copyright (c) 2024 Thomas Koch <linrunner at gmx.net> and others.
# SPDX-License-Identifier: GPL-2.0-or-later

# Cmdline options
#   --outfile <FILE>: filepath to contain merged configuration
#   --notrace: disable trace
#   --cdiff: only show differences to the default
#
# 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_DPR => "@TLP_CONFDPR@";
use constant CONF_OLD => "@TLP_CONF@";

# Exit codes
use constant EXIT_TLPCONF => 5;
use constant EXIT_DEFCONF => 6;

# --- Global vars
my @config_val = ();  # 2-dim array: parameter name, value, source, default-value
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 %dprmsg = ();      # hash: PARAMETER => deprecated message

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

my $outfile;

my $defsrc = basename (CONF_DEF);

# --- Subroutines

# Format and write debug message
# @_: printf arguments including format string
sub printf_debug {
    if ( ! $notrace && $debug ) {
        open (my $logpipe, "|-", "logger -p debug -t \"tlp\" --id=\$\$ --") || 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.
# $_[4]: 0=user config/1=default
# return: 0=new name/1=known name
sub store_name_value_source {
    my $name = $_[0];
    my $value = $_[1];
    my $append = $_[2];
    my $source = $_[3];
    my $is_def = $_[4];

    $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
        if ( $is_def ) {
            #save value as default
            push(@config_val, [$name, $value, $source, $value]);
        } else {
            # save value as user config
            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;
    my $is_def;
    if ( $fname eq CONF_DEF ) {
        $source = $defsrc;
        $is_def = 1;
    } else {
        $source = $fname;
        $is_def = 0;
    }

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

    my $ln = 0;
    while ( my $line = <$cf> ) {
        # strip newline
        chomp $line;
        $ln += 1;
        # strip comments: everything after '#' but not when '#' is quoted, i.e. followed by a closing quote ('"')
        # note: opening quote is handled by the regex below
        $line =~ s/#(?=[^"]*$).*$//;
        # strip trailing spaces
        $line =~ s/\s+$//;
        # 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), $is_def );
        }
    }
    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 ( ! $fname ) {
        $runconf = *STDOUT;
    } else {
        open ($runconf, ">", $fname) || return 1;
    }

    foreach ( @config_val ) {
        my ($name, $value, $source, $default) = @$_;
        if ( $runconf eq *STDOUT ) {
            my $msg = "";
            # stdout: check for deprecated message
            if ( defined $dprmsg{$name} ) {
                $msg = " #! $dprmsg{$name}";
            }
            # --cdiff: do not show user config lines matching the default
            if ( ! $cdiff || $value ne $default ) {
                printf {$runconf} "%s: %s=\"%s\"%s\n", $source, $name, $value, $msg;
            }
        } 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) || 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;
}

# Parse deprecated parameters and messages from file
# $_[0]: parameters file
# return: 0=ok/1=file non-existent
sub parse_dprfile {
    my $fname = $_[0];

    open (my $df, "<", $fname) || return 1;

    # accumulate deprecated params and mesgs
    while ( my $line = <$df> ) {
        chomp $line;
        # select lines with format 'PARAMETER<whitespace># message'
        if ( $line =~ /^(?<param_name>[A-Z_]+[0-9]*)\s+#\s+(?<param_msg>.*)$/ ) {
            my $param_name = $+{param_name};
            my $param_msg = $+{param_msg};
            $dprmsg{$param_name} = $param_msg;
        }
    }
    close ($df);

    return 0;
}

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

# read parameter renaming rules
parse_renfile (CONF_REN);

# read deprecated parameter messages
parse_dprfile (CONF_DPR);

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

# 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
    || parse_configfile (CONF_OLD, $do_rename) == 0 || exit EXIT_TLPCONF;

# save result
write_runconf ($outfile);

exit 0;