#!/usr/bin/perl -w
########################################################
#
# This script is intended to provide a means for
# detecting changes made to files, via a regular
# comparison of MD5 hashes and others properties
# to an established "database".
# In this respect, it is designed as a portable clone
# of tripwire or aide softwares.
#
# This script requires perl ,and some others perl modules
# which come in standard installation
#
###############################################################################
#    Copyright (C) 2002-2004 by Eric Gerbier
#    Bug reports to: gerbier@users.sourceforge.net
#    $Id: afick.pl,v 1.81 2005/01/06 15:27:10 gerbier Exp $
#
#    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.
#
###############################################################################
# I use special naming for references :
# $r_name : for a ref to scalar
# $rh_name : for a ref to hashes
# $ra_name : for a ref to array

# global var begin with an uppercase
###############################################################################
#                         perl modules
###############################################################################

use strict;
use diagnostics;

#use Data::Dumper;

use Carp qw(cluck);    # for debugging
use Digest::MD5;       # for md5 checksum

# !! can also use Digest::SHA1 if exists: see below

use POSIX qw(:sys_stat_h strftime);    # for file type macros and date

use SDBM_File;                         # database
use FileHandle;                        # for database open mode
use Getopt::Long;                      # arg analysis
use Cwd 'abs_path';                    # convert to absolute path

use File::Glob ':glob';                # for jokers
use File::Basename;                    # for delete

# !!! Win32::FileSecurity is used too (on windows)

my $dirname = dirname($0);
require $dirname . '/afick-common.pl';

###############################################################################
#                     global variables
###############################################################################
# almost all begin with a first upper-case character

my $Version = '2.6-1';

my $Dbm = 'SDBM_File';    # database type

use vars
  qw (%Finded %Hashfile %Newfiles %Dangling %Toscan %Onlydir %Onlythis %Oldval %Newval %Macros %Aliases %Rules %Directives);
%Finded   = ();           # list of scanned files
%Hashfile = ();           # hash-table tied to database
%Newfiles = ();           # list of new files
%Dangling = ();           # dangling links
%Toscan   = ();           # list of files to scan
%Onlydir  = ();           # only this and content, without sub-dir
%Onlythis = ();           # only this inode
%Oldval   = ();           # store old values
%Newval   = ();           # store new changes values

%Macros     = ();         # hash-table of macros
%Aliases    = ();         # hash-table of alias
%Rules      = ();         # hash-table of rules
%Directives = ();

use vars qw ( $Nbmod  $Update $File);
$Nbmod  = 0;              # number of modifications
$Update = 0;              # distinguish update (1) and compare mode (0)
$File   = 0;              # distinguish file mode (1) from update/compare (0)

# directives status
# not initialized to be able to detect negative command lines
use vars
  qw ($Verbose $Warn_dead_symlinks $Report_full_newdel $Warn_missing_file $Report_url
  $Progress $Timing $Running $Ignore_case $History $Archive
  $Output_format $Debug_level $Database $Max_checksum_size
  $Sufx $Prefx $Exclude_re
);

# $Verbose = undef;           	# verbose mode ?
# $Warn_dead_symlinks = undef;  # warn_dead_symlink ?
# $Report_full_newdel = undef;	# report new and del directories contents ?
# $Warn_missing_file  = undef;  # report about files in configuration file, but not installed ?
# $Progress           = undef;  # show progress (for use with tk interface) ?
# $Timing             = undef;  # show cpu statistics ?
# $Running            = undef;  # show changed files during scan ?
# $Ignore_case;       = undef;  # ignore case ?
# $History;           = undef;  # path to history file
# $Output_format      = undef;  # not yet used
# $Debug_level        = undef;  # debuging level from 0 (none) to 3 (full)
# $Database           = undef;	# database name
# $Max_checksum_size  = undef;	# max file size for a complete checksum
# $Sufx		      = undef;	# list of suffix to exclude
# $Prefx	      = undef;	# list of prefix to exclude
# $Exclude_re	      = undef;	# list of regular expression to exclude

# patterns for exclude
my $SufxPat  = '';
my $PrefxPat = '';
my $ExRePat  = '';

# a glob to store a file descriptor
my $Archive_df;

# alias table
# contains pre-defined values
my %Alias = get_default_alias();

my $Acl_exist;    # flag on Win32 perl module
my @Date;         # date of begin

my $Database_ext = '.pag';    # database extension
my $Control_ext  = '.ctr';    # database control file

my $Default_alias = 'all';

# index hash for internal info
my %Id = (
	'md5'       => 0,
	'sha1'      => 0,         # same place as md5
	'device'    => 1,
	'inode'     => 2,
	'file_mode' => 3,
	'links'     => 4,
	'uid'       => 5,
	'acl'       => 6,         # acl data are same than gid
	'gid'       => 6,
	'filesize'  => 7,
	'blocs'     => 8,
	'atime'     => 9,
	'mtime'     => 10,
	'ctime'     => 11
);

# array of field names
my @Field = (
	'checksum  ',             # 0
	'device    ',             # 1
	'inode     ',             # 2
	'file mode ',             # 3
	'links     ',             # 4
	'uid       ',             # 5
	'gid       ',             # 6
	'filesize  ',             # 7
	'blocs     ',             # 8
	'atime     ',             # 9
	'mtime     ',             # 10
	'ctime     '              # 11
);

# database internal separator
my $Sep     = '|';                # for join
my $Sepmeta = quotemeta($Sep);    # for split

my $Sepacl = ',';                 # for windows acl

my $Comment = '#';                # comment non-changes lines

# counters for excluded files/dir
my $Nb_exclude_sufx  = 0;
my $Nb_exclude_prefx = 0;
my $Nb_exclude_re    = 0;
my $Nb_degraded      = 0;
###############################################################################
#                    default parameter config
###############################################################################
sub get_report_url() {
	return $Report_url || 'STDOUT';
}

#######################################################
sub get_debug_level() {
	return $Debug_level || 0;
}
#######################################################
sub get_exclude_sufx() {
	return $Sufx || '';
}
#######################################################
sub get_exclude_prefx() {
	return $Prefx || '';
}
###############################################################################
sub get_exclude_re() {
	return $Exclude_re || '';
}
###############################################################################
#                     subroutines
###############################################################################
# a general low-level methode to access database data
sub get_data($$) {

	my $name  = shift(@_);    # file name
	my $field = shift(@_);    # field name

	my $hash = $Hashfile{$name} || $Newval{$name} || '';
	my @tab = split( /$Sepmeta/, $hash );
	return $tab[ $Id{$field} ];
}
#######################################################
# get checksum from database
sub get_md5 ($) {
	my $name = shift(@_);     # file name

	return get_data( $name, 'md5' );
}
#######################################################
# get inode date from database
sub get_ctime ($) {
	my $name = shift(@_);     # file name

	return get_data( $name, 'ctime' ) || 0;
}
#######################################################
# get inode date from database
sub get_mtime ($) {
	my $name = shift(@_);     # file name

	return get_data( $name, 'mtime' ) || 0;
}
#######################################################
# return true if a socket
# same format as posix macros
sub S_IFSOCK($) {
	my $p = shift(@_);

	# see sys/stat.h
	my $S_IFSOCK = 0140000;

	return ( ( $p & $S_IFSOCK ) == $S_IFSOCK );
}
#######################################################
# return true if a link
# same format as posix macros
sub S_IFLNK($) {
	my $p = shift(@_);

	# see sys/stat.h
	my $S_IFLNK = 0120000;

	return ( ( $p & $S_IFLNK ) == $S_IFLNK );
}
#######################################################
# get file_type from database
sub file_type ($) {
	my $name = shift(@_);    # file name

	# $Hashfile for changed file
	# Newval in compare mode for new files
	my $hash;
	if ( exists $Hashfile{$name} ) {
		$hash = $Hashfile{$name};
	}
	elsif ( exists $Newval{$name} ) {
		$hash = $Newval{$name};
	}
	else {
		warning("file_type problem on $name\n");
		return 'unknown_type';
	}

	my @tab = split( /$Sepmeta/, $hash );
	my $perm = $tab[ $Id{'file_mode'} ] || 0;

	# now use POSIX macro if exists
	# else my own sub  S_IFLNK S_IFSOCK

	my $type;

	# order of test is important for the first test !
	if ( S_IFSOCK($perm) ) {
		$type = 'socket';
	}
	elsif ( S_IFLNK($perm) ) {
		$type = 'symbolic_link';
	}
	elsif ( S_ISREG($perm) ) {
		$type = 'file';
	}
	elsif ( S_ISBLK($perm) ) {
		$type = 'block_device';
	}
	elsif ( S_ISDIR($perm) ) {
		$type = 'directory';
	}
	elsif ( S_ISCHR($perm) ) {
		$type = 'character_device';
	}
	elsif ( S_ISFIFO($perm) ) {
		$type = 'fifo';
	}
	else {
		$type = 'unknown_type';
	}
	return $type;
}
#######################################################
# low-level sub to send "normal" messages
sub report($) {
	my $text = $_[0];

	no strict 'refs';
	my $url = get_report_url();
	print $url $text if ( $url ne 'null' );
	print $Archive_df $text if ( ($Archive_df) and ( $text !~ m/^progress/ ) );
}
#######################################################
# high-level sub for summary messages
sub report_summary($$) {
	my $type     = shift(@_);    # new, change, deleted, dangling ...
	my $filename = shift(@_);    # file name

	my $filetype = file_type($filename);

	report("$type $filetype : $filename\n");
}
#######################################################
# high-level sub for detailed messages
sub report_detailed($$;$) {
	my $field = shift(@_);       # field name
	my $val1  = shift(@_);       # old value
	my $val2  = shift(@_);       # new value (optionnal)

	report("\t$field\t\t : $val1");
	if ( defined $val2 ) {
		report("\t$val2\n");
	}
	else {
		report("\n");
	}
}
#######################################################
# print a commented line
sub info($) {
	report("$Comment @_");
}
#######################################################
# for progress purpose
sub progress($) {
	report("progress @_\n");
}
#######################################################
# for debug purpose
sub debug($;$) {
	my $txt   = shift(@_);
	my $level = shift(@_) || 3;

	report("DEBUG$level: $txt")
	  if ( ($Verbose) or ( $level <= get_debug_level() ) );
}
#######################################################
sub warning($) {
	my $text = shift(@_);

	warn "WARNING: $text";
	print $Archive_df "WARNING: $text" if ($Archive_df);
}
#######################################################
sub history($) {
	my $txt = shift(@_);
	chomp($txt);

	if ($History) {

		# add a summary on history file
		if ( open( HIST, '>>', $History ) ) {
			print HIST strftime( "%Y/%m/%d %H:%M:%S", @Date ) . "  $txt\n";
		}
		else {
			warning("can not write to $History history file\n");
		}
		close(HIST);
	}
}
#######################################################
# print run conditions
sub print_env ($) {
	my $action = shift(@_);

	info(   "Afick ($Version) $action at "
		  . strftime( "%Y/%m/%d %H:%M:%S", @Date )
		  . " with options :\n" );
	info("database:=$Database history:=$History archive:=$Archive\n");
	info(   "report_url:="
		  . get_report_url()
		  . " verbose:=$Verbose debug:="
		  . get_debug_level()
		  . "\n" );
	info(
"warn_dead_symlinks:=$Warn_dead_symlinks report_full_newdel:=$Report_full_newdel warn_missing_file:=$Warn_missing_file\n"
	);
	info("ignore_case:=$Ignore_case running_files:=$Running timing:=$Timing\n");
	info( 'exclude_suffix:=' . get_exclude_sufx() . "\n" );
	info( 'exclude_prefix:=' . get_exclude_prefx() . "\n" );
	info( 'exclude_re=' . get_exclude_re() . "\n" );
	info("max_checksum_size:=$Max_checksum_size\n");

	#	info ( "output_format=$Output_format\n" );
}
#######################################################
# print last run date and version
sub print_last($$) {
	my $run_date    = shift(@_);
	my $old_version = shift(@_);

	if ( defined($run_date) ) {
		info(   'last run on '
			  . localtime($run_date)
			  . ' with afick version '
			  . $old_version
			  . "\n" );
	}
}
#######################################################
# test_double
# to detect bad configuration
sub test_double($) {
	my $elem = shift(@_);

	return exists $Toscan{$elem};
}
#######################################################
# exclude code
# I do not like code duplication (prefix, suffix, regular)
# but I search performance (/o flag on test)
# so there is (bad) ways :
# - a low-level test_exclude sub with common code (see below
#--------------------------------------------------
# sub test_exclude($$$$) {
# 	my $fic        = shift(@_);    # file name
# 	my $pattern    = shift(@_);    # regular expression
# 	my $r_compteur = shift(@_);    # counter for stats
# 	my $text       = shift(@_);    # text for debug
#
# 	if ( ($pattern) and ( $fic =~ m/$pattern/ ) ) {
# 		debug( "find excluded $text ($1) in $fic\n", 2 );
# 		$$r_compteur++;
# 		return 1;
# 	}
# 	else {
# 		return 0;
# 	}
# }
# #######################################################
# # used to exclude suffixes
# sub test_exclude_suffix($) {
# 	my $fic = shift(@_);
#
# 	return test_exclude( $fic, $SufxPat, \$Nb_exclude_sufx, 'suffixe' );
# }
# #######################################################
# # used to exclude prefixes
# sub test_exclude_prefix($) {
# 	my $fic = shift(@_);
#
# 	return test_exclude( $fic, $PrefxPat, \$Nb_exclude_prefx, 'prefix' );
# }
# #######################################################
# sub test_exclude_re($) {
# 	my $fic = shift(@_);
#
# 	return test_exclude( $fic, $ExRePat, \$Nb_exclude_re, 'regular' );
# }
#--------------------------------------------------
# which is nice to see, but slow (impossible to use /o flag :(
# - and to have only one test with all pattern (join all excludes)
# , but file arg is not the same (full path or not), because of prefix/regular
# - 3 subs with a lot of common code :(, but quick
# note : 'advanced perl programming' book gives a tips with code eval
# but it is here impossible to use
#--------------------------------------------------
#######################################################
# used to exclude suffixes
sub test_exclude_suffix($) {
	my $fic = shift(@_);

	if ( ($SufxPat) and ( $fic =~ m/$SufxPat/o ) ) {
		debug( "find excluded suffix ($1) in $fic\n", 2 );
		$Nb_exclude_sufx++;
		return 1;
	}
	else {
		return 0;
	}
}
#######################################################
# used to exclude prefixes
sub test_exclude_prefix($) {
	my $fic = shift(@_);

	if ( ($PrefxPat) and ( $fic =~ m/$PrefxPat/o ) ) {
		debug( "find excluded prefix ($1) in $fic\n", 2 );
		$Nb_exclude_prefx++;
		return 1;
	}
	else {
		return 0;
	}
}
#######################################################
# used to exclude prefixes
sub test_exclude_re($) {
	my $fic = shift(@_);

	if ( ($ExRePat) and ( $fic =~ m/$ExRePat/o ) ) {
		debug( "find excluded regular ($1) in $fic\n", 2 );
		$Nb_exclude_re++;
		return 1;
	}
	else {
		return 0;
	}
}
#######################################################
# expand_line
# expand config line : treat jokers, and split into <file attribute flagdir>
sub trait_line ($$) {
	my $name      = shift(@_);
	my $attribute = shift(@_);

	# if ignore_case change all names
	$name = lc($name) if ($Ignore_case);

	# for compatibilite with old syntaxe
	$attribute = $Default_alias if ( !$attribute );

	# debug("$name -> $attribute", 1);

	my @tab;
	my $flagdir;

	# expand jokers if exists
	if ( $name =~ m/[\*\?]/ ) {
		@tab = glob($name);
		debug( "expand $name in @tab\n", 2 );
	}
	elsif ( $name eq '/' ) {
		$flagdir = 1;
		push( @tab, $name );
	}
	elsif ( $name =~ m?/$? ) {

		# remove trailing /
		$name =~ s?/$??;
		$flagdir = 1;
		push( @tab, $name );
	}
	else {
		$flagdir = 0;
		push( @tab, $name );
	}
	push( @tab, $attribute, $flagdir );
	return @tab;
}
#######################################################
#resolv_alias
# expand and resolv action pattern, for alias definitions and files config
# be careful : not recursif
#sub resolv_alias($$$$) {
#	my $alias = shift(@_);    # hash_table of all aliases
#	my $nline = shift(@_);    # line number in config file
#	my $val   = shift(@_);    # value to resolve
#	my $nb_pb = shift(@_);    # number of problems in config file parsing
#
#	my $realval = '';
#
#	remove_all_spaces( \$val );
#
#	$val =~ m/^([^+-]*)/;     # first motif before any +/-
#	my $first_alias = $1;
#	debug( 2, "resolv $val first alias : $first_alias\n" );
#	if ( !exists $alias->{$first_alias} ) {
#
#		# error : pattern not found
#		warning(
#"error in config file (line $nline : $val) : first alias \"$first_alias\" can not be resolved (ignored)\n"
#		);
#		$$nb_pb++;
#	}
#	else {
#		$realval = $alias->{$first_alias};
#	}
#
#	# then other flags
#	# first negative ones
#	while ( $val =~ m/-([^+-]*)/g ) {
#		my $remov_alias = $1;
#		debug( 2, "soustractive alias $remov_alias\n" );
#		if ( !exists $alias->{$remov_alias} ) {
#
#			# remove bad aliases
#			warning(
#"error in config file (line $nline : $val) :  soustractive alias \"$remov_alias\" can not be resolved (ignored)\n"
#			);
#			$$nb_pb++;
#		}
#		else {
#			$realval =~ s/$alias->{$remov_alias}//;
#		}
#	}
#
#	# then additives ones
#	while ( $val =~ m/\+([^+-]*)/g ) {
#		my $add_alias = $1;
#		debug( 2, "additive alias $add_alias\n" );
#		if ( !exists $alias->{$add_alias} ) {
#
#			# remove bad aliases
#			warning(
#"error in config file (line $nline : $val) : additive alias \"$add_alias\" can not be resolved (ignored)\n"
#			);
#			$$nb_pb++;
#			next;
#		}
#		elsif ( $realval =~ m/$alias->{$add_alias}/ ) {
#
#			# do not allow duplicates
#			warning(
#"error in config file (line $nline : $val) : duplicate alias $add_alias in $realval\n"
#			);
#			$$nb_pb++;
#		}
#		else {
#			$realval .= $alias->{$add_alias};
#		}
#	}
#
#	if ( !$realval ) {
#		$realval = $alias->{$Default_alias};
#		warning(
#"set to default pattern \"$Default_alias\" in config line line $nline\n"
#		);
#		$$nb_pb++;
#	}
#
#	# test for optionnal sha1
#	if ( $realval =~ m/1/ ) {
#		if ($Sha1_exist) {
#
#			# sha1 take place of md5
#			if ( $realval =~ s/5// ) {
#				warning(
#"can not use sha1 and md5 (line $nline : $val) : keep sha1\n"
#				);
#				$$nb_pb++;
#			}
#		}
#		else {
#			warning(
#"sha1 is not installed, will be replaced by md5 checksum on config file (line $nline : $val)\n"
#			);
#			$$nb_pb++;
#
#			# a test to avoid duplicate
#			if ( $realval !~ m/5/ ) {
#				$realval =~ s/1/5/;
#			}
#		}
#	}
#
#	return $realval;
#}
#######################################################
# get_names
# used by auto_control to know which program names to control
sub get_names() {
	my ( $name, $path, undef ) = fileparse($0);

	$path = abs_path($path) . '/';    # convert in absolute path

	my @list;

	# because of links from afick.pl to afick
	my $afick = $path . 'afick.pl';
	if ( -x $afick ) {
		push( @list, $afick );
	}
	else {
		push( @list, $path . $name );
	}

	my $aficktk = $path . 'afick-tk.pl';

	# is afick-tk installed ?
	if ( -x $aficktk ) {
		push( @list, $aficktk );
	}

	return @list;
}
#######################################################
# check if config line directive is overloaded by command line option
sub check_overload($$$$$) {
	my $key     = shift(@_);    # directive name
	my $val     = shift(@_);    # associated value in config file
	my $line    = shift(@_);    # config file line string
	my $line_id = shift(@_);    # config line number
	my $rh_call = shift(@_);    # ref to hash to know if first call

	debug( "check_overload $key\n", 3 );

	my %h_overload = (
		database           => \$Database,
		verbose            => \$Verbose,
		warn_dead_symlinks => \$Warn_dead_symlinks,
		report_full_newdel => \$Report_full_newdel,
		warn_missing_file  => \$Warn_missing_file,
		report_url         => \$Report_url,
		exclude_suffix     => \$Sufx,
		exclude_prefix     => \$Prefx,
		exclude_re         => \$Exclude_re,
		timing             => \$Timing,
		ignore_case        => \$Ignore_case,
		history            => \$History,
		running_files      => \$Running,
		archive            => \$Archive,
		debug              => \$Debug_level,
		max_checksum_size  => \$Max_checksum_size
	);

	return unless ( exists $h_overload{$key} );
	my $option = ${ $h_overload{$key} };

	if ( $key =~ m/^exclude/ ) {

		# this directives allow multi-line !!
		debug( "exclude call " . $rh_call->{$key} . "\n", 2 );

		#first call :
		if ( ( $rh_call->{$key} ) and ( defined $option ) ) {
			debug(
"check_overload ignore $line (line $line_id) : overload by command line option ($option)\n",
				2
			);
		}
		else {

			# add new lines
			debug( "check_overload add new $key : $val\n", 2 );
			${ $h_overload{$key} } .= " $val";

			# set to false for next lines
			$rh_call->{$key} = 0;
		}
	}
	else {
		if ( !defined $option ) {
			debug( "check_overload found directive $key : $val\n", 2 );
			${ $h_overload{$key} } = $val;
		}
		else {
			debug(
"check_overload ignore $line (line $line_id) : overload by command line option ($option)\n",
				2
			);
		}
	}
}
#######################################################
# read_configuration :
# read the config file to build a list of directory to scan
sub read_configuration($$$$) {
	my $configfile = shift(@_);    # config file name
	my $rh_alias   = shift(@_);
	my $r_nb_pbs   = shift(@_);    # ref to number of problems
	my $clean      = shift(@_);    # boolean to

	debug( "read_configuration $configfile\n", 3 );

	# some hash to detect multiple lines
	my %h_m_macro;
	my %h_m_directive;
	my %h_m_alias;
	my %h_m_rule;

	# this list may seems to be a duplicate for Toscan
	# but is necessary to keep the config file order
	my @liste_toscan;

	debug( "-------- begin of config file -------------\n", 1 );

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

	my $line_id = 0;
	foreach my $line (@config) {
		$line_id++;
		chomp $line;

		$line =~ s/#.*//;    # skip comments
		                     #remove_trailing_spaces( \$line );
		next unless length($line);    # skip blank lines

		# replace \ by / (for windows), but just on files (selection lines)
		# because exclude_re can use \x patterns
		my $linebis = $line;
		$linebis =~ s?\\?/?g;

		#debug( "config line = $line\n", 1);

		my @ret;
		if ( @ret = is_macro($line) ) {

			debug( "detect macro line $line\n", 3 );

			# macros lines
			###################
			my $key = shift(@ret);
			my $val = shift(@ret);

			if (   ( !defined check_macro( $key, $val, 0 ) )
				or ( check_duplicate( $key, \%h_m_macro ) ) )
			{
				if ($clean) {
					$line = '# ' . $line;
					$config[ $line_id - 1 ] = $line;
					warning(
"fix bad config file $line (line $line_id), macro $key : "
						  . get_error() );
				}
				else {
					warning(
"skipped config file $line (line $line_id), macro $key : "
						  . get_error() );
				}
				$$r_nb_pbs++;
				next;
			}
			debug( "found macro $key : $val\n", 2 );

			# add to Macro for print_config
			$Macros{$key} = $val;
		}
		elsif ( @ret = is_directive($line) ) {
			debug( "detect directive line $line\n", 3 );

			# a configuration line
			######################
			my $key = shift(@ret);
			my $val = shift(@ret);
			remove_trailing_spaces( \$val );

			my $ret2 = check_directive( $key, $val, 0 );
			if (   ( !defined $ret2 )
				or ( check_duplicate( $key, \%h_m_directive ) ) )
			{
				if ($clean) {
					$line = '# ' . $line;
					$config[ $line_id - 1 ] = $line;
					warning(
"fix bad config file $line (line $line_id), directive $key : "
						  . get_error() );
				}
				else {
					warning(
"skipped config file $line (line $line_id), directive $key : "
						  . get_error() );
				}
				$$r_nb_pbs++;
				next;
			}
			check_overload( $key, $ret2, $line, $line_id, \%h_m_directive );
		}
		elsif ( @ret = is_alias($line) ) {
			debug( "detect alias line $line\n", 3 );

			# is an alias definition
			########################
			my $key = shift(@ret);
			my $val = shift(@ret);
			remove_all_spaces( \$val );

			my $decoded = check_alias( $val, $rh_alias, 0 );
			if (   ( !defined $decoded )
				or ( check_duplicate( $key, \%h_m_alias ) ) )
			{
				if ($clean) {
					$line = '# ' . $line;
					$config[ $line_id - 1 ] = $line;
					warning(
"fix bad config file $line (line $line_id), alias $key : "
						  . get_error() );
				}
				else {
					warning(
"skipped config file $line (line $line_id), alias $key : "
						  . get_error() );
				}
				$$r_nb_pbs++;
				next;
			}

			$rh_alias->{$key} = $decoded;

			# for print_config
			$Aliases{$key} = $val;

			debug( "alias $key -> $decoded\n", 2 );
		}
		elsif ( @ret = is_negsel($linebis) ) {
			debug( "detect negative rule line $line\n", 3 );

			# begin with ! : it is an exception
			###################################

			my @tab     = trait_line( shift(@ret), shift(@ret) );
			my $flagdir = pop(@tab);                                # and ignore
			my $masq    = pop(@tab);                                # and ignore
			foreach my $elem (@tab) {
				if ( test_double($elem) ) {
					warning(
"skipped config file $line (line $line_id : exception $elem already seen in config file\n"
					);
					$$r_nb_pbs++;
				}
				else {
					debug( "exception : $elem\n", 2 );
					$Toscan{$elem} = 0;
				}
			}
		}
		elsif ( @ret = is_equalsel($linebis) ) {
			debug( "detect equal rule line $line\n", 3 );

			# begin with a = : a directory to scan without recurse
			######################################################

			my @tab = trait_line( shift(@ret), shift(@ret) );
			my $flagdir = pop(@tab);
			my $masqb = pop(@tab);    # brut alias line

			my $masq = check_alias( $masqb, $rh_alias, 0 );
			if ( !defined $masq ) {
				if ($clean) {
					$line = '# ' . $line;
					$config[ $line_id - 1 ] = $line;
					warning( "fix bad config file $line (line $line_id), "
						  . get_error() );
				}
				else {
					warning( "skipped config file $line (line $line_id), "
						  . get_error() );
				}
				$$r_nb_pbs++;
				next;
			}

			foreach my $elem (@tab) {
				if ( test_double($elem) ) {
					warning(
"skipped config file $line (line $line_id : $elem already in config file\n"
					);
				}
				elsif ( is_directory($elem) ) {
					push( @liste_toscan, $elem ) unless ($File);
					$Toscan{$elem} = $masq;
					$Rules{$elem}  = $masqb;
					if ($flagdir) {
						$Onlydir{$elem} = 1;
						debug( "toscan without sub-dir : $elem masq $masq\n",
							2 );
					}
					else {
						$Onlythis{$elem} = 1;
						debug( "toscan only this inode : $elem masq $masq\n",
							2 );
					}
				}
				else {
					warning("skipped config file $line (line $line_id : "
						  . get_error()
						  . "\n" );
					$$r_nb_pbs++;
				}
			}    # foreach my $elem
		}
		elsif ( @ret = is_sel($linebis) ) {
			debug( "detect rule line $line\n", 3 );

			# directory or file to scan
			###########################
			my @tab = trait_line( shift(@ret), shift(@ret) );
			my $flagdir = pop(@tab);    # to be ignored
			my $masqb = pop(@tab);    # brut alias line

			my $masq = check_alias( $masqb, $rh_alias, 0 );
			if ( !defined $masq ) {
				if ($clean) {
					$line = '# ' . $line;
					$config[ $line_id - 1 ] = $line;
					warning( "fix bad config file $line (line $line_id), "
						  . get_error() );
				}
				else {
					warning( "skipped config file $line (line $line_id), "
						  . get_error() );
				}
				$$r_nb_pbs++;
				next;
			}

			foreach my $elem (@tab) {
				if ( test_double($elem) ) {
					warning(
"skipped config file $line (line $line_id : $elem already in config file\n"
					);
					$$r_nb_pbs++;
				}
				elsif ( is_anyfile($elem) ) {

					push( @liste_toscan, $elem ) unless ($File);
					debug( "toscan : $elem masq $masq\n", 2 );
					$Toscan{$elem} = $masq;
					$Rules{$elem}  = $masqb;
				}
				elsif ($Warn_missing_file) {
					warning(
"skipped config file $line (line $line_id : $elem does not exists\n"
					);
					$$r_nb_pbs++;
				}
			}    # foreach my $elem
		}
		else {
			warning(
				"skipped config file $line (line $line_id) : unknown type\n");
		}
	}    # foreach my $line

	# clean config file
	if ( ($clean) and ($$r_nb_pbs) ) {

		# rewrite cleaned config file
		write_config( $configfile, \@config );
	}

	# test if something to do
	if ( !scalar( keys %Toscan ) ) {
		warning("nothing to scan\n");
	}

	# set default values if not founds
	$Verbose            = 0 if ( !defined $Verbose );
	$Warn_dead_symlinks = 0 if ( !defined $Warn_dead_symlinks );
	$Report_full_newdel = 0 if ( !defined $Report_full_newdel );
	$Warn_missing_file  = 0 if ( !defined $Warn_missing_file );
	$Timing             = 0 if ( !defined $Timing );
	$Running            = 0 if ( !defined $Running );
	$Ignore_case        = 0 if ( !defined $Ignore_case );
	$History            = 0 if ( !defined $History );
	$Archive            = 0 if ( !defined $Archive );
	$Output_format      = 0 if ( !defined $Output_format );
	$Max_checksum_size  = 0 if ( !defined $Max_checksum_size );

	#$Debug_level        = 0 if ( !defined $Debug_level );

	# compute patterns for exclude
	if ($Sufx) {
		my @tab = split( ' ', $Sufx );
		$SufxPat = '\.(' . join( '|', map { "$_" } @tab ) . ')$' if (@tab);
		debug( "Sufx=$Sufx SufxPat=$SufxPat\n", 2 );
	}
	if ($Prefx) {
		my @tab = split( ' ', $Prefx );
		$PrefxPat = '^(' . join( '|', map { "$_" } @tab ) . ')' if (@tab);
		debug( "Prefx=$Prefx PrefxPat=$PrefxPat\n", 2 );
	}
	if ($Exclude_re) {
		my @tab = split( ' ', $Exclude_re );
		$ExRePat = '(' . join( '|', map { "$_" } @tab ) . ')' if (@tab);
		debug( "Exclude_re=$Exclude_re ExRePat=$ExRePat\n", 2 );
	}

# add some files for internal check : this program, the graphical interface, the config file
	my $masq = $rh_alias->{'all'};

	my @list = get_names();

	foreach my $elem (@list) {
		$Toscan{$elem} = $masq;
		$Rules{$elem}  = 'all';
		push( @liste_toscan, $elem );
	}

	$Toscan{$configfile} = $masq;
	$Rules{$configfile}  = 'all';
	push( @liste_toscan, $configfile );

	if ( ( $^O !~ m/^MSWin/ ) and ($Ignore_case) ) {
		warning("ignore_case is dangerous\n");
		$$r_nb_pbs++;
	}

	debug( "-------- end of config file : $$r_nb_pbs problems -------------\n",
		1 );

	return @liste_toscan;
}
#######################################################
# transform a window's acl in binary form from hashtable
# to clear one for display
sub split_acl($) {
	my $acl = shift(@_);

	my @tab_acl = split( /$Sepacl/, $acl );
	my @text;
	foreach my $acl_item (@tab_acl) {
		my ( $sid, $mask ) = split( '=', $acl_item );
		next if ( !defined $mask );
		my @rights;
		Win32::FileSecurity::EnumerateRights( $mask, \@rights );
		push( @text, "$sid=" . join( ',', @rights ) );
	}
	return @text;
}
#######################################################
# display
# convert a field from database in a human way
sub display($$) {
	my $elem = shift(@_);    # field id
	my $info = shift(@_);    # array from database

	if ( $elem == $Id{'device'} ) {

		# device is in hexa, ex 309 == major 3, minor 9 == /dev/hda9
		return sprintf "%lx", $info->[$elem];
	}
	elsif ( $elem == $Id{'file_mode'} ) {

		# perm is in octal
		return sprintf "%lo", $info->[$elem];
	}
	elsif ( ( $elem == $Id{'acl'} ) and ($Acl_exist) ) {

		# uid on windows are acl
		return join( ';', split_acl( $info->[$elem] ) );
	}
	elsif (( $elem == $Id{'atime'} )
		or ( $elem == $Id{'mtime'} )
		or ( $elem == $Id{'ctime'} ) )
	{

		# dates
		if ( $info->[$elem] ) {
			return localtime( $info->[$elem] );
		}
		else {
			return 0;
		}
	}
	else {
		return $info->[$elem];
	}
}

#######################################################
# display_all
# convert in a human way all the record
sub display_all($) {
	my $record = shift(@_);    # value from database

	my @fileinfo = split( /$Sepmeta/, $record );

	my $output;

	my $max = scalar @fileinfo;
	for ( my $i = 0 ; $i < $max ; $i++ ) {
		$output .= display( $i, \@fileinfo ) . "$Sep";
	}
	return $output;
}
#######################################################
# low-level checksum sub
sub base_checksum($$$) {
	my $ctx      = shift(@_);    # checksum object
	my $name     = shift(@_);    # file name
	my $degraded = shift(@_);    # flag of degraded mode :0 or size of file

	if ( open( FILE, '<', $name ) ) {
		binmode(FILE);
		if ($degraded) {

			debug(
				"degraded checksum on $name : $degraded > $Max_checksum_size\n",
				2
			);
			$Nb_degraded++;

			# we just want to have checksum on first Max_checksum_size bytes
			my $buf;    # buffer
			my $buf_size = 65536;    # buffer size
			my $lu;                  # effective read count
			my $reste = $Max_checksum_size;    # size to read
			while ( $reste > $buf_size ) {
				$lu = read( FILE, $buf, $buf_size );
				$ctx->add($buf);
				$reste -= $lu;
				last if ($lu);
			}
			$lu = read( FILE, $buf, $reste );
			$ctx->add($buf);
			$reste -= $lu;

			# check : $reste = 0
			warning(
"pb checksum on file $name size $degraded buf_size $buf_size limit $Max_checksum_size\n"
			  )
			  if ( $reste != 0 );
		}
		else {

			# checksum on all file
			$ctx->addfile(*FILE);
		}
		close(FILE);
		my $sum = $ctx->b64digest;
		return $sum;
	}
	else {
		warning("can not open $name for checksum: $!\n");
		return 0;
	}
}
#######################################################
# md5sum :
# build a MD5 checksum on the given file
sub md5sum($$) {
	my $name     = shift(@_);    # file name
	my $degraded = shift(@_);

	# !!! the Digest module is not in standard
	# so we can not write Digest->new("MD5");
	my $ctx = Digest::MD5->new();

	return base_checksum( $ctx, $name, $degraded );
}
#######################################################
# sha1sum :
# build a sha1 checksum on the given file
sub sha1sum($$) {
	my $name     = shift(@_);    # file name
	my $degraded = shift(@_);

	# !!! the Digest module is not in standard
	# so we can not write Digest->new("SHA1");
	my $ctx = Digest::SHA1->new();
	return base_checksum( $ctx, $name, $degraded );
}
#######################################################
# get windows acl for a given file
sub winacl($) {
	my $filename = shift(@_);

	my $acl = 0;
	my %perm;
	if ($Acl_exist) {
		my @acl;

		# catch the error to avoid stop the program
		eval { Win32::FileSecurity::Get( $filename, \%perm ) };
		if ($@) {
			warning("can not get windows acl for $filename : $@");
		}
		else {
			while ( my ( $name, $mask ) = each %perm ) {
				$name =~ s/ /_/g;
				push( @acl, "$name=$mask" );
			}
			$acl = join( $Sepacl, @acl );
		}
	}
	return $acl;
}
#######################################################
# file_info :
# build a complete info on the given file
sub file_info($$) {
	my $name = shift(@_);
	my $masq = shift(@_);

	# for afick-tk progress text
	progress("$name") if ($Progress);

	debug( $name . $Sep, 3 );

	my @fileinfo = lstat($name);

	my $sum;
	if ( -f $name ) {

		# test on file size to reduce cpu cost
		# if degraded mode, pass file size
		my $degraded =
		  ( ($Max_checksum_size) and ( $fileinfo[7] > $Max_checksum_size ) )
		  ? $fileinfo[7]
		  : 0;
		if ( $masq =~ m/1/ ) {
			$sum = sha1sum( $name, $degraded );
		}
		elsif ( ( $masq =~ m/h/ ) or ( $masq =~ m/5/ ) ) {
			$sum = md5sum( $name, $degraded );
		}
		else {
			$sum = 0;
		}
	}
	else {
		$sum = 0;
	}

	# Each file gets a pipe-delimited entry, with format as follows:
	#
	# field 0 = checksum hash
	# field 1 = device number of filesystem
	# field 2 = inode number
	# field 3 = file mode (type/permissions)
	# field 4 = number of hard links to file
	# field 5 = uid of the file
	# field 6 = gid of the file
	# field 7 = total size of file, in bytes
	# field 8 = actual number of blocks allocated
	# field 9 = last access time in seconds since the epoch
	# field 10 = last modify time (since epoch)
	# field 11 =  inode change time
	#
	# See the perl "stat" command or man stat() for more information.

	# default value is 0
	my (
		$device, $inode, $mode,  $link,  $uid, $gid,
		$size,   $bloc,  $atime, $mtime, $ctime
	  )
	  = ( 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0 );

	$device = $fileinfo[0] if ( $masq =~ m/d/ );
	$inode  = $fileinfo[1] if ( $masq =~ m/i/ );

	# file mode are different on unix and windows
	# user/group/other and acl
	# but we use mode to get file type, so keep this field as it
	$mode = $fileinfo[2] if ( $masq =~ m/p/ );
	$link = $fileinfo[3] if ( $masq =~ m/n/ );
	$uid  = $fileinfo[4] if ( $masq =~ m/u/ );

	#$gid   = $fileinfo[5]  if ( $masq =~ m/g/ );
	if ( $masq =~ m/g/ ) {
		if ( $^O =~ m/^MSWin/ ) {

			# gid is unused on windows
			# it is replaced by the acess control list
			$gid = winacl($name);
		}
		else {

			# unix
			$gid = $fileinfo[5];
		}
	}

	$size  = $fileinfo[7]  if ( $masq =~ m/s/ );
	$atime = $fileinfo[8]  if ( $masq =~ m/a/ );
	$mtime = $fileinfo[9]  if ( $masq =~ m/m/ );
	$ctime = $fileinfo[10] if ( $masq =~ m/c/ );
	$bloc  = $fileinfo[12] if ( $masq =~ m/b/ );

	my $entry = join( $Sep,
		$sum, $device, $inode, $mode,  $link,  $uid,
		$gid, $size,   $bloc,  $atime, $mtime, $ctime );

	debug( display_all($entry) . "\n", 3 );

	if ($Running) {

		# !! seems to be a problem with -M/-C on dangling links
		if ( $masq =~ m/m/ ) {
			my $age = -M $name;
			warning("$name as been modified during the program run\n")
			  if ( ( defined $age ) and ( $age < 0 ) );
		}
		if ( $masq =~ m/c/ ) {
			my $age = -C $name;
			warning("inode of $name as been modified during the program run\n")
			  if ( ( defined $age ) and ( $age < 0 ) );
		}
	}

	return $entry;
}
#######################################################
# transform a windows acl from array (split_acl)
# to a hash, to allow a good compare
sub hash_acl(@) {
	my @tab = @_;
	my %acl;

	foreach my $elem (@tab) {
		my ( $sid, $acl ) = split( /=/, $elem );
		$acl{$sid} = $acl;
	}
	return %acl;
}
#######################################################
# compare 2 acl : show new, deleted, changed
sub compare_acl($$) {
	my $acl1 = shift(@_);    # old value from database
	my $acl2 = shift(@_);    # new value from database

	my %acl1 = hash_acl( split_acl($acl1) );
	my %acl2 = hash_acl( split_acl($acl2) );

	foreach my $key ( keys %acl1 ) {
		if ( exists $acl2{$key} ) {
			if ( $acl1{$key} ne $acl2{$key} ) {

				# changed acl
				report_detailed( "change acl $key", $acl1{$key}, $acl2{$key} );
			}
			delete $acl2{$key};
		}
		else {

			# deleted acl
			report_detailed( "deleted acl $key", $acl1{$key} );
		}
	}

	# we deleted all common keys on acl2
	# so we just have new acl now
	foreach my $key ( keys %acl2 ) {

		# new acl
		report_detailed( "new acl $key", $acl2{$key} );
	}

}
#######################################################
# compare_entry :
# compare 2 file infos and print the difference
sub compare_entry($$$) {
	my $name   = shift(@_);    # file name
	my $entry1 = shift(@_);    # old value
	my $entry2 = shift(@_);    # new value

	my @fileinfo1 = split( /$Sepmeta/, $entry1 );
	my @fileinfo2 = split( /$Sepmeta/, $entry2 );

	my $i;
	my $max = scalar @fileinfo1;
	for ( $i = 0 ; $i < $max ; $i++ ) {
		if ( $fileinfo1[$i] ne $fileinfo2[$i] ) {

			# !!!! for windows acl, it is long and difficult to read
			# so a special report is necessary
			if ( ( $i == $Id{'acl'} ) and $Acl_exist ) {
				compare_acl( $fileinfo1[$i], $fileinfo2[$i] );
			}
			else {

				# general case
				report_detailed(
					"$Field[$i]",
					display( $i, \@fileinfo1 ),
					display( $i, \@fileinfo2 )
				);
			}
		}    # if fileinfo ne
	}    # for
}

#######################################################
# is_exception :
# return true if the file name belong exception list
sub is_exception($) {
	my $elem = shift(@_);
	return ( exists( $Toscan{$elem} ) and ( $Toscan{$elem} eq '0' ) );
}
#######################################################
# parcours :
# the general sub to scan a directory (recursive)
# explore a directory or a file to populate an array
sub parcours($$$$) {
	my $rep     = shift(@_);    # file or directory to scan
	my $traite  = shift(@_);    # sub to call
	my $masq    = shift(@_);    # herited masq
	my $newflag = shift(@_);    # herited new flag

	debug( "parcours : $rep masq = $masq\n", 3 );

	my @liste;

	my $rep_key;
	if ($Ignore_case) {
		$rep_key = lc($rep);
	}
	else {
		$rep_key = $rep;
	}

	# first build a list of file
	if ( -d $rep ) {
		return if ( $rep =~ /\/\.\.?$/ );

		if ( exists $Toscan{$rep_key} ) {
			$masq = $Toscan{$rep_key};

			debug( "change masq to $masq for $rep\n", 2 );
		}
		$traite->( $rep, $masq, $newflag );

		# equal : do not scan into the directory
		return if ( exists $Onlythis{$rep_key} );

		if ( !-l $rep ) {

			if ( !opendir( DIR, $rep ) ) {
				warning("(parcours) can not open directory $rep : $!\n");
				return;
			}
			my $elem;
			while ( defined( $elem = readdir(DIR) ) ) {
				next if $elem =~ /^\.\.?$/;

				# equal : do not scan sub-dir
				next
				  if (  ( exists $Onlydir{$rep_key} )
					and ( -d $rep . '/' . $elem ) );

				push( @liste, $elem );

				# special case : / to avoid //
				#if ( $rep eq '/' ) {
				#	push( @liste, '/' . $elem );
				#}
				#else {
				#	push( @liste, $rep . '/' . $elem );
				#}
			}
			closedir(DIR);
		}
		else {

			# on ne suit pas les liens sur les repertoires
			debug( "$rep skipped (link on directory)\n", 2 );
		}
	}
	else {

		# ordinary files (for exemples afick.pl afick.conf ...)
		my ( $fic, $dir, undef ) = fileparse($rep);
		$dir =~ s/\/$//;

		# just put in @list the file name without path
		push( @liste, $fic );

		# we had to build the parent directory
		$rep = $dir;
	}

	parcours2( $rep, $traite, $masq, $Newfiles{$rep}, \@liste );
}
#######################################################
# treat an array of file (or directory)
# search exceptions
# call file info on remaining files
# recursive call on directories
sub parcours2($$$$$) {
	my $rep     = shift(@_);    # file or directory to scan
	my $traite  = shift(@_);    # sub to call
	my $masq    = shift(@_);    # herited masq
	my $newflag = shift(@_);    # herited new flag
	my $liste   = shift(@_);

	foreach my $file (@$liste) {

		# build full path
		my $fic;
		if ( $rep eq '/' ) {

			#special case : / to avoid //
			$fic = '/' . $file;
		}
		else {
			$fic = $rep . '/' . $file;
		}

		# build case/nocase name
		my $fic_key;
		if ($Ignore_case) {
			$fic_key = lc($fic);
		}
		else {
			$fic_key = $fic;
		}

		next if ( is_exception($fic_key) );
		next if ( test_exclude_prefix($file) );
		next if ( test_exclude_re($fic_key) );
		next if ( test_exclude_suffix($fic_key) );

		# heritage, set to all by default (ex : -l action)
		my $lmasq = $masq;
		if ( !$lmasq ) {
			$lmasq = $Alias{'all'};
			debug( "lmasq set to all\n", 2 );
		}

		# surcharge
		if ( exists $Toscan{$fic_key} ) {
			$lmasq = $Toscan{$fic_key};

			debug( "change masq to $lmasq for $fic\n", 2 );
		}

		debug( "parcours2 : $fic ($rep) lmasq=$lmasq\n", 2 );

		if ( -d $fic ) {
			parcours( $fic, $traite, $lmasq, $newflag );
		}    # end directory
		elsif ( -l $fic ) {
			my $whatlink = readlink($fic);
			my $abs_whatlink;

			# is the link an absolute path ?
			if ( $whatlink !~ m/^\// ) {

				# absolute path for check
				$abs_whatlink = $rep . '/' . $whatlink;
				debug( "abs_whatlink for $fic : $abs_whatlink ($whatlink)\n",
					2 );
			}
			else {
				$abs_whatlink = $whatlink;
			}
			if ( !-e $abs_whatlink ) {

				# real path for display
				$Dangling{$fic} = $whatlink;
			}
			$traite->( $fic, $lmasq, $Newfiles{$rep} );
		}    # end link
		else {
			$traite->( $fic, $lmasq, $Newfiles{$rep} );
		}    # end normal file
	}    # foreach
}
#######################################################
# wanted_create
# process a file in create mode
sub wanted_create($$) {
	my $name = shift(@_);
	my $masq = shift(@_);

	$Finded{$name} = 1;

	my $entry = file_info( $name, $masq );

	$Hashfile{$name} = $entry;
}
#######################################################
# end_report
# to be called at end of scan to display informations on database
# and write control file
sub end_report($) {
	my $database = shift(@_);

	# Generate a MD5 for the dbm file.
	my $sum = md5sum( $database . $Database_ext, 0 );

	info( $Comment x 65 . "\n" );
	info("MD5 hash of $database => $sum\n\n");
	write_control( $sum, $database );
}
#######################################################
# create (base liste)
# create a new database (empty the existing one if exists)
sub create($$) {
	my $database = shift(@_);
	my $listerep = shift(@_);
	tie( %Hashfile, $Dbm, $database, O_WRONLY | O_CREAT, 0666 )
	  or die "abort (create) : can not open $Dbm $database : $!";

	print_env('init');
	debug( "begin create\n", 1 );

	# delete all previous keys
	%Hashfile = ();

	foreach my $elem (@$listerep) {

		# to skip already scanned files
		next if ( exists $Finded{$elem} );

		parcours( $elem, \&wanted_create, '', undef );
	}
	my $nbscan = scalar( keys %Finded );
	print_dangling(1);
	untie %Hashfile;

	report("\n");
	info("Hash database created successfully. $nbscan files entered.\n");
	history("init : $nbscan files entered\n");

	end_report($database);
}
#######################################################
# wanted_update
# process a file in update mode
sub wanted_update($$$) {
	my $name    = shift(@_);
	my $masq    = shift(@_);
	my $newflag = shift(@_);

	$Finded{$name} = 1;

	my $entry = file_info( $name, $masq );

	if ( $Hashfile{$name} ) {

		# test for changes
		my $old_entry = $Hashfile{$name};
		if ( $old_entry ne $entry ) {

			# keep values to compare
			$Oldval{$name} = $old_entry;
			$Newval{$name} = $entry;
			$Nbmod++;
			$Hashfile{$name} = $entry if ($Update);
		}
	}
	else {

		# new entry
		if ( defined $newflag ) {
			$Newfiles{$name} = $newflag + 1;
		}
		else {
			$Newfiles{$name} = 1;
		}

		$Newval{$name} = $entry;

		#debug ("$name heritage : $newflag value $Newfiles{$name}\n");
		$Hashfile{$name} = $entry if ($Update);
	}
}    # end of wanted
#######################################################
# update :
# compare or update a database with the system
sub update($$$) {
	my $database   = shift(@_);
	my $configfile = shift(@_);
	my $listerep   = shift(@_);

	debug( "update $database $configfile\n", 3 );

	tie( %Hashfile, $Dbm, $database, O_RDWR, 0666 )
	  or die "abort (update) : can not open $Dbm $database : $!";

	my $action = $Update ? 'update' : 'compare';
	print_env($action);

	debug( "begin $action\n", 1 );

	my ( $old_version, $run_date ) = calc_control( $configfile, $database );

	# for afick-tk progress bar
	# guess the number of file does not change too much
	my $total = scalar( keys %Hashfile );
	progress("total $total") if ($Progress);

	# scan file list
	foreach my $elem (@$listerep) {

		# skip already scanned
		next if ( exists $Finded{$elem} );

		parcours( $elem, \&wanted_update, '', undef );
	}

	debug( "begin analysis\n", 1 );

	# analysis
	my $nbchange = $Nbmod;
	my $nbdelete = 0;
	my $nbnew    = 0;
	if ( !$File ) {

		# display a general message
		print_last( $run_date, $old_version );

		# look for new files
		$nbnew = print_new(0);
		$Nbmod += $nbnew;

		# look for deleted files
		$nbdelete = print_delete(0);
		$Nbmod += $nbdelete;

		print_dangling(0);
	}
	print_changed(0);

	report("\n");
	info("detailed changes\n") if ($Nbmod);
	if ( !$File ) {
		print_new(1);
		print_delete(1);
		print_dangling(1);
	}
	print_changed(1);

	untie %Hashfile;

	report("\n");
	my $nbscan   = scalar( keys %Finded );
	my $dangling = scalar( keys %Dangling );
	my $text     =
"$nbscan files scanned, $Nbmod changed (new : $nbnew; delete : $nbdelete; changed : $nbchange; dangling : $dangling; exclude_suffix : $Nb_exclude_sufx; exclude_prefix : $Nb_exclude_prefx; exclude_re : $Nb_exclude_re; degraded : $Nb_degraded)\n";
	if ($Update) {
		info("Hash database updated successfully : $text");
	}
	else {
		info("Hash database : $text");
	}
	history("$action : $text");

	end_report($database);

	# return a status
	return oct(
		join( '',
			'0b',
			map { $_ ? 1 : 0; } ( $nbnew, $nbdelete, $nbchange, $dangling ) )
	);
}    # end update

#######################################################
# print_dangling
# print all danglink symbolic links
sub print_dangling($) {
	my $detailed = shift(@_);
	return unless ($Warn_dead_symlinks);

	debug( "print_dangling begin detailed=$detailed\n", 1 );
	foreach my $key ( keys %Dangling ) {
		report_summary( 'Dangling', $key );
		report_detailed( 'linked_to', $Dangling{$key} ) if ($detailed);
	}
	debug( "print_dangling end\n", 1 );
}

#######################################################
# print_dbm
# print the database content
sub print_dbm($$) {
	my $database   = shift(@_);
	my $configfile = shift(@_);

	tie( %Hashfile, $Dbm, $database, O_RDONLY, 0666 )
	  or die "abort (print_dbm) : Couldn't tie $Dbm file $database : $!";

	my ( $old_version, $run_date ) = calc_control( $configfile, $database );

	print_last( $run_date, $old_version );

	# display print format
	info( 'format : file_type name' . $Sep . join( $Sep, @Field ) . "\n" );

	# ??? change to have same format as other ?
	foreach my $key ( sort keys %Hashfile ) {
		report( file_type($key) . " $key" . $Sep
			  . display_all( $Hashfile{$key} )
			  . "\n" );
	}
	info( 'number of file : ' . scalar( keys %Hashfile ) . "\n" );
	untie %Hashfile;
}
#######################################################
# print a summary or detailed info on changes
sub print_changed($) {
	my $detailed = shift(@_);
	foreach my $key ( sort keys %Oldval ) {
		report_summary( 'changed', $key );
		compare_entry( $key, $Oldval{$key}, $Newval{$key} ) if ($detailed);
	}
}
#######################################################
# get a forced ctime to display inode date for new files
sub ctime($) {
	my $key = shift(@_);
	my $ctime = get_ctime($key) || ( stat($key) )[10] || 0;
	return localtime($ctime);
}
#######################################################
# we display as detailed info the inode last change date
sub print_new($) {
	my $detailed = shift(@_);

	# look for new files
	my $nb    = 0;
	my $nbnew = 0;
	foreach my $key ( sort keys %Newfiles ) {

		# report only if asked all ($Report_full_newdel) or first level
		if ($Report_full_newdel) {
			report_summary( 'new', $key );
			report_detailed( 'inode_date', ctime($key) ) if ($detailed);
		}
		elsif ( $Newfiles{$key} == 1 ) {
			if ($nb) {
				report_detailed( 'number of new files', $nb );
			}
			report_summary( 'new', $key );
			report_detailed( 'inode_date', ctime($key) ) if ($detailed);
			$nb = 0;
		}
		else {
			$nb++;
		}

		$nbnew++;
	}
	if ($nb) {
		report_detailed( 'number of new files', $nb );
	}
	return $nbnew;
}
#######################################################
# get parent mtime
sub parent_date($) {
	my $parent = shift(@_);
	my $mtime = get_mtime($parent) || ( stat($parent) )[9] || 0;
	return localtime($mtime);
}
#######################################################
# we display as info the date change of parent directory
sub print_delete($) {
	my $detailed = shift(@_);

	my %deleted;
	my $nb       = 0;
	my $nbdelete = 0;
	foreach my $key ( sort keys %Hashfile ) {
		if ( !exists( $Finded{$key} ) ) {

			# get directory for a file or parent directory for a directory
			my $path = dirname($key);

			if ($Report_full_newdel) {
				report_summary( 'deleted', $key );
				report_detailed( 'parent_date', parent_date($path) )
				  if ($detailed);
				$nb = 0;
			}
			else {

				#print "--- deleted $key $path\n";
				if ( exists $deleted{$path} ) {
					$deleted{$key} = $deleted{$path} + 1;
					$nb++;
				}
				else {
					$deleted{$key} = 1;
					if ($nb) {
						report_detailed( 'number of deleted files', $nb );
					}
					$nb = 0;
					report_summary( 'deleted', $key );
					report_detailed( 'parent_date', parent_date($path) )
					  if ($detailed);
				}
			}
			delete $Hashfile{$key} if ( $detailed and $Update );
			$nbdelete++;
		}
	}
	if ($nb) {
		report_detailed( 'number of deleted files', $nb );
	}
	return $nbdelete;
}
#######################################################
sub display_rule($$;$$) {
	my $elem    = shift(@_);
	my $r_alias = shift(@_);          # reverse alias
	my $prefix  = shift(@_) || '';    # prefix (optionnal)
	my $suffix  = shift(@_) || '';

	# resolved alias in base attributes
	debug( "display_rule intern $elem $Toscan{$elem}\n", 3 );
	my $v = join( '+', map { $r_alias->{$_} } split( //, $Toscan{$elem} ) );
	debug( "# resolved ${prefix}${elem}${suffix} $v\n", 2 );
	debug( "${prefix}${elem}${suffix} $Rules{$elem}\n", 1 );
}
#######################################################
# print internal flag state
sub print_config() {
	debug( "database:=$Database\n",                         1 );
	debug( "history:=$History\n",                           1 );
	debug( "archive:=$Archive\n",                           1 );
	debug( "report_url:=" . get_report_url() . "\n",        1 );
	debug( "verbose:=$Verbose\n",                           1 );
	debug( "debug:=" . get_debug_level() . "\n",            1 );
	debug( "warn_dead_symlinks:=$Warn_dead_symlinks\n",     1 );
	debug( "report_full_newdel:=$Report_full_newdel\n",     1 );
	debug( "warn_missing_file:=$Warn_missing_file\n",       1 );
	debug( "running_files:=$Running\n",                     1 );
	debug( "timing:=$Timing\n",                             1 );
	debug( "ignore_case:=$Ignore_case\n",                   1 );
	debug( 'exclude_suffix:=' . get_exclude_sufx() . "\n",  1 );
	debug( 'exclude_prefix:=' . get_exclude_prefx() . "\n", 1 );
	debug( 'exclude_re=' . get_exclude_re() . "\n",         1 );
	debug( "max_checksum_size=$Max_checksum_size\n",        1 );

	debug( "#SufxPat=$SufxPat\n",   1 );
	debug( "#PrefxPat=$PrefxPat\n", 1 );
	debug( "#ExRePat=$ExRePat\n",   1 );

	#	debug( "output_format=$Output_format\n", 1 );

	# macros
	foreach my $m ( keys %Macros ) {
		debug( "\@\@define $m $Macros{$m}\n", 1 );
	}

	# alias
	while ( my ( $a, $v ) = each %Aliases ) {
		debug( "$a=$v\n", 1 ) if ( $a ne $v );
	}

	# and now : the list of files to scan
	my %r_alias = reverse %Alias;

	#my %r_alias = %Alias;
	foreach my $elem ( keys %Toscan ) {
		if ( !$Toscan{$elem} ) {

			# negative option
			debug( "! $elem\n", 1 );
		}
		elsif ( exists $Onlythis{$elem} ) {
			display_rule( $elem, \%r_alias, '=' );
		}
		elsif ( exists $Onlydir{$elem} ) {
			display_rule( $elem, \%r_alias, '=', '/' );
		}
		else {

			# normal
			display_rule( $elem, \%r_alias );
		}
	}
}

#######################################################
#  print program version
sub version($) {
	my $version = shift(@_);
	print "\n";
	print "afick : another file integrity checker\nversion $version\n";
}
#######################################################
# read database previous checksum and compare with new one
sub read_control($$) {
	my $newchecksum  = shift(@_);
	my $database     = shift(@_);
	my $control_file = $database . $Control_ext;

	my ( $oldchecksum, $old_version, $run_date );
	if ( open( CONTROL, '<', $control_file ) ) {
		$oldchecksum = <CONTROL>;
		chomp($oldchecksum);
		$old_version = <CONTROL>;
		chomp($old_version) if ( defined $old_version );
		$run_date = <CONTROL>;
		chomp($run_date) if ( defined $run_date );
		close(CONTROL);
		if ( $oldchecksum ne $newchecksum ) {
			warning(
				"internal change in afick database $database (see below)\n");
		}
	}
	else {
		warning(
			"(read_control) can not read control file $control_file : $!\n");
	}
	return ( $old_version, $run_date );
}
#######################################################
# write database checksum for next run
sub write_control ($$) {
	my $checksum     = shift(@_);                  # the string to write
	my $database     = shift(@_);
	my $control_file = $database . $Control_ext;

	# to avoid Tainted warnings
	$control_file = $1 if ( $control_file =~ /(.+)/ );

	if ( open( CONTROL, '>', $control_file ) ) {
		print CONTROL "$checksum\n";               # database checksum
		print CONTROL "$Version\n";                # afick version
		print CONTROL time() . "\n";               # date of run
		close(CONTROL);
	}
	else {
		warning(
			"(write_control) can not write in control file $control_file : $!\n"
		);
	}
}
#######################################################
# compare old and new checksum for afick main components
sub control ($) {
	my $name = shift(@_);                          # file name to control

	my $newchecksum = md5sum( $name, 0 );
	my $oldchecksum = get_md5($name);

	if ( !defined $oldchecksum ) {

		# first run
		return;
	}
	elsif ( $oldchecksum ne $newchecksum ) {
		warning("(control) afick internal change : $name (see below)\n");
		debug( "oldchecksum=$oldchecksum newchecksum=$newchecksum\n", 2 );
	}
}
#######################################################
# check if afick change since last run
sub calc_control($$) {
	my $configfile = shift(@_);
	my $database   = shift(@_);

	my @list = get_names();

	foreach my $elem (@list) {
		control($elem);    # afick.pl
	}

	control($configfile);    # afick-tk.pl

	my $database_check = md5sum( $database . $Database_ext, 0 );
	return read_control( $database_check, $database );
}
#############################################################
sub open_archive() {
	debug( "open_archive\n", 3 );
	if ($Archive) {

		if ( !-d $Archive ) {
			warning("archive directory $Archive does not exists\n");
		}
		else {

			# open archive file
			my $archive_file =
			  $Archive . '/afick.' . strftime( "%Y%m%d%H%M%S", @Date );
			if ( !open( ARCHIV, '>', $archive_file ) ) {
				warning("can not open archive file $archive_file : $!\n");
			}
			else {
				debug( "open archive file $archive_file\n", 2 );
				$Archive_df = *ARCHIV;
			}
		}
	}
}
#######################################################
sub rech_parent($$) {
	my $file  = shift(@_);
	my $rscan = shift(@_);

	my $found = 0;
	if ( exists $rscan->{$file} ) {

		#print "found file $file : $rscan->{$file}\n";
		$found = $rscan->{$file};
	}
	else {
		my $dirname = dirname($file);

		while (1) {
			if ( exists $rscan->{$dirname} ) {

				#print "found file $dirname : $rscan->{$dirname}\n";
				$found = $rscan->{$dirname};
				last;
			}
			else {
				my $newdirname = dirname($dirname);
				last if ( $newdirname eq $dirname );
				$dirname = $newdirname;

				#print "dirname = $dirname\n";
			}
		}

		#if ( ! $found ) {
		#        print "no parent for $file\n";
		#}
	}
	return $found;
}
#######################################################
# usage
# print some help
sub usage($) {
	my $version = shift(@_);
	print <<EOHELP;

Usage: $0 [mandatory action] [other options]

Mandatory action (one and only one must be used) : 
 -i|--init                    initialize the hash.dbm database
 -C|--check_config	      only check config file and exit
 -G|--clean_config            check and clean configuration, then exit
 -k|--compare                 compare the hash.dbm database
 -l|--list fic1 .. fic2       check the files given in arg 
 -u|--update                  compare and update the hash.dbm database
 -p|--print                   print content of dbm database
 --print_config               display internals variables after arguments and config file parsing
 				(for debugging purposes)

Other options
 -a|--ignore_case             helpful on windows plateforms, dangerous on unix ones
 				reverse : --noignore_case
 -c|--config_file file        name of config file to use
 -D| --database file          force the database name    
 -d|--debug level	      set a level of debugging messages, from 0 (none) to 3 (full)
 				default : 0
 -f|--full_newdel             report full information for new or deleted directories
                               default: no
			       reverse : --nofull_newdel 
 -m|--missing_files           warn about files declared in config files 
                               which do not exists, 
			       default: no; 
			       reverse : --nomissing_files
 -r|--running_files           warn about "running" files : modified since program begin
                               default: no 
                               reverse: --norunning_files
 -s|--dead_symlinks           warn about dead symlinks 
                               default: no 
                               reverse: --nodead_symlinks
 -S|--max_checksum_size	size  maximum cheksum size (bytes) : for bigger file, just compute checksum on begin of file
 				default : 0 (no limit)
 -t|--timing		      Print timing statistics
				default: no
				reverse : --notiming
 -v|--verbose                 toggle verbose mode (identical to full debug);
                               default: no 
 			       reverse : --noverbose
 -P|--progress		      display the name of scanned files, to be used only by afick-tk
 -h|--help                    show this help page
 -V|--version                 show afick version
 -x|--exclude_suffix ext1 ext2        list of file/dir suffixes to ignore
 -X|--exclude_prefix pre1 pre2        list of files/dir prefixes to ignore
 -R|--exclude_re patern1 patern2      list of files/dir patterns (regular expressions) to ignore
 -y|--history file	      history file of all runs with summary
 -A|--archive directory	      directory where archive files are stored

Disclaimer:
This script is intended to provide a means for
detecting changes made to files, via a regular
comparison of MD5 hashes to an established baseline. 

Copyright (c) 2002 Eric Gerbier <gerbier\@users.sourceforge.net>

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.
EOHELP

}
#############################################################
#                          main
#############################################################

my $default_config_file = get_default_config();
if ( $^O =~ m/^MSWin/ ) {

	# for acl list
	eval { require Win32::FileSecurity };
	if ($@) {
		warning("perl module Win32::FileSecurity not found : $@\n");

		# will work but without acl
		$Acl_exist = 0;
	}
	else {
		$Acl_exist = 1;
	}
}

$| = 1;

# var for get options
my $check_config;
my $clean_config;
my $compare;
my $configfile;    # config file name
my $help;
my $init;
my $list;
my $print;
my $print_config;
my $version;

Getopt::Long::Configure('no_ignore_case');
unless (
	GetOptions(
		'archive|A=s'           => \$Archive,
		'ignore_case|a!'        => \$Ignore_case,
		'config_file|c=s'       => \$configfile,
		'check_config|C'        => \$check_config,
		'clean_config|G'        => \$clean_config,
		'database|D=s'          => \$Database,
		'debug|d=i'             => \$Debug_level,
		'full_newdel|f!'        => \$Report_full_newdel,
		'help|h'                => \$help,
		'history|y=s'           => \$History,
		'init|i'                => \$init,
		'compare|k'             => \$compare,
		'list|l=s'              => \$list,
		'max_checksum_size|S=i' => \$Max_checksum_size,
		'missing_files|m!'      => \$Warn_missing_file,

		#		'output_format|o=s'  => \$Output_format,
		'print|p'            => \$print,
		'print_config'       => \$print_config,
		'progress|P'         => \$Progress,
		'running_files|r!'   => \$Running,
		'dead_symlinks|s!'   => \$Warn_dead_symlinks,
		'verbose|v!'         => \$Verbose,
		'version|V'          => \$version,
		'exclude_suffix|x=s' => \$Sufx,
		'exclude_prefix|X=s' => \$Prefx,
		'exclude_re|R=s'     => \$Exclude_re,
		'timing|t!'          => \$Timing,
		'update|u'           => \$Update
	)
  )
{
	usage($Version);
	die "abort : incorrect option\n";
}

if ($help) {

	# -h : help
	usage($Version);
	exit;
}
elsif ($version) {

	# -V : version
	version($Version);
	exit;
}

if ($configfile) {
	my ( $name, $path, undef ) = fileparse($configfile);
	$path = abs_path($path) . '/';    # convert in absolute path

	$configfile = $path . $name;      # convert in absolute path
	debug( "config file : $configfile\n", 2 );
}
elsif ( -e $default_config_file ) {
	$configfile = $default_config_file;
}
else {
	usage($Version);
	die
"abort : missing configfile name (-c flag) and default config file $default_config_file\n";
}

# parse config file
my $nb_pbs = 0;

# need to be set before read_configuration because change listerep
$File = 1 if ($list);

# list of files from config file
my @listerep =
  read_configuration( $configfile, \%Alias, \$nb_pbs, $clean_config );

if ( ($check_config) or ($clean_config) ) {
	if ($nb_pbs) {
		warning("find $nb_pbs errors in config file $configfile\n");
	}
	else {
		info("config file $configfile ok\n");
	}
	exit $nb_pbs;
}

if ($print_config) {

	# force print and exit
	$Verbose = 1;
	print_config();
	exit;
}
else {

	# print in debug mode
	print_config();
}

@Date = localtime();

# no we should have a database name
if ( !$Database ) {
	usage($Version);
	die
"abort : missing database name in flag list (-b) and in config file $configfile\n";
}

my $return_value = 0;

# actions
if ($list) {

	# -l : liste
	#$File         = 1;
	foreach my $elem ( split( ? ?, $list ) ) {
		my $ret = rech_parent( $elem, \%Toscan );
		if ($ret) {

			# ad to the list
			push( @listerep, $elem );

			# set scan options
			$Toscan{$elem} = $ret unless exists $Toscan{$elem};
			debug( "scan option for file $elem : $ret\n", 2 );
		}
		else {
			warning("can not scan $elem : no rules found\n");
		}
	}
	$return_value = update( $Database, $configfile, \@listerep );
}
elsif ($print) {

	# -p : print
	print_dbm( $Database, $configfile );
}
elsif ($init) {

	# -i : init
	open_archive();
	create( $Database, \@listerep );
}
elsif ($Update) {

	# -u : update
	open_archive();
	$return_value = update( $Database, $configfile, \@listerep );
}
elsif ($compare) {

	# -k : check
	open_archive();
	$return_value = update( $Database, $configfile, \@listerep );
}
else {
	usage($Version);
	die "abort : no action to do (-i, -u, -k, -l, -p) \n";
}

# timing info
if ($Timing) {
	my ( $user, $system, $cuser, $csystem ) = times();
	info("user time : $user; system time : $system\n");
}

if ($Archive) {
	close(ARCHIV);
}

exit $return_value;

__END__

=head1 NAME

afick - Another File Integrity Checker

=head1 DESCRIPTION

The goal of this program is to monitor what change on your host : new/deleted/modified files.
So it can be used as an intrusion detection system ( by integrity checking ).
It is designed to be a portable clone of aide (Advanced Intrusion Detection Environment), or Tripwire software.

You should launch it regulary (by cron for example) and after any software change.

This is a command-line program, you can use C<afick-tk.pl> if you
prefer a graphical interface.

=head1 SYNOPSIS

afick [L<action|actions>] [L<options|options>]

afick use posix syntaxe, which allow many possibilities : 

=over 4

=item *

long (--) options

=item *

short (-) options

=item *

negative (--no) options

=back

=head1 ACTIONS

You have to use one this mandatory action :

=over 4

=item *
--init|-i

initiate the database.

=item *
--check_config|-C

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

=item *
--clean_config|-G

check config file syntaxe, clean (coments) bad line, and exit with the number of errors

=item *
--compare|-k

compare the file system with the database.

=item *
--list|-l "file1 file2 ... filen"

compare the specified files with the database.

=item *
--print|-p

print the content of the database.

=item *
--print_config

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

=item *
--update|-u

compare and update the database.

=back

=head1 OPTIONS

You can use any number of the following options :

=over 4

=item *
--archive|-A directory

write reports to "directory".

=item *
--config_file|-c configfile

read the configuration in config file named "configfile".

=item *
--database|-D name

name of database to use.

=item *
--debug|-d level

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

=item *
--full_newdel|-f,(--nofull_newdel)

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

=item *
--help|-h

Output help information and exit.

=item *
--history|-y historyfile

write session status to history file

=item *
--ignore_case|-a

ignore case for file names. Can be helpfull on windows plateforms, but is dangerous on unix ones.

=item *
--max_checksum_size|-S size

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

=item *
--missing_files|-m,(--nomissing_files)

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

=item *
--dead_symlinks|-s,(--nodead_symlinks)

(do not) warn about dead symlinks. Default : no

=item *
--progress|-P

display the name of scanned files, to be used only by afick-tk

=item *
--running_files|-r,(--norunning_files)

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

=item *
--timing|-t,(--notiming)

(do not) Print timing statistics. Default : no

=item *
--version|-V

Output version information and exit.

=item *
--verbose|-v,(--noverbose)

(not in) verbose mode (obsolete). Default : no

=item *
--exclude_suffix|-x "ext1 ext2 ... extn"

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

=item *
--exclude_prefix|-X "pre1 pre2 ... pren"

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

=item *
--exclude_re|-R "pre1 pre2 ... pren"

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

=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)

each database is composed of 3 binary files :

=over 4

=item *

one with .dir suffixe : a file index

=item *

one with .pag suffixe : the database core

=item *

one with .ctr suffixe : a control file

=back

=head1 USE

To use this program, you must

first adjust the config file to your needs :
see afick.conf(5) for the syntaxe)

then initiate the database with :
C<afick -c linux.conf --init>

then you can compare with
C<afick -c linux.conf -k>

or compare and update with
C<afick -c linux.conf --update>


=head1 RETURN VALUES

An exit status of 0 means no differences were found, non-zero means
some differences were found. The non-zero value is a bitmap represent-
ing the type of difference found:

=over 4

=item Bit 0 ( value : 1)

Dangling

=item Bit 1 (value : 2)

Changed

=item Bit 2 (value : 4)

Deleted

=item Bit 3 (value : 8)

New

=back

=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 configuration file
<br>
<a href="afick-tk.1.html">afick-tk(1)</a> for graphical interface
<br>
<a href="afickonfig.1.html">afickonfig(1)</a> for a tool to change afick's configuration file

=for man
\fIafick.conf\fR\|(5) for configuration file
.PP
\fIafick\-tk\fR\|(1) for graphical interface
.PP
\fIafickonfig\fR\|(1) for a tool to change afick's configuration file

=head1 COPYRIGHT

Copyright (c) 2002,2003,2004 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 AUTHORS

Eric Gerbier

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