gniza4cp/whm/gniza-whm/lib/GnizaWHM/Config.pm

package GnizaWHM::Config;
# Pure Perl config file parser/writer for bash-style KEY="value" files.
# No shell calls — reads/writes via Perl file I/O only.

use strict;
use warnings;
use Fcntl qw(:flock);

our @MAIN_KEYS = qw(
    TEMP_DIR INCLUDE_ACCOUNTS EXCLUDE_ACCOUNTS
    RSYNC_EXTRA_OPTS LOG_DIR LOG_LEVEL LOG_RETAIN NOTIFY_EMAIL NOTIFY_ON
    SMTP_HOST SMTP_PORT SMTP_USER SMTP_PASSWORD SMTP_FROM SMTP_SECURITY
    LOCK_FILE SSH_TIMEOUT SSH_RETRIES
    USER_RESTORE_REMOTES
);

our @REMOTE_KEYS = qw(
    REMOTE_TYPE REMOTE_HOST REMOTE_PORT REMOTE_USER REMOTE_AUTH_METHOD REMOTE_KEY
    REMOTE_PASSWORD REMOTE_BASE BWLIMIT RETENTION_COUNT RSYNC_EXTRA_OPTS
    S3_ACCESS_KEY_ID S3_SECRET_ACCESS_KEY S3_REGION S3_ENDPOINT S3_BUCKET
    GDRIVE_SERVICE_ACCOUNT_FILE GDRIVE_ROOT_FOLDER_ID
);

our @SCHEDULE_KEYS = qw(
    SCHEDULE SCHEDULE_TIME SCHEDULE_DAY SCHEDULE_CRON REMOTES SYSBACKUP SKIP_SUSPENDED
);

my %MAIN_KEY_SET     = map { $_ => 1 } @MAIN_KEYS;
my %REMOTE_KEY_SET   = map { $_ => 1 } @REMOTE_KEYS;
my %SCHEDULE_KEY_SET = map { $_ => 1 } @SCHEDULE_KEYS;

# parse($filepath, $type)
# $type: 'main', 'remote', or 'schedule' — determines which keys are allowed.
# Returns hashref of KEY => value.
sub parse {
    my ($filepath, $type) = @_;
    $type //= 'main';
    my $allowed = ($type eq 'schedule') ? \%SCHEDULE_KEY_SET
               : ($type eq 'remote')   ? \%REMOTE_KEY_SET
               :                          \%MAIN_KEY_SET;

    my %config;
    open my $fh, '<', $filepath or return \%config;  ## no critic (RequireBriefOpen)
    while (my $line = <$fh>) {
        chomp $line;
        # Skip blank lines and comments
        next if $line =~ /^\s*$/;
        next if $line =~ /^\s*#/;
        # Match KEY="value", KEY='value', or KEY=value
        if ($line =~ /^([A-Z_]+)=(?:"([^"]*)"|'([^']*)'|(\S*))$/) {
            my $key = $1;
            my $val = defined $2 ? $2 : (defined $3 ? $3 : ($4 // ''));
            if ($allowed->{$key}) {
                $config{$key} = $val;
            }
        }
    }
    close $fh;
    return \%config;
}

# escape_value($string)
# Strips everything except safe characters for bash config values.
sub escape_value {
    my ($val) = @_;
    $val //= '';
    $val =~ s/[^a-zA-Z0-9\@._\/: ,=+\-]//g;
    return $val;
}

# Keys whose values are written with single quotes (preserves special chars).
my %SINGLE_QUOTE_KEYS = (REMOTE_PASSWORD => 1, S3_SECRET_ACCESS_KEY => 1, SMTP_PASSWORD => 1);

# escape_password($string)
# For single-quoted bash values: only strip single quotes (can't appear in single-quoted strings).
sub escape_password {
    my ($val) = @_;
    $val //= '';
    $val =~ s/'//g;
    return $val;
}

# save($filepath, \%values, \@allowed_keys)
# Updates a config file preserving comments and structure.
# Keys not in @allowed_keys are ignored. Values are escaped.
# Uses flock for concurrency safety.
sub save {
    my ($filepath, $values, $allowed_keys) = @_;

    my %allowed = map { $_ => 1 } @$allowed_keys;
    my %to_write;
    for my $key (keys %$values) {
        if ($allowed{$key}) {
            $to_write{$key} = $SINGLE_QUOTE_KEYS{$key}
                ? escape_password($values->{$key})
                : escape_value($values->{$key});
        }
    }

    # Open file for read+write with exclusive lock to prevent TOCTOU
    ## no critic (RequireBriefOpen)
    my @lines;
    my $wfh;
    if (-f $filepath) {
        open $wfh, '+<', $filepath or return (0, "Cannot open $filepath: $!");
        flock($wfh, LOCK_EX) or return (0, "Cannot lock $filepath: $!");
        @lines = <$wfh>;
    } else {
        open $wfh, '>', $filepath or return (0, "Cannot create $filepath: $!");
        flock($wfh, LOCK_EX) or return (0, "Cannot lock $filepath: $!");
    }

    # Track which keys we've updated in-place
    my %written;
    my @output;
    for my $line (@lines) {
        if ($line =~ /^([A-Z_]+)=/) {
            my $key = $1;
            if (exists $to_write{$key}) {
                my $val = $to_write{$key};
                my $q = $SINGLE_QUOTE_KEYS{$key} ? "'" : '"';
                push @output, "$key=$q$val$q\n";
                $written{$key} = 1;
                next;
            }
        }
        push @output, $line;
    }

    # Append any new keys not already in the file
    for my $key (@$allowed_keys) {
        next unless exists $to_write{$key};
        next if $written{$key};
        my $val = $to_write{$key};
        my $q = $SINGLE_QUOTE_KEYS{$key} ? "'" : '"';
        push @output, "$key=$q$val$q\n";
    }

    # Truncate and write under the same lock
    seek($wfh, 0, 0) or return (0, "Cannot seek $filepath: $!");
    truncate($wfh, 0) or return (0, "Cannot truncate $filepath: $!");
    print $wfh @output;
    close $wfh;

    return (1, undef);
}

1;