#!/usr/bin/perl -w
############################################################################
#                                                                          #
# This file is part of the IPFire Firewall.                                #
#                                                                          #
# IPFire is free software; you can redistribute it and/or modify           #
# it under the terms of the GNU General Public License as published by     #
# the Free Software Foundation; either version 2 of the License, or        #
# (at your option) any later version.                                      #
#                                                                          #
# IPFire is distributed in the hope that it will be useful,                #
# but WITHOUT ANY WARRANTY; without even the implied warranty of           #
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the            #
# GNU General Public License for more details.                             #
#                                                                          #
# You should have received a copy of the GNU General Public License        #
# along with IPFire; if not, write to the Free Software                    #
# Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307 USA #
#                                                                          #
# Copyright (C) 2021 IPFire Team <info@ipfire.org>.                        #
#                                                                          #
############################################################################

# This package provides functions for reading and writing configuration files.
package Configuration;

use strict;
use Text::CSV_XS;
use Fcntl qw(:flock);

#
## Store a hash as a key/value list:
#
# %hash = ("foo" => "bar", 123 => 456);
#
# foo=bar
# 123=456
#
# Writing non alphanumeric keys is possible, but reading is limited to: "A-Za-z0-9_-".
# Control characters (i.e. carriage return, tab) in values are replaced by spaces.
#

# Read function - parameters:
#	filename: Configuration file
#	hash: Hash reference
#	clear_hash: Clear contents of hash before reading (default: enabled)
sub keyvalue_read {
	my($filename, $hash, $clear_hash) = @_;
	$clear_hash //= 1; # Default: enabled

	if($clear_hash) {
		%$hash = ();
	}

	open(my $file, "<", $filename) or die "Can't read from file '$filename': $!";
	while(<$file>) {
		my $line = $_;
		$line =~ s/^\s+|\s+$|\R//g; # Trim whitespace and linebreak

		next if ($line =~ /^#/); # Skip comments
		next unless($line =~ /=/); # Skip incomplete lines

		# Split line into key/value pair at "=" character
		my $key = "";
		my($left, $value) = split(/=/, $line, 2);
		if($left =~ /(^[A-Za-z0-9_-]+)(?=\s*$)/) { # Get only alphanumeric key from left side
			$key = $1;
		}

		if($key ne "") {
			$value =~ s/^\s*['"]?|['"]?\s*$//g; # Remove quotes and outside whitespace
			$value =~ s/[[:cntrl:]]+/ /g; # Replace control characters with spaces

			# Store value in hash
			$hash->{$key} = $value;
		}
	}
	close($file);

	return;
}

# Write function - parameters:
#	filename: Configuration file
#	hash: Hash reference
sub keyvalue_write {
	my($filename, $hash) = @_;

	open(my $file, ">", $filename) or die "Can't write to file '$filename': $!";
	flock($file, LOCK_EX);
	foreach my $key (sort {uc($a) cmp uc($b)} keys %$hash) {
		next if($key =~ /[=[:cntrl:]]/); # Skip invalid keys
		next if(($key eq "__CGI__") || ($key =~ /^ACTION/)); # Skip CGI internals
		
		next if($key =~ /\.x$|\.y$/); # Skip mouse coordinates as intended by:
# Darren Critchley Jan 17, 2003 added the following because when submitting with a graphic, the x and y
# location of the mouse are submitted as well, this was being written to the settings file causing
# some serious grief! This skips the variable.x and variable.y

		# Load and sanitize value
		my $value = $hash->{$key};
		$value =~ s/[[:cntrl:]]+/ /g; # Replace control characters with spaces
		if ($value =~ /[='" ]/) { # Quote fields containing reserved characters or spaces
			$value = "'${value}'";
		}

		# Write to file
		print $file "${key}=${value}\n";
	}
	close($file);

	return;
}

#
## Store a hash of arrays as a numerically indexed parameter list:
#
# %hash = ('1' => ["foo, bar", "foobar"], '2' => [123, 456]);
#
# 1,"foo, bar", foobar
# 2,123,456
#
# Non numeric keys are not permitted.
# If CSV encoding is enabled, commas and line breaks can be used in values.
#

# Read function - parameters:
#	filename: Configuration file
#	hash: Hash reference
#	clear_hash: Clear contents of hash before reading (default: enabled)
#	separator: Character used to separate fields (default: ",")
sub paramlist_read {
	my($filename, $hash, $clear_hash, $separator) = @_;
	$clear_hash //= 1; # Default: enabled
	$separator //= ","; # Default: ","

	if($clear_hash) {
		%$hash = ();
	}

	# Set up CSV decoder
	my $csv = Text::CSV_XS->new({
		binary => 1,
		auto_diag => 1,
		sep_char => $separator,
#		strict => 0,		# requires CSV_XS update
#		skip_empty_rows => 1,
#		comment_str => "#"
	}) or die Text::CSV_XS->error_diag();

	open(my $file, "<", $filename) or die "Can't read from file '$filename': $!";
	while(my $data = $csv->getline($file)) {
		my $index = shift(@$data); # Get and remove index from data
		next unless ($index =~ /^[0-9]+$/); # Skip non-numeric index

		# Store data array in hash
		$hash->{$index} = $data;
	}
	close($file);
	$csv->eof() or die $csv->error_diag();

	return;
}

# Write function - parameters:
#	filename: Configuration file
#	hash: Hash reference
#	csv_encode: Encode data as RFC4180 CSV (default: enabled)
#	(If disabled, characters requiring encoding i.e. commas will be removed from the output!)
#	separator: Character used to separate fields (default: ",")
sub paramlist_write {
	my($filename, $hash, $csv_encode, $separator) = @_;
	$csv_encode //= 1; # Default: enabled
	$separator //= ","; # Default: ","

	# Set up CSV encoder
	my $csv = Text::CSV_XS->new({
		binary => 1,
		auto_diag => 1,
		sep_char => $separator,
		eol => "\n",
		quote_space => 0
	}) or die Text::CSV_XS->error_diag();

	open(my $file, ">", $filename) or die "Can't write to file '$filename': $!";
	flock($file, LOCK_EX);
	foreach my $index (sort {$a <=> $b} keys %$hash) {
		next unless ($index =~ /^[0-9]+$/); # Skip non-numeric index
		my @data = $hash->{$index}->@*; # Dereference to preserve data

		# CSV encoding disabled: Remove characters that would require encoding
		unless($csv_encode) {
			foreach my $value (@data) {
				$value =~ s/[${separator}"[:cntrl:]]+/ /g;
			}
		}

		# Add index and write record to file
		unshift(@data, $index);
		$csv->print($file, \@data);
	}
	close($file);

	return;
}

# Get the next index to append data without re-using deleted indexes
# %hash = 1, 3, 4 => return 5
#	hash: Hash reference
sub paramlist_appendindex {
	my($hash) = @_;

	if($hash) {
		my @indexes = sort {$b <=> $a} keys %$hash; # Reverse sort
		return $indexes[0] + 1;
	}
	return 1; # Empty hash
}

# Get the next index to insert data on the first free position
# %hash = 1, 3, 4 => return 2
#	hash: Hash reference
sub paramlist_freeindex {
	my($hash) = @_;

	if($hash) {
		my $index = 1;
		while(exists($hash->{$index})) { # Loop until free index found
			$index++;
		}
		return $index;
	}
	return 1; # Empty hash
}

1; # end of package

__END__

sub demo() {
	use Data::Dumper;

	# Demo key/value store:
	my %keyvalue = ('foo' => "thisdata=\t'isweird'", 'bar' => "föö, b#r", 123 => 456, '#disabled' => 0);
	keyvalue_write("keyvalue.txt", \%keyvalue);
	print Dumper(%keyvalue);
	print "\n\n";
	keyvalue_read("keyvalue.txt", \%keyvalue);
	print Dumper(%keyvalue);
	print "\n\n";

	# Demo parameter list:
	my %paramlist = (1 => ["foo bar", "foo, bar"], 2 => [123, 456], 3 => ["thisdata=\t'isweird'", "föö,\nb#r"]);
	paramlist_write("paramlist.txt", \%paramlist, 0); # encoding disabled
	print Dumper(%paramlist);
	print "\n\n";
	paramlist_read("paramlist.txt", \%paramlist);
	print Dumper(%paramlist);
	print "\n\n";

	delete $paramlist{2};
	print("4 = ", paramlist_appendindex(\%paramlist));
	print "\n";
	print("2 = ", paramlist_freeindex(\%paramlist));
}

demo();