package Mail::SpamAssassin::CmdManageSA3;

use strict;

use Errno;
use POSIX;

use Text::Iconv;
use MIME::Base64 ();
use MIME::QuotedPrint ();

use Mail::SpamAssassin;
use Mail::SpamAssassin::ArchiveIterator;
use Mail::SpamAssassin::Message;
use Mail::SpamAssassin::PerMsgLearner;

use Getopt::Long;
use Pod::Usage;


use constant BIG_BYTES => 256*1024;	# 256k is a big email

## Pathes definition
use constant PID_DIR  => '/var/run/spamd'; ## Pidfiles directory
use constant SOCK_DIR => '/tmp'; ## Named pipe directory
use constant PSA_CFG  => '/etc/psa/psa.conf'; ## PSA configuration file
use constant HOOK_TMPL => 'spam'; ## template for use in mailmng --handler-name option

sub SPAM_HOOK() { ## Hook for using spamc
	return $main::SPAM_HOOK_BIN;
}

sub SPAM_HOOK_PRIORITY() {
	return $main::SPAM_HOOK_PRIORITY;
}

sub SPAM_HOOK_TEMPLATE() {
	return $main::SPAM_HOOK_TEMPLATE;
}

sub SERVER_CONFIG_DIR() { ## Server's config directory path
	return $main::LOCAL_RULES_DIR;
}

sub SERVER_CONFIG_FILE() { ## Server's config file path
	return $main::LOCAL_RULES_DIR . '/local.cf';
}

#sub QMAIL_LOCAL { ## Path to qmail-local binary
#	return $main::QMAIL_DIR . '/bin/qmail-local';
#}

## Options definition
use constant OPTIONS => {
	'sensitivity'          => sub {
		return { 'required_score' => shift }
	},

	'modify-header'        => sub {
		return { 'rewrite_header' => 'subject ' . shift }
	},

	'not-modify-header'    => sub {
		return { 'rewrite_header' => 'subject' }
	},

	'add-to-whitelist'     => sub {
		my $new = shift;
		my $old = shift;

		my @list = split(/\s+/, $old->{'whitelist_from'} || '');
		push @list, split(/,\s*/, $new); @list = map $_, keys %{ { map { $_, 1 } @list } };

		return { 'whitelist_from' => join(' ', @list) }
	},

	'add-to-blacklist'     => sub {
		my $new = shift;
		my $old = shift;

		my @list = split(/\s+/, $old->{'blacklist_from'} || '');
		push @list, split(/,\s*/, $new); @list = map $_, keys %{ { map { $_, 1 } @list } };

		return { 'blacklist_from' => join(' ', @list) }
	},

	'add-to-unwhitelist'   => sub {
		my $new = shift;
		my $old = shift;

		my @list = split(/\s+/, $old->{'unwhitelist_from'} || '');
		push @list, split(/,\s*/, $new); @list = map $_, keys %{ { map { $_, 1 } @list } };

		return { 'unwhitelist_from' => join(' ', @list) }
	},

	'add-to-unblacklist'   => sub {
		my $new = shift;
		my $old = shift;

		my @list = split(/\s+/, $old->{'unblacklist_from'} || '');
		push @list, split(/,\s*/, $new); @list = map $_, keys %{ { map { $_, 1 } @list } };

		return { 'unblacklist_from' => join(' ', @list) }
	},

	'del-from-whitelist'   => sub {
		my $new = shift;
		my $old = shift;

		my @list = split(/\s+/, $old->{'whitelist_from'} || '');
		my @del_list = split(/,\s*/, $new);
		my $i = 0; while ($i < @list) {
			if (grep $list[$i] eq $_, @del_list) { splice(@list, $i, 1) }
			else { $i++ }
		}

		my $str = join(' ', @list);
		return { 'whitelist_from' => length($str) ? $str : undef }
	},

	'del-from-blacklist'   => sub {
		my $new = shift;
		my $old = shift;

		my @list = split(/\s+/, $old->{'blacklist_from'} || '');
		my @del_list = split(/,\s*/, $new);
		my $i = 0; while ($i < @list) {
			if (grep $list[$i] eq $_, @del_list) { splice(@list, $i, 1) }
			else { $i++ }
		}

		my $str = join(' ', @list);
		return { 'blacklist_from' => length($str) ? $str : undef }
	},

	'del-from-unwhitelist' => sub {
		my $new = shift;
		my $old = shift;

		my @list = split(/\s+/, $old->{'unwhitelist_from'} || '');
		my @del_list = split(/,\s*/, $new);
		my $i = 0; while ($i < @list) {
			if (grep $list[$i] eq $_, @del_list) { splice(@list, $i, 1) }
			else { $i++ }
		}

		my $str = join(' ', @list);
		return { 'unwhitelist_from' => length($str) ? $str : undef }
	},

	'del-from-unblacklist' => sub {
		my $new = shift;
		my $old = shift;

		my @list = split(/\s+/, $old->{'blacklist_from'} || '');
		my @del_list = split(/,\s*/, $new);
		my $i = 0; while ($i < @list) {
			if (grep $list[$i] eq $_, @del_list) { splice(@list, $i, 1) }
			else { $i++ }
		}

		my $str = join(' ', @list);
		return { 'unblacklist_from' => length($str) ? $str : undef }
	},
};

## User name which the POP3 server running under
use constant POPUSER    => 'popuser';
## Apache user
use constant APACHEUSER => 'psaadm';

## Default charset for output subject line
use constant DEFAULT_CHARSET => 'utf8';

## Command line argumets
use constant COMMANDS => [ qw/start stop restart status/ ];

## Exit codes
use constant EX_OK           =>  0; ## normal exit
use constant EX_STOPPED      =>  1; ## daemon is not running
use constant EX_USAGE        => 64; ## command line usage error
use constant EX_DATAERR      => 65; ## data format error
use constant EX_NOINPUT      => 66; ## cannot open input
use constant EX_NOUSER       => 67; ## addressee unknown
use constant EX_NOHOST       => 68; ## host name unknown
use constant EX_UNAVAILABLE  => 69; ## service unavailable
use constant EX_SOFTWARE     => 70; ## internal software error
use constant EX_OSERR        => 71; ## system error (e.g., can't fork)
use constant EX_OSFILE       => 72; ## critical OS file missing
use constant EX_CANTCREAT    => 73; ## can't create (user) output file
use constant EX_IOERR        => 74; ## input/output error
use constant EX_TEMPFAIL     => 75; ## temp failure; user is invited to retry
use constant EX_PROTOCOL     => 76; ## remote error in protocol
use constant EX_NOPERM       => 77; ## permission denied
use constant EX_CONFIG       => 78; ## configuration erroruse constant EX_USAGE => 64;

## Translator errno-to-ex
use constant ERRNO2EX => {
	EACCES() => EX_NOPERM(),
	EPERM()  => EX_NOPERM(),
	ENOENT() => EX_OSERR(),
};

## Global variables
use vars qw/
	@preferencesA %preferencesH
	%opts %cmds $full_daemon_pid $psa_config
	$spamtest $messagecount $learnedcount $isspam $forget
	$max_children
/;

###########################################################################
## Main access point
## >> class
## << none
sub cmdline_run($) {
	my $class  = shift;
	my $result = EX_OK();

	## First, check for we are running under right user
	$result = $class->user_check_do();
	return $result if $result;

	## Parse command line
	$result = $class->cmdline_parse();
	return $result if $result;

	## Process options
	$result = $class->bayes_train() if $opts{'bayes'} || $opts{'list-mailbox'} || $opts{'info'};
	return $result if $result;

	$result = $class->change_mail_prefs()
		if $opts{'enable-mailname'} || $opts{'disable-mailname'}
			|| $opts{'enable-checking'} || $opts{'disable-checking'};
	return $result if $result;

	$result = $class->update_configuration(1)
		if grep($opts{$_}, keys %{ OPTIONS() }) || scalar @preferencesA || scalar keys %preferencesH;
	return $result if $result;

	$result = $class->mailnames_mass_action()
		if !$opts{'mailname'} && ($opts{'enable'} || $opts{'disable'});
	return $result if $result;

	## Process commands
	$result = $class->start_daemon(1) if $cmds{start};
	return $result if $result;

	$result = $class->stop_daemon(1) if $cmds{stop};
	return $result if $result;

	$result = $class->restart_daemon(1) if $cmds{restart};
	return $result if $result;

	$result = $class->status_daemon(1) if $cmds{status};
	return $result if $result;


	return EX_OK();
}

###########################################################################
## Checks for we are running under the right user
## >> class
## << exitcode
sub user_check_do($) {
	my $class = shift;

	## Not root - may be we are running by apache?
	if ($<) {
		my $uid = getpwnam(APACHEUSER());
		if ($< != $uid) { ## Not apache - warn and exit
			print "You are running script under user '" . getpwuid($<) . "' ";
			print "but 'root' or '" . APACHEUSER() . "' only allowed.\n";
			return EX_USAGE();
		}

		## Ok, we are under apache. Set real user/group to effective
		$< = $>; $( = $);
	}

	return EX_OK();
}

###########################################################################
## Bayesian train
## >> class
## << exitcode
sub bayes_train($) {
	my $class = shift;

	## Load PSA configuration file
	unless ($psa_config) {
		$psa_config = $class->config_parse(PSA_CFG());
		return EX_CONFIG() unless $psa_config;
	}

	## Get mails list
	my ($name, $domain) = split '@', $opts{mailname};
	my $path = $psa_config->{'PLESK_MAILNAMES_D'} . "/$domain/$name";
	my $bayes_override_path = $path . '/.spamassassin/bayes';

	# create the tester factory
	$spamtest = new Mail::SpamAssassin(
		{
			config_text         => '#', ####################### It speeds up!!!
##			rules_filename      => $main::DEF_RULES_DIR,# $opt{'configpath'},
#			site_rules_filename => $opt{'siteconfigpath'},
##			userprefs_filename  => $path . '/user_prefs',# $opt{'prefspath'},
#			username            => POPUSER,# $opt{'username'},
#			debug               => defined( $opt{'debug-level'} ),
			local_tests_only    => 1,
			dont_copy_prefs     => 1,
			PREFIX              => $main::PREFIX,# $PREFIX,
			DEF_RULES_DIR       => $main::DEF_RULES_DIR,# $DEF_RULES_DIR,
			LOCAL_RULES_DIR     => $main::LOCAL_RULES_DIR,# $LOCAL_RULES_DIR,
		}
	);

	$spamtest->init(1);

	# init() above ties to the db r/o and leaves it that way
	# so we need to untie before dumping (it'll reopen)
	$spamtest->finish_learner();
	$spamtest->{conf}->{bayes_path} = $bayes_override_path;

	if (defined $opts{'clear'}) {
		unless ($spamtest->{bayes_scanner}->{store}->clear_database()) {
			$spamtest->finish_learner();
			print "ERROR: Bayes clear returned an error\n";
			return EX_OSERR();
		}

		$spamtest->finish_learner();
		print "Bayes database is cleared.\n";
#		return EX_OK();
	}
	$spamtest->init_learner(
		{
			force_expire      => 0,# $opt{'force-expire'},
			learn_to_journal  => 0,# $opt{'nosync'},
			wait_for_lock     => 1,
			caller_will_untie => 1
		}
	);
	# sync the journal first if we're going to go r/w so we make sure to
	# learn everything before doing anything else.
	#
	$spamtest->rebuild_learner_caches();

	# run this lot in an eval block, so we can catch die's and clear
	# up the dbs.
	my $result = eval {
		$SIG{INT}  = \&killed;
		$SIG{TERM} = \&killed;

		my $iter = new Mail::SpamAssassin::ArchiveIterator(
			{
				'opt_j'   => 1,# 0,
				'opt_n'   => 1,
				'opt_all' => 0, # don't train for big letters
			}
		);

		if ( $opts{'bayes'} ) {

			$iter->set_functions( \&wanted, sub { } );
			$messagecount = 0;
			$learnedcount = 0;

			for my $name (qw/ham spam forget/) {
				$isspam = 0; $forget = 0; ## Flush values

				## How we need to do
				if ($name eq 'ham') { $isspam = 0 }
				elsif ($name eq 'spam') { $isspam = 1 }
				elsif ($name eq 'forget') { $forget = 1 }

				## Ok, collect targets
				my @targets;
				for (@{$opts{$name}}) {
					push @targets, grep -f, glob $_
				}
				next unless @targets;
				@targets = map { ($isspam ? 'spam' : 'ham') . ":detect:$_" } @targets;

				eval { $iter->run(@targets); };

				if ($@) { print "$@\n"; return EX_SOFTWARE() }
#				if ($@ && $@ !~ /HITLIMIT/) { print "$@\n"; return EX_SOFTWARE() }
			}

			print "Learned from $learnedcount message(s) ($messagecount message(s) examined).\n";

		}

		if ( $opts{'list-mailbox'} ) {

			my @targets;

			for my $p ($path . '/Maildir/new', $path . '/Maildir/cur') {
				push @targets, ("h:dir:$p") if grep -f, glob "$p/*";
			}

			if (@targets) {
				$iter->set_functions( \&wanted_seen, sub { } );

				eval { $iter->run(@targets); };

				if ($@) { print "$@\n"; return EX_SOFTWARE() }
			}

		}

		if ( $opts{'info'} ) {
			#$spamtest->{bayes_scanner}->{store}->tie_db_readonly();
			my($sb,$ns,$nh,$nt,$le,$oa,$bv,$js,$ad,$er,$na) = $spamtest->{bayes_scanner}->{store}->get_storage_variables();
			print "Spam: $ns\tHam: $nh\n";
		}

		return EX_OK();
	};

	if ($@) { print "$@\n"; $result = EX_SOFTWARE() }

	$spamtest->finish_learner();

	## Be a popuser
	if (($path . '/.spamassassin/') =~ /^(.+)$/) {
		$path = $1;
	} else {
		print "Cannot determine user's spamassassin settings directory.\n";
		exit EX_DATAERR();
	}

	system('chown', ('-R', POPUSER() . ':' . POPUSER(), $path));

	return $result;
}

###########################################################################
## Lists user's mailbox
## >> class
## << exitcode
sub list_mailbox($) {
	my $class = shift;

	return $class->bayes_train();
}

###########################################################################
## Decodes MIME-coded header
## >> class
## >> raw header
## << clear header
sub decode_header($$) {
	my $class  = shift;
	my $header = shift;

	## Redefine charset if we need it
	my $output_charset = $opts{'output-charset'} || DEFAULT_CHARSET();

	while ($header =~ /=\?(.+?)\?(\w)\?(.+?)\?=/) {
		my $charset = $1; my $encoding_type = $2; my $encoded_body = $3;

		my $decoded_body;
	 	if (uc($encoding_type) eq 'Q') { ## 'Q' type
			$decoded_body = $encoded_body;
			$decoded_body =~ s/_/=20/g;
			$decoded_body = MIME::QuotedPrint::decode($decoded_body);
		} else { ## Not - 'Q' - allways 'B'
			$decoded_body = MIME::Base64::decode_base64($encoded_body);
		}

		## Ok, try to convert from subject's charset to output one
		if ($charset ne $output_charset) {
			my $converter;
			eval { $converter = Text::Iconv->new($charset, $output_charset) }; ## Catch it!
			unless ($@) { ## Uups, not catched.. try it!
				my $converted;
				$converted = $converter->convert($decoded_body);

				## Show decoded string if we can. If not - show original
				$decoded_body = $converted if $converted;
			}
		}

		## All done. Replace raw to clear message
	 	$header =~ s/=\Q?$charset?$encoding_type?$encoded_body?\E=/$decoded_body/;
	}

	return $header;
}

###########################################################################
## Updates configuration file
## >> class
## << exitcode
sub update_configuration($) {
	my $class = shift;

	my $filename = $class->select_config_file();
	my $config = $class->config_parse($filename);
	unless ($config) {
		print "Cannot open or parse config file '$filename'\n";
		return EX_CONFIG();
	}

	my $new_entries = { };
	for (keys %{ OPTIONS() }) {
		if (exists($opts{$_})) {
			my $entrie = OPTIONS()->{$_}->($opts{$_}, $config);
			@$new_entries{keys %$entrie} = values %$entrie;
		}
	}

	unless ($class->config_update($filename, %$new_entries)) {
		print "Cannot open or parse config file '$filename'\n";
		return EX_CONFIG();
	}

	print("File $filename updated successfully.\n");
	return EX_OK();
}

###########################################################################
## Selects current configuration file using passed options and creates it
## if it does not exist
## >> class
## << filename
sub select_config_file($) {
	my $class = shift;

	my $filename = SERVER_CONFIG_FILE();
	if ($opts{'mailname'}) {
		## Load PSA configuration file
		unless ($psa_config) {
			$psa_config = $class->config_parse(PSA_CFG());
			return EX_CONFIG() unless $psa_config;
		}

		my ($name, $domain) = split '@', $opts{mailname};
		my $user_config_dir = $psa_config->{'PLESK_MAILNAMES_D'} . "/$domain/$name/.spamassassin";
		if ($user_config_dir =~ /^(.*)$/) {
			$user_config_dir = $1;
		}
		$filename = "$user_config_dir/user_prefs";
		unless (-d $user_config_dir) {
			mkdir($user_config_dir, 0755);
			my ($login, $pass, $uid, $gid) = getpwnam(POPUSER())
				or do { print POPUSER() . " not in passwd file.\n"; return EX_NOUSER() };
			chown($uid, $gid, $user_config_dir);
		}
	}

	if ($filename =~ /^(.*)$/) {
		$filename = $1;
	}

	## Check for config file exists and create it if not
	unless (-f $filename) {
		sysopen(FOUT, $filename, O_CREAT, 0600);
		close(FOUT);

		## Also, the user's config file must be owned by 'popuser'
		if ($opts{'mailname'}) {
			my ($login, $pass, $uid, $gid) = getpwnam(POPUSER())
				or do { print POPUSER() . " not in passwd file.\n"; return EX_NOUSER() };

			chown($uid, $gid, $filename);
		}
	}

	return $filename;
}
###########################################################################
## Change props of mailname(s). Thin wrapper around change_mail_prefs_one
## >> class
## << exitcode

sub change_mail_prefs($) {
	my $class = shift;
	my $status_code = EX_OK();
	foreach my $mailname (split(" ", $opts{'mailname'})) {
		my $rc = $class->change_mail_prefs_one($mailname);
		if ($rc != EX_OK()) {
			$status_code = $rc;
		}
	}
	return $status_code;
}

###########################################################################
## Change props of one mailname
## >> class
## << exitcode
sub change_mail_prefs_one($) {
	my $class = shift;
	my $mailname = shift;

	# Fix of Insecure $ENV{PATH}
	delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
	$ENV{'PATH'} = $main::ADMIN_DIR;

	#Fix Insecure dependency
	if ($mailname =~ /^([\w\-\'][\w+\-\']*(\.[\w+\-\']+)*\@\w+[\w-]*(\.\w[\w-]*)+.*)$/) {
		$mailname = $1;
	}

	my @args = ('--check',
		    '--name=' . HOOK_TMPL(),
		    '--type=' . 'recipient', 
		    '--mailname=' . $mailname,
		    '--queue=' . 'before-local'
		    );

	system($main::ADMIN_DIR . '/mail_handlers_control', @args);
	my $h_exists = $? >> 8;
	my $exitcode = 0;

	if ($opts{'enable-checking'}) {
		if ($h_exists) {
			@args = (qw|--enable|, 
				    '--name=' . HOOK_TMPL(),
				    '--type=' . 'recipient', 
				    '--mailname=' . $mailname,
				    '--queue=' . 'before-local'
				);

			system($main::ADMIN_DIR . '/mail_handlers_control', @args);

			$exitcode = $? >> 8;
			if ($exitcode) {
				print "Unable to make operation with spam handler for mailname $mailname.\n";
				return ERRNO2EX()->{$exitcode} || EX_OSERR();
			}
		}
		return EX_OK();
	}

	if ($opts{'disable-checking'}) {
		if ($h_exists) {
			@args = (qw|--disable|, 
				    '--name=' . HOOK_TMPL(),
				    '--type=' . 'recipient', 
				    '--mailname=' . $mailname,
				    '--queue=' . 'before-local'
				);

			system($main::ADMIN_DIR . '/mail_handlers_control', @args);

			$exitcode = $? >> 8;
			if ($exitcode) {
				print "Unable to make operation with spam handler for mailname $mailname.\n";
				return ERRNO2EX()->{$exitcode} || EX_OSERR();
			}
		}
		return EX_OK();
	}

	if ($opts{'enable-mailname'}) {
		my $context = 'text';

		if ($opts{'action'} eq 'delete') {
			$context = 'delete';
		} elsif ($opts{'action'} eq 'move') {
			$context = 'move';
		}

		if ($h_exists) {
			@args = (qw|--remove|,
				    '--name=' . HOOK_TMPL(),
				    '--type=' . 'recipient', 
				    '--mailname=' . $mailname,
				    '--queue=' . 'before-local'
				);

			system($main::ADMIN_DIR . '/mail_handlers_control', @args);

			$exitcode = $? >> 8;
			if ($exitcode) {
				print "Unable to remove spam handler for mailname $mailname.\n";
				return ERRNO2EX()->{$exitcode} || EX_OSERR();
			}
		}

		@args = (qw|--add|,
			'--name=' . HOOK_TMPL(), 
			'--type=' . 'recipient', 
			'--mailname=' . $mailname,
			'--context=' . $context,
			'--priority=' . SPAM_HOOK_PRIORITY(), 
			'--queue=' . 'before-local',
			'--executable=' . SPAM_HOOK(),
			'--enabled'
			);

		system($main::ADMIN_DIR . '/mail_handlers_control', @args);

		$exitcode = $? >> 8;
		if ($exitcode) {
			print "Unable to register handler.\n";
			return ERRNO2EX()->{$exitcode} || EX_OSERR();
		}

		return EX_OK();
	}

	if ($opts{'disable-mailname'}) {
		if ($h_exists) {
			@args = (qw|--remove|,
				    '--name=' . HOOK_TMPL(),
				    '--type=' . 'recipient', 
				    '--mailname=' . $mailname,
				    '--queue=' . 'before-local'
				);

			system($main::ADMIN_DIR . '/mail_handlers_control', @args);

			$exitcode = $? >> 8;
			if ($exitcode) {
				print "Unable to make operation with spam handler for mailname $mailname.\n";
				return ERRNO2EX()->{$exitcode} || EX_OSERR();
			}
		}
		return EX_OK();
	}

	return EX_OK();
}

sub mailnames_mass_action {
	if ($opts{'mailname'}) {
		return EX_OK();
	}

	my @args;

	delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
	$ENV{'PATH'} = '/bin:/usr/bin:/usr/local/bin';

	if ($opts{'enable'}) {
		@args = (qw|--enable-handler|, 
			    '--handler-name=' . HOOK_TMPL(),
			    '--handler-type=' . 'recipient',
			    '--handler-type-name=' . 'all', 
			    '--hook=' . 'before-local'
			);
	} elsif ($opts{'disable'}) {
		@args = (qw|--disable-handler|, 
			    '--handler-name=' . HOOK_TMPL(),
			    '--handler-type=' . 'recipient',
			    '--handler-type-name=' . 'all', 
			    '--hook=' . 'before-local'
			);
	} else {
		return EX_OK();
	}

	system($main::ADMIN_DIR . '/mailmng', @args);

	my $exitcode = $? >> 8;
	if ($exitcode) {
		print "Unable to make mass operation with spam handlers.\n";
		return ERRNO2EX()->{$exitcode} || EX_OSERR();
	}

	return EX_OK();
}

###########################################################################
## Starts the Spamassassin's daemon
## >> class
## >> show messages
## << exitcode
sub start_daemon($) {
	my $class = shift;
	my $msgs  = shift;

	my $daemon_status = $class->status_daemon();

	if ($daemon_status == EX_OK()) {
		print "Service is already started.\n" if $msgs;
		return EX_OK();
	}

	unless ($daemon_status == EX_STOPPED()) {
		print "The service was not stopped properly. Trying to stop it first...\n" if $msgs;
		unless ((my $status = $class->stop_daemon($msgs)) == EX_OK()) {
			print "Unable to start service.\n" if $msgs;
			return $status;
		}
	}

	## Load PSA configuration file
	unless ($psa_config) {
		$psa_config = $class->config_parse(PSA_CFG());
		return EX_CONFIG() unless $psa_config;
	}

	chdir($main::QMAIL_DIR); ## Prevent daemon died

	## Common arguments
	my @common_args = (qw|--username=popuser --daemonize --nouser-config|);
	push @common_args, '--helper-home-dir=' . $main::QMAIL_DIR;

	$max_children = $opts{'max-children'} =~ /^(\d+)$/ ? $1 : 5;
	push @common_args, '--max-children', $max_children;

	push @common_args, (
		qw|--create-prefs|,
		'--virtual-config-dir='
		. $psa_config->{'PLESK_MAILNAMES_D'} . '/%d/%l/.spamassassin',
	) if $opts{'enable-user-configs'};

	## Start full configured daemon
	my @args = ( @common_args, '--pidfile=' . PID_DIR . '/spamd_full.pid' );
	push @args, ('--socketpath=' . SOCK_DIR . '/spamd_full.sock');

	# Fix of Insecure $ENV{PATH}
	delete @ENV{qw(IFS CDPATH ENV BASH_ENV)};
	$ENV{'PATH'} = $main::PREFIX . $main::SPAMD_PREFIX;

	system($main::PREFIX . $main::SPAMD_PREFIX . '/spamd', @args);

	my $exitcode = $? >> 8;
	if ($exitcode) {
		print "Unable to start service.\n" if $msgs;
		return ERRNO2EX()->{$exitcode} || EX_OSERR();
	}

	for ( 1 .. 20 ) {
		$daemon_status = $class->status_daemon();
		last if $daemon_status == EX_OK();
		sleep 1;
	}
		
	unless ($daemon_status == EX_OK()) {
		print "Unable to start service.\n" if $msgs;
		return $daemon_status;
	}

	print "Service has been successfully started.\n" if $msgs;
	return EX_OK();
}

###########################################################################
## Stops the Spamassassin's daemon
## >> class
## >> show messages
## << exitcode
sub stop_daemon($) {
	my $class = shift;
	my $msgs  = shift;

	# Check service's status.
	if ($class->status_daemon() == EX_STOPPED()) {
		print "Service is already stopped.\n" if $msgs;
		return EX_OK();
	}

	my @pids = grep { /^\d+$/ && $_ } ($full_daemon_pid);

	my $fail;

	for my $signal ('TERM', 'KILL') {
		$fail = 0;
		last unless @pids;

		# Send signal.
		for (@pids) {
			unless (kill($signal, $_) or $!{ESRCH}) {
				warn "$0: $!\n";
				$fail = 1;
			}
		}

		if ($fail) {
			print "Unable to stop service.\n" if $msgs;
			return EX_OSERR();
		}

		# Wait until the daemons die.
		for ( 1 .. 20 ) {
			last unless @pids;
			sleep 1;
			@pids = grep {
				my $alive = kill(0, $_);
				unless ($alive or $!{ESRCH}) {
					warn "$0: $!\n";
					$alive = 1;
				}
				$alive;
			} @pids;
		}
	}

	if (@pids) {
		print "Unable to stop service.\n" if $msgs;
		return EX_OSERR();
	}

	print "Service has been successfully stopped.\n" if $msgs;
	return EX_OK();
}

###########################################################################
## Restarts the Spamassassin's daemon
## >> class
## >> show messages
## << exitcode
sub restart_daemon($) {
	my $class = shift;
	my $msgs  = shift;

	my $daemon_status = $class->status_daemon();

	if ($daemon_status == EX_STOPPED()) {
		print "Unable to restart: the service is not running.\n" if $msgs;
		return EX_STOPPED();
	}

	unless ($daemon_status == EX_OK()) {
		my $status;
		print "The service was not stopped properly. Trying to stop it first...\n" if $msgs;
		unless (($status = $class->stop_daemon($msgs)) == EX_OK()) {
			print "Unable to restart service.\n" if $msgs;
			return $status;
		}

		print "Now trying to start it...\n" if $msgs;
		unless (($status = $class->start_daemon($msgs)) == EX_OK()) {
			print "Unable to restart service.\n" if $msgs;
			return $status;
		}

		print "Service has been successfully restarted.\n" if $msgs;
		return EX_OK();
	}

	my @pids = ($full_daemon_pid);

	# Send signals.
	## if spamd receives SIGHUP, it internally reloads itself, which means that it will change its pid
	for (@pids) {
		unless (/^\d+$/ and kill HUP => $_) {
			warn "$0: $!\n";
			print "Unable to restart service.\n" if $msgs;
			return EX_OSERR();
		}
	}

	# Wait until the daemons die.
	for ( 1 .. 20 ) {
		last unless @pids;
		sleep 1;
		@pids = grep {
			my $alive = kill(0, $_);
			unless ($alive or $!{ESRCH}) {
				warn "$0: $!\n";
				$alive = 1;
			}
			$alive;
		} @pids;
	}

	if (@pids) {
		print "Unable to restart service.\n" if $msgs;
		return EX_OSERR();
	}

	for ( 1 .. 20 ) {
		$daemon_status = $class->status_daemon();
		last if $daemon_status == EX_OK();
		sleep 1;
	}
		
	unless ($daemon_status == EX_OK()) {
		print "Unable to restart service.\n" if $msgs;
		return $daemon_status;
	}

	print "Service has been successfully restarted.\n" if $msgs;
	return EX_OK();
}

###########################################################################
## Status the Spamassassin's daemon
## >> class
## >> messages - output status messages
## << EX_OK for running and EX_STOPPED if else
sub status_daemon($;$) {
	my $class = shift;
	my $msgs  = shift;

	my @pids = grep { /^\d+$/ && $_ } ($full_daemon_pid);
	if (scalar @pids && scalar @pids == kill 0, @pids) {
		print "is running\n" if $msgs;
		return EX_OK();
	}

	my $pidfile;
	for my $pid ($full_daemon_pid) {
#		unless ($pidfile) { $pidfile = PID_DIR . '/spamd_full.pid' }
#		else { $pidfile = PID_DIR . '/spamd_light.pid' }
		$pidfile = PID_DIR . '/spamd_full.pid';

		$pid = undef;
		if (open(PIDFILE, $pidfile)) {
			## Read pidfile
			chomp($_ = <PIDFILE>);
			close(PIDFILE);

			## Check for a number
			unless (/(\d+)/ && $1) {
				warn "$0: Pidfile $pidfile does not contain valid PID.\n";
				return EX_OSFILE();
			}
			$pid = $1;
		}
		else {
			unless ($!{ENOENT}) {
				warn "$0: $!$/";
				return EX_OSFILE();
			}
		}
	}

	@pids = grep { /^\d+$/ && $_ } ($full_daemon_pid);
	my $count = kill 0, @pids;

	unless ($count) {
		return EX_STOPPED();
	}

	unless ($count == scalar @pids) {
		print "The service was not stopped properly.\n" if $msgs;
		return EX_SOFTWARE();
	}

	print "is running\n" if $msgs; ## For 'clever' PSA
	return EX_OK();
}

sub add_to_list()
{
	my $class = shift;
	my $name = shift;
	my @values = split /(?<!\\),\s*/, join ',', @_;

	foreach my $value (@values) {
		push @preferencesA, { name => $name, value => $value };
		$preferencesH{$name}{$value} = scalar @preferencesA;
	}
}

sub del_from_list()
{
	my $class = shift;
	my $name = shift;
	my @values = split /(?<!\\),\s*/, join ',', @_;

	foreach my $value (@values) {
		$preferencesH{$name}{$value} = undef unless exists $preferencesH{$name}{$value};
	}
}

###########################################################################
## Parse command line arguments
## Method will exits on error
## >> class
## << none
sub cmdline_parse($) {
	my $class = shift;

	Getopt::Long::Configure(qw(no_ignore_case));

	do { print "Command line usage invalid.\n"; return EX_USAGE() }
		unless GetOptions(\%opts,
			'enable',
			'disable',
			'enable-server-configs|c',
			'enable-user-configs|C',
			'sensitivity|s=f',
			'modify-header|m=s',
			'not-modify-header|M',
			'add-to-whitelist|a=s' => sub { shift; $class->add_to_list('whitelist_from', @_) },
			'add-to-blacklist|A=s' => sub { shift; $class->add_to_list('blacklist_from', @_) },
			'del-from-whitelist|d=s' => sub { shift; $class->del_from_list('whitelist_from', @_) },
			'del-from-blacklist|D=s' => sub { shift; $class->del_from_list('blacklist_from', @_) },
			'add-to-unwhitelist|u=s' => sub { shift; $class->add_to_list('unwhitelist_from', @_) },
			'add-to-unblacklist|U=s' => sub { shift; $class->add_to_list('unblacklist_from', @_) },
			'del-from-unwhitelist|l=s' => sub { shift; $class->del_from_list('unwhitelist_from', @_) },
			'del-from-unblacklist|L=s' => sub { shift; $class->del_from_list('unblacklist_from', @_) },
			'enable-checking',
			'disable-checking',
			'enable-mailname|e',
			'disable-mailname|E',
			'action|z=s',
			'bayes|b',
			'spam|p=s'   => \@{$opts{spam}},
			'ham|h=s'    => \@{$opts{ham}},
			'forget|f=s' => \@{$opts{forget}},
			'clear|r',
			'info|i',
			'mailname|n=s',
			'list-mailbox|x',
			'output-charset|o=s',
			'max-children=i',
#			'rewrite-config',
			'help|?',
		);
	for my $name (qw/spam ham forget/) {
		@{$opts{$name}} = split /(?<!\\),\s*/, join ',', @{$opts{$name}};
		for (@{$opts{$name}}) { s/\\,/,/g };
	}

	## Ok, options has been parsed. Let's get commands
	for my $cmd (@{ COMMANDS() }) {
		my $i = 0;
		for my $arg (@ARGV) {
			last if $cmd eq $arg;
			$i++;
		}

		$cmds{$cmd} = 1 unless $i > $#ARGV;
		splice(@ARGV, $i, 1);
	}

	## Define on-cmd line parse error method
	my $cmd_error = sub {
		my @lines = @_;

		push @lines, 'For usage information start utility with \'--help\' option.';
		chomp(@lines); my $msg = join "\n", @lines; $msg .= "\n"; print $msg;

		return EX_USAGE();
	};

	## Ok, commands parsed. All of another - is a trash
	if (@ARGV) {
		my $s = $#ARGV ? 's' : '';
		return $cmd_error->("Unknown option$s/argument$s '@ARGV' specified.");
	}

	## Help needed
	return usage("For more information read the manual page", EX_OK())
		if $opts{'help'} || !(%opts || %cmds);

	return $cmd_error->("Too many arguments specified.")
		if keys(%cmds) > 1;


	## Command line parsed. Let's check dependencies and cross-races
	$opts{'mailname'} =~ s/,/ /g;

	if ($opts{'mailname'}) {
		## validate each mailaccout separately
		## local of mailname validator completely taken from frontend Checker.pnp/mailname()
		foreach my $mailname (split(/ /,$opts{'mailname'})) {
			return $cmd_error->("Specified mailname '${mailname}' is invalid.") unless
				$mailname =~ /^[\w\-\'][\w&\+\-\']*(\.[\w&\+\-\']+)*\@\w+[\w\-]*(\.\w[\w\-]*)+$/;
		}
	}

	return $cmd_error->("'--enable-user-configs' specified without 'start' command.")
		if $opts{'enable-user-configs'} && !($cmds{'start'} || $cmds{'restart'});

	return $cmd_error->("'--bayes' specified without any train option.")
		if $opts{'bayes'} && !$opts{'spam'} && !$opts{'ham'} && !$opts{'forget'} && !$opts{'clear'};

	return $cmd_error->("'--enable-checking' specified without '--mailname' option")
		if $opts{'enable-checking'} && !$opts{'mailname'};

	return $cmd_error->("'--disable-checking' specified without '--mailname' option")
		if $opts{'disable-checking'} && !$opts{'mailname'};

	return $cmd_error->("'--enable-checking' specified with '--disable-checking' option")
		if $opts{'enable-checking'} && $opts{'disable-checking'};

	return $cmd_error->("'--enable-mailname' specified without '--mailname' option")
		if $opts{'enable-mailname'} && !$opts{'mailname'};

	return $cmd_error->("'--disable-mailname' specified without '--mailname' option")
		if $opts{'disable-mailname'} && !$opts{'mailname'};

	return $cmd_error->("'--enable-mailname' specified with '--disable-mailname' option")
		if $opts{'enable-mailname'} && $opts{'disable-mailname'};

	return $cmd_error->("'--action' specified without '--enable-mailname' option")
		if $opts{'action'} && !$opts{'enable-mailname'};

	return $cmd_error->("'--enable-server-configs' specified without '--enable-mailname' option or 'start' command.")
		if $opts{'enable-server-configs'} && !($opts{'enable-mailname'} || $cmds{'start'} || $cmds{'restart'});

	return $cmd_error->("'--list-mailbox' specified without '--mailname' option")
		if $opts{'list-mailbox'} && !$opts{'mailname'};

	return $cmd_error->("'--output-charset' specified without '--list-mailbox' option")
		if $opts{'output-charset'} && !$opts{'list-mailbox'};

	return $cmd_error->("'--max-children' specified without 'start' command.")
		if $opts{'max-children'} && !($cmds{'start'} || $cmds{'restart'});

	return EX_OK();
}

###########################################################################
## Updates Unix-like config file
## >> class
## >> filename
## >> hash of config entries for update (undef value means 'remove entrie')
## << 1 on success or undef on error
sub config_update($$) {
	my $class    = shift;
	my $filename = shift;
	my %entries  = @_;

	## Try to open file
	unless (open(CONF, $filename)) {
		print "Unable to open file '$filename': $!\n";
		return undef;
	}
	## Load all of config
	my @config = <CONF>;
	close(CONF); ## Done loading

	## Try to create file
	$filename =~ /^(.+)$/; $filename = $1; ## care about -T option
	unless (open(CONF, ">$filename")) {
		print "Unable to create file '$filename': $!\n";
		return undef;
	}

	my $selfGeneratedConfigText = "#ATTENTION!
#
#DO NOT MODIFY THIS FILE BECAUSE IT WAS GENERATED AUTOMATICALLY,
#SO ALL YOUR CHANGES WILL BE LOST THE NEXT TIME THE FILE IS GENERATED.
";
	print CONF $selfGeneratedConfigText;

	## Ok, put all of config file but replace a new entries
	for (@config) {
		next if /^\s*#/; ## skip comments

		next unless /^(\S+)\s+(.+)$/; ## parse key-value pair

		if (exists($entries{$1})) {
			## this entrie must be updated
			$_ = defined $entries{$1} ? "$1\t$entries{$1}\n" : '';
			delete $entries{$1};
		}

		if (exists($preferencesH{$1}{$2})) {
			$_ = '';
		}

		print CONF; ## Ok, output entry
	}

	## Ok, config file patched. Let's add new entries
	print CONF "$_" . ($entries{$_} ne '' ? "\t$entries{$_}" : '') . "\n"
		for grep defined $entries{$_}, keys %entries;

	print CONF "$_->{name}\t$_->{value}\n"
		for (@preferencesA);

	close(CONF); ## All done

	return 1;
}

###########################################################################
## Parses Unix-like config file
## >> class
## >> filename
## << hashref with config data on success or undef on error
sub config_parse($$) {
	my $class    = shift;
	my $filename = shift;
	my $result   = { };

	## Try to open file
	unless (open(CONF, $filename)) {
		print "Unable to open file '$filename': $!\n";
		return undef;
	}

	## Parse all of config
	while (<CONF>) {
		s/^\s*(.+?)\s*$/$1/;

		## Skip comment lines
		next if /^#/;
		next unless /^(\S+)\s+(.+)$/;

		$result->{$1} = $2;
	}

	close(CONF); ## Well, done

	return $result;
}

###########################################################################
## Safe on-kill method. It will handles SIGTERM and SIGKILL
## >> none
## << none
sub killed {
	$spamtest->finish_learner();
	print "interrupted\n" . EX_TEMPFAIL() . "\n";
	exit(EX_TEMPFAIL());
}

###########################################################################
## Learn for one mail message
## >> message ID
## >> message count
## >> arrayref with lines of message
sub wanted {
	my ( $class, $id, $time, $dataref ) = @_;

	my $spam = $class eq "s" ? 1 : 0;
	$messagecount++;
	my $ma = $spamtest->parse($dataref);

	if ( $ma->get_header("X-Spam-Checker-Version") ) {
		my $dataref = $spamtest->remove_spamassassin_markup($ma);
		$ma->finish();
		$ma = $spamtest->parse($dataref, 1);
	}

	my $status = $spamtest->learn( $ma, undef, $spam, $forget );
	$learnedcount++ if $status->did_learn();

	# Do cleanup ...
	$status->finish();
	undef $status;

	$ma->finish();
	undef $ma;
}

###########################################################################
##
##
##
##
##
sub wanted_seen {
	my ($class, $id, $time, $dataref) = @_;

	my $ma = $spamtest->parse($dataref);
	chomp(my $subject = $ma->get_pristine_header('Subject'));
	chomp(my $from    = $ma->get_pristine_header('From'));
	chomp(my $date    = $ma->get_header('Date'));
	my $hits          = $ma->get_header('X-Spam-Status');
	if ($hits) {
		$hits =~ /\s(hits|score)=(\S+)\s/;
		$hits = $2;
	} else {
		$hits = '?';
	}
	chomp(my $message_id = $ma->get_header('Message-ID'));

	if ( $ma->get_header("X-Spam-Checker-Version") ) {
		my $dataref = $spamtest->remove_spamassassin_markup($ma);
		$ma->finish();
		$ma = $spamtest->parse($dataref);
	}

	my $seen = '?';
	my @msgid = $spamtest->{bayes_scanner}->get_msgid($ma);
	foreach my $msgid (@msgid) {
		$seen = $spamtest->{bayes_scanner}->{store}->seen_get($msgid) || $seen;
	}

	## Print all 'bout mail, but first - decode all of them
	for ($subject, $from) {
		$_ = Mail::SpamAssassin::CmdManageSA3->decode_header($_);
		s/\t/    /g; s/[\n\r]+/ /g;
	}

	my $filename = $id =~ /^([^:]+):2,(.*)$/ ? $1: $id;

	print "$filename\t$subject\t$from\t$date\t$seen\t$hits\t$message_id\n" unless ($2 =~ /T/); # Don't display Trashed messages.

	# Do cleanup ...
	$ma->finish();
	undef $ma;
}

###########################################################################
## Shows usage information from the caller's POD
## >> message - The text of a message to print immediately prior to printing the program's usage message
## >> exitval - The desired exit status to pass to the exit() function. This should be an integer
sub usage($$) {
	my ($message, $exitval) = @_;
	my $ver = Mail::SpamAssassin::Version();
	print "SpamAssassin version $ver\n";
	pod2usage(-verbose => 1, -message => $message, -exitval => $exitval);
}

1;