#!/usr/bin/perl
###############################################################################
#    Copyright (C) 2002-2204 by Eric Gerbier
#    Bug reports to: gerbier@users.sourceforge.net
#    $Id: afickonfig.pl 1179 2008-10-15 20:18:00Z gerbier $
#
#    This program 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.
#
#    This program 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.
#
###############################################################################
# afickonfig is designed to modify afick's config file in a batch way
# it just add, replace, remove any components (macro, alias, directives, rules)
# of this file
###############################################################################

use strict;
use warnings;
use Pod::Usage;
use English qw(-no_match_vars);

# debuggging
#use diagnostics;
# use Data::Dumper;

use Getopt::Long;    # option analysis

use File::Basename;  # for path
my $dirname = dirname($PROGRAM_NAME);
require $dirname . '/afick-common.pl';

###############################################################################
#                     global variables
###############################################################################

my $Version = '0.8';
## no critic (ProhibitPackageVars)
use vars qw( $Verbose);
## use critic

my $EMPTY = q{};

#######################################################
# now use debug and warning sub from afick-common
#sub debug($;$)
#sub warning($)
#############################################################
# wrapper for afick commands
sub wrapper ($@) {
	my $configfile = shift @_;
	my @options    = @_;

	# to use same afick as afick-common and afickonfig
	system $dirname . '/afick.pl', '-c', $configfile, @options;
	return;
}
#############################################################
# build config line according type
sub buildligne($$$$) {
	my $title   = shift @_;    # type of ligne
	my $changes = shift @_;    # ref to hash, containing changes
	my $onlydir = shift @_;    # ref to hash, for selection
	my $key     = shift @_;    # parameter value

	## no critic (RequireInterpolationOfMetachars)
	my %h_format = (
		macro     => '@@define %s %s',
		alias     => '%s = %s',
		directive => '%s := %s',
	);
	## use critic

	if ( $title eq 'rule' ) {

		# return of the quotes
		my $newkey = ( $key =~ m/\s/ ) ? "\"$key\"" : $key;
		my $newligne;
		if ( !defined $changes->{$key} ) {

			#negative rule
			$newligne = "! $newkey";
		}
		elsif ( exists $onlydir->{$key} ) {
			$newligne = "= $newkey $changes->{$key}";
		}
		else {
			$newligne = "$newkey $changes->{$key}";
		}
		return $newligne;
	}
	else {
		return sprintf $h_format{$title}, $key, $changes->{$key};
	}
}
#############################################################
# generic sub to apply changes on a parameter type
sub change($$$$$) {
	my $title        = shift @_;    # parameter name
	my $changes      = shift @_;    # ref to hash, containing changes
	my $onlydir      = shift @_;    # ref to hash, for selection
	my $test_pattern = shift @_;    # ref to sub to detect adequate pattern
	my $config       = shift @_;    # array of config file lines

	my $nb_changes = 0;
	foreach my $key ( keys %{$changes} ) {

		debug("$title : $key");
		my $found          = 0;
		my $nb_changes_key = 0;
		my $i              = 0;
		my $newligne       = buildligne( $title, $changes, $onlydir, $key );
		foreach my $ligne ( @{$config} ) {

			my @ret;
			if ( @ret = &{$test_pattern}($ligne) ) {

				# found pattern
				#print Dumper(@ret);
				my $key_lu = shift @ret;
				if ( $key_lu eq $key ) {

					# found same key
					if ( $ligne eq $newligne ) {
						print "no changes for $title $key\n";
					}
					elsif ( ( defined $changes->{$key} )
						and ( $changes->{$key} eq $EMPTY ) )
					{
						print "delete $title $key\n";
						$ligne = '# ' . $ligne;
						@{$config}[$i] = $ligne;
						$nb_changes_key++;
					}
					else {
						print "replace $title $ligne by $newligne\n";
						@{$config}[$i] = $newligne;
						$nb_changes_key++;
					}
					$found = 1;
				}    # found key
			}    # test pattern
			$i++;
		}    # foreach config
		if ( !$found ) {
			if (    ( defined $changes->{$key} )
				and ( $changes->{$key} eq $EMPTY ) )
			{
				warning("can not delete $title $key : not found");
			}
			else {
				print "add $title line $newligne\n";
				push @{$config}, $newligne;
				$nb_changes_key++;
			}
		}
		if ( $nb_changes_key > 1 ) {
			warning("too many changes for $title $key : $nb_changes_key");
		}
		$nb_changes += $nb_changes_key;
	}    #foreach change

	return $nb_changes;
}
#############################################################
# apply changes
## no critic (ProhibitManyArgs)
sub change_config($$$$$$) {
	my $configfile = shift @_;    # config file name
	my $directives = shift @_;    # ref to hash containing directives changes
	my $macros     = shift @_;    # ref to hash containing macro changes
	my $alias      = shift @_;    # ref to hash containing alias changes
	my $rule       = shift @_;    # ref to hash containing rules changes
	my $onlydir    = shift @_;    # ref to hash for equal selections

	my @config;
	read_config( $configfile, \@config ) or die get_error() . "\n";

	# begin directives
	my $nb_changes_dir =
	  change( 'directive', $directives, $onlydir, \&is_directive, \@config );

	# begin macros
	my $nb_changes_macros =
	  change( 'macro', $macros, $onlydir, \&is_macro, \@config );

	# begin alias
	my $nb_changes_alias =
	  change( 'alias', $alias, $onlydir, \&is_alias, \@config );

	# begin rules
	my $nb_changes_rules =
	  change( 'rule', $rule, $onlydir, \&is_anysel, \@config );

	my $nb_changes =
	  $nb_changes_dir +
	  $nb_changes_macros +
	  $nb_changes_alias +
	  $nb_changes_rules;

	if ($nb_changes) {

		# save modified config file
		print "rewrite changed $configfile ($nb_changes)\n";
		print
"directives ($nb_changes_dir) macros($nb_changes_macros) alias ($nb_changes_alias) rules ($nb_changes_rules)\n";
		write_config( $configfile, \@config );
	}
	return $nb_changes;
}
## use critic
#############################################################
# just display program version
sub version($) {
	my $version = shift @_;
	print
"afickonfig : another file integrity checker configurator\nversion $version\n";
	return;
}
#############################################################
# a generic sub to add a new valid directive
sub convert2dir($$$) {
	my $rdir = shift @_;    # hash table of new directives
	my $key  = shift @_;    # directive key
	my $val  = shift @_;    # directive value

	if ( defined $val ) {
		if ( !defined check_directive( $key, $val, 1 ) ) {
			warning( "skip directive $key : " . get_error() );
		}
		else {
			debug("(convert2dir) find option directive $key : $val");
			$rdir->{$key} = $val;
		}
	}
	return;
}
#############################################################
# add content of an environment variable
sub add_env($$$$) {
	my $name      = shift @_;    # env var name
	my $rscan     = shift @_;    # old rules hash
	my $rnewrules = shift @_;    # new rules hash
	my $ralias    = shift @_;    # ref to alias hash

	my $val = $ENV{$name};
	if ($val) {
		debug("(add_env) env $name -> $val");
		my $path_sep;
		my $microsoft = is_microsoft();
		if ($microsoft) {
			$path_sep = q{;};
		}
		else {
			$path_sep = q{:};
		}
		my @tab = split /$path_sep/, $val;
		foreach my $elem (@tab) {

			# relative or absolute path ?
			if ( $microsoft or ( $elem =~ m/^\// ) ) {

				# we have to clean name as for rules
				my $elembis = reg_name($elem);

				# remove trailing slash
				$elembis =~ s{/$}{};

				# absolute path
				my $test = rech_parent( $elembis, $rscan ) || $EMPTY;

				debug("(add_env) $elem ($elembis) parent $test");
				if ($test) {

					# test if enough rules enough ?
					# whe should have at least checksum
					my $old_alias = check_alias( $test, $ralias, 0 );
					if ( ( $old_alias =~ m/1/ ) or ( $old_alias =~ m/5/ ) ) {
						debug(
"(add_env) rule $test ($old_alias) for $elem is enough"
						);
					}
					else {

						# not enough
						warning(
"(add_env) rule $test ($old_alias) for $elem is not enough"
						);
						$rnewrules->{$elembis} = 'all';
						$rscan->{$elembis}     = 'all';
					}
				}
				else {

					# no rules : we have to add it
					warning("(add_env) add rule all for $elem");
					$rnewrules->{$elembis} = 'all';
					$rscan->{$elembis}     = 'all';
				}
			}
			else {

				# relative path
				debug("(add_env) skip $elem : relative path");
			}
		}
	}
	else {
		debug("(add_env) nothing to add from env : $name");
	}
	return;
}
#############################################################
# read a file and convert content to csv, delimited by ':'
sub convert_file($) {
	my $name = shift @_;

	my $list = $EMPTY;
	if ( -r $name ) {
		my $fh;
		if ( open $fh, '<', $name ) {
			my @tab = <$fh>;
			close $fh or warning("can not close $name : $ERRNO");
			chomp @tab;
			$list = join q{:}, @tab;
		}
		else {
			warning("can not open $name : $ERRNO");
		}
	}
	return $list;
}
#############################################################
#                          main
#############################################################

my $default_config_file = get_default_config();

$OUTPUT_AUTOFLUSH = 1;

# variables for parameter analysis
my $configfile;    # config file name
my $opt_help;
my $opt_man;
my $opt_version;
my $opt_print_config;
my $opt_check_config;
my $opt_clean_config;

# parameters for afick
my (
	$archive,            $debug_level,        $ignore_case,
	$report_full_newdel, $history,            $warn_missing_file,
	$running,            $warn_dead_symlinks, $follow_symlinks,
	$allow_overload,     $sufx_list,          $prefx_list,
	$re_list,            $timing,             $database,
	$max_checksum_size,  $addpath,		$addlib,
	#$output_format,
	$report_syslog,
);

Getopt::Long::Configure('no_ignore_case');
if (
	!GetOptions(

		# afickonfig options
		'config_file|c=s' => \$configfile,
		'check_config|C'  => \$opt_check_config,
		'clean_config|G'  => \$opt_clean_config,
		'help|?'          => \$opt_help,
		'man'             => \$opt_man,
		'print_config'    => \$opt_print_config,
		'version|V'       => \$opt_version,
		'verbose'         => \$Verbose,
		'addpath'         => \$addpath,
		'addlib'          => \$addlib,

		# afick options
		'archive=s'             => \$archive,
		'database|D=s'          => \$database,
		'ignore_case|a!'        => \$ignore_case,
		'full_newdel|f!'        => \$report_full_newdel,
		'history|y=s'           => \$history,
		'missing_files|m!'      => \$warn_missing_file,
		'running_files|r!'      => \$running,
		'dead_symlinks|s!'      => \$warn_dead_symlinks,
		'follow_symlinks|Y!'    => \$follow_symlinks,
		'allow_overload|o!'     => \$allow_overload,
		'exclude_suffix|x=s'    => \$sufx_list,
		'exclude_prefix|X=s'    => \$prefx_list,
		'exclude_re|R=s'        => \$re_list,
		'timing|t!'             => \$timing,
		'debug|d=i'             => \$debug_level,
		'max_checksum_size|S=i' => \$max_checksum_size,
		'report_syslog!'        => \$report_syslog,

		#		'output_format|o=s'  => \$output_format,

	)
  )
{
	pod2usage('incorrect option');
}

if ($opt_help) {

	# -h : help
	pod2usage(1);
}
elsif ($opt_version) {

	# -V : version
	version($Version);
	exit;
}
elsif ($opt_man) {
	pod2usage( -verbose => 2 );
}

if ($configfile) {
}
elsif ( -e $default_config_file ) {
	$configfile = $default_config_file;
}
else {
	pod2usage(
"missing configfile name (-c flag) and default config file $default_config_file"
	);
}

# some more controls
if ( !-e $configfile ) {
	die "abort : missing configfile name $configfile\n";
}
elsif ( !-w $configfile ) {
	die "abort : configfile name $configfile is not writable\n";
}

if ($opt_print_config) {
	wrapper( $configfile, '--print_config' );
	exit;
}
elsif ($opt_check_config) {
	wrapper( $configfile, '--check_config' );
	exit;
}
elsif ($opt_clean_config) {
	wrapper( $configfile, '--clean_config' );
	exit;
}

my %newdirectives;

# convert afick like options to %newdirectives
convert2dir( \%newdirectives, 'archive',            $archive );
convert2dir( \%newdirectives, 'database',           $database );
convert2dir( \%newdirectives, 'debug',              $debug_level );
convert2dir( \%newdirectives, 'history',            $history );
convert2dir( \%newdirectives, 'ignore_case',        $ignore_case );
convert2dir( \%newdirectives, 'report_full_newdel', $report_full_newdel );
convert2dir( \%newdirectives, 'running_files',      $running );
convert2dir( \%newdirectives, 'warn_dead_symlinks', $warn_dead_symlinks );
convert2dir( \%newdirectives, 'follow_symlinks',    $follow_symlinks );
convert2dir( \%newdirectives, 'allow_overload',     $allow_overload );
convert2dir( \%newdirectives, 'warn_missing_file',  $warn_missing_file );
convert2dir( \%newdirectives, 'exclude_suffix',     $sufx_list );
convert2dir( \%newdirectives, 'exclude_prefix',     $prefx_list );
convert2dir( \%newdirectives, 'exclude_re',         $re_list );
convert2dir( \%newdirectives, 'timing',             $timing );
convert2dir( \%newdirectives, 'max_checksum_size',  $max_checksum_size );
convert2dir( \%newdirectives, 'report_syslog',      $report_syslog );

# not yet coded
#convert2dir( \%newdirectives, 'output_format', $output_format);

# get old config from, to be able to check new aliases/rules
my %macros;
my %alias = get_default_alias();
my %directive;
my %rules;
my %onlydir;

get_configuration( $configfile, \%macros, \%alias, \%directive, \%rules,
	\%onlydir );

# look at others parameters
my %newmacros;
my %newalias;
my %newrules;
my %newonlydir;

if ($addpath) {

	add_env( 'PATH', \%rules, \%newrules, \%alias );
	if ( is_microsoft() ) {
		add_env( 'systemroot',   \%rules, \%newrules, \%alias );
		add_env( 'ProgramFiles', \%rules, \%newrules, \%alias );
	}
}
if ($addlib) {
	add_env( 'SHLIB_PATH',      \%rules, \%newrules, \%alias );
	add_env( 'LD_LIBRARY_PATH', \%rules, \%newrules, \%alias );

	# save old value if exists
	my $save = $ENV{'AFICKONFIG_TMP'};

	if ( !is_microsoft() ) {

		# add the defaults lib dir /lib and /usr/lib
		$ENV{'AFICKONFIG_TMP'} = '/lib:/usr/lib';
		add_env( 'AFICKONFIG_TMP', \%rules, \%newrules, \%alias );

		if ( is_linux() ) {

			# add contents of /etc/ld.so.conf config file
			$ENV{'AFICKONFIG_TMP'} = convert_file('/etc/ld.so.conf');
			add_env( 'AFICKONFIG_TMP', \%rules, \%newrules, \%alias );
		}
	}

	# restore value
	$ENV{'AFICKONFIG_TMP'} = $save if ($save);
}

foreach my $elem (@ARGV) {
	remove_trailing_spaces( \$elem );

	my @ret = ();
	## no critic (ProhibitCascadingIfElse)
	if ( @ret = is_macro($elem) ) {

		# macros
		my $key = shift @ret;
		my $val = shift @ret;

		if ( !defined check_macro( $key, $val, 1 ) ) {
			warning( "skip macro $elem : " . get_error() );
		}
		else {
			$newmacros{$key} = $val;
		}
	}
	elsif ( @ret = is_directive($elem) ) {

		# directives
		# another way to set directives
		my $key = shift @ret;
		my $val = shift @ret;

		if ( !defined check_directive( $key, $val, 1 ) ) {
			warning( "skip directive $elem : " . get_error() );
		}
		else {
			debug("find directive $key : $val");
			$newdirectives{$key} = $val;
		}
	}
	elsif ( @ret = is_alias($elem) ) {

		# alias
		my $key = shift @ret;
		my $val = shift @ret;

		# we do not try to resolv aliases, because it can depends
		# on config file definitions
		if ( !defined check_alias( $val, \%alias, 1 ) ) {
			warning( "skip alias $elem : " . get_error() );
		}
		else {
			debug("find alias $key : $val");
			$newalias{$key} = $val;

			# add in alias list to allow a rule to use it
			$alias{$key} = $val;
		}
	}
	elsif ( @ret = is_negsel($elem) ) {

		# negative option
		my $key = shift @ret;
		if ( !is_anyfile($key) ) {
			warning( "skip rule $elem : " . get_error() );
		}
		else {
			$newrules{$key} = undef;
		}
	}
	elsif ( @ret = is_equalsel($elem) ) {

		# only dir option
		my $name = shift @ret;
		my $attribute = shift @ret || $EMPTY;

		# do not check resolv globbing
		# just check attribute syntax
		if ( !defined check_alias( $attribute, \%alias, 1 ) ) {
			warning( "skip rule $elem : " . get_error() );
		}
		else {
			debug("find rule $name : $attribute");
			$newrules{$name}   = $attribute;
			$newonlydir{$name} = 1;
		}
	}
	elsif ( @ret = is_sel($elem) ) {

		# classic selection
		my $name = shift @ret;
		my $attribute = shift @ret || $EMPTY;

		# do not check resolv globbing
		# just check attribute syntax
		if ( !defined check_alias( $attribute, \%alias, 1 ) ) {
			warning( "skip rule $elem : " . get_error() );
		}
		else {
			debug("find rule $name : $attribute");
			$newrules{$name} = $attribute;
		}
	}
	else {
		warning("unknown element $elem (ignored)");
	}
	## use critic
}

my $return_value = change_config(
	$configfile, \%newdirectives, \%newmacros,
	\%newalias,  \%newrules,      \%newonlydir
);

# control
wrapper( $configfile, '--check_config', '--debug', 0 );

exit $return_value;
## no critic (UnreachableCode);

__END__

=head1 NAME

afickonfig - a tool to manage Afick's config files

=head1 DESCRIPTION

C<afickonfig> is to change parameters in afick's config file, in a batch way.
It can add, replace, remove any components (macro, alias, directives, rules)
It was designed to work with same options names as afick (directives).

Note : in the current version, it can checks some arguments syntax before applying,

The idea came from the "postconf" utility from postfix.

=head1 SYNOPSIS

afickonfig.pl  [L<options|options>] [L<action|actions>] [L<macros|macros>] [L<alias|alias>] [L<directives|directives>] [L<rules|rules>]

afick use posix syntax, which allow many possibilities :

=over 4

=item *
long (--) options

=item *
short (-) options

=item *
negative (--no) options

=back

=head1 REQUIRED ARGUMENTS

=head1 OPTIONS

options are used to control afickconfig

=over 4

=item B<--config_file|-c configfile>

read the configuration in config file named "configfile".

=item B<--check_config|-C>

only check config file syntax and exit with the number of errors

=item B<--clean_config|-G>

check config file syntax, clean bad line, and exit with the number of errors

=item B<--help|-?>

Output summary help information and exit.

=item B<--man>

Output full help information and exit.

=item B<--print_config>

display internals variables after arguments and config file parsing (for debugging purposes)

=item B<--version|-V>

Output version information and exit.

=item B<--verbose|-v>

add debugging messages

=back

=head1 ACTIONS

actions are used to change afick's configuration

=over 4

=item B<--allow_overload,(--noallow_overload)>

if set, allow rule overload (the last rule wins), else put a warning and keep the first rule.

=item B<--archive|-A directory>

write reports to "directory".

=item B<--database|-D name>

select the database named "name".

=item B<--debug|-d level>

set a level of debugging messages, from 0 (none) to 3 (full)

=item B<--full_newdel|-f,(--nofull_newdel)>

(do not) report full information on new and deleted directories.

=item B<--history|-y historyfile>

write session status to history file

=item B<--ignore_case|-a>

ignore case for file names. Can be helpful on Windows platforms, but is dangerous on Unix ones.

=item B<--missing_files|-m,(--nomissing_files)>

(do not) warn about files declared in config files which does not exists.

=item B<--max_checksum_size|-S size>

fix a maximum size (bytes) for checksum. on bigger files, compute checksum only on first 'size' bytes.
(0 means no limit)

=item B<--dead_symlinks|-s,(--nodead_symlinks)>

(do not) warn about dead symlinks.

=item B<--follow_symlinks,(--nofollow_symlinks)>

if set, do checksum on target file, else do checksum on target file name.

=item B<--running_files|-r,(--norunning_files)>

(do not) warn about "running" files : modified since program begin.

=item B<--timing|-t,(--notiming)>

(do not) Print timing statistics.

=item B<--exclude_suffix|-x "ext1 ext2 ... extn">

list of suffixes (files/directories ending in .ext1 or .ext2 ...) to ignore.

=item B<--exclude_prefix|-X "pre1 pre2 ... pren">

list of prefix (files/directories beginning with pre1 or pre2 ...) to ignore.

=item B<--exclude_re|-R "pat1 pat2 ... patn">

list of patterns (regular expressions) to ignore files or directories

=back

=head1 MACROS

macros are to be set in afick configuration format (see afick.conf(5)) : C< '@@define macro value'>

=head1 ALIAS

aliases are to be set in afick configuration format (see afick.conf(5)) : C<'newrule = attributes'>

=head1 DIRECTIVES

directives are to be set in afick configuration format (see afick.conf(5)) : C<'directive := value'>

=head1 RULES

rules are to be set in afick configuration format (see afick.conf(5)) : C<'file alias'>

you can also use

=over 4

=item --addpath

add PATH directories to rules

=item --addlib

add libraries directories to rules (linux)

=back

=head1 FILES

if no config file on command line, afick try to open F</etc/afick.conf> (Unix) or F<windows.conf> (Windows) as
default config

for config file syntax see afick.conf(5)

=head1 USE

afickonfig may

=over 4

=item change a config

if it can find an old config

=item add a config

if it does not find a previous value

=item remove a config

you just have to specify a parameter without any value. the old line is commented

=back

=head1 USAGE

To use this program, you must just run it with same afick command line options :

C<afickonfig.pl -c afick.conf --timing --norunnig_files --debug=1 --archive=afick_archive>

or the same in configuration file syntax :

C<afickonfig.pl -c afick.conf 'timing := 1' ' running_files := no' 'debug:=1 'archive:=afick_archive'>

and a mix of all types

C<afickonfig.pl -c afick.conf --timing 'debug:=1' '@@define BATCH 0' 'newrule = p+u+g' '/tmp newrule'>

remove lines

C<afickonfig -c afick.conf 'debug:=' '@@define BATCH' 'newrule=' '/tmp'>

=head1 NOTES

this program only use perl and its standard modules.

=head1 SEE ALSO

=for html
<a href="afick.conf.5.html">afick.conf(5)</a> for the configuration file syntax
<a href="afick-tk.1.html">afick-tk(1)</a> for the graphical interface
<a href="afick.1.html">afick(1)</a> for the command-line interface
<a href="afick_archive.1.html">afick_archive(1)</a> for a tool to manage archive's reports

=for man
\fIafick.conf\fR\|(5) for the configuration file syntax
.PP
\fIafick\-tk\fR\|(1) for the graphical interface
.PP
\fIafick\fR\|(1) for the command-line interface
.PP
\fIafick_archive\fR\|(1) for a tool to manage archive's reports

=head1 DIAGNOSTICS

all warnings go to stderr

=head1 EXIT STATUS

The exit status is the number of real changes

=head1 CONFIGURATION

no specific configuration file

=head1 DEPENDENCIES

perl

=head1 INCOMPATIBILITIES

(none)

=head1 BUGS AND LIMITATIONS

(none known)

=head1 LICENSE AND COPYRIGHT

Copyright (c) 2002 Eric Gerbier
All rights reserved.

This program 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.

=head1 AUTHOR

Eric Gerbier

you can report any bug or suggest to gerbier@users.sourceforge.net
