#!/usr/bin/perl --
# perl antispam smtp proxy professional
# (c) John Hanna, John Calvi, Robert Orso, AJ 2004 under the terms of the GPL
# (c) Fritz Borgstedt 2006 under the terms of the GPL
# (c) Thomas Eckardt 2008 under the terms of the GPL
# 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;

# 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.
# ASSP founded and developed to Version 1.0.12 by John Hanna
# ASSP development since 1.0.12 by John Calvi
# ASSP development since 1.2.0 by Fritz Borgstedt
#
# ASSP V2 pro development since 2.0.0 by
# Thomas Eckardt - DB Support, Conversions, Transparent SMTP Proxy, SSL/TLS support,
#                  LDAP-List, recipient replacement, Plugins, multithreading,
#                  global-penalty-box, backscatter-checks(BATV,FBMTV,DNS), VRFY-check,
#                  MailLog- and Resend-Function, multipart SpamReport, RebuildSpamDB,
#                  move2num, https for GUI, many GUI improvements,Block Reports,
#                  encryption, DB-encryption, DKIM/Domainkey, AdminUsers Interface,
#                  connection damping, code autoupdate, GUI multi language support,
#                  local charset support, UTF8 support for check engines,
#                  delay queuing, LDAPS, global penaltybox , regex optimization,
#                  POP3 collector, config sync , SNMP, group management ,IPv6 support,
#                  Crash Analyzer , Perl module update, (Win32)Unicode support, DMARC,
#                  private Whitelist
#
# Feature implementations:
# AJ - Web interface
# Robert Orso - LDAP
# Nigel Barling - SPF & DNSBL
# Mark Pizzolato - SMTP Session Limits
# Przemek Czerkas - SRS, Delaying, Maillog Search, HTTP Compression, URIBL, RWL,
#					and many ideas and pieces
# Craig Schmitt - SPF2 & code optimizing
# Misc. contributions:
# Wim Borghs, Micheal Espinola, Doug Traylor, Lars Troen, Marco Tomasi,
# Andrew Macpherson, Marco Michelino, Matti Haack, Dave Emory, Kevin,
# Grayhat (Andrea), Victor Miasnikov
#
# the latest released version is available at:
# http://downloads.sourceforge.net/projects/assp/files/ASSP%20V2%20multithreading/autoupdate/assp.pl.gz
#
# the latest development version is available at
# http://assp.cvs.sourceforge.net/viewvc/*checkout*/assp/assp2/assp.pl.gz

## no critic qw(BuiltinFunctions::ProhibitStringyEval)

use strict qw(vars subs);

our %signo;
sub check_iThreads {
use Config qw(myconfig);

my $iThreads = myconfig();
$iThreads =~ /useithreads\s*=\s*([^\s\r\n]+)/gio;
$iThreads = lc($1);
{
    my $i = 0;
    foreach (split(/\s+/o, $Config::Config{sig_name})) {
        $signo{$_} = $i;
        $i++;
    }
}

die <<EOT  if ($iThreads !~ /define/i);

***** ATTENTION *****

******************************************************************************
This version of Perl ( $] ) does not support iThreads (multithreading)!
iThreads are needed to run ASSP version 2.0.0 or higher!
To get more information about your Perl installation
start the following commands in commandline or shell:

perl -v
perl -V

Upgrade your Perl installation to a multithreading version or
use a singlethread version of ASSP (version 1.x.x)!
To run this version of ASSP, a Perl version 5.016003 (5.16.3) or higher
is recommended - a version 5.010000 is at least required.
Perl version 6.x is not supported.
******************************************************************************

EOT
no Config;
undef $iThreads;
}

my $VSTR;
BEGIN {
    $VSTR = $];
    $VSTR =~ s/^(5\.)0(\d\d).+$/$1$2/o;
}

use 5.010;
use feature ":$VSTR";     # <- turn on the available version features
use threads 1.69 ('yield');
use threads::shared 1.18;
use Thread::Queue 2.06;
use IO::Poll 0.07 qw(POLLIN POLLOUT POLLERR POLLHUP POLLNVAL);
use IO::Select;
use Encode 2.12;
use File::Copy;
use IO::Socket;
use Sys::Hostname;
use Time::Local;
use Time::HiRes;
use HTML::Entities ();
use Cwd;
use MIME::Base64();
use MIME::QuotedPrint();
no warnings qw(uninitialized);  # possibly add   'recursion' and/or 'utf8'

#eval{$^M = 'a' x (1 << 16);}; # use 64KB for "out of memory" area
STDOUT->autoflush;
STDERR->autoflush;
$SIG{ALRM} = sub {};

our $MAINVERSION;
our $MajorVersion;
our $version;
our $modversion;
our $build;
our $availversion:shared;
our $versionURL;
our $NewAsspURL;
our $ChangeLogURL;
our $requiredSelfLoaderVersion;
our %requiredDBVersion:shared;
our $codename;
our $perl = $^X;
our $assp = $0;
our $allIdle:shared = 0;

#
sub setVersion {
$version='2.3.3';
$build = '14029';
$modversion="($build)";    #appended in version display (YYDDD[.subver]).
$MAINVERSION = $version . $modversion;
$MajorVersion = substr($version,0,1);
$requiredSelfLoaderVersion = '2.03';
#$codename = 'SIC58&nbsp;&dagger;&nbsp;';
$codename = '';

# the database versions build and required by this release
$requiredDBVersion{'Spamdb'} = $MajorVersion.'_13218_'.$];
$requiredDBVersion{'HMMdb'}  = $MajorVersion.'_13218_'.$];
}
#
&setVersion();

our $utf8;
our $open;
our $unicodeFH;
our $unicodeDH;
our $move;
our $copy;
our $unlink;
our $rename;
our $chmod;
our $stat;
our $mkdir;
our $rmdir;
our $rmtree;
our $eF;
our $dF;
our $unicodeName;

sub disableUnicode {
    $utf8 = sub {};
    $open = sub { open(shift,shift,shift); };    ## no critic
    $unicodeFH = sub {};
    $unicodeDH = sub { opendir(my $d,shift);my @l = readdir($d);close $d;return @l; };
    $move = sub { File::Copy::move(shift,shift) };
    $copy = sub { File::Copy::copy(shift,shift) };
    $unlink = sub { unlink(shift) };
    $rename = sub { rename(shift,shift) };
    $chmod = sub { chmod(shift,shift) };
    $stat = sub { stat(shift) };
    $mkdir = sub { mkdir(shift,shift) };
    $rmdir = sub { rmdir(shift) };
    $rmtree = sub { return unless eval('use File::Path 2.00 ();1;'); File::Path::remove_tree(@_);};
    $eF = sub { -e shift; };
    $dF = sub { -d shift; };
    $unicodeName = sub { $_[0];};
}
disableUnicode();

my ($subversion) = $version =~ /\d+\.\d+\.(\d+)/o;
if ($subversion % 2) {
# stabil published version download
    $versionURL = 'http://downloads.sourceforge.net/project/assp/ASSP%20V2%20multithreading/autoupdate/version.txt';
    $NewAsspURL = 'http://downloads.sourceforge.net/project/assp/ASSP%20V2%20multithreading/autoupdate/assp.pl.gz';
    $ChangeLogURL = 'http://downloads.sourceforge.net/project/assp/ASSP%20V2%20multithreading/changelog.txt';
} else {
# stabil development (beta) version download
    $versionURL = 'http://assp.cvs.sourceforge.net/viewvc/*checkout*/assp/assp2/version.txt';
    $NewAsspURL = 'http://assp.cvs.sourceforge.net/viewvc/*checkout*/assp/assp2/assp.pl.gz';
    $ChangeLogURL = 'http://assp.cvs.sourceforge.net/viewvc/*checkout*/assp/assp2/changelog.txt';
}
our $gripListDownUrl = 'http://*HOST*/cgi-bin/assp_griplist?binary';
our $gripListUpUrl = 'http://*HOST*/cgi-bin/assp_griplist?binary';
our $gripListUpHost = 'assp.sourceforge.net';
$gripListDownUrl =~ s/\*HOST\*/$gripListUpHost/o;
$gripListUpUrl  =~ s/\*HOST\*/$gripListUpHost/o;
our $GroupsFileURL = 'http://assp.cvs.sourceforge.net/viewvc/*checkout*/assp/assp2/files/groups.txt';
#-----------

our %neverLockTable;
our %skipDeclare;
our @ConfigArray;
our %Modules;
our %ModulesUsed;
our @prelog;
our $mydb;
our %DBvars;
our %tempDBvars;
our %Config:shared;
our %ConfigSync;
our %newConfig;
our %ConfigAdd;
our %RunTaskNow:shared;
our $Charsets;
our %CurrentMEM:shared;
our $base:shared;
our %Plugins:shared;
our %PluginFiles:shared;
our $runlvl0PL:shared;
our $runlvl1PL:shared;
our $runlvl2PL:shared;
our $wikiinfo;
our $mtObj = threads->self();
our $DBdrivers;
our $DBdriversJ;
our $DBautocommit = 1;
our $dftrestartcmd;
our $dftCaFile;
our $dftCertFile;
our $dftPrivKeyFile;
our $AsAService;
our $ServiceStopping = 0;
our $LogDateFormat;
our $LogDateLang;
our $defaultLogCharset;
our $WorkerNumber = 0;
our $WorkerName = 'startup';
our %lngmsg;
our %lngmsghint;
our $PIDH;
our $NODHO = 1;
our $CreateMIB = 0;
our $GPBinstallLib;
our $GPBmodTestList;
our $GPBCompLibVer;
our $crashHMM;
our $optReModule;
our %MemTable;
our %MemTableHist;
#our $ProtPrefix = '(?:'.erw('ht').'|' .erw('f').')'.erw('tp').erw('s','?').erw('://');  # (ht|f)tps?://

# *********************************************************************************************************************************************
# hidden config variables that could be changed using the module CorrectASSPcfg.pm
# or that could be changed using a commandline switch like --enableCrashAnalyzer:=1
# *********************************************************************************************************************************************

# CrashAnalyzer related
our $enableCrashAnalyzer = 0;            # (0/1) enable the automatic crash analyzer (CA)
our $CrashAnalyzerTopCount = 10;         # (number > 0) number of records used for the CA top count
our $CrashAnalyzerWouldBlock = 1;        # (0/1) block the mail if CA detects that the mail would crash ASSP

#IP related
our $IPv6TestPort = '51965';             # (port number) the port number that is used at startup to bind IPv6 to - to check if IPv6 is available
our $forceDNSv4:shared = 1;              # (0/1) force DNS querys to use IPv4 instead to try IPv6 first

# Bayesian and HMM related
our $HMMSequenceLength = 4;              # (number > 0) count of words used for a sequence
our $HMMDBWords = 600;                   # (number > 0) number of words used per mail in rebuildspamdb
our $BayesDomainPrior = 2;               # (number > 0) Bayesian/HMM domain entry priority (1 = lowest)
our $BayesPrivatPrior = 3;               # (number > 0) Bayesian/HMM privat/user entry priority (1 = lowest)

# logging related
our $AUTHLogUser = 0;                    # (0/1) write the username for AUTH (PLAIN/LOGIN) to maillog.txt
our $AUTHLogPWD = 0;                     # (0/1) write the userpassword for AUTH (PLAIN/LOGIN) to maillog.txt
our $Unidecode2Console = 0;              # (0/1) use Text::Unidecode to decode NONASCII characters to ASCII - if available  - if set - 'ConsoleCharset' is ignored
our $showMEM = 0;                        # (0/1) show the current memory usage in every worker
our $AnalyzeLogRegex = 0;                # (0/1) enables enhanced regex analyzing (in console mode only)

# database related
our $forceTrunc4ClearDB = 0;             # (0/1) try/force a 'TRUNCATE TABLE' instead of a 'DELETE FROM' - 'DELETE FROM' is used as fall back if the truncate failes
our $DoSQL_LIKE = 1;                     # (0/1) do an 'DELETE FROM table WHERE pkey LIKE ?' to remove generic keys
our $lockBDB = 0;                        # (0/1) use the CDB locking for BerkeleyDB (default = 0)
our $lockDatabases = 0;                  # (0/1) locks all databases on access in every worker to prevent access violation
our $DBCacheSize = 12;                   # (number > 0) database cache record count , if less it will be set to NumComWorkers * 2 + 8

# some more
our $SPF_max_dns_interactive_terms = 10; # (number > 0) max_dns_interactive_terms max number of SPF-mechanism per domain (defaults to 10)
our $neverQueueSize = 12000000;          # (number > 0) never queue mails larger than these number of bytes
our $SpamCountNormCorrection = 0;        # (+/- number in percent) correct the required by X% higher
our $FileScanCMDbuild_API;               # called if defined in FileScanOK with - $FileScanCMDbuild_API->(\$cmd,$this) - $cmd in place modification

# *********************************************************************************************************************************************

$BayesDomainPrior ||= 1;
$BayesPrivatPrior ||= 1;

our %NotifyFreqTF:shared = (     # one notification per timeframe in seconds per tag per worker
    'info'    => 60,
    'warning' => 60,
    'error'   => 60
);

our $tlds_alpha_URL = 'http://data.iana.org/TLD/tlds-alpha-by-domain.txt';
our $tlds2_URL = 'http://george.surbl.org/two-level-tlds';
#    "http://www.surbl.org/tld/two-level-tlds",
#    "http://assp.cvs.sourceforge.net/viewvc/*checkout*/assp/assp2/files/URIBLCCTLDS-L2.txt",
our $tlds3_URL = 'http://george.surbl.org/three-level-tlds';
#    "http://www.surbl.org/tld/three-level-tlds",
#    "http://assp.cvs.sourceforge.net/viewvc/*checkout*/assp/assp2/files/URIBLCCTLDS-L3.txt",

our $BackDNSFileURL = 'http://wget-mirrors.uceprotect.net/rbldnsd-all/ips.backscatterer.org.gz';

# static config sharing vars
our $syncToDo:shared;
our $syncUser;
our $syncIP;
our %neverShareCFG = (
    'DisableSMTPNetworking' => 1,
    'defaultLocalHost' => 1,
    'myServerRe' => 1,
    'pbdb' => 1,
    'DelayShowDB' => 1,
    'DelayShowDBwhite' => 1,
    'base' => 1,
    'spamdb' => 1,
    'whitelistdb' => 1,
    'redlistdb' => 1,
    'persblackdb' => 1,
    'griplist' => 1,
    'droplist' => 1,
    'delaydb' => 1,
    'ldaplistdb' => 1,
    'adminusersdb' => 1,
    'mysqlSlaveMode' => 1,
    'fillUpImportDBDir' => 1,
    'ImportMysqlDB' => 1,
    'ExportMysqlDB' => 1,
    'LDAPShowDB' => 1,
    'forceLDAPcrossCheck' => 1,
    'myName' => 1,
    'asspCfg' => 1,
    'asspCfgVersion' => 1,
    'NumComWorkers' => 1,
    'ReservedOutboundWorkers' => 1,
    'RebuildSchedule' => 1,
    'ReplaceOldSpamdb' => 1,
    'RunRebuildNow' => 1,
    'globalClientName' => 1,
    'globalClientPass' => 1,
    'globalClientLicDate' => 1,
    'DoGlobalBlack' => 1,
    'globalValencePB' => 1,
    'globalBlackExpiration' => 1,
    'DoGlobalWhite' => 1,
    'globalWhiteExpiration' => 1,
    'GPBDownloadLists' => 1,
    'GPBautoLibUpdate' => 1,
    'BlockRepForwHost' => 1,
    'BlockReportNow' => 1,
    'POP3ConfigFile' => 1,
    'POP3Interval' => 1,
    'POP3fork' => 1,
    'POP3KeepRejected' => 1,
    'POP3debug' => 1,
    'BerkeleyDB_DBEngine' => 1,
    'TLDS' => 1,
    'URIBLCCTLDS' => 1,
    'localBackDNSFile' => 1,
    'asspCpuAffinity' => 1,
    'MemoryUsageLimit' => 1,

# never share the sync vars
    'enableCFGShare' => 1,
    'isShareMaster' => 1,
    'isShareSlave' => 1,
    'syncServer' => 1,
    'syncTestMode' => 1,
    'syncConfigFile' => 1,
    'syncCFGPass' => 1,
    'syncShowGUIDetails' => 1
);
### end sharing vars

# set the blocking mode for HTTPS (0/1 default is 0) and HTTP (0/1 default is 0) on the GUI
our $HTTPSblocking = 0;
our $HTTPblocking = 0;

# set the blocking mode for STATS connection (0/1) - default is 0
our $STATSblocking = 0;

#set BerkeleyDB sync to off (0) or on (1)
our $DoSyncBDB = 1;
our $DoCompactBDB = 1;

# change regexes in ConfigCompileRe to allow grouping only (...) -> (?:...) to spend memory
our $RegexGroupingOnly = 1;

our $TimeZoneDiff = time;
$TimeZoneDiff = Time::Local::timelocal(localtime($TimeZoneDiff))-Time::Local::timelocal(gmtime($TimeZoneDiff));
*{'Time::HiRes::gmtime'} = sub {Time::HiRes::time - $TimeZoneDiff;};

# some special regular expressions
our $ScheduleRe;
our $ScheduleGUIRe;
our $neverMatch;
our $neverMatchRE;
our $punyRE;
our $EmailAdrRe;
our $EmailDomainRe;
our $HeaderNameRe;
our $HeaderValueRe;
our $HeaderRe;
our $UUENCODEDRe;
our $UTFBOMRE;
our $UTF8BOMRE;
our $UTF8BOM;
our $complexREStart;
our $complexREEnd;
our $dot;
our $UriDot;
our $NONPRINT;
our $HamTagRE;
our $SpamTagRE;
our $ValencePBRE;
our $ValencePB2RE;
our $NonSymLangRE;
our $SymLangRE;
our $notAllowedSMTP;

# IP Address representations
our $IPprivate;
our $IPQuadSectRE;
our $IPQuadSectDotRE;
our $IPQuadRE;
our $IPStrictQuadRE;
our $RFC822RE;

# Host
our $IPSectRe;
our $IPSectHexRe;
our $IPSectDotRe;
our $IPSectHexDotRe;
our $IPRe;
our $IPv4Re;
our $IPv6Re;
our $IPv6LikeRe;
our $PortRe;
our $HostRe;
our $HostPortRe;

# for GUI check
our $GUIHostPort;

# some special variables to DEBUG IO and Poll Errors and to reduce memory usage
our $CloseHandleOnPollError = 1;
our $undefMEM = 1;
our $printVars;
our $countRefs;
our %Vars2Print;
our %Refs2Count;
our $process_external_cmdqueue:shared = unlink("$base/cmdqueue");
print "\nexternal CMD-queue '$base/cmdqueue' registered " if $process_external_cmdqueue;
# end of DEBUG special vars

#DKIM html to base64 conversion (0/1) - default is 0 - set it to  1 to workaround an issue in older Mail::DKIM
our $DKIMconvHTML2base64 = 0;

# runtime variable
our $runHMMusesBDB:shared;

srand();

our %cryptConfigVars:shared = (
    'myuser' => 1,
    'mypassword' => 1,
    'LDAPLogin' => 1 ,
    'LDAPPassword' => 1 ,
    'adminusersdb' => 1,
    'adminusersdbpass' => 1,
    'adminusersdbNoBIN' => 1,
    'Notify' => 1,
    'NotifyRe' => 1,
    'NoNotifyRe' => 1,
    'proxyuser' => 1,
    'proxypass' => 1,
    'globalRegisterURL' => 1,
    'globalUploadURL' => 1,
    'globalClientPass' => 1,
    'globalClientName' => 1,
    'SSLCaFile' => 1,
    'SSLCertFile' => 1,
    'SSLKeyFile' => 1,
    'SSLPKPassword' => 1,
    'SRSSecretKey' => 1,
    'relayAuthUser' => 1,
    'relayAuthPass' => 1,
    'syncCFGPass' => 1,
    'Groups' => 1,
    'SNMPUser' => 1,
    'ConfigChangeSchedule' => 1
);

# UnicodeBlocks
our @UnicodeBlocks = qw (
    InAlphabeticPresentationForms
    InArabic
    InArabicPresentationFormsA
    InArabicPresentationFormsB
    InArmenian
    InArrows
    InBasicLatin
    InBengali
    InBlockElements
    InBopomofo
    InBopomofoExtended
    InBoxDrawing
    InBraillePatterns
    InBuhid
    InByzantineMusicalSymbols
    InCJKCompatibility
    InCJKCompatibilityForms
    InCJKCompatibilityIdeographs
    InCJKCompatibilityIdeographsSupplement
    InCJKRadicalsSupplement
    InCJKSymbolsAndPunctuation
    InCJKUnifiedIdeographs
    InCJKUnifiedIdeographsExtensionA
    InCJKUnifiedIdeographsExtensionB
    InCherokee
    InCombiningDiacriticalMarks
    InCombiningDiacriticalMarksforSymbols
    InCombiningHalfMarks
    InControlPictures
    InCurrencySymbols
    InCyrillic
    InCyrillicSupplementary
    InDeseret
    InDevanagari
    InDingbats
    InEgyptianHieroglyphs
    InEnclosedAlphanumerics
    InEnclosedCJKLettersAndMonths
    InEthiopic
    InGeneralPunctuation
    InGeometricShapes
    InGeorgian
    InGothic
    InGreekExtended
    InGreekAndCoptic
    InGujarati
    InGurmukhi
    InHalfwidthAndFullwidthForms
    InHangulCompatibilityJamo
    InHangulJamo
    InHangulSyllables
    InHanunoo
    InHebrew
    InHighPrivateUseSurrogates
    InHighSurrogates
    InHiragana
    InIPAExtensions
    InIdeographicDescriptionCharacters
    InKanbun
    InKangxiRadicals
    InKannada
    InKatakana
    InKatakanaPhoneticExtensions
    InKhmer
    InLao
    InLatin1Supplement
    InLatinExtendedA
    InLatinExtendedAdditional
    InLatinExtendedB
    InLetterlikeSymbols
    InLowSurrogates
    InMalayalam
    InMathematicalAlphanumericSymbols
    InMathematicalOperators
    InMiscellaneousMathematicalSymbolsA
    InMiscellaneousMathematicalSymbolsB
    InMiscellaneousSymbols
    InMiscellaneousTechnical
    InMongolian
    InMusicalSymbols
    InMyanmar
    InNumberForms
    InOgham
    InOldItalic
    InOpticalCharacterRecognition
    InOriya
    InPrivateUseArea
    InRunic
    InSinhala
    InSmallFormVariants
    InSpacingModifierLetters
    InSpecials
    InSuperscriptsAndSubscripts
    InSupplementalArrowsA
    InSupplementalArrowsB
    InSupplementalMathematicalOperators
    InSupplementaryPrivateUseAreaA
    InSupplementaryPrivateUseAreaB
    InSyriac
    InTagalog
    InTagbanwa
    InTags
    InTamil
    InTelugu
    InThaana
    InThai
    InTibetan
    InUnifiedCanadianAboriginalSyllabics
    InVariationSelectors
    InYiRadicals
    InYiSyllables
);


our @NonSymLangs = qw (
    InAlphabeticPresentationForms
    InArabic
    InArabicPresentationFormsA
    InArabicPresentationFormsB
    InArmenian
    InBasicLatin
    InCyrillic
    InCyrillicSupplementary
    InEnclosedAlphanumerics
    InGeorgian
    InGothic
    InGreekExtended
    InGreekAndCoptic
    InHebrew
    InLatin1Supplement
    InLatinExtendedA
    InLatinExtendedAdditional
    InLatinExtendedB
    InLetterlikeSymbols
    InMathematicalAlphanumericSymbols
    InMathematicalOperators
    InOldItalic
    InOpticalCharacterRecognition
);
our @SymLangs;

our @UniCodeScripts = qw (
    Common
    Arabic
    Armenian
    Bengali
    Bopomofo
    Braille
    Buhid
    CanadianAboriginal
    Cherokee
    Cyrillic
    Devanagari
    Ethiopic
    Georgian
    Greek
    Gujarati
    Gurmukhi
    Han
    Hangul
    Hanunoo
    Hebrew
    Hiragana
    Kannada
    Katakana
    Khmer
    Lao
    Latin
    Limbu
    Malayalam
    Mongolian
    Myanmar
    Ogham
    Oriya
    Runic
    Sinhala
    Syriac
    Tagalog
    Tagbanwa
    TaiLe
    Tamil
    Telugu
    Thaana
    Thai
    Tibetan
    Yi
);

sub setSpecialRegex {
my $w = 'a-zA-Z0-9_';
my $d = '0-9';
$ScheduleRe = '(?:\S+\s+){4}\S+';
$ScheduleGUIRe = '^('.$ScheduleRe.'(?:\|'.$ScheduleRe.")*|[$d]+|)\$";
$neverMatch = '^(?!)';
$neverMatchRE = quotemeta($neverMatch).'\)?\$?\)*$';
$punyRE = 'xn--[a-zA-Z0-9\-]+';
$EmailAdrRe=qr/[^()<>@,;:"\[\]\000-\040\x7F-\xFF]+/o;
$EmailDomainRe=qr/(?:[$w][$w\-]*(?:\.[$w][$w\-]*)*\.(?:$punyRE|[$w][$w]+)|\[[$d][$d\.]*\.[$d]+\])/o;
$HeaderNameRe=qr/\S[^\r\n]*/o;
$HeaderValueRe=qr/[ \t]*[^\r\n]*(?:\r?\n[ \t]+\S[^\r\n]*)*(?:\r?\n)?/o;
$HeaderRe=qr/(?:$HeaderNameRe:$HeaderValueRe)/o;
$UUENCODEDRe=qr/\bbegin\b [$d]{3} \b\S{0,72}.*?\S{61}.{0,61}\bend\b/o;
$UTF8BOM = "\xEF\xBB\xBF";
$UTFBOMRE = qr/(?:\x00\x00\xFE\xFF|\xFF\xFE\x00\x00|\xFE\xFF|\xFF\xFE|$UTF8BOM)/o;
$UTF8BOMRE = qr/(?:$UTF8BOM)/o;
$NONPRINT = qr/[\x00-\x1F\x7F-\xFF]/o;
$complexREStart = '^(?=.*?(((?!)';
$complexREEnd = '(?!)).*?(?!\g{-1})){';
$notAllowedSMTP = qr/CHUNKING|PIPELINING|XEXCH50|
                     SMTPUTF8|UTF8REPLY|
                     UTF8SMTP|UTF8SMTPA|UTF8SMTPS|UTF8SMTPAS|
                     UTF8LMTP|UTF8LMTPA|UTF8LMTPS|UTF8LMTPAS|
                     XCLIENT|XFORWARD|
                     TURN|ATRN|ETRN|TURNME|X-TURNME|XTRN|
                     SEND|SOML|SAML|EMAL|ESAM|ESND|ESOM|
                     XAUTH|XQUE|XREMOTEQUEUE|
                     X-EXPS|X-ADAT|X-DRCP|X-ERCP|EVFY|
                     8BITMIME|BINARYMIME|BDAT|
                     AUTH GSSAPI|AUTH NTLM|X-LINK2STATE
                  /oix;

# IP Address representations
my $sep;
my $v6Re = '[0-9A-Fa-f]{1,4}';
$IPSectRe = "(?:25[0-5]|2[0-4][$d]|1[$d]{2}|0?[$d]?[$d])";
$IPSectHexRe = '(?:(?:0x)?(?:[A-Fa-f][A-Fa-f0-9]?|[A-Fa-f0-9]?[A-Fa-f]))';

$IPprivate  = '^(?:0{1,3}\.0{1,3}\.0{1,3}\.0{1,3}|127(?:\.'.$IPSectRe.'){3}|169\.254(?:\.'.$IPSectRe.'){2}|0?10(?:\.'.$IPSectRe.'){3}|192\.168(?:\.'.$IPSectRe.'){2}|172\.0?1[6-9](?:\.'.$IPSectRe.'){2}|172\.0?2[0-9](?:\.'.$IPSectRe.'){2}|172\.0?3[01](?:\.'.$IPSectRe.'){2})$';   #RFC 1918 decimal
$IPprivate .= '|^(?:(?:0x)?0{1,2}\.(?:0x)?0{1,2}\.(?:0x)?0{1,2}\.(?:0x)?0{1,2}|(?:0x)?7[Ff](?:\.'.$IPSectHexRe.'){3}|(?:0x)?[aA]9\.(?:0x)?[Ff][Ee](?:\.'.$IPSectHexRe.'){2}|(?:0x)?0[aA](?:\.'.$IPSectHexRe.'){3}|(?:0x)?[Cc]0\.(?:0x)?[Aa]8(?:\.'.$IPSectHexRe.'){2}|(?:0x)[Aa][Cc]\.(?:0x)1[0-9a-fA-F](?:\.'.$IPSectHexRe.'){2})$';   #RFC 1918 Hex
$IPprivate .= '|^(?:0{0,4}:){2,6}'.$IPprivate.'$';  # private IPv4 in IPv6
$IPprivate .= '|^(?:0{0,4}:){2,7}[1:]?$';  # IPv6 loopback and universal

$IPQuadSectRE="(?:0([0-7]+)|0x([0-9a-fA-F]+)|([$d]+))";
$IPQuadSectDotRE='(?:'.$IPQuadSectRE.'\.)';
$IPQuadRE=qr/$IPQuadSectDotRE?$IPQuadSectDotRE?$IPQuadSectDotRE?$IPQuadSectRE/o;

$dot = '[^a-zA-Z0-9\.]?d[^a-zA-Z0-9\.]?o[^a-zA-Z0-9\.]?t[^a-zA-Z0-9\.]?|[\=\%]2[eE]|\&\#0?46\;?';      # the DOT
$UriDot = '(?:[\=\%]2[eE]|\&\#0?46\;?|\.)';

$IPSectDotRe = '(?:'.$IPSectRe.'\.)';
$IPSectHexDotRe = '(?:'.$IPSectHexRe.'\.)';
$IPv4Re = qr/(?:
(?:$IPSectDotRe){3}$IPSectRe
|
(?:$IPSectHexDotRe){3}$IPSectHexRe
)/xo;

# private IPv6 addresses
$IPprivate .= <<EOT;
|^(?i:FE[89A-F][0-9A-F]):
(?:
(?:(?:$v6Re:){6}(?:                                $v6Re      |:))|
(?:(?:$v6Re:){5}(?:                   $IPv4Re |   :$v6Re      |:))|
(?:(?:$v6Re:){4}(?:                  :$IPv4Re |(?::$v6Re){1,2}|:))|
(?:(?:$v6Re:){3}(?:(?:(?::$v6Re)?    :$IPv4Re)|(?::$v6Re){1,3}|:))|
(?:(?:$v6Re:){2}(?:(?:(?::$v6Re){0,2}:$IPv4Re)|(?::$v6Re){1,4}|:))|
(?:(?:$v6Re:)   (?:(?:(?::$v6Re){0,3}:$IPv4Re)|(?::$v6Re){1,5}|:))|
                (?:(?:(?::$v6Re){0,4}:$IPv4Re)|(?::$v6Re){1,6}|:)
)\$
EOT
$IPprivate = qr/$IPprivate/xo;

# RFC4291, section 2.2, "Text Representation of Addresses"
$sep = '[:-]';
$IPv6Re = $IPv6LikeRe = <<EOT;
(?:
(?:(?:$v6Re$sep){7}(?:                                         $v6Re      |$sep))|
(?:(?:$v6Re$sep){6}(?:                         $IPv4Re |   $sep$v6Re      |$sep))|
(?:(?:$v6Re$sep){5}(?:                     $sep$IPv4Re |(?:$sep$v6Re){1,2}|$sep))|
(?:(?:$v6Re$sep){4}(?:(?:(?:$sep$v6Re)?    $sep$IPv4Re)|(?:$sep$v6Re){1,3}|$sep))|
(?:(?:$v6Re$sep){3}(?:(?:(?:$sep$v6Re){0,2}$sep$IPv4Re)|(?:$sep$v6Re){1,4}|$sep))|
(?:(?:$v6Re$sep){2}(?:(?:(?:$sep$v6Re){0,3}$sep$IPv4Re)|(?:$sep$v6Re){1,5}|$sep))|
(?:(?:$v6Re$sep)   (?:(?:(?:$sep$v6Re){0,4}$sep$IPv4Re)|(?:$sep$v6Re){1,6}|$sep))|
(?:        $sep    (?:(?:(?:$sep$v6Re){0,5}$sep$IPv4Re)|(?:$sep$v6Re){1,7}|$sep))
)
EOT

$IPv6Re =~ s/\Q$sep\E/:/go;
$IPv6Re = qr/$IPv6Re/xo;
$IPv6LikeRe = qr/$IPv6LikeRe/xo;

$IPRe = qr/(?:
$IPv4Re
|
$IPv6Re
)/xo;

# re for a single port - could be number 1 to 65535
$PortRe = qr/(?:(?:[1-6][$d]{4})|(?:[1-9][$d]{0,3}))/o;
# re for a single host - could be an IP a name or a fqdn
$HostRe = qr/(?:(?:$IPv4Re|\[?$IPv6Re\]?)|$EmailDomainRe|[$w][$w]+)/o;
$HostPortRe = qr/$HostRe:$PortRe/o;

$GUIHostPort = qr/^((?:(?:$PortRe|$HostPortRe)(?:\|(?:$PortRe|$HostPortRe))*)|)$/o;

$RFC822RE = <<'EOF';
[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\
xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xf
f\n\015()]*)*\)[\040\t]*)*(?:(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\x
ff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\xff\n\015
"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[\040\t]*(?:\([^\\\x80-\
xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80
-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*
)*(?:\.[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\
\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\
x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x8
0-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|"[^\\\x80-\xff\n
\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[\040\t]*(?:\([^\\\x
80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^
\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040
\t]*)*)*@[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([
^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\
\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\
x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-
\xff\n\015\[\]]|\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()
]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\
x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\04
0\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\
n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\
015()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?!
[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\
]]|\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\
x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\01
5()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)*|(?:[^(\040)<>@,;:".
\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]
)|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[^
()<>@,;:".\\\[\]\x80-\xff\000-\010\012-\037]*(?:(?:\([^\\\x80-\xff\n\0
15()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][
^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)|"[^\\\x80-\xff\
n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015"]*)*")[^()<>@,;:".\\\[\]\
x80-\xff\000-\010\012-\037]*)*<[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?
:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-
\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:@[\040\t]*
(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015
()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()
]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\0
40)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\
[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\
xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*
)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80
-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x
80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t
]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\
\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])
*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x
80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80
-\xff\n\015()]*)*\)[\040\t]*)*)*(?:,[\040\t]*(?:\([^\\\x80-\xff\n\015(
)]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\
\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*@[\040\t
]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\0
15()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015
()]*)*\)[\040\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(
\040)<>@,;:".\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|
\\[^\x80-\xff])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80
-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()
]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x
80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^
\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040
\t]*)*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".
\\\[\]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff
])*\])[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\
\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x
80-\xff\n\015()]*)*\)[\040\t]*)*)*)*:[\040\t]*(?:\([^\\\x80-\xff\n\015
()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\
\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)?(?:[^
(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-
\037\x80-\xff])|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\xff\
n\015"]*)*")[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|
\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))
[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80-\xff
\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\x
ff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(
?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\
000-\037\x80-\xff])|"[^\\\x80-\xff\n\015"]*(?:\\[^\x80-\xff][^\\\x80-\
xff\n\015"]*)*")[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\x
ff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)
*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*)*@[\040\t]*(?:\([^\\\x80-\x
ff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-
\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)
*(?:[^(\040)<>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\
]\000-\037\x80-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\]
)[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-
\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\x
ff\n\015()]*)*\)[\040\t]*)*(?:\.[\040\t]*(?:\([^\\\x80-\xff\n\015()]*(
?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]*(?:\\[^\x80-\xff][^\\\x80
-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)*\)[\040\t]*)*(?:[^(\040)<
>@,;:".\\\[\]\000-\037\x80-\xff]+(?![^(\040)<>@,;:".\\\[\]\000-\037\x8
0-\xff])|\[(?:[^\\\x80-\xff\n\015\[\]]|\\[^\x80-\xff])*\])[\040\t]*(?:
\([^\\\x80-\xff\n\015()]*(?:(?:\\[^\x80-\xff]|\([^\\\x80-\xff\n\015()]
*(?:\\[^\x80-\xff][^\\\x80-\xff\n\015()]*)*\))[^\\\x80-\xff\n\015()]*)
*\)[\040\t]*)*)*>)
EOF

$RFC822RE =~ s/\r?\n//go;
$RFC822RE = qr/^$RFC822RE$/;

$SpamTagRE = qr/(?:
                  \[
                  (?:
                   Attachment | AUTHError

                   Backscatter | BATV | Bayesian |
                   BlackDomain | BlackHELO | BombBlack |
                   BombData | BombHeader | BombRe |
                   BombScript | BombSender | BounceAddress |

                   Collect | Connection | CountryCode |

                   DCC | DNSBL | Delayed | DenyIP |
                   DenyStrict | DomainKey | DKIM | DMARC

                   Extreme | ForgedHELO |
                   ForgedLocalSender | FromMissing |

                   History | HMM |

                   IPfrequency | IPperDomain |
                   InternalAddress | InvalidAddress | InvalidHELO |

                   MailLoop | MalformedAddress | Max-Equal-X-Header |
                   MaxAUTHErrors | MaxErrors | MessageScore |
                   messageSize | MaxRealMessageSize | MaxMessageSize |
                   MissingMXA? | MsgID | MSGID-sig |

                   Organization | OversizedHeader |

                   PTRinvalid | PTRmissing | PenaltyBox | Penalty |

                   razor | RelayAttempt |

                   SameSubject | SPF | SRS | SpoofedSender |
                   SuspiciousHelo |

                   Trap |
                   UnknownLocalSender | URIBL |
                   VIRUS | ValidHELO |

                   WhitelistOnly
                  )
                  \] |
                   spam\sfound
               )/iox;

$HamTagRE = qr/(?:\[(?:Local|MessageOK|RWL|Whitelisted|NoProcessing)\])/io;
$ValencePBRE = qr/(\s*[$d]+\s*(?:[\|,]\s*[$d]+\s*){0,1})/o;
$ValencePB2RE = qr/(\s*-?[$d]+\s*(?:[\|,]\s*-?[$d]+\s*){0,1})/o;

$NonSymLangRE .= '\p{'.$_.'}|' for (@NonSymLangs);
chop $NonSymLangRE;
$NonSymLangRE = qr/$NonSymLangRE/;
map {my $t = $_; unless (grep(/$t/,@NonSymLangs)) {$SymLangRE .= '\p{'.$t.'}|'; push @SymLangs,$t;}} @UnicodeBlocks;
chop $SymLangRE;
$SymLangRE = qr/$SymLangRE/;

%skipDeclare = (
    'LogDateLang' => 1,
    'LogDateFormat' => 1,
    'mydb' => 1,
    'base' => 1,
    'delaySameIP' => 1
);

%neverLockTable = (
    'hmmdb' => 1,
    'spamdb' => 1,
    'spamdbhelo' => 1,
    'adminusers' => 1,
    'adminusersright' => 1,
    'backdns' => 1
);

}

sub printVarsOn {
    %Vars2Print = ();
    %Refs2Count = ();
    return unless (open my $va,'<', "$base/debug/vardebug.txt");
    $printVars = 1;
    binmode $va;
    while (my $line = (<$va>)) {
        $line =~ s/\r|\n|\s//go;
        $line =~ s/^([^#;]*)([#;])/$1/go;
        next unless $line;
        next if $line =~ /^#|;/o;
        $Vars2Print{$line} = 1;
    }
    close $va;
    if (open $va ,'<',"$base/debug/refcount.txt") {
        binmode $va;
        $countRefs = 1;
        while (my $line = (<$va>)) {
            $line =~ s/\r|\n|\s//go;
            $line =~ s/^([^#;]*)([#;])/$1/go;
            next unless $line;
            next if $line =~ /^#|;/o;
            $Refs2Count{$line} = 1;
        }
        close $va;
    }
    return;
}

sub setLocalCharsets {
    $Charsets = '0:System Default|';
    $defaultLogCharset = 0;
    foreach (Encode->encodings(':all')) {
        $Charsets .= $_ . ':' . $_ . '|' if $_ !~ /mime|symbol|null|nextstep/io;
        $defaultLogCharset = $_ if ($^O ne 'MSWin32' &&
                                    $defaultLogCharset !~ /^utf-?8/io &&
                                    $_ =~ /^utf-?8/io);
    }
    chop $Charsets;
}

sub loadModuleVars {
    %Modules = (
      'IO::Socket::INET6' => 1,
      'Thread::State' => 1,
      'File::Scan::ClamAV' => 1,
      'Net::LDAP' => 1,
      'Net::DNS' => 1,
      'Mail::SPF::Query' => 1,
      'Mail::SPF' => 1,
      'Mail::SRS' => 1,
      'Compress::Zlib' => 1,
      'Digest::MD5' => 1,
      'Digest::SHA1' => 1,
      'File::ReadBackwards' => 1,
      'PerlIO::scalar' => 1,
      'Sys::Syslog' => 1,
      'Win32::Daemon' => 1,
      'Win32::API::OutputDebugString' => 1,
      'Tie::RDBM' => 1,
      'Net::CIDR::Lite' => 1,
      'NetAddr::IP::Lite' => 1,
      'Net::IP' => 1,
      'LWP::Simple' => 1,
      'Email::MIME' => 1,
      'MIME::Types' => 1,
      'Email::Send' => 1,
      'Convert::TNEF' => 1,
      'Mail::DKIM::Verifier' => 1,
      'Net::SMTP' => 1,
      'Net::SMTP::TLS' => 1,
      'Schedule::Cron' => 1,
      'Sys::MemInfo' => 1,
      'IO::Socket::SSL' => 1,
      'BerkeleyDB' => 1,
      'DB_File' => 1,
      'Authen::SASL' => 1,
      'Regex::Optimizer' => 1,
      'Regexp::Optimizer' => 1,
      'NetSNMP::agent' => 1,
      'Time::Hi::Res' => 1,
      'AsspSelfLoader' => 1,
      'ASSP_WordStem' => 1,
      'ASSP_FC' => 1,
      'ASSP_SVG' => 1,
      'Win32::Unicode' => 1,
      'Unicode::GCString' => 1,
      'Text::Unidecode' => 1,
      'Sys::CpuAffinity' => 1
    );
    my @cfglines;
    my $i = 3000;
    foreach (sort keys %Modules) {
        my $mod = $_;
        my $link;
        for my $idx (0...$#ConfigArray) {
            my $c = $ConfigArray[$idx];
            if ($c->[7] && $c->[7] =~ /$mod/i) {
                $link .= " $c->[0]";
            }
        }

        next if $mod eq 'Time::Hi::Res';
        my $hint = ($mod eq 'Regex::Optimizer') ? ' Using this module disables the module Regexp::Optimizer internaly! ' : '';
        $mod =~ s/:://go;
        my $varname = 'use'.$mod;
        $ModulesUsed{$varname} = 1;
        $link = $link ? "<br />This module is possibly used for$link and maybe some other features." : '';
        $i++;
        push (@cfglines,[$varname,"Use Module $_",0,\&checkbox,1,'(.*)',undef,"If selected, the perl module $_ will be loaded if it is installed. If not selected, ASSP will not load the perl module $_ even it is installed and several features of ASSP will not be available! It is recommended to disable installed but unused modules to reduce the required memory.<span class=\"negative\"> Requires ASSP restart!</span>$hint$link",undef,undef,'msg0'.$i.'0','msg0'.$i.'1'])
    }
    push (@ConfigArray,[0,0,0,'heading','Module Setup <a href="javascript:popFileEditor(\'moduleLoadErrors.txt\',8);"><img height=12 width=12 src="' . $wikiinfo . '" alt="show module load errors" /></a>']);
    while (@cfglines) {
        push(@ConfigArray,shift @cfglines);
    }
}

# imported from IO :: Socket version 1.30_01 to handle MSWIN32 blocking mode
# modified by Thomas Eckardt to use a real long pointer
sub assp_socket_blocking {
    my $sock = shift;

    return $sock->SUPER::blocking(@_)
        if $^O ne 'MSWin32';

    # Windows handles blocking differently
    #
    # http://groups.google.co.uk/group/perl.perl5.porters/browse_thread/thread/b4e2b1d88280ddff/630b667a66e3509f?#630b667a66e3509f
    # http://msdn.microsoft.com/library/default.asp?url=/library/en-us/winsock/winsock/ioctlsocket_2.asp
    #
    # http://www.perlmonks.org/?node_id=780083   /TE
    #
    # 0x8004667e is FIONBIO
    #
    # which is used to set blocking behaviour.

    # NOTE:
    # This is a little confusing, the perl keyword for this is
    # 'blocking' but the OS level behaviour is 'non-blocking', probably
    # because sockets are blocking by default.
    # Therefore internally we have to reverse the semantics.

    my $orig= !${*$sock}{io_sock_nonblocking};

    return $orig unless @_;

    my $block = shift;

    my $nonblocking = "\x00\x00\x00\x01"; # pack("L",1) works too
    my $blocking = "\x00\x00\x00\x00"; # pack("L",0) works too
    my $FIONBIO = 0x8004667e;

    if ( !$block != !$orig ) {
        ${*$sock}{io_sock_nonblocking} = $block ? $blocking : $nonblocking;
        ioctl($sock, $FIONBIO, unpack('I',pack('P',${*$sock}{io_sock_nonblocking})))
            or return;
    }

    return $orig;
}

sub defConfigArray {
 # last used msg number 010121

 # still unused msg numbers
 #

@ConfigArray = (

 # except for the heading lines, all config lines have the following:
 # $name,$nicename,$size,$func,$default,$valid,$onchange,$description(,CssAdition,note,MSG-nicename,MSG-description)
 # name is the variable name that holds the data
 # nicename is a human readable pretty display name (oh how nice!)
 # size is the appropriate input box size
 # func is a function called to render the config item
 # default is the default value
 # valid is a regular expression used to clean and validate the input -- no match is an error and $1 is the desired result
 # onchange is a function to be called when this value is changed -- usually undef; just updating the value is enough
 # description is text displayed to help the user figure what to put in the entry
 # CssAdition (optional) adds the string to the CSS-name for nicename Style
 # note for Edit java script
 # message number for the nicename - for multilingual support - SNMP OID extension
 # message number for the description - for multilingual support


[0,0,0,'heading','Configuration Synchronization and Sharing'],
['enableCFGShare','Enable Configuration Sharing',0,\&checkbox,'','(.*)','ConfigChangeEnableCFGSync', '<hr><b>Read all positions in this section carefully (multiple times is recommended!!!)!&nbsp;A wrong configuration sequence or wrong configuration values can lead in to a destroyed ASSP configuration!</b><hr>
  If set, the configuration value and option files synchronization will be enabled. This synchronization belong to the configuration values, to the file that is possibly defined in a value and to the include files that are possibly defined in the configured file. If you don\'t want a specific configuration file or include file to be synchronized (send and receive), write<br />
  # assp-no-sync<br />
  as a comment anywhere in the file. An possible reason could be for example \'localDomains\' - if ASSP1 is hosting DOMAIN1 and DOMAIN2 but ASSP2 is hosting only DOMAIN2 - so the entry for DOMAIN2 could be put in a not synchronized include file on ASSP1 and the synchronized main config file contains the entry for DOMAIN1.<br />
  If the configuration of all values in this section is valid, the synchronization status will be shown in the GUI for each config value that is, or <b>could be shared</b>. There are several configuration values, that could not be shared. The list of all shareable values could be found in the distributed file assp_sync.cfg<br /><br />
  For an initial synchronization setup set the following config values in this order: setup syncServer, syncConfigFile, syncTestMode and as last syncCFGPass (leave isShareSlave and isShareMaster off). Use the default (distributed syncConfigFile assp_sync.cfg) file and configure all values to your needs - do this on all peers by removing lines or setting the general sync flag to 0 or 1 (see the description of syncConfigFile ).<br />
  If you have finished this initial setup, enable isShareMaster or isShareSlave - now assp will setup all entries in the configuration file for all sync peers to the configured default values (to 1 if isShareMaster or to 3 if isShareSlave is selected). Do this on all peers. Now you can configure the synchronization behavior for each single configuration value for each peer, if it should differ from the default setup.<br />
  For the initial synchronization, configure only one ASSP installation as master (all others as slave). If the initial synchronization has finished, which will take up to one hour, you can configure all or some assp as master and slave. On the initial master simply switch on isShareSlave. On the inital slaves, switch on isShareMaster and change all values in the sync config file that should be bidirectional shared from 3 to 1. As last action enable enableCFGShare on the SyncSlaves first and then on the SyncMaster.<br />
  After such an initial setup, any changes of the peers (syncServer) will have no effect to the configuration file (syncConfigFile)! To add or remove a sync peer after an initial setup, you have to configure syncServer and you have to edit the sync config file manualy.<br /><br />
  This option can only be enabled, if isShareMaster and/or isShareSlave and syncServer and syncConfigFile and syncCFGPass are configured!<br />
  <b>Because the synchronization is done using a special SMTP protocol (without "mail from" and "rcpt to"), this option requires an installed <a href="http://search.cpan.org/search?query=Net::SMTP" rel="external">Net::SMTP</a> module in PERL. If you want the sync feature to use a secured connection (using STARTTLS) you need (in addition) to install the perl module <a href="http://search.cpan.org/search?query=Net::SMTP::TLS" rel="external">Net::SMTP::TLS</a> and DoTLS has to be set to "do TLS". This special SMTP protocol is not usable to for any MTA for security reasons, so the "sync mails" could not be forwarded via any MTA.<br />
  For this reason all sync peers must have a direct or routed TCP connection to each other peer.</b><br /><br />
  If you build a sync topology with more than two ASSP, please notice, that it is not allowed to build any ring-synchronization. Only a chain-, tree- or star- topology is supported. It is also not allowed to build a sync ring inside any of the three allowed topologies!<br />
  <input type="button" value="show sync status" onclick="javascript:popFileEditor(\'files/sync_failed.txt\',8);" />',undef,undef,'msg009170','msg009171'],
['isShareMaster','This is a Share Master',0,\&checkbox,'','(.*)','ConfigChangeSync', 'If selected, ASSP will send configured configuration changes to sync peers.',undef,undef,'msg009180','msg009181'],
['isShareSlave','This is a Share Slave',0,\&checkbox,'','(.*)','ConfigChangeSync', 'If selected, ASSP will receive configured configuration changes from sync peers. To accept a sync request, every sending peer has to be defined in syncServer - even if there are manualy made entries in the sync config file for a peer.',undef,undef,'msg009190','msg009191'],
['syncServer','Default Sync Peers',100,\&textinput,'','^((?:' . $HostPortRe . '(?:\|' . $HostPortRe . ')*)|)$','ConfigChangeSyncServer','Define all configuration sync peers here (to send changes to or to receive changes from). Sepatate multiple values by "|". Any value must be a pair of hostname or ip-address and :port, like 10.10.10.10:25 or mypeerhost:125 or mypeerhost.mydomain.com:225. The :port must be defined!<br />
  The target port can be the listenPort , listenPort2 or relayPort of the peer.',undef,undef,'msg009200','msg009201'],
['syncTestMode','Test Mode for Config Sync',0,\&checkbox,'','(.*)',undef, 'If selected, a master (isShareMaster) will process all steps to send configuration changes, but will not realy send the request to the peers. A slave (isShareSlave) will receive all sync requests, but it will not change the configuration values and possibly sent configuration files will be stored at the original location and will get an extension of ".synctest".',undef,undef,'msg009210','msg009211'],
['syncConfigFile','Configuration File for Config Sync*',40,\&textinput,'file:assp_sync.cfg','(file:\S+|)','ConfigChangeSyncFile','Define the synchronization configuration file here (default is file:assp_sync.cfg).<br />
 This file holds the configuration and the current status of all synchronized assp configuration values.<br />
 The format of an initial value is:  "varname:=syncflag" - where syncflag could be 0 -not shared and 1 -is shared - for example: HeaderMaxLength:=1 . The syncflag is a general sign, which meens, a value of 0 disables the synchronization of the config value for all peers. A value of 1, enables the peer configuration that possibly follows.<br />
 The format after an initial setup is: "varname:=syncflag,syncServer1=status,syncServer2=status,......". The "status" could be one of the following:<br /><br />
 0 - no sync - changes of this value will not be sent to this syncServer - I will ignore all change requests for this value from there<br />
 1 - I am a SyncMaster, the value is still out of sync to this peer and should be synchronized as soon as possible<br />
 2 - I am a SyncMaster, the value is still in sync to this peer - I am also a SyncSlave to this peer (bidirectional sync) if isShareSlave is enabled<br />
 3 - I am not a SyncMaster but a SyncSlave - only this SyncMaster (peer) knows the current sync status to me<br />
 4 - I am a SyncMaster and a SyncSlave (bidirectional sync) - a change of this value was still received from this syncServer (peer) and should not be sent back to this syncServer - this flag will be automaticaly set back to 2 at the next synchronization check<br /><br />
 ',undef,undef,'msg009220','msg009221'],
['syncCFGPass','Config Sync Password',20,\&passinput,'','(.{6,}|)','ConfigChangeSync','The password that is used and required (additionaly to the sending IP address) to identify a valid sync request. This password has to be set equal in all ASSP installations, from where and/or to where the configuration should be synchronized.<br />
  The password must be at least six characters long.<br />
  If you want or need to change this password, first disable enableCFGShare here and on all peers, change the password on all peers, enable enableCFGShare on SyncSlaves then enable enableCFGShare on SyncMasters.',undef,undef,'msg009230','msg009231'],
['syncShowGUIDetails','Show Detail Sync Information in GUI',0,\&checkbox,'','(.*)',undef, 'If selected, the detail synchronization status is shown at the top of each configuration parameter like:<br /><br />
  nothing shown - there is no entry defined for this parameter in the syncConfigFile or it is an unsharable parameter<br />
  "(shareable)" - the parameter is shareable but the general sync sign in the syncConfigFile is zero<br />
  "(shared: ...)" - the detail sync status for each sync peer<br /><br />
  If not selected, only different colored bulls are shown at the top of each configuration parameter like:<br /><br />
  nothing shown - no entry in the syncConfigFile or it is an unsharable parameter<br />
  "black bull <b><font color=\'black\'>&bull;</font></b>" - the parameter is shareable but the general sync sign in the syncConfigFile is zero<br />
  "green bull <b><font color=\'green\'>&bull;</font></b>" - the parameter is shared and in sync to each peer<br />
  "red bull <b><font color=\'red\'>&bull;</font></b>" - the parameter is shared but it is currently out of sync to at least one peer<br /><br />
  If you move the mouse over the bull, a hint box will show the detail synchronization status. An click on the bull or link will open a sync config dialog box for the single configuration parameter.
  <hr /><div class="menuLevel1">Notes Config Sync</div>
  <input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/configsync.txt\',3);" />',undef,undef,'msg009250','msg009251'],

[ 0, 0, 0, 'heading', 'Network Setup <a href="http://www.iworld.de/homes/assp/docu/BasicFlow" target=wiki><img height=12 width=12 src="' . $wikiinfo . '" alt="Network Flow" /></a>' ],
['DisableSMTPNetworking',"Disable all new SMTP and Proxy Network Connections",0,\&checkbox,0,'(.*)','configUpdateSMTPNet',
  'If selected, ASSP will not answer to new SMTP and Proxy connections on \'listenPort , listenPort2 , listenPortSSL , relayPort and ProxyConf\'. Currently existing SMTP and Proxy connections are not affected! Web and Stat connection are also not affected.',undef,undef,'msg000010','msg000011'],
['enableINET6','Enable IPv6 support',0,\&checkbox,'','(.*)','ConfigChangeIPv6','For IPv6 network support to be enabled, check this box. Default is disabled. IO::Socket::INET6 is able to handle both IPv4 and IPv6. NOTE: This option requires an installed <a href="http://search.cpan.org/search?query=IO::Socket::INET6" rel="external">IO::Socket::INET6</a> module in PERL and your system should support IPv6 sockets to give enableing this option a sense!<br />
  Before you enable or disable IPv6, please check every IP listener and destination definition in assp and correct the settings. After changing this option a restart of assp is recommended. IPv4 addresses are defined for example 192.168.0.1 or 192.168.0.1:25 - IPv6 addresses are defined like [FE80:1:0:0:0:0:0:1]:25 or [FE80:1::1]:25 ! If an IPv4 address is defined for a listener, assp will listen only on the IPv4 socket. If an IPv6 address is defined for a listener, assp will listen only on the IPv6 socket. If only a port is defined for a listener, assp will listen on both IPv4 and IPv6 sockets.<br />
  For the definition of destination IP\'s applies the same. You are free to define hostnames instead of IP addresses like myhost.mydomain.com:25 - how ever, because of the needed IP address resolving, this will possibly slow down assp.',undef,undef,'msg009480','msg009481'],
['listenPort','SMTP Listen Port',80,\&textinput,'25',$GUIHostPort,'ConfigChangeMailPort',
  'The port number on which ASSP will listen for incoming SMTP connections (normally 25). You can specify both an IP address and port number to limit connections to a specific interface. Separate multiple entries by "|".<p><small><i>Examples:</i> 25, 127.0.0.1:25, 127.0.0.1:25|127.0.0.2:25 </small></p>','Basic',undef,'msg000020','msg000021'],
['smtpDestination','SMTP Destination',80,\&textinput,'125',$GUIHostPort,undef,
  'The IP <b>number!</b> and port number of your primary SMTP <a href=http://en.wikipedia.org/wiki/Mail_transfer_agent>mail transfer agent</a> (MTA). If multiple servers are listed and the first listed MTA does not respond, each additional MTA will be tried. If only a port number is entered, or the dynamic keyword <b>INBOUND</b> is used with a port number, then the connection will be established to the local IP address on which the connection was received. This is useful when you have several IP addresses with different domains or profiles in your MTA. If INBOUND:PORT is used, ReportingReplies (Analyze,Help,etc and CopyMail will go to 127.0.0.1:PORT. If your needs are different, use smtpReportServer (SMTP Reporting Destination) and sendAllDestination (Copy Spam SMTP Destination). Separate multiple entries by "|".<small><i>Examples:</i> 125,  127.0.0.1:125, 127.0.0.1:125|127.0.0.5:125, INBOUND:125</small>','Basic',undef,'msg000030','msg000031'],
['smtpDestinationRT','SMTP Destination Routing Table*',80,\&textinput,'','^((?:(?:\s*'.$HostRe.'\s*=>\s*'.$HostPortRe.'\s*)(?:\|\s*'.$HostRe.'\s*=>\s*'.$HostPortRe.'\s*)*)|\s*file\s*:\s*.+|)$','configChangeRT',
  'If INBOUND is used in the SMTP Destination field, the rules specified here are used to route the inbound IP address to a different outbound IP address. You must specify a port number with the outbound IP address. <p><small><i>Example:</i>141.120.110.1=>141.120.110.129:25|141.120.110.2=>141.120.110.130:125|141.120.110.3=>141.120.110.130:125</small></p>',undef,undef,'msg000040','msg000041'],
['listenPortSSL','SMTP Secure Listen Port',80,\&textinput,'',$GUIHostPort,'ConfigChangeMailPortSSL',
  'The port number on which ASSP will listen for incoming secure SMTP connections (normally 465). You can specify both an IP address and port number to limit connections to a specific interface. Separate multiple entries by "|".<p><small><i>Examples:</i> 465, 127.0.0.1:465, 127.0.0.1:465|127.0.0.2:465 </small></p>',undef,undef,'msg000050','msg000051'],
['smtpDestinationSSL','SSL Destination',80,\&textinput,'',$GUIHostPort,undef,
  'The IP <b>address!</b> and port number to connect to when mail is received on the SSL listen port. If the field is blank, the primary SMTP destination will be used. <p><small><i>Examples:</i>127.0.0.1:565, 565</small></p>',undef,undef,'msg000060','msg000061'],
['listenPort2','Second SMTP Listen Port',80,\&textinput,'',$GUIHostPort,'ConfigChangeMailPort2',
  'A secondary port number on which ASSP can accept SMTP connections. This is useful as a dedicated port for VPN clients or for those who cannot directly send mail to a mail server outside of their ISP\'s network because the ISP is blocking port 25. You may also specify an IP address to limit connections to a specific interface. Separate multiple entries by "|".<p><small><i>Examples:</i> 2525, 127.0.0.1:2525, 192.168.0.100:25000</small></p>',undef,undef,'msg000070','msg000071'],
['smtpAuthServer','Second SMTP Destination',20,\&textinput,'',$GUIHostPort,undef,
  'The IP address and port number to connect to when mail is received on the second SMTP listen port. If the field is blank, the primary SMTP destination will be used. The purpose of this setting is to allow remote users to make authenticated connections and transmit their email without encountering SPF failures.<p><small><i>Examples:</i> 587, 127.0.0.1:587</small></p>',undef,undef,'msg000080','msg000081'],
['NoAUTHlistenPorts','Disable AUTH support on listenPorts',80,\&textinput,'','(.*)','ConfigChangeNoAUTHPorts',
  'This disables the SMTP AUTH command on the defined listenPorts. This option works for listenPort , listenPort2 and listenPortSSL . The listener definition here has to be the same like in the port definitions. Separate multiple entries by "|".<p><small><i>Examples:</i> 25, 127.0.0.1:25, 127.0.0.1:25|127.0.0.2:25 </small></p>',undef,undef,'msg008060','msg008061'],
['EnforceAuth',"Force SMTP AUTH on Second SMTP Listen Port",0,\&checkbox,0,'(.*)',undef,
  'Force clients connecting to the second listen port to authenticate before transferring mail. To use this setting, both listenPort2 (Second SMTP Listen Port) and smtpAuthServer (Second SMTP Destination) must be configured.<hr /><div class="menuLevel1">Notes On Network Setup</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/network.txt\',3);" />',undef,undef,'msg000090','msg000091'],

[0,0,0,'heading','SMTP Session Limits '],
['MaxErrors','Maximum Errors Per Session',5,\&textinput,'5','(\d+)',undef,
  'The maximum number of SMTP session errors encountered before the connection is dropped. An value of zero disables this feature. PB: meValencePB',undef,undef,'msg000100','msg000101'],

['maxSMTPSessions','Maximum Sessions',5,\&textinput,'64','(\d?\d?\d?)',undef,
  'The maximum number of simultaneous SMTP sessions. This can prevent server overloading and DoS attacks. 64 simultaneous sessions are typically enough. No entry or zero means no limit. Connections on relayPort will be counted, but connections on relayPort will never be limited because of this value. If the value is reached, assp will wait until the number of simultaneous SMTP sessions is lower than (value - 20) or (value * 0.75).',undef,undef,'msg000110','msg000111'],
['noMaxSMTPSessions','No Maximum Sessions IP numbers*',60,\&textinput,'','(\S*)','ConfigMakeIPRe','Mail from any of these IP numbers will pass through without checking maximum number of simultaneous SMTP sessions. For example: 145.145.145.145',undef,undef,'msg009160','msg009161'],
['maxSMTPipSessions','Maximum Sessions Per IP Address',3,\&textinput,'5','(\d?\d?\d?)',undef,
  'The maximum number of SMTP sessions allowed per IP address. Use this setting to prevent server overloading and DoS attacks. 5 sessions are typically enough. If left blank or set to 0 there is no limit imposed by ASSP. ispip (ISP/Secondary MX Servers) and acceptAllMail (Accept All Mail) matches are excluded from SMTP session limiting. PB: iplValencePB',undef,undef,'msg000120','msg000121'],

['HeaderMaxLength','Maximum Header Size',10,\&textinput,50000,'(\d*)',undef,
  'The maximum allowed header length, in bytes. At each mail hop header information is added by the mail server. A large mail header can indicate a mail loop. If the value is blank or 0 the header size will not be checked.',undef,undef,'msg000130','msg000131'],
['detectMailLoop','Detect Possible Mailloop',10,\&textinput,'3','(\d*)',undef,
 'If set to a value higher than 0, ASSP count it\'s own Received-header in the header of the mail. If this count exceeds the defined value, the transmission of the message will be canceled.',undef,undef,'msg008860','msg008861'],
['MaxEqualXHeader','Maximum Equal X-Header Lines*',40,\&textinput,'*=>20','^((?:.+?\s*=>\s*\d+(?:\s*\|.+?\s*=>\s*\d+)*)|\s*file\s*:\s*.+|)$','configUpdateStringToNum',
 'The maximum allowed equal X-header lines - eg. "X-SubscriberID". If the value is set to empty the header will not be checked for equal X-header lines. This check will be skipped for noprocessing, whitelisted and outgoing mails.<br />
  The default is "*=&gt;20", which means any X-header can occure 20 time maximum. You can define different values for different X-headers - wildcards like "*" and "?" are allowed to be used.<br />
  For example:<br />
  *=&gt;20|X-Notes-Item=&gt;100|X-Subscriber*=&gt;10|X-AnyTag=&gt;0<br />
  An value of zero disables the check for the defined X-header. The check is also skipped if no default like "*=&gt;20" is defined and the X-header defintion is not found.',undef,undef,'msg009060','msg009061'],

['maxRealSize','Max Real Size of Local Message',10,\&textinput,'','(\d*)',undef,
 'If the value of (number of [rcpt to] * [message size]) exceeds maxRealSize in bytes the transmission of the local message will be canceled. No limit is imposed by ASSP if the field is left blank or set to 0. This option allows admins to limit useless bandwidth wasting based on the total transmit size.',undef,undef,'msg000140','msg000141'],
['MaxRealSizeAdr','Max Real Size of Local Message Addresses*',40,\&textinput,'file:files/MaxRealSize.txt','(\s*file\s*:\s*.+|)','configUpdateMaxSize',
'Use this parameter to set individual maxRealSize values for email addresses, domains, user names and IP addresses. A file must be specified if used.<br />
Accepts specific addresses (user@domain.com), user parts (user), entire domains (@domain.com) and IP addresses (CIDR notation like 123.1.101/32 is here not supported!) - group definitions could be used. Use one entry per line. Wildcards are supported (fribo*@domain.co?). A second parameter separated by "=>" specifies the size limit. <br />
For example:<br />
fribo*@thisdomain.co?=&gt;1000000<br />
jhanna=&gt;0<br />
@sillyguys.org=&gt;500000<br />
101.1.2.*=&gt;0<br />
[admins]=&gt;0 <br />
If multiple matches (values) are found in a mail for any IP address in the transport mail chain, any envelope recipient and the envelope sender, the highest value or 0 (no limit) will be used! If no match (value) is found in a mail, the definition in maxRealSize will take place.'
,undef,undef,'msg009490','msg009491'],
['maxRealSizeExternal','Max Real Size of External Message',10,\&textinput,'','(\d*)',undef,
 'If the value of (number of [rcpt to] * [message size]) exceeds maxRealSizeExternal in bytes the transmission of the external message will be canceled. No limit is imposed by ASSP if the field is left blank or set to 0. This option allows admins to limit useless bandwidth wasting based on the total transmit size.',undef,undef,'msg000150','msg000151'],
['MaxRealSizeExternalAdr','Max Real Size of External Message Addresses*',40,\&textinput,'file:files/MaxRealSizeExt.txt','(\s*file\s*:\s*.+|)','configUpdateMaxSize',
'Use this parameter to set individual maxRealSizeExternal values for email addresses, domains, user names and IP addresses. A file must be specified if used.<br />
Accepts specific addresses (user@domain.com), user parts (user), entire domains (@domain.com) and IP addresses (CIDR notation like 123.1.101/32 is here not supported!) - group definitions could be used. Use one entry per line. Wildcards are supported (fribo*@domain.co?). A second parameter separated by "=>" specifies the size limit. <br />
For example:<br />
fribo*@thisdomain.co?=&gt;1000000<br />
jhanna=&gt;0<br />
@sillyguys.org=&gt;500000<br />
101.1.2.*=&gt;0<br />
[admins]=&gt;0 <br />
If multiple matches (values) are found in a mail for any IP address in the transport mail chain, any envelope recipient and the envelope sender, the highest value or 0 (no limit) will be used! If no match (value) is found in a mail, the definition in maxRealSizeExternal will take place.'
,undef,undef,'msg009500','msg009501'],
['maxRealSizeError','max real message size Error',80,\&textinput,'552 message exceeds MAXREALSIZE byte (size * rcpt)','(552 .*)',undef,'SMTP error message to reject maxRealSize / maxRealSizeExternal exceeding mails. For example:552 message exceeds MAXREALSIZE byte (size * rcpt)! MAXREALSIZE will be replaced by the value of maxRealSize / maxRealSizeExternal.',undef,undef,'msg000160','msg000161'],

['maxSize','Max Size of Local Message',10,\&textinput,'','(\d*)',undef,
 'If the value of ([message size]) exceeds maxSize in bytes the transmission of the local message will be canceled. No limit is imposed by ASSP if the field is left blank or set to 0. This option allows admins to limit useless bandwidth wasting based on the transmit size.',undef,undef,'msg008620','msg008621'],
['MaxSizeAdr','Max Size of Local Message Addresses*',40,\&textinput,'file:files/MaxSize.txt','(\s*file\s*:\s*.+|)','configUpdateMaxSize',
'Use this parameter to set individual maxSize values for email addresses, domains, user names and IP addresses. A file must be specified if used.<br />
Accepts specific addresses (user@domain.com), user parts (user), entire domains (@domain.com) and IP addresses (CIDR notation like 123.1.101/32 is here not supported!) - group definitions could be used. Use one entry per line. Wildcards are supported (fribo*@domain.co?). A second parameter separated by "=>" specifies the size limit. <br />
For example:<br />
fribo*@thisdomain.co?=&gt;1000000<br />
jhanna=&gt;0<br />
@sillyguys.org=&gt;500000<br />
101.1.2.*=&gt;0<br />
[admins]=&gt;0 <br />
If multiple matches (values) are found in a mail for any IP address in the transport mail chain, any envelope recipient and the envelope sender, the highest value or 0 (no limit) will be used! If no match (value) is found in a mail, the definition in maxSize will take place.'
,undef,undef,'msg009510','msg009511'],
['maxSizeExternal','Max Size of External Message',10,\&textinput,'','(\d*)',undef,
 'If the value of ([message size]) exceeds maxSizeExternal in bytes the transmission of the external message will be canceled. No limit is imposed by ASSP if the field is left blank or set to 0. This option allows admins to limit useless bandwidth wasting based on the transmit size.',undef,undef,'msg008630','msg008631'],
['MaxSizeExternalAdr','Max Size of External Message Addresses*',40,\&textinput,'file:files/MaxSizeExt.txt','(\s*file\s*:\s*.+|)','configUpdateMaxSize',
'Use this parameter to set individual maxSizeExternal values for email addresses, domains, user names and IP addresses. A file must be specified if used.<br />
Accepts specific addresses (user@domain.com), user parts (user), entire domains (@domain.com) and IP addresses (CIDR notation like 123.1.101/32 is here not supported!) - group definitions could be used. Use one entry per line. Wildcards are supported (fribo*@domain.co?). A second parameter separated by "=>" specifies the size limit. <br />
For example:<br />
fribo*@thisdomain.co?=&gt;1000000<br />
jhanna=&gt;0<br />
@sillyguys.org=&gt;500000<br />
101.1.2.*=&gt;0<br />
[admins]=&gt;0 <br />
If multiple matches (values) are found in a mail for any IP address in the transport mail chain, any envelope recipient and the envelope sender, the highest value or 0 (no limit) will be used! If no match (value) is found in a mail, the definition in maxSizeExternal will take place.',undef,undef,'msg009520','msg009521'],
['maxSizeError','max message size Error',80,\&textinput,'552 message exceeds MAXSIZE byte (size)','(552 .*)',undef,'SMTP error message to reject maxSize / maxSizeExternal exceeding mails. For example:552 message exceeds MAXSIZE byte (size)! MAXSIZE will be replaced by the value of maxSize / maxSizeExternal.',undef,undef,'msg008640','msg008641'],

['MaxAUTHErrors','Max Number of AUTHentication Errors',10,\&textinput,'','(\d*)',undef,
 'If an IP (/24 network is used) exceeds this number of authentication errors (535 or 530) the transmission of the current message will be canceled and any new connection from that IP will be blocked for 5-10 minutes.<br />
  Every 5 Minutes the \'AUTHError\' -counter of the IP will be decreased by one. autValencePB is used for the penalty box.<br />
  No limit is imposed by ASSP if the field is left blank or set to 0. This option allows admins to prevent external bruteforce or dictionary attacks via AUTH command. Whitelisted, noBlockingIPs and NoProcessing IP\'s are ignored like any relayed connection.',undef,undef,'msg009310','msg009311'],
['noMaxAUTHErrorIPs','Do not check MaxAUTHErrors for these IP\'s*',40,\&textinput,'','(\S*)','ConfigMakeIPRe','List of IP\'s which should not be checked for MaxAUTHErrors .  For example: 145.145.145.145|145.146.',undef,undef,'msg009580','msg009581'],

['DoSameSubject','Check Same Subjects','0:disabled|1:block|2:monitor|3:score|4:testmode',\&listbox,0,'(.*)',undef,
 'If activated, assp will check the mail subjects for equality using the config parameters below. Scoring is done with \'isValencePB\'.',undef,undef,'msg010040','msg010041'],

['subjectFrequencyInt','Subject Frequency Interval',40,\&textinput,'300','(\d*)',undef,'The time interval in seconds in which the number of equal subjects has not to exceed a specific number ( subjectFrequencyNumSubj ).<br />
  Use this in combination with subjectFrequencyNumSubj to limit the number of equal subjects in a given interval. A value of 0 (default) will disable this feature and clean the cache within five minutes.<br />
  <input type="button" value="edit Subject Frequency Cache" onclick="javascript:popFileEditor(\'DB-subjectFrequencyCache\',\'1h\');" />',undef,undef,'msg010050','msg010051'],

['subjectFrequencyNumSubj','Subject Frequency Number of Subjects',40,\&textinput,'5','(\d*)',undef,'The number of equal sbujects that has not to exceed in a specific time interval ( subjectFrequencyInt ).<br />
  Use this in combination with subjectFrequencyInt to limit the number of equal subjects in a given interval. A value of 0 (default) will disable this feature and clean the cache within five minutes.<br />
  <input type="button" value="edit Subject Frequency Cache" onclick="javascript:popFileEditor(\'DB-subjectFrequencyCache\',\'1h\');" />',undef,undef,'msg010060','msg010061'],

['subjectFrequencyOnly','Check Equal Subject Frequency for this Users only*',60,\&textinput,'','(.*)','ConfigMakeSLRe',
 'A list of local addresses, for which the \'subject frequency check\' should be done. Leave this field blank (default), to do the check for every address.<br />
  Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com).  Wildcards are supported (fribo*@domain.com).<br />
  For example: fribo*@thisdomain.com|jhanna|@sillyguys.org ',undef,undef,'msg010070','msg010071'],

['NoSubjectFrequency','Check Equal Subject Frequency NOT for this Users*',60,\&textinput,'','(.*)','ConfigMakeSLRe',
 'A list of local addresses, for which the \'subject frequency check\' should not be done.<br />
  Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com).  Wildcards are supported (fribo*@domain.com).<br />
  For example: fribo*@thisdomain.com|jhanna|@sillyguys.org ',undef,undef,'msg010080','msg010081'],

['NoSubjectFrequencyIP','Check Equal Subject Frequency NOT for this IP\'s*',60,\&textinput,'','(\S*)','ConfigMakeIPRe','Mail from any of these IP numbers will pass through without checking the equality of subjects. For example: 145.145.145.145',undef,undef,'msg010090','msg010091'],

['smtpIdleTimeout','SMTP Idle Timeout',5,\&textinput,'180','(\d?\d?\d?\d?)',undef,
 'The number of seconds a session is allowed to be idle before being forcibly disconnected. The default is 180 seconds. No limit is imposed by ASSP if the field is left blank or set to 0. If you have not defined an IdleTimeout on your MTA, this value should not be set to 0, because then a connection will never be timed out!',undef,undef,'msg000170','msg000171'],
['NpWlTimeOut','SMTP Idle Timeout for Whitelisted an Noprocessing',5,\&textinput,'1200','(\d?\d?\d?\d?)',undef,
 'The number of seconds a whitelisted or noprocessing session is allowed to be idle before being forcibly disconnected. The default is 1200 seconds. No limit is imposed by ASSP if the field is left blank or set to 0. If you have not defined an IdleTimeout on your MTA, this value should not be set to 0, because then a connection will never be timed out!',undef,undef,'msg009860','msg009861'],
['smtpNOOPIdleTimeout','SMTP Idle Timeout after NOOP',5,\&textinput,'0','(\d?\d?\d?\d?)',undef,
 'The number of seconds a session is allowed to be idle after a "NOOP" command is received, before being forcibly disconnected. The default is 0 seconds. No limit is imposed by ASSP if the field is left blank or set to 0.<br />
  This should prevent hackers to hold and block connections by sending "NOOP" commands short before the "smtpIdleTimeout" is reached.',undef,undef,'msg000180','msg000181'],
['smtpNOOPIdleTimeoutCount','SMTP Idle Timeout after NOOP Count',5,\&textinput,'0','(\d?\d?)',undef,
 'The number of counts a session is allowed send "NOOP" commands following on each other, before being forcibly disconnected. The default is 0. No limit is imposed by ASSP if the field is left blank or set to 0.<br />
  This in cooperation with "smtpNOOPIdleTimeout" should prevent hackers to hold and block connections by sending repeatedly "NOOP" commands short before the "smtpNOOPIdleTimeout" is reached. If "smtpNOOPIdleTimeout" is not defined or 0, this value will be ignored!<hr /><div class="menuLevel1">Notes On SMTP Session Limits</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/sessionlimits.txt\',3);" />',undef,undef,'msg000190','msg000191'],

[0,0,0,'heading','Group definition'],
['Groups','Address and Domain Groups*',80,\&textinput,'','(\s*file\s*:\s*.+|)','ConfigMakeGroupRe','
 If you don\'t want to use group definitions, leave this field blank otherwise a file definition like \'file:files/groups.txt\' is required.<br/>
 Group definitions could be used in any other configuration value where multiple user names, email addresses or domain names or IP addresses could be defined.<br />
 Groups are defined and used using the same syntax [group-name] (including the brackets) in a single line. In the configuration parameters, the line [group-name] will be replaced by the content of the group definition, that is done here.<br />
 All group definitions are case sensitive. Group names can only contain the following characters: A-Z, a-z, 0-9, - , _ and @ !<br />
 The structure of this file has to be as follows:<br />
 <br />
 [super_spamlovers]<br />
 myBoss<br />
 ldap:{host=&gt;my_LDAP_server:389,base=&gt;(sep)DC=domain,DC=tld(sep),user=&gt;(sep)CN=admin,DC=domain(sep),password=&gt;(sep)pass(sep),timeout=&gt;2,scheme=&gt;ldap,STARTTLS=&gt;1,version=&gt;3},{(CN=management)}{member},{(CN=%USERID%)}{mailaddress}<br />
 entry<br />
 exec:/usr/bin/list_postfix_users --domain mydomain --group postoffice<br />
 entry<br />
 ...<br />
 <br />
 [admins]<br />
 ldap:{host=&gt;domino1.mydomain.com:389,base=&gt;(sep)DC=domain,DC=tld(sep),user=&gt;(sep)Administrator(sep),password=&gt;(sep)pass(sep),timeout=&gt;2,scheme=&gt;ldap,STARTTLS=&gt;1,version=&gt;3},{(CN=LocalDomainAdmins)}{member},{(CN=%USERID%)}{mailaddress}<br />
 entry<br />
 entry<br />
 ...<br />
 <br />
 [specialIPList]<br />
 1.2.3.4<br />
 123.234.0.0/16<br />
 ::1<br />
 <br />
 Lines starting with a # OR ; are consider a comment. Empty lines will be ignored. An group definition stopps, if a new group definition starts or at the end of the file. Comments are not allowed inside a definition line.<br />
 <br />
 There are two possible methodes to import entries from an external source in to a group - the execution of a system command or a LDAP query.<br />
 To import entries via a system command like (eg. cat|grep or find or your self made shell script), write a single line that begins with exec: followed by the command to be executed - like:<br />
 exec:cat /etc/anydir/*.txt|grep \'@\'<br />
 The executed system command has to write a comma(,) or pipe(|) or linefeed(LF,CRLF) separated list of entries to STDOUT, that should become part of that group, where this line is used. There could be multiple and any combination of entry types in one group definition.<br />
 <br />
 If you are familar with the usage of LDAP, you can define LDAP querys to import entries from one or more LDAP server. This is done, defining one query per line. The syntax of such a line is:<br />
 <br />
 ldap:{host_and_protocol},{LDAP_group_query_filter}{LDAP_group_query_attribut_to_return},{LDAP_entry_query_filter}{LDAP_entry_query_attribut_to_return}<br />
 <br />
 If the \'host_and_protocol\' part is empty {}, the default LDAP configuration will be used. An \'host_and_protocol\' part should contain the following entries in the following structure:<br />
 {host=&gt;127.0.0.1:389,base=&gt;(sep)DC=domain,DC=tld(sep),user=&gt;(sep)...(sep),password=&gt;(sep)pass(sep),timeout=&gt;..,scheme=&gt;ldap/ldaps,STARTTLS=&gt;0/1,version=&gt;2/3}<br />
 The \'host\' has to be set, if you want to define any other LDAP parameter. If any other parameter is not defined, the default LDAP configuration value will be used, except user and password. The port definition (:xxx) in the host setting is optional - if not defined, the default LDAP ports 389(LDAP) and 636(LDAPS) will be used. It is possible to define a comma(,) separated list of hosts for failover functionality like \'host=>"localhost:389,192.168.1.1:389,...."\' - notice the quotes as terminator which are required in this case!<br />
 The value of the base, password and user parameter has to start and end with a single character (sep) as terminator, that is not part of the value
 and is not used in the value. The parameter "base" defines the LDAP search root like LDAPRoot .<br />
 <br />
 The \'LDAP_group_query_filter\' and \'LDAP_group_query_attribut_to_return\' are used to query a LDAP group for it\'s members (users). The resulting list will contain the requested attributes of all group members. The definition of these two parameters could look as follows:<br />
 {(&(objectclass=dominoGroup)(CN=LocalDomainAdmins))}{member}<br />
 <br />
 It is possible to modify each returned value with a callback-code. This is for example usefull for MS-AD querys on the attribute \'proxyaddresses\', which returns a list of all available mail addresses (SMTP,smtp,X400...).
 <br />
 example: ldap:{},{(&(CN=firstname lastname)(proxyaddresses=smtp:*))<=s/^\s*smtp:\s*(.+)\s*$/$1/i}{proxyaddresses},{}{}
 <br />
 <= is the required separator, s/^\s*smtp:\s*(.+)\s*$/$1/i is the callback code.<br />
 The callback code has to return a value of not zero or undef on success. The code gets the LDAP result in the variable $_ and has to modify this variable in place on success.<br />
 It is not allowed to use any of the following characters in the callback definiton of a ldap line: {}| <br />
 <br />
 The \'LDAP_entry_query_filter\' and \'LDAP_entry_query_attribut_to_return\' are used to query each member from the first query, for it\'s email address. The literal \'%USERID%\' in the \'LDAP_entry_query_filter\' will be replaced by each LDAP-attribute result of the first query. The definition of these two parameters could look as follows:<br />
 {(&(objecttype=person)(CN=%USERID%)(o=%USERID%))}{mailaddress}<br />
 or more simple<br />
 {(&(objecttype=person)(CN=%USERID%))}{mailaddress}<br />
 <br />
 An callback code could be used the same way like for \'LDAP_group_query_filter\' - {(&(objecttype=person)(CN=%USERID%))<=callback-code}{mailaddress}.
 <br />
 To break long lines in to multiple, terminate a continued line with a slash "/"<br /><br />
 If you are able to get all results (eg. email addresses or domain names) with the \'LDAP_group_query\' query, leave the definition of \'LDAP_entry_query_filter\' and \'LDAP_entry_query_attribut_to_return\' empty {}{}.<br />
 <br />
 The result of each group definition will be stored in a file in files/group_export/GROUPNAME.txt.<br />
 The groups are build at every start of assp and if the defined file or an include file is stored (changed file time). To force a reload of all groups, open the file and click \'Save changes\' or change the file time with an external shell script. It is also possible to use GroupsReloadEvery, to reload the Groups definition in time intervals, if the exec: or ldap: option are used.','Basic',undef,'msg009470','msg009471'],
['GroupsReloadEvery','Reload the Groups definitions every this minutes <sup>s</sup>',40,\&textinput,60,$ScheduleGUIRe,'configChangeSched',
 'ASSP will reload the Groups definiton every this minutes, if the exec: or ldap: option is used in Groups. <br />
 An value of zero disables the scheduled reload. Defaults to 60 minutes.<br />
 <hr /><div class="menuLevel1">Notes On Group Definitions</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/groupsdef.txt\',3);" />','Basic',undef,'msg007910','msg007911'],

[0,0,0,'heading','SPAM Control <a href="http://apps.sourceforge.net/mediawiki/assp/index.php?title=Getting_Started" target=wiki><img height=12 width=12 src="' . $wikiinfo . '" alt="Getting Started" /></a>'],
['redRe','Regular Expression to Identify Redlisted Mail*',80,\&textinput,'file:files/redre.txt','(.*)','ConfigCompileRe',
 'If an email matches this Perl regular expression it will be considered redlisted.<br />
 redRe detects tags to process a mail like the recipient were redlisted - nothing else (no redlist addition/removal).<br />
 The Redlist serves two purposes:<br />
1) the Redlist is a list of addresses that cannot contribute to the
whitelist and which are not considered local even if their mail is
from a local computer. For example, if someone goes on a vacation and
turns on their autoresponder, put them on the redlist until
they return. Then as they reply to every spam they receive they won\'t
corrupt your non-spam collection or whitelist: \[autoreply\]<br />
2) Redlisted addresses will not be added to the Whitelist when your
local user sends mail to that address, thereby preventing accidental
pollution of the Whitelist by, say, inadvertent replies by your
users to mails from the spammer.<br />
Redlisted messages will not be stored in the SPAM/NOTSPAM-collection. As all fields marked by * this field accepts
a list separated by | or a specified file \'file:files/redre.txt\'. ',undef,undef,'msg000200','msg000201'],
['EmailWhiteRemovalToRed','Add  Whitelist Removals To Redlist ',0,\&checkbox,'','(.*)',undef,
  'If set addresses which are removed from Whitelist via email-interface will automatically be added to the Redlist. The address can only be added again to the Whitelist after it is removed from the Redlist.',undef,undef,'msg000210','msg000211'],
['SpamError','Spam Error',80,\&textinput,'554 5.7.1 Mail appears to be unsolicited -- send error reports to postmaster@LOCALDOMAIN','([245]\d\d .*)',undef,'SMTP error message to reject spam. The literal LOCALDOMAIN will be replaced by the recipient domain. For example:554 5.7.1 Mail appears to be unsolicited -- send error reports to postmaster@LOCALDOMAIN. ',undef,undef,'msg000220','msg000221'],
['noGriplistUpload','Don\'t Upload Griplist Stats',0,\&checkbox,'','(.*)',undef,
 'Check this to disable the Griplist upload when rebuildspamdb runs. The Griplist contains IPs and their value between 0 and 1, lower is less spammy, higher is more spammy. This value is called the grip value. ',undef,undef,'msg000230','msg000231'],
['noGriplistDownload','Don\'t auto-download the Griplist file',0,\&checkbox,'','(.*)',undef,
 'Set this checkbox, if you don\'t use the Griplist. You have to disable also noGriplistUpload to download the Griplist.',undef,undef,'msg000240','msg000241'],

['StoreASSPHeader','Store Assp-Header into Spam Collection',0,\&checkbox,'','(.*)',undef,
 'Add "X-Assp-" to the collected spam-mails.',undef,undef,'msg008770','msg008771'],
['AddIntendedForHeader','Add Envelope-Recipient Header',0,\&checkbox,1,'(.*)',undef,
 'Adds two lines to the email header: "X-Assp-Intended-For: user@domain" and "X-Assp-Envelope-From: user@domain".',undef,undef,'msg000250','msg000251'],
['NoExternalSpamProb','Block Outgoing Spam-Prob header',0,\&checkbox,1,'(.*)',undef,
'Check this box if you don\'t want your X-Assp-Spam-Prob header on external mail<br />
 Note this means mail from local users to local users will also be missing the header.',undef,undef,'msg000260','msg000261'],
['AddSpamHeader','Add Spam Header',0,\&checkbox,1,'(.*)',undef,
 'Adds a line to the email header "X-Assp-Spam: YES" if the message is spam.',undef,undef,'msg000270','msg000271'],
['AddCustomHeader','Add Custom Header',80,\&textinput,'X-Spam-Status:yes','^(|X\-[A-Za-z0-9_.-]+?:.*)$',undef,
 'Adds a line to the email header if the message is spam. For example: <a href="http://exchangepedia.com/blog/2008/01/assigning-scl-to-messages-scanned-by.html">X-Spam-Status:yes<img src="' . $wikiinfo . '" alt="Assigning SCL to messages scanned by 3rd-party antispam filters" /></a>',undef,undef,'msg000280','msg000281'],
['AddLevelHeader','Add Graphical Level Header',0,\&checkbox,1,'(.*)',undef,
 'Adds a line to the email header "X-Assp-Spam-Level: **** " showing the total message score represented by stars (1 - 20), every star represents five scoring points.',undef,undef,'msg000290','msg000291'],
['AddSubjectHeader','Add X-ASSP-Original-Subject Header',1,\&checkbox,'','(.*)',undef,
 'Adds a line to the email header "X-ASSP-Original-Subject: the subject".',undef,undef,'msg000300','msg000301'],
['AddSpamReasonHeader','Add Spam Reason Header',0,\&checkbox,1,'(.*)',undef,
 'Adds a line to the email header "X-Assp-Spam-Reason: " explaining why the message is spam.<br /><hr /><div class="menuLevel1">Notes On Spam Control</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/spamcontrol.txt\',3);" />',undef,undef,'msg000310','msg000311'],

[0,0,0,'heading','Copy Spam & Ham'],
['sendAllSpam','Copy Spam and Send to this Address',80,\&textinput,'','(.*)',undef,
 'If this is set ASSP will deliver a copy of spam mails to this address. For example: spammaster@mydomain.com. The literal USERNAME is replaced by the user part of the recipient, the literal DOMAIN is replaced by the domain part of the recipient.
 For example: USERNAME@Spam.DOMAIN, USERNAME+Spam@DOMAIN, catchallspamthis@DOMAIN. Separate multiple entries by comma or space. To deliver copy of spams based on the domain name (only some special hosted domains), use ccSpamInDomain .','Basic',undef,'msg000320','msg000321'],
['ccSpamInDomain','Copy Spam and Send to this Address per Domain*',60,\&textinput,'','(.*)','configUpdateCCD',
 'ASSP will deliver an additional copy of spam emails of a domain to this address (even if sendAllSpam is not set) - if the domain of the recipient-address is matched. For example: monitorspam@example1.com|monitor@example2.com.','Basic',undef,'msg008880','msg008881'],
['sendAllDestination','Copy Spam SMTP Destination',20,\&textinput,'','^('.$PortRe.'|'.$HostPortRe.'|)$',undef,
 'Port to connect to when  Spam messages are copied. If blank they go to the main SMTP Destination. eg "10.0.1.3:1025", "1025", etc.',undef,undef,'msg000330','msg000331'],
['ccSpamFilter','Copy Spam to these Recipients Only*',40,\&textinput,'','(.*)','ConfigMakeSLRe',
 'Restricts Copy Spam to these recipients. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com). Wildcards are supported (fribo*@domain.com).',undef,undef,'msg000340','msg000341'],
['ccSpamAlways','Copy Spam to these Recipients always*',40,\&textinput,'','(.*)','ConfigMakeSLRe',
 'Copy Spam to these recipients regardless of collection mode. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com).  Wildcards are supported (fribo*@domain.com).',undef,undef,'msg000350','msg000351'],
['ccSpamNeverRe','Do Not Copy Spam Regex*',40,\&textinput,'','(.*)','ConfigCompileRe',
 'Never Copy Spam regardless of collection mode. Put anything here to identify messages which should not be copied.',undef,undef,'msg000360','msg000361'],
['ccMaxScore','Do Not Copy Messages Above This MessageTotal score',3,\&textinput,'','(\d*)',undef,
 'Messages whose score exceeds this threshold will not be copied.  For example: 75',undef,undef,'msg000370','msg000371'],
['ccMaxBytes','Restrict Copy Spam to MaxBytes',0,\&checkbox,1,'(.*)',undef,
 'CCMail will cut off Spam mails, thereby reducing the load considerably (recommended).',undef,undef,'msg000380','msg000381'],
['spamSubjectCC','Prepend Spam Subject to Copied Spam',0,\&checkbox,'','(.*)',undef,
 'If set, spamSubject gets prepended to the subject of the copied message.',undef,undef,'msg000390','msg000391'],
['spamTagCC','Prepend Spam Tag to Copied Spam',0,\&checkbox,1,'(.*)',undef,'The check which caused the spam detection will be prepended to the subject of the message. For example: [DNSBL]',undef,undef,'msg000400','msg000401'],
['sendAllHamDestination','Copy Not-Spam SMTP Destination',20,\&textinput,'','^('.$PortRe.'|'.$HostPortRe.'|)$',undef,
 'Port to connect to when  Ham messages are copied. If blank they go to the Spam SMTP Destination. eg "10.0.1.3:1025", "1025", etc.',undef,undef,'msg000410','msg000411'],
['sendHamInbound','Copy Incoming Not-Spam and Send to this Address',20,\&textinput,'','(.*)',undef, 'If you put an address in this box  ASSP will forward a copy of notspam messages from outside to this address. The literal USERNAME is replaced by the user part of the recipient, the literal DOMAIN is replaced by the domain part of the recipient. For example: archiv@mydomain.com, USERNAME@mybackup.domain, catchallforthis@DOMAIN',undef,undef,'msg000420','msg000421'],
['sendHamOutbound','Copy Outgoing Not-Spam and Send to this Address',20,\&textinput,'','(.*)',undef, 'If you put an address in this box ASSP will forward a copy of outgoing notspam messages to this address.',undef,undef,'msg000430','msg000431'],
['ccHamFilter','Copy Ham Filter*',40,\&textinput,'','(.*)','ConfigMakeSLRe',
 'Copy Not-Spam to these addresses only. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com). Wildcards are supported (fribo*@domain.com).',undef,undef,'msg000440','msg000441'],
['ccnHamFilter','Do Not Copy Ham Filter*',40,\&textinput,'','(.*)','ConfigMakeSLRe',
 'Do Not Copy Ham to these addresses. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com). Wildcards are supported (fribo*@domain.com).',undef,undef,'msg000450','msg000451'],
['ccMailReplaceRecpt','ccMail Recipient Replacement',0,\&checkbox,'','(.*)',undef,'The recipient replacement (ReplaceRecpt) rules from the "Recipients/Local Domains" section, will be used to replace ccMail recipients. For example: sendHamInbound = USERNAME@yourspamdomain.lan - in this case you are able to detect the target domain "yourspamdomain.lan" in a rule and you can replace the recipient/domain depending on its values and/or on the senders address.<br />
<hr /><div class="menuLevel1">Notes On CC Messages</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/copymail.txt\',3);" />',undef,undef,'msg000460','msg000461'],

[0,0,0,'heading','SPAM Lover/Hater'],
['spamSubjectSL','Suppress SpamSubject to Spam-Lover-Messages',0,\&checkbox,'','(.*)',undef,
 'If set, spamSubject and spamTag does NOT get prepended to the subject of the Spam-Lover-Message.',undef,undef,'msg000470','msg000471'],
['spamTagSL','Suppress SpamTags to Spam-Lover-Messages',0,\&checkbox,1,'(.*)',undef,
 'If set, spamTags does NOT get prepended to the subject of the Spam-Lover-Message.',undef,undef,'msg000480','msg000481'],
['groupSpamLovers',"Group SpamLovers and Not SpamLovers per mail",0,\&checkbox,'','(.*)',undef,
 'If set, the first envelope recipient consider a mail to be for spamlovers or not. If the first envelope recipient is any SpamLover, all other (following) envelope recipients must be also any SpamLover (or reverse) - if not, their address will be not accepted by ASSP for this single mail and \'452 too many recipients\' will be sent.',undef,undef,'msg008800','msg008801'],
['spamLovers','All Spam-Lover*',60,\&textinput,'postmaster|abuse','(.*)','ConfigMakeSLReSL',
 'Messages to Spam-Lovers are processed and filtered by ASSP, but get tagged with spamSubject and are not blocked. When a
 Spam-Lover is not the sole recipient of a message, the message is processed
 normally, and if it is found to be spam, it will not be delivered to the
 Spam-Lover. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com). Wildcards are supported (fribo*@domain.com). Default: postmaster|abuse.<br />For example: fribo*@thisdomain.com|jhanna|@sillyguys.org
 <hr>
 This option and all SpamLover-Options below accepting a second score parameter like "user@your-domain.com=>70"<br />
 If such a parameter is defined in any option for an entry and the recipient address matches this entry and the message score exceeds the parameter value, the message will be blocked.<br />
 If there are multiple possible matches for a recipient address found, the generic longest match (and value) will be used.<br />
 ASSP will use the highest found value for all recipients of an email.',undef,undef,'msg000490','msg000491'],
['SpamLoversRe','Regular Expression to Identify  Spam-Lover*',60,\&textinput,'','(.*)','ConfigCompileRe',
'If a message matches this regular expression it will be considered a Spam-Lover message.',undef,undef,'msg000500','msg000501'],
['baysSpamLovers','Bayesian Spam-Lover*',60,\&textinput,'','(.*)','ConfigMakeSLReSL','',undef,undef,'msg000510','msg000511'],
['baysSpamLoversRe','Regular Expression to Identify Bayesian Spam-Lover*',60,\&textinput,'','(.*)','ConfigCompileRe',
 'If a message matches this regular expression it will be considered a Bayesian Spam-Lover message. For example: passwor|news',undef,undef,'msg000520','msg000521'],
['baysSpamLoversRed','Do not store Bayesian Spam-Lover in SpamDB',0,\&checkbox,'','(.*)',undef,
 'If set, mail to Bayesian Spam-Lover will not be stored in Spam/Notspam folder.',undef,undef,'msg000530','msg000531'],
['blSpamLovers','Blacklisted Domains Spam-Lover*',60,\&textinput,'','(.*)','ConfigMakeSLReSL','',undef,undef,'msg000540','msg000541'],
['bombSpamLovers','Bomb Spam-Lover*',60,\&textinput,'','(.*)','ConfigMakeSLReSL','',undef,undef,'msg000550','msg000551'],
['hlSpamLovers','HELO Blacklisted Spam-Lover*',60,\&textinput,'','(.*)','ConfigMakeSLReSL','',undef,undef,'msg000560','msg000561'],
['hiSpamLovers','Valid/Invalid Helo*',60,\&textinput,'','(.*)','ConfigMakeSLReSL','',undef,undef,'msg000570','msg000571'],
['atSpamLovers','Bad Attachment Spam-Lover*',60,\&textinput,'','(.*)','ConfigMakeSLReSL','',undef,undef,'msg000580','msg000581'],
['spfSpamLovers','SPF Failures Spam-Lover*',60,\&textinput,'','(.*)','ConfigMakeSLReSL','',undef,undef,'msg000590','msg000591'],
['rblSpamLovers','DNSBL Failures Spam-Lover*',60,\&textinput,'','(.*)','ConfigMakeSLReSL','',undef,undef,'msg000600','msg000601'],
['uriblSpamLovers','URIBL Failures Spam-Lover*',60,\&textinput,'','(.*)','ConfigMakeSLReSL','',undef,undef,'msg000610','msg000611'],
['srsSpamLovers','Unsigned SRS Bounces Spam-Lover *',60,\&textinput,'','(.*)','ConfigMakeSLReSL','',undef,undef,'msg000620','msg000621'],
['delaySpamLovers','No Delaying Spam-Lover*',60,\&textinput,'','(.*)','ConfigMakeSLReSL','',undef,undef,'msg000630','msg000631'],
['isSpamLovers','Invalid Sender Spam-Lover*',60,\&textinput,'','(.*)','ConfigMakeSLReSL','',undef,undef,'msg000640','msg000641'],
['mxaSpamLovers','Missing MX Spam-Lover*',60,\&textinput,'','(.*)','ConfigMakeSLReSL','',undef,undef,'msg000650','msg000651'],
['ptrSpamLovers','Invalid/Missing PTR Spam-Lover*',60,\&textinput,'','(.*)','ConfigMakeSLReSL','',undef,undef,'msg000660','msg000661'],
['pbSpamLovers','Penalty Box Blocking Spam-Lover *',60,\&textinput,'','(.*)','ConfigMakeSLReSL','',undef,undef,'msg000670','msg000671'],
['sbSpamLovers','Country Blocking Spam-Lover *',60,\&textinput,'','(.*)','ConfigMakeSLReSL','',undef,undef,'msg000680','msg000681'],
['spamHaters','All Spam-Haters*',60,\&textinput,'','(.*)','ConfigMakeSLRe',
 'Spam-Haters are used to override Spam-Lovers.
 Example: If you have set your entire domain as a Spam-Lover(s), but there are still some addresses you still wish to block spam for. If you add those addresses to the Spam-Haters field allows messages to only those addresses to be blocked while still allowing the messages to the other Spam-Lovers pass through. The message will only be blocked if all recipients are Spam-Haters. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com).  Wildcards are supported (fribo*@domain.com).<br />For example: *fribo@thisdomain.com|jhanna|@sillyguys.org ',undef,undef,'msg000690','msg000691'],
['baysSpamHaters','Bayesian Spam-Hater*',60,\&textinput,'','(.*)','ConfigMakeSLRe','',undef,undef,'msg000700','msg000701'],
['rblSpamHaters','DNSBL Failures Spam-Hater*',60,\&textinput,'','(.*)','ConfigMakeSLRe','',undef,undef,'msg000710','msg000711'],
['hlSpamHaters','HELO Blacklisted Spam-Hater*',60,\&textinput,'','(.*)','ConfigMakeSLRe','',undef,undef,'msg000720','msg000721'],
['switchSpamLoverToScoring',"Switch Spam-Lover to Message Scoring",0,\&checkbox,'','(.*)',undef,
 'Put the filter automatically in "Message Scoring Mode" when DoPenaltyMessage is set (instead of stopping spam processing altogether).<br /><hr /> <div class="menuLevel1">Notes On Spam-Lover</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/spamlover.txt\',3);" />',,undef,undef,'msg000730','msg000731'],

[0,0,0,'heading','No Processing'],
['noProcessingIPs','No Processing IPs*',60,\&textinput,'file:files/ipnp.txt','(\S*)','ConfigMakeIPRe','Mail from any of these IP\'s will pass through without processing. <br />
 For example: 145.145.145.145|146.145.<br />
  To define IP\'s only for specific email addresses or domains (recipients) you must use the file:... option<br />
  An entry (line) may look as follows:<br />
  145.146.0.0/16=>*@local.domain|user@mydomain|user2@*.mydomain # comment<br /><br />
  It is possible to define a predefined group on any or both sides of the \'=>\' separator, like:<br />
  [ipgroup]=>[usergroup]|user@mydomain<br /><br />
  NOTICE: the following combination of two entries, will lead in to a user/domain based matching - the global entry will be ignored!<br />
  145.146.0.0/16 # comment<br />
  145.146.0.0/16=>*@local.domain|user@mydomain|user2@*.mydomain # comment<br />
  If multiple user/domain based entries are defined for the same IP, only the last one will be used!<br /><br />
 <span class="positive"> All fields marked by \'*\' accept  a filepath/filename : \'file:files/ipnp.txt\'.</span>',undef,'7','msg000740','msg000741'],
['noProcessing','No Processing Addresses*',60,\&textinput,'','(.*)','ConfigMakeSLRe',
 'Mail solely to or from any of these addresses are proxied without processing. Like a more efficient version of Spam-Lovers &amp; redlist combined. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com).  Wildcards are supported (fribo*@domain.com).',undef,undef,'msg000750','msg000751'],
['noProcessingFrom','No Processing Addresses From*',60,\&textinput,'','(.*)','ConfigMakeSLRe',
 'Mail solely from any of these addresses are proxied without processing. Accepts specific addresses (user@example.com), user parts (user) or entire domains (@example.com).  Wildcards are supported (fribo*@example.com).',undef,undef,'msg000760','msg000761'],
['noProcessingDomains','No Processing Domains*',60,\&textinput,'sourceforge.net','(.*)','ConfigMakeRe',
 'Domains from which you want to receive all mail and  proxy without processing. Your ISP, domain registration, mail list servers, stock broker, or other key business partners might be good candidates. Note this matches the end of the address, so if you don\'t want to match subdomains then include the @. Note that buy.com would also match spambuy.com but .buy.com won\'t match buy.com. For example: sourceforge.net|@google.com|.buy.com',undef,undef,'msg000770','msg000771'],
['npRe','Regular Expression to Identify No Processing Mail*',60,\&textinput,'','(.*)','ConfigCompileRe',
 'If a message matches this Perl regular expression ASSP will treat the message as a \'No Processing\' mail. For example: 169\.254\.122\.|172\.16\.|\\[autoreply\\].',undef,undef,'msg000780','msg000781'],
['npSize','Message Size Limit',10,\&textinput,'500000','(.*)',undef,'ASSP will treat incoming messages larger than this SIZE (in bytes) as \'No Processing\' mail, after the header part of the mail is received without any error. Empty or 0 disables the feature.',undef,undef,'msg000790','msg000791'],
['npSizeOut','Message Size Limit Outgoing',10,\&textinput,'500000','(.*)',undef,'ASSP will treat outgoing messages larger than this SIZE (in bytes) as \'No Processing\' mail. Empty or 0 disables the feature. ',undef,undef,'msg000800','msg000801'],
['processOnlyAddresses','Process Only These Addresses*',80,\&textinput,'','(.*)','ConfigMakeSLRe','Mail solely to or from any of these addresses will be processed by ASSP. All others will be proxied without processing. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com).  Wildcards are supported (fribo*@domain.com).<br /> Note that if an address matches both the NoProcessing and the OnlyTheseProcessing lists, the NoProcessing rules take precedence.',undef,undef,'msg000810','msg000811'],
['poTestMode','Enable Process Only Addresses',0,\&checkbox,'','(.*)',undef,'<br /><hr /><div class="menuLevel1">Notes On No Processing</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/noprocessing.txt\',3);" />',,undef,undef,'msg000820','msg000821'],

[0,0,0,'heading','Whitelisting'],
['whiteListedIPs','Whitelisted IPs*',80,\&textinput,'file:files/ipwl.txt','(\S*)','ConfigMakeIPRe',
 'They contribute to the Whitelist and to Notspam. For example: 145.145.145.145|146.145.|146.145.0.0/16. It is recommended to use the CIDR notation.<br />
  To define IP\'s only for specific email addresses or domains (recipients) you must use the file:... option<br />
  An entry (line) may look as follows:<br />
  145.146.0.0/16=>*@local.domain|user@mydomain|user2@*.mydomain # comment<br /><br />
  It is possible to define a predefined group on any or both sides of the \'=>\' separator, like:<br />
  [ipgroup]=>[usergroup]|user@mydomain<br /><br />
  NOTICE: the following combination of two entries, will lead in to a user/domain based matching - the global entry will be ignored!<br />
  145.146.0.0/16 # comment<br />
  145.146.0.0/16=>*@local.domain|user@mydomain|user2@*.mydomain # comment<br />
  If multiple user/domain based entries are defined for the same IP, only the last one will be used!<br /><br />
  <span class="positive"> All fields marked by \'*\' accept  a filepath/filename : \'file:files/ipwl.txt\'.</span>',undef,'7','msg000830','msg000831'],
['whiteRe','Regular Expression to Identify Non-Spam*',80,\&textinput,'','(.*)','ConfigCompileRe','If an incoming email matches this Perl regular expression it will be considered whitelisted.<br />For example: Secret Ham Password|307\D{0,3}730\D{0,3}4[12]\d\d<br />For help writing regular expressions click <a href="http://www.perlmonks.org/index.pl?node=perlre" rel="external">here</a>.<br />IMPORTANT: The body is scanned in a later stage  AFTER all sender related checks are performed. So a white regular expression here might not prevent the message to be blocked by eg. invalid PTR. Set the sender related checks to score only if you want to make sure that the white regular expression will be seen. Some things you might include here are your office phone number or street address, spam rarely includes these details.  .',undef,undef,'msg000840','msg000841'],
['whiteListedDomains','Whitelisted Domains and Addresses*',80,\&textinput,'file:files/whitedomains.txt','(.*)','ConfigMakePrivatRe','Domains and addresses from which you want to receive all mail. Your ISP, domain registration, mail list servers, stock broker, or other key business partners might be good candidates. Be careful not to put widely used domains here like google.com or hotmail.com. Our recommended approach is to put whitelisted domains into whiteSenderBase. Note this matches the end of the address, so if you don\'t want to match subdomains then include the @. Note that example.com would also match spamexample.com but .example.com won\'t match example.com. Wildcards are supported. For example: sourceforge.net|group*@google.com|.example.com<br /><br />
  It is possible to make email addresses whitelisted only for a set of local domains and/or local users. Use wildcards (* and ?) to define domains.<br />
  Use the following syntax to do this:<br />
  *@anydomain=>*@any_local_domain - for domain to domain<br />
  *@*.anydomain=>*@any_local_domain - for any sub-domain to domain<br />
  user@anydomain=>*@*.any_local_domain - for user to any sub-domain<br /><br />
  It is possible to define more than one entry at the left and the right side of the definition (=&gt;), like:<br />
  *@anydomain|*@other_domain=>*@any_local_domain|*@other_local_domain - always separate multiple entries by pipes<br />
  It is also possible to use a GroupDefinition in any or both sides, like:<br />
  [sendergroup]=>[recipientgroup]<br />
  [sendergroup1]|[sendergroup2]|*@domain=>[recipientgroup1]|[recipientgroup2]|user@local_domain<br /><br />
  NOTICE - that the local email addresses and domains are not checked to be local once',undef,undef,'msg000850','msg000851'],
['wildcardUser','Wildcard User for White Domain ',20,\&textinput,'*','(.*)',undef,'If you add this user via email-interface(eg: *@domain.com), the whole domain will be whitelisted. For example: \'*\'',undef,undef,'msg000860','msg000861'],
['ValidateRWL','Enable Realtime Whitelist Validation',0,\&checkbox,'','(.*)','configUpdateRWL','RWL: Real-time white list. These are lists of IP addresses that have
 somehow been verified to be from a known good host. Senders that pass RWL validation will pass IP-based filters. This requires an installed <a href="http://search.cpan.org/search?query=Net::DNS" rel="external">Net::DNS</a> module in PERL. ',undef,undef,'msg000870','msg000871'],
['RWLwhitelisting','Whitelist all RWL Validated Addresses',0,\&checkbox,'','(.*)',undef,'If set, the message will also pass Bayesian Filter and URIBL.',undef,undef,'msg000880','msg000881'],
['RWLServiceProvider','RWL Service Providers*',80,\&textinput,'file:files/dnsrws.txt','(.*)','configUpdateRWLSP','Host Names of RWLs to use separated by "|".<br />
 Examples are:<br />
 <p>list.dnswl.org|query.bondedsender.org|cml.anti-spam.org.cn|iadb.isipp.com|hul.habeas.com </p>',undef,undef,'msg000890','msg000891'],
['RWLmaxreplies','Maximum Replies',5,\&textinput,4,'(\d*)','configUpdateRWLMR','A reply is affirmative or negative reply from a RWL. The RWL module will wait for this number of replies (negative or positive) from the RWLs listed under Service Provider for up to the Maximum Time below. This number should be equal to or less than the number of RWL Service Providers listed to allow for randomly unavailable RWLs. ',undef,undef,'msg000900','msg000901'],
['RWLminhits','Minimum Hits',5,\&textinput,1,'(\d*)','configUpdateRWLMH','A hit is an affirmative response from a RWL. The RWL module will check all of the RWLs listed under Service Provider, and flag the email with a RWL pass flag if equal to or more than this number of RWLs return a postive whitelisted response. This number should be less than or equal to Maximum Replies above and greater than 0',undef,undef,'msg000910','msg000911'],
['RWLmaxtime','Maximum Time',5,\&textinput,10,'(\d*)',undef,'This sets the maximum time to spend on each message performing RWL checks',undef,undef,'msg000920','msg000921'],
['noRWL','Don\'t Validate RWL for these IPs*',80,\&textinput,'','(\S*)','ConfigMakeIPRe','Enter IP addresses that you don\'t want to be RWL validated, separated by pipes (|). For example: 145.145.145.145|146.145.',undef,'7','msg000930','msg000931'],
['AddRWLHeader','Add X-Assp-Received-RWL Header',0,\&checkbox,1,'(.*)',undef,'Add X-Assp-Received-RWL header to header of all mails processed by RWL.',undef,undef,'msg000940','msg000941'],
['RWLCacheInterval','RWL Cache Refresh Interval',4,\&textinput,7,'(\d+\.?\d*|)','configUpdateRWLCR','IP\'s in cache will be removed after this interval in days. 0 will disable the cache. <input type="button" value=" Show RWL Cache" onclick="javascript:popFileEditor(\'pb/pbdb.rwl.db\',5);" />',undef,undef,'msg000950','msg000951'],
['WhitelistPrivacyLevel','PrivacyLevel of the Whitelist','0:global & private(legacy)|1:domain & private|2:private only',\&listbox,0,'(.*)',undef,
 'Sets the privacy level of the whitelistdb . If an (local) user adds an email address to the whitelist:<br /><br />
  (0) global & private - this email address is automaticaly whitelisted for all other local users<br />
  (1) domain & private - this email address is automaticaly whitelisted for all other local users in the same local domain<br />
  (2) private only - this email address is only whitelisted for this single local user<br /><br />
  (0-1) unless another user has removed this email address from his whitelist. Default is zero, which is the legacy setting.<br />
  NOTICE: independend from this setting, the whitelistdb is filled with all three entries (global,domain,private), to make it possible to change this value.',undef,undef,'msg009740','msg009741'],
['MaxWhitelistDays','Max Whitelist/Personal Black Days',5,\&textinput,'365','(\d+)',undef,'This is the number of days an address will be kept on the whitelist and personal blacklist without any email to/from this address. Set it to 0 to keep the entries infinity.',undef,undef,'msg000960','msg000961'],
['WhitelistOnly','Reject All But Whitelisted Mail',0,\&checkbox,'','(.*)',undef,'Check this if you don\'t want Bayesian filtering and want to reject all mail from anyone not whitelisted. To do this related to local user addresses, use InternalAndWhiteAddresses and switch this option off.',undef,undef,'msg000970','msg000971'],
['NoAutoWhite','Only Email-Interface Addition to Whitelist.',0,\&checkbox,'','(.*)',undef,'Check this box to  allow additions to the whitelist by email interface only.',undef,undef,'msg000980','msg000981'],
['NoAutoWhiteAdresses','No AutoWhite Addresses*',60,\&textinput,'','(.*)','ConfigMakeSLRe',
 'Mail solely to or from any of these addresses are excluded from automatic whitelist additions. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com).  Wildcards are supported (fribo*@domain.com).',undef,undef,'msg009970','msg009971'],
['NotGreedyWhitelist','Only the envelope-sender is added/compared to the whitelist','0:check all addresses|1:consider whitelisted if ANY match, only check the envelop|2:only consider whitelisted if ALL match',\&listbox,'0','(.*)',undef,'Normal operation includes addresses in the FROM, SENDER, REPLY-TO, ERRORS-TO, or LIST-* header fields.<br />
  This allows nearly all list email to be whitelisted. If set to \'envelope-sender only\', only this address is compared/added.<br />
  If set to \'check all addresses - one match for white - add all\', one match in any of this fields is enough to get white and all addresses will be added to whitelist.<br />
  If set to \'check all addresses - all matches for white - update all\', all defined addresses in all defined fields must be already whitelisted for a message to get a whitelisted state and all addresses will updated in whitelist.<br />
  If any address is found in redlist, no whitelist addition will be done and the message gets not white. Will not do anything if you add/remove whitelist entries via email-interface.',undef,undef,'msg000990','msg000991'],
['GreedyWhitelistAdditions','How add Greedy Senders to Whitelist','0:none|1:envelope only|2:all senders',\&listbox,1,'(.*)',undef,
  'Defines what sender addresses are added to the whitelist if a message is considered to be from a whitelisted sender. NotGreedyWhitelist is considered in determining if a message is from a whitelisted sender.',undef,undef,'msg008780','msg008781'],
['WhitelistLocalOnly','Only local or authenticated users contribute to the whitelist.',0,\&checkbox,'','(.*)',undef,'Normal operation allows all local, authenticated, or whitelisted users to contribute to the whitelist.<br />
  Check this box to not allow whitelisted users to add to the whitelist.',undef,undef,'msg001000','msg001001'],
['WhitelistLocalFromOnly','Only users with a local domain in mailfrom contribute to the whitelist.',0,\&checkbox,'1','(.*)',undef,'Check this box to prevent sender with non-local domains from contributing to the whitelist. (for example: redirected messages).',undef,undef,'msg001010','msg001011'],
['WhitelistAuth','Whitelist mails from authenticated users.',0,\&checkbox,'','(.*)',undef,'Mails from authenticated users will be processed as whitelisted.',undef,undef,'msg001020','msg001021'],
['UpdateWhitelist','Save Whitelist <sup>s</sup>',40,\&textinput,3600,$ScheduleGUIRe,'configChangeSched','Save a copy of the white list every this many seconds. Empty or Zero will prevent any saving and the cleanup of old records.<br />
  <hr /><div class="menuLevel1">Notes On Whitelist</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/whitelist.txt\',3);" />',undef,undef,'msg001030','msg001031'],

[0,0,0,'heading','Relaying <a href="http://apps.sourceforge.net/mediawiki/assp/index.php?title=Relaying" target=wiki><img height=12 width=12 src="' . $wikiinfo . '" alt="relaying not allowed" /></a>'],
['acceptAllMail','Accept All Mail*',80,\&textinput,'','(\S*)','ConfigMakeIPRe','Relaying is allowed for these IPs. They  contribute also to the whitelist. This can take either a directly entered list of IP\'s separated by pipes or a file \'file:files/acceptall.txt\'.<br />For example: 145.145.145.145|146.145.','Basic','7','msg001040','msg001041'],
['DoLocalSenderDomain','Do Local Domain Check for Local Sender',0,\&checkbox,'','(.*)',undef,
  'If activated, each local sender address must have a valid Local Domain.',undef,undef,'msg001050','msg001051'],
['DoLocalSenderAddress','Do Local Address Check for Local Sender',0,\&checkbox,'','(.*)',undef,
  'If activated, each local sender address must have a valid Local Address.',undef,undef,'msg001060','msg001061'],
['nolocalDomains','Skip Local Domain Check',0,\&checkbox,'','(.*)',undef,'Do not check relaying based on localDomains. Let the mailserver do it. <b>NOT RECOMMENDED</b>.',undef,undef,'msg001070','msg001071'],
['ldLDAP','Do LDAP lookup for local domains',0,\&checkbox,'','(.*)',undef,'Check local domains against an LDAP database.<br />Note: Checking this requires filling in LDAP DomainFilter ( ldLDAPFilter ) in the LDAP section.<br />This requires an installed <a href="http://search.cpan.org/~gbarr/perl-ldap-0.31/lib/Net/LDAP.pod" rel="external">NET::LDAP</a> module in Perl.',undef,undef,'msg001080','msg001081'],
['ispip','ISP/Secondary MX Servers*',80,\&textinput,'','(\S*)','ConfigMakeIPRe','Enter any addresses that are your ISP or backup MX servers, separated by pipes (|). <br />These addresses will (necessarily) bypass Griplist, IP Limiting, Delaying, Penalty Box, SPF, DNSBL &amp; SRS checks unless the IP can be determined by (ispHostnames) ISP/Secondary Hostnames. For example: 127.0.0.1|172.16..','Basic','7','msg001090','msg001091'],
['contentOnlyRe', 'Regular Expression to Identify Forwarded Messages*',80,\&textinput,'','(.*)','ConfigCompileRe',
 "Put anything here to identify messages which should bypass PB, Sender Validation, Griplist, IP Limiting, Delaying, SPF, DNSBL &amp; SRS checks. For example:  email addresses of people who are forwarding from other accounts to their mailbox on your server.",undef,undef,'msg001100','msg001101'],
['ispHostnames','Regular Expression to Identify ISP/Secondary Hostnames*',80,\&textinput, '','(.*)', 'ConfigCompileRe', 'Hostnames (regular expression) to lookup the IP that connected to the ISP/Secondary server.<br />If found, this address is used to perform IP-based checks on forwarded messages. <br />For example: mx1\.yourisp\.com or mx1\.yourisp\.net|mx2\.yoursecondary\.com . <i>This hostnames are found in the \'Received:\' header, like  \'Received: from ...123.123.123.123... by <b>mx1.yourisp.com</b>\'</i>. Leave this blank to disable the feature. ',undef,undef,'msg001110','msg001111'],
['send250OKISP','Send 250 OK To ISP/Secondary MX Servers',0,\&checkbox,'1','(.*)',undef,
 'Set this checkbox if you want ASSP to reply to IP\'s in ISPIP with \'250 OK\' instead of SMTP error code \'554 5.7.1\'.',undef,undef,'msg001120','msg001121'],
['ispgripvalue','ISP/Secondary MX Grip Value',5,\&textinput,'0.5','^(0\.?\d*|)$',undef,'It is recommended  to set it to 0.5 (Completely GReyIP) for ISP and Secondary MX servers. If left blank the Griplist X value is used (percentage of spam messages in relation to total). <br />Note: value has to be greater than 0 and less than 1, where 0 = never spam and 1 = always spam',undef,undef,'msg001130','msg001131'],

['BounceSenders','Bounce Senders*',80,\&textinput,'postmaster|mailer-daemon','(.*)','ConfigMakeRe','Envelope sender addresses treated as bounce origins. Null sender (&lt;&gt;) is always included.<br />
 Accepts specific addresses (postmaster@domain.com), usernames (mailer-daemon), or entire domains (@bounces.domain.com)<br />Separate entries with pipes: |. For example: postmaster|mailer-daemon',undef,undef,'msg001140','msg001141'],
['PopB4SMTPFile','Pop Before SMTP DB File',40,\&textinput,'','(.*)',undef,'Enter the DB database filename of your POP before SMTP implementation with records stored for dotted-quad IP addresses.<br />For example: /etc/mail/popip.db',undef,undef,'msg001150','msg001151'],
['PopB4SMTPMerak','Pop Before SMTP Merak Style',0,\&checkbox,'','(.*)',undef,'If set Merak 7.5.2 is supported.',undef,undef,'msg001160','msg001161'],
['relayHost','Relay Host',80,\&textinput,'',$GUIHostPort,undef,'Your isp\'s mail relayhost (smarthost). For example: mail.isp.com:25<br />If you run Exchange/Notes and you want assp to update the nonspam database and the whitelist, then enter your isp\'s smtp relay host here. Blank means no relayhost. Only required if clients don\'t deliver through SMTP. Separate multiple entries by "|".<br />
 Examples: your_ISP_Server:25, 149.1.1.1:25, 149.1.1.2:325|any_other_host:25 !','Basic',undef,'msg001170','msg001171'],
['relayAuthUser','User to Authenticate to Relay Host',80,\&passinput,'','(.*)',undef,'The username used for SMTP AUTH authentication to the relayhost  - for example, if your ISP need authentication on the SMTP port! Supported authentication methodes are PLAIN, LOGIN, CRAM-MD5 and DIGEST-MD5 . If the relayhost offers multiple methodes, the one with highest security option will be used. The Perl module <a href="http://search.cpan.org/search?query=Authen::SASL" rel="external">Authen::SASL</a> must be installed to use this feature! The usage of this feature will be skipped, if the sending MTA uses the AUTH command. Leave this blank, if you do not want use this feature.','Basic',undef,'msg009040','msg009041'],
['relayAuthPass','Password to Authenticate to Relay Host',80,\&passinput,'','(.*)',undef,'The password used for SMTP AUTH authentication to the relayhost ! Leave this blank, if you do not want use this feature.','Basic',undef,'msg009050','msg009051'],
['relayPort','Relay Port',80,\&textinput,'',$GUIHostPort,'ConfigChangeRelayPort','Tell your mail server to connect to this IP/port as its smarthost / relayhost. For example: 225<br /> Note that you\'ll want to keep the relayPort protected from external access by your firewall.<br />You can supply an interface:port to limit connections. Separate multiple entries by "|".<p><small><i>Examples:</i> 225, 127.0.0.1:225, 192.168.1.1:225|192.168.2.1:225 </small></p>!',undef,undef,'msg001180','msg001181'],
['allowRelayCon','Allow Relay Connection from these IP\'s*',80,\&textinput,'','(\S*)','ConfigMakeIPRe','Enter any addresses that are allowed to use the relayPort , separated by pipes (|). If empty, any ip address is allowed to connect to the relayPort. If this option is defined, keep in mind : Addresses defined in acceptAllMail are <b>NOT</b> automaticly included and have to be also defined here, if them should allow to use the relayPort. For example: 127.0.0.1|172.16..','Basic','7','msg008830','msg008831'],
['NoRelaying','No Relaying Error <a href="http://apps.sourceforge.net/mediawiki/assp/Relaying" target="ASSPHELP"><img src="' . $wikiinfo . '" alt="wiki" /></a>',80,\&textinput,'530 Relaying not allowed','([25]\d\d .*)',undef,'SMTP error message to deny relaying.',undef,undef,'msg001190','msg001191'],
['defaultLocalHost','Default Local Host',40,\&textinput,'assp.local','('.$EmailDomainRe.')?',undef,'If you want to be able to send mail to local users without a domain name then put the default local domain here.<br /> Blank disables this feature. For example: mydomain.com .',undef,undef,'msg001200','msg001201'],

['LocalFrequencyInt','Local Frequency Interval',40,\&textinput,'0','(\d*)',undef,'The time interval in seconds in which the number of envelope recipients per sending address has not to exceed a specific number ( LocalFrequencyNumRcpt ).<br />
  Use this in combination with LocalFrequencyNumRcpt to limit the number of recipients in a given interval, to prevent local abuse - for example from highjacked local accounts. A value of 0 (default) will disable this feature and clean the cache within five minutes. It is recommended to enable DoLocalSenderAddress and/or DoLocalSenderDomain, if you want to use this feature. To give users the chance to inform an admin about such blocked mails, local mails to EmailAdmins are never blocked because of that feature.<br />
  <input type="button" value="edit local Frequency Cache" onclick="javascript:popFileEditor(\'DB-localFrequencyCache\',\'1h\');" />',undef,undef,'msg008720','msg008721'],
['LocalFrequencyNumRcpt','Local Frequency Recipient Number',40,\&textinput,'0','(\d*)',undef,'The number of envelope recipients per sending address that has not to exceed in a specific time interval ( LocalFrequencyInt ).<br />
  Use this in combination with LocalFrequencyInt to limit the number of recipients in a given interval, to prevent local abuse - for example from highjacked local accounts. A value of 0 (default) will disable this feature and clean the cache within five minutes. It is recommended to enable DoLocalSenderAddress and/or DoLocalSenderDomain, if you want to use this feature. To give users the chance to inform an admin about such blocked mails, local mails to EmailAdmins are never blocked because of that feature. <br />
  <input type="button" value="edit local Frequency Cache" onclick="javascript:popFileEditor(\'DB-localFrequencyCache\',\'1h\');" />',undef,undef,'msg008730','msg008731'],
['LocalFrequencyOnly','Check local Frequency for this Users only*',60,\&textinput,'','(.*)','ConfigMakeSLRe',
 'A list of local addresses, for which the \'local frequency check\' should be done. Leave this field blank (default), to do the check for every address.<br />
  Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com).  Wildcards are supported (fribo*@domain.com).<br />
  For example: fribo*@thisdomain.com|jhanna|@sillyguys.org ',undef,undef,'msg008740','msg008741'],
['NoLocalFrequency','Check local Frequency NOT for this Users*',60,\&textinput,'','(.*)','ConfigMakeSLRe',
 'A list of local addresses, for which the \'local frequency check\' should not be done. Noprocessing messages will skip this check.<br />
  Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com).  Wildcards are supported (fribo*@domain.com).<br />
  For example: fribo*@thisdomain.com|jhanna|@sillyguys.org ',undef,undef,'msg008750','msg008751'],
['NoLocalFrequencyIP','Check local Frequency NOT for this IP\'s*',60,\&textinput,'','(.*)','ConfigMakeIPRe',
 'A list of local IP-addresses, for which the \'local frequency check\' should not be done.<br />
  For example: 145.145.145.145|145.146. ',undef,undef,'msg010110','msg010111'],

['genDKIM','Generate and Add DKIM <a href="http://en.wikipedia.org/wiki/DomainKeys_Identified_Mail" target=wiki><img height=12 width=12 src="' . $wikiinfo . '" alt="Network Flow" /></a> signatures to relayed messages',0,\&checkbox,'','(.*)',undef,'If selected, ASSP will add DKIM signatures to relayed messages if it finds a valid DKIM configuration in DKIMgenConfig for the sending domain. This will also be done for noprocessing mails. This requires an installed <a href="http://search.cpan.org/search?query=Mail::DKIM" rel="external">Mail::DKIM</a> module in PERL.',undef,undef,'msg001210','msg001211'],
['DKIMgenConfig','The File with the DKIM configurations*',40,\&textinput,'file:dkim/dkimconfig.txt','(file:\S*)','configUpdateDKIMConf','The file that contains the DKIM configuration. A description how to configure DKIM could be found in the default file dkim/dkimconfig.txt.<br />
<hr /><div class="menuLevel1">Notes On Relaying</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/relaying.txt\',3);" />',undef,undef,'msg001220','msg001221'],

[0,0,0,'heading','Recipients/Local Domains'],
['removeForeignBCC','remove Foreign BCC',0,\&checkbox,'','(.*)',undef,'Remove foreign BCC: header lines from the mail header. The remove is done before the DoHeaderAddrCheck is done!',undef,undef,'msg009780','msg009781'],

['DoHeaderAddrCheck','Check TO,CC and BCC headers',0,\&checkbox,'','(.*)',undef,'If enabled TO: , CC: and BCC: header lines are checked the following way:<br /><br />
 1. a possible recipient replacement is done<br />
 2. local email address validation is done -  if OK, the next address or headerline is processed<br />
 3. spamtrapaddresses will be detected - scored with stValencePB - <b>mail is blocked</b> (noPenaltyMakeTraps is honored)<br />
 4. a local but not valid TO/CC/BCC: address will be detected - scored with irValencePB<br />
 5. a RelayAttempt will be detected if a BCC address is not local - scored with rlValencePB - <b>mail is blocked</b><br />
 The check 3 and 4 honors whitelisting , noprocessing and noBlockingIPs<br />
 Enable this check only, if assp is configured to validate local domains and email addresses!<br />
 NOTICE: that removeForeignBCC take place before this check is done - step 5 will be never reached if removeForeignBCC is enabled!',undef,undef,'msg010010','msg010011'],

['sendAllPostmaster','Catchall Address for Messages to Postmaster',20,\&textinput,'','(.*)',undef,'ASSP will deliver messages addressed to all postmasters of your local domains to this address. For example: postmaster@mydomain.com',undef,undef,'msg001250','msg001251'],
['sendAllPostmasterNP','Skip Spam Checks for Postmaster Catchall',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg001260','msg001261'],
['sendAllAbuse','Catchall Address for Messages to Abuse',20,\&textinput,'','(.*)',undef,'ASSP will deliver messages to all abuse addresses of your local domains to this address. For example: abuse@mydomain.com',undef,undef,'msg001270','msg001271'],
['sendAllAbuseNP','Skip Spam Checks for Abuse Catchall',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg001280','msg001281'],
['DoRFC822','Validate addresses to conform with RFC 822','0:disabled|1:recipients|2:sender|3:both',\&listbox,1,'(.*)',undef,'If activated, the envelope sender and/or each envelope recipient is checked to conform with the email format defined in RFC 822. For an invalid sender address \'nofromValencePB\' is used for scoring - for invalid recipient addresses, each is scored with \'irValencePB\'.<br />
  For the sender address in addition a top level domain existence and DNS name server registration check is done.',undef,undef,'msg001290','msg001291'],
['LocalAddresses_Flat','Lookup valid Local Addresses from here*',80,\&textinput,'','(.*)','ConfigMakeSLRe','These email addresses are the list of your local addresses. You can list specific addresses (user@mydomain.com), addresses at any local domain (user), or entire domains (@mydomain.com).  Wildcards are supported (fribo*@domain.com). (|).<br />For example: fribo@thisdomain.com|jhanna|@sillyguys.org or place them in a plain ASCII file one address per line:file:files/localuser.txt. You can use entries like @mydomain.com=>vrfyhost:port to VRFY users on your MTA, for more information read localDomains. You can use an entry like ALL=>vrfyhost:port to define a VRFY host for all domain entries ( better use Groups ).','Basic',undef,'msg001300','msg001301'],
['LocalAddresses_Flat_Domains','Use Addresses without \'@\' as Domains',0,\&checkbox,0,'([01]?)',undef,'Will handle entries without \'@\' as full domains',undef,undef,'msg001310','msg001311'],
['RejectTheseLocalAddresses','Reject These Local Addresses*',80,\&textinput,'','(.*)','ConfigMakeSLRe',
'If ANY recipient is on reject list, message will not be delivered. Used for disabled legitimate accounts, where a user may have left the company. This stops wildcard mailboxes from getting these messages.',undef,undef,'msg001320','msg001321'],
['localDomains','Local Domains*',80,\&textinput,'putYourDomains.com|here.org','(.*)','ConfigMakeLocalDomainsRe','Check local domains against these addresses. Add a fake domain like \'assp-nospam.org\' for the email interface if you run MS Exchange. When mailing to eg. \'spam@assp-nospam.org\' MS Exchange forwards it outbound to ASSP who handles the different options. As in every field marked by \'*\' separate addresses with | or use file \'file:files/localdomains.txt\'. Wildcards are supported.<br /> For example: *mydomain.com|*.mydomain.com|here.org <br />
 Use the syntax: *mydomain.com=>smtp.mydomain.com|other.com=>mx.other.com:port|other2.com=>mx.other.com:port,mx2.other.com:port to verify the recipient addresses with the SMTP-VRFY (if VRFY is not supported \'MAIL FROM:\' and \'RCPT TO:\' will be used) command on other SMTP servers. The entry behind => must be the hostname:port or ip-address:port of the MTA which is used to verify \'RCPT TO\' addresses with a VRFY command! If :port is not defined, port :25 will be used. You can use an entry like ALL=>vrfyhost:port to define a VRFY host for all local domain entries that don\'t have a MTA defined ( better use Groups ). Separate multiple VRFY hosts for failover by comma ",". You have to enable the SMTP \'VRFY\' command on your MTA - the \'EXPN\' command should be enabled! This requires an installed <a href="http://search.cpan.org/search?query=Net::SMTP" rel="external">Net::SMTP</a> module in PERL. <br />
 If you have configured LDAP and enabled DoLDAP and ASSP finds a VRFY entry for a domain, LDAP search will be done first and if this fails, the VRFY will be used. So VRFY could be used for LDAP backup/fallback/failover!<br />
 It is recommended to configure \'ldaplistdb\' in the \'File Paths and Database\' section when using this verify extension - so ASSP will store all verified recipients addresses there to minimize the querys on MTA\'s. There is no need to configure LDAP, but both VRFY and LDAP are using ldaplistdb. Please go to the \'LDAP setup\' section to configure MaxLDAPlistDays and LDAPcrossCheckInterval or start a crosscheck now with forceLDAPcrossCheck. This three parameters belong also to VRFY.','Basic',undef,'msg001330','msg001331'],
['DoVRFY','Verify Recipients with SMTP-VRFY',0,\&checkbox,1,'(.*)',undef,  'If activated and the format \'Domain=>MTA\' is encountered in
 localDomains recipient addresses will be verified with SMTP-VRFY (if VRFY is not supported \'MAIL FROM:\' and \'RCPT TO:\' will be used).
 If you know that VRFY is not supported with a MTA, you may put the MTA into VRFYforceRCPTTO. Don\'t forget to configure LDAPFail (belongs also to VRFY) to your needs!', undef,undef,'msg008850','msg008851'],
['VRFYQueryTimeOut','SMTP VRFY-Query Timeout',5,\&textinput,'5','(\d\d?)',undef,
 'The number of seconds ASSP will wait for an answer of the MTA that is queryed with the VRFY command to verify a recipient address.',undef,undef,'msg001340','msg001341'],
['VRFYforceRCPTTO','Force the usage of RCPT TO*',80,\&textinput,'','(.*)','ConfigMakeRe','Define MTA\'s here for which you want ASSP to force the usage of MAIL FROM:,RCPT TO: instead of the VRFY command. The definition of each MTA has to be the same as defined in LocalAddresses_Flat and/or localDomains (after the \'=>\') for example: smtp.mydomain.com|mx.other.com:port|10.1.1.1|10.1.1.2:125 .',undef,undef,'msg001350','msg001351'],
['DisableVRFY','Disable VRFY and EXPN for External Clients',0,\&checkbox,'','(.*)',undef,'If you have enabled VRFY and/or EXPN on your MTA to make assp able to verify addresses and you do not want external clients to use VRFY and EXPN - select this option.',undef,undef,'msg008600','msg008601'],
['DoLDAP','Do LDAP lookup for valid local addresses',0,\&checkbox,'','(.*)',undef,'Check local addresses against an LDAP database before accepting the message.<br />Note: Checking this requires filling in the other LDAP parameters below.<br />This requires an installed <a href="http://search.cpan.org/~gbarr/perl-ldap-0.31/lib/Net/LDAP.pod" rel="external">Net::LDAP</a> module in PERL.',undef,undef,'msg001360','msg001361'],
['LocalAddressesNP','Do Not  Validate Local Addresses if in NoProcessing List',0,\&checkbox,'','(.*)',undef,'If a recipient is found in NoProcessing, the user validation is skipped. ',undef,undef,'msg001370','msg001371'],
['CatchAll','Catchall per Domain*',40,\&textinput,'','(.*)','configUpdateCA','ASSP will send to this addresses/domain if no valid user is found in LocalAddresses_Flat/LDAP. <br />For example: catchall@domain1.com|catchall@domain2.com',undef,undef,'msg001390','msg001391'],
['CatchAllAll','Catchall for All Domains',40,\&textinput,'','(.*)',undef,'ASSP will send to this address if no valid user is found  in LocalAddresses_Flat/LDAP and no match is found in Catchall per Domain. <br />For example: catchall@domain.com',undef,undef,'msg001400','msg001401'],
['CatchallallISP2NULL','Move ISP Connection with wrong Recipient Address to NULL',0,\&checkbox,'','(.*)',undef,
  'If set, ASSP will move all ISP connections with wrong recipient addresses to a NULL-connection. The ISP will receive "250 OK" until the mail has passed, but the mail will not be sent to your MTA. This is done after CatchAll but before CatchAllAll is checked.',undef,undef,'msg001410','msg001411'],
['NullAddresses','NULL Connection Addresses*',80,\&textinput,'','(.*)','ConfigMakeSLRe','ASSP will dump a message silently when encountering such an address in "MAIL FROM:" or "RCPT TO:". Accepts specific addresses (null@example.com), user parts (nobody) or entire domains (@example.com).',undef,undef,'msg001420','msg001421'],
['InternalAddresses','Accept Mail from Local Domains only*',80,\&textinput,'','(.*)','ConfigMakeSLRe','These local addresses accept mail only from local domains. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com). Wildcards are supported (fribo*@domain.com).',undef,undef,'msg001430','msg001431'],
['InternalAndWhiteAddresses','Accept Mail from Local Domains and Whitelisted Senders only*',80,\&textinput,'','(.*)','ConfigMakeSLRe','These local addresses accept mail only from local domains and whitelisted external serders. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com). Wildcards are supported (fribo*@domain.com).',undef,undef,'msg009890','msg009891'],
['SepChar','Separation Character for Subaddressing',2,\&textinput,'+','([^*]?)',undef,'RFC 3598 describes subaddressing with a Separation Character. A star (\'*\') is not allowed as Separation Character. Everything between Separation Character and @ is ignored (including Separation Character). For Example = \'+\' will allow user+subaddress@domain.com.',undef,undef,'msg001440','msg001441'],
['EnableBangPath','Support Bang Path',0,\&checkbox,'','(.*)',undef,
 'If set, ASSP will support addresses like domainx!user and will convert them to user@domainx .',undef,undef,'msg001450','msg001451'],
['MaxVRFYErrors','Maximum recipient verification Errors',5,\&textinput,'0','(\d+)',undef,
  'The maximum number of failed \'RCPT TO\' or \'VRFY\' commands encountered before the connection is dropped. You can leave this field at 0, if you are using \'DoLDAP\', \'LocalAddresses_Flat\'! If configured, ASSP will drop the connection, if the count of \'550 unknown user\' errors, received from your \'smtpDestination\'(MTA), reached this value!',undef,undef,'msg001460','msg001461'],
['DoMaxDupRcpt','Block Max Duplicate Recipients','0:disabled|1:block|2:monitor|3:score',\&listbox,3,'(\d*)',undef,
  'Block remote servers that uses the same recipient address more times, than the number defined in MaxDupRcpt in the RCPT TO: command. Scoring is done with mdrValencePB . This check is skipped for outgoing, noprocessing, whitelisted and spamlovers mails. If a message has to be delayed, this check will score before the delay if set to block or score - and score and/or block on the next server request.',undef,undef,'msg008950','msg008951'],
['MaxDupRcpt','Maximum Allowed Duplicate Recipient Addresses',5,\&textinput,'0','(\d+)',undef,
  'The maximum number of duplicate recipient addresses that are allowed in the sequence of the RCPT TO: commands!<br />
  The number per mail is calculated by \'number of RCPT TO: commands  -  number of unique recipient addresses\'.<br />
  For example: if one address is used three times or two addresses are used each two times, will result in the same count - 2. Or if both is the case in one mail, the count will be 4.',undef,undef,'msg008960','msg008961'],
['ReplaceRecpt','Enable recipient replacement*',80,\&textinput,'','(.*)','configChangeRcptRepl','recommented if used: file:files/rcptreplrules.txt - default empty ! This enables recipient replacement. If you do not use file:, separate the rules with |. The replacement will be done before any ASSP check. Use this option carefully - for example: if you have enabled DKIM check, the DKIM check will fail, if the recipient of the mail was modified. For a more detailed description of the rules and options, read the file: files/rcptreplrules.txt!',undef,undef,'msg001470','msg001471'],
['NoValidRecipient','No-Valid-Local-User Reply',80,\&textinput,'550 5.1.1 User unknown: EMAILADDRESS','([5|4|2]\d\d .*)',undef,'SMTP reply for invalid Users. Default: \'550 5.1.1 User unknown: EMAILADDRESS\' <br /> The literal EMAILADDRESS (case sensitive) is replaced by the fully qualified SMTP recipient (e.g., thisuser@yourcompany.com).<br /><hr /><div class="menuLevel1">Notes On Local Addresses</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/localaddresses.txt\',3);" />',undef,undef,'msg001480','msg001481'],

[0,0,0,'heading','Validate Helo'],
['useHeloBlacklist','Use the Helo Blacklist','0:disabled|1:block|2:monitor|3:score',\&listbox,3,'(.*)',undef,
  'Use the list of blacklisted-helo hosts built by rebuildspamdb.',undef,undef,'msg001490','msg001491'],
['useHeloGoodlist','Use the Helo Goodlist','0:disabled|1:bonus|2:whitelisted|3:bonus &amp; whitelisted',\&listbox,1,'(.*)',undef,
  'Use the list of known good helo hosts built by rebuildspamdb.<br />
  bonus - the message/IP get a bonus of the weigthed negative value of hlValencePB <br />
  whitelisted - the message is processed as whitelisted<br /><br />
  The good helos and weights are stored together with the helo blacklist.',undef,undef,'msg009920','msg009921'],
['DoIPinHelo','Do Score Suspicious Helos','0:disabled|2:monitor|3:score',\&listbox,3,'(\d*)',undef,
  'Score servers with IP number in Helo and check for mismatch with sending IP.',undef,undef,'msg001500','msg001501'],
['ForceFakedLocalHelo','Enforce Check of Forged Helos Before Delaying',0,\&checkbox,1,'(.*)',undef,
  'If set, ASSP will  check Forged Helos before DELAYING. Collecting, Testmode, CopySpam, Spam-Lover is ignored.',undef,undef,'msg001510','msg001511'],
['DoFakedLocalHelo','Block Forged Helos','0:disabled|1:block|2:monitor|3:score',\&listbox,1,'(\d*)',undef,
  'Block remote servers that claim to come from our Local Domains/Local IP\'s/Local Host.',undef,undef,'msg001520','msg001521'],
['DoFakedUseLocalDomain','Use Local Domain List for Blocking Forged Helos',0,\&checkbox,1,'(.*)',undef,
  'If set, DoFakedLocalHelo will  use <b>localDomains</b>.',undef,undef,'msg001530','msg001531'],
['DoFakedWL','Do Not Block Whitelisted',0,\&checkbox,'','(.*)',undef,
  'Disable "Block Forged Helo\'s" for whitelisted addresses (not recommended).',undef,undef,'msg001540','msg001541'],
['DoFakedNP','Do Not Block Noprocessing',0,\&checkbox,'','(.*)',undef,
  'Disable "Block Forged Helo\'s" for addresses identified as noprocessing (not recommended).',undef,undef,'msg001550','msg001551'],
['myServerRe','Local Domains,IP\'s and Hostnames*',80,\&textinput,'','(.*)','ConfigMakeRe',
  'Local Domains, IP\'s and Hostnames are often use to fake (forge) the Helo. Include all IP addresses and hostnames for your server here, localhost is already included. Include Local Domains of your choice here, if you deactivated the automatic use of the local domain list.  For example: 11.22.33.44|mx.YourDomains.com|here.org','Basic',undef,'msg001560','msg001561'],
['noHelo','Don\'t Validate HELO for these IP\'s*',60,\&textinput,'','(\S*)','ConfigMakeIPRe',
  'Enter IP addresses that you don\'t want to be HELO validated.<br />
   For example: 127.0.0.1|192.168.',undef,'7','msg001570','msg001571'],
['heloBlacklistIgnore','Don\'t block these HELO\'s*',80,\&textinput,'','(.*)','ConfigMakeRe',
  'HELO / EHLO greetings on this list will be excluded from the HELO checks. For example: host123.isp.com|host456.*.com',undef,undef,'msg001580','msg001581'],
['ForceValidateHelo','Enforce Early Helo Checks',0,\&checkbox,1,'(.*)',undef,
  'If set, ASSP will  Validate/Invalidate the format of HELO before DELAYING. Collecting, Testmode, CopySpam, Spam-Lover is ignored.',undef,undef,'msg001590','msg001591'],
['DoValidFormatHelo','Validate Format of HELO','0:disabled|1:block|2:monitor|3:score',\&listbox,1,'(\d*)',undef,
  'If activated, the HELO is checked against the expression below. If the Regular Expression matches, the HELO is validated as being ok. ',undef,undef,'msg001600','msg001601'],
['validFormatHeloRe','Regular Expression to Validate Format of HELO*',80,\&textinput,'file:files/validhelo.txt','(.*)','ConfigCompileRe',
  'Validate Format HELO will check incoming HELOs according to rfc1123. <br />For example: ^(?:\w[\w\.\-]*\.\w{2,6})$ or ^(?:(?:[a-z\d][a-z\d\-]*)?[a-z\d]\.)+[a-z]{2,6}$',undef,undef,'msg001610','msg001611'],
['DoInvalidFormatHelo','Invalidate Format of HELO','0:disabled|1:block|2:monitor|3:score',\&listbox,1,'(\d*)',undef,
  'If activated, the HELO is checked against the expression below. If the Regular Expression matches, the HELO is invalidated as being not ok.',undef,undef,'msg001620','msg001621'],
['invalidFormatHeloRe','Regular Expression to Invalidate Format of HELO**',80,\&textinput,'file:files/invalidhelo.txt','(.*)','ConfigCompileRe','Invalidate Format HELO will check incoming HELOs for this. <br />
 For example:  ^\d+\.\d+\.\d+\.\d+$|^[^\.]+\.?$,',undef,undef,'msg001630','msg001631'],
['DoHeloWL','Do Valid/Invalid/Black Helo for Whitelisted',0,\&checkbox,'1','(.*)',undef,
  'Do valid/invalid Helo for whitelisted addresses.',undef,undef,'msg001640','msg001641'],
['DoHeloNP','Do Valid/Invalid/Black Helo for Noprocessing',0,\&checkbox,'1','(.*)',undef,
  'Do valid/invalid Helo for noprocessing addresses.<br /><hr />
  <div class="menuLevel1">Notes On Validate Helo</div>
  <input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/validatehelo.txt\',3);" />',undef,undef,'msg001650','msg001651'],

[0,0,0,'heading','Validate Sender'],

['DoBlackDomain','Do Blacklisted Addresses and Domains','0:disabled|1:block|2:monitor|3:score', \&listbox,1,'(\d*)',undef, '',undef,undef,'msg001660','msg001661'],
['DoBlackDomainWL','Do Blacklisting Addresses and Domains for White',0,\&checkbox,'1','(.*)',undef,
  'Do blacklisting addresses & domains in messages which are marked whitelisted by whiteRe, whiteListedDomains, whiteListedIPs or whitelistdb.',undef,undef,'msg001670','msg001671'],
['DoBlackDomainNP','Do Blacklisting Addresses and Domains for NoProcessing',0,\&checkbox,'1','(.*)',undef,
  'Do blacklisting addresses & domains in messages which are marked noprocessing by npRe, noProcessingDomains, noProcessingIPs or noProcessing.',undef,undef,'msg001680','msg001681'],
['blackListedDomains','Blacklisted Addresses and Domains*',60,\&textinput,'file:files/blackdomains.txt','(.*)','ConfigMakePrivatRe','Addresses  &amp; Domains from which you always want to reject mail, they only send you spam. Note this matches the end of the address, so if you don\'t want to match subdomains then include the @. Note that buy.com would also match spambuy.com but .buy.com won\'t match buy.com. abc@def.com will match abc@def.com but won\'t match bbc@def.com. Wildcards are supported. For example: cc|info|biz|seller@bayer.com|sell*@basf.com<br /><br />
  It is possible to make email addresses blacklisted only for a set of local domains and/or local users. Use wildcards (* and ?) to define domains.<br />
  Use the following syntax to do this:<br />
  *@anydomain=>*@any_local_domain - for domain to domain<br />
  *@*.anydomain=>*@any_local_domain - for any sub-domain to domain<br />
  user@anydomain=>*@*.any_local_domain - for user to any sub-domain<br /><br />
  It is possible to define more than one entry at the left and the right side of the definition (=&gt;), like:<br />
  *@anydomain|*@other_domain=>*@any_local_domain|*@other_local_domain - always separate multiple entries by pipes<br />
  It is also possible to use a GroupDefinition in any or both sides, like:<br />
  [sendergroup]=>[recipientgroup]<br />
  [sendergroup1]|[sendergroup2]|*@domain=>[recipientgroup1]|[recipientgroup2]|user@local_domain<br /><br />
  NOTICE - that the local email addresses and domains are not checked to be local once',undef,undef,'msg001690','msg001691'],

['DoMsgID','Check Message IDs','0:disabled|2:monitor|3:score',\&listbox,3,'(\d*)',undef,
  'Score messages with missing/suspicious/invalid Message-ID. Scoring is done by midmValencePB / midsValencePB / midiValencePB .',undef,undef,'msg001700','msg001701'],
['noMsgID','Don\'t Validate Message-IDs for these IPs*',80,\&textinput,'127.0.0.|192.168.|10.','(\S*)','ConfigMakeIPRe','Enter IP addresses that you don\'t want to be Message-ID validated, separated by pipes (|). For example: 127.0.0.1|192.168.',undef,'7','msg001710','msg001711'],
['validMsgIDRe','Regular Expression to Validate Format of Message-ID*',80,\&textinput,'^.+\@.+\..+$','(.*)','ConfigCompileRe',
  'Check Message IDs will check incoming messages for valid Message-IDs. <br />For example: ^.+\@.+\..+$  ',undef,undef,'msg001720','msg001721'],
['invalidMsgIDRe','Regular Expression to Invalidate Format of Message-ID**',80,\&textinput,'','(.*)','ConfigCompileRe',
  'Check Message IDs will check incoming messages for invalid Message-IDs.',undef,undef,'msg001730','msg001731'],

['DoNoValidLocalSender','Validate Remote Sender with Local Domain Address','0:disabled|1:block|2:monitor|3:score|4:testmode',\&listbox,1,'(\d*)',undef,
  'If activated, each remote sender  with a local domain is checked against the <i>Local Addresses File</i> and/or LDAP. ',undef,undef,'msg001740','msg001741'],
['ForceNoValidLocalSender','Early "Remote Sender with Local Domain Address" Check',0,\&checkbox,'1','(.*)',undef,
  'If set, ASSP will check Remote Sender with Local Domain Address before Delaying a message.<br /> Collecting, Testmode, CopySpam, and Spam-Lover settings are ignored.',undef,undef,'msg001750','msg001751'],
['DoNoSpoofing','Block Local Address from External Sender ','0:disabled|1:block|2:monitor|3:score',\&listbox,3,'(.*)',undef,
  'If activated, each external sender address built with a domain in localDomains is regarded a spoofed address. An external sender is a sender from an IP not in acceptAllMail and not authenticated. ',undef,undef,'msg001760','msg001761'],
['onlySpoofingCheckIP','Do Spoofing Check ONLY for these IP\'s*',80,\&textinput,'','(\S*)','ConfigMakeIPRe',
 'Enter IP\'s that you want to be checked for spoofing. If this is set, ONLY these IP\'s will be checked. For example:145.145.145.145|145.146.',undef,'7','msg009900','msg009901'],
['onlySpoofingCheckDomain','Do Spoofing Check ONLY for these Addresses/Domains*',80,\&textinput,'','(.*)','ConfigMakeSLRe',
 'Accepts specific addresses (user@example.com), user parts (user) or entire domains (@example.com). Wildcards are supported (fribo*@example.com). If set, ONLY these addresses/domains will be checked for spoofing.',undef,undef,'msg009910','msg009911'],
['noSpoofingCheckIP','Don\'t do Spoofing Check for these IP\'s*',80,\&textinput,'','(\S*)','ConfigMakeIPRe',
 'Enter IP\'s that you don\'t want to be checked for spoofing. For example:145.145.145.145|145.146.',undef,'7','msg001770','msg001771'],
['noSpoofingCheckDomain','Don\'t do Spoofing Check for these Addresses/Domains*',80,\&textinput,'','(.*)','ConfigMakeSLRe',
 'Accepts specific addresses (user@example.com), user parts (user) or entire domains (@example.com). Wildcards are supported (fribo*@example.com).',undef,undef,'msg001780','msg001781'],
['DoNoSpoofing4From','Do NoSpoofing for from:',0,\&checkbox,'','(.*)',undef,
  'Do the NoSpoofing check also for header \'from:\' addresses.',undef,undef,'msg009850','msg009851'],
['DoReversed','Reversed Lookup','0:disabled|1:block|2:monitor|3:score',\&listbox,3,'(.*)',undef,
  'If activated, each sender IP is checked for a PTR record. This requires an installed <a href="http://search.cpan.org/search?query=Net::DNS" rel="external">Net::DNS</a> module in PERL.',undef,undef,'msg001800','msg001801'],
['DoReversedWL','Do Reversed Lookup for Whitelisted',0,\&checkbox,'1','(.*)',undef,
  'Do reversed lookup for whitelisted addresses.',undef,undef,'msg001810','msg001811'],
['DoReversedNP','Do Reversed Lookup for Noprocessing',0,\&checkbox,'1','(.*)',undef,
  'Do reversed lookup for noprocessing addresses.',undef,undef,'msg001820','msg001821'],
['DoInvalidPTR','Reversed Lookup FQDN','0:disabled|1:block|2:monitor|3:score',\&listbox,3,'(.*)',undef,
  'If activated - and Reversed Lookup is activated -, the PTR-FQDN record is checked against the Regex. This requires an installed <a href="http://search.cpan.org/search?query=Net::DNS" rel="external">Net::DNS</a> module in PERL.',undef,undef,'msg001830','msg001831'],
['invalidPTRRe','Regular Expression to Invalidate Format of PTR**',80,\&textinput,'file:files/invalidptr.txt','(.*)','ConfigCompileRe',
  'Validate Format PTR will check PTR records for this. <br />
  For example:  ^\d+\.\d+\.\d+\.\d+$|^[^\.]+\.?$ or file:files/invalidptr.txt',undef,undef,'msg001840','msg001841'],
['validPTRRe','Regular Expression to Validate Format of PTR*',80,\&textinput,'file:files/validptr.txt','(.*)','ConfigCompileRe',
  'Validate Format PTR will check PTR records for this. <br />
  For example:  static or file:files/validptr.txt',undef,undef,'msg001850','msg001851'],
['PTRCacheInterval','Reversed Lookup Cache Refresh Interval',4,\&textinput,7,'(\d+\.?\d*|)','configUpdatePTRCR',
  'IP\'s in cache will be removed after this interval in days. 0 will disable the cache. <input type="button" value=" Show PTR Cache" onclick="javascript:popFileEditor(\'pb/pbdb.ptr.db\',5);" />',undef,undef,'msg001860','msg001861'],
['DoDomainCheck','Validate MX or A Record','0:disabled|1:block|2:monitor|3:score',\&listbox,3,'(.*)',undef,
  'If activated, the sender address and each address found in the following header lines (ReturnReceipt:, Return-Receipt-To:, Disposition-Notification-To:, Return-Path:, Reply-To:, Sender:, Errors-To:, List-...:) is checked for a valid MX or A record. Scoring is done for non existing MX record and non existing A record - a messages failes (block), if both records are not found.',undef,undef,'msg001870','msg001871'],
['MXACacheInterval','Validate Domain MX Cache Refresh Interval',4,\&textinput,7,'(\d+\.?\d*|)','configUpdateMXACR',
  'IP\'s in cache will be removed after this interval in days. 0 will disable the cache.<input type="button" value=" Show MX Cache" onclick="javascript:popFileEditor(\'pb/pbdb.mxa.db\',5);" />',undef,undef,'msg001880','msg001881'],
['DoNoFrom','Check For Existing From Header ','0:disabled|2:monitor|3:score',\&listbox,3,'(.*)',undef,
  'Scoring is set with fromValencePB.',undef,undef,'msg001890','msg001891'],
['DoNoFromWL','Do DoNoFrom for Whitelisted',0,\&checkbox,'1','(.*)',undef,
  'Check for existing From Header for whitelisted addresses.',undef,undef,'msg001900','msg001901'],
['DoNoFromNP','Do DoNoFrom for NoProcessing',0,\&checkbox,'1','(.*)',undef,
  'Check for existing From Header for noprocessing addresses.',undef,undef,'msg001910','msg001911'],
['removeDispositionNotification','Remove Disposition Notification Headers',0,\&checkbox,'','(.*)',undef,
  'If set, all headers : "ReturnReceipt: , Return-Receipt-To: and Disposition-Notification-To:" will be removed from not whitelisted and not noprocessing incoming mails. Select this to prevent unwanted whitelisting of spammers that request a Disposition Notification. An other way to prevent autowhitelisting because of an autoresponds is to use redRe .',undef,undef,'msg008970','msg008971'],
['DoDKIM','Validate DomainKeys Identified Mail <a href="http://en.wikipedia.org/wiki/DomainKeys" target=wiki><img height=12 width=12 src="' . $wikiinfo . '" alt="DKIM" /></a>','0:disabled|1:block|2:monitor|3:score',\&listbox,3,'(.*)',undef,
  'If activated, DomainKeys Identified Mails are checked for the right signature and contents. All DKIM parameters belongs also to the old DomainKey specification. This requires an installed <a href="http://search.cpan.org/search?query=Mail::DKIM::Verifier" rel="external">Mail::DKIM::Verifier</a> module in PERL. In addition DKIM is used to process Domain-based Message Authentication, Reporting &amp; Conformance - described in <a href="http://www.dmarc.org/" rel="external">DMARC</a> (DMARC requires also ValidateSPF to be enabled).',undef,undef,'msg001920','msg001921'],
['DoStrictDKIM','Validate DomainKeys Identified Mail strictly',0,\&checkbox,0,'(.*)',undef,
  'The DKIM test will fail, if the mail was modified by a mailhop. In this case the from address, the from domain, the to domain, the DKIM-signature by itself and the prefix of the digest-verification are valid, only the lower digest value differs! This may happen, if a mailhop has modified any other headerfield like X-...! If unchecked a mail will only pass, if the author policy and sender policy are accept or neutral!',undef,undef,'msg001930','msg001931'],
['noDKIMAddresses','Do not any DKIM Check for this Addresses *',80,\&textinput,'','(.*)','ConfigMakeSLRe',
  'Mail from any of these addresses will not be tagged and checked for DKIM. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com).',undef,undef,'msg001940','msg001941'],
['noDKIMIP','Exclude these IP\'s from any DKIM Check*',80,\&textinput,'','(\S*)','ConfigMakeIPRe','Enter IP\'s that you want to exclude from DKIM check, separated by pipes (|).',undef,undef,'msg001950','msg001951'],
['DKIMCacheInterval','Validate DKIM-Pre-Check-Cache Refresh Interval',4,\&textinput,7,'(\d+\.?\d*|)','configUpdateDKIMCR',
  'domains\'s in cache will be removed after this interval in days. 0 will disable the cache.<br />
  If activated a DKIM-pre-check will be done. If ASSP finds a DKIM-Signature in the mail header, it checks the DNS records of the sending domain for valid DKIM configurations and writes a record in to the DKIM-pre-check-cache, if it finds such configuration.<br />
  If ASSP does not find a DKIM-Signature in the mail header, it also checks the DNS records of the sending domain for valid DKIM configurations. If it find such a configuration, the mail is considered spam, because it should have a DKIM-Signature.<br />
  The next mail from a domain that is found in this cache, must have a DKIM-Signature to pass the DKIM-pre-check. How ever, some DNS records are wrong or inaccurate and will cause ASSP to block mails because of this - register such domains and/or IP\'s in noDKIMAddresses and/or noDKIMIP .<br />
  <input type="button" value=" Show DKIM Cache" onclick="javascript:popFileEditor(\'pb/pbdb.dkim.db\',5);" />',undef,undef,'msg001960','msg001961'],
['AddDKIMHeader','Add X-Assp-DKIM Header',0,\&checkbox,1,'(.*)',undef,
  'Add X-Assp-DKIM header.',undef,undef,'msg001970','msg001971'],
['SenderInvalidError','Sender Validation Error',80,\&textinput,'554 5.7.1 REASON .','^([245]\d\d .*)$',undef,
  'SMTP error message to reject invalid senders. The literal REASON is replaced by (missing MX, missing PTR, invalid Helo, invalid user) depending on the check.<br /><hr />
  <div class="menuLevel1">Notes On Validate Sender</div>
  <input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/validatesender.txt\',3);" />',undef,undef,'msg001980','msg001981'],

[0,0,0,'heading','IP Blocking '],
['DelayIP','Simple IP Greylisting',10,\&textinput,'','(\d*)',undef,
  'Enable simple delaying for IP\'s in black penaltybox with totalscore above this value. An value of zero or empty disables this feature.',undef,undef,'msg009320','msg009321'],
['DelayIPTime','Simple IP Greylisting Embargo Time',5,\&textinput,5,'(\d*)',undef,
  'Enter the number of minutes for which delivery, related with IP address of the sending host, is refused with a temporary failure. Default is 5 minutes.',undef,undef,'msg009330','msg009331'],
['DoDenySMTP','Do Deny Connections from these IP\'s','0:disabled|1:block|2:monitor',\&listbox,1,'(\d*)',undef,
 'If activated, the IP is checked against (denySMTPConnectionsFrom) Deny Connections from these IP\'s.<br />',undef,undef,'msg001990','msg001991'],
['denySMTPConnectionsFrom','Deny Connections from these IP\'s*',40,\&textinput,'','(\S*)','ConfigMakeIPRe','Manually maintained list of IP\'s which should be blocked. IP\'s in noPB, noDelay, acceptAllMail, ispip, whiteListedIPs, noProcessingIPs, whitebox will pass. For example: file:files/blockip.txt.<br />
  To define IP\'s only for specific email addresses or domains (recipients) you must use the file:... option<br />
  An entry (line) may look as follows:<br />
  145.146.0.0/16=>*@local.domain|user@mydomain|user2@*.mydomain # comment<br /><br />
  It is possible to define a predefined group on any or both sides of the \'=>\' separator, like:<br />
  [ipgroup]=>[usergroup]|user@mydomain<br /><br />
  NOTICE: the following combination of two entries, will lead in to a user/domain based matching - the global entry will be ignored!<br />
  145.146.0.0/16 # comment<br />
  145.146.0.0/16=>*@local.domain|user@mydomain|user2@*.mydomain # comment<br />
  If multiple user/domain based entries are defined for the same IP, only the last one will be used!',undef,'7','msg002000','msg002001'],
['noBlockingIPs','Do not block Connections from these IP\'s*',40,\&textinput,'','(\S*)','ConfigMakeIPRe','Manually maintained list of IP\'s which should not be blocked.  For example: 145.145.145.145|145.146.<br />
  To define IP\'s only for specific email addresses or domains (recipients) you must use the file:... option<br />
  An entry (line) may look as follows:<br />
  145.146.0.0/16=>*@local.domain|user@mydomain|user2@*.mydomain # comment<br /><br />
  It is possible to define a predefined group on any or both sides of the \'=>\' separator, like:<br />
  [ipgroup]=>[usergroup]|user@mydomain<br /><br />
  NOTICE: the following combination of two entries, will lead in to a user/domain based matching - the global entry will be ignored!<br />
  145.146.0.0/16 # comment<br />
  145.146.0.0/16=>*@local.domain|user@mydomain|user2@*.mydomain # comment<br />
  If multiple user/domain based entries are defined for the same IP, only the last one will be used!',undef,'7','msg002010','msg002011'],
['DoDenySMTPstrict','Do Deny Connections from these IP\'s Strictly','0:disabled|1:block|2:monitor',\&listbox,1,'(\d*)',undef,
 'If activated, the IP is checked against (\'denySMTPConnectionsFromAlways\') Deny Connections from these IP\'s Strictly.',undef,undef,'msg002020','msg002021'],
['denySMTPConnectionsFromAlways','Deny Connections from these IP\'s Strictly*',40,\&textinput,'file:files/denyalways.txt','(\S*)','ConfigMakeIPRe',
 'Manually maintained list of IP\'s which should <b>strictly</b> be blocked after address verification and before body and header is downloaded. Contrary to <i>denySMTPConnectionsFrom</i> IP\'s in noDelay, acceptAllMail, ispip, whiteListedIPs, noProcessingIPs, whitebox will <b>not</b> pass if listed here.',undef,'7','msg002030','msg002031'],
['DoDropList','Do also Deny Connections from these IP\'s','0:disabled|1:add to deny|2:add to denyAlways|3:add to both',\&listbox,0,'(\d*)',undef,
 'If activated, the IP is checked against the Droplist in addition to \'denySMTPConnectionsFromAlways\' and/or \'denySMTPConnectionsFrom\'. The droplist is downloaded if a new one is available and contains the Spamhaus DROP List. See "http://www.spamhaus.org/drop/drop.lasso".',undef,undef,'msg002040','msg002041'],
['denySMTPstrictEarly','Do Strictly Deny Connections Early',0,\&checkbox,'','(.*)',undef,
  'IP\'s in <b>denySMTPConnectionsFromAlways</b> will be denied right away.',undef,undef,'msg002050','msg002051'],
['enhancedOriginIPDetect','Do an Enhanced Origin IP Address Detection in the Mail Header',0,\&checkbox,'1','(.*)',undef,
  'If selected, ASSP will analyze the mail headers "RECEIVED:" lines for IP\'s on the mail routing way to detect spam bots, that uses open relay or highjacked mail servers for mail delivery.<br />
  Local and private IP\'s, and IP\'s listed in ispip, acceptAllMail, whiteListedIPs, noProcessingIPs, noDelay and noPB will be ingnored.<br />
  The detected IP\'s will be additionaly checked for IP-Blocking, DNSBL and IP-Frequency - the same way like the connected IP. These IP\'s are also additionaly used for the maximum mail size calculation in MaxRealSizeAdr and MaxRealSizeExternalAdr.',undef,undef,'msg009590','msg009591'],
['DoFrequencyIP','Check Frequency - Maximum Connections Per IP','0:disabled|1:block|2:monitor|3:score|4:testmode',\&listbox,0,'(\d*)',undef,
 '',undef,undef,'msg002060','msg002061'],
['maxSMTPipConnects','Maximum Frequency of Connections Per IP ',3,\&textinput,'10','(\d?\d?\d?)',undef,
 'The maximum number of SMTP connections an IP Address can make during the <a href="./#maxSMTPipDuration">IP Address Frequency Duration</a>. If a server makes more than this many connections to ASSP within the (maxSMTPipDuration) IP Address Frequency Duration it will be banned from future connections until the (maxSMTPipExpiration) IP Address Frequency Expiration is reached. This can be used to prevent server overloading and DoS attacks. 10 connections are typically enough. If left blank or 0, there is no limit imposed by ASSP. IP\'s in noPB, noDelay, acceptAllMail, ispip, whiteListedIPs, noProcessingIPs, PB-whitebox are excluded from SMTP session limiting, whitelisted and noprocessing addresses are honored',undef,undef,'msg002070','msg002071'],
['maxSMTPipDuration','Maximum Frequency of Connections Per IP Duration',5,\&textinput,'90','(\d?\d?\d?\d?)',undef,
 'The window (in seconds) during which the (maxSMTPipConnects) IP Frequency (see above for more details) will be scrutinized for each IP. The default is 90 seconds.',undef,undef,'msg002080','msg002081'],
['maxSMTPipExpiration','Expiration of Maximum Frequency',5,\&textinput,'7200','(\d?\d?\d?\d?)',undef,
 'The number of seconds that must pass before an IP address blocked by the (maxSMTPipConnects) IP Address Frequency setting is allowed to connect again. The default is 7200 (seconds) .',undef,undef,'msg002090','msg002091'],
['DoDomainIP','Check Number of IP\'s Per Domain','0:disabled|1:block|2:monitor|3:score|4:testmode',\&listbox,0,'(\d*)',undef,
 'This check is skipped if the IP and domain have passed the SPF-check. If ValidateSPF is enabled and an IP/Domain reaches the maxSMTPdomainIP limit, the MaintThread starts a background SPF check to prevent blocking good mails in future.',undef,undef,'msg002100','msg002101'],
['maxSMTPdomainIP','Limit Number of IP\'s  Per Domain',3,\&textinput,'10','(\d?\d?\d?)',undef,
 'The number of IP(subnet) switches a domain may have during the (maxSMTPdomainIPExpiration) Limit Different IP\'s Per Domain Expiration. If a domain switches more often than this it will be banned from future connections until the Expiration is reached. This can be used to prevent server overloading and DoS attacks. 10 connections are typically enough. If left blank or 0, there is no limit imposed by ASSP. IP\'s in noPB, noDelay, acceptAllMail, ispip, whiteListedIPs, noProcessingIPs, PB-whitebox are excluded, whitelisted and noprocessing addresses are honored.',undef,undef,'msg002110','msg002111'],
['maxSMTPdomainIPExpiration','Expiration of Limit Number',5,\&textinput,'7200','(\d?\d?\d?\d?\d?)',undef,
  'The number of seconds that must pass before a domain blocked by the (maxSMTPdomainIP) Limit Subnet IP\'s Per Domain setting (see above for more details) is allowed to connect again. The default is 7200 (seconds).',undef,undef,'msg002120','msg002121'],
['maxSMTPdomainIPWL','Do Not Limit Different IP\'s For These Domains*',60,\&textinput,'gmx.de|t-online.de|yahoo.com|hotmail.com|gmail.com','(.*)','ConfigMakeRe',
  'This prevents specific domains from limiting. For example: yahoo.com|hotmail.*.com|gmail.com<br /><hr />
  <div class="menuLevel1">Notes On IP Blocking</div>
  <input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/ipblocking.txt\',3);" />',undef,undef,'msg002130','msg002131'],

[0,0,0,'heading','SenderBase <a href="http://www.senderbase.org/" target=wiki><img height=12 width=12 src="' . $wikiinfo . '" alt="SenderBase" /></a>'],
['sbTestMode','SenderBase Testmode',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg002140','msg002141'],
['DoOrgWhiting','Do Organization Whiting','0:disabled|1:whiting|2:monitor|3:score',\&listbox,1,'(.*)',undef,
   'If activated, each sending IP address has its assigned organization looked up. Scoring is set with sworgValencePB.',undef,undef,'msg002150','msg002151'],
['whiteSenderBase','Whitelisted Organizations and Domains in SenderBase**',80,\&textinput,'file:files/whiteorg.txt','(.*)','ConfigCompileRe','If the organization or domain  in the <a href="http://www.senderbase.org/" rel="external">SenderBase</a> IP description matches this Perl regular expression the message will be considered non-spam. For example file:files/whiteorg.txt',undef,undef,'msg002160','msg002161'],
['DoOrgBlocking','Do Organization Blocking','0:disabled|1:block|2:monitor|3:score',\&listbox,2,'(.*)',undef,
   'If activated, each sending IP address has its assigned organization looked up. Scoring is set with sborgValencePB, Testmode is set with sbTestMode.',undef,undef,'msg002170','msg002171'],
['blackSenderBase','Blacklisted Organizations and Domains in SenderBase**',80,\&textinput,'','(.*)','ConfigCompileRe','If the organization or domain in the <a href="http://www.senderbase.org/" rel="external">SenderBase</a> IP description matches this Perl regular expression the message will be considered spam.',undef,undef,'msg002180','msg002181'],
['DoCountryBlocking','Do Country Blocking','0:disabled|1:block|2:monitor|3:score',\&listbox,2,'(.*)',undef,
   'If activated, each sending IP address has its assigned country looked up.',undef,undef,'msg002190','msg002191'],

['CountryCodeBlockedRe','Blocked Country Codes**',80,\&textinput,'CN|KR|RU|JP|TR|TH|PL|LT|CL|RO|UA|GR|HU|SA|IN|GB|IE|PT|MD|PE|CZ|TW|BR|CL','(.*)','ConfigCompileRe',
  'Messages from IP\'s based in these countries will be blocked. For example: CN|KR|RU|JP|TR|TH|PL|LT|CL|RO|UA|GR|HU|SA|IN|IE|PT|MD|PE|CZ|TW|BR|CL. "all" will block all foreign countrycodes which are not in \'Suspicious Country Codes\' or \'Ignore Country Codes\'. See: <a href="http://www.iso.org/iso/country_codes/iso_3166_code_lists/english_country_names_and_code_elements.htm" rel="external">English country names and code elements</a>. ',undef,undef,'msg002200','msg002201'],
['DoSenderBase','Do Country Code Scoring','0:disabled|2:monitor|3:score',\&listbox,3,'(.*)',undef,
   'If activated, each sending IP address has its assigned country looked up.',undef,undef,'msg002210','msg002211'],

['NoCountryCodeRe','Ignore Countries*',80,\&textinput,'US|CA|DE','(.*)','ConfigCompileRe',
  'Messages from IP\'s based in these countries will be ignored. For example: US|CA|DE',undef,undef,'msg002220','msg002221'],
['CountryCodeRe','Suspicious Country Codes**',80,\&textinput,'CN|KR|RU|JP|TR|TH|PL|LT|CL|RO|UA|GR|HU|SA|IN|IE|PT|MD|PE|CZ|TW|BR|CL|ID|PH','(.*)','ConfigCompileRe',
  'Messages from IP\'s based in these countries will increase the MessageScore. For example: CN|KR|RU|JP|TR|TH|PL|LT|CL|RO|UA|GR|HU|SA|IN|IE|PT|MD|PE|CZ|TW|BR|CL|ID|PH',undef,undef,'msg002230','msg002231'],
['MyCountryCodeRe','Home Country Codes**',80,\&textinput,'','(.*)','ConfigCompileRe',
  'Put here your own country code(s) (for example: US). Messages from IP\'s based in these countries will decrease, messages from other countries will increase the MessageScore.',undef,undef,'msg002240','msg002241'],
['ScoreForeignCountries','Score Foreign Countries',0,\&checkbox,'1','(.*)',undef,
  'Messages from foreign countries will increase the total messageScore using sbfccValencePB.',undef,undef,'msg002250','msg002251'],
['SBCacheExp','Country Cache Refresh Interval',4,\&textinput,3,'(\d+\.?\d*|)','configUpdateSBCR',
  'IP\'s in cache will be removed after this interval in days. 0 will disable the cache.  <input type="button" value=" show cache" onclick="javascript:popFileEditor(\'pb/pbdb.sb.db\',5);" />',undef,undef,'msg002260','msg002261'],

[0,0,0,'heading','PenaltyBox <a href="http://apps.sourceforge.net/mediawiki/assp/index.php?title=Penalty_Box" target=wiki><img height=12 width=12 src="' . $wikiinfo . '" alt="PenaltyBox" /></a>'],
['DoPenalty','Do PenaltyBox - IP History<a href="http://apps.sourceforge.net/mediawiki/assp/Penalty_Box" target="ASSPHELP"><img src="' . $wikiinfo . '" alt="wiki" /></a>','0:disabled|1:block|2:monitor/messageScoring',\&listbox,2,'(\d*)',undef,'The PenaltyBox is a  temporary position of low esteem awarded for a perceived misdeed. It scores IP\'s based on some events ( baValencePB see  penalty scores )and writes them into  a BlackBox. If the score per specified time interval surpasses the threshold the message is rejected (and the IP is marked for blocking). They continue to get scored  up to the Extreme Threshold.<br />
 These top performers can get a special treatment PenaltyExtreme when DoPenaltyExtreme is enabled. The WhiteBox stores IP\'s which should not be put into the BlackBox. The WhiteBox is always enabled. If an address is in the whitelist or whitedomain, the IP goes into the WhiteBox. The WhiteBox is one of the sources  Delaying/Greylisting uses to determine when delaying should not be done. <br />Entries in <i>Don\'t do penalties for these IP\'s</i> or <i>ISP/Secondary MX Servers</i> will prevent from penalties. Select \'monitor/messageScoring\' to fill WhiteBox and BlackBox. \'monitor/messageScoring\' is also the right choice if you do not want to block IP\'s but rather score a message in \'Message Scoring Mode\'. ',undef,undef,'msg002270','msg002271'],
['DoPenaltyMessage','Message Scoring Mode ','0:disabled|1:block|2:monitor|4:tagging',\&listbox,1,'(\d*)',undef,'If this feature is selected, the total score for all checks during a message is used to determine if the email is Spam. If the combined score is greater than the <b>Low MessageLimit</b> (PenaltyMessageLow) and less than or equal the <b>High MessageLimit</b> (PenaltyMessageLimit) the message will not be blocked but tagged. If the combined score is greater than the <b>High MessageLimit</b> (PenaltyMessageLimit), the message will be blocked.',undef,undef,'msg002280','msg002281'],
['MsgScoreOnEnd','Message Scoring on End',0,\&checkbox,'','(.*)',undef,'ASSP will wait using the \'DoPenaltyMessage\' action, until all configured possible checks are finished. Use this, to force calculating a complete message score over all values, including all bonus values.',undef,undef,'msg002290','msg002291'],
['PenaltyMessageLow','Low MessageLimit',3,\&textinput,40,'(\d*)',undef,'MessageMode will not block messages whose score exceeds this threshold during the message but will tag them.  For example: 40',undef,undef,'msg002300','msg002301'],

['PenaltyMessageLimit','High MessageLimit',3,\&textinput,50,'(\d*)',undef,'MessageMode will block messages whose score exceeds this threshold during the message.  For example: 50',undef,undef,'msg002310','msg002311'],
['AddScoringHeader','Add IP/Message Scoring Header',0,\&checkbox,1,'(.*)',undef,'Adds a line to the email header "X-Assp-XXX-Score: ", where XXX may be IP, Message or both.',undef,undef,'msg002320','msg002321'],

['pbdb','PenaltyBox Database',40,\&textinput,'pb/pbdb','(\S*)','configChangeDB','The directory/file with the penaltybox database files. For removal of entries from BlackBox use noPB .
 For removal of entries from WhiteBox use noPBwhite. For whitelisting IP\'s use whiteListedIPs or noProcessingIPs . For blacklisting use denySMTPConnectionsFrom and denySMTPConnectionsFromAlways .<br />Write only "DB:" to use a database table instead of a local file. <br />
 <input type="button" value=" Show BlackBox" onclick="javascript:popFileEditor(\'pb/pbdb.black.db\',4);" /><input type="button" value="Show White Box" onclick="javascript:popFileEditor(\'pb/pbdb.white.db\',4);" />',undef,undef,'msg002330','msg002331'],
['noPB','Don\'t do Profiling for these IP\'s*',80,\&textinput,'','(\S*)','ConfigMakeIPRe',
 'Enter IP\'s that you don\'t want to be penalized. These IP\'s will also be automatically removed from PB-BlackBox. For example: 127.0.0.1|172.16.',undef,'7','msg002340','msg002341'],
['noPBwhite','Don\'t do WhiteBox for these IP\'s*',80,\&textinput,'','(\S*)','ConfigMakeIPRe',
 'Enter IP\'s that you want to be penalized. These IP\'s will also be automatically removed from PB-WhiteBox.',undef,'7','msg002350','msg002351'],
['WhiteExpiration','Expiration Time for WhiteBox Entries',4,\&textinput,30,'(\d?\d?\d?\d?)',undef,
  "The WhiteBox is always activated. The WhiteBox is similar to the  Whitelist  - but it is not a whitelist: content-related checks like Bayesian, URIBL, Bomb  will be done, IP-related checks will be skipped. WhiteBox entries will expire after this specified number of days. For example: 30",undef,undef,'msg002360','msg002361'],
['DoDamping','Do Damping on Messagescore [0...99]',4,\&textinput,'0','(\d{1,2})',undef,'If DoPenalty and DoPenaltyMessage are set not to disabled and DoDamping is not set to 0, ASSP will slowdown the spammers traffic speed proportional to the current message score - because slowing down their speed will reduce spam everywhere.<br />
  The delay in seconds per receive/read cycle is calculated by the division [messagescore / DoDamping] . A recommended value is 5 default is 0. In this case the delay for a message score of 50 would be 10 seconds.<br />
  Do not use this option, if you have a highly frequented system, because the spammers connections will stay possibly a long time on your system, and you system could possibly reach the sessions limit ( maxSMTPSessions ).<br />
  Damping is never done for: noprocessing, whitelisted, nodelay, ISP, redlisted, noPB, outgoing/releayed and contentonly addresses, IP\'s, messages.<br />
  Damping may not be done for forced checks, relay attemps, messages reaching maxerrors, spamtrapaddresses and if any block condition is found - because ASSP will no more read from those connections and closes such connections immediately - but ASSP will try to keep the connection open for the calculated time, before it closes the connection.<br />
  Using this option or using a too low value (long delay) could possibly prevent ASSP from receiving spam messages, for example for spamlovers or sendAllSpam . Some Servers could give up sending data, because of too long delays.',undef,undef,'msg002370','msg002371'],
['maxDampingTime','Max time Used for Damping',4,\&textinput,30,'(\d?\d?\d?)',undef,
  "The maximum time in second, that is used for one damping cycle if DoDamping is not set to 0, even if the calculated value caused by DoDamping is higher. For example: 30",undef,undef,'msg002380','msg002381'],
['spamtrapaddresses','PenaltyBox Trap Addresses *',80,\&textinput,'put|your@penaltytrap.com|addresses|@here.org','(.*)','ConfigMakeSLRe',
  'Mail to any of these addresses will be blocked and the scoring value is added. Whitelist and noPenaltyMakeTraps will be ignored. Nothing will be stored in the Spam Collection, if these addresses are not checked for validity. TO: and CC: addresses will be also checked - BCC: addresses only, if \'removeForeignBCC\' is not set. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com).',undef,undef,'msg002390','msg002391'],
['PenaltyTrapPolite','PenaltyTrap Reply',80,\&textinput,'550 5.1.1 User unknown: EMAILADDRESS','^([542]\d\d .+)',undef,'SMTP reply for invalid Users. Default: \'550 5.1.1 User unknown: EMAILADDRESS\' <br /> The literal EMAILADDRESS (case sensitive) is replaced by the fully qualified SMTP recipient (e.g., thisuser@example.com).',undef,undef,'msg002400','msg002401'],
['DoPenaltyMakeTraps','Do Heavy Used Invalid Addresses as PenaltyBox Trap Addresses','0:disabled|1:make traps and block them|2:make traps, only collect them|3:do not make them but block',\&listbox,2,'(.*)',undef,
  'If set to \'make traps, only collect them\', the frequency of Invalid Addresses is stored, no other action taken. If set to \'do not make them but block\' or \'make traps and block them\', addresses in heavy use will act like spamtrapaddresses (PenaltyBox Trap Addresses). If UseTrapToCollect is also set they will work like spamaddresses and collect the mails.',undef,undef,'msg002410','msg002411'],
['PenaltyMakeTraps','Invalid Addresses Limit',3,\&textinput,'10','(\d*)',undef,
  'Minimum number of times an address must appear before it will be used as Trap. For example 10.',undef,undef,'msg002420','msg002421'],

['noPenaltyMakeTraps','Exceptionlist for Traps*',60,\&textinput,'','(.*)','ConfigMakeSLRe',
 'Addresses which should not be used for traps. This list is also opponent to spamtrapaddresses . Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com).  Wildcards are supported (fribo*@domain.com).',undef,undef,'msg002430','msg002431'],
['PBTrapInterval','Invalid Addresses Refresh Interval',4,\&textinput,3,'(\d+\.?\d*|)',undef,
  'Addresses will be removed after this interval in days. For example 3. <input type="button" value=" Show Invalid Addresses" onclick="javascript:popFileEditor(\'pb/pbdb.trap.db\',5);" />',undef,undef,'msg002440','msg002441'],
['PenaltyUseNetblocks','Use IP Netblocks',0,\&checkbox,'1','(.*)',undef,
  'Perform the IP address checks of the sending host based on the /24 subnet  rather than on the specific IP.',undef,undef,'msg002450','msg002451'],
['PenaltyError','Penalty Reply',80,\&textinput,'','^([245]\d\d .*|)$',undef,
  'If set SMTP reply for Penalty Deny. eg: \'554 5.7.1 Error, send your mail to postmaster@LOCALDOMAIN to ensure delivery\'. The literal LOCALDOMAIN will be replaced by the recipient domain. For example:554 5.7.1 Mail appears to be unsolicited -- send error reports to postmaster@LOCALDOMAIN.',undef,undef,'msg002460','msg002461'],
['PenaltyDuration','Penalty Interval',4,\&textinput,60,'(\d?\d?\d?\d?)','updatePenaltyDuration',
  "IP\'s will be kept in the BlackBox if their score exceeds the Penalty Limit during this interval (minutes).",undef,undef,'msg002470','msg002471'],
['PenaltyLimit','Penalty Limit',4,\&textinput,50,'(\d*)',undef,
  'PB will block IP\'s whose score exceeds this threshold during the Penalty Interval. <br />Successful ASSP checks will increase the internal score per IP. For example: 50',undef,undef,'msg002480','msg002481'],
['PenaltyExpiration','Expiration Time',4,\&textinput,360,'(\d?\d?\d?\d?)','updatePenaltyExpiration',
  "Penalties will expire after this number of minutes. If set to Zero the Penalty BlackBox will be deleted and started from scratch.",undef,undef,'msg002490','msg002491'],
['CleanPBInterval','Clean Up PB Databases <sup>s</sup>',40,\&textinput,3,$ScheduleGUIRe,'configChangeSched',
  'Delete outdated entries from blackbox and whitebox databases every this many hours.<br />
  Defaults to 3 hours.',undef,undef,'msg002500','msg002501'],
['DoPenaltyExtreme','PenaltyBox Extreme IP Profiling','0:disabled|1:block|2:monitor',\&listbox,0,'(\d*)',undef,'If set PBextreme will block IP\'s whose score meet or exceed Extreme Scoring Threshold. DoPenaltyExtreme blocks after the header is done, based on the IP\'s score from previous and current SMTP session',undef,undef,'msg002510','msg002511'],
['DoPenaltyExtremeSMTP','Enforce Early PenaltyBox Extreme IP Profiling','0:disabled|1:block|2:monitor',\&listbox,0,'(.*)',undef,
  'If set PBextreme will block IP\'s whose score meet or exceed Extreme Scoring Threshold before DELAYING, based on the IP\'s score from previous SMTP sessions. This can be set independently from DoPenaltyExtreme above. Whitelist, Collecting, Testmode, CopySpam, Spam-Lover is ignored.',undef,undef,'msg002520','msg002521'],

['noExtremePB','Don\'t do Extreme Profiling for these IP\'s*',80,\&textinput,'','(\S*)','ConfigMakeIPRe',
 'Enter IP\'s that you don\'t want to be extreme penalized. IP\'s in noPB are already included. For example: 127.0.0.1|172.16.',undef,'7','msg009280','msg009281'],
['noExtremePBAddresses','Don\'t do Extreme Profiling for Mails from any of these Addresses*',60,\&textinput,'','(.*)','ConfigMakeSLRe',
 'Mails from any of these addresses will not be extreme profiled if DoPenaltyExtremeSMTP is not set. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com).  Wildcards are supported (fribo*@domain.com).',undef,undef,'msg009290','msg009291'],
['PenaltyExtreme','Extreme Scoring Threshold',4,\&textinput,150,'(\d*)',undef,
  'PBextreme will use this to determine candidates for special treatment. For example: 150.',undef,undef,'msg002530','msg002531'],
['ExtremeWL','Penalize Whitelisted',0,\&checkbox,'','(.*)',undef,
  'Enable extreme penalties for whitelisted addresses.',undef,undef,'msg002540','msg002541'],
['ExtremeNP','Penalize NonProcessing',0,\&checkbox,'','(.*)',undef,
  'Enable extreme penalties for addresses on the noProcessing list.',undef,undef,'msg002550','msg002551'],
['ExtremeExpiration','Expiration Time for Extreme Penalties',4,\&textinput,7,'(\d?\d?\d?\d?)',undef,,
  "Extreme penalties will expire after this number of days. For example: 7",undef,undef,'msg002560','msg002561'],
['DoExtremeExport','Do Export Penalty BlackBox Extreme',0,\&checkbox,'','(.*)',undef,  '',undef,undef,'msg002570','msg002571'],
['DoExtremeExportAppend','Append Export File',0,\&checkbox,'','(.*)',undef,'Do not overwrite the export file but append to it.',undef,undef,'msg002580','msg002581'],
['exportInterval','Export BlackBox Extreme File Interval <sup>s</sup>',40,\&textinput,6,$ScheduleGUIRe,'configChangeSched',
  ' Exported Penalty Black Box Extreme File every this hours.<br />
  Defaults to 6 hours.',undef,undef,'msg002590','msg002591'],
['exportExtremeBlack','Exported BlackBox Extreme File ',40,\&textinput,'file:files/exportedextreme.txt','(\S*)',undef, 'IP\'s in Penalty BlackBox which surpassed the extreme level will be regularly stored into this file. May be used for setting the firewall or similar applications.'  ,undef,undef,'msg002600','msg002601'],
['DoNotPenalizeRed','Do Not Score IP\'s in Redlisted Messages',0,\&checkbox,'','(.*)',undef,
  'IP\'s matching Red Regex or Redlist will not collect scoring values from PenaltyBox.',undef,undef,'msg002610','msg002611'],
['DoNotPenalizeNull','Do Not Score IP\'s From Bounce/Null-Senders',0,\&checkbox,'','(.*)',undef,
  'IP\'s matching BounceSenders will not be IP-penalized.<hr>',undef,undef,'msg002620','msg002621'],

['autValencePB','Bad SMTP Authentication, default=60 +',10,\&textinput,60,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring<br />
 <hr>This option and all other *ValencePB options with an "+" at the end of the description, accepts a second comma or pipe separated value like: "20,10" .<br />
  In this case the first value is used for message scoring and the second value is used for IP scoring.<br />
  If only the first value is defined, this value is used for both scoring mechanism.<br />
  If a *ValencePB option is related to any feature which allowes the usage of weighted penalties, the message scoring value is used to calculate the weighted penalty and the result is used for message and IP scoring.','Basic',undef,'msg009300','msg009301'],
['baValencePB','Bad Attachment, default=20 +',10,\&textinput,20,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002630','msg002631'],
['backsctrValencePB','Backscatter detection, default=10 +',10,\&textinput,10,$ValencePBRE,'ConfigChangeValencePB', 'Message scoring',undef,undef,'msg002640','msg002641'],
['baysValencePB','Bayesian, default=49 +',10,\&textinput,49,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002650','msg002651'],
['bayslocalValencePB','Bayesian for Local Messages, default=55 +',10,\&textinput,55,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg009550','msg009551'],
['HMMValencePB','Hidden-Makov-Model, default=49 +',10,\&textinput,49,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg009640','msg009641'],
['HMMlocalValencePB','Hidden-Makov-Model for Local Messages, default=55 +',10,\&textinput,55,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg009650','msg009651'],
['blValencePB','Blacklisted Domain, default=20 +',10,\&textinput,20,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002660','msg002661'],
['bombSuspiciousValencePB','Bomb Suspicious - scoring only, default=10 +',10,\&textinput,10,$ValencePBRE,'ConfigChangeValencePB', 'Message scoring',undef,undef,'msg002670','msg002671'],
['bombValencePB','Bomb Expression, default=20 +',10,\&textinput,20,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002680','msg002681'],
['blackValencePB','Bomb Black Expression, default=20 +',10,\&textinput,20,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002690','msg002691'],
['dkimValencePB','Domain Key Verification failed, default=15 +',10,\&textinput,15,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002700','msg002701'],
['dkimOkValencePB','Domain Key Verification OK, default=0',3,\&textinput,0,'(-{0,1}\d*)','ConfigChangeValencePB', '<span class="positive">Message Scoring Bonus</span>',undef,undef,'msg002710','msg002711'],
['erValencePB','Empty Recipients, default=5 +',10,\&textinput,5,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002720','msg002721'],
['etValencePB','Early Talker Scoring, default=25 +',10,\&textinput,25,$ValencePBRE,'ConfigChangeValencePB', "Message/IP scoring for clients who talk before server's greeting is sent. An value of zero will disable this check - otherwise assp scores the IP and droppes the connection.",undef,undef,'msg002730','msg002731'],
['fhValencePB','Forged HELO, default=150 +',10,\&textinput,150,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002740','msg002741'],
['fiphValencePB','Suspicious HELO: IP in HELO, default=39 +',10,\&textinput,39,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002750','msg002751'],
['fiphmValencePB','Suspicious HELO: IP in HELO mismatch, default=60 +',10,\&textinput,60,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002760','msg002761'],
['flValencePB','Invalid Local Sender, default=20 +',10,\&textinput,20,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002770','msg002771'],
['hlValencePB','Blacklisted/Good HELO, default=20 +',10,\&textinput,20,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002780','msg002781'],
['iaValencePB','Internal Only Address, default=25 +',10,\&textinput,25,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002790','msg002791'],
['idValencePB','Domain Changing IP Frequency, default=150 +',10,\&textinput,150,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002800','msg002801'],
['ifValencePB','IP Frequency, default=150 +',10,\&textinput,150,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002810','msg002811'],
['idleValencePB','Timeout Score',3,\&textinput,0,'(\d+)','ConfigChangeValencePB', 'For IP scoring with smtpIdleTimeout.',undef,undef,'msg008870','msg008871'],
['iplValencePB','IP Parallel Sessions, default=5 +',10,\&textinput,5,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002820','msg002821'],
['ihValencePB','Invalid HELO, default=10 +',10,\&textinput,10,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002830','msg002831'],
['irValencePB','Invalid Recipient, default=10 +',10,\&textinput,10,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg008940','msg008941'],
['isValencePB','Subject Frequency, default=150 +',10,\&textinput,150,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg010030','msg010031'],
['mdrValencePB','Duplicate Recipient, default=10 +',10,\&textinput,10,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002840','msg002841'],
['midmValencePB','Missing Message-ID, default=10 +',10,\&textinput,10,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002850','msg002851'],
['midsValencePB','Suspicious Message-ID, default=10 +',10,\&textinput,10,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002860','msg002861'],
['midiValencePB','Invalid Message-ID, default=10 +',10,\&textinput,10,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002870','msg002871'],
['fbmtvValencePB','Invalid FBMTV check, default=25 +',10,\&textinput,25,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002880','msg002881'],
['batvValencePB','Invalid BATV check, default=25 +',10,\&textinput,25,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002890','msg002891'],
['meValencePB','Max Errors Exceeded, default=10 +',10,\&textinput,10,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002900','msg002901'],
['msValencePB','Message Scoring Limit Exceeded, default=10 +',10,\&textinput,10,$ValencePBRE,'ConfigChangeValencePB', 'IP scoring',undef,undef,'msg002910','msg002911'],
['mxValencePB','Missing MX, default=10 +',10,\&textinput,10,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002920','msg002921'],
['mxaValencePB','Missing MX &amp; A Record, default=15 +',10,\&textinput,15,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg002930','msg002931'],
['nofromValencePB','No From Score, default=50 +',10,\&textinput,50,$ValencePBRE,'ConfigChangeValencePB','For Message/IP scoring in DoNoFrom.',undef,undef,'msg002940','msg002941'],
['pbeValencePB','Extreme Bad IP History, TotalScore larger than PenaltyExtreme, default=25',3,\&textinput,25,'(\d+)','ConfigChangeValencePB', 'Message Scoring',undef,undef,'msg002950','msg002951'],
['pbValencePB','Bad IP History, TotalScore larger than PenaltyLimit, default=15',3,\&textinput,15,'(\d+)','ConfigChangeValencePB', 'Message Scoring',undef,undef,'msg002960','msg002961'],
['pbwValencePB','Good IP History (IP in PB WhiteBox), default=-15',3,\&textinput,-15,'(-{0,1}\d*)','ConfigChangeValencePB', '<span class="positive">Message Scoring Bonus</span>',undef,undef,'msg002970','msg002971'],
['gripValencePB','GRIP value (+ if > 0.9,- if < 0.1), default=5',3,\&textinput,5,'(\d+)','ConfigChangeValencePB', 'Message scoring',undef,undef,'msg002980','msg002981'],
['okValencePB','Message OK, default=-25',3,\&textinput,-25,'(-?\d*)','ConfigChangeValencePB', '<span class="positive">IP Bonus</span>',undef,undef,'msg002990','msg002991'],
['ptmValencePB','Missing PTR Record, default=10 +',10,\&textinput,10,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg003000','msg003001'],
['ptiValencePB','Invalid PTR Record, default=15 +',10,\&textinput,15,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg003010','msg003011'],
['rblnValencePB','DNSBL Neutral, default=35 +',10,\&textinput,35,$ValencePBRE,'ConfigChangeValencePB','Message/IP scoring',undef,undef,'msg003020','msg003021'],
['rblValencePB','DNSBL Failed, default=100 +',10,\&textinput,100,$ValencePBRE,'ConfigChangeValencePB','Message/IP scoring',undef,undef,'msg003030','msg003031'],
['rlValencePB','Failed Relay Attempt, default=10 +',10,\&textinput,10,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg003040','msg003041'],
['saValencePB','Spam Collect Address, default=25',3,\&textinput,25,'(\d+)','ConfigChangeValencePB', 'IP scoring',undef,undef,'msg003050','msg003051'],
['scriptValencePB','Script Expression, default=25 +',10,\&textinput,25,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg003060','msg003061'],
['sbnValencePB','No Organization and No CountryCode, default=10 +',10,\&textinput,10,$ValencePBRE,'ConfigChangeValencePB', 'For Message/IP scoring in DoOrgBlocking/DoCountryBlocking',undef,undef,'msg003070','msg003071'],
['sworgValencePB','White Organizations Score, default=-25',3,\&textinput,-25,'(-\d*)','ConfigChangeValencePB', '<span class="positive"> Bonus for Message/IP scoring in DoOrgWhiting</span>',undef,undef,'msg003080','msg003081'],
['sbsccValencePB','Suspicious Country Code, default=10',3,\&textinput,10,'(\d+)','ConfigChangeValencePB', 'Message scoring',undef,undef,'msg003090','msg003091'],
['bccValencePB','Blocked Country Code Score, default=25 +',10,\&textinput,25,$ValencePBRE,'ConfigChangeValencePB', 'For Message/IP scoring  in PenaltyBox ( DoPenalty )',undef,undef,'msg003100','msg003101'],
['sbfccValencePB','Foreign Country Code Score, default=10 +',10,\&textinput,10,$ValencePBRE,'ConfigChangeValencePB', 'message scoring  in PenaltyBox ( DoPenaltyMessage )',undef,undef,'msg003110','msg003111'],
['sbhccValencePB','<span class="positive">Home Country Code Score, default=-10</span> +',10,\&textinput,-10,$ValencePB2RE,'ConfigChangeValencePB', '<span class="positive"> Bonus for Message/IP Scoring  in PenaltyBox ( DoPenalty )</span>',undef,undef,'msg003120','msg003121'],
['sborgValencePB','Blocked Organizations Score, default=25 +',10,\&textinput,25,$ValencePBRE,'ConfigChangeValencePB', 'For Message/IP scoring  in PenaltyBox ( DoPenalty )',undef,undef,'msg003130','msg003131'],
['spfpValencePB','SPF Pass Score, default=-10',3,\&textinput,-10,'(-{0,1}\d*)','ConfigChangeValencePB','<span class="positive"> Bonus for Message/IP scoring with SPF',undef,undef,'msg003140','msg003141'],
['spfnValencePB','SPF Neutral, default=5 +',10,\&textinput,5,$ValencePBRE,'ConfigChangeValencePB','Message/IP scoring',undef,undef,'msg003150','msg003151'],
['spfsValencePB','SPF Softfailed, default=5 +',10,\&textinput,5,$ValencePBRE,'ConfigChangeValencePB','Message/IP scoring',undef,undef,'msg003160','msg003161'],
['spfnonValencePB','SPF None, default=0 +',10,\&textinput,0,$ValencePBRE,'ConfigChangeValencePB','Message/IP scoring',undef,undef,'msg003170','msg003171'],
['spfuValencePB','SPF Unknown, default=0 +',10,\&textinput,0,$ValencePBRE,'ConfigChangeValencePB','Message/IP scoring',undef,undef,'msg003180','msg003181'],
['spfeValencePB','SPF Error, default=5 +',10,\&textinput,5,$ValencePBRE,'ConfigChangeValencePB','Message/IP scoring',undef,undef,'msg003190','msg003191'],
['spfValencePB','SPF Failed, default=10 +',10,\&textinput,10,$ValencePBRE,'ConfigChangeValencePB','Message/IP scoring',undef,undef,'msg003200','msg003201'],
['srsValencePB','SRS Validate Bounce Failed Score, default=10 +',10,\&textinput,10,$ValencePBRE,'ConfigChangeValencePB','For Message/IP scoring in SRSValidateBounce',undef,undef,'msg003210','msg003211'],
['stValencePB','Penalty Trap Address, default=50 +',10,\&textinput,50,$ValencePBRE,'ConfigChangeValencePB', 'For Message/IP scoring',undef,undef,'msg003220','msg003221'],
['tlsValencePB','OK, Is a SSL/TLS connection, default=-10 +',10,\&textinput,-10,$ValencePB2RE,'ConfigChangeValencePB', '<span class="positive">Message Scoring/IP scoring Bonus for SSL/TLS connections</span>',undef,undef,'msg003230','msg003231'],
['uriblnValencePB','URIBL Neutral, default=20 +',10,\&textinput,20,$ValencePBRE,'ConfigChangeValencePB','Message/IP scoring',undef,undef,'msg003240','msg003241'],
['uriblValencePB','URIBL Failed, default=25 +',10,\&textinput,25,$ValencePBRE,'ConfigChangeValencePB','Message/IP scoring',undef,undef,'msg003250','msg003251'],
['vsValencePB','Virus suspicious, default=25',3,\&textinput,25,'(\d+)','ConfigChangeValencePB','Message scoring',undef,undef,'msg003260','msg003261'],
['vdValencePB','Virus detected, default=50 +',10,\&textinput,50,$ValencePBRE,'ConfigChangeValencePB', 'Message/IP scoring',undef,undef,'msg003270','msg003271'],
['teValencePB','TestRe Valence, default=20 +',10,\&textinput,20,$ValencePBRE,'ConfigChangeValencePB', 'Valence for testing testRe<br /><hr />
  <div class="menuLevel1">Notes On Penalty Box</div>
  <input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/penaltybox.txt\',3);" />',undef,undef,'msg008710','msg008711'],

[0,0,0,'heading','Delaying/Greylisting <a href="http://apps.sourceforge.net/mediawiki/assp/index.php?title=Delaying/Greylisting" target=wiki><img height=12 width=12 src="' . $wikiinfo . '" alt="Delaying" /></a>'],
['EnableDelaying','Enable Delaying/Greylisting',0,\&checkbox,1,'(.*)',undef,
  'Enable Greylisting as described at <a href="http://projects.puremagic.com/greylisting/whitepaper.html?view=markup" rel="external">Greylisting-whitepaper</a>.<br />
  It\'s a new method of blocking significant amounts of spam at the mailserver level, but without resorting to heavyweight statistical analysis or other heuristical approaches.',undef,undef,'msg003280','msg003281'],
['DelayWL','Whitelisted Greylisting',0,\&checkbox,'','(.*)',undef,
  'Enable Greylisting for whitelisted mails. This also enables Geylisting for SPF-Cache-OK listed IP\'s and mails from white organizations, which are normaly not greylisted.',undef,undef,'msg003290','msg003291'],
['DelayNP','NoProcessing Greylisting',0,\&checkbox,'','(.*)',undef,
  'Enable Greylisting for noprocessing mails.',undef,undef,'msg003300','msg003301'],
['DelaySL','Spam-Lovers Greylisting',0,\&checkbox,'','(.*)',undef,
  'Enable Greylisting for Spam-Lovers.',undef,undef,'msg003310','msg003311'],
['DelayAddHeader','Add X-Assp-Delayed Header',0,\&checkbox,1,'(.*)',undef,
  'Add X-Assp-Delayed header to header of all delayed or whitelisted mails.',undef,undef,'msg003320','msg003321'],
['DelayEmbargoTime','Embargo Time',5,\&textinput,5,'(\d+)',undef,
  'Enter the number of minutes for which delivery, related with new \'triplet\' (IP address of the sending<br />
  host + mail from + rcpt to), is refused with a temporary failure. Default is 5 minutes.',undef,undef,'msg003330','msg003331'],
['DelayWaitTime','Wait Time',5,\&textinput,28,'(\d+)',undef,
  'Enter the number of hours to wait for delivery attempts related with recognised \'triplet\'; delivery is accepted <br />
  immediately and the \'tuplet\' (IP address of the sending host + sender\'s domain) is safelisted. Default is 28 hours.',undef,undef,'msg003340','msg003341'],
['DelayExpiryTime','Expiry Time',5,\&textinput,36,'(\d+)',undef,
  'Enter the number of days for which whitelisted \'tuplet\' is considered valid. Default is 36 days.',undef,undef,'msg003350','msg003351'],
['DelayUseNetblocks','Use IP Netblocks',0,\&checkbox,1,'(.*)',undef,
  'Perform the IP address checks of the sending host based on the /24 subnet it is at rather than the specific IP. <br />
  This feature may be useful for legitimate mail systems that shuffle messages among SMTP clients between retransmissions.',undef,undef,'msg003360','msg003361'],
['DelayNormalizeVERPs','Normalize VERP Addresses',0,\&checkbox,1,'(.*)',undef,
  'Some mailing lists (such as Ezmlm) try to track bounces to individual mails, rather than just individual recipients, which creates a variation on the VERP method where each email has its own unique envelope sender. Since the automatic whitelisting (called savelisting to make a difference to the standard whitelisting) that is built into Greylisting depends on the envelope addresses for subsequent mails being the same, the greylisting filter will attempt to normalize the unique sender addresses, when this option is checked.',undef,undef,'msg003370','msg003371'],
['DelayWithMyName','Add myName to Triplets',0,\&checkbox,0,'(.*)',undef,
  'If set, myName is added to every delay triplet (not to tuplets). This is useful and recommended, if you are using more than one ASSP host with shared databases for delaydb. This option makes the triplets unique to every ASSP host, because it is allowed for SMTP-hosts, to request a backup MX immediately after the primary MX, without waiting 5 minutes (DelayEmbargoTime) between the two requests.',undef,undef,'msg003380','msg003381'],
['DelayMD5','Use MD5 for DelayDB',0,\&checkbox,'1','(.*)',undef,
  'Message-Digest algorithm 5 is a cryptographic hash function and adds some level of security to the delay database. Must be set to off if you want to list the database with DelayShowDB/DelayShowDBwhite. This requires an installed <a href="http://search.cpan.org/search?query=Digest::MD5" rel="external">Digest::MD5</a> module in PERL.',undef,undef,'msg003390','msg003391'],
['DelayShowDB','Show Delay/Greylisting Database',40,\&textinput,'file:delaydb','(\S*)',undef,'The directory/file with the delay database file. If you change the filename in section Filepath ( delaydb ) you must change it here too.',undef,'8','msg003400','msg003401'],
['DelayShowDBwhite','Show Delay/Greylisting Save Database',40,\&textinput,'file:delaydb.white','(\S*)',undef,'The directory/file with the save delay database file. If you change the filename in section Filepath ( delaydb )  you must change it here too.',undef,'8','msg003410','msg003411'],
['DelayExpireOnSpam','Expire Spamming Safelisted Tuplets',0,\&checkbox,1,'(.*)',undef,
  'If a safelisted \'tuplet\' is ever associated with spam, viri, failed rbl, spf etc, it is deleted from the safelist. <br />
  This renews the temporary embargo for subsequent mail involving the tuplet.',undef,undef,'msg003420','msg003421'],
['CleanDelayDBInterval','Clean Up Delaying Database <sup>s</sup>',40,\&textinput,10800,$ScheduleGUIRe,'configChangeSched',
  'Delete outdated entries from triplets and safelisted tuplets databases every this many seconds.<br />
  Defaults to 3 hour.',undef,undef,'msg003430','msg003431'],
['noDelay','Don\'t Delay these IPs*',80,\&textinput,'file:files/nodelay.txt','(\S*)','ConfigMakeIPRe',
  'Enter IP addresses that you don\'t want to be delayed, separated by pipes (|). There are misbehaving MTAs that will not be able to get a legitimate email through a Greylisting server because they do not try again later. An INCOMPLETE list of such mailers is available at <a href="http://cvs.puremagic.com/viewcvs/greylisting/schema/whitelist_ip.txt" rel="external">cvs.puremagic.com/viewcvs/Greylisting/schema/whitelist_ip.txt</a>. <br />
  When using mentioned list remember to add trailing dots in IP addresses which specify subnets (eg. 192.168 -> 192.168. ).<br />
  For example:  127.0.0.1|172.16..<br />
  To define IP\'s only for specific email addresses or domains (recipients) you must use the file:... option<br />
  An entry (line) may look as follows:<br />
  145.146.0.0/16=>*@local.domain|user@mydomain|user2@*.mydomain # comment<br /><br />
  It is possible to define a predefined group on any or both sides of the \'=>\' separator, like:<br />
  [ipgroup]=>[usergroup]|user@mydomain<br /><br />
  NOTICE: the following combination of two entries, will lead in to a user/domain based matching - the global entry will be ignored!<br />
  145.146.0.0/16 # comment<br />
  145.146.0.0/16=>*@local.domain|user@mydomain|user2@*.mydomain # comment<br />
  If multiple user/domain based entries are defined for the same IP, only the last one will be used!',undef,'7','msg003440','msg003441'],
['noDelayAddresses','Do not Delay these Addresses*',80,\&textinput,'','(.*)','ConfigMakeSLRe','Enter senders email addresses that you don\'t want to be delayed, separated by pipes (|). You can list specific addresses (user@anydomain.com), addresses at any domain (user), or entire domains (@anydomain.com).  Wildcards are supported (fribo*@domain.com). (|).<br />For example: fribo@anydomain.com|jhanna|@sillyguys.org or place them in a plain ASCII file one address per line:file:files/nodelayuser.txt.',undef,undef,'msg008610','msg008611'],
['localnoDelayAddresses','Do not Delay local Addresses*',0,\&checkbox,'','(.*)',undef,'Skip delaying if the recipient matches \'noDelayAddresses\' (incoming mail only).',undef,undef,'msg009760','msg009761'],
['DelayError','Reply Code to Refuse Delayed Messages',80,\&textinput,'451 4.7.1 Please try again later','(45\d .*)',undef,
  'SMTP reply code to refuse delayed messages. Default: 451 4.7.1 Please try again later
  <br /><hr />
  <div class="menuLevel1">Notes On Delaying</div>
  <input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/delaying.txt\',3);" />',undef,undef,'msg003450','msg003451'],

[0,0,0,'heading','SPF/DMARC/SRS <a href="http://apps.sourceforge.net/mediawiki/assp/index.php?title=SPF" target=wiki><img height=12 width=12 src="' . $wikiinfo . '" alt="SPF" /></a>'],
['ValidateSPF','Enable SPF Validation','0:disabled|1:block|2:monitor|3:score',\&listbox,3,'(.*)',undef,
  'Enable Sender Policy Framework Validation as described at <a href="http://www.openspf.org/" rel="external">openspf</a> and Domain-based Message Authentication, Reporting &amp; Conformance - described in <a href="http://www.dmarc.org/" rel="external">DMARC</a> (DMARC requires also DoDKIM to be enabled).<br />
  This requires an installed <a href="http://www.openspf.org/Implementations" rel="external">Mail::SPF</a> module in PERL. Testmode is set with spfTestMode, scoring is set with spfValencePB. If you need more information about the syntax of SPF records, visit <a href="http://www.openspf.org/SPF_Record_Syntax" rel="external">SPF_Record_Syntax</a>.',undef,undef,'msg003460','msg003461'],
['SPF2','Do SPF Version 2 Validation',0,\&checkbox,'1','(.*)',undef,
  'Enable Sender Policy Framework Validation Version 2.<br />
  This requires an installed <a href="http://search.cpan.org/dist/Mail-SPF/" rel="external">Mail::SPF</a> object-oriented Perl module that supersedes the old Mail::SPF::Query module. ',undef,undef,'msg003470','msg003471'],
['SPFWL','Whitelisted SPF Validation',0,\&checkbox,'','(.*)',undef,
  'Enable Sender Policy Framework Validation for whitelisted users also.',undef,undef,'msg003480','msg003481'],
['SPFNP','noProcessing SPF Validation',0,\&checkbox,'','(.*)',undef,
  'Enable Sender Policy Framework Validation for nonprocessed messages also.',undef,undef,'msg009560','msg009561'],
['SPFLocal','Local and outgoing mail SPF Validation',0,\&checkbox,'','(.*)',undef,
  'Enable Sender Policy Framework Validation for local and outgoing messages also. Don\'t forget to configure your DNS-server for SPF and/or to configure SPFoverride / SPFfallback / SPFlocalRecord, if you enable this option.',undef,undef,'msg003490','msg003491'],
['enableSPFbackground','Enable SPF Background Check',0,\&checkbox,'1','(.*)',undef,
 'SPF background checks are initiated by some features (for example DoDomainIP) to fillup the SPFCache. The collected results are later used to prevent blocking good mails.',undef,undef,'msg003500','msg003501'],
['AddSPFHeader','Add Received-SPF Header',0,\&checkbox,1,'(.*)',undef,
  'Add Received-SPF header to header of all mails processed by SPF.',undef,undef,'msg003510','msg003511'],
['SPFError','SPF Failed Reply',80,\&textinput,'554 5.7.1 failed SPF: SPFRESULT','([245]\d\d .*)',undef,
  'SMTP reply for SPF failed messages. Default: \'554 5.7.1 failed SPF: SPFRESULT\'<br />
  The literal SPFRESULT (case sensitive) is replaced by the actual result.',undef,undef,'msg003520','msg003521'],
['noSPFRe','Skip SPF Processing*',80,\&textinput,'','(.*)','ConfigCompileRe',
 'Put anything here to identify these messages in mailfrom or header',undef,undef,'msg003530','msg003531'],
['SPFoverride','Override Domains*',80,\&textinput,'','(.*)','configUpdateSPFOF',
 'Set override to define SPF records for domains that do publish but which you want to override anyway. If you specify only domains the Local SPF Record ( SPFlocalRecord ) below will be used as default. Wildcards are supported. For example: abc.com=>v=spf1 a/24 mx/24 ptr -all|cello.ch=>v=spf1 ip4:213.46.243.0/26  ~all|abc.com|*.def.com . <br />
 To generate a SPF record for a domain:<br />
 - go to <a href="http://www.senderbase.org/" target="_blank">http://www.senderbase.org</a><br />
 - lookup the domain information in "Look up your network"<br />
 - right beside "Addresses in domain used to send email" click on export, and export the list in to plain text<br />
 - copy and past the list in to an editor and generate a comma separated IP list<br />
 - go to an online SPF record generator - for example: <a href="http://www.royhochstenbach.com/projects/spfgenerator/" target="_blank">http://www.royhochstenbach.com/projects/spfgenerator</a> and generate the SPF record<br />
 - put "domain=>SPF-record" in any of SPFoverride or SPFfallback<br />
 - define the policy as strict as possible',undef,undef,'msg003540','msg003541'],
['SPFfallback','Fallback Domains*',80,\&textinput,'','(.*)','configUpdateSPFOF',
 'Set fallback to define "pretend" SPF records for domains that don\'t publish them yet. If you specify only domains the Local SPF Record ( SPFlocalRecord ) below will be used as default. Wildcards are supported. For example: abc.com=>v=spf1 a/24 mx/24 ptr -all|cello.ch=>v=spf1 ip4:213.46.243.0/26  ~all|abc.com|*.def.com',undef,undef,'msg003550','msg003551'],
['LocalPolicySPF','Local SPF Policy',80,\&textinput,'v=spf1 a/24 mx/24 ptr ~all','(.*)','configUpdateSPFLR','If the sending domain does not publish its own SPF Records this will be used.<br />The default is v=spf1 a/24 mx/24 ptr ~all<br />
 <span class="negative">This option applies to Mail::SPF::Query module only.</span>',undef,undef,'msg003560','msg003561'],
['SPFlocalRecord','Fallback/Override SPF Record',80,\&textinput,'v=spf1 a/24 mx/24 ptr -all','(.*)','configUpdateSPFLR','Used in Fallback/Override Domains<br />The default is v=spf1 a/24 mx/24 ptr -all',undef,undef,'msg003570','msg003571'],
['strictSPFRe','Strict SPF Processing Regex*',80,\&textinput,'file:files/strictspf.txt','(.*)','ConfigCompileRe',
 'Softfail/Neutral will be failed for these sending addresses. Put anything here to identify the addresses',undef,undef,'msg003580','msg003581'],
['blockstrictSPFRe','Block SPF Processing Regex*',80,\&textinput,'@ebay.com|@paypal.com','(.*)','ConfigCompileRe',
 'All failed messages will be blocked for these sending addresses. Put anything here to identify the addresses.',undef,undef,'msg003590','msg003591'],
['DoSPFinHeader','Additional SPF Check on the Header from',0,\&checkbox,'','(.*)',undef,
  'Do an additional SPF check on the header from: address if it is in blockstrictSPFRe *** this check breakes RFC rules ***.',undef,undef,'msg009820','msg009821'],
['SPFsoftfail','Fail SPF Softfail Validations',0,\&checkbox,'','(.*)',undef,
  'Intentionally fail SPF softfail status responses. The possible results of a query are:
<br />pass:The client IP address is an authorized mailer for the sender. The mail should be accepted subject to local policy regarding the sender.
<br />fail:The client IP address is not an authorized mailer, and the sender wants you to reject the transaction for fear of forgery.
<br />softfail:The client IP address is not an authorized mailer, but the sender prefers that you accept the transaction because it isn\'t absolutely sure all its users are mailing through approved servers. The softfail status is often used during initial deployment of SPF records by a domain.
<br />neutral:The sender makes no assertion about the status of the client IP.
<br />none:There is no SPF record for this domain.
<br />permerror &amp; temperror:The DNS lookup encountered an error during processing.
<br />unknown:The domain has a configuration error in the published data or defines a mechanism that this library does not understand.',undef,undef,'msg003600','msg003601'],
['SPFneutral','Fail SPF Neutral Validations',0,\&checkbox,'','(.*)',undef,
  'Intentionally fail SPF neutral status responses',undef,undef,'msg003610','msg003611'],
['SPFqueryerror','Fail SPF Error Responses',0,\&checkbox,'','(.*)',undef,
  'Intentionally fail SPF \'error\' status responses',undef,undef,'msg003620','msg003621'],
['SPFnone','Fail SPF None and Unknown Responses',0,\&checkbox,'','(.*)',undef,
  'Intentionally fail SPF \'none\' and \'unknown\' status responses',undef,undef,'msg003630','msg003631'],
['SPFunknown','Fail SPF Unknown  Responses',0,\&checkbox,'','(.*)',undef,
  'Intentionally fail SPF \'unknown\'  status responses',undef,undef,'msg003640','msg003641'],
['SPFCacheInterval','SPF Cache Refresh Interval',4,\&textinput,7,'(\d+\.?\d*|)','configUpdateSPFCR',
  'SPF records in cache will be removed after this interval in days. 0 will disable the cache.<input type="button" value=" Show SPF Cache" onclick="javascript:popFileEditor(\'pb/pbdb.spf.db\',6);" />',undef,undef,'msg003650','msg003651'],
['DebugSPF','Enable SPF Debug output to ASSP Logfile',0,\&checkbox,'','(.*)',undef,
 'Enables verbose debugging of SPF queries within the Mail::SPF module.
 <br /><hr />
 <div class="menuLevel1">Notes On SPF</div>
 <input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/spf.txt\',3);" /> ',undef,undef,'msg003660','msg003661'],
['DMARCReportFrom','From Address for DMARC Reports',40,\&textinput,'','('.$EmailAdrRe.'(?:\@'.$EmailDomainRe.')?|)',undef,
  'The email address to be used as FROM: address to send <a href="http://www.dmarc.org/" rel="external">DMARC</a> reports. If blank, no DMARC reports will be sent! If only the user name is defined, assp will add the domain name that belongs to the report.',undef,undef,'msg009730','msg009731'],
['EnableSRS','Enable Sender Rewriting Scheme',0,\&checkbox,'','(.*)','updateSRS',
  'Enable Sender Rewriting Scheme as described at <a href="http://www.openspf.org/SRS" rel="external">www.openspf.org/SRS</a>.<br />
  This requires an installed <a href="http://www.openspf.org/Implementations" rel="external">Mail::SRS</a> module in PERL.<br />
  You should use SRS if your message handling system forwards email for domains with published spf records and there SPF record not includes your MX.<br />
  NOTICE: In case your local users are forwarding mails (e.g. from external domains) to external domains (external mail accounts) and these foreign domains bounces back (e.g. out_of_office / vacation), your MTA (smtpDestination) will possibly get mails from external domains to be deliverd to external domains!<br />
  Note that you have to setup the outgoing path (Relay Host and Port) to let ASSP see and rewrite your outgoing traffic.<br /> Testmode is set with srsTestMode.',undef,undef,'msg003670','msg003671'],
['SRSAliasDomain','Alias Domain',40,\&textinput,'thisdomain.com','(.*)','updateSRSAD',
  'SPF requires the SMTP client IP to match the envelope sender (return-path). When a message is forwarded through<br />
  an intermediate server, that intermediate server may need to rewrite the return-path to remain SPF compliant.<br />
  For example: thisdomain.com',undef,undef,'msg003680','msg003681'],
['SRSSecretKey','Secret Key',20,\&textinput,'','(.*)','updateSRSSK',
  'A key for the cryptographic algorithms -- Must be at least 5 characters long.',undef,undef,'msg003690','msg003691'],
['SRSTimestampMaxAge','Maximum Timestamp Age',5,\&textinput,2,'(\d+)',undef,
  'Enter the maximum number of days for which a timestamp is considered valid. Default is 2 days. After this number of days a SRS bounce is no longer valid!',undef,undef,'msg003700','msg003701'],
['SRSHashLength','Hash Length',5,\&textinput,6,'(\d+)',undef,
  'The number of bytes of base64 encoded data to use for the cryptographic hash.<br />
  More is better, but makes for longer addresses which might exceed the 64 character length suggested by RFC2821.<br />
  This defaults to 6, which gives 6 x 6 = 36 bits of cryptographic information, which means that a spammer will have <br />
  to make 2^36 attempts to guarantee forging an SRS address.',undef,undef,'msg003710','msg003711'],
['SRSValidateBounce','Enable Bounce Recipient Validation','0:disabled|1:block|2:monitor|3:score',\&listbox,0,'(.*)',undef,
  'Bounce messages that fail reverse SRS validation (but not a valid SMTP probe)<br />
  will receive a 554 5.7.5 [Bounce address not SRS signed] SMTP error code.<br /> Testmode is set with srsTestMode, scoring is set with srsValencePB.',undef,undef,'msg003720','msg003721'],
['SRSno','Don\'t Rewrite These Addresses*',60,\&textinput,'','(.*)','ConfigMakeSLRe',
  'Don\'t rewrite addresses when messages come from these addresses. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com). <br />For example: fribo@thisdomain.com|jhanna|@sillyguys.org',undef,undef,'msg003730','msg003731'],
['noSRS','Don\'t Validate Bounces From these IPs*',80,\&textinput,'','(\S*)','ConfigMakeIPRe',
  'Enter IP addresses that you don\'t want to validate bounces from, separated by pipes (|).
  For example:  127.0.0.1|172.16..<br /><hr />
  <div class="menuLevel1">Notes On SRS</div>
  <input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/srs.txt\',3);" />',undef,'7','msg003740','msg003741'],

[0,0,0,'heading','DNSBL <a href="http://apps.sourceforge.net/mediawiki/assp/index.php?title=DNSBL" target=wiki><img height=12 width=12 src="' . $wikiinfo . '" alt="DNSBL" /></a>'],
['ValidateRBL','Enable DNS Blacklist Validation ','0:disabled|1:block|2:monitor|3:score',\&listbox,1,'(.*)','configUpdateRBL',
  'This requires an installed <a href="http://search.cpan.org/search?query=Net::DNS" rel="external">Net::DNS</a> module in PERL.',undef,undef,'msg003750','msg003751'],
['ForceRBLCache','Early DNSBL Cache Blocking',0,\&checkbox,'','(.*)',undef,
  'If set, ASSP will use cached DNSBL hits to block messages before other tests. <b>testmode</b> will override this. <b>spamlover settings</b> will be ignored.',undef,undef,'msg003760','msg003761'],
['noRBL','Don\'t do DNSBL for these IPs*',80,\&textinput,'','(\S*)','ConfigMakeIPRe',
 'Enter IP addresses that you don\'t want to be DNSBL validated, separated by pipes (|). For example:  127.0.0.1|172.16..',undef,'7','msg003770','msg003771'],
['RBLWL','Whitelisted DNSBL Validation',0,\&checkbox,0,'(.*)',undef,
  'Enable DNSBL for whitelisted users also',undef,undef,'msg003780','msg003781'],
['AddRBLHeader','Add X-Assp-DNSBL Header',0,\&checkbox,1,'(.*)',undef,
  'Add X-Assp-DNSBL header to messages with positive reply from DNSBL.',undef,undef,'msg003790','msg003791'],
['RBLError','DNSBL Failed Reply',80,\&textinput,'554 5.7.1 DNS Blacklisted by RBLLISTED','(.*)',undef,
  'SMTP reply for DNSBL failed messages. Default: \'554 5.7.1 DNS Blacklisted by RBLLISTED\'<br />
  The literal RBLLISTED (case sensitive) is replaced by the actual serviceproviders(s).',undef,undef,'msg003800','msg003801'],
['RBLServiceProvider','RBL Service Providers*',80,\&textinput,'file:files/dnsbls.txt','(\S*)','configUpdateRBLSP',
 'Names of DNSBLs to use separated by "|". You may set for every provider a weight like zen.spamhaus.org=>50|bl.spamcop.net=>25.<br />
 Defaults are:<br />
 zen.spamhaus.org=>1|bl.spamcop.net=>1|psbl.surriel.com=>2|ix.dnsbl.manitu.net=>2|<br />
 l2.apews.org=>3|combined.njabl.org=>1|safe.dnsbl.sorbs.net=>1|dnsbl-1.uceprotect.net=>2|<br />
 dnsbl-2.uceprotect.net=>2|dnsbl-3.uceprotect.net=>2|blackholes.five-ten-sg.com=>3".<br />
 DNSBL providers can get a "weight" like bl.spamcop.net=>1.<br />
 The value of the weight can be set directly like=>45 or as a divisor of RBLmaxweight. Low numbers < 6 are divisors . So if RBLmaxweight = 50 (default) bl.spamcop.net=>50  would be the same as bl.spamcop.net=>1, bl.spamcop.net=>2 would be the same as bl.spamcop.net=>25.<br />
 If the sum of weights surpasses RBLmaxweight, the DNSBL check fails.  If not, the DNSBL check is scored as "neutral" even with RBLmaxhits reached. Setting Showmaxreplies will allow ALL replies to contribute to the total weight regardless of RBLmaxhits.<br />
 Some RBL Service Providers, like blackholes.five-ten-sg.com, provides different return codes in a single DNS-zone: like 127.a.b.c - where a,b,c are used to identify a weight or type (or what ever) of the returned entry. If you want to care about special return codes, or if you want to use different weights for different return codes, you should use the following enhanced entry syntax:<br /><br />
 RBL-Service-Provider=>result-to-watch=>weight (like:)<br />
 blackholes.five-ten-sg.com=>127.0.0.2=>3<br />
 blackholes.five-ten-sg.com=>127.0.0.5=>4<br />
 blackholes.five-ten-sg.com=>127.0.?.*=>5<br /><br />
 You can see, the wildcards * (multiple character) and ? (single character) are possible to use in the second parameter. Never mix the three possible syntax types for the same RBL Service Provider. An search for a match inside such a definition is done in reverse ASCII order, so the wildcards are used as last.<br />
 Some RBL Service Providers, provides different return codes using a bitmask in any part of the reply. To define weights for bitmasks, place a single \'M\' in front of the mask number, like<br /><br />
 sp.com=>127.0.0.M2=>25<br />
 sp.com=>127.0.0.M4=>41<br />
 sp.com=>127.0.M1.5=>56<br />
 sp.com=>127.0.M64.*=>11<br />
 sp.com=>127.0.0.2=>22<br />
 sp.com=>127.0.*.*=>1<br /><br />
 Valid bitmasks are 1,2,4,8,16,32,64 and 128. The resulting weight will be the weight sum of all matching bitmasks (if no full qualified definition is found). For example: a return code of 127.0.0.6 for sp.com will result in a weight of 66 (25+41), a reply of 127.0.0.2 will result in 22<br />
 Because each single bitmask indicates a set of 128 numbers you should prevent the usage of something like 127.0.M16.M1 - this will lead in to a set of (128*128) 16384 addresses, which is really too much!<br />
 For the same service provider, first define all bitmask definitions, after that all full qualified definitions and than all definitions with wildcards, like in the example above! If your definition order is wrong, the resulting weights will be unexpected!
  ',undef,undef,'msg003810','msg003811'],
['RBLmaxreplies','Maximum Replies',3,\&textinput,7,'(\d*)','configUpdateRBLMR','A reply is affirmative or negative reply from a DNSBL.<br />
  The DNSBL module will wait for this number of replies (negative or positive) from the DNSBLs listed under Service Provider for up to the Maximum Time( RBLmaxtime ).<br />
  This number should be equal to or less than the number of DNSBL Service Providers listed to allow for randomly unavailable DNSBLs.',undef,undef,'msg003820','msg003821'],
['RBLmaxhits','Maximum Hits',3,\&textinput,2,'(\d*)','configUpdateRBLMH','A hit is an affirmative response from a DNSBL.<br />
  The DNSBL module will check all of the DNSBLs listed under Service Provider. If the number of hits is greater or equal Maximum Hits, the email is flagged <b>Failed</b>.<br /> If the number of hits is greater 0 and less Maximum Hits, the email is flagged <b>Neutral</b>',undef,undef,'msg003830','msg003831'],
['RBLmaxweight','RBL Maximum Weight',3,\&textinput,50,'(\d*)',undef,'A weight is a number representing the trust we put into a DNSBL.<br />
  The DNSBL module will check all of the DNSBLs listed under Service Provider. If the total of weights is greater or equal Maximum Weight, the email is flagged <b>Failed</b>.<br /> If the total of weights is greater 0 and less Maximum Weight, the email is flagged <b>Neutral</b>',undef,undef,'msg003840','msg003841'],
['RBLmaxtime','Maximum Time',5,\&textinput,15,'(\d*)',undef,'This sets the maximum time in seconds to spend on each message performing DNSBL checks. Default is 15.',undef,undef,'msg003850','msg003851'],
['RBLsocktime','Socket Timeout',5,\&textinput,1,'(\d*)',undef,'This sets the DNSBL socket read timeout in seconds.',undef,undef,'msg003860','msg003861'],
['RBLCacheExp','DNSBL Expiration Time',4,\&textinput,24,'(\d+\.?\d*|)','configUpdateRBLCR',
  'IP\'s in cache will be removed after this interval in hours. 0 will disable the cache. <input type="button" value=" Show DNSBL Cache" onclick="javascript:popFileEditor(\'pb/pbdb.rbl.db\',5);" />
  <hr /><div class="menuLevel1">Notes On DNSBL</div>
  <input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/rbl.txt\',3);" />',undef,undef,'msg003870','msg003871'],

[0,0,0,'heading','URIBL'],
 ['ValidateURIBL','Enable URI Blocklist Validation <a href="http://www.uribl.com/about.shtml" target="ASSPHELP"><img src="' . $wikiinfo . '" alt="about" /></a>','0:disabled|1:block|2:monitor|3:score',\&listbox,'1','(.*)','configUpdateURIBL',
  'Enable URI Blocklist. Messages that fail URIBL validation will receive URIBLError SMTP error code. This requires an installed <a href="http://search.cpan.org/search?query=Net::DNS" rel="external">Net::DNS</a> module and an installed <a href="http://search.cpan.org/search?query=Email::MIME" rel="external">Email::MIME</a> module in PERL. <a href="http://apps.sourceforge.net/mediawiki/assp/FAQ#Common_Problems" target="ASSPHELP"><img src="' . $wikiinfo . '" alt="wiki" /></a><br />
  <span class="negative"> 0 = disabled, 1 = block, 2 = monitor, 3 =  messagescore .</span>',undef,undef,'msg003880','msg003881'],
 ['URIBLWL','Do URI Blocklist Validation for Whitelisted',0,\&checkbox,'','(.*)',undef,'URIBL check is done ignoring all spamlovers and testmodes!',undef,undef,'msg003890','msg003891'],
 ['URIBLNP','Do URI Blocklist Validation for NoProcessing',0,\&checkbox,'','(.*)',undef,'URIBL check is done ignoring all spamlovers and testmodes!',undef,undef,'msg003900','msg003901'],
 ['URIBLLocal','Do URI Blocklist Validation for Local Mails',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg003910','msg003911'],
 ['URIBLISP','Do URI Blocklist Validation for ISP/Secondary',0,\&checkbox,1,'(.*)',undef,'',undef,undef,'msg003920','msg003921'],
 ['URIBLServiceProvider','URIBL Service Providers*',60,\&textinput,'file:files/uribls.txt','(.*)','configUpdateURIBLSP',
 'Domain Names of URIBLs to use separated by "|". You may set for every provider a weight like multi.surbl.org=>50|black.uribl.com=>25.<br />
 The value of the weight can be set directly like=>45 or as a divisor of URIBLmaxweight . Low numbers < 6 are divisors . So if URIBLmaxweight = 50 (default) multi.surbl.org=>50  would be the same as multi.surbl.org=>1, multi.surbl.org=>2 would be the same as multi.surbl.org=>25.<br />
 If the sum of weights surpasses URIBLmaxweight, the URIBL check fails.  If not, the URIBL check is scored as "neutral"  even with URIBLmaxhits reached. Setting Showmaxreplies will allow ALL replies to contribute to the total weight regardless of URIBLmaxhits.<br />
 Some URIBL Service Providers, like multi.surbl.org and black.uribl.com , provides different return codes in a single DNS-zone: like 127.a.b.c - where a,b,c are used to identify a weight or type (or what ever) of the returned entry. If you want to care about special return codes, or if you want to use different weights for different return codes, you should use the following enhanced entry syntax:<br /><br />
 URIBL-Service-Provider=>result-to-watch=>weight (like:)<br />
 multi.surbl.org=>127.0.0.2=>2<br />
 multi.surbl.org=>127.0.0.4=>3<br />
 multi.surbl.org=>127.0.0.?=>4<br />
 multi.surbl.org=>127.0.0.*=>5<br /><br />
 You can see, the wildcards * (multiple character) and ? (single character) are possible to use in the second parameter. Never mix the three possible syntax types for the same URIBL Service Provider. An search for a match inside such a definition is done in reverse ASCII order, so the wildcards are used as last.<br />
 Some URIBL Service Providers, provides different return codes using a bitmask in any part of the reply. To define weights for bitmasks, place a single \'M\' in front of the mask number, like<br /><br />
 sp.com=>127.0.0.M2=>25<br />
 sp.com=>127.0.0.M4=>41<br />
 sp.com=>127.0.M1.5=>56<br />
 sp.com=>127.0.M64.*=>11<br />
 sp.com=>127.0.0.2=>22<br />
 sp.com=>127.0.*.*=>1<br /><br />
 Valid bitmasks are 1,2,4,8,16,32,64 and 128. The resulting weight will be the weight sum of all matching bitmasks (if no full qualified definition is found). For example: a return code of 127.0.0.6 for sp.com will result in a weight of 66 (25+41), a reply of 127.0.0.2 will result in 22<br />
 Because each single bitmask indicates a set of 128 numbers you should prevent the usage of something like 127.0.M16.M1 - this will lead in to a set of (128*128) 16384 addresses, which is really too much!<br />
 For the same service provider, first define all bitmask definitions, after that all full qualified definitions and than all definitions with wildcards, like in the example above! If your definition order is wrong, the resulting weights will be unexpected!
 Default is: multi.surbl.org|black.uribl.com',undef,undef,'msg003930','msg003931'],
 ['URIBLCCTLDS','URIBL Country Code TLDs*',60,\&textnoinput,'file:files/URIBLCCTLDS.txt','(.*)','ConfigMakeRe',
  'List of <a href="http://www.surbl.org/tld/two-level-tlds" rel="external">two level country code TLDs</a> and <a href="http://www.surbl.org/tld/three-level-tlds" rel="external">three level country code TLDs</a> used to determine the base domain of the uri. Two level TLDs will be checked on third level, third level TLDs will be checked on fourth level. Any not listed domain will be checked in level two.',undef,undef,'msg003940','msg003941'],
 ['URIBLmaxuris','Maximum URIs',5,\&textinput,0,'(\d*)',undef,
  'More than this number of URIs in the body will increase spam probability. Enter 0 to disable feature.',undef,undef,'msg003950','msg003951'],
 ['URIBLmaxdomains','Maximum Unique Domain URIs',5,\&textinput,0,'(\d*)',undef,
  'More than this number of unique domain URIs in the body will increase spam probability. Enter 0 to disable feature.',undef,undef,'msg003960','msg003961'],
 ['URIBLNoObfuscated','Disallow Obfuscated URIs <a href="http://www.pc-help.org/obscure.htm" target="ASSPHELP"><img src="' . $wikiinfo . '" alt="obscure" /></a>',0,\&checkbox,'1','(.*)',undef,
  'When enabled, messages with obfuscated URIs of types [integer/octal/hex IP, other things!] in the body will get increased spam probability and if weights are used, the double weight will be used.',undef,undef,'msg003970','msg003971'],
 ['URIBLcheckDOTinURI','Check for \'DOT\' in URI',0,\&checkbox,'','(.*)',undef,
  'When enabled, assp will also check for the used word \'DOT\' instead of a \'.\' in URI\'s like \'example<b>dot</b>com or example<b>!d o-t_</b>com\' .<br />
   Enable this feature only, if you don\'t expect any problems in your national language (using \'dot\' + a toplevel domain in any words).',undef,undef,'msg008820','msg008821'],
 ['URIBLmaxreplies','Maximum Replies',5,\&textinput,2,'(\d*)','configUpdateURIBLMR',
  'A reply is affirmative or negative reply from a URIBL.<br />
   The URIBL module will wait for this number of replies (negative or positive) from the URIBLs listed under Service Provider<br />
   for up to the Maximum Time below. This number should be equal to or less than the number of URIBL Service Providers<br />
   listed to allow for randomly unavailable URIBLs.',undef,undef,'msg003980','msg003981'],
 ['URIBLmaxhits','Maximum Hits',5,\&textinput,1,'(\d*)','configUpdateURIBLMH',
  'A hit is an affirmative response from a URIBL.<br />
   The URIBL module will check all of the URIBLs listed under Service Provider,<br />
   and flag the email with a URIBL failure flag if more than this number of URIBLs return a postive blacklisted response.<br />
   This number should be less than or equal to Maximum Replies above and greater than 0.
   If the number of hits is greater or equal Maximum Hits, the email is flagged <b>failed</b> in every case!
   If the number of hits is greater 0 and less Maximum Hits, the email is flagged <b>neutral</b>.<br />
   This behavior could be changed to your needs by using weighted values for the URIBLServiceProvider .',undef,undef,'msg003990','msg003991'],
 ['URIBLmaxweight','URIBL Maximum Weight',3,\&textinput,50,'(\d*)',undef,'A weight is a number representing the trust we put into a URIBL.<br />
  The URIBL module will check all of the URIBLs listed under URIBLServiceProvider for every URI found in an email. If the total of weights for an URI is greater or equal this Maximum Weight, the email is flagged <b>Failed</b>.<br /> If the total of weights is greater 0 and less Maximum Weight, the email is flagged <b>Neutral</b> . If not defined or set to zero only the hit count will used to detect a fail or neutral state.',undef,undef,'msg009150','msg009151'],
 ['URIBLmaxtime','Maximum Time',5,\&textinput,10,'(\d*)',undef,
  'This sets the maximum time in seconds to spend on each message performing URIBL checks.',undef,undef,'msg004000','msg004001'],
 ['URIBLsocktime','Socket Timeout',5,\&textinput,1,'(\d*)',undef,'This sets the URIBL socket read timeout in seconds.',undef,undef,'msg004010','msg004011'],
 ['URIBLwhitelist','Whitelisted URIBL Domains*',60,\&textinput,'doubleclick.net','(.*)','ConfigMakeRe',
  'This prevents specific domains from being checked by URIBL module. For example: doubleclick.net or file:files/URIBLwhitelist.txt. Domains already listed in noProcessingDomains and whiteListedDomains will be honored.',undef,undef,'msg004020','msg004021'],
 ['noURIBL','Don\'t Check Messages from these Addresses*',60,\&textinput,'','(.*)','ConfigMakeSLRe',
  'Don\'t validate URIBL when messages come from these addresses. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com). <br />For example: fribo@thisdomain.com|jhanna|@sillyguys.org',undef,undef,'msg004030','msg004031'],
 ['URIBLIPRe','Bad URI IP\'s*',80,\&textinput,'','(\S*)','ConfigMakeIPRe',
  'Every IP in an URI and every IP resolved for a hostname in an URI is checked against this list of IP\'s or networks. For example:145.145.145.145|145.146.|1.2.0.0/16<br />
  This high security feature will follow the rules in URIBLWL, URIBLNP, URIBLLocal and URIBLISP - but if a match is found, it will block the email ( ignores scoring, monitoring, testmodes and spamlover ).',undef,undef,'msg009600','msg009601'],
 ['AddURIBLHeader','Add X-Assp-Received-URIBL Header',0,\&checkbox,1,'(.*)',undef,
  'Add X-Assp-Received-URIBL header to messages with positive reply from URIBL.',undef,undef,'msg004040','msg004041'],
 ['AddURIS2MyHeader','Add X-Assp-Detected-URI Header',0,\&checkbox,'','(.*)',undef,
  'URI\'s detected with URIBLOK are added to our header lines (X-Assp-Detected-URI:).',undef,undef,'msg009750','msg009751'],
 ['URIBLCacheInterval','URIBL Cache Refresh Interval for Hits',3,\&textinput,1,'(\d+\.?\d*|)','configUpdateURIBLCR',
  'Domains in cache will be removed after this interval in days. Empty or 0 will disable the cache. <input type="button" value=" Show URIBL Cache" onclick="javascript:popFileEditor(\'pb/pbdb.uribl.db\',5);" />',undef,undef,'msg004050','msg004051'],
 ['URIBLCacheIntervalMiss','URIBL Cache Refresh Interval for Misses',3,\&textinput,0.5,'(\d+\.?\d*|)','configUpdateURIBLCR',
  'Domains in cache with status=2 (miss) will be removed after this interval in days. Empty or 0 will prevent caching of non-hits. ',undef,undef,'msg004060','msg004061'],
 ['URIBLError','Reply Code to Refuse Failed URIBL Message',80,\&textinput,'554 5.7.1 Blacklisted by URIBLNAME Contact the postmaster of this domain for resolution. This attempt has been logged.','([245]5\d .*|)',undef,
  'SMTP reply code to refuse failed URIBL message. The literal URIBLNAME (case sensitive) is replaced by the names of URIBLs with negative response. If this field is empty, client connection is simply dropped.<br /><hr /><div class="menuLevel1">Notes On URIBL</div>
  <input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/uribl.txt\',3);" />',undef,undef,'msg004070','msg004071'],

[0,0,0,'heading','Attachment Blocking'],
['DoBlockExes','External Attachment Blocking ','0:disabled|1:block|2:monitor|3:score',\&listbox,0,'([\s0123]?)',undef,'This requires an installed <a href="http://search.cpan.org/search?query=Email::MIME" rel="external">Email::MIME</a> module in PERL.',undef,undef,'msg004080','msg004081'],
['BlockExes','External Attachment Blocking Level','0:Level 0|1:Level 1|2:Level 2|3:Level 3|4:Level 4',\&listbox,0,'([\s01234]?)',undef,
  'Set the level of Attachment Blocking to 1-3 for attachments that should be blocked, set level to 4  for attachments that should be allowed. Choose 0 for no attachment blocking.',undef,undef,'msg004090','msg004091'],
['BlockWLExes','Whitelisted &amp; Local Attachment Blocking','0:Level 0|1:Level 1|2:Level 2|3:Level 3|4:Level 4',\&listbox,0,'([\s01234]?)',undef,
  'Set the level of Attachment Blocking to 0-4 for whitelisted &amp; local senders. Choose 0 for no attachment blocking.',undef,undef,'msg004100','msg004101'],
['BlockNPExes','NoProcessing Attachment Blocking','0:Level 0|1:Level 1|2:Level 2|3:Level 3|4:Level 4',\&listbox,0,'([\s01234]?)',undef,
  'Set the level of Attachment Blocking to 0-4 for no processing senders. Choose 0 for no attachment blocking. ',undef,undef,'msg004110','msg004111'],
['BadAttachL1','Level 1 rejected File Extensions',80,\&textinput,'exe\-bin|exe|scr|pif|vb[es]?|jse?|ws[cfh]?|sh[sb]?|li?nk|bat|cmd|com|ht[ab]|ps1?','(.*)','updateBadAttachL1',
  'This regular expression is used to identify Level 1 attachments that should be blocked.<br />
  Separate entries with a pipe |. The dot . is assumed to precede these, so don\'t include it.<br />
  For example:<br />
  ad[ep]|asx|ba[st]|chm|cmd|com|cpl|crt|dbx|exe|exe\-bin|hlp|ht[ab]|in[fs]|isp|js|jse|lnk|md[abez]|mht|ms[cipt]|nch|pcd|pif|prf|ps1?|reg|sc[frt]|sh[bs]|vb|vb[es]|wms|ws[cfh]<br />
  If you\'ve installed the ASSP_AFC Plugin (at least version 2.10) and \'exe-bin\' is defined (on any level), the Plugin will detect executable files based on there binary content. Detected will be all executables, libraries and scripts for DOS and Windows (except .com files), MAC-OS and linux ELF (for all processor architectures).',undef,undef,'msg004120','msg004121'],
['BadAttachL2','Level 2 rejected File Extensions',80,\&textinput,'','(.*)','updateBadAttachL2',
  'This regular expression is used to identify Level 2 attachments that should be blocked.<br />
  Level 2 already includes all rejected extensions from Level 1. <br /> For example:<br /> (ad[ep]|asx|ba[st]|chm|cmd|com|cpl|crt|dbx|exe|hlp|ht[ab]|in[fs]|isp|js|jse|lnk|md[abez]|mht|ms[cipt]|nch|pcd|pif|prf|reg|sc[frt]|sh[bs]|vb|vb[es]|wms|ws[cfh]).zip',undef,undef,'msg004130','msg004131'],
['BadAttachL3','Level 3 rejected File Extensions',80,\&textinput,'','(.*)','updateBadAttachL3',
  'This regular expression is used to identify Level 3 attachments that should be blocked.<br />
  Level 3 includes Level 2 and Level 1.<br /> For example:<br /> zip|url',undef,undef,'msg004140','msg004141'],
['GoodAttach','Level 4 Allowed File Extensions',80,\&textinput,'','(.*)','updateGoodAttach',
  'This regular expression is used to identify attachments that should be allowed. All others are blocked. Separate entries with a pipe |. The dot . is assumed to precede these, so don\'t include it.<br /> For example:<br /> ai|asc|bhx|dat|docx?|eps|gif|htm|html|ics|jpg|jpeg|hqx|od[tsp]|pdf|ppt|rar|rpt|rtf|snp|txt|xls|zip|7z',undef,undef,'msg004150','msg004151'],

['UserAttach','User based Good and Bad Attachments*',40,\&textinput,'','(file:.+|)','updateUserAttach','This set of regular expression is used to identify attachments that should be allowed or blocked for specified users and/or domains. Separate entries with a any of \'=&gt; , ; space\'. Separate multiple regex entries with pipe \'|\'. The dot . is assumed to precede the regex, so don\'t include it anywhere (except the user name).<br />
  To define entries you have to use the \'file:...\' option. Define one entry per line - comments are not allowed in a definition line.<br />
  The syntax of an entry is as follows:<br />
  username => good => goodAttachRegex , good-out => goodoutRegex , good-in => goodinRegex , block => blockAttachRegex , block-out => blockoutRegex , block-in => blockinRegex<br />
  username - Mail solely to or from any of these addresses. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com) or a Group definition [GROUP]. Wildcards are supported (fribo*@domain.com).<br /><br />
  good => goodAttachRegex - good attachment for incoming and outgoing mails<br />
  good-out => goodoutRegex - good attachment for outgoing mails<br />
  good-in => goodinRegex - good attachment for incoming mails<br />
  block => blockAttachRegex - bad attachment for incoming and outgoing mails<br />
  block-out => blockoutRegex - bad attachment for outgoing mails<br />
  block-in => blockinRegex - bad attachment for incoming mails<br /><br />
  For example:<br />
  user@domain.tld => good => ai|asc|bhx|dat|doc|eps|gif|htm|html|ics|jpg|jpeg|hqx|od[tsp]|pdf|ppt|rar|rpt|rtf|snp|txt|xls|zip<br />
  *@domain.tld => good => ai|asc|bhx , good-out => eps|gif , good-in => htm|html , block => pdf|ppt , block-out => rar|rpt , block-in => xls|exe\-bin<br /><br />
  At least one of the above option must be defined in a line - a maximum of all (six) could be defined, if this makes sense.<br />
  If the user name matches for a sender or recipient and a (in/out) regex definition is found in this file, all level definition are overwritten for this mail.<br />
  good, good-out and good-in - and also - block, block-out and block-in - will be logical OR combined according to the mail flow.<br />
  Notice: if a bad attachment is found on a user based attachment check, the penalty box IP address scoring is skipped.',undef,undef,'msg009690','msg009691'],

['AttachmentError','Reply Code to Refuse Rejected Attachments',80,\&textinput,'550 5.7.1 These attachments are not allowed -- Compress before mailing.','([245]\d\d .*)',undef,'The literal \'FILENAME\' will be replaced with the name of the blocked attachment!',undef,undef,'msg004160','msg004161'],
['BlockUuencoded','Refuse Uuencoded Mails',0,\&checkbox,1,'(.*)',undef,'',undef,undef,'msg004170','msg004171'],
['UuencodedError','Reply to Refuse Uuencoded Mails',80,\&textinput,'554 5.7.1 This message is uuencoded and will be blocked. ','([25]\d\d .*)',undef,
 'For example: 554 5.7.1 This mail is uuencoded and will be blocked<br />
 <hr /><div class="menuLevel1">Notes On Attachment Blocking</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/Attachments.txt\',3);" />',undef,undef,'msg004180','msg004181'],

[0,0,0,'heading','ClamAV and FileScan'],
['noScan','Do Not Scan Messages from/to these Addresses*',60,\&textinput,'','(.*)','ConfigMakeSLRe','Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com).',undef,undef,'msg004190','msg004191'],
['noScanIP','Do Not Scan Messages from these IP\'s*',60,\&textinput,'','(\S*)','ConfigMakeIPRe','Enter IP addresses that you don\'t want to be scanned for virus , separated by pipes (|). For example: 145.145.145.145|145.146.',undef,undef,'msg004200','msg004201'],
['NoScanRe','Skip Virus RegEx*',80,\&textinput,'','(.*)','ConfigCompileRe',
 "Put anything here to identify messages which should not be checked for viruses.",undef,undef,'msg004210','msg004211'],
['SuspiciousVirus','No-Blocking Virus Scan Scoring Regex**',80,\&textinput,'file:files/suspiciousvirus.txt','(.*)','ConfigCompileRe',
 'If a ClamAV or FileScan result matches this expression it will be scored with the suspicious virus score ( vsValencePB ) and the message will not be blocked.<br />
 It is possible to weight such results. Every weighted regex that contains at least one \'|\' has to begin and end with a \'~\' - inside such regexes it is not allowed to use a \'~\', even it is escaped - for example:  ~abc\\~|def~=>23 or ~abc~|def~=>23 - instead use the octal (\\126) or hex (\\x7E) notation , for example ~abc\\126|def~=>23 or ~abc\\x7E|def~=>23 . Every weighted regex has to be followed by \'=>\' and the weight value. For example: <br />Phishing\\.=>1.45|~Heuristics|Email~=>50  <br />or <br />~(Email|HTML|Sanesecurity)\\.(Phishing|Spear|(Spam|Scam)[a-z0-9]?)\\.~=>4.6|Spam=>1.1|~Spear|Scam~=>2.1 . <br />The multiplication result of the weight and the penaltybox valence value will be used for scoring, if the absolute value of weight is less or equal 6. Otherwise the value of weight is used for scoring.',undef,undef,'msg004220','msg004221'],
['ScanWL','Scan Whitelisted Senders',0,\&checkbox,'1','(.*)',undef,'',undef,undef,'msg004230','msg004231'],
['ScanNP','Scan No Processing Senders',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg004240','msg004241'],
['ScanLocal','Scan Local Senders',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg004250','msg004251'],
['ScanCC','Scan Copied Spam Mails',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg004260','msg004261'],
['AvError','Reply Code to Refuse Infected Messages',80,\&textinput,'554 5.7.1 Mail appears infected with \[$infection\].','([25]\d\d .*)',undef,
 'Reply code to refuse infected messages. The string $infection is replaced with the name of the detected virus.<br />
 For example: 554 5.7.1 Mail appears infected with \[$infection\] -- disinfect and resend.',undef,undef,'msg004270','msg004271'],
['EmailVirusReportsTo','Send Virus Report To This Address',40,\&textinput,'','(.*)',undef,
 'If set an email containing the Message ID, Remote IP, Message Subject, Sender email address, Recipient email address, and the virus detected will be sent to this address. For example: admin@domain.com',undef,undef,'msg004280','msg004281'],
['EmailVirusReportsHeader','Add Full Header To Virus Report To Mail Address Above',0,\&checkbox,'','(.*)',undef,'If set the full message headers will also be added to Virus Reports.',undef,undef,'msg004290','msg004291'],
['EmailVirusReportsToRCPT','Send Virus Report To Recipient',0,\&checkbox,'','(.*)',undef,'If set the intended recipient of the message will be sent a copy of the Virus Report.<hr />',undef,undef,'msg004300','msg004301'],
['DoFileScan','Use File System Virus Scanner','0:disabled|1:block|2:monitor',\&listbox,0,'(\d*)',undef,
 'If activated, the message is written to a file inside the \'FileScanDir\' with an extension of \'maillogExt\'. After that ASSP will call \'FileScanCMD\' to detect if the temporary file is infected or not. The temporary created file(s) will be removed.<br />
 The viruses will be stored in a special folder if the SpamVirusLog is set to \'quarantine\' and the filepath to the viruslog is set.',undef,undef,'msg004310','msg004311'],
['FileScanDir','File Scan Directory',80,\&textinput,"$base/virusscan",'(.*)','',
 'Define the full path to the directory where the messages are temporary stored for the file system virus scanner. This could be any directory inside your file system. The running ASSP process must have full permission to this directory and the files inside!',undef,undef,'msg004320','msg004321'],
['FileScanCMD','File Scan Command',80,\&textinput,'','(.*)','',
 'ASSP will call this system command and expects a returned string from this command. This returned string is checked against \'FileScanBad\' and/or \'FileScanGood\' to detect if the message is OK or not! If the file does not exists after the command call, the message is consider infected. ASSP expects, that the file scan is finished when the command returns!<br />
  The literal \'FILENAME\' will be replaced by the full qualified file name of the temporary file.<br />
  The literal \'NUMBER\' will be replaced by the threadnumber and could be used to name logfiles and to redirect them to STDOUT.<br />
  The literal \'FILESCANDIR\' will be replaced with the value of FileScanDir.<br />
  Any case sensitive literal starting and ending with an asterix (*) like \'*rcpt*\' or \'*mailfrom*\' will be replaced by the quoted runtime connection variable of Con{fh}->{literal} (this->{literal}). You need to know the assp internals!<br />
  If a code reference is defined for the internal variable &#36;main::FileScanCMDbuild_API in lib/CorrectASSPcfg.pm , assp will call \'&#36;FileScanCMDbuild_API->(\\&#36;cmd,&#36;this)\' before running the command. The first parameter, the command (FileScanCMD), is submitted as a reference to a scalar, which must be modified in place. If you want assp not to scan the message, set this variable to undef. The second submitted parameter is the reference to the client connection parameter HASH - &#36;Con{fh} (eg. &#36;this)<br />
  All outputs of this command to STDERR are automatic redirected to STDOUT.<br />
  FileScan will not run, if FileScanCMD is not specified.<br />
  If you have your online/autoprotect file scanner configured to delete infected files inside the \'FileScanDir\', define \'NORUN\' in this field! In this case FileScanGood and FileScanBad are ignored. If there is a need to wait some time for the autoprotect scanner, write \'NORUN-dddd\', where dddd are the milliseconds to wait!<br />
  Depending on your operating system it may possible that you have to quote (\' or ") the command, if it contains whitespaces. The replaced file name will be quoted by ASSP if needed.',undef,undef,'msg004330','msg004331'],
['FileScanBad','RegEx to Detect \'BAD\' in Returned String*',80,\&textinput,'','(.*)','ConfigCompileRe',
 'Put anything here to identify bad messages by the string returned from the FileScanCMD. If defined and this regular expression matches, the message is consider infected.',undef,undef,'msg004340','msg004341'],
['FileScanGood','RegEx to Detect \'GOOD\' in Returned String*',80,\&textinput,'','(.*)','ConfigCompileRe',
 'Put anything here to identify good messages by the string returned from the FileScanCMD. If defined and this regular expression matches and \'FileScanBad\' does not, the message is consider not infected.<br />
   If both FileScanBad and FileScanGood are defined, FileScanBad has not to match and FileScanGood has to match, to consider a mail not infected!',undef,undef,'msg004350','msg004351'],
['FileScanRespRe','FileScan Reponds Regex*',60,\&textinput,'','(.*)','ConfigCompileRe',
 'A regular expression that will be used over the text returned from the FileScanCMD. The result of this regex is used as virus name ($infection) in AvError. For example: infected by .+? \.\&lt;hr \/\&gt;',undef,undef,'msg004360','msg004361'],
['UseAvClamd','Use ClamAV',0,\&checkbox,0,'(.*)',undef,
 'If activated, the message is checked by ClamAV, this requires an installed File::Scan::ClamAV Perl module and a running Clamd . It is not recommended to use ClamAV on heavy-load systems, because of resulting system overload, stucking workers or timeouts.<br />
 The viruses will be stored in a special folder if the SpamVirusLog is set to \'quarantine\' and the filepath to the viruslog is set.',undef,undef,'msg004370','msg004371'],
['AvClamdPort','Port or file socket for ClamAV',30,\&textinput,'','(\S+|)',undef,
 'A socket specified in the clamav.conf file - LocalSocket. For example /tmp/clamd. If the socket has been setup as a TCP/IP socket (see the TCPSocket option in the clamav.conf file), then specify the TCP socket. For example: 3310 ',undef,undef,'msg004380','msg004381'],
['ClamAVBytes','ClamAV Bytes',8,\&textinput,60000,'(\d*)',undef,
  'The number of bytes per message that will be submited to ClamAV and FileScan for virus scanning. Values of 100000 or larger are not recommended, because while a thread is waiting for the scanner result, it could not get new connections.',undef,undef,'msg004390','msg004391'],
['ClamAVtimeout','ClamAV Timeout',3,\&textinput,10,'(\d+)',undef, 'ClamAV will timeout after this many seconds.<br /> default: 10 seconds.
 <hr /><div class="menuLevel1">Notes On Virus Control</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/viruscontrol.txt\',3);" />',undef,undef,'msg004400','msg004401'],

[0,0,0,'heading','Regex Filter / Spambomb <a href="http://apps.sourceforge.net/mediawiki/assp/index.php?title=Regular_Expressions" target=wiki><img height=12 width=12 src="' . $wikiinfo . '" alt="bombRe" /></a>'],
['AllowInternalsInRegex','Allow Internal Variables in Regex',0,\&checkbox,'','(.*)',undef,'Allow internal variables to be used in regular expressions - replaces something like \${$EmailDomainRe} with the value of $EmailDomainRe',undef,undef,'msg009770','msg009771'],
['preHeaderRe','Regular Expression to early Identify Spam in Handshake and Header Part*',80,\&textinput,'file:files/preheaderre.txt','(.*)','ConfigCompileRe',
 'Until the complete mail header is received, assp is processing the handshake and header content line per line, but the first mail content check is done after the complete mail header is received.<br />
 It is possible, that some content (malformed headers, forbidden characters or character combinations) could cause assp to die or to run in to a unrecoverable exception.<br />
 Use this regular expression to identify such incoming mails based on a line per line check, at the moment where a single line is received.<br />
 This setting does not affect any other and is not affected by any other configuration setting, except that this check is only done for incoming mails.<br />
 If a match is found, assp will immediately send a \'421 <myName> closing transmission\' reply to the client and will immediately terminate the connection.<br />
  Default setting is file:files/preheaderre.txt',undef,undef,'msg008890','msg008891'],
['bombReWL','Do Bomb/Script Regular Expressions Checks for Whitelisted',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg004410','msg004411'],
['bombReNP','Do Bomb/Script Regular Expressions Checks for NoProcessing',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg004420','msg004421'],
['bombReLocal','Do Bomb/Script Regular Expressions Checks for Local Messages',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg004430','msg004431'],
['bombReISPIP','Do Bomb/Script Regular Expressions Checks for ISPIP',0,\&checkbox,'1','(.*)',undef,'',undef,undef,'msg004440','msg004441'],

['bombMaxPenaltyVal','Maximum Penalty on Bombs per Mail per Check',3,\&textinput,70,'(\d*)',undef, 'Depending on the configuration, it could be possible that a message gets a very high penalty value on a bomb-check. This value limits the maximum penalty per mail for every single bomb-check that is enabled.',undef,undef,'msg004450','msg004451'],
['maxBombSearchTime','Maximum time spend on Bomb Search',3,\&textinput,5,'(\d*)',undef, 'Maximum time in seconds that is spend on every configured bomb check. This time check is done, after every found bomb. So it is possible that the bomb search takes longer as the defined value, if no bomb is found or a single search takes more time. Default is 5.
  <hr><hr>
  <span class="negative">Even if any of the following bomb parameters is set to "block", but the sum of the resulting weighted penalty value is less than the corresponding "Penalty Box Valence Value" (because of lower weights) - only scoring will be done!<br />
  A description of how of weighting regular expressions is done and working, could be found at the bottom this web page.</span><hr>',undef,undef,'msg004460','msg004461'],
['DoTransliterate','Transliterate non-Roman characters in to Roman',0,\&checkbox,'','(.*)',undef,
'If enabled, ASSP tries to transliterate non-Roman characters in an email it to Roman characters. These transliterations are than additionaly used in the bomb checks.<br />
 For example - the (character) sequence \'&#24180;&#20809;&#36890;&#20449;&#20135;&#19994;&#20250;&#22238;&#24402;&#39640;&#22686;&#38271;&#36712;&#36947;\' will be transliterated to \'Nian Guang Tong Xin Chan Ye Hui Hui Gui Gao Zeng Chang Gui Dao\' .<br />
 To transliterate something, use the \'Mail Analyzer\'.<br />
 To make this feature working, the Perl module <a href="http://search.cpan.org/search?query=Text::Unidecode" rel="external">Text::Unidecode</a> must be installed.',undef,undef,'msg00009990','msg009991'],
['DoBombHeaderRe','Use BombHeader Regular Expressions on Header Part','0:disabled|1:block|2:monitor|3:score|4:testmode',\&listbox,1,'(\d*)',undef,
  'If activated, each message-header is checked  against bombSenderRe, bombHeaderRe, bombSubjectRe and bombCharSets Regular Expressions. If you use sendAllSpam, be aware that only the header will be shown in the spamcopy.<br />
  The scoring value is the sum of all valences(weights) of all found bombs - bombValencePB .',undef,undef,'msg004470','msg004471'],
['bombSenderRe','Envelope Blocking Regular Expression **',80,\&textinput,'emailserver3\.com|\d\d\d\d\d\d\@tom\.com','(.*)','ConfigCompileRe',
  'Part of DoBombHeaderRe: expression to identify sender (mailfrom,ip,helo).',undef,undef,'msg004480','msg004481'],
['bombHeaderRe','Regular Expression to Identify Spam in Header Part**',80,\&textinput,'file:files/bombheaderre.txt','(.*)','ConfigCompileRe',
  'Part of DoBombHeaderRe: header will be checked against this Regex if DoBombHeaderRe is enabled. For example<br /> file:files/bombheaderre.txt',undef,undef,'msg004490','msg004491'],
['bombSubjectRe','Regular Expression to Identify Spam in Subject**',80,\&textinput,'','(.*)','ConfigCompileRe','Part of DoBombHeaderRe : the mail header will be checked against this Regex if  DoBombHeaderRe  is enabled.',undef,undef,'msg004500','msg004501'],
['maxSubjectLength','Maximum allowed Subject Length',20,\&textinput,'200=>100','^(\d+(?:\=\>\d+)?|)$',undef,'If set to a value greater than 0, assp will check the length of the Subject of the mail. If the Subject length exceeds this value, the message score will be increased by \'bombValencePB\' and the string that is checked in \'bombSubjectRe\' will be trunked to this length. It is possible to define a special weight using the syntax \'length=>value\', in this case the defined absolute value will be used instead of \'bombValencePB\' to increase the message score. If the subject is too long and this weight is equal or higher than \'bombMaxPenaltyVal\' no further bomb checks will be done on the subject.',undef,undef,'msg009360','msg009361'],
['bombCharSets','Regular Expression to Identify Foreign Charsets**',60,\&textinput,'charset=(?:BIG5|CHINESEBIG|GB2312|KS_C_5601|KOI8-R|EUC-KR|ISO-2022-JP|ISO-2022-KR|ISO-2022-CN|CP1251)','(.*)','ConfigCompileRe','Part of DoBombHeaderRe: header will be checked against this Regex if DoBombHeaderRe is enabled.<br />
  Part of DoBombRe : every MIME-part header will be checked against this Regex if DoBombRe is enabled.<br />
 For example:<br /> charset=(?:BIG5|CHINESEBIG|GB2312|KS_C_5601|KOI8-R|EUC-KR|ISO-2022-JP|ISO-2022-KR|ISO-2022-CN|CP1251). ',undef,undef,'msg004510','msg004511'],
['bombHeaderReMaxHits','Maximum Hits for Bombs in Header and Sender',3,\&textinput,1,'(\d*)',undef,'A hit is a found Bomb in header and sender - bombSenderRe , bombHeaderRe , bombSubjectRe , bombCharSets .<br />
  If the number of hits is greater or equal Maximum Hits, the email is flagged <b>Failed</b> (possibly blocked and/or scored).<br />
  If the number of hits is greater 0 and less Maximum Hits, the email is flagged <b>Neutral</b> (possibly scored)',undef,undef,'msg004520','msg004521'],
['DoBombRe','Use Bomb Regular Expressions','0:disabled|1:block|2:monitor|3:score',\&listbox,1,'(\d*)',undef,
  'If activated, each message is checked  against bombRe and BombData Regular Expressions.<br />
  The scoring value is the sum of all valences(weights) of all found bombs - bombValencePB .',undef,undef,'msg004530','msg004531'],
['bombRe','Regular Expression for Header and Data Part**',80,\&textinput,'file:files/bombre.txt','(.*)','ConfigCompileRe','Header and Data will be checked against this Regular Expression if DoBombRe is enabled.  For example:<br />IMG [^&gt;]*src=[\'&quot;]cid|&lt;BODY[^&gt;]*&gt;(&lt;[^&gt;]+&gt;|\n|\r)*&lt;IMG[^&gt;]+&gt;(&lt;[^&gt;]+&gt;|\n|\r)*&lt;/BODY&gt;<br />
 If you want to search for attachment names, define a line with \'attachment:the_attachment_name\'.',undef,undef,'msg004540','msg004541'],
['bombSkipHeaderTagRe','Regular Expression to Identify skipped Tags in Header Part*',80,\&textinput,'file:files/bombskipheadertagre.txt','(.*)','ConfigCompileRe',
  'Regular Expression to define header tags, that will be skipped for bombSuspiciousRe, bombHeaderRe, bombRe and blackRe - like \'DKIM-Signature|Domainkey-Signature\' - the always followed collon (:) is added by assp. For example<br /> file:files/bombskipheadertagre.txt',undef,undef,'msg009980','msg009981'],
['bombReMaxHits','Maximum Hits for Bombs in Header and Data',3,\&textinput,1,'(\d*)',undef,'A hit is a found Bomb in header and data - bombRe .<br />
  If the number of hits is greater or equal Maximum Hits, the email is flagged <b>Failed</b> (possibly blocked and/or scored).<br />
  If the number of hits is greater 0 and less Maximum Hits, the email is flagged <b>Neutral</b> (possibly scored)',undef,undef,'msg004550','msg004551'],
['bombDataRe','BombData Regular Expression for Data Part**',80,\&textinput,'','(.*)','ConfigCompileRe','Data part will be checked against the Regular Expression  if DoBombRe is enabled. For example:<br />IMG [^&gt;]*src=[\'&quot;]cid|&lt;BODY[^&gt;]*&gt;(&lt;[^&gt;]+&gt;|\n|\r)*&lt;IMG[^&gt;]+&gt;(&lt;[^&gt;]+&gt;|\n|\r)*&lt;/BODY&gt;<br />
  If you want to search for attachment names, define a line with \'attachment:the_attachment_name\'.',undef,undef,'msg004560','msg004561'],
['bombDataReMaxHits','Maximum Hits for Bombs in Data',3,\&textinput,1,'(\d*)',undef,'A hit is a found Bomb in data - bombDataRe .<br />
  If the number of hits is greater or equal Maximum Hits, the email is flagged <b>Failed</b> (possibly blocked and/or scored).<br />
  If the number of hits is greater 0 and less Maximum Hits, the email is flagged <b>Neutral</b> (possibly scored)',undef,undef,'msg004570','msg004571'],
['bombSuspiciousRe','Suspicious Expression for Scoring Only**',80,\&textinput,'','(.*)','ConfigCompileRe','Sender, Header and Data will be checked for scoring only. Put here anything which might be suspicious. bombSuspiciousValencePB will be used to increase the score. For example:<br />unsubscribe',undef,undef,'msg004580','msg004581'],
['noBombScript','Don\'t Check Messages from these Addresses*',80,\&textinput,'','(.*)','ConfigMakeSLRe',
  'Don\'t detect spam bombs or scripts in messages from these addresses. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com).',undef,undef,'msg004590','msg004591'],
['DoTestRe','Do Test Regular Expression',0,\&checkbox,0,'(.*)',undef,
  'If activated, each message is checked  against the Test Regular Expression below. This provides a way to test regex strings on live mail.',undef,undef,'msg004600','msg004601'],
['testRe','Test Regular Expression**',80,\&textinput,'','(.*)','ConfigCompileRe','Use this to test your regular expressions. Test valence is teValencePB .',undef,undef,'msg004610','msg004611'],
['bombError','Spam Bomb Error',80,\&textinput,'554 5.7.1 Delivery not authorized, message refused -- .','^([245]\d\d .*|)$',undef,
  'SMTP error message to reject spam bombs. For example: 554 5.7.1 Delivery not authorized, message refused -- send report to mailto:postmaster@mydomain.tld or call +12.34.56.78.90',undef,undef,'msg004620','msg004621'],
['bombErrorReason','Add Reason',0,\&checkbox,1,'(.*)',undef,
  'Add matching expression to Spam Bomb Error',undef,undef,'msg004630','msg004631'],
['DoBlackRe','Use Black Regular Expression to Identify Spam Strictly','0:disabled|1:block|2:monitor|3:score',\&listbox,0,'(\d*)',undef,
  'Each incoming message is checked  against the BlackRe to Identify Spams. No Optout. <br />
  The scoring value is the sum of all valences(weights) of all found bombs - blackValencePB .',undef,undef,'msg004640','msg004641'],
['blackRe','BlackRe - Regular Expression to Identify Spam Strictly**',80,\&textinput,'file:files/blackre.txt','(.*)','ConfigCompileRe',
  'If an incoming email matches this Perl regular expression it will be strictly considered spam . For example: \breplica watches\b|\bMegaDik\b|\bcock\b|\bpenis\b|\bpills\b|\bOriginal Viagra\b|\bbetter sex life\b|\baverage penis\b|\benlargement\b|\borgasm\b|\berections\b|\bViagra\b|\bbig dick\b|\bsperma\b|\bSexual\b|\bErectionsk\b|\bStamina\b|\bsildenafil\b|\bcitrate\b|\bErectile\b',undef,undef,'msg004650','msg004651'],
['blackReMaxHits','Maximum Hits for Identify Spam Strictly',3,\&textinput,1,'(\d*)',undef,'A hit is a found Bomb for Identify Spam Strictly. - blackRe <br />
  If the number of hits is greater or equal Maximum Hits, the email is flagged <b>Failed</b> (possibly blocked and/or scored).<br />
  If the number of hits is greater 0 and less Maximum Hits, the email is flagged <b>Neutral</b> (possibly scored)',undef,undef,'msg004660','msg004661'],

['DoScriptRe','Use Regular Expression to Identify Mobile Scripts','0:disabled|1:block|2:monitor|3:score',\&listbox,0,'(\d*)',undef,
  'Each message is checked  against the Expression to Identify Mobile Scripts.<br />
  The scoring value is the sum of all valences(weights) of all found bombs - scriptValencePB .',undef,undef,'msg004670','msg004671'],
['scriptRe','Regular Expression to Identify Mobile Scripts**',80,\&textinput,'','(.*)','ConfigCompileRe',
  'Spam mails may contain mobile scripting code, eg activex and java or php. You can use this feature to block those messages.<br />
  Leave this blank to disable the feature. For example:<br /> \&lt;applet|\&lt;embed|\&lt;iframe|\&lt;object|\&lt;script|\&lt;?php|onmouseover|onload|onfocus|onblure|onclick|javascript:',undef,undef,'msg004680','msg004681'],
['scriptReMaxHits','Maximum Hits for Identify Mobile Scripts',3,\&textinput,1,'(\d*)',undef,'A hit is a found mobile scripting code for Identify Mobile Scripts - scriptRe .<br />
  If the number of hits is greater or equal Maximum Hits, the email is flagged <b>Failed</b> (possibly blocked and/or scored).<br />
  If the number of hits is greater 0 and less Maximum Hits, the email is flagged <b>Neutral</b> (possibly scored)',undef,undef,'msg004690','msg004691'],

['scriptError','Script Error',80,\&textinput,'554 5.7.1 Your email contains html scripting code -- please resend as plain text.','^([245]\d\d .*|)$',undef,
  'SMTP error message to reject scripts. For example: 554 5.7.1 Your email appears to be spam -- send an error report to mailto:postmaster@mydomain.tld or call +12.34.56.78.90
  <br /><hr /><div class="menuLevel1">Notes On Bomb Regex</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/bombre.txt\',3);" />',undef,undef,'msg004700','msg004701'],

[0,0,0,'heading','Bayesian and Hidden Markov Model (HMM) Options <a href="http://apps.sourceforge.net/mediawiki/assp/index.php?title=ASSP_Bayesian_Filter" target=wiki><img height=12 width=12 src="' . $wikiinfo . '" alt="Theory of Operation" /></a>'],
['DoBayesian','Bayesian Check <a href="http://apps.sourceforge.net/mediawiki/assp/General_ASSP_Questions#Theory_of_Operation" target=wiki><img height=12 width=12 src="' . $wikiinfo . '" alt="Theory of Operation" /></a>','0:disabled|1:block|2:monitor|3:score',\&listbox,0,'(.*)',undef,
  'If activated, the message is checked based on Bayesian factors in spamdb for global and private entries. Private spamdb entries have a five times higher weight than global entries. This needs a fully functional spamdb built by rebuildspamdb. For starters it is best practice to put this inactiv and built the spamdb collection with the help of DSNBL ,URIBL and spamaddresses. Scoring is done with baysValencePB for external mails, baysValencePB_local is used for outgoing and internal mails - both values are multiplied with the detected baysProbability .<br />
  Both, the Bayesian-check and the Hidden-Markov-Model-check (below), are using Perl version depending (Perl 5.12 and higher) <a href=\"http://unicode.org/charts/\" rel=\"external\">Unicode</a> features to recognize any possible character. How ever, some east asian languages (and some others) have graphemes, that contains multiple <a href=\"http://en.wikipedia.org/wiki/Unicode\" rel=\"external\">unicode code points</a>. If you need (or want) assp to process all text as a sequence of <a href=\"http://unicode.org/reports/tr29/\" rel=\"external\">UAX #29 Grapheme Clusters</a>, the Perl module <a href=\"http://search.cpan.org/dist/Unicode::LineBreak/\" rel=\"external\">Unicode::LineBreak</a> is required.',undef,undef,'msg004710','msg004711'],
['DoHMM','Hidden Markov Model Check <a href="http://apps.sourceforge.net/mediawiki/assp/General_ASSP_Questions#Theory_of_Operation" target=wiki><img height=12 width=12 src="' . $wikiinfo . '" alt="Theory of Operation" /></a>','0:disabled|1:block|2:monitor|3:score',\&listbox,0,'(.*)',undef,
  "If activated, the message is checked based on a <a href=\"http://en.wikipedia.org/wiki/Hidden_Markov_model\">Hidden Markov Model</a>  for global and private entries.  Private HMM entries have a five times higher weight than global entries. This needs a fully functional HMMdb database built by rebuildspamdb. For starters it is best practice to put this in monitoring mode and built the HMM collection with the help of DSNBL ,URIBL and spamaddresses. Scoring is done with HMMValencePB for external mails, HMMValencePB_local is used for outgoing and internal mails. <br />
  The perl module <a href=\"http://search.cpan.org/dist/BerkeleyDB/\" rel=\"external\">BerkeleyDB</a> version 0.34 or higher and BerkeleyDB version 4.5 or higher is required (to store temporary data) to use this feature and 'useDB4Rebuild' and 'useBerkeleyDB' must be set to ON.<br />
  If this option is disabled, the rebuildspamdb task will <b>NOT</b> build a valid HMM database!<br />
  Compared to the Bayesian option, the Hidden Markov Model will produce results that are much more exact. How ever, it is possible, that HMM gets no result on very small messages, for this reason it is recommended to use both Bayesian and HMM. If you enable both checks, check your settings for baysValencePB, HMMValencePB, bayslocalValencePB and HMMlocalValencePB - eg. divide them by 2. or set the bayes values to 1/3 and the HMM values to 2/3.<br />
  NOTICE that using this option requires a <b>very fast database server</b> behind, if HMMusesBDB is set to OFF. The Bayesian- and HMM check together can produce <b>4000 and much more SQL querys per second</b>.<br />
  Keep in mind, that all backups and exports of the HMM database could require several 100MB of diskspace, if the file count in the corpus is very large.",undef,undef,'msg001230','msg001231'],
['ignoreDBVersionMissMatch','Ignore a database version missmatch','0:disabled|1:Spamdb|2:HMMdb|3:Spam and HMMDB',\&listbox,0,'(.*)',undef,
  'The status of assp is changed to "not healthy" if the current version of any of Spamdb or HMMdb is not equal to the required database version. Such a missmatch is automaticaly corrected with the next successfull rebuildspamdb. How ever, if you are unable to solve this problem for any reason, you should set this value to keep the status of assp "healthy".',undef,undef,'msg009940','msg009941'],
['HMMusesBDB','Use BerkeleyDB for the Hidden Markov Model database',0,\&checkbox,1,'(.*)',undef,"If enabled (default), the Hidden Markov Model database uses BerkeleyDB - notice: in this case no database import, backup or export are provided for the HMMdb. This value is completely ignored, if DBdriver is set to 'BerkeleyDB' and spamdb is set to 'DB:'. Switch this parameter to OFF, if you want to use the same database engine for the HMMdb like spamdb is configured. <br />
  <span class=\"negative\">Changing this value requires a restart of assp. Possibly a forced rebuildspamdb is required after the restart.</span>",undef,undef,'msg001240','msg001241'],
['DoPrivatSpamdb','Use also private entries for the Bayesian Spamdb and Hidden Markov Model databases','0:NO|1:for users only|2:for domains only|3:for users and domains',\&listbox,0,'(.*)','ConfigChangeDoPrivatSpamdb','If enabled, private entries (based on the local recipient and/or the report sender email address) will be added to the Bayesian and HMM databases. These private entries have a three times higher priority for users (full email address) and two times higher priority for domains (domain part of the email address) than global entries. To enable this option "spamdb" must be set to use a database "DB:" first!<br />
 <b>Setting this option to ON, will increase the record count for the spamdb and the HMM databases dramaticaly!</b>',undef,undef,'msg009630','msg009631'],
['BayesMaxProcessTime','Bayesian and HMM Check Timeout ',3,\&textinput,'15','(\d+)',undef,'The Bayesian- and HMM Checks are the most memory and CPU consuming tasks that ASSP is doing on a message. If such tasks running to long on one message, other messages could run in to SMTPIdleTimeout. Define here the maximum time in seconds that ASSP should spend on Bayesian Checks for one message. Default is 60.',undef,undef,'msg004720','msg004721'],
['BayesWL','Bayesian/HMM Check on Whitelisted Senders/Messages',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg006120','msg006121'],
['BayesNP','Bayesian/HMM Check on NoProcessing Messages',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg007420','msg007421'],
['noBayesian','Skip Bayesian and HMM Check*',60,\&textinput,'','(.*)','ConfigMakeSLRe',
 'Mail from/to any of these addresses are ignored by Bayesian- and HMM check, mails will not be stored in spam/notspam collection. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com)',undef,undef,'msg004730','msg004731'],
['noBayesian_local','Skip Bayesian and HMM Check for this local senders*',60,\&textinput,'','(.*)','ConfigMakeSLRe',
 'Mail from any of these local addresses are ignored by Bayesian- and HMM checks, mails will not be stored in spam/notspam collection. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com)',undef,undef,'msg009570','msg009571'],
['Bayesian_localOnly','Do Bayesian and HMM Check ONLY for this local senders*',60,\&textinput,'','(.*)','ConfigMakeSLRe',
 'Only mail from any of these local addresses are processed by the Bayesian- and HMM checks, except they are also defined in noBayesian_local . Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com)',undef,undef,'msg009010','msg009011'],
['maxBayesValues','Maximum most significant results used per mail to calculate Bayesian- and HMM-Probability',3,\&textinput,'60','([3-9]\d|\d{3})',undef,'Maximum count of most significant values used to calculate the Bayesian/HMM-Spam-Probability and the confidence of that probability.<br />
 The Bayesian/HMM Spam Probability will be fine with 30 and will get more exact, than higher this value is - until a value of 60.<br />
 The confidence of the Bayesian/HMM Spam Probability will get better, than higher this value is.<br />
 Values above 60 are possible, but could lead in to a performance penalty, without getting a better spam detection.
 Default is \'60\', minimum is \'30\'.',undef,undef,'msg007890','msg007891'],
['baysProbability','Bayesian and HMM Probability Threshold ',3,\&textinput,'0.6','(0\.\d+)',undef,' Messages with spam-probability below or equal this threshold are considered Ham. Recommended \'0.6\'.<br />
 An resulting Spam-Probability above this value is multiplied with baysValencePB_local or baysValencePB to get the penaltybox scoring value for the IP- and message score. In other words, the penaltybox scoring value is weighted by the Spam-Probability in case Spam is detected.<br />
 An resulting Spam-Probability below this value but higher than ( 1 - baysProbability ) is stated as \'UNSURE\' . In this case the half score will be added to the message score but not to the IP score and the message will not be blocked.<br /><br />
 The following default Bayesian math (prob = p1 / (p1 + p2)) is used to calculate the SpamProb value for \'n\' found Bayesian-Word-Pairs or HMM-Sequences, each with a spam-weight \'p\' - where 0&lt;p&lt;1 :<br /><br />
 \'SpamProb\' = (p<sub>1</sub> * p<sub>2</sub> * ... * p<sub>n</sub>) / ( p<sub>1</sub> * p<sub>2</sub> * ... * p<sub>n</sub>  + (1 - p<sub>1</sub>) * (1 - p<sub>2</sub> ) * ... * (1 - p<sub>n</sub>))<br />',undef,undef,'msg004740','msg004741'],
['baysConf','Bayesian and HMM Confidence Threshold',3,\&textinput,'0','(0\.?\d*)',undef,' Spam-Mails having a confidence below this threshold are passed in TestMode .
 Spam-Mails having a confidence above this threshold are blocked. Set this only above 0 if you are familiar with the bayesian statistics used in ASSP.<br />
 Messages that are processed by the bayesian and HMM check get a spam-probability score and a confidence score. The confidence score in assp is a quality indicator. A confidence near 0 would mean the probability score is like a wild guess. A confidence score near 1 would mean that it\'s pretty sure that the bayesian analysis result is correct. The confidence threshold is an allowance to process a Bayesian/HMM Spam as-if in Bayesian TestMode, if the message\'s *confidence* score is lower than the confidence threshold.
 Set this level to a specfic value, let\'s say .001 (which is a good one for starting), then:<br />
 - messages with spam-probability higher than 0.6 and a confidence of less than .001 would come through as in test mode<br />
 - messages with spam-probability higher than 0.6 and a confidence of more than .001 would be blocked<br />
 - messages with spam-probability less than 0.6 would pass<br />
 The 0.6 threshold can be set in baysProbability .<br />
 Carefully set this parameter above 0, if the bayesian corpus norm (shown by the rebuildspamdb log) is less than 0.6 or higher than 1.4 .<br /><br />
 The following math is used to calculate the SpamProbConfidence value for \'n\' found Bayesian-Word-Pairs or HMM-Sequences, each with a spam-weight \'p\' - where 0&lt;p&lt;1 :<br /><br />
 extreme_confidence_count = |(0 &lt; p<sub>1...n</sub> &lt; 0.01)| - |(0.99 &lt; p<sub>1...n</sub> &lt; 1)|<br />
 extreme_confidence_count = 0 - if ( extreme_confidence_count &lt; 0 and SpamProb &gt; 0.5) or ( extreme_confidence_count &gt; 0 and SpamProb &lt;= 0.5) == TRUE; <br />
 extreme_confidence_count = abs( extreme_confidence_count )<br />
 mail_confidence = abs((P<sub>1</sub> * P<sub>2</sub> * ... * P<sub>k</sub>) - ((1 - P<sub>1</sub>) * (1 - P<sub>2</sub> ) * ... * (1 - P<sub>k</sub>))) - for all elements P<sub>1...k</sub> in (0.01 &lt; p<sub>1...n</sub> &lt; 0.99)<br />
 corpus_confidence = 1 / ((abs(1 - corpus_norm) + 1)<sup>int(abs(1 - corpus_norm) * 10)</sup>) - the exponent is limited to a maximum of 4<br />
 SpamProbConfidence = 0.01<sup>extreme_confidence_count</sup> * mail_confidence * corpus_confidence * (n / maxBayesValues)<sup>2</sup><br /><br />
 The SpamProbConfidence is limited to a maximum of 1.0 . <br />
 All extreme values \'p\' having a spam weight less than 0.01 or higher than 0.99 with a corresponding extreme value like (0.009 &lt;-&gt; 0.999) are ignored for the mail_confidence calculation.<br /><br />
 <span class="negative"> empty or zero = disabled</span>.',undef,undef,'msg004750','msg004751'],
['baysConfidenceHalfScore','Reduce Scoring for Low Confidence',0,\&checkbox,1,'(.*)',undef,
 'Spam-Mails having a confidence below the threshold, will get half of the normal penalty score for Bayesian and HMM hits.',undef,undef,'msg004760','msg004761'],
['NoTagInTestmode','No Subject Tag in Testmode',0,\&checkbox,'','(.*)',undef,
  'In Bayesian TestMode "/Prepend Spam Subject/" is only added if the message is Spam and confidence is higher than Bayesian Confidence Threshold" .',undef,undef,'msg004770','msg004771'],
['AddSpamProbHeader','Add Bayes and HMM Probability Header',0,\&checkbox,'','(.*)',undef,
 'Adds a line to the email header "X-Assp-Spam-Prob: 0.0123" and/or "X-Assp-HMM-Spam-Prob: 0.0123" Probability ranges from 0 to +1 where > 0.6 = spam.',undef,undef,'msg004780','msg004781'],
['AddConfidenceHeader','Add Bayes and HMM Confidence Header',0,\&checkbox,'','(.*)',undef,
  'Adds a line to the email header "X-Assp-Bayes-Confidence: 0.0123" and/or "X-Assp-HMM-Confidence: 0.0123".<br /><hr />
  <div class="menuLevel1">Notes On Bayesian</div>
  <input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/bayesian.txt\',3);" />',undef,undef,'msg004790','msg004791'],

[0,0,0,'heading','Backscatter Detection'],
['DoMSGIDsig','Do Message-ID tagging and validating (FBMTV)','0:disabled|1:block|2:monitor|3:score|4:testmode',\&listbox,0,'(\d*)',undef,
  'If activated, the message-ID of each outgoing message will be signed with a unique Tag and every incoming mail from null sender, bounced or postmaster will be checked against this Tag. This tagging mode is called FBMTV "Forwarder(s) Bounce Message-ID Tag Validation" and it is worldwide unique to ASSP. This Tag is build nearly the same way, as BATVTag is build for the sender address. This Tag will be removed from any incoming email, to recover the original references in the mail header! If anything is changed on this option inside the mail, no DKIM-check will be done! Before activating DoMSGIDsig, please configure MSGIDpreTag and MSGIDsec!<br />
  This check requires an installed <a href="http://search.cpan.org/search?query=Digest::SHA1" rel="external">Digest::SHA1</a> module in Perl.',undef,undef,'msg004800','msg004801'],
['MSGIDpreTag','Message-ID pre-Tag for MSGID-TAG-generation',10,\&textinput,'sig','([a-zA-Z0-9]{2,5})',undef,'To use Message-ID signing and to create the MSGID-Tags, a pre-Tag is needed. This Tag must be 2-5 characters [a-z,A-Z,0-9] long. Default is \'sig\'.',undef,undef,'msg004810','msg004811'],
['MSGIDSec','Message-ID Secrets for MSGID-TAG-generation*',80,\&textinput,'0=key0|1=key1|2=key2|3=key3|4=key4|5=key5|6=key6|7=key7|8=key8|9=key9','(\S*)','configChangeMSGIDSec','To use Message-ID signing and to generate the MSGID-Tags, at leased one secret key is needed, up to ten keys are possible.<br />
  The notation is : generationnumber[0-9]=secretKey. For example<font color=red>(do not use!)</font>: 0=jk09Z|1=oPLmn4g|....   . Multiple paires are separated by pipes (|). Default is  0=key0|1=key1|2=key2|3=key3|4=key4|5=key5|6=key6|7=key7|8=key8|9=key9 . Do not defines spaces, tabs and \'=\' as part of the keys(secrets)! <br />
  <font color=red>Values that contains any default are not valid, please change them, to prevent detecting strange ASSP-signatures as valid local signatures!</font><br />For this reason, please define your secrets as unique as possible! The secrets are used randomly to build the Message-ID-Tags.',undef,undef,'msg004820','msg004821'],
['MSGIDsigAddresses','Do FBMTV For These Addresses Only*',80,\&textinput,'','(.*)','ConfigMakeSLRe',
  'Mail to any of these addresses will be tagged and checked by FBMTV. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com). If empty, FBMTV is done for all addresses.',undef,undef,'msg004830','msg004831'],
['noMSGIDsigRe','Skip Message-ID signing, mail content dependend*',80,\&textinput,'','(.*)','ConfigCompileRe','Use this to skip the Message-ID tagging depending on the content of the email. If the content of the email matches this regular expression (checking MaxBytes only), FBMTV will not be done. For example: \'I am out of office\' .',undef,undef,'msg008900','msg008901'],
['noRedMSGIDsig','Skip Message-ID signing for Redlisted mails',0,\&checkbox,'0','(.*)',undef,'If selected, FBMTV will not be done for redlisted emails!',undef,undef,'msg008910','msg008911'],
['DoBATV','Do BATV taging and validating','0:disabled|1:block|2:monitor|3:score|4:testmode',\&listbox,0,'(\d*)',undef,'If enabled any sender address of outgoing mails is mangled with a <a href="http://en.wikipedia.org/wiki/Bounce_Address_Tag_Validation" rel="external">BATV-Tag</a>. Any incoming bounced mail is checked for a valid BATV-Tag. All valid (local) BATV-Tags will be removed from incoming mails - so whitelisting, delaying an all other recipient and sender based checks will use the normal addresses. If the BATV-check is successful, no MSGID-signing-check and DNS-Backscatter-check will be done! If any BATVTag was removed, no DKIM-check will be done! BATV-address-replacement is done, before the recipient replacement rules are processed!<br />
  This check requires an installed <a href="http://search.cpan.org/search?query=Digest::SHA1" rel="external">Digest::SHA1</a> module in Perl.',undef,undef,'msg004840','msg004841'],
['BATVSec','BATV Secrets for BATV-TAG-generation*',80,\&textinput,'0=key0|1=key1|2=key2|3=key3|4=key4|5=key5|6=key6|7=key7|8=key8|9=key9','(\S*)','configChangeBATVSec','To use <a href="http://en.wikipedia.org/wiki/Bounce_Address_Tag_Validation" rel="external">BATV</a> and to create the BATV-Tags, at leased one secret key is needed, up to ten keys are possible.<br />
  The notation is : generationnumber[0-9]=secretKey. For example: 0=key0|1=KEYX45rt|....   . Multiple paires are separated by pipes (|). Default is  0=key0|1=key1|2=key2|3=key3|4=key4|5=key5|6=key6|7=key7|8=key8|9=key9 . Do not defines spaces, tabs and \'=\' as part of the keys(secrets)! The secrets are use randomly to build the BATV-Tags.',undef,undef,'msg004850','msg004851'],
['removeBATVTag','remove strange BATV-Tags from incoming mails',0,\&checkbox,'0','(.*)',undef,'Any strange BATV-signature will be removed from the sender address and the real sender address will be used! Using this together with remindBATVTag keeps your clients addressbooks (also whitelist, delaydb ...) clean from BATV-Tags. This will also work, if DoBATV is disabled. If you do not use remindBATVTag and the MTA behind ASSP sends a bounced mail back - this mail will fail on BATV on the recipients site. If any BATVTag was removed, no DKIM-check will be done!',undef,undef,'msg004860','msg004861'],
['remindBATVTag','store incoming strange BATV-Tags to remind them for outgoing bounce mails',0,\&checkbox,'0','(.*)',undef,'If defined, any incoming stange BATV-signature will be stored and any recipient of outgoing bounce mails will be checked against this list. If there is found a valid (not older than 7 days) BATV-Tag for that recipient, it will be mangled in to the recipient address. This will also work, if DoBATV is disabled.',undef,undef,'msg004870','msg004871'],
['DoBackSctr','Do DNS-Backscatter Detection','0:disabled|1:block|2:monitor|3:score|4:testmode',\&listbox,0,'(\d*)',undef,
  'If activated, the IP-address of each message received for null sender,bounced or postmaster will be checked against the list below.
   DNS base checks requires an installed <a href="http://search.cpan.org/search?query=Net::DNS" rel="external">Net::DNS</a> module in Perl.<br />
   For more information about backscatter detection please read <a href="http://www.backscatterer.org/?target=usage" rel="external">http://www.backscatterer.org/?target=usage</a>.',undef,undef,'msg004880','msg004881'],
['BackDNSInterval','Backscatter-DNS Cache Refresh Interval',4,\&textinput,7,'(\d+\.?\d*|)','configUpdateBDNSCR','IP\'s in cache will be removed after this interval in days. 0 will disable the cache and the usage of downloadBackDNSFile and localBackDNSFile. <input type="button" value=" Show Backscatter-DNS Cache" onclick="javascript:popFileEditor(\'pb/pbdb.back.db\',5);" />',undef,undef,'msg004890','msg004891'],
['BackSctrServiceProvider','ServiceProvider for Backscatterer Detection*',60,\&textinput,'ips.backscatterer.org','(.*)','configUpdateBACKSctrSP',
  'ServiceProvider for DNS check on Backscatterer. Possible value is ips.backscatterer.org for DNS check.',undef,undef,'msg004900','msg004901'],
['downloadBackDNSFile','Download the Backscatterer DNS-IP-List',0,\&checkbox,'0','(.*)',undef,'If selected, the complete IP-list is downloaded to a local file. If useDB4IntCache is set, the list is stored in a BerkeleyDB database (BackDNS2). Otherwise the records will be stored in the pbdb cache BackDNS . The download will be skipped, if useDB4IntCache is not set and mysqlSlaveMode is set. IP\'s are checked on this file first, if the IP is not found on this list, a DNS query is done. It is recommended to use this option for ISP\'s and users with more than 1000 bounced mails a day. See wget-mirrors.uceprotect.net/rbldnsd-all/ips.backscatterer.org.gz',undef,undef,'msg004910','msg004911'],
['localBackDNSFile','Local File for the Backscatterer DNS-IP-List',0,\&textinput,'file:files/backdnslist.txt','(\s*file\s*:\s*.+|)',undef,'The name of the local file that is used for this IP-list. The content of this file is filled in to the \'Backscatter-DNS Cache\' ( BackDNSInterval ). IP\'s from this list will be removed after one day from the cache.
  <hr /><hr /><font color=red>The following configurations are valid for all Backscatter Detection Options!</font><hr />',undef,undef,'msg004920','msg004921'],

['Back250OKISP','Send 250 OK to ISP if any Backscatter Detection fails',0,\&checkbox,'0','(.*)',undef,'If any Backscatter check fails for a bounced mail that is coming from an ISPIP, ASSP will send "250 OK" to the ISP, but will discard the mail, if the check is configured to block!',undef,undef,'msg004930','msg004931'],
['BackWL','Do Backscatter Detection checks for Whitelisted mail',0,\&checkbox,'','(.*)',undef,'Tagging will be always done, if not excluded by address or domain!',undef,undef,'msg004940','msg004941'],
['BackNP','Do Backscatter Detection checks for No Processing mail',0,\&checkbox,'','(.*)',undef,'Tagging will be always done, if not excluded by address or domain!',undef,undef,'msg004950','msg004951'],
['noBackSctrRe','Regular Expression to Skip all BackScatter Checks*',80,\&textinput,'','(.*)','ConfigCompileRe',
  'If the contents of a mail matches these regular expressions, all BackScatter checks will be skipped.',undef,undef,'msg009240','msg009241'],
['noBackSctrAddresses','Do not any Backscatter detection for this Addresses *',80,\&textinput,'','(.*)','ConfigMakeSLRe',
  'Mail to and from any of these addresses will not be tagged and checked by any backscatter option. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com).',undef,undef,'msg004960','msg004961'],
['noBackSctrIP','Exclude these IP\'s from any Backscatter detection*',80,\&textinput,'','(\S*)','ConfigMakeIPRe','Enter IP\'s that you want to exclude from FBMTV and Backscatter check, separated by pipes (|). <br />
  <hr /><div class="menuLevel1">Notes On Backscatter Detection</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/backscatter.txt\',3);" />',undef,'7','msg004970','msg004971'],

[0,0,0,'heading','TestModes'],
['spamSubject','Prepend Spam Subject <a href="http://apps.sourceforge.net/mediawiki/assp/Getting_Started#Rebuild_your_Bayesian_database."><img src="' . $wikiinfo . '" alt="TestMode" /></a>',20,\&textinput,'','(.*)',undef,'Setting a filter to testmode will tell ASSP not to reject the mail but rather build up the whitelist and spam and notspam collections. This can go on for some time without disturbing normal operation. After this very important phase TestMode can be used to tag the message: if TestMode and the message is spam Spam Subject gets prepended to the subject of the email. For example: [SPAM]','Basic',undef,'msg004980','msg004981'],
['spamTag','Prepend Spam Tag',0,\&checkbox,'','(.*)',undef,'ASSP uses many methods. The method which caught the spam will be prepended to the subject of the email. For example; [DNSBL]','Basic',undef,'msg004990','msg004991'],
['allTestMode','All Test Mode ON',0,\&checkbox,'','(.*)',undef,'Turn all of the individual testmodes on - regardless of the individual test mode settings. ',undef,undef,'msg005000','msg005001'],
['baysTestMode','Bayesian/Hidden-Markov-Model Test Mode',0,\&checkbox,1,'(.*)',undef,'',undef,undef,'msg005010','msg005011'],
['baysTestModeUserAddresses','Bayesian Test Mode User Addresses*',80,\&textinput,'','(.*)','ConfigMakeSLRe','These users are in test mode / mark subject only for bayesian spam, even with test mode above off','Basic',undef,'msg005020','msg005021'],
['blTestMode','BlackDomain Test Mode',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg005030','msg005031'],
['hlTestMode','Helo Blacklist Test Mode',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg005040','msg005041'],
['flsTestMode','Forged Local Domain Test Mode',0,\&checkbox,'','(.*)','','-> DoNoValidLocalSender',undef,undef,'msg005050','msg005051'],
['spfTestMode','SPF Test Mode',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg005060','msg005061'],
['rblTestMode','DNSBL Test Mode',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg005070','msg005071'],
['attachTestMode','Bad Attachment Test Mode',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg005080','msg005081'],
['uriblTestMode','URIBL Test Mode',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg005090','msg005091'],
['srsTestMode','SRS Test Mode',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg005100','msg005101'],
['bombTestMode','Bomb Regex Test Mode',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg005110','msg005111'],
['scriptTestMode','Script Regex Test Mode',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg005120','msg005121'],
['mxaTestMode','Missing MX Record Test Mode',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg005130','msg005131'],
['ptrTestMode','Reversed Lookup Test Mode',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg005140','msg005141'],
['ihTestMode','Invalid Helo Test Mode',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg005150','msg005151'],
['fhTestMode','Forged Helo Test Mode',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg005160','msg005161'],
['msTestMode','Message Scoring Test Mode',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg005170','msg005171'],
['dkimTestMode','DKIM Test Mode',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg005180','msg005181'],
['pbTestMode','Penalty Box Test Mode',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg005190','msg005191'],
['switchTestToScoring',"Switch Testmode to Message Scoring",0,\&checkbox,'','(.*)',undef,
 'Put the filter automatically in "Message Scoring" when DoPenaltyMessage is set  (instead of stopping spam processing altogether).<br /><hr /><div class="menuLevel1">Notes On Testmode</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/testmode.txt\',3);" />',undef,undef,'msg005200','msg005201'],


[0,0,0,'heading','Email Interface <a href="http://apps.sourceforge.net/mediawiki/assp/index.php?title=How_do_i_use_the_e-mail_interface" target=wiki><img height=12 width=12 src="' . $wikiinfo . '" alt="How do I use the e-mail interface" /></a>'],
['EmailInterfaceOk','Enable Email Interface',0,\&checkbox,1,'(.*)',undef,
  'Checked means that you want ASSP to intercept and parse mail to the following usernames at any localdomains. The domain \'@assp.local\' is automatically a local domain and can be used for the email-interface.
  <hr>
  <b>NOTICE:</b> It is possible to define any MIME-header lines in any report file after the first (subject) line. This makes it possible to define MIME encoding and/or charset settings.<br />
  If a definition of MIME encoding and/or charset is found in a report file, assp converts the report from UTF-8 in to the defined encodings. <b> Don\'t forget to terminate your MIME-header with an empty line!</b><br /><br />
  It is also possible to include files at any line of such a file, using the following directive<br />
  # include filename<br />
  where filename is the relative path (from '.$base.') to the included file like reports/mime-header.txt (one file per line). The line will be internaly replaced by the contents of the included file!',undef,undef,'msg005210','msg005211'],
['EmailAdminReportsTo','Admin Mail Address',40,\&textinput,'','('.$EmailAdrRe.'\@'.$EmailDomainRe.')?',undef,
  'If set internal warnings/infos  will be sent to this address. For example: admin@domain.com',undef,undef,'msg005220','msg005221'],
['EmailReportDestination','Email Interface Reports Destination',20,\&textinput,'','^((?:' . $HostPortRe . '(?:\|' . $HostPortRe . ')*)|)$',undef,
 'Port to connect to when Email Interface or Block reports are send. If blank they go to the main smtpDestination. eg "10.0.1.3:1025", etc.',undef,undef,'msg005230','msg005231'],
['EmailHelp','Help Address<a href="http://apps.sourceforge.net/mediawiki/assp/Getting_Started#Instructions_for_use_for_your_end_users." target="ASSPHELP"><img src="' . $wikiinfo . '" alt="doku" /></a>',20,\&textinput,'assphelp','(.*)@?',undef,
  'Any mail sent by local/authenticated users to this username will be interpreted as a request for help. Do not put the full address here, just the user part. For example: assphelp',undef,undef,'msg005240','msg005241'],
['EmailAdmins','Authorized Addresses*',80,\&textinput,'','(.*)','ConfigMakeSLRe',
  'Mail from any of these addresses can add/remove to/from redlist, spamlovers, noprocessing, blacklist. May request an EmailBlockReport for a list of users. Accepts specific addresses (user@example.com), user parts (user) or entire domains (@example.com)',undef,undef,'msg005250','msg005251'],
['EmailSenderOK','Accept Mails (Reports) from these external addresses*',40,\&textinput,'','(.*)','ConfigMakeSLRe',
  'Allow these external domains/addresses to report to the email interface (NOT RECOMMENDED). The reply address for the reports must be set to a local one.  By default, ASSP only accepts reports from local or authenticated users. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com)',undef,undef,'msg005260','msg005261'],
['EmailSenderNotOK','Not Authorized Addresses*',80,\&textinput,'','(.*)','ConfigMakeSLRe',
  'Mail from any of these addresses are not accepted from Email Interface, except "Help Report", "Analyze Report" and "Block Report/Resend". Accepts specific addresses (user@example.com), user parts (user) or entire domains (@example.com). The user will get informed about the denied request.',undef,undef,'msg005270','msg005271'],
['EmailSenderIgnore','Ignore Not Authorized Addresses*',80,\&textinput,'','(.*)','ConfigMakeSLRe',
  'Mail from any of these addresses are not accepted from Email Interface, except "Help Report", "Analyze Report" and "Block Report/Resend". Accepts specific addresses (user@example.com), user parts (user) or entire domains (@example.com). The user will get not informed about the denied request.',undef,undef,'msg009390','msg009391'],
['EmailSpam','Report Spam Address',20,\&textinput,'asspspam','(.*)@?',undef,
  'Any mail sent or forwarded by local/authenticated users to this username will be interpreted as a spam report. Multiple attachments get truncated to MaxBytesReports. Do not put the full address here, just the user part.<br />
   For example: asspspam . Use a fake domain like @assp.local when you send the email- so the full address would be then asspspam@assp.local. <br />You can sent multiple mails as attachments and/or zipped file(s). Each attached email-file must have the extension defined in "maillogExt". In this case only the attachments will be processed. To use this multi-attachment-feature an installed <a href="http://search.cpan.org/search?query=Email::MIME" rel="external">Email::MIME</a> module in PERL is needed. It is also possible to send MS-outlook \'.msg\' files (possibly zipped). To use this MS-outlook-feature in addition an installed <a href="http://search.cpan.org/search?query=Email::Outlook::Message" rel="external">Email::Outlook::Message</a> module in PERL is needed.','Basic',undef,'msg005280','msg005281'],
['EmailHam','Report Ham (Not-Spam) Address',20,\&textinput,'asspnotspam','(.*)@?',undef,
  'Any mail sent or forwarded by local/authenticated users to this username will be interpreted as a false-positive report. Multiple attachments get truncated to MaxBytesReports. Do not put the full address here, just the user part.<br />
   For example: asspnotspam . Use a fake domain like @assp.local when you send the email- so the full address would be then asspspam@assp.local. <br />You can sent multiple mails as attachments and/or zipped file(s). Each attached email-file must have the extension defined in "maillogExt". In this case only the attachments will be processed. To use this multi-attachment-feature an installed <a href="http://search.cpan.org/search?query=Email::MIME" rel="external">Email::MIME</a> module in PERL is needed. It is also possible to send MS-outlook \'.msg\' files (possibly zipped). To use this MS-outlook-feature in addition an installed <a href="http://search.cpan.org/search?query=Email::Outlook::Message" rel="external">Email::Outlook::Message</a> module in PERL is needed.','Basic',undef,'msg005290','msg005291'],
['EmailForwardReportedTo','Email Interface Forward Reports Destination',20,\&textinput,'','^((?:' . $HostPortRe . '(?:\|' . $HostPortRe . ')*)|)$',undef,
 'Host and Port to forward EmailSpam and EmailHam reports to - eg "10.0.1.3:1025".<br />
  If you use more than one assp instance and your users are reporting spam and ham mails to multiple or all of them, but only one (but not this instance) is doing the rebuildspamdb and the corpus folders are not shared between the instances,<br />
  define the "host:port" of the central assp (rebuild-) instance here. Every report to EmailSpam and EmailHam (but only these!) will be forwarded to the defined host(s) and NO other local action will be taken. If the forwarding to all defined hosts failes, the request will be processed localy. To define multiple hosts for failover, separte them by pipe (|).',undef,undef,'msg009930','msg009931'],
['EmailErrorsReply','Reply to Spam/Not-Spam Reports','0:NO REPLY|1:REPLY TO SENDER|2:REPLY TO EmailErrorsTo|3:REPLY TO BOTH',\&listbox,1,'(\d*)',undef,  '',undef,undef,'msg005300','msg005301'],
['EmailErrorsTo','Send Copy of Spam/Ham-Reports TO',40,\&textinput,'','('.$EmailAdrRe.'\@'.$EmailDomainRe.')?',undef,
  'Email sent from ASSP acknowledging your submissions will be sent to this address. For example: admin@domain.com<br />',undef,undef,'msg005310','msg005311'],

['EmailErrorsModifyWhite','Combined Spam/Ham Report &amp; Whitelist Check','0:disabled|1:modify whitelist|2:show whitelist',\&listbox,1,'(.*)',undef,
  'If set to \'modify whitelist\' Ham Reports will add email addresses to the Whitelist, Spam Reports will remove addresses from the Whitelist, also a copy of a file in the GUI to correctedspam (remove) and correctednotspam (add) will modify the Whitelist for the found addresses. If set to \'show whitelist\' Spam Reports will show if addresses are whitelisted.','Basic',undef,'msg005320','msg005321'],
['EmailErrorsModifyNoP','Combined Spam Report and NoProcessing Deletion','0:disabled|1:modify noprocessing|2:show noprocessing',\&listbox,1,'(.*)',undef,
  'If set to \'modify noProcessing\' Spam Reports will remove email addresses from noProcessing list. If set to \'show noProcessing\' Spam Reports will show if addresses are on noProcessing list, also a copy of a file in the GUI to correctedspam (remove) and correctednotspam (show) will modify the noProcessing list for the found addresses.','Basic',undef,'msg008790','msg008791'],

['EmailWhitelistAdd','Add to Whitelist Address',20,\&textinput,'asspwhite','(.*)@?',undef,
  'Any mail sent by local/authenticated users to this username will be interpreted as a request to add addresses to the whitelist. Do not put the full address here, just the user part. <br />
  For example: asspwhite<br />
  If an address is added to whitelist, it will be removed from the Personal Blacklist of the sending user.','Basic',undef,'msg005330','msg005331'],
['EmailWhitelistRemove','Remove from Whitelist Address',20,\&textinput,'asspnotwhite','(.*)@?',undef,
  'Any mail sent by local/authenticated users to this username will be interpreted as a request to remove addresses from the whitelist. Do not put the full address here, just the user part. <br />For example: asspnotwhite','Basic',undef,'msg005340','msg005341'],
['EmailWhitelistReply','Reply to Add to/Remove from Whitelist','0:NO REPLY|1:REPLY TO SENDER|2:REPLY TO EmailWhitelistTo|3:REPLY TO BOTH',\&listbox,1,'(\d*)',undef,
  '',undef,undef,'msg005350','msg005351'],
['EmailWhitelistTo','Send Copy of Whitelist-Reports TO',40,\&textinput,'','('.$EmailAdrRe.'\@'.$EmailDomainRe.')?',undef,
  'Email sent from ASSP acknowledging your submissions will be sent to this address. For example: admin@domain.com',undef,undef,'msg005360','msg005361'],
['EmailRedlistAdd','Add to Redlist Address',20,\&textinput,'asspred','(.*)@?',undef,
  'Any mail sent by local/authenticated users to this username will be interpreted as a request to add the sender address to the redlist. Only the users defined in EmailRedlistTo, EmailAdmins and EmailAdminReportsTo are able to define a list of email addresses in the mail body.  Do not put the full address here, just the user part. <br />For example: asspred.',undef,undef,'msg005370','msg005371'],
['EmailRedlistRemove','Remove from Redlist Addresses',20,\&textinput,'asspnotred','(.*)@?',undef,
  'Any mail sent by local/authenticated users to this username will be interpreted as a request to remove the sender address from the redlist. Only the users defined in EmailRedlistTo, EmailAdmins and EmailAdminReportsTo are able to define a list of email addresses in the mail body. <br />
  Do not put the full address here, just the user part. <br />For example: asspnotred',undef,undef,'msg005380','msg005381'],
['EmailRedlistReply','Reply to Add to/Remove from Redlist','0:NO REPLY|1:REPLY TO SENDER|2:REPLY TO EmailRedlistTo|3:REPLY TO BOTH',\&listbox,1,'(\d*)',undef,
  '',undef,undef,'msg005390','msg005391'],
['EmailRedlistTo','Send Copy of Redlist-Reports TO',40,\&textinput,'','('.$EmailAdrRe.'\@'.$EmailDomainRe.')?',undef,
  'Email sent from ASSP acknowledging your submissions will be sent to this address. For example: admin@domain.com',undef,undef,'msg005400','msg005401'],
['EmailSpamLoverAdd','Add to SpamLover Addresses',20,\&textinput,'asspspamlover','(.*)@?',undef,
  'Any mail sent by local/authenticated users to this username will be interpreted as a request to add the sender address to spamLovers. Only the users defined in EmailSpamLoverTo, EmailAdmins and EmailAdminReportsTo are able to define a list of email addresses in the mail body. Do not put the full address here, just the user part. <br />For example: asspspamlover. To use this option, you have to configure spamLovers with "file:..." for example "file:files/spamlovers.txt" !',undef,undef,'msg005410','msg005411'],
['EmailSpamLoverRemove','Remove from SpamLover Addresses',20,\&textinput,'asspnotspamlover','(.*)@?',undef,
  'Any mail sent by local/authenticated users to this username will be interpreted as a request to remove the sender address from spamLovers. Only the users defined in EmailSpamLoverTo, EmailAdmins and EmailAdminReportsTo are able to define a list of email addresses in the mail body. <br />
  Do not put the full address here, just the user part. <br />For example: asspnotspamlover',undef,undef,'msg005420','msg005421'],
['EmailSpamLoverReply','Reply to Add to/Remove from SpamLovers','0:NO REPLY|1:REPLY TO SENDER|2:REPLY TO EmailSpamLoverTo|3:REPLY TO BOTH',\&listbox,1,'(\d*)',undef,
  '',undef,undef,'msg005430','msg005431'],
['EmailSpamLoverTo','Send Copy of Spamlover-Reports TO',40,\&textinput,'','('.$EmailAdrRe.'\@'.$EmailDomainRe.')?',undef,
  'Email sent from ASSP acknowledging your submissions will be sent to this address. For example: admin@domain.com',undef,undef,'msg005440','msg005441'],
['EmailNoProcessingAdd','Add to NoProcessing Addresses',20,\&textinput,'asspnpadd','(.*)@?',undef,
  'Any mail sent by local/authenticated users to this username will be interpreted as a request to add the sender address to the noProcessing addresses. Only the users defined in EmailNoProcessingTo, EmailAdmins and EmailAdminReportsTo are able to define a list of email addresses in the mail body. Do not put the full address here, just the user part. <br />For example: asspnpadd. To use this option, you have to configure noProcessing with "file:..." for example "file:files/noprocessing.txt" !',undef,undef,'msg005450','msg005451'],
['EmailNoProcessingRemove','Remove from noProcessing Addresses',20,\&textinput,'asspnprem','(.*)@?',undef,
  'Any mail sent by local/authenticated users to this username will be interpreted as a request to remove the sender address from noProcessing .<br />
  Do not put the full address here, just the user part. Only the users defined in EmailNoProcessingTo, EmailAdmins and EmailAdminReportsTo are able to define a list of email addresses in the mail body. <br />For example: asspnprem. To use this option, you have to configure noProcessing with "file:..." for example "file:files/noprocessing.txt" !',undef,undef,'msg005460','msg005461'],
['EmailNoProcessingReply','Reply to Add to/Remove from noProcessing','0:NO REPLY|1:REPLY TO SENDER|2:REPLY TO EmailNoProcessingTo|3:REPLY TO BOTH',\&listbox,1,'(\d*)',undef,
  '',undef,undef,'msg005470','msg005471'],
['EmailNoProcessingTo','Send Copy of NoProcessing-Reports TO',40,\&textinput,'','('.$EmailAdrRe.'\@'.$EmailDomainRe.')?',undef,
  'Email sent from ASSP acknowledging your submissions will be sent to this address. For example: admin@domain.com',undef,undef,'msg005480','msg005481'],
['EmailBlackAdd','Add to BlackListed  Addresses',20,\&textinput,'assp-black','(.*)@?',undef,
  'Any mail sent by local/authenticated users to this username will be interpreted as a request to add the sender address to the blackListedDomains addresses. Only the users defined in EmailAdmins and EmailAdminReportsTo are able to request an addition. Do not put the full address here, just the user part. <br />For example: assp-black. To use this option, you have to configure blackListedDomains with "file:..." for example "file:files/blacklisted.txt" !',undef,undef,'msg005490','msg005491'],
['EmailBlackRemove','Remove from BlackListed Addresses',20,\&textinput,'assp-notblack','(.*)@?',undef,
  'Any mail sent by local/authenticated users to this username will be interpreted as a request to remove the sender address from blackListedDomains .<br />
  Do not put the full address here, just the user part. Only the users defined in EmailAdmins and EmailAdminReportsTo are able to request an addition. <br />For example: assp-notblack. To use this option, you have to configure blackListedDomains with "file:..." for example "file:files/blacklisted.txt" !',undef,undef,'msg005500','msg005501'],
['EmailErrorsModifyPersBlack','Spam/NotSpam Report will modify Personal Blacklist *',60,\&textinput,'*@*','(.*)','ConfigMakeSLRe',
  'Spam Reports will add email addresses to the Personal Blacklist, NotSpam Reports will remove addresses from the Personal Blacklist, if the report senders address matches.<br />
  Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com). Wildcards are supported (fribo*@domain.com).<br />
  Default is *@* , which matches all addresses.',undef,undef,'msg009610','msg009611'],
['EmailPersBlackAdd','Add to Personal BlackListed Addresses',20,\&textinput,'assp-persblack','(.*)@?',undef,
  'Any mail sent by local/authenticated users to this username will be interpreted as a request to add the listed address(es) to the personal blackListed addresses. Do not put the full address here, just the user part. <br />
  For example: assp-persblack.<br />
  The add and remove is done via email-interface, by sending specific email addresses to \'EmailPersBlackAdd\'  and \'EmailPersBlackRemove\'.
  A local user can force a complete report about all his personal black list entries by defining an email address that begins with \'reportpersblack\' in a remove or add request : eg: reportpersblack@anydomain.com or by sending an empty body.<br />
  Any mail address sent to this username will be removed from the whitelist if possible.<br />
  Globalized adding an address to all local users is not supported - use EmailBlackAdd instead.<br />
  The following wildcard combinations are allowed for an email address to support personal blacklisting of domains:<br /><br />
  full_sender_address<br />
  *@sender_domain or @sender_domain<br />
  @*sender_domain or *@*sender_domain<br />
  @*.sender_domain or *@*.sender_domain',undef,undef,'msg009110','msg009111'],
['EmailPersBlackRemove','Remove from Personal BlackListed Addresses',20,\&textinput,'assp-persnotblack','(.*)@?',undef,
  'Any mail sent by local/authenticated users to this username will be interpreted as a request to remove the listed address(es) from the personal blackListed addresses .<br />
  Do not put the full address here, just the user part.<br />
  For example: assp-persnotblack.<br />
  The add and remove is done via email-interface, by sending specific email addresses to \'EmailPersBlackAdd\'  and \'EmailPersBlackRemove\'.
  A local user can force a complete report about all his personal black list entries by defining an email address that begins with \'reportpersblack\' in a remove or add request : eg: reportpersblack@anydomain.com or by sending an empty body.<br />
  Only an admin can force a complete cleanup of all personal black entries for a specific email address for all local users - sending an email to \'EmailPersBlackRemove\' with the address followed by \',*\' in the body
  eg: address_to_remove@the_domain.foo,* - be carefull modifying personal entries of other users!<br />
  The same wildcard combinations like in EmailPersBlackAdd are supported.<br />
  <b>Notice: a removement request for a specific email address will remove ALL entries from the users personal blacklist, that would block this email address (also all matching wildcard entries)!</b>',undef,undef,'msg009120','msg009121'],
['EmailBlackReply','Reply to Add to/Remove from BlackListed','0:NO REPLY|1:REPLY TO SENDER|2:REPLY TO EmailBlackTo|3:REPLY TO BOTH',\&listbox,1,'(\d*)',undef,
  '',undef,undef,'msg005510','msg005511'],
['EmailBlackTo','Send Copy of Black-Change-Reports TO',40,\&textinput,'','('.$EmailAdrRe.'\@'.$EmailDomainRe.')?',undef,
  'Email sent from ASSP acknowledging your submissions will be sent to this address. For example: admin@domain.com',undef,undef,'msg005520','msg005521'],
['EmailAnalyze','Request Analyze Report',20,\&textinput,'asspanalyze','(.*)@?',undef,
  'Any mail sent or forwarded by local/authenticated users to this username will be interpreted as a request for analyzing the mail. Do not put the full address here, just the user part. For example: asspanalyze <br />
  Use a fake domain like @assp.local when you send the email- so the full address would be then asspanalyze@assp.local. <br />You can sent multiple mails as attachments and/or zipped file(s). Each attached email-file must have the extension defined in "maillogExt". In this case only the attachments will be processed. To use this multi-attachment-feature an installed <a href="http://search.cpan.org/search?query=Email::MIME" rel="external">Email::MIME</a> module in PERL is needed. It is also possible to send MS-outlook \'.msg\' files (possibly zipped). To use this MS-outlook-feature in addition an installed <a href="http://search.cpan.org/search?query=Email::Outlook::Message" rel="external">Email::Outlook::Message</a> module in PERL is needed.','Basic',undef,'msg005530','msg005531'],
['EmailAnalyzeReply','Reply to Analyze Request','0:NO REPLY|1:SEND TO SENDER|2:SEND TO EmailAnalyzeTo|3:SEND TO BOTH',\&listbox,1,'(\d*)',undef,'',undef,undef,'msg005540','msg005541'],
['EmailAnalyzeTo','Send Copy of Analyze-Reports',40,\&textinput,'','('.$EmailAdrRe.'\@'.$EmailDomainRe.')?',undef,
  'A copy of the Analyze-Report will be sent to this address. For example: admin@domain.com',undef,undef,'msg005550','msg005551'],
['DoAdditionalAnalyze','Spam and Ham Reports will trigger an additional Analyze Report ','0:NO ADDITIONAL REPORT|1:SEND TO SENDER|2:SEND TO EmailAnalyzeTo|3:SEND TO BOTH',\&listbox,0,'(.*)',undef,
  'Additional Analyze Report will be generated for Spam and Ham Reports. Setting the TO Address accordingly and choosing <b>EmailAnalyzeTo</b> will send the Analyze Report to the admin only.',undef,undef,'msg005560','msg005561'],

['EmailFrom','From Address for Reports',40,\&textinput,'<spammaster@yourdomain.com>','('.$EmailAdrRe.'\@'.$EmailDomainRe.')?',undef,
  'Email sent from ASSP acknowledging your submissions will be sent from this address.',undef,undef,'msg005570','msg005571'],
['EmailAllowEqual','Allow \'=\' in Addresses',0,\&checkbox,'1','(.*)',undef,
  'Allow \'=\' in addresses to be whitelisted or redlisted.',undef,undef,'msg005580','msg005581'],

['EmailSenderNoReply','Do Not Reply To These Addresses*',80,\&textinput,'','(.*)','ConfigMakeSLRe',
  'Email sent from ASSP acknowledging your submissions will not be sent to these addresses. Accepts specific addresses (user@example.com), user parts (user) or entire domains (@example.com).<br />
  Analyze-, PersonalBlackList- and all virus related reports are ignored by this feature (are sent even a user is listed here).<br />
  An Report copy to EmailAnalyzeTo, EmailBlackTo, EmailNoProcessingTo, EmailSpamLoverTo, EmailRedlistTo, EmailWhitelistTo and EmailErrorsTo is also ignored by this feature.<br /><hr />
  <div class="menuLevel1">Notes On Email Interface</div>
  <input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/emailinterface.txt\',3);" />',undef,undef,'msg005590','msg005591'],

[0,0,0,'heading','File Paths and Database'],
['base','Directory Base',40,\&textnoinput,'.','(.*)',undef,'All paths are relative to this folder.<br />
  <b>Note: Display only.</b>',undef,undef,'msg005600','msg005601'],
['spamlog','Spam Collection',40,\&textinput,'spam','(\S+)',undef,'The folder to save the collection of spam mails. This directory will be used in building the spamdb . For example: spam',undef,undef,'msg005610','msg005611'],
['notspamlog','Not-spam Collection',40,\&textinput,'notspam','(\S+)',undef,'The folder to save the collection of not-spam mails. This directory will be used in building the spamdb . For example: notspam',undef,undef,'msg005620','msg005621'],
['incomingOkMail','OK Mail',40,\&textinput,'okmail','(.*)',undef,'The folder to save non-spam (message ok). These are messages which are considered as HAM, but are not stored in the standard HAM folder because of our policy to use only confirmed HAM messages (whitelisted or local) for spamdb . If you want to keep copies of ok mail then put in a directory name. This directory will not be used in building the spamdb . Default: okmail',undef,undef,'msg005630','msg005631'],
['discarded','Discarded Spam',40,\&textinput,'discarded','(.*)',undef,'The folder to save discarded spam-messages. These are Spam messages which are not stored for building the spamdb but for resending with an EmailBlockReport. If you want to keep copies of discarded Spam then put in a directory name. Default: discarded',undef,undef,'msg005640','msg005641'],
['viruslog','Attachment/Virus Collection',40,\&textinput,'quarantine','(.*)',undef,
  'The folder to save rejected attachments and virii. Leave this blank to not save these files (default). If you want to keep copies of rejected content then put in a directory name. Note: you must create the directory. This directory will not be used in building the spamdb . For example: quarantine',undef,undef,'msg005650','msg005651'],
['correctedspam','False-negative Collection',40,\&textinput,'errors/spam','(\S+)',undef,
  'Spam that got through -- counts double. This directory will be used in building the spamdb . For example: errors/spam',undef,undef,'msg005660','msg005661'],
['correctednotspam','False-positive Collection',40,\&textinput,'errors/notspam','(\S+)',undef,
  'Good mail that was listed as spam, count 4x. This directory will be used in building the spamdb . For example: errors/notspam',undef,undef,'msg005670','msg005671'],
['resendmail','try to resend this files',40,\&textinput,'resendmail','(\S+)',undef,
  'ASSP will try to resend the files in this directory to the original recipient. The files must have the "maillogExt" extension and must have the SMTP-format. For example: resendmail. This requires an installed <a href="http://search.cpan.org/search?query=Email::Send" rel="external">Email::Send</a> module in PERL.',undef,undef,'msg005680','msg005681'],
['maillogExt','Extension for Mail Files',20,\&textinput,'.eml','(\S*)',undef,
  'Enter the file extension (include the period) you want appended to the mail files in the mail collections.<br />
  Leave it blank for no extension - this setting will prevent several features from working. Never use \'.msg\' - this is an extension used by MS-outlook! For Example: .eml',undef,undef,'msg005690','msg005691'],
['spamdb','Spam/HMM Bayesian Database Files',40,\&textinput,'spamdb','(\S+)','configChangeDB','The output file from rebuildspamdb. Write only "DB:" to use a database table instead of a local file, in this case you need to edit the database parameters below. The Hidden Makov Model is only available if this parameter is set to DB: .<br />
 <hr /><span class=\"negative\">It is recommended to use a database for all possible lists and caches for best performance, less memoryusage and stability! If you do not want to install a database engine like MySql or Oracle, use BerkeleyDB! Please read the section DBdriver !</span><br />
 <hr /><div class="menuLevel1">Last Run Rebuildspamdb</div><input type="button" value="Last Run Rebuildspamdb" onclick="javascript:popFileEditor(\'rebuildrun.txt\',5);" />',undef,undef,'msg005700','msg005701'],
['whitelistdb','E<!--get rid of google autofill-->mail Whitelist Database File',40,\&textinput,'whitelist','(\S+)','configChangeDB','The file with the whitelist.<br />
  Write only "DB:" to use a database table instead of a local file, in this case you need to edit the database parameters below.',undef,undef,'msg005710','msg005711'],
['redlistdb','E<!--get rid of google autofill-->mail Redlist Database File',40,\&textinput,'redlist','(\S+)','configChangeDB','The file with the redlist.<br />
  Write only "DB:" to use a database table instead of a local file, in this case you need to edit the database parameters below.',undef,undef,'msg005720','msg005721'],
['persblackdb','Personal Blacklist Database File',40,\&textinput,'persblack','(\S+)','configChangeDB','The file with the personal blacklist. The check of the personal black list is done shortly after the RCPT TO: command. This command will be rejected if an entry is found - any other setting except send250OK and send250OKISP will be ignored.<br />
  Each entry is represented by two comma separated values TO,FROM (and an expiration date).<br />
  TO could be any of : email address, [subdomain.]domain.tld, @[subdomain.]domain.tld, *@[subdomain.]domain.tld - the last three entry options could be only added and removed by editing the list in the GUI !<br />
  FROM could be any of : email address or any [@][subdomain.][domain.]TLD variant (wildcards are allowed). All values are supported by the email interface for all local users.<br />
  Write only "DB:" to use a database table instead of a local file, in this case you need to edit the database parameters below.',undef,undef,'msg009100','msg009101'],
['griplist','GreyIPlist Database',40,\&textinput,'griplist','(\S*)',undef,'The file with the current Grey-IP-List database -- make this blank if you don\'t use it.',undef,undef,'msg005730','msg005731'],
['useDB4griplist','Use BerkeleyDB for Griplist',0,\&checkbox,'','(.*)','configChangeDB',
  'If selected ASSP uses \'BerkeleyDB\' instead of \'orderedtie\' for griplist. Depending on your settings for OrderedTieHashTableSize this could spend some memory and/or result in better performance.  The perl module <a href="http://search.cpan.org/dist/BerkeleyDB/" rel="external">BerkeleyDB</a> version 0.34 or higher and BerkeleyDB version 4.5 or higher is required to use this feature.',undef,undef,'msg005740','msg005741'],
['droplist','Drop also Connections from these IP\'s*',40,\&textinput,'file:files/droplist.txt','(\s*file\s*:\s*.+|)','ConfigMakeIPRe','Automatically downloaded (http://www.spamhaus.org/drop/drop.lasso) list of IP\'s which should be blocked right away. This list could be used in addition to denySMTPConnectionsFrom and/or denySMTPConnectionsFromAlways!',undef,'7','msg005750','msg005751'],
['delaydb','Delaying Database',40,\&textinput,'delaydb','(\S*)','configChangeDB','The file with the delay database.<br />Write only "DB:" to use a database table instead of a local file, in this case you need to edit the database parameters below.',undef,undef,'msg005760','msg005761'],
['ldaplistdb','LDAP Database',40,\&textinput,'ldaplist','(\S*)','configChangeDB','The file with the LDAP-cache database.<br />Write only "DB:" to use a database table instead of a local file, in this case you need to edit the database parameters below.',undef,undef,'msg005770','msg005771'],
['adminusersdb','Admin Users Database',40,\&textinput,'','(\S*)','configChangeDB','The file with the GUI-Admin-Users database - default to set is \'adminusers\'.<br />Write only "DB:" to use a database table instead of a local file, in this case you need to edit the database parameters below. Before setting this parameter, please set adminusersdbpass to a value of your choice!<br />
 <hr>To use this database shared between multiple ASSP\'s, set all ASSP to mysqlSlaveMode (except the master) and the adminusersdbpass must be the same on all installations! If you want to change the adminusersdbpass, first change it on the master.<hr>',undef,undef,'msg005780','msg005781'],
['adminusersdbNoBIN','Admin Users Database uses no Binary Data (ASCII only)',0,\&checkbox,'','(.*)',undef,'Select this, if adminusersdb is set to "DB:" and your database engine does not accept or has problems with binary data (eg. Postgres). <span class="negative">If you change this value, you have to stop all assp and to cleanup both tables (adminusers and adminusersright) <b>before</b> restarting assp!</span>. To keep your data do the following: do an ExportMysqlDB - change this value - stop assp - drop or clean both tables - start assp - do an ImportMysqlDB .',undef,undef,'msg005790','msg005791'],
['adminusersdbpass','Admin Users Database PassPhrase',40,\&passinput,'','(.+)','ConfigChangePassPhrase','The passphrase that is used to encrypt the adminusersdb. This has to be the same on all ASSP installations that are sharing the adminusersdb. If you want to change it, first change it on the master installation and than on the slaves. Do not forget to configure \'mysqlSlaveMode\' first. An empty value is not valid!',undef,undef,'msg005800','msg005801'],
['myhost','database hostname or IP',40,\&textinput,'','^(' . $HostRe .'|)$',undef,
  'You need <a  href="http://search.cpan.org/~lds/Tie-DBI-1.02/lib/Tie/RDBM.pm" rel="external">Tie::RDBM</a> to use a database instead of local files.<br />
  This way you can share whitelist, delaydb, redlist and penaltybox between servers',undef,undef,'msg005810','msg005811'],
['DBdriver','database driver name',40,\&textinput,'','(.*)','configChangeDB',
  'The database driver used to access your database - DBD-driver. The following drivers are available on your system:<br />
  $DBdriversJ<br />
  If you can not find the driver for your database in this list, you should install it via cpan or ppm!<br />
  -  or if you have installed an ODBC-driver for your database and DBD-ODBC, just create a DSN and use ODBC.<br />
  If assp is running on windows and you want to use a MSSQL server as backend, don\'t use the ODBC driver - use the ADO driver with the DSN definition!<br />
  Useful are ADO|DB2|Informix|ODBC|Oracle|Pg|Sybase|mysql - but any other SQL compatible database should also work.<br/ ><br />
  syntax examples: driver,option1,option2,...,...<br />
  ADO[,DSN=mydsn[;Provider=sqloledb]]<br />
  DB2<br />
  Informix<br />
  ODBC,DSN=mydsn|driver=\{SQL Server\},Server=server_name<br />
  Oracle,SID=1|INSTANCE_NAME=myinstance|SERVER=myserver|SERVICE_NAME=myservice_name,[PORT=myport]<br />
  Pg[,PORT=myport]<br />
  Sybase,SERVER=myserver,[PORT=myport]<br />
  mysql[,PORT=myport][,mysql_socket=/path/to/mysql.sock][,AutoCommit=1][,mysql_auto_reconnect=1]<br /><br />
  <span class="negative">Instead using local files for hashes and lists via shared memory, it is recommended to use <a  href=\"http://search.cpan.org/search?query=berkeleydb\" rel=\"external\">BerkeleyDB</a> (Perl-module) version 0.34 or higher for highest performance and less memory usage.  The BerkeleyDB (engine) version 4.5 or higher is required to use BerkeleyDB.</span><br />
  If you specify BerkeleyDB here, the values for myhost, mydb, myuser and mypassword will be ignored. All possible BerkeleyDB option must be defined here - the option for \'-Filename\' is already set by ASSP! Options could be defined for example:<br />
  BerkeleyDB,-Pagesize=>number,-Env=>[-Cachesize=>number,-Mode=>mode,...,...],...,...<br />
  If \'-Env=>[-Cachesize=>number]\' (number in bytes) is specified, this cache size will be used at minimum for every single list. This is not recommended, because ASSP does automaticly calculate the right cache for every list. You may setup configuration values for any BerkeleyDB, creating a file <a href=http://www.oracle.com/technology/documentation/berkeley-db/db/ref/env/db_config.html>DB_CONFIG</a> (case sensitive) in the corresponding directory ./tmpDB/[list]. Please use the BerkeleyDB documentation if you don\'t know the syntax of this file. Any value defined in that file will overwrite the corresponding internal ASSP configuration for this DB.<br /><br />
  The options for all drivers and their possible or required order depends on the DBD driver used, please read the driver\'s documentation, if you do not know the needed option.<br />
  The username, password, host and databasename are always used from this configuration page.',undef,undef,'msg005820','msg005821'],
['mydb','database name',40,\&textinput,'','(\S*)',undef,
  'This database must exist before starting ASSP, necessary tables will be created automatically into this database.',undef,undef,'msg005830','msg005831'],
['mysqlSlaveMode','This is a slave of more then one assp-computers accessing the same database',0,\&checkbox,'','(.*)',undef,
  'If you are running more then one assp-computers accessing the same or <a href="http://www.webopedia.com/TERM/S/SPOF.html">(better because of SPOF)</a> a bidirectional replicated database<br />
  this is a slave-assp and no database maintenance will be done by this one!<br />
  Maintenance should only be done by the first assp - the master!<br />
  Maintenance for file based caches and lists will always be done!',undef,undef,'msg005840','msg005841'],
['myuser','database username',40,\&passinput,'','(.*)',undef,
  'This user must have CREATE privilege on database to create tables automatically',undef,undef,'msg005850','msg005851'],
['mypassword','database password',40,\&passinput,'','(.*)',undef,'',undef,undef,'msg005860','msg005861'],
['DBCacheMaxAge','Database Maximum Cache Age',10,\&textinput,'0','(\d+)',undef,'Setting this value above zero, enables an internal database cache for every defined table to reduce the concurrent database queries and to prevent possible record access collisions, which could cause stucking workers on some systems<br />
  The value defines the maximum age in seconds a record will exists untouched in the table cache.<br />
  Be carefull, setting this value too high in a database replication envirionment could cause unexpected query results, because this cache is NOT shared between multiple assp instances.<br />
  If set, a value of 10 seems to be popular in any case. An too less value, will produce overhead without any advantage. An too high setting could cause the described database consistency problems.',undef,undef,'msg010020','msg010021'],
['importDBDir','import directory',40,\&textinput,'mysql/dbimport','(\S+)',undef,'The folder to import the used tables of the database from.<br />The schema of the files must be the assp-schema.<br />
Files can be:<br />
- pbdb.back.db.(add|rpl)<br />
- pbdb.batv.db.(add|rpl)<br />
- pbdb.black.db.(add|rpl)<br />
- pbdb.dkim.db.(add|rpl)<br />
- pbdb.mxa.db.(add|rpl)<br />
- pbdb.ptr.db(add|rpl)<br />
- pbdb.rbl.db.(add|rpl)<br />
- pbdb.rwl.db.(add|rpl)<br />
- pbdb.sb.db.(add|rpl)<br />
- pbdb.spf.db.(add|rpl)<br />
- pbdb.trap.db.(add|rpl)<br />
- pbdb.uribl.db.(add|rpl)<br />
- pbdb.white.db.(add|rpl)<br />
- ldaplist.(add|rpl)<br />
- redlist.(add|rpl)<br />
- whitelist.(add|rpl)<br />
- persblackdb.(add|rpl)<br />
- spamdb.(add|rpl)<br />
- spamdb.helo.(add|rpl)<br />
- delaydb.(add|rpl)<br />
- delaydb.white.(add|rpl)<br />
- adminusers.(add|rpl)<br />
- adminusersright.(add|rpl)<br />
Use the extension "add" or "rpl" to add or replace the records to the tables.<br />
Only files for database-enabled tables will be imported ! The import will be done at ASSP start or if the option below is used.<br />
Imported files will be renamed to *.OK !<br />For example: mysql/dbimport<br />
<span class="negative">If you plan to import in to BerkeleyDB - do the following:<br />
- set DisableSMTPNetworking to on
- set all needed DB parameters
- collect your import files
- restart assp and wait until all imports are finished
- restart assp
- set DisableSMTPNetworking to off </span>',undef,undef,'msg005870','msg005871'],
['preventBulkImport','Prevent Bulk Import',0,\&checkbox,'','(.*)',undef,'Do not select, if you are using MySQL! Doing a Bulk-Import of data, ASSP modifies the properties of table columnes. This could result in breaking some configured DB features like DB-replication in MSSQL. If selected, ASSP will do a line per line insert/update (which takes much more time) without modifying the tables properties.',undef,undef,'msg005880','msg005881'],
['fillUpImportDBDir','Fill the Import Folder',10,\&textinput,'','^([1-9]|L|)$','ConfigChangeRunTaskNow','If set to a value between 1 and 9, the corresponding backup file for any list/hash that configured to use a database will be copied from the backupDBDir to the importDBDir. The resulting file name will has an extension of ".rpl", so a possible import will replace the current table content. If a value of "L" is defined, the last backup will be used. Possible values are L or 1 - 9 or blank. Any configured value will be reset to blank after the copy is finished.',undef,undef,'msg008990','msg008991'],
['ImportMysqlDB','import all files from the importDBDir Directory in to the database - now.',0,\&checkbox,'','(.*)','ConfigChangeRunTaskNow',
  "All files from the \"importDBDir\" will be imported in to database $mydb. Please define the directory above, before using the import!<br />
<input type=button value=\"Run Now!\" onclick=\"document.forms['ASSPconfig'].theButtonX.value='Apply Changes';document.forms['ASSPconfig'].submit();WaitDiv();return false;\" />&nbsp;<input type=button value=\"Refresh Browser\" onclick=\"document.forms['ASSPconfig'].theButtonRefresh.value='Apply Changes';document.forms['ASSPconfig'].submit();WaitDiv();return false;\" />",undef,undef,'msg005890','msg005891'],
['exportDBDir','export directory',40,\&textinput,'mysql/dbexport','(\S+)',undef,'The folder to export the used tables of the database.<br />The schema of the files is the assp-schema.<br />Ten versions of exports are available!<br />For example: mysql/dbexport',undef,undef,'msg005900','msg005901'],
['ExportMysqlDB','export all tables from the database',0,\&checkbox,'','(.*)','ConfigChangeRunTaskNow',
  "All table of the database will be exported to the \"exportDBDir\" Directory. Please define the Directory above, before using the export!<br />
<input type=button value=\"Run Now!\" onclick=\"document.forms['ASSPconfig'].theButtonX.value='Apply Changes';document.forms['ASSPconfig'].submit();WaitDiv();return false;\" />&nbsp;<input type=button value=\"Refresh Browser\" onclick=\"document.forms['ASSPconfig'].theButtonRefresh.value='Apply Changes';document.forms['ASSPconfig'].submit();WaitDiv();return false;\" />",undef,undef,'msg005910','msg005911'],
['backupDBDir','backup directory',40,\&textinput,'mysql/dbbackup','(\S+)',undef,'The folder to backup the used tables of the database.<br />The schema of the files is the assp-schema.<br />Ten versions of backups are available!<br />For example: mysql/dbbackup',undef,undef,'msg005920','msg005921'],
['backupDBInterval','backup database Interval <sup>s</sup>',40,\&textinput,2,$ScheduleGUIRe,'configChangeSched',
  'backup the database (all tables used by assp at the time)  every this hours.<br />
  Defaults to 2 hours.',undef,undef,'msg005930','msg005931'],
['copyDBToOrgLoc','copy the last DB-backup to the original location',0,\&checkbox,'1','(.*)',undef,
  'If DB-backup is enabled, the last backupversion is also copied to the original location.<br />
  If database connections are failed, while ASSP is running, ASSP will switch over to use these files instead of DB-tables.<br />
  DB-tables will not be imported from here, this must be done from the importDBDir!',undef,undef,'msg005940','msg005941'],
['logfile','ASSP Logfile',40,\&textinput,'logs/maillog.txt','(\S*)','ConfigChangeLogfile',
  'Blank if you don\'t want a log file. Change it to maillog.log if you don\'t want auto rollover.
  NOTE: Changing this field requires restarting ASSP before changes take effect.',undef,undef,'msg005950','msg005951'],
['MaxLogAge','Max Age of Logfiles',10,\&textinput,0,'(\d+)',undef,
  'The maximum file age in days of logfiles. If a logfile is older than this number in days, the file will be deleted. Default is 0 - recommended is 30. A value of 0 disables this feature and no logfile will be deleted because of its age.',undef,undef,'msg005960','msg005961'],
['MaxLogAgeSchedule','Runtime MaxLogAge',4,\&textinput,'1','^(1?[0-9]|2[0-3])$',undef,
  'Runtime hour for deleting old logfiles. Set a number between 0 and 23. 0 means midnight, 1 is default.',undef,undef,'msg005970','msg005971'],
['pidfile','PID File',40,\&textinput,'pid','(\S+)',undef,'Blank is not a valid value!<br />
  You have to restart ASSP before you get a pid file in the new location.<br />
  This file is used to detect a clean shutdown of ASSP - in this case it does not exist at startup!
  <hr /><div class="menuLevel1">Notes On File Path</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/filepath.txt\',3);" />',undef,undef,'msg005980','msg005981'],

[0,0,0,'heading','Collecting'],
['spamaddresses','Spam Collect Addresses*',80,\&textinput,'','(.*)','ConfigMakeSLRe',
  'Mail to any of these addresses are always spam and will contribute to the spam-collection unless from someone on the whitelist. Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com). The addresses are not validated, they  are readdressed to ccallspam, however you can supersede this by putting a valid address into sendAllCollect below.',undef,undef,'msg005990','msg005991'],
['sendAllCollect','Catchall Address for Collect Addresses',20,\&textinput,'','(.*)',undef,
  'ASSP will readdress messages addressed to Collect Addresses to this address.<br />
  For example: collect@mydomain.com',undef,undef,'msg006000','msg006001'],
['DoNotBlockCollect','Use Collect Addresses for Testing Your Environment',0,\&checkbox,'','(.*)',undef,
  'If set ASSP will block messages from Collect Addresses <b>after</b> other checks are performed. That may help to test and control activated filters.',undef,undef,'msg006010','msg006011'],
['UseTrapToCollect','Use Penalty Trap Addresses To Collect',0,\&checkbox,'','(.*)',undef,
  'If set ASSP will use addresses from DoPenaltyMakeTraps and spamtrapaddresses to collect spams.',undef,undef,'msg006020','msg006021'],
['noCollecting','Do Not Collect Messages from/to these Addresses*',60,\&textinput,'','(.*)','ConfigMakeSLRe','Accepts specific addresses (user@domain.com), user parts (user) or entire domains (@domain.com).',undef,undef,'msg006030','msg006031'],
['noCollectRe','Do Not Collect Messages - Content Based*',60,\&textinput,'','(.*)','ConfigCompileRe','If the content of a collected file (incl. X-ASSP-... headers) matches this regular expression, it will be deleted from the collection after the mail is completely processed.<br />
  If the ASSP_ARC plugin is used, the file will be deleted from the collection after it was archived. This is the only "no collect" option which removes an already collected file, all other options will prevent assp from creating a collection file - if set to "no collection". The check is limited to MaxBytes or at max 100000 Bytes.',undef,undef,'msg008930','msg008931'],
['DoNotCollectRedRe','Do Not Collect RedRe Matching Mails',0,\&checkbox,1,'(.*)',undef,
  'Mails (Spam/Ham) matching Red Regex (redRe) will not be stored in the collection folders.',undef,undef,'msg006040','msg006041'],
['DoNotCollectRedList','Do Not Collect Redlisted Mails',0,\&checkbox,'1','(.*)',undef,
  'Mails (Spam/Ham) matching  Redlist will not be stored in the collection folders.',undef,undef,'msg006050','msg006051'],
['DoNotCollectBounces','Do Not Collect Bounced Mails',0,\&checkbox,1,'(.*)',undef,
  'Mails matching &lt;Bounce Senders&gt; will not be collected.',undef,undef,'msg006060','msg006061'],
['NoMaillog','Don\'t Collect Mail',0,\&checkbox,'','(.*)',undef,
  'Check this if you\'re using Whitelist-Only and don\'t care to save mail to build the Bayesian database.',undef,undef,'msg006070','msg006071'],

['MaxFiles','Max Files',10,\&textinput,14000,'(\d+)',undef,
  'If you\'re not using subjects as file names ( UseSubjectsAsMaillogNames ), this is the maximum number of files to keep in each collection (spam &amp; nonspam)<br />
  It\'s actually less than this -- files get a random number between 1 and MaxFiles.',undef,undef,'msg006080','msg006081'],
['FilesDistribution','Files Distribution',4,\&textinput,1,'(0\.\d?[1-9]+|1)',undef,
  'This defines how file names are chosen in each collection. If set to 1, names are uniformly distributed. If set between 0.01 and 0.99, names distribution is exponential -- files get lower numbers more frequently. This prevents from corpus being refreshed too quickly, especially when MaxFiles is set to low value (ex. 3000)<br />
 Recommended: 0.5, Default: 1',undef,undef,'msg006090','msg006091'],
['UseSubjectsAsMaillogNames','Use Subject as Maillog Names',0,\&checkbox,'1','(.*)','ConfigChangeUSAMN',
  'You can turn this on to help you manually identify mail in your spam and non-spam collections. This will prevent ASSP from controlling the number of files in your collections(-> MaxFiles ). It is recommended to switch on MaintBayesCollection and to setup MaxNoBayesFileAge to your needs, if you have switched on this option.',undef,undef,'msg006100','msg006101'],
['MaxAllowedDups','Max Number of Duplicate File Names',5,\&textinput,5,'(\d+)','ConfigChangeMaxAllowedDups',
  'The maximum number of logged files with the same filename (subject) that are stored in the spam folder (spamlog), if UseSubjectsAsMaillogNames is selected. Default is 0. A low value reduces the number of possibly duplicate mails, assuming that mails with the same subject will have the same content. A value of 0 disables this feature. If this number of files with the same filename is reached, the oldest file with the same subject will be moved to the discarded folder, which has to be defined ( in addition to spamlog ) for this feature to work.', undef, undef,'msg008660','msg008661'],
['AllowedDupSubjectRe','Regular Expression to Identify allowed duplicate Subjects*',80,\&textinput,'','(.*)','ConfigCompileRe','Messages their subject matches this regular expression will be collected regardless the setting in MaxAllowedDups .',undef,undef,'msg008670','msg008671'],
['UseUnicode4MaillogNames','Use Unicode to build Maillog Names',0,\&checkbox,'','(.*)',undef,
  'If you have switched on UseSubjectsAsMaillogNames and your default (local language) characterset (please setup ConsoleCharset) needs 8 Bit like "KOI8-r","CP-866","Windows-1251","Windows-1252","ISO-8859-X","X-Mac-Cyrillic","JIS_X0201" or any other (or is UTF-8) - and you want to have readable filenames in the maillog and on the console screen, you can switch on this option. The resolution of some characters written to the console could be incorrect depending on your operating system. This requires an installed <a href="http://search.cpan.org/search?query=Email::MIME" rel="external">Email::MIME</a> module in PERL.<br />
  If in addition the module <a href="http://search.cpan.org/search?query=Win32::Unicode" rel="external">Win32::Unicode</a> is installed on windows plattforms, assp will generate unicode filenames for the collected corpus files (already on nix systems).',undef,undef,'msg006110','msg006111'],
['UseUnicode4SubjectLogging','Use Unicode to build Subjects in Maillog',0,\&checkbox,'','(.*)',undef,
  'If you have switched on UseUnicode4SubjectLogging and your default (local language) characterset (please setup ConsoleCharset) needs 8 Bit like "KOI8-r","CP-866","Windows-1251","Windows-1252","ISO-8859-X","X-Mac-Cyrillic","JIS_X0201" or any other (or is UTF-8) - and you want to have a readable subject in the maillog and on the console screen, you can switch on this option. The resolution of some characters written to the console could be incorrect depending on your operating system. This requires an installed <a href="http://search.cpan.org/search?query=Email::MIME" rel="external">Email::MIME</a> module in PERL.',undef,undef,'msg008920','msg008921'],
['MaxFileNameLength','Max Length of File Names',10,\&textinput,50,'(\d+)',undef,
  'The maximum character count that is used from the mail subject to build the file name of the logged file, if UseSubjectsAsMaillogNames is selected. This could be useful, if your mail clients having trouble to build the resend file name (right button - URL) correctly in block reports. Every non printable character will be replaced by a 4 byte string in this link.',undef,undef,'msg006130','msg006131'],
['MaintBayesCollection','Maintenance for Bayesian Collection',0,\&checkbox,'1','(.*)',undef,
  'Set this to on, if you want ASSP to run a maintenance tasks on the bayesian collection folders ( spamlog , notspamlog , correctedspam , correctednotspam ). ASSP will delete the oldest files until the number of files per folder reaches MaxFiles. If you want ASSP to delete files because of their age instead of the number of files ( MaxFiles ), setup MaxBayesFileAge and/or MaxCorrectedDays to your needs.<br />
  MaintBayesCollection is useful, if UseSubjectsAsMaillogNames is set to on and doMove2Num is set to off, because in this case the number of files in every collection folder will grow infinite. If set to On, the rebuildspamdb task will also do the cleanup.',undef,undef,'msg006140','msg006141'],
['MaxBayesFileAge','Max Age of Bayes Files',15,\&textinput,31,'^(\d+|\d+\s+\d+)$',undef,
  'The maximum file age in days of every file in every bayesian collection folder ( spamlog , notspamlog ). If MaintBayesCollection is set to on and a file is older than this number in days, the file will be deleted. Default is 31. A value of 0 disables this feature and no file will be deleted because of its age. To use different values for spamlog and notspamlog, define two space separated values - the first for spamlog and the second for notspamlog, like \'30 60\'. The rebuildspamdb task will ignore files older than this days (if not zero).<br />
  <span class = "negative">It is not recommended to enable this option, if you use the bayesian engine of ASSP and doMove2Num is set to ON.  A better solution in this case is, to have MaintBayesCollection take care of deletions (by date) and change this setting to 0.</span>',undef,undef,'msg006150','msg006151'],
['MaxCorrectedDays','Max Corrected File Age',15,\&textinput,'1000','^(\d+|\d+\s+\d+)$',undef,'This is the number of days a error report will be kept in the correctedspam and correctednotspam folders. These folders are the longterm memory of ASSP, therefore the default is 1000 days. To use different values for correctedspam and correctednotspam, define two space separated values - the first for correctedspam and the second for correctednotspam, like \'1000 1500\'. The rebuildspamdb task will ignore files older than this days (if not zero).',undef,undef,'msg008590','msg008591'],
['MaxNoBayesFileAge','Max Age of non Bayes Files',15,\&textinput,31,'^(\d+|\d+\s+\d+\s+\d+)$',undef,
  'The maximum file age in days of every file in every non bayesian collection folder ( incomingOkMail , discarded , viruslog ). If defined and a file is older than this number in days, the file will be deleted. Default is 31. A value of 0 disables this feature and no file will be deleted because of its age. To use different values for incomingOkMail and discarded and viruslog, define three space separated values - the first for incomingOkMail and the second for discarded and the third for viruslog, like \'31 45 60\'',undef,undef,'msg006160','msg006161'],
['MaxFileAgeSchedule','Runtime for MaintBayesCollection and MaxNoBayesFileAge <sup>s</sup>',40,\&textinput,'1',$ScheduleGUIRe,'configChangeSched',
  'Runtime hour for deleting old collected files (bayes and non bayes). Set a number between 0 and 23. 0 means midnight, 1 is default. If empty a cleanup will not be scheduled. This could be fine, if a rebuildspamdb is scheduled, which will also do the cleanup based on the settings of MaintBayesCollection , MaxBayesFileAge and MaxCorrectedDays - but it will not maintain incomingOkMail , discarded and viruslog based on MaxNoBayesFileAge !',undef,undef,'msg006170','msg006171'],
['MaxBytes','Max Bytes',10,\&textinput,4000,'(\d+)',undef,
  'How many bytes of the message body will ASSP look at - the message header is always included in all checks? Mails stored in the collecting folders will be truncated to this size. The average of Ham messages (message body) is 6K, the average of Spam messages is 3K. Usually the spam folder will be filled quicker than the notspam folder, therefore set this value to 4000 to get more wordpairs per Ham Message. When both folders are close to the maxfiles limit, reduce it to 3000.',undef,undef,'msg006180','msg006181'],
['StoreCompleteMail','Store the Complete Mail','0:disabled|100000:up to 100 kByte|500000:up to 500 kByte|1000000:up to 1 MByte|10000000:up to 10 MByte|999999999:no limit',\&listbox,999999999,'(\d*)',undef,
  'If set, ASSP will look at MaxBytes, but if possible it will store the complete mail up to the number of bytes configured. This could be useful for example, if you want resend blocked messages. Be carefull using this option, your disk could be filled up very fast!',undef,undef,'msg006190','msg006191'],
['MaxBytesReports','Error Max Bytes',10,\&textinput,10000,'(\d+)',undef,'How many bytes of an error report message will ASSP look at. For example: 10000. Set this to zero for no limit.',undef,undef,'msg006200','msg006201'],
['NonSpamLog','Non Spam','0:no collection|2:notspam folder',\&listbox,2,'(\d*)',undef,'Where to store whitelisted/local non spam messages. Default: notspam folder ( notspamlog ).',undef,undef,'msg006210','msg006211'],
['baysNonSpamLog','OK Mail','0:no collection|2:notspam folder|4:okmail folder',\&listbox,0 ,'(\d*)',undef,'Where to store non spam (message ok) messages. These are messages which are considered as HAM, but should not stored in the standard HAM folder because of our policy to use only confirmed HAM messages (whitelisted or local) for SpamDB. Set incomingOkMail accordingly if you choose \'okmail folder\'. Default: no collection',undef,undef,'msg006220','msg006221'],
['SpamLog','Store Spam','0:disabled|1:enabled',\&listbox,1,'(\d*)',undef,'Set this to \'disabled\' if you do not want to store any Spam regardless of settings in. Default: enabled (store in folder spamlog ).',undef,undef,'msg006230','msg006231'],
['noProcessingLog','NoProcessing OK Mails','0:no collection|4:okmail folder',\&listbox,0,'(\d*)',undef,'Where to store noprocessing OK mails.',undef,undef,'msg006240','msg006241'],
['npAttachLog','NoProcessing rejected Attachments','0:no collection|5:attachment folder|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,7,'(\d*)',undef,'Where to store noprocessing rejected mail+attachments. Recommended: discard folder ( discarded ) &amp; sendAllSpam',undef,undef,'msg006250','msg006251'],
['wlAttachLog','Whitelisted rejected Attachments','0:no collection|5:attachment folder|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,7,'(\d*)',undef,'Where to store whitelisted rejected mail+attachments. Recommended: discard folder ( discarded ) &amp; sendAllSpam',undef,undef,'msg006260','msg006261'],
['extAttachLog','External rejected Attachments','0:no collection|5:attachment folder|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,7,'(\d*)',undef,'Where to store external rejected mail+attachments. Recommended: discard folder ( discarded ) &amp; sendAllSpam',undef,undef,'msg006270','msg006271'],
['SpamVirusLog','Virus Infected','0:no collection|5:quarantine|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,5,'(\d*)',undef,'Where to store virus infected messages. Recommended: quarantine ( quarantine )',undef,undef,'msg006280','msg006281'],
['spamBombLog','Spam Bombs','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,6,'(\d*)',undef,'Where to store spam bombs. Recommended: discard folder ( discarded )',undef,undef,'msg006290','msg006291'],
['scriptLog','Scripts','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,3,'(\d*)',undef,'Where to store scripted messages. Recommended: spam folder   ( spamlog )  &amp; sendAllSpam',undef,undef,'msg006300','msg006301'],

['blDomainLog','Blacklisted Domains','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,3,'(\d*)',undef,'Where to store blacklisted domain messages. Recommended: spam folder ( spamlog ) &amp; sendAllSpam',undef,undef,'msg006310','msg006311'],
['spamHeloLog','Blacklisted Helos','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,7,'(\d*)',undef,'Where to store spam helo messages. Recommended: discard folder ( discarded ) &amp; sendAllSpam',undef,undef,'msg006320','msg006321'],
['forgedHeloLog','Forged Helos','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,0,'(\d*)',undef,'Where to store forged helo messages. Recommended: no collection',undef,undef,'msg006330','msg006331'],
['invalidHeloLog','Invalid Helos','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,6,'(\d*)',undef,'Where to store invalid helo messages. Recommended: discard folder ( discarded )',undef,undef,'msg006340','msg006341'],
['spamBucketLog','Spam Collect Addresses','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,1,'(\d*)',undef,'Where to store mails addressed to Spam Collect Addresses. Recommended: spam folder ( spamlog )',undef,undef,'msg006350','msg006351'],
['baysSpamLog','Bayesian Spams','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,7,'(\d*)',undef,'Where to store Bayesian spam messages. Recommended: discard folder ( discarded ) &amp; sendAllSpam',undef,undef,'msg006360','msg006361'],
['SPFFailLog','SPF Failures','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,3,'(\d*)',undef,'Where to store SPF Failure spam messages. Recommended: spam folder ( spamlog ) &amp; sendAllSpam',undef,undef,'msg006370','msg006371'],
['RBLFailLog','DNSBL Failures','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,3,'(\d*)',undef,'Where to store DNSBL Failure spam messages. Recommended: spam folder ( spamlog ) &amp; sendAllSpam',undef,undef,'msg006380','msg006381'],
['URIBLFailLog','URIBL Failures','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,3,'(\d*)',undef,'Where to store URIBL Failure spam messages. Recommended: spam folder ( spamlog ) &amp; sendAllSpam',undef,undef,'msg006390','msg006391'],
['SRSFailLog','SRS Failures','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,3,'(\d*)',undef,'Where to store SRS Failure (not signed bounces) spam messages. Recommended: spam folder ( spamlog ) &amp; sendAllSpam',undef,undef,'msg006400','msg006401'],
['spamPTRLog','Missing/Invalid Pointer ','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,3,'(\d*)',undef,'Where to store Missing/Invalid Pointer rejected messages. Recommended: spam folder ( spamlog ) &amp; sendAllSpam',undef,undef,'msg006410','msg006411'],
['spamMXALog','Missing MX Record ','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,3,'(\d*)',undef,'Where to store Missing MX record rejected messages. Recommended: spam folder ( spamlog ) &amp; sendAllSpam',undef,undef,'msg006420','msg006421'],
['spamISLog','Invalid Local Sender','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,0,'(\d*)',undef,'Where to store messages from a local domain with an unknown userpart. Recommended: no collection',undef,undef,'msg006430','msg006431'],
['spamSBLog','Blocked Country','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,3,'(\d*)',undef,'Where to store messages from a blocked country. Recommended: spam folder ( spamlog ) &amp; sendAllSpam',undef,undef,'msg006440','msg006441'],
['spamMSLog','Message Limit Blocks','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,3,'(\d*)',undef,'Where to store Message Scoring Limit rejected messages. Recommended: spam folder ( spamlog ) &amp; sendAllSpam',undef,undef,'msg006450','msg006451'],
['spamPBLog','PenaltyBox Blocks','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,3,'(\d*)',undef,'Where to store PB rejected messages. Recommended: spam folder ( spamlog ) &amp; sendAllSpam',undef,undef,'msg006460','msg006461'],

['DKIMLog','DKIM failed','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,3,'(\d*)',undef,'Where to store DKIM rejected messages. Recommended: spam folder ( spamlog ) &amp; sendAllSpam',undef,undef,'msg006470','msg006471'],
['BackLog','Backscatter check failed','0:no collection|1:spam folder|3:spam folder &amp; sendAllSpam|6:discard folder|7:discard folder &amp; sendAllSpam',\&listbox,6,'(\d*)',undef,'Where to store backscatter (MSGID-signing, BATV, DNS-Backscatter) rejected messages. Recommended: no collection',undef,undef,'msg006480','msg006481'],
['freqNonSpam','Non Spam Collection Frequency',5,\&textinput,1,'(\d*)','updateLog2','Store every n\'th non spam message. If you set the value to 10 then every 10th message is logged. These frequency settings are for ASSP users with a mature installation who experience heavy mail or spam volumes. Enter a larger value if the non spam corpus is being refreshed too quickly. Default Value = 1, log every message. Leave it at the default value 1, if you use BlockReports.',undef,undef,'msg006490','msg006491'],
['freqSpam','Spam Collection Frequency',5,\&textinput,1,'(\d*)','updateLog3','Store every n\'th spam message. The same as for non spam but helps prevent spam corpuses being skewed by flooding. It is recommended that this be set depending on spam volume. Default value = 1, log every message. Leave it at the default value 1, if you use BlockReports.<br /><hr /><div class="menuLevel1">Notes On Collecting</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/collecting.txt\',3);" />',undef,undef,'msg006500','msg006501'],

[0,0,0,'heading','Logging'],
['Notify','Notification Email To',80,\&textinput,'','('.$EmailAdrRe.'\@'.$EmailDomainRe.')?',undef,
  'Email address(es) to which you want ASSP to send a notification email per default, if a matching log entry ( NotifyRe , NoNotifyRe ) is found. Separate multiple entries by "|".',undef,undef,'msg006510','msg006511'],
['NotifyRe','Do Notify, if log entry matches*',60,\&textinput,'','(.*)','ConfigCompileNotifyRe','Regular Expression to identify loglines for which a notification message should be send.<br />
  useful entries are:<br />
  Info: new assp version - to get informed about new available assp versions<br />
  info: autoupdate: new assp version - to get informed about an autoupdate of the running script<br />
  adminupdate: - for config changes<br />
  admininfo: - for admin information<br />
  option list file: - for option file reload<br />
  error: - for any error<br />
  warning: - for any warning<br />
  restart - to detect a ASSP restart<br />
  notification: too many recipients - for local frequency abuse once per day and sender<br />
  warning: too many recipients - for every local frequency abuse<br />
  MainThread started - to detect a start of ASSP<br />
  Admin connection - for GUI logon<br /><br />
  You may define a comma separated list (after \'=>\') of recipients in every line, this will override the default recipient defined in \'Notify\'.<br />
  for example: adminupdate:=>user1@yourdomain.com,user2@yourdomain.com.<br />
  As third parameter after a second (\'=>\') you can define the subject line for the notification message.<br />
  for example: adminupdate:=>user1@yourdomain.com,user2@yourdomain.com=>configuration was changed<br />
  or: adminupdate:=>=>configuration was changed.',undef,undef,'msg006520','msg006521'],
['NoNotifyRe','Do NOT Notify, if log entry matches*',60,\&textinput,'','(.*)','ConfigCompileRe','Regular Expression to identify loglines for which no notification message should be send.<br />
  for example:<br />
  user root - if root does anything<br />
  \[root.*?\] - if root changes the config',undef,undef,'msg006530','msg006531'],
['fileLogging','File name logging',0,\&checkbox,'','(.*)',undef,'Show file names of collected spam/notspam in log. Will be automaticly set to on, if inclResendLink is not set to disabled.',undef,undef,'msg006540','msg006541'],
['subjectLogging','Subject logging',0,\&checkbox,1,'(.*)',undef,'Show subject of mail in log ',undef,undef,'msg006550','msg006551'],
['subjectStart','Subject Start Delimiter',2,\&textinput,'[','(.*)',undef,'Start delimiter of subject in log ',undef,undef,'msg006560','msg006561'],
['subjectEnd','Subject End Delimiter',2,\&textinput,']','(.*)',undef,'End delimiter of subject in log',undef,undef,'msg006570','msg006571'],
['regexLogging','Regex Match logging',0,\&checkbox,1,'(.*)',undef,'Show matching regex in log, note that all lists (like eg. noprocessing-list) are used as regex. ',undef,undef,'msg006580','msg006581'],
['WorkerLogging','Worker logging',0,\&checkbox,1,'(.*)',undef,'Show Workername in Log. ',undef,undef,'msg006590','msg006591'],
['ipmatchLogging','IP Matches Logging',0,\&checkbox,'','(.*)',undef,
  'Enables logging of IP addresses matches in the maillog. Will show a comment instead of the range if there is text after the IP ranges (and before any numbersign)  eg. 182.82.10.0/24 AOL',undef,undef,'msg006600','msg006601'],
['slmatchLogging','Logging Address Matches',0,\&checkbox,'','(.*)',undef,
  'Enables logging of address matches in the maillog.',undef,undef,'msg006610','msg006611'],
['AddRegexHeader','Add RegEx Match Header',0,\&checkbox,'','(.*)',undef,'',undef,undef,'msg006620','msg006621'],
['uniqeIDLogging','Unique ID logging',0,\&checkbox,1,'(.*)',undef,'Add unique string to log  ',undef,undef,'msg006630','msg006631'],
['uniqueIDPrefix','Prepend Unique ID logging',10,\&textinput,'m1-','(.*)',undef,
  'Prepend ID. For example: m1-',undef,undef,'msg006640','msg006641'],
['tagLogging','Spam Tag Logging',0,\&checkbox,1,'(.*)',undef,'Add spam tag to log.',undef,undef,'msg006650','msg006651'],

['replyLogging','SMTP Status Code Reply Logging','0:disabled|1:enabled - exclude [123]XX|2:enabled - all',\&listbox,1 ,'(\d*)',undef,undef,undef,undef,'msg006660','msg006661'],
['expandedLogging','Logging Records include IP & MailFrom',0,\&checkbox,1,'(.*)',undef,'',undef,undef,'msg006670','msg006671'],

['sysLog','SYSLOG Centralized Logging',0,\&checkbox,'','(.*)','ConfigChangeSysLog','Enables logging to UNIX or Network Syslog. Needs Sys::Syslog for local (UNIX/LINUX) logging.',undef,undef,'msg006680','msg006681'],
['sysLogPort','Syslog Port (UDP)',5,\&textinput,'514','(\d*)','ConfigChangeSysLog',
  'Port for Network Syslog logging.',undef,undef,'msg006690','msg006691'],
['SysLogFac','Syslog Facility',40,\&textinput,'mail','(\S*)','ConfigChangeSysLog',
  'Syslog Facility. Valid are kern, user, mail, daemon, auth, syslog, lpr, news, uucp, cron, authpriv, ftp, local0, local1, local2, local3, local4, local5, local6',undef,undef,'msg006700','msg006701'],
['sysLogIp','Syslog IP',40,\&textinput,'','^(' . $HostRe .'|)$','ConfigChangeSysLog',
  'IP Address or hostname of your Network Syslog Daemon for Syslog logging.',undef,undef,'msg006710','msg006711'],
['asspLog','ASSP local logging',0,\&checkbox,'1','(.*)',undef,'ASSP manages local logging. The logs (logfile) are stored inside the directory where ASSP is installed.',undef,undef,'msg006720','msg006721'],
['LogRollDays','Roll the Logfile How Often?',5,\&textinput,'1','([1-9]\d*)',undef,
  'ASSP closes and renames the log file after this number of days.',undef,undef,'msg006730','msg006731'],
['LogNameMMDD','No Year in LogName',0,\&checkbox,'','(.*)',undef,'The standard name for the logfile is YY-MM-DD.maillog.txt, use this option to set it to MM-DD.maillog.txt',undef,undef,'msg006740','msg006741'],
['LogDateFormat','Date/Time Format in LogDate',30,\&textinput,'MMM-DD-YY hh:mm:ss','((?:(?:MM|MMM|DD|DDD|YY|YYYY)(?:[\_\-\. \/]|)){3}(?:[\-\_ ]*)(?:(?:hh|mm|ss)(?:[\.:\-\_]|)){3})',undef,'Use this option to set the logdate. The default value is \'MMM-DD-YY hh:mm:ss\'. The following (case sensitive !) replacements will be done:<br /><br />
 YYYY - year four digits<br />
 YY - year two digits<br />
 MMM - month (three charactes) alpha numeric - like Oct Nov Dec<br />
 MM - month numeric two digits<br />
 DDD - day (three charactes) alpha numeric - like Mon Tue Fri<br />
 DD - day numeric two digits<br />
 hh - hour two digits<br />
 mm - minute two digits<br />
 ss - second two digits<br /><br />
 <span class="positive">A value has to be defined for every part of the date/time, the date must be the first part. Allowed separators in date part are \'_ -./\' - in time part \'-_.:\' .</span>',undef,undef,'msg008690','msg008691'],
['LogDateLang','Date/Time Language','0:English|1:Français|2:Deutsch|3:Español|4:Português|5:Nederlands|6:Italiano|7:Norsk|8:Svenska|9:Dansk|10:suomi|11:Magyar|12:polski|13:Romaneste',\&listbox,0,'(.*)',undef,
  'Select the language for the day and month if LogDateFormat contains DDD and/or MMM.',undef,undef,'msg008700','msg008701'],
['silent','Silent Mode',0,\&checkbox,'','(.*)',undef,
  'Checked means don\'t print log messages to the console. AsADaemon overrides this.',undef,undef,'msg006750','msg006751'],
['debug','General Debug Mode',0,\&checkbox,'','(.*)','ConfigDEBUG',
  'Checked sends debugging info to a .dbg file. Debug is enabled for all Threads, all the time! debugIP and debugRE will be ignored!
  Leave this unchecked unless there is a program error you are trying to track down.',undef,undef,'msg006760','msg006761'],
['debugIP','Debug these IPs*',40,\&textinput,'','(\S*)','ConfigMakeIPRe',
  'Enter IP addresses that you want to be debugged, separated by pipes (|). The local and the remote IP of the connection will be checked!<br />
  Not blank sends debugging info to a .dbg file. Leave this blank unless there is a program error you are trying to track down.<br />
  This can be IP address of the SMTP service monitoring agent. For example:  127.0.0.1|172.16.',undef,'7','msg006770','msg006771'],
['debugRe', 'Regular Expression to Identify Debug-Messages*',80,\&textinput,'','(.*)','ConfigCompileRe',
 'Put anything here to identify messages that you want to be debugged.  Not blank sends debugging info to a .dbg file. Leave this blank unless there is a program error you are trying to track down.',undef,undef,'msg006780','msg006781'],
['debugCode', 'Run this Code to switch on Debug',80,\&textinput,'','(.*)',undef,
 'Put a code line here, to detect messages that you want to debug. The code line has to return 0 or 1. A return of 1 will switch on debug.<br />
  for example:<br /><br />
  $Con{$fh}->{isbounce}<br />
  This code line will switch on debug for all bounce messages.<br /><br />
  ($Con{$fh}->{relayok} && $Con{$fh}->{isbounce})<br />
  This code line will switch on debug for all outgoing bounce messages.<br /><br />
  ($Con{$fh}->{ispip} && $Con{$fh}->{cip} =~ /^193\.2\.1\./)<br />
  This code line will switch on debug if the messages is from ISP and the IP of the server that was connected to the ISP begins with 193.2.1. .<br /><br />
  To use this option, you need to know the internal ASSP variables and their usage!',undef,undef,'msg006790','msg006791'],
['debugNoWriteBody','Do not write Body to Debug',0,\&checkbox,'','(.*)',undef,'If selected, the sent message body data will not be written to the debug file.',undef,undef,'msg006800','msg006801'],
['DataBaseDebug','Database Connection Debug Mode',0,\&checkbox,'','(.*)',undef,'Select to debug the database connections!',undef,undef,'msg006810','msg006811'],
['ConTimeOutDebug','Connection Timeout Debug Mode',0,\&checkbox,'','(.*)',undef,'Select to debug SMTP connections that are running in to timeout!',undef,undef,'msg006820','msg006821'],
['IgnoreMIMEErrors','Ignore MIME Errors',0,\&checkbox,1,'(.*)',undef,'If selected - Errors, based on wrong email MIME contents, will not be written to log!',undef,undef,'msg006830','msg006831'],
['noLog','Don\'t Log these IPs*',40,\&textinput,'','(\S*)','ConfigMakeIPRe',
  'Enter IP addresses that you don\'t want to be logged, separated by pipes (|). The local and the remote IP of the connection will be checked!<br />
  This can be IP address of the SMTP service monitoring agent. For example:  127.0.0.1|172.16.',undef,'7','msg006840','msg006841'],
['noLogRe', 'Regular Expression to Identify NoLog-Messages*',80,\&textinput,'','(.*)','ConfigCompileRe',
 'Put anything here to identify messages that you don\'t want to be logged.',undef,undef,'msg006850','msg006851'],
['allLogRe', 'Regular Expression to Identify Messages from/to Problematic Addresses *',80,\&textinput,'','(.*)','ConfigCompileRe',
 'Put anything here to identify messages from/to addresses you want to look at for problem solving. Messages identified will also be set to StoreCompleteMail.',undef,undef,'msg006860','msg006861'],
['noLogLineRe', 'Regular Expression to Identify skipped Log Lines*',80,\&textinput,'','(.*)','ConfigCompileRe',
 'Put anything here to identify log Lines that you don\'t want to be logged.',undef,undef,'msg008680','msg008681'],
['ConnectionLog','Connections Logging','0:nolog|1:standard|2:verbose|3:diagnostic',\&listbox,0,'(.*)',undef,
  '',undef,undef,'msg006870','msg006871'],
['SessionLog','Session Limit Logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg006880','msg006881'],
['denySMTPLog','Enables Logging for \'Deny SMTP Connections From\'','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,'',undef,undef,'msg006890','msg006891'],
['RWLLog','Enable RWL logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg006900','msg006901'],
['LDAPLog','Enable LDAP logging','0:nolog|1:standard|2:verbose|3:diagnostic',\&listbox,1,'(.*)',undef,
  'ATTENTION: diagnostic will possibly write credital information in clear text to the log!',undef,undef,'msg006910','msg006911'],
['VRFYLog','Enable VRFY logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg006920','msg006921'],
['ValidateUserLog','Enable User Validation logging','0:nolog|1:standard|2:verbose|3:diagnostic',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg006930','msg006931'],
['PenaltyLog','Enable PenaltyBox logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(\d*)',undef,
  '',undef,undef,'msg006940','msg006941'],
['PenaltyExtremeLog','Enable PenaltyBox logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(\d*)',undef,
  '',undef,undef,'msg006950','msg006951'],
['MessageLog','Enable Message Scoring logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg006960','msg006961'],
['MSGIDsigLog','Enable Message-ID signing logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg006970','msg006971'],
['BacksctrLog','Enable DNS-Backscatter detection logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg006980','msg006981'],
['BATVLog','Enable BATV logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg006990','msg006991'],
['ValidateSenderLog','Enable Validate Sender Logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg007000','msg007001'],
['SenderBaseLog','Enable SenderBase Logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg007010','msg007011'],
['DelayLog','Enable Greylisting/Delaying logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg007020','msg007021'],
['BombLog','Enable Bomb logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  'If set to verbose, the reporting to the logfile and the X-ASSP- scoring header will show the complete list of all hits. Otherwise only the highest match will be shown.',undef,undef,'msg007030','msg007031'],
['AttachmentLog','Enable Attachment logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg007040','msg007041'],
['SPFLog','Enable SPF logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg007050','msg007051'],
['RBLLog','Enable DNSBL logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg007060','msg007061'],
['URIBLLog','Enable URIBL logging','0:nolog|1:standard|2:verbose|3:diagnostic',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg007070','msg007071'],
['ScanLog','Enable ClamAV logging','0:nolog|1:standard|2:verbose|3:diagnostic',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg007080','msg007081'],
['DKIMlogging','Enable DKIM logging','0:nolog|1:standard|2:verbose|3:diagnostic',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg007090','msg007091'],
['WorkerLog','Enable thread action logging','0:nolog|1:standard|2:verbose|3:diagnostic',\&listbox,0,'(.*)',undef,
  '',undef,undef,'msg007100','msg007101'],
['SignalLog','Enable central Perl-signal logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  'nolog will handle the Perl signals without any output, standard will write a message to log, verbose will write a message to log and to file debugSignal.txt',undef,undef,'msg007110','msg007111'],
['BayesianLog','Enable Bayesian Logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  'Enables verbose logging of  Bayesian checks in the maillog.',undef,undef,'msg007120','msg007121'],
['ConvLog','Enable Conversion logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg007130','msg007131'],
['MaintenanceLog','Enable Maintenance logging','0:nolog|1:standard|2:verbose|3:diagnostic',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg007140','msg007141'],
['PerformanceLog','Enable Performance logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg007150','msg007151'],
['ReportLog','Enable Report logging','0:nolog|1:standard|2:verbose|3:diagnostic',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg007160','msg007161'],
['ScheduleLog','Enable Scheduler logging','0:nolog|1:standard|2:verbose',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg007170','msg007171'],
['SNMPLog','Enable SNMP logging','0:nolog|1:standard|2:verbose|3:diagnostic',\&listbox,1,'(.*)',undef,
  '',undef,undef,'msg009420','msg009421'],
['Showmaxreplies','Show All Possible Hits ',0,\&checkbox,'','(.*)',undef,
  'Show hits until maxreplies instead of stopping at maxhits (RBL,URIBL,RWL).',undef,undef,'msg007180','msg007181'],
['RegExLength','RegEx Length in Log',2,\&textinput,32,'(\d*)',undef,
  'Defines how many bytes of a matching Regular Expression will be shown in the log<br />
  Some matching Regular Expressions are too long for one line. Default: 32',undef,undef,'msg007190','msg007191'],
['sendNoopInfo','Send NOOP Info',0,\&checkbox,'','(.*)',undef,
  'Checked means you want ASSP to send a "NOOP Connection from $ip" message to your SMTP server.
  <br /><hr />
  <div class="menuLevel1">Notes On Logging</div>
  <input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/logging.txt\',3);" />',undef,undef,'msg007200','msg007201'],

[0,0,0,'heading','LDAP Setup <a href="http://apps.sourceforge.net/mediawiki/assp/index.php?title=LDAP" target=wiki><img height=12 width=12 src="' . $wikiinfo . '" alt="LDAP" /></a>'],
['LDAPHost','LDAP Host(s)',80,\&textinput,'localhost','^((?:(?:'.$HostRe.'|'.$HostPortRe.')(?:\|(?:'.$HostRe.'|'.$HostPortRe.'))*)|)$','updateLDAPHost','Enter the DNS-name(s) or IP address(es) of the server(s) that run(s) the <a href="http://ldap.perl.org/FAQ.html">LDAP</a> database. Second entry is backup. For example: localhost. Separate entries with pipes: LDAP-1.domain.com|LDAP-2.domain.com . To use a different than the default LDAP port, define host:port.' ,undef,undef,'msg007210','msg007211'],
['DoLDAPSSL','Use SSL with LDAP (ldaps)','0:no|1:SSL|2:TLS',\&listbox,'0','(.*)',undef,'ASSP will use \'ldaps (SSL port 636)\' instead of ldap (port 389) or \'ldaps (TLS over port 389)\'. The Perl module <a href="http://search.cpan.org/search?query=IO::Socket::SSL" rel="external">IO::Socket::SSL</a> must be installed to use SSL or TLS!',undef,undef,'msg007220','msg007221'],
['LDAPtimeout','LDAP Query Timeout',2,\&textinput,15,'(\d+)',undef,'timeout when connecting to the remote server. The default is 15 seconds.',undef,undef,'msg007230','msg007231'],
['LDAPLogin','LDAP Login',80,\&passinput,'','(.*)',undef,'Most LDAP servers require a login and password before they allow queries.<br />Enter the DN specification for a user with sufficient permissions here.<br />For example: cn=Administrator,cn=Users,DC=yourcompany,DC=com',undef,undef,'msg007240','msg007241'],
['LDAPPassword','LDAP Password',20,\&passinput,'','(.*)',undef,'Enter the password for the specified LDAP login here.',undef,undef,'msg007250','msg007251'],
['LDAPVersion','LDAP Version',1,\&textinput,3,'(\d+)',undef,'Enter the version for the specified LDAP here.',undef,undef,'msg007260','msg007261'],
['ldLDAPRoot','LDAP Root container for Local Domains',80,\&textinput,'','(.*)',undef,'The LDAP lookup will use this container and all sub-containers to match the local domain query.<br />The literal DOMAIN is replaced by the domain part of SMTP recipient (eg. domain.com) during the search.<br />For example: DC=yourcompany,DC=com.<br />If you use DOMAIN here, you must check "LDAP failures return false" below or non local domains will be treated as local. If not defined, LDAPRoot will be used.',undef,undef,'msg009350','msg009351'],
['ldLDAPFilter','LDAP Filter for Local Domains',80,\&textinput,'','(\S*)',undef,'This filter is used to query the LDAP database. This strongly depends on the LDAP structure.<br />The filter must return an entry if the domain must be relayed.<br />
  The literal DOMAIN is replaced by the domain name during the search.<br />
  for example: (&amp;(|(|(|(|(&amp;(objectclass=user)(objectcategory=person))(objectcategory=group))(objectclass=publicfolder))(!(objectclass=contact)))(objectclass=msExchDynamicDistributionList))(proxyaddresses=smtp:*@DOMAIN))',undef,undef,'msg007280','msg007281'],
['LDAPRoot','LDAP Root container for Local Addresses',80,\&textinput,'','(.*)',undef,'The LDAP lookup will use this container and all sub-containers to match the local email address query.<br />The literal DOMAIN is replaced by the domain part of SMTP recipient (eg. domain.com) during the search.<br />For example: DC=yourcompany,DC=com.<br />If you use DOMAIN here, you must check "LDAP failures return false" below or non local domains will be treated as local.',undef,undef,'msg007270','msg007271'],
['LDAPFilter','LDAP Filter for Local Addresses',80,\&textinput,'','(\S*)',undef,'This filter is used to query the LDAP database. This strongly depends on the LDAP structure.<br />The filter must return an entry if the recipient address matches with that of any user.<br />The literal EMAILADDRESS is replaced by the fully qualified SMTP recipient (eg. user@domain.com) during the search.<br />The literal USERNAME is replaced by the user part of SMTP recipient (eg. user) during the search.<br />The literal DOMAIN is replaced by the domain part of SMTP recipient (eg. domain.com) during the search.<br />For example: (proxyaddresses=smtp:EMAILADDRESS) or (|(mail=EMAILADDRESS)(mailaddress=EMAILADDRESS)) or<br />
 (&amp;(|(|(|(|(&amp;(objectclass=user)(objectcategory=person))(objectcategory=group))(objectclass=publicfolder))(!(objectclass=contact)))(objectclass=msExchDynamicDistributionList))(proxyaddresses=smtp:EMAILADDRESS))',undef,undef,'msg007290','msg007291'],
['LDAPcrossCheckInterval','Clean Up local LDAP/VRFY Database <sup>s</sup>',40,\&textinput,12,$ScheduleGUIRe,'configChangeSched',
  'Delete outdated entries from the LDAP/VRFY cache. Check the LDAP cache to the LDAP server and/or VRFY-MTA and delete not existing entries.<br />
  Defaults to 12 hours. Is only used, if ldaplistdb is defined in the database section!',undef,undef,'msg007300','msg007301'],
['LDAPShowDB','Show local LDAP Database',40,\&textinput,'file:ldaplist','(\S*)',undef,'The directory/file with the LDAP cache database file. If you change ldaplistdb in section Filepath you must change it here too.',undef,'8','msg007310','msg007311'],
['forceLDAPcrossCheck','force to run LDAP/VRFY-CrossCheck - now.',0,\&checkbox,'','(.*)','ConfigChangeRunTaskNow','ASSP will force to run a LDAP/VRFY-CrossCheck now!<br />'. "<input type=button value=\"Run Now!\" onclick=\"document.forms['ASSPconfig'].theButtonX.value='Apply Changes';document.forms['ASSPconfig'].submit();WaitDiv();return false;\" />&nbsp;<input type=button value=\"Refresh Browser\" onclick=\"document.forms['ASSPconfig'].theButtonRefresh.value='Apply Changes';document.forms['ASSPconfig'].submit();WaitDiv();return false;\" />",undef,undef,'msg007320','msg007321'],
['MaxLDAPlistDays','Max LDAP/VRFY cache Days',5,\&textinput,'30','(\d+)',undef,'This is the number of days an address will be kept on the local LDAP/VRFY cache without any email to this address.',undef,undef,'msg007330','msg007331'],
['LDAPFail','LDAP/VRFY failures return false',20,\&checkbox,'','(.*)',undef,'If checked, when an error occurs in LDAP or VRFY lookups, the test fails.<hr /><div class="menuLevel1">Notes On LDAP </div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/ldap.txt\',3);" />',undef,undef,'msg007340','msg007341'],

[0,0,0,'heading','DNS Setup'],
['UseLocalDNS','Use Local DNS',0,\&checkbox,1,'(.*)','updateUseLocalDNS','Use system default local DNS Name Servers. To use system default local DNS Servers and the configured DNSServers (below), unselect this option and define the system default local DNS Servers in addition below!<br />
  all configured or local DNS Name Servers will be checked <span class="negative">this may take some time if the servers are responding slow- please wait after apply changes!</span>',undef,undef,'msg007350','msg007351'],
['DNSResponseLog','Show DNS Name Servers Response Time in Log',0,\&checkbox,0,'(.*)',undef,'You can use this to arrange DNSServers for better performance. Put the fastest first.',undef,undef,'msg007360','msg007361'],
['DNSServers','DNS Name Servers*',80,\&textinput,'208.67.222.222|208.67.220.220','^((?:(?:'.$HostRe.'|'.$HostPortRe.')(?:\|(?:'.$HostRe.'|'.$HostPortRe.'))*)(?:\s*=>\s*'.$HostRe.'\.?)?|(?:\s*=>\s*'.$HostRe.'\.?)|)$','updateDNS',
 'DNS Name Servers IP\'s to use for DNSBL, RWL, URIBL, PTR, SPF2 lookups. Separate multiple entries by "|" or leave blank to use system defaults.<br /> For example: 208.67.222.222|208.67.220.220 (<a href="http://www.opendns.com/" rel="external">OpenDNS</a>).<br />
  An DNS-query for the domain \'sourceforge.net\' is used per default to measure the speed of the used DNS-servers. If you want assp to use another domain or hostname for this, append \'=>domain.tld\' at the end of the line - like: 208.67.222.222|208.67.220.220=>myhost.com<br />
  To define the domain if you use the local DNS-servers \'UseLocalDNS\' without defining any DNS-servers here, simply write \'=>myhost.com\'.<br />
  All configured or local DNS Name Servers will be checked <span class="negative">this may take some time if the servers are responding slow - please wait after apply changes!</span>',undef,undef,'msg007370','msg007371'],
['maxDNSRespDist','Maximum DNS Responstime change',3,\&textinput,50,'([1-9]\d*)',undef,'Maximum DNS Server responstime change in milliseconds before the query order of the name servers should be changed.',undef,undef,'msg009800','msg009801'],
['DNStimeout','DNS Query Timeout',2,\&textinput,5,'(\d+)','updateUseLocalDNS','Global DNS Query Timeout for DNSBL, RWL, URIBL, PTR, SPF, MX and A record lookups. The default is 5 seconds.',undef,undef,'msg007380','msg007381'],
['DNSretry','DNS Query Retry',2,\&textinput,1,'(\d+)','updateUseLocalDNS','Global DNS Query Retry. Set the number of times to try the query. The default is 1.',undef,undef,'msg007390','msg007391'],
['DNSretrans','DNS Query Retrans',2,\&textinput,3,'(\d+)','updateUseLocalDNS','Global DNS Query Retransmission Interval. Set the retransmission interval. The default is 3.<br /><hr />
  <div class="menuLevel1">Notes On DNS Setup</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/DNSsetup.txt\',3);" />',undef,undef,'msg007400','msg007401'],

[0,0,0,'heading','Server Setup'],
['ConsoleCharset','Charset for STDOUT and STDERR',$Charsets,\&listbox,'0','(.*)',undef,
 'Set the characterset/codepage for the console output to your local needs. Default is "System Default" - default conversion. To display nonASCII characters on the console screen, setup UseUnicode4MaillogNames . <span class=\'negative\'>Restart is required!</span>',undef,undef,'msg007410','msg007411'],
['send250OK','Send 250 OK ',0,\&checkbox,'','(.*)',undef,
 'Set this checkbox if you want ASSP to reply with \'250 OK\' instead of SMTP error code \'554 5.7.1\'. This will turn ASSP in some form of tarpit. ',undef,undef,'msg007430','msg007431'],
['AsADaemon','Run ASSP as a Daemon','0:No|1:Yes - externaly controlled|2:Yes - run AutoRestartCmd on restart and wait|3:Yes - run AutoRestartCmd on restart and exit',\&listbox,'0','(.*)',undef,'In Linux/BSD/Unix/OSX fork and close file handles. <br />
 Similar to the command "perl assp.pl &amp;", but better.<br />
 If "externaly controlled" is selected, ASSP simply ends and you have to restart assp from your daemon or watchdog script<br />
 If "run AutoRestartCmd on restart and wait" is selected, assp starts the OS command defined in AutoRestartCmd - assp will <b>NOT !</b> automaticaly terminate - the started command has to terminate/kill and to (re)start assp - like "service assp restart"!<br />
 If "run AutoRestartCmd on restart and exit" is selected, assp starts the OS command defined in AutoRestartCmd and terminates immediatly!<br />
  <span class="negative"> requires ASSP restart</span>',undef,undef,'msg007440','msg007441'],
['runAsUser','Run as UID',20,\&textinput,'','(\S*)',undef,'The *nix user name to assume after startup (*nix only). use the autorestart features carefull, because any restart from inside ASSP will be done with the permission of this user! <p><small><i>Examples:</i> assp, nobody</small></p>
  <span class="negative"> requires ASSP restart</span>',undef,undef,'msg007450','msg007451'],
['runAsGroup','Run as GID',20,\&textinput,'','(\S*)',undef,'The *nix group to assume after startup (*nix only).<p><small><i>Examples:</i> assp, nobody</small></p>
  <span class="negative"> requires ASSP restart</span>',undef,undef,'msg007460','msg007461'],
['ChangeRoot','Change Root',40,\&textinput,'','(.*)',undef,'The new root directory to which ASSP should chroot (*nix only). If blank, no chroot jail will be used. Note: if you use this feature, be sure to copy or link the etc/protocols file in your chroot jail.<br />
  <span class="negative"> requires ASSP restart</span>',undef,undef,'msg007470','msg007471'],
['setFilePermOnStart','Set ASSP File Permission on Startup',0,\&checkbox,'','(.*)',undef,'If set, ASSP sets the permission of all ASSP- files and directories at startup to full (0777) - without any function on windows systems!',undef,undef,'msg007480','msg007481'],
['checkFilePermOnStart','Check ASSP File Permission on Startup',0,\&checkbox,'','(.*)',undef,'If set, ASSP checks the permission of all ASSP- files and directories at startup - all files must be writable for the running job - the minimum permission is 0600 - without any function on windows systems!',undef,undef,'msg007490','msg007491'],
['AutoRestart','Automatic Restart after Exception',0,\&checkbox,'','(.*)',undef,'If ASSP detects a main exception and it runs not as service or daemon, it will try to restart it self automaticly!  If running as daemon on nix/MAC , ASSP uses the action defined in AsADaemon to restart.',undef,undef,'msg007500','msg007501'],
['AutoRestartAfterCodeChange','Automatic Restart ASSP on new or changed Script',20,\&textinput,'','^(|immed|[1-9]|1[0-9]|2[0-3])$',undef,'If selected, ASSP will restart it self, if it detects a new or changed running script. An automatic restart will not be done, if ASSP is not running as a service on windows or as daemon on linux/MAC, and AutoRestartCmd is not configured. If running as daemon on linux/MAC ( AsADaemon ) ASSP simply ends - you have to restart assp from your daemon script. Leave this field empty to disable the feature. Possible values are \'immed and 1...23\' . If set to \'immed\', assp will restart within some seconds after a detected code change. If set to \'1...23\' the restart will be scheduled to that hour. A restart at 00:00 is not supported.',undef,undef,'msg007510','msg007511'],
['AutoUpdateASSP','Auto Update the Running Script (assp.pl)','0:no auto update|1:download only|2:download and install',\&listbox,'0','(.*)','ConfigChangeAutoUpdate',
 'No action will be done if \'no auto update\' is selected. You\'ll get a hint in the GUI (top) and a log line will be written, if a new version is availabe at the download location.<br />
  If \'download only\' is selected and a new assp version is available, this new version will be downloaded to the directory ' . $base . '/download (assp.pl) and the syntax will be checked. The still running script will be saved version numbered to the download directory.<br />
  If \'download and install\' is selected, in addition the still running script will be replaced by the new version.<br />
  Configure ( AutoRestartAfterCodeChange ), if you want the new version to become the active running script.<br />
  If this value is changed to \'download and install\', the autoupdate procedure will be scheduled immediatly.<br />
  If set, ASSP (on windows systems with ActivePerl installations) will search for updated Perl modules in all registered PPM respositories &nbsp;&nbsp;<input type="button" value="new available perl modules" onclick="javascript:popFileEditor(\'notes/avail_perl_modules.txt\',5);" /><br />
  The installation of some modules could require manual configuration and the installation failes or an upgrade is not recommended. In this case put the case sensitive module names (one per line) in the followog file. &nbsp;&nbsp;<input type="button" value="never upgrade these modules" onclick="javascript:popFileEditor(\'files/noupgrade.txt\',1);" /><br />
  If this value is set to \'download and install\', ASSP will try an autoupdate of the new available modules. It is possible, that some modules could not be installed, because the XS module parts are still in use. In this case follow the instruction - click the "new available perl modules" button above. To disable the automatic Perl module update - set "noModuleAutoUpdate" below.<br />
  Click this button to see the log file for the updated modules&nbsp;&nbsp;<input type="button" value="module upgrade log" onclick="javascript:popFileEditor(\'notes/upgraded_Perl_Modules.log\',1);" /><br />
  The perl module <a href="http://search.cpan.org/dist/Compress-Zlib/" rel="external">Compress::Zlib</a> is required to use this feature.',undef,undef,'msg008810','msg008811'],
['noModuleAutoUpdate','No Automatic Perl Module update',0,\&checkbox,'','(.*)',undef,'If set, ASSP will skip the automatic Perl module update.',undef,undef,'msg007900','msg007901'],
['AutoRestartCmd','OS-shell command for AutoRestart',100,\&textinput,'','(.*)',undef,'The OS level shell-command that is used to autorestart ASSP, if it runs not as a service or daemon! A possible value for your system is:<br /><font color=blue>'.$dftrestartcmd.'</font><br />Leave this field blank, if ASSP runs inside an external loop (inside the OS like assp.sh or assp.cmd). If running on NIX systems and runAsUser and/or runAsGroup is used, don\'t forget to switch back to root permissions in the script!',undef,undef,'msg007520','msg007521'],
['RestartEvery','Restart Timeout',10,\&textinput,'0','(\d+)','configChangeRestartEvery',
  'ASSP will automatically terminate and restart after this many seconds. Use this setting to periodically reload configuration data, combat potential memory leaks, or perform shutdown/startup processes. This will only work properly if ASSP runs as a Windows service or in a script that restarts it after it stops or AutoRestartCmd is configured. Alternative to this field you can use ReStartSchedule, to schedule restarts.',undef,undef,'msg007530','msg007531'],
['ReStartSchedule','Schedule Cron time for ASSP Restart',50,\&textinput,'noschedule','^((?:'.$ScheduleRe.'(?:\|'.$ScheduleRe.')*)|noschedule)$','configChangeRSRBSched','If <b>not</b> set to "noschedule" (noschedule is default), ASSP uses scheduled times to shutdown or restart ( AutoRestartCmd )! The syntax is the same like in <a href="http://en.wikipedia.org/wiki/Cron" rel="external">"Vixie" cron</a>! To disable this Scheduler leave this field blank!<b> Never write quotes in to this field!</b><br />
This requires an installed <a href="http://search.cpan.org/search?query=Schedule::Cron" rel="external">Schedule::Cron</a> module in PERL.<br />
<br /><b>Time and Date specification</b><br />
<br />
Entry is the specification of the scheduled time in crontab format,
which contains five mandatory time and date fields.
Entry can be either a plain string, which contains
a whitespace separated time and date specification.<br />
<br />
The time and date fields are (taken mostly from "Vixie" cron):<br />
<br />
<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH="50%" >
<tr><td><b>field</b></td><td><b>values</b></td></tr>
<tr><td>minute</td><td>0-59</td></tr>
<tr><td>hour</td><td>0-23</td></tr>
<tr><td>day of month</td><td>1-31</td></tr>
<tr><td>month</td><td>1-12 (or as names)</td></tr>
<tr><td>day of week</td><td>0-7 (0 or 7 is Sunday, or as names )</td></tr>
<tr><td>seconds</td><td>0-59 (optional) <b>not supported inside ASSP !!!</b></td></tr>
</table>
<br />
 A field may be an asterisk (*), which always stands for
 "first-last".<br />
<br />
 Ranges of numbers are  allowed.  Ranges are two numbers
 separated  with  a  hyphen.   The  specified  range  is
 inclusive.   For example, 8-11  for an  "hours" entry
 specifies execution at hours 8, 9, 10 and 11.<br />
<br />
 Lists  are allowed.   A list  is a  set of  numbers (or
 ranges)  separated by  commas.   Examples: "1,2,5,9",
 "0-4,8-12".<br />
<br />
 Step  values can  be used  in conjunction  with ranges.
 Following a range with "/<number>" specifies skips of
 the  numbers value  through the  range.   For example,
 "0-23/2" can  be used in  the hours field  to specify
 command execution every  other hour (the alternative in
 the V7 standard is "0,2,4,6,8,10,12,14,16,18,20,22").
 Steps are  also permitted after an asterisk,  so if you
 want to say "every two hours", just use "*/2".<br />
<br />
 Names can also  be used for the "month"  and "day of
 week"  fields.  Use  the  first three  letters of  the
 particular day or month (case doesn\'t matter).<br />
<br />
 Note:<br />
       The day of a command\'s execution can be specified
       by two fields  -- day of month, and  day of week.
       If both fields are restricted (ie, aren\'t *), the
       command will be run when either field matches the
       current  time.  For  example, "30  4 1,15  * 5"
       would cause a command to be run at 4:30 am on the
       1st and 15th of each month, plus every Friday<br />
<br />
Examples:<br />
<br />
<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH="80%" >
<tr><td>8 0 * * *</td><td>==></td><td>8 minutes after midnight, every day</td></tr>
<tr><td>5 11 * * Sat,Sun</td><td>==></td><td>at 11:05 on each Saturday and Sunday</td></tr>
<tr><td>0-59/5 * * * *</td><td>==></td><td>every five minutes</td></tr>
<tr><td>42 12 3 Feb Sat</td><td>==></td><td>at 12:42 on 3rd of February and on each Saturday in February</td></tr>
<tr><td>32 11 * * * 0-30/2</td><td>==></td><td>11:32:00, 11:32:02, ... 11:32:30 every day</td></tr>
</table>
<br />
In addition, ranges or lists of names are allowed.<br />
If you want to define multiple entries separate them by "|"',undef,undef,'msg007540','msg007541'],
['MemoryUsageLimit','Memory Limit in MB that ASSP could use',40,\&textinput,'','^(\d+|)$',undef,
 'The memory limit in megabyte the assp process could use at maximum on your system. Set this to empty or zero to disable the feature. The check is done using the schedule defined in MemoryUsageCheckSchedule . If the assp process uses more memory than the limit at a scheduled time and assp is able to restart it self - a restart will be done within 15 seconds. The user running assp must have read access to /proc on nix systems or must have read access to the WMI provider on windows systems!',undef,undef,'msg009950','msg009951'],
['MemoryUsageCheckSchedule','Schedule(s) to check the ASSP process memory usage <sup>s</sup>',40,\&textinput,'0-59/10 * * * *','^((?:'.$ScheduleRe.'(?:\|'.$ScheduleRe.')*)|)$','configChangeSched',
 'The schedule(s) that is used to check the current memory usage of the assp process compared to the MemoryUsageLimit. Default value is (0-59/10 * * * *), which means every 10 minutes. This requires an installed <a href="http://search.cpan.org/search?query=Schedule::Cron" rel="external">Schedule::Cron</a> module in PERL.',undef,undef,'msg009960','msg009961'],
['myName','My Name',40,\&textinput,'ASSP.nospam','('.$EmailDomainRe.')',undef,'ASSP will identify itself by this name in the email "Received:" header and in the helo when sending report-replies. Usually the fully qualified domain name of the host.<p><small><i>Examples:</i> assp.mydomain.com, ASSP.nospam</small></p>',undef,undef,'msg007550','msg007551'],
['myNameAlso','Additional My-Name-Definitions',40,\&textinput,'','^('.$EmailDomainRe.'(?:[\|\s,]+'.$EmailDomainRe.')*|)$',undef,'If myName was changed or you use shared folders (multiple ASSP) for the corpus files, define the old or other host names here - separate multiple entries by pipe, space or comma. ASSP will use this host names in addition to myName, to detect the received headerlines while the rebuildspamdb is running and in the mail analyzer.',undef,undef,'msg007880','msg007881'],
['myHelo','My Helo','0:transparent|1:use myName|2:use FQDN',\&listbox,0,'(\d)',undef,'How ASSP will identify itself when connecting to the target MTA.<br>
  transparent - the Helo of the sender will be used<br />
  use myName - myName will be used<br />
  use FQDN - fully qualified domain name of the host assp is running on',undef,undef,'msg007560','msg007561'],

['HideIPandHelo','Hide IP and/or Helo',40,\&textinput,'','(.*)',undef,'Replace any of these information ( ip=127.0.0.1 helo=anyhost.local ) in our received header for outgoing mails. use the syntax ip=127.0.0.1 and/or helo=anyhost.local .',undef,undef,'msg009830','msg009831'],
['asspCfg','assp.cfg*',40,\&textnoinput,'file:assp.cfg','(.*)','configUpdateASSPCfg','For internal use only - it is assp.cfg file. Do not change this value.',undef,undef,'msg007570','msg007571'],
['AutoReloadCfg','Automatic Reload ConfigFile',0,\&checkbox,'','(.*)','configChangeAutoReloadCfg','If selected and the assp.cfg file is changed externaly, ASSP will reload the configuration from the file automaticly.',undef,undef,'msg007580','msg007581'],
['asspCfgVersion','assp.cfg version',40,\&textnoinput,'','(.*)',undef,'ASSP will identify the assp.cfg file. Do not change this.',undef,undef,'msg007590','msg007591'],
['ConfigChangeSchedule','Schedule Configuration Changes*',40,\&textinput,'','(file:.+|)','configChangeConfigSched',
 'Use this option to schedule configuration changes. You must use the file option like \'file:files/configchangeschedule.txt\' to define schedules - an empty value disables this feature.<br />
 Define one schedule per line - comments are not allowed in a schedule definition line!<br />
 The line has to start with the schedule string ( see ReStartSchedule ) followed by the variable (or hidden variable ) name to change, followed by \':=\', followed by the value to change the variable to - like:<br /><br />
 8 0 * * * myNameAlso:=otherhost1.mydomain.tld<br />
 0 6 * * *|0 10 * * * myNameAlso:=otherhost2.mydomain.tld<br />
 0 1 * * * debug:=1<br />
 0 2 * * * debug:=<br /><br />
 The schedule string can contain multiple schedule definitions separated by pipe\'|\'. You will get errors if:<br />
 - the schedule definiton is wrong<br />
 - the variable name is wrong (does not exists)<br />
 - the syntax of the value is wrong<br />
 Notice - assp will only check the syntax at definition time - the logical correctness of the value will be checked at the scheduled time! So, assp will (for example) not check any dependencies at definition time - if a dependency is wrong, the change request at the scheduled time will fail!<br />
 Notice - all configuration changes are done with \'root\' permission! For this reason, this configuration parameter is only visable to root and it is stored encrypted!<br /><br  />
 <span class="negative">For advanced users ONLY:<br />
 Using the following extension, requires a deep internal knowledge of the assp code!</span><br />
 It is also possible to schedule a call to an internal assp subroutine. The name of the subroutine has to begin with a \'&amp;\', the parameters that should passed to the subroutine must be in \'()\' - like:<br />
 0 6 * * * &amp;subname(var1,var2,..,...)<br />
 0 7 * * * &amp;subname()<br />
 Notice: the subroutine will be called in the MainThread and syntax check will be done at run time - possible errors are shown in the log!',undef,undef,'msg009680','msg009681'],
['proxyserver','Proxy Server',20,\&textinput,'','(\S*)',undef,'The Proxy Server to use when uploading global statistics and downloading the greylist.<p><small><i>Examples:</i> 192.168.0.1:8080, 192.168.0.1</small></p>',undef,undef,'msg007600','msg007601'],
['proxyuser','Proxy User',20,\&passinput,'','(\S*)',undef,'The Proxy-UserName that is used to authenticate to the proxy.',undef,undef,'msg007610','msg007611'],
['proxypass','Proxy Password',20,\&passinput,'','(\S*)',undef,'The password for Proxy-UserName that is used to authenticate to the proxy.',undef,undef,'msg007620','msg007621'],
['webAdminPort','Web Admin Port',20,\&textinput,55555,$GUIHostPort,'ConfigChangeAdminPort',
  'The port on which ASSP will listen for http connections to the web administration interface. If you change this, after you click Apply you must change the URL on your browser to reconnect. You may also supply an IP address or hostname to limit connections to a specific interface. Separate multiple entries by pipe "|"!<p><small><i>Examples:</i> 55555, 192.168.0.5:12345, myhost:12345, 192.168.0.5:22345|myhost:12345</small></p>',undef,undef,'msg007630','msg007631'],
['enableWebAdminSSL','Use https instead of http',0,\&checkbox,'','(.*)','ConfigChangeEnableAdminSSL',
 'If selected the web admin interface will be only accessable via https. If you change this, after you click Apply you must change the URL on your browser to reconnect.
  This requires an installed <a href="http://search.cpan.org/search?query=IO::Socket::SSL" rel="external">IO::Socket::SSL</a> module in PERL.<br />
  A server-certificate-file "certs/server-cert.pem" and a server-key-file "certs/server-key.pem" must exist and must be valid!<br />
  If you do not have valid certificates, you may generate both files online with <a href="http://www.mobilefish.com/services/ssl_certificates/ssl_certificates.php" rel="external">www.mobilefish.com</a> or you may use OpenSSL to generate <a href="http://www.mobilefish.com/developer/openssl/openssl_quickguide_self_certificate.html" rel="external">Self-signed SSL certificates</a>!',undef,undef,'msg007640','msg007641'],
['webAdminPassword','Web Admin Password - Masterpassword (root)',20,\&passinput,'nospam4me','(.{5,})','ConfigChangePassword',
 # I hate hidden password input, but if you like it, uncomment this line and comment the next one. -- just quit bugging me about it!
 #[webAdminPassword','Web Admin Password - Masterpassword (root)',20,\&textinput,'nospam4me','(.{5,})',ConfigChangePassword,
  'The password for the web administration interface for user root(minimum of 5 characters). If root is logged on, no other logins are allowed. Always use the "logoff"-button as root to terminate the session - closing the browser without logoff could cause other session to be disallowed.',undef,undef,'msg007650','msg007651'],
['allowAdminConnectionsFrom','Only Allow Admin Connections From*',80,\&textinput,'','(\S*)','ConfigMakeIPRe',
  'An optional list of IP addresses and/or hostnames from which you will accept web admin connections. Blank means accept connections from any IP address.<br /> <span class="negative">Note: if you make a mistake here, you may disable your web administration interface and be forced to manually edit your configuration file to fix it.</span><p><small><i>Examples:</i></small></p>
  127.0.0.1|172.16.',undef,'7','msg007660','msg007661'],
['httpRequireCookies','HTTP and HTTPS require enabled browser cookies',0,\&checkbox,'1','(.*)',undef,
 'Cookie based http session ID\'s are used by assp to handle different requests from the same IP (eg behind NAT). Switch this off, if you are unable to use cookies in your browser. If switched off, a security hole is opened for connection that are using NAT - it could be possible that a second workstation (behind NAT) is able to login to the GUI, without user credentials if the same OS and browser version is used.',undef,undef,'msg009000','msg009001'],
['webStatHealthyResp','Status Response Literal for a Healty State of ASSP',25,\&textinput,'healthy','(.+)',undef,
  'This option must be set and it must be different to webStatNotHealthyResp. This literal will be given back in stat requests, if ASSP is working healty.',undef,undef,'msg009260','msg009261'],
['webStatNotHealthyResp','Status Response Literal for a Not Healty State of ASSP',25,\&textinput,'not healthy','(.+)',undef,
  'This option must be set and it must be different to webStatHealthyResp. This literal will be given back in stat requests, if ASSP is working not healty.',undef,undef,'msg009270','msg009271'],
['webStatPort','Raw Statistics Port',20,\&textinput,55553,$GUIHostPort,'ConfigChangeStatPort',
  'The port on which ASSP will listen for http or telnet connections to the statistics interface. You may also supply an IP address to limit connections to a specific interface. Only one value is supported!<br />
   The stats are available via browser or telnet (or telnet similar socket). Using telnet, press ENTER two times to get the healthy state (\'$Config{webStatHealthyResp} [CRLF]\' or \'$Config{webStatNotHealthyResp} [CRLF]\' in a single line), this is the recommended methode to get the \'UP\'-state of assp from nagios or any other external script.<br />
   Type \'stat[ENTER][ENTER]\' to get the STATS in raw text where each line is terminated with \'[CR]LF\' (CR is send in any case, if the request contains CR).<br />
   The HTML output are LF terminated STAT lines.<p><small><i>Examples:</i> 55553, 192.168.0.5:12345</small></p>',undef,undef,'msg007670','msg007671'],
['enableWebStatSSL','Use https instead of http',0,\&checkbox,'','(.*)','ConfigChangeEnableStatSSL',
 'The web stat interface will be only accessable via https.
  This requires an installed <a href="http://search.cpan.org/search?query=IO::Socket::SSL" rel="external">IO::Socket::SSL</a> module in PERL.<br />
  A server-certificate-file "certs/server-cert.pem" and a server-key-file "certs/server-key.pem" must exits and must be valid!',undef,undef,'msg007680','msg007681'],
['allowStatConnectionsFrom','Only Allow Raw Statistics Connections From*',80,\&textinput,'127.0.0.1','(\S*)','ConfigMakeIPRe',
  'An optional list of IP addresses from which you will accept raw statistical connections. Blank means accept connections from any IP address. <p><small><i>Examples:</i></small></p>
 127.0.0.1|172.16.',undef,undef,'msg007690','msg007691'],
['EnableHTTPCompression','Enable HTTP Compression in GUI',0,\&checkbox,1,'(.*)',undef,
  'Enable HTTP Compression for faster web administration interface loading. The perl module <a href="http://search.cpan.org/dist/Compress-Zlib/" rel="external">Compress::Zlib</a> is required to use this feature.',undef,undef,'msg007700','msg007701'],
['EnableFloatingMenu','Enable Floating Menu Panel in GUI',0,\&checkbox,'','(.*)',undef,
  'Allow the menu panel on the web administration interface to float (floating Div code taken from <a href="http://www.javascript-fx.com" rel="external">www.javascript-fx.com</a>).',undef,undef,'msg007710','msg007711'],
['hideAlphaIndex','Hide the Alpha Index Menu Panel in GUI',0,\&checkbox,'','(.*)',undef,
  'Removes the index panel on the left side in the GUI, but the index is accessable by clicking on "Sorted".',undef,undef,'msg007720','msg007721'],
['IndexSlideSpeed','Sliding Speed of the Alpha Index Menu Panel in GUI','450:no slide|50:fast|10:normal|5:slow',\&listbox,10,'(.*)',undef,
  'Adjust the sliding speed of the Alpha Index Menu Panel in GUI to your needs.',undef,undef,'msg007730','msg007731'],
['RememberGUIPos','Remember the last GUI position',0,\&checkbox,1,'(.*)',undef,
  'If selected, the GUI will remember the last topic of the main menu, that had the focus, was changed, that were jumped to or that were clicked to.',undef,undef,'msg009340','msg009341'],
['EnableInternalNamesInDesc','Show Internal Names in the GUI',0,\&checkbox,1,'(.*)',undef,
  'Show the internal names in the web interface. The internal names are used in the configuration file (assp.cfg), in the application code, and in the menu bar on the left side of the GUI.',undef,undef,'msg007740','msg007741'],
['MaillogTailJump','Jump to the End of the Maillog',0,\&checkbox,'','(.*)',undef,
  'Causes the browser window to jump to the bottom of the maillog instead of sitting at the top of the display.',undef,undef,'msg007750','msg007751'],
['MaillogTailBytes','Maillog Tail Bytes',10,\&textinput,10000,'(\d+)',undef,
  'The number of bytes that will be shown when the end of the maillog is viewed. The default value is 10000.',undef,undef,'msg007760','msg007761'],
['CleanCacheEvery','Cache Cleaning Interval <sup>s</sup>',40,\&textinput,'6',$ScheduleGUIRe,'configChangeSched',
  'This period (in hours) determines how frequently ASSP does cache-housekeeping.',undef,undef,'msg007780','msg007781'],
['SaveStatsEvery','Statistics Save Interval <sup>s</sup>',40,\&textinput,'30',$ScheduleGUIRe,'configChangeSched',
  'This period (in minutes) determines how frequently ASSP statistics are written to a local file.',undef,undef,'msg007790','msg007791'],
['totalizeSpamStats','Upload Consolidated Spam Statistics',0,\&checkbox,1,'(.*)',undef,
 'ASSP will upload its statistics to be consolidated with the <a href="http://assp.sourceforge.net/cgi-bin/assp_stats?stats" rel="external">global ASSP totals</a>. This is a great marketing tool for the ASSP project &mdash; please do not disable it unless you have a good reason to do so. No private information is being disclosed by this upload.',undef,undef,'msg007800','msg007801'],
['enableGraphStats','Enable Graphical Statistics Collection',0,\&checkbox,0,'(.*)',undef,
 'ASSP will collect statistical data in files located in the \'/logs\' folder (scoreGraphStats-YYYY-MM.txt , statGraphStats-YYYY-MM.txt). If data are collected and the module lib/ASSP_SVG.pm is installed and the files images/stat.gplot, images/svg_style.css, images/svg_defs.svg and images/svg.js are installed and your browser supports SVG, assp will show graphical statistic data, if you click on a line in the \'Info and Stats\' view.<br />
 It is recommended to set \'SaveStatsEvery\' to a value of 5 or 10 minutes, if this option is enabled!<br />
 Keep in mind that assp will NOT delete any of the \'*GraphStats...txt\'-files. If you don\'t need some of that files anymore, remove them manualy!',undef,undef,'msg010000','msg010001'],
['ReloadOptionFiles','Reload Option Files Interval <sup>s</sup>',40,\&textinput,'300',$ScheduleGUIRe,'configChangeSched',
  'If set not to zero, ASSP reloads configuration option files (file:.....) every this many seconds if they have changed. It is not recommended (and could make ASSP unavailable) to use rsync or any external tool to synchronise caches and list permanently. If you need to synchronise data between ASSP installations, you better use a database of your choice!',undef,undef,'msg007810','msg007811'],
['host2IPminTTL','Minimum TTL used for config reload',5,\&textinput,300,'(\d+)',undef,'Minimum TTL used for config reload options, if hostnames are defined for any IP in regular expressions.',undef,undef,'msg009810','msg009811'],
['OrderedTieHashTableSize','Ordered-Tie Hash Table Size',10,\&textinput,10000,'(\d+)',undef,
 'The number of entries allowed in the hash tables used by ASSP. This only belongs to Griplist if useDB4IntCache is not set. Larger numbers require more RAM but result in fewer disk hits. The default value is 10000. Adjust down to use less RAM.',undef,undef,'msg007820','msg007821'],
['OutgoingBufSizeNew','Size of TCP/IP Buffer',10,\&textinput,10240000,'(\d+)',undef,
 'The default is 10240000. Even more is better...',undef,undef,'msg007830','msg007831'],
['useDB4IntCache','Use BerkeleyDB for Internal Caches',0,\&checkbox,'','(.*)','configChangeDB',
  'ASSP uses some internal caches that could grow to a large number of entries. Switch this on, if you want ASSP to use less memory and be a little slower. The perl module <a href="http://search.cpan.org/dist/BerkeleyDB/" rel="external">BerkeleyDB</a> version 0.34 or higher and BerkeleyDB version 4.5 or higher is required to use this feature.',undef,undef,'msg007840','msg007841'],
['ALARMtimeout','Module Call Timeout',5,\&textinput,10,'(\d+)',undef,'Global Timeout for SPF checks. The default is 10 seconds.
  <hr /><hr /><font color=red>Thread Control - be carefull changing the following green options!</font><hr />',undef,undef,'msg007850','msg007851'],
['NumComWorkers','Number of SMTP-Threads',2,\&textinput,5,'^([12][0-9]|[2-9])$','configChangeNumThreads','Number of SMTP-Threads to be used! Typical and default is 5. 10 should be enought for 200.000 connections a day. 15 should be the absolute maximium. Values above 7 will mostly not increase performance. Configurable values are between 2 and 29. Restart ASSP if you changed this and you are using any database connection! An restart of assp is required if tis value was increased.','Basic',undef,'msg007860','msg007861'],
['ReservedOutboundWorkers','Reserved Number of Outbound-SMTP-Threads on relayPort',2,\&textinput,0,'(\d\d?)',undef,'Number of SMTP-Threads to be resevered for relayed (outbound) connections on relayPort ! This number of Threads will be exclusive reserved for connections on relayPort . For example: NumComWorkers=7 and ReservedOutboundWorkers=2 - mails on listenPort , listenPort2 and listenPortSSL are using worker 1-5 and mails on relayPort using worker 7-1 ! If you are not using the relayPort, do not reserve any workers.','Basic',undef,'msg007870','msg007871'],
['autoRestartDiedThreads','automaticly restart died threads',0,\&checkbox,'1','(.*)',undef,
  'If defined, a (for any reason) died thread will be automaticly restarted!','Basic',undef,'msg007920','msg007921'],
['MaxFinConWaitTime','Maximum time to wait for SMTP-Workers to finish connections',5,\&textinput,45,'^([1-5][0-9][0-9]|[1-9][0-9])$',undef,'The maximum time in seconds to wait for SMTP-Workers to finish connections, in case of a shutdown or restart of ASSP. Default is 45. Configurable values are 10 to 599.','Basic',undef,'msg007930','msg007931'],
['MonitorMainThread','Monitor the MainThread',0,\&checkbox,'1','(.*)',undef,
  'If defined, the MainThread will be monitored for healthy by the MaintThread (Worker 10000)!','Basic',undef,'msg007940','msg007941'],
['EnableHighPerformance','Enable Higher Performance','0:off|3000:slightly|1000:medium|500:high|10:very high',\&listbox,'0','(.*)',undef,
  'If set, the SMTP-Worker-Threads will get new pending connections much faster - using less wait states. The speed to interrupt the workers by the MainThread is increased. Using this feature will increase the CPU usage of the system!','Basic',undef,'msg009700','msg009701'],
['ThreadCycleTime','thread cycle time',5,\&textinput,3000,'(\d+)',undef,'Time in microseconds (for SMTP workers and MainThread) to give each other thread to run in high CPU-workload conditions. Default value is 3000, typical values are between 10 and 9000. You can set this to 0, if your OS honors system-yield-calls (0 is not recommended on Windows OS)! A higher value will reduce CPU usage but cause ASSP to run more slowly!','Basic',undef,'msg007950','msg007951'],
['MaintThreadCycleTime','MaintenanceThread cycle time',5,\&textinput,3000,'(\d+)',undef,'Time in microseconds (for MaintThread) to give each other thread to run in high CPU-workload conditions. Default value is 3000, typical values are between 10 and 9000. You can set this to 0, if your OS honors system-yield-calls (0 is not recommended on Windows OS)! A higher value will reduce CPU usage but cause ASSP to run more slowly!','Basic',undef,'msg007960','msg007961'],
['RebuildThreadCycleTime','RebuildSpamDBThread cycle time',5,\&textinput,30,'(\d+)',undef,'Time in microseconds (for RebuildSpamDBThread) to give each other thread to run in high CPU-workload conditions. Default value is 30, typical values are between 10 and 1000. You can set this to 0, if your OS honors system-yield-calls (0 is not recommended on Windows OS) and your system is fast enough! A higher value will reduce CPU usage but cause ASSP to run more slowly!','Basic',undef,'msg007970','msg007971'],
['ThreadStackSize','Stack Size use by every Thread',5,\&textinput,0,'(\d+)',undef,'The stack size in MB that is used by every thread. Default is 0, which meens to use the default system stack size. 16 MB is the default system stack size on windows platforms. This system value may differ on different platforms. To get the default stack size on linux use the shell command "ulimit -a". Try to increase this value, if you get "out of memory" errors while running assp. Changing this value requires an assp restart to take effect.','Basic',undef,'msg009030','msg009031'],
['IOEngine','Use This IO Engine','0:IO::Poll|1:IO::Select',\&listbox,0,'(.*)',undef,
  'Depending on your operating system and your Perl version it could be necessary to use the non default IOEngine \'IO::Select\'. Try this if you see unexpected early closed connections in the log. You have to restart ASSP, if you have changed this value!','Basic',undef,'msg007980','msg007981'],
['MinPollTime','Minimum Poll/Select Wait Time',5,\&textinput,2,'(\d+)',undef,'The time in milliseconds that ASSP will at least wait for IO::Poll/IO::Select events! A higher value will reduce CPU usage but cause ASSP to run more slowly! Default is 2.','Basic',undef,'msg007990','msg007991'],
['WorkerCPUPriority','CPU priority for SMTP-Threads',5,\&textinput,0,'(0|1|2)','configChangeWorkerPriority','Set the priority for the Workers in relation to all other processes/threads on the system. Than higher the value - than lower the priority. Default is 0 (system default is 0). Possible values are 0,1 and 2. This requires installed <a href="http://search.cpan.org/search?query=Thread::State" rel="external">Thread::State</a> module. It is recommended to run the Workers on lower priority, if ASSP has to process most of the time a large number of mails at one moment ( number of mails > NumComWorkers ).','Basic',undef,'msg008000','msg008001'],
['asspCpuAffinity','Cpu Affinity for assp',20,\&textinput,'-1','(\-1|\d+(?:[, ]+\d+)*)','configChangeCpuAffinity','Set the Cpu Affinity for all threads . Default is -1 (for use all CPU\'s). Possible values are comma or space separated CPU numbers starting with zero (0) or -1 for all CPU\'s. This requires installed <a href="http://search.cpan.org/search?query=Sys::CpuAffinity" rel="external">Sys::CpuAffinity</a> module. This feature will possibly not work on MacOS and OpenBSD and on any OS, if the system contains more than 32 CPU\'s.','Basic',undef,'msg009880','msg009881'],
['PreAllocMem','pre allocate memory for every mail',5,\&textinput,100000,'(\d+)',undef,'ASSP pre-allocates this number of bytes in mainstorage two times (in/out) for every mail to avoid memoryfracmentation (particularly in ASSP long run conditions). The memory will be allocated, if the DATA command is received from the server. Default is 100000 - this is enough for most of the mails. If ASSP receives the SIZE command from the server, the pre-allocation-memory will be calculated on that value. Question: Is it better to increase this value? Answer: Yes, it is - but be careful, this may cause ASSP running in out of memory errors!','Basic',undef,'msg008010','msg008011'],
['FreeupMemoryGarbage','Freeup Memory Garbage',0,\&checkbox,'1','(.*)',undef,
  'If defined, all Threads will try to recover memory every five minutes!','Basic',undef,'msg008020','msg008021'],
['ConnectionTransferTimeOut','Connection Transfer Timeout',5,\&textinput,30,'(\d+)',undef,'Global Timeout for MainThread to transfer a connection to any Worker. If no Worker is able to take the new SMTP-connection (for any reason), the new connection will be droped! The default is 30 seconds.','Basic',undef,'msg008030','msg008031'],
['ShowPerformanceData','Show Performance DATA in SMTP Connection screen',0,\&checkbox,'1','(.*)',undef,
  'If defined, performance data will be shown in top of the SMTP connection screen!
  <hr /><hr /><font color=red>end of Thread Control</font><hr />',undef,undef,'msg008040','msg008041'],
['UseLocalTime','Use Local Time',0,\&checkbox,1,'(.*)',undef,
  'Use local time and timezone offset rather than UTC time in the mail headers.<br /><hr />
  <div class="menuLevel1">Notes On Server Setup</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/myserver.txt\',3);" />',undef,undef,'msg008050','msg008051'],

[0,0,0,'heading','Rebuild Spamdb'],
['RebuildSchedule','Schedule Cron time for RebuildSpamdb',50,\&textinput,'noschedule','^((?:'.$ScheduleRe.'(?:\|'.$ScheduleRe.')*)|noschedule)$','configChangeRSRBSched','If <b>not</b> set to "noschedule" (noschedule is default) , ASSP uses scheduled times to run the RebuildSpamdb! The syntax is the same like in <a href="http://en.wikipedia.org/wiki/Cron" rel="external">"Vixie" cron</a>! To disable the Scheduler write "noschedule"!<b> Never write quotes in to this field!</b><br />
This requires an installed <a href="http://search.cpan.org/search?query=Schedule::Cron" rel="external">Schedule::Cron</a> module in PERL.<br />
It is possible to define more than one scheduled time per day to keep the Bayesian and HMM databes up to date, but this is not required - use \'newReportedInterval\' instead.<br />
If a file '.$base.'/rebuilddebug.txt exists, the rebuild task will write the debug output to this file.<br />
<br /><b>Time and Date specification</b><br />
<br />
Entry is the specification of the scheduled time in crontab format,
which contains five mandatory time and date fields.
Entry can be either a plain string, which contains
a whitespace separated time and date specification.<br />
<br />
The time and date fields are (taken mostly from "Vixie" cron):<br />
<br />
<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH="50%" >
<tr><td><b>field</b></td><td><b>values</b></td></tr>
<tr><td>minute</td><td>0-59</td></tr>
<tr><td>hour</td><td>0-23</td></tr>
<tr><td>day of month</td><td>1-31</td></tr>
<tr><td>month</td><td>1-12 (or as names)</td></tr>
<tr><td>day of week</td><td>0-7 (0 or 7 is Sunday, or as names )</td></tr>
<tr><td>seconds</td><td>0-59 (optional) <b>not supported inside ASSP !!!</b></td></tr>
</table>
<br />
 A field may be an asterisk (*), which always stands for
 "first-last".<br />
<br />
 Ranges of numbers are  allowed.  Ranges are two numbers
 separated  with  a  hyphen.   The  specified  range  is
 inclusive.   For example, 8-11  for an  "hours" entry
 specifies execution at hours 8, 9, 10 and 11.<br />
<br />
 Lists  are allowed.   A list  is a  set of  numbers (or
 ranges)  separated by  commas.   Examples: "1,2,5,9",
 "0-4,8-12".<br />
<br />
 Step  values can  be used  in conjunction  with ranges.
 Following a range with "/<number>" specifies skips of
 the  numbers value  through the  range.   For example,
 "0-23/2" can  be used in  the hours field  to specify
 command execution every  other hour (the alternative in
 the V7 standard is "0,2,4,6,8,10,12,14,16,18,20,22").
 Steps are  also permitted after an asterisk,  so if you
 want to say "every two hours", just use "*/2".<br />
<br />
 Names can also  be used for the "month"  and "day of
 week"  fields.  Use  the  first three  letters of  the
 particular day or month (case doesn\'t matter).<br />
<br />
 Note:<br />
       The day of a command\'s execution can be specified
       by two fields  -- day of month, and  day of week.
       If both fields are restricted (ie, aren\'t *), the
       command will be run when either field matches the
       current  time.  For  example, "30  4 1,15  * 5"
       would cause a command to be run at 4:30 am on the
       1st and 15th of each month, plus every Friday<br />
<br />
Examples:<br />
<br />
<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH="80%" >
<tr><td>8 0 * * *</td><td>==></td><td>8 minutes after midnight, every day</td></tr>
<tr><td>5 11 * * Sat,Sun</td><td>==></td><td>at 11:05 on each Saturday and Sunday</td></tr>
<tr><td>0-59/5 * * * *</td><td>==></td><td>every five minutes</td></tr>
<tr><td>42 12 3 Feb Sat</td><td>==></td><td>at 12:42 on 3rd of February and on each Saturday in February</td></tr>
<tr><td>32 11 * * * 0-30/2</td><td>==></td><td>11:32:00, 11:32:02, ... 11:32:30 every day</td></tr>
</table>
<br />
In addition, ranges or lists of names are allowed.<br />
If you want to define multiple entries separate them by "|"',undef,undef,'msg008070','msg008071'],
['useDB4Rebuild','Use BerkeleyDB/DB_File or orderedtie for the RebuildSpamDB Internal Caches',0,\&checkbox,'','(.*)','configChangeDB',
  'The RebuildSpamDB thread uses some internal caches that could grow to a large number of entries. Switch this on, if you want this thread to use less memory and be a little slower.<br />
   Adjust RebuildThreadCycleTime to a lower value (between 0 and 30) to speed up the RebuildSpamDB thread.<br />
   The perl module <a href="http://search.cpan.org/dist/BerkeleyDB/" rel="external">BerkeleyDB</a> version 0.34 or higher and BerkeleyDB version 4.5 or higher is required to use this feature. DB_File (Berkeley V1) will be used if BerkeleyDB is not available. If both BerkeleyDB and DB_File are not available, the rebuild thread will use the internal \'orderedtie\' which is up to 1000 times slower than BerkeleyDB.',undef,undef,'msg008080','msg008081'],
['ReplaceOldSpamdb','Replace the old Records in Spamdb and Spamdb.helo',0,\&checkbox,'1','(.*)',undef,
  'If selected, the new created records for Spamdb and Spamdb.helo will replace the old (belongs not to HMM, which is replaced every time). If not seleted, the new records will be added to Spamdb and Spamdb.helo . Default is on.',undef,undef,'msg008090','msg008091'],
['doMove2Num','Do move2num Before Rebuild',0,\&checkbox,'','(.*)',undef,'Renames files to numbers before the rebuild is started. If this is done, some other features like \'MailLogTail\' and \'Block-Report\' will be unable to find the files!',undef,undef,'msg008100','msg008101'],
['newReportedInterval','Interval for processing new Reported Mails',30,\&textinput,'10 5','(\d+\s+\d+)',undef,
 'File count and interval definition (count minutes) for processing new reported mails (correctedspam , correctednotspam) - process if at least \'first value\' mails are reported but every \'second value\' minutes.<br />
 Set the first value to zero to disable this feature.<br />
 If enabled, new reported mails or files moved in to the corpus via GUI are used, to immediatly update the Spamdb and HMMdb with the new information.<br />
 This will keep the databases continuously uptodate and the RebuildSchedule interval could be increased, if there are enough files in the corpus and your corpus norm is fine.<br />
 If you need to copy/move several files from outside assp in to the corpus and you want assp to process them immediatly, copy/move the files in to the subfolder "error/.../newManualyAdded".',undef,undef,'msg009870','msg009871'],
['MaxKeepDeleted','Max Days of Keep Deleted',5,\&textinput,0,'(\d+)',undef,
  'The maximum number in days deleted files in the bayesian collection folders ( spamlog , notspamlog ) will be kept. This is necessary when EmailBlockReport is used to handle the file and the file is meanwhile deleted. The list of files that are maked for deletion is stored in trashlist.db .',undef,undef,'msg008650','msg008651'],
['autoCorrectCorpus','Automatic Corpus Correction',60,\&textinput,'0.6-1.4-4000-14','(\d\.\d\d?-\d\.\d\d?-(?:[4-9]\d{3}|\d{5,})-\d+|)',undef,'(Syntax: a.a[a]-b.b[b]-cccc-dd or empty - default is "0.6-1.4-4000-14") If the corpus norm (the weight between spamwords/hamwords) is less than "a" (0.6 - too much ham) or greater than "b" (1.4 - too much spam), assp will delete the excess (oldest) files from the corresponding folder ( spamlog , notspamlog ). ASSP will keep a minimum of "c" (4000) files in the folder and will never delete files that are younger than "d" (14) days. This cleanup will run at the end of the rebuildspamdb task. So the corrected file corpus will take effect at the next rebuildspamdb!<br />
  If this value is defined, assp will use the middle value of "a" and "b" ((a+b)/2) as target corpusnorm and will try to reach this value, using (as many as possible) but only such a count of files in the folders spamlog and notspamlog as required!',undef,undef,'msg008980','msg008981'],
['RebuildFileTimeLimit','File Processing time Limit',30,\&textinput,'1 5','(\d+(?:\.\d+)?(?:(?:\s+|,)\d+(?:\.\d+)?)?)',undef,'(Syntax: a[.aa] b[.bb] - default is "1 5")<br />
   Define one, or two space or comma separated values.<br />
   If the first value is not zero and the processing time of a single corpus file exceeds the first value in seconds, this will be shown in the rebuild log.<br />
   If the second value is not zero and the processing time of a single corpus file exceeds the second value in seconds, the file will be moved to the folder "$base/rebuild_error" to prevent future runtime penalties.',undef,undef,'msg009620','msg009621'],
['RebuildNotify','Notification Email To',80,\&textinput,'','(.*)',undef,
  'Email address(es) to which you want ASSP to send a notification email after the rebuild task is finished. The file rebuildrun.txt is included in this notification. Separate multiple entries by "|".',undef,undef,'msg008110','msg008111'],
['RebuildTestMode','Run the Rebuild in Test Mode',0,\&checkbox,'','(.*)',undef,'If selected, all rebuildspamdb tasks will not populate the spamdb and hmmdb - and no data will be sent to the griplist-Server.',undef,undef,'msg009720','msg009721'],
['forceRebuildDowngrade','Keep rebuildspamdb.pm compatible to assp.pl',0,\&checkbox,'1','(.*)',undef,'Keep rebuildspamdb.pm compatible to assp.pl in case of an assp.pl version downgrade.',undef,undef,'msg009840','msg009841'],
['RunRebuildNow','Run RebuildSpamdb now',0,\&checkbox,'','(.*)','ConfigChangeRunTaskNow',
  'If selected, RebuildSpamdb will be started immediately.<br />' . "<input type=button value=\"Run Now!\" onclick=\"document.forms['ASSPconfig'].theButtonX.value='Apply Changes';document.forms['ASSPconfig'].submit();WaitDiv();return false;\" />&nbsp;<input type=button value=\"Refresh Browser\" onclick=\"document.forms['ASSPconfig'].theButtonRefresh.value='Apply Changes';document.forms['ASSPconfig'].submit();WaitDiv();return false;\" />" .
  '<hr /><div class="menuLevel1">Last Run Rebuildspamdb</div><input type="button" value="Last Run Rebuildspamdb" onclick="javascript:popFileEditor(\'rebuildrun.txt\',5);" />
  <hr /><div class="menuLevel1">Rebuildspamdb-debug-output</div><input type="button" value="Rebuildspamdb-debug-output" onclick="javascript:popFileEditor(\'rebuilddebug.txt\',3);" />
  <hr /><div class="menuLevel1">Notes On RebuildSpamdb</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/rebuildspamdb.txt\',3);" />',undef,undef,'msg008120','msg008121'],

[0,0,0,'heading','Char Conversions / TNEF'],
['inChrSetConv','inbound charset conversion table*',80,\&textinput,'','(\S*)','configChangeIC',
  'If defined, characterset conversion for inbound mails will be done. For example: if your emailserver does not understand UTF-8, ASSP will convert the mail parts to the characterset of your choice. The rules specified here are used to convert text parts of inbound mails from one to an other characterset.<p><small><i>Example:</i>UTF-8=>ISO-8859-1|ISO-8859-15=>ISO-8859-1</small></p>
 This requires an installed <a href="http://search.cpan.org/search?query=Email::MIME" rel="external">Email::MIME</a> module in PERL.<br />
 This conversions are done for all (inbound,CC,report ..) mails except relayed mails. The converted mail will be not available on disk except DEBUG.',undef,undef,'msg008130','msg008131'],
['outChrSetConv','outbound charset conversion table*',80,\&textinput,'','(\S*)','configChangeOC',
  'If defined, characterset conversion for outbound mails will be done. For example: if your emailserver is unable to send mails in UTF-8, ASSP will convert the mail parts to UTF-8. The rules specified here are used to convert text parts of outbound mails from one to an other characterset.<p><small><i>Example:</i>ISO-8859-1=>UTF-8|ISO-8859-2=>UTF-8|windows-1250=>UTF-8</small></p>
 This requires an installed <a href="http://search.cpan.org/search?query=Email::MIME" rel="external">Email::MIME</a> module in PERL.<br />
 This conversions are done only for relayed mails!',undef,undef,'msg008140','msg008141'],
['doInFixTNEF','convert inbound MS-TNEF attachments to MIME',0,\&checkbox,'','(.*)',undef,
  'convert inbound MS-TNEF attachments like winmail.dat to MIME parts/attachments. If a TNEF-file is attached by other than Exchange (like application/octet-stream) no conversion will be done. <br />
 In addition to <a href="http://search.cpan.org/search?query=Email::MIME" rel="external">Email::MIME</a> this requires both installed <a href="http://search.cpan.org/search?query=Convert::TNEF" rel="external">Convert::TNEF</a> and <a href="http://search.cpan.org/search?query=MIME::Types" rel="external">MIME::Types</a> module in PERL.',undef,undef,'msg008150','msg008151'],
['keepInTNEF','keep the MS-TNEF part in inbound mail',0,\&checkbox,'1','(.*)',undef,
  'keep inbound MS-TNEF attachments like winmail.dat in MIME parts. If unchecked and the conversion is successfull, the original attachment will be removed from mail!',undef,undef,'msg008160','msg008161'],
['doOutFixTNEF','convert outbound MS-TNEF attachments to MIME',0,\&checkbox,'','(.*)',undef,
  'convert outbound MS-TNEF attachments like winmail.dat to MIME parts/attachments. If a TNEF-file is attached by other than Exchange (like application/octet-stream) no conversion will be done.<br />
 In addition to <a href="http://search.cpan.org/search?query=Email::MIME" rel="external">Email::MIME</a> this requires both installed <a href="http://search.cpan.org/search?query=Convert::TNEF" rel="external">Convert::TNEF</a> and <a href="http://search.cpan.org/search?query=MIME::Types" rel="external">MIME::Types</a> module in PERL.',undef,undef,'msg008170','msg008171'],
['keepOutTNEF','keep the MS-TNEF part in outbound mail',0,\&checkbox,'1','(.*)',undef,
  'keep outbound MS-TNEF attachments like winmail.dat in MIME parts. If unchecked and the conversion is successfull, the original attachment will be removed from mail!',undef,undef,'msg008180','msg008181'],
['convertNP','convert NoProcessing mails',0,\&checkbox,'','(.*)',undef,
  'Set this to on, if noprocessing mails should be converted, which is normaly not the case.',undef,undef,'msg008840','msg008841'],
['doDKIMConv','convert DKIM mails',0,\&checkbox,'0','(.*)',undef,
  'DKIM messages could normaly not modified. If checked, conversions will be done on DKIM messages - <span class="negative">you have to disable the DKIM check on your emailserver (MTA)!</span>',undef,undef,'msg008190','msg008191'],
['TNEFDEBUG','TNEFDEBUG (only in dev)',0,\&checkbox,'','(.*)',undef,'prints TNEF conversion debug info to screen.<br /><hr />
  <div class="menuLevel1">Notes On Character Conversions / TNEF</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/conversions.txt\',3);" />',undef,undef,'msg008200','msg008201'],

[0,0,0,'heading','SSL Proxy and TLS support'],
['DoTLS','How to Handle STARTTLS Requests','0:drop TLS|1:TLS to Proxy|2:do TLS',\&listbox,0,'(\d*)',undef,
  'If set to "drop TLS", any STARTTLS request will be removed from the protocol stack and no connection will ever go in to any TLS mode!<br />
  If set to "TLS to Proxy" and both peers (client and server) supports TLS, both connection will be moved in to a transparent Proxy mode. All data will be encrypted and unreadable to ASSP.<br />
  If set to "do TLS", ASSP will be the "man in the middle". ASSP will try to move both connections in to TLS. All data will be readable to ASSP - so all checks could be done. If any of the peers does not support TLS, ASSP will fake this (250-STARTTLS) to the other peer. So it could be possible, that the connection to the client is going in to TLS mode, even if TLS is not supported by the server. If a client does not request TLS (STARTTLS) even it has got the (250-STARTTLS), ASSP tries to start a TLS session to server, if he has sent (250-STARTTLS)! This behavior belongs to incoming and outgoing messages. This option requires the installed perl module <a href="http://search.cpan.org/search?query=IO::Socket::SSL" rel="external">IO::Socket::SSL</a>!<br />
  For "do TLS" a server-certificate-file " SSLCertFile " and a server-key-file " SSLKeyFile " must exist and must be valid!<br />
  If you do not have valid certificates, you may generate both files online with <a href="http://www.mobilefish.com/services/ssl_certificates/ssl_certificates.php" rel="external">www.mobilefish.com</a> or you may use OpenSSL to generate <a href="http://www.mobilefish.com/developer/openssl/openssl_quickguide_self_certificate.html" rel="external">Self-signed SSL certificates</a>! If you have installed OpenSSL (must be in PATH) and installed and enabled IO::Socket::SSL and ASSP is unable to find valid certificates - ASSP will try to create them at startup!<br />
  <input type="button" value="SSLfailed Cache" onclick="javascript:popFileEditor(\'DB-SSLfailed\',\'1h\');" /><br />',undef,undef,'msg008210','msg008211'],
['SSL_version','SSL version used for transmission',20,\&textinput,'SSLv2/3','(\!?(?:SSLv2\/3|SSLv2|SSLv3|TLSv1)(?:\:\!?(SSLv2\/3|SSLv2|SSLv3|TLSv1))*)','ConfigChangeSSL',
  'Sets the version of the SSL protocol used to transmit data. The default is SSLv2/3,<br />
  which auto-negotiates between SSLv2 and SSLv3. You may specify \'SSLv2\', \'SSLv3\', or \'TLSv1\' (case-insensitive) combined with \':\' and negated with \'!\' (example: \'SSLv2/3:!SSLv2\') if you do not want this behavior.',undef,undef,'msg009660','msg009661'],
['SSL_cipher_list','SSL key cipher list',80,\&textinput,'','(.*)','ConfigChangeSSL',
 'If this option is set, the cipher list for the connection will be set to the given value, e.g. something like \'ALL:!LOW:!EXP:!ADH\'. Look into the OpenSSL documentation (<a href="http://www.openssl.org/docs/apps/ciphers.html#CIPHER_STRINGS" rel="external">http://www.openssl.org/docs/apps/ciphers.html#CIPHER_STRINGS</a>) for more details. Setting this value causes the \'SSL_honor_cipher_order\' flag to be switched on (BEAST vulnerable)<br />
 If this option is not used (default) the openssl builtin default is used which is suitable for most cases.',undef,undef,'msg009670','msg009671'],
['NoTLSlistenPorts','Disable SSL support on listenPorts',80,\&textinput,'','(.*)','ConfigChangeTLSPorts',
  'This disables TLS/SSL on the defined listenPorts, if DoTLS is set to "do TLS". All other SMTP listeners will support TLS/SSL, if DoTLS is set to "do TLS". This option works for listenPort , listenPort2 and relayPort . The listener definition here has to be the same like in the port definitions. Separate multiple entries by "|".<p><small><i>Examples:</i> 25, 127.0.0.1:25, 127.0.0.1:25|127.0.0.2:25 </small></p>',undef,undef,'msg008220','msg008221'],
['TLStoProxyListenPorts','Force TLS to Proxy on this Ports',80,\&textinput,'','(.*)','ConfigChangeTLSPorts',
  'If a STARTTLS command is received on a port that is defined here, the connection will be moved in to the transparent proxy mode every time - independend from the setting of DoTLS . This option works for listenPort , listenPort2 and relayPort . The listener definition here has to be the same like in the port definitions. Separate multiple entries by "|".<p><small><i>Examples:</i> 25, 127.0.0.1:25, 127.0.0.1:25|127.0.0.2:25 </small></p>',undef,undef,'msg009020','msg009021'],
['SSLCertFile','SSL Certificate File (PEM format)',48,\&textinput,$dftCertFile,'(\S*)','ConfigChangeSSL',
  "Full path to the file containing the server's SSL certificate, for example : /usr/local/etc/ssl/certs/assp-cert.pem or c:/assp/certs/server-cert.pem. A general cert.pem file is already provided in \'assp/certs/server-cert.pem\'",undef,undef,'msg008230','msg008231'],
['SSLKeyFile','SSL Key File (PEM format)',48,\&textinput,$dftPrivKeyFile,'(\S*)','ConfigChangeSSL',
  "Full path to the file containing the server\'s SSL private key, for example: /usr/local/etc/ssl/certs/assp-key.pem or c:/assp/certs/server-key.pem. A general key.pem file is already provided in \'assp/certs/server-key.pem\'",undef,undef,'msg008240','msg008241'],
['SSLPKPassword','SSL Private Key Password',48,\&passinput,'','(.*)',undef,
  "Optional parameter. If your private key ' SSLKeyFile ' is password protected, assp will need this password to decrypt the server\'s SSL private key file.",undef,undef,'msg009540','msg009541'],
['SSLCaFile','SSL Certificate Authority File',48,\&textinput,'','(\S*)','ConfigChangeSSL',
  "Optional parameter to enable chained certificate validation at the client side. Full path to the file containing the server's SSL certificate authority, for example : /usr/local/etc/ssl/certs/assp-ca.crt or c:/assp/certs/server-ca.crt. A general ca.crt file is already provided in '$dftCaFile'. The default value is empty and leave it empty as long as you don't know, how this parameter works.",undef,undef,'msg009530','msg009531'],
['noTLSIP','Exclude these IP\'s from TLS*',80,\&textinput,'','(\S*)','ConfigMakeIPRe','Enter IP\'s that you want to exclude from starting SSL/TLS, separated by pipes (|). For example, put all IP\'s here, that making trouble to switch to TLS every time, what will prevent ASSP from getting mails from this hosts.',undef,undef,'msg008250','msg008251'],
['banFailedSSLIP','Ban Failed SSL IP','0:disable|1:privat only|2:public only|3:both',\&listbox,3,'(\d*)',undef,
 'If set (recommended is \'both\'), an IP that failes to connect via SSL/TLS will be banned for 12 hour from using SSL/TLS.<br />
  Privat IP\'s and IP addresses listed in \'acceptAllMail\' will get one more try to correct the mistake.<br />
  This is done per default (\'both\'), to prevent possible DoS attacks via SSL/TLS.<br />
  Those IP\'s are stored in the SSLfailed cache. This cache is cleaned up at startup.<br />
  disable - disables this feature, which is highly NOT recommended<br />
  privat only - only privat IP\'s and IP\'s in acceptAllMail will be banned (they have two tries)<br />
  public only - only public IP\'s will be banned<br />
  both - privat and public IP\'s will be banned<br />
  <input type="button" value="edit SSLfailed Cache" onclick="javascript:popFileEditor(\'DB-SSLfailed\',\'1h\');" />',undef,undef,'msg010100','msg010101'],
['sendEHLO','Send EHLO',0,\&checkbox,'','(.*)',undef,
  'If selected, ASSP sends an EHLO even if the client has sent only a HELO. This is useful to force the usage of TLS to the server or to statisfy XCLIENT/XFORWARD helo offers, because EHLO is needed before STARTTLS or XCLIENT/XFORWARD could be used.',undef,undef,'msg008260','msg008261'],
['SSLRetryOnError','Retry SSL on "SSL want a read first" error',0,\&checkbox,'','(.*)',undef,
  'If selected, ASSP retries one time to establish a SSL connection with one second delay, if the peer was not ready after STARTTLS because of a "SSL want a read/write first" error.',undef,undef,'msg008270','msg008271'],
['SSLtimeout','SSL Timeout (0-999)',4,\&textinput,5,'(\d{1,3})',undef,
 'SSL/TLS negotiation will timeout after this many seconds. default is : 5 seconds.',undef,undef,'msg008280','msg008281'],
['SSLDEBUG','Debug Level for SSL/TLS','0:no Debug|1:level 1|2:level 2|3:level 3',\&listbox,0,'(\d*)',undef,'Set the debug-level for SSL/TLS. Than higher the level, than more information are written to STDOUT!',undef,undef,'msg008290','msg008291'],
['ProxyConf','Transparent TCP Proxy Table*',80,\&textinput,'','(\S*)','configChangeProxy',
  'Define transparent Port Proxy here. ASSP will forward incoming packets to a specific destination.<br />
   For example: if you want incoming connections on port 465 (SMTP-SSL) to be forwarded to your emailserver.<br />
   <p><small><i>Example:</i>0.0.0.0:465=>192.168.1.25:465<=12.1.1.3,34.5.6.7,67.23.2.1|<br />
   10.1.1.1:1477=>192.168.1.23:25<=120.5.1.3,134.5.19.7,67.123.221.11</small></p><br />
 The syntax is: localIP:localPORT=>forwardIP:forwardPORT<=allowfromIP1,allowfromIP2,...|next Proxy configuration|....<br />
 You have to configure the IP-address and IP-port for both - local and forward  values. AllowfromIP are comma separated values of IP-addresses from where connections are allowed. If there is no allow value defined, all connections will be allowed!<hr />
  <div class="menuLevel1">SSL Proxy and TLS support</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/ssl_and_proxy.txt\',3);" />',undef,undef,'msg008300','msg008301'],

[0,0,0,'heading','Global PenaltyBox'],
['globalClientName','client registration name',60,\&textinput,'','(.*)','configUpdateGlobalClient',
 'The Name of this global-client for registation on the global-server. This entry has to be the full qualified DNS-Name of the IP-address over which ASSP is doing HTTP-requests! If you are using a HTTP-Proxy, this should be the public IP-address of the last Proxy in chain! This DNS-Name has to be resolveable worldwide and the resolved IP-address has to match the ASSP-HTTP-connection-IP-address. It is not possible to use an IP-address in this field! Dynamic DNS-Names like "yourdomain.dyndns.org" are supported!<br />
 To become a member of the exclusive global-penalty-box-users, you will need a subscription and you will have to pay a yearly maintenance fee. To get registered and/or to get more information, please send an email with your personal/company details and the globalClientName to "assp.globalpb@thockar.com".<br />
 The name of this client has to be known by the global server before it could be registered from here. Please wait until you\'ve got an information, that your client name is known by the global server.<br />
 In addition to <a href="http://search.cpan.org/search?query=Compress::Zlib" rel="external">Compress::Zlib</a> this requires an installed <a href="http://search.cpan.org/search?query=LWP::UserAgent" rel="external">LWP::UserAgent</a> module in PERL.',undef,undef,'msg008310','msg008311'],
['globalClientPass','client registration password',20,\&passnoinput,'','(.*)','configUpdateGlobalHidden','If the global client is registered on the global-server, you will see a number of "*" in this field. This field is readonly.',undef,undef,'msg008320','msg008321'],
['globalClientLicDate','client subscription expiration date',20,\&textnoinput,'','(.*)','configUpdateGlobalHidden','The date of license/subscription expiration for this global client. If this date is exceeded, no upload and download of global PB will be done! This field is readonly.',undef,undef,'msg008330','msg008331'],
['DoGlobalBlack','Enable the Global-Black-Penalty',0,\&checkbox,'','(.*)',undef,'Enables the upload and download of Black-Penalty-Box-Entries, if the client is registered on the global-PB-server.',undef,undef,'msg008340','msg008341'],
['globalValencePB','Value for Global-Black-PB Entries +',3,\&textinput,20,'(\s*\d+\s*(?:\|\s*\d+\s*){0,1})','ConfigChangeValencePB', 'This penalty-value will be given to downloaded Black-Penalty-Box-Entries. As long as entries have the "GLOBALPB" state, they will never become extreme-Black. It is recommended to set this value above PenaltyLimit!',undef,undef,'msg008350','msg008351'],
['globalBlackExpiration','Expiration for Global-PB-Black Records',3,\&textinput,48,'(\d*)',undef, 'Global-Black-Penalties will expire after this number of hours.',undef,undef,'msg008360','msg008361'],
['DoGlobalWhite','Enable the Global-White-Penalty',0,\&checkbox,'','(.*)',undef,'Enables the upload and download of White-Penalty-Box-Entries, if the client is registered on the global-PB-server.',undef,undef,'msg008370','msg008371'],
['globalWhiteExpiration','Expiration for Global-PB-White Records(days)',3,\&textinput,7,'(\d*)',undef, 'Global-White-Penalties will expire after this number of days.',undef,undef,'msg008380','msg008381'],
['GPBDownloadLists','Download List and Regex Updates from GPB-Server','0:no download|1:download|2:download and install',\&listbox,2,'(\d*)',undef,'Select, if assp should download updates for lists and regular expressions from the global penaltybox server. Downloads will be done to the \'download\' folder. If install is selected, the downloaded lines will merged in to the defined files (file:...). If you want to disable a specific line in any of your files, do not delete the line, instead commed it out - putting an \'#\' or \';\' in front of the line. If any list is not configured using the \'file:...\' option, only the download will be done, even if install is selected. To disable a line that was added by the GPB-server to your file - simply commend the line out (# or ;). If you remove such a line, it could be possibly added again by the next GPB check. To change a line that was added by the GPB-server to your file - disable the line and customize a copied line to your needs.',undef,undef,'msg009370','msg009371'],
['GPBautoLibUpdate','Download Plugin and Library Updates from GPB-Server','0:no download|1:download|2:download and install',\&listbox,2,'(\d*)',undef,'Select, if assp should download updates for Plugins or Library-Files (../lib) from the global penaltybox server. Downloads will be done to the \'download\' folder. If install is selected, the downloaded Plugins and/or modules will be installed in to there original location, if an older version of the file still exists. If an older version is not found, only the download will be done. To activate updated Plugins or modules a restart of assp is required. This feature will not force an automatic restart of assp!.
<hr /><div class="menuLevel1">Notes On Global Penalty Box</div><input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/global_pb.txt\',3);" />',undef,undef,'msg009380','msg009381'],

[0,0,0,'heading','Block Reporting'],
['ExtraBlockReportLog','Enable extra Logging for BlockReports',0,\&checkbox,'1','(.*)','ConfigChangeBRLogfile','Maillogs could grow to a very large size. Enable this feature to log only loglines with blocking information to an extra file. These files will be named as "b" + logfile . Using this option will speed up Block Reporting. Before you switch on this option, you should run "grep"[linux/MacOS] or "find"[Windows] to create the "b" - file from the maillogs.<br />
 linux/MacOS - grep "\\[spam found\\]" *maillog.txt > bmaillog.txt<br />
 Windows - find "[spam found]" *maillog.txt > bmaillog.txt',undef,undef,'msg008390','msg008391'],
['EmailBlockReport','Request Block Report',40,\&textinput,'asspblock','('.$EmailAdrRe.')?',undef,
 'Any mail sent by local/authenticated users to this username will be interpreted as a request to get a report about blocked emails. Do not put the full address here, just the user part. For example: asspblock<br />
 Leading digits/numbers in the mail subject will be interpreted as "report request for the last number of days". If the number of days is not specified in the mail subject, a default of 5 days will be used to build the report. <br />
 All characters behind the "number of days" will be interpreted as a regular expression to overwrite the BlockReportFilter - leading and trailing white spaces will be ignored.<br />
 Users defined in EmailBlockTo, EmailAdmins and EmailAdminReportsTo are \'Admins\' and can request a report for multiple users. They have to use a special syntax with \'=>\' in the body of the report request. The syntax is: <br />
 QueryAddress=>ReportRecipient=>ReportDays  -  there are many possible combinations of this three parameters. For example:<br />
 user@domain and user@domain=>user@domain - will send a report for this user to this user<br />
 *@domain (better use) *@domain=>* - will send a report for every blocked user in this domain to this user<br />
 user@domain=>recipient@any-domain - will send a report for user@domain to recipient@any-domain<br />
 *@domain=>recipient@any-domain - will send a report for every blocked user in this domain to recipient@any-domain<br />
 It is possible to define a group ( Groups ) in the first parameter like:<br />
 [user@domain]=>recipient@any-domain<br />
 The group name must be a lower case email address of a local domain without any wildcard. This will create a combined block report for all email addresses defined in this group - useful, if someone has multiple email addresses and want\'s to get a single report.<br />
 If the group name is equal to a real existing email address of a user, and this user requests a block report using this email address (MAIL FROM:), a combined block report for the group will be generated.<br />
 A third parameter is possible to set, which defines the number of days for which the report should be created. The default (if empty or not defined) is one day. This value is used to calculate the \'next run date\'. For example:<br />
 *@domain=>recipient@any-domain=>2 - creates a report for two days.<br />
 *@domain=>*=>14 - creates a report for 14 days.<br />
 user@domain=>=>3 or user@domain=>*=>3 - creates a report for three days. The second parameter is here empty or *.<br />
 To overwrite the defined BlockReportFilter, you can define a fourth parameter, which contains the regular expression to use.<br />
 *@domain=>*=>14=>virus|newsletter - creates a report for 14 days and skips all lines that contains the words \'virus\' or \'newsletter\'.<br />
 If an admin emails a block report request and specifies a filter in the subject of the email and a fourth parameter in the body, both regular expressions will be merged in to a single regex for each line.<br />
 If you or a user want the default BlockReportFilter to become part of the overwrite regex, the literal \'$BRF\' should be inluded in the regex like:<br />
 *@domain=>*=>14=>virus|$BRF|newsletter - or even in the subject of the email<br />
 In this case the literal \'$BRF\' will be replaced by the BlockReportFilter.<br />
 Only Admins are able to request blockreports for non local email addresses. For example:<br />
 user@non_local_domain=>recipient@any-domain=>4<br />
 *@non_local_domain=>recipient@any-domain=>4<br />
 This will result in an extended blockreport for the non local address(es). Replace \'non_local_domain\' with the domain name you want to query for.<br />
 It is possible to change the complete design of the BlockReports to your needs,  using a html-css file. An default css-file \'blockreport.css\' is in the image folder.<br />
 There you can also find a default icon file \'blockreporticon.gif\' and a default header-image-file \'blockreport.gif\' - which is the same like \'logo.gif\'.  There is no need to install that fles. If assp can not find this files in its
 image folder, it will use default hardcoded css and icon. If the file \'blockreport.gif\' is not found \'logo.gif\' will be used.<br />
 To change any contents, use the Blockreport::modify module in the lib folder. You\'ll need some Perl skills to do that.<br />
  <input type="button" value=" Edit blockreport_sub.txt file" onclick="javascript:popFileEditor(\'reports/blockreport_sub.txt\',2);" /><br />
  <input type="button" value=" Edit blockreport_html.txt file" onclick="javascript:popFileEditor(\'reports/blockreport_html.txt\',2);" /><br />
  <input type="button" value=" Edit blockreport_text.txt file" onclick="javascript:popFileEditor(\'reports/blockreport_text.txt\',2);" />','Basic',undef,'msg008400','msg008401'],
['EmailBlockReportDomain','Request Blocked Email Domain',40,\&textinput,'@assp.local','(\@'.$EmailDomainRe.')?',undef,
  'Set this to the domain to which the users can send a request to receive blocked messages. For example: @assp.local. Notice the leading required \'@\'!',undef,undef,'msg008410','msg008411'],
['EmailBlockReply','Reply to Block-Report Request','0:NO REPLY|1:REPLY TO SENDER|2:REPLY TO EmailBlockTo|3:REPLY TO BOTH',\&listbox,1,'(\d*)',undef,
  '',undef,undef,'msg008420','msg008421'],
['QueueUserBlockReports','Queue User Block Report Requests','0:run instantly|2:store and run scheduled',\&listbox,0,'(\d*)',undef,
  'How to process block report requests for users ( not EmailBlockTo, EmailAdmins, EmailAdminReportsTo ).<br />
  \'run instantly\' - the request will be processed instantly (not stored).<br />
  \'store and run scheduled\' - (deprecated) the request will be stored/queued, runs permanently scheduled at BlockReportSchedule until it will be removed from queue - a \'+\' in the subject is not needed<br />
  To add a request to queue, the user has to send an email to EmailBlockReport. Leading digits/numbers in the mail subject will be interpreted as "report request for the last number of days". If the number of days is not specified in the mail subject, a default of 5 days will be used to build the report.<br />
  If \'run instantly\' is selected, but a user wants to schedule a permanent request, a leading \'+\' before the digits in subject is required.<br />
  To remove a request from queue the user has to send an email to EmailBlockReport with a leading \'-\' in the subject.<br />
  <input type="button" value=" Edit user report queue" onclick="javascript:popFileEditor(\'files/UserBlockReportQueue.txt\',2);" />',undef,undef,'msg008430','msg008431'],
['QueueSchedule','Runtime for Queued Requests <sup>s</sup>',40,\&textinput,'0',$ScheduleGUIRe,'configChangeSched',
  'Runtime hour for reports in QueueUserBlockReports. Set a number between 0 and 23. 0 means midnight and is default',undef,undef,'msg008440','msg008441'],
['BlockRepForwHost','Forward The Blockreportrequest to other ASSP',40,\&textinput,'','(.*)',undef,'If you are using more than one ASSP (backup MX), define the IP-address and relayPort (x.x.x.x:ppp) of the other ASSP here (separate multiple entries by "|"). The Blockreportrequest will be forwarded to this ASSP and the user will get a blockreport from every ASSP. The forwarded request has the same sender and recipient like the original request. So EmailBlockReport and EmailBlockReportDomain have to be configured identic on all ASSP!!!! Resend requests are automatic forwarded to the right (or next) host, if ASSP finds the hostname in the subject of the request. If you have more than two ASSP, the logical sending structure must be a star. If ASSP(A) (the sun) is in the middle and you have also ASSP(B), ASSP(C) and ASSP(D) (satelites), ASSP(A) should know C,B and D, and B,C and D should only know A.<br />
 The perl module <a href="http://search.cpan.org/search?query=Net::SMTP/" rel="external">Net::SMTP</a> is required to use this feature.',undef,undef,'msg008450','msg008451'],
['EmailBlockTo','Send Copy of Block-Reports TO',40,\&textinput,'','('.$EmailAdrRe.'\@'.$EmailDomainRe.')?',undef,
  'Email sent from ASSP acknowledging your submissions will be sent to this address. For example: admin@domain.com',undef,undef,'msg008460','msg008461'],
['EmailAdminDomains','Restrict Email Admins to Domains*',40,\&textinput,'','(file:.+)|','ConfigMakeEmailAdmDomRe',
  'Use this parameter to restrict users registered in EmailAdmins, EmailAdminReportsTo and EmailBlockTo to a list of domains or users, for which they can request BlockReports.<br />
  It is possible to use defined GROUPS. The file: option is required. Use the following syntax to define an entry (one per line):<br />
  EmailAdminAddress=>*@domain1,*@domain2 user@domain3 ...<br />
  [user@domain]=>*@domain1,*@domain2 user@domain3 ...<br />
  Wildcards are allowed to be used in the domain definition - like *@*.domain.tld - separate multiple domains by comma or space.<br />
  If a BlockReport is requested for a not allowed email address, the complete BlockReport request will be ignored.<br />
  If an EmailAdmins address is not registered in this parameter, he/she is able to request BlockReports for all domains.',undef,undef,'msg009710','msg009711'],
['EmailResendRequester','Blocked Email Resend Requester*',60,\&textinput,'','(.*)','ConfigMakeSLRe',
 'A list of local addresses, which are allowed to request a resend of blocked emails for other users, even they are not EmailAdmins . Leave this field blank (default), to disable this feature.<br />
  This is usefull, if a user gets automatic generated BlockReports (e.g via BlockReportFile ) for a group of users and should be able to manage resends for them. Added here, the user is not allowed to request BlockReports for other users - in this case use EmailAdmins and EmailAdminDomains instead.<br />
  The resend is done to the recipient stored in the X-Assp-Intended-For: ( requires AddIntendedForHeader ) header field and the requester if the address was found in a TO: header filed. <br />
  Accepts specific addresses (user@domain.com), user parts (user).  Wildcards are supported (fribo*@domain.com).<br />
  For example: fribo*@thisdomain.com|jhanna ',undef,undef,'msg010120','msg010121'],
['BlockReportFile','File for Blockreportrequest',40,\&textinput,'','(file:.+)|','initMaintScheduler','A file with BlockReport requests. ASSP will generate a block report for every line in this file (file:files/blockreportlist.txt - file: is required if defined!) every day at midnight for the last day. The perl modules <a href="http://search.cpan.org/search?query=Net::SMTP/" rel="external">Net::SMTP</a> and <a href="http://search.cpan.org/search?query=Email::MIME /" rel="external">Email::MIME </a> are required to use this feature. A report will be only created, if there is at least one blocked email found! The syntax is: <br />
 QueryAddress=>ReportRecipient=>ReportDays  -  there are many possible combinations of this three parameters. For example:<br />
 user@domain and user@domain=>user@domain - will send a report for this user to this user<br />
 *@domain (better use) *@domain=>* - will send a report for every blocked user in this domain to this user<br />
 *@* - creates a report for all local users in all local domains<br />
 user@domain=>recipient@any-domain - will send a report for user@domain to recipient@any-domain<br />
 *@domain=>recipient@any-domain - will send a report for every blocked user in this domain to recipient@any-domain<br />
 It is possible to define a group ( Groups ) in the first parameter like:<br />
 [user@domain]=>recipient@any-domain<br />
 The group name must be a lower case email address of a local domain without any wildcard. This will create a combined block report for all email addresses defined in this group - useful, if someone has multiple email addresses and want\'s to get a single report.<br />
 An third parameter is possible to set, which defines the number of days for which the report should be created. The default (if empty or not defined) is one day. This value is used to calculate the \'next run date\'. For example:<br />
 *@domain=>recipient@any-domain=>2 - creates a report for two days.<br />
 *@domain=>*=>14 - creates a report for 14 days.<br />
 user@domain=>=>3 or user@domain=>*=>3 - creates a report for three days. The second parameter is here empty or *!<br />
 To overwrite the defined BlockReportFilter, you can define a fourth parameter, which contains the regular expression to use.<br />
 *@domain=>*=>14=>virus|newsletter - creates a report for 14 days and skippes all lines that contains the words \'virus\' or \'newsletter\'.<br />
 An fifth parameter could be used to schedule (cron) a BlockReport. If this paramter is used, the line will be ignored at BlockReportSchedule. For the syntax of the cron entry, please read RebuildSchedule . Multiple schedules in one line could be separated by pipe (|).<br />
 *@domain=>it_dep@domain=>7=>virus|newsletter=>0 0 * * 0 - creates a report every Sunday at 00:00 for the last seven days<br />
 *@domain=>it_dep@domain=>2=>virus|newsletter=>0 0 * * 2,4,6|0 12 * * 1 - creates a report every Tuesday,Thursday,Saturday at 00:00 and at every Monday at 12:00 for the last two days<br />
 Only Admins are able to request blockreports for non local email addresses. For example:<br />
 user@non_local_domain=>recipient@any-domain=>4<br />
 *@non_local_domain=>recipient@any-domain=>4<br />
 This will result in an extended blockreport for the non local address(es). Replace \'non_local_domain\' with the domain name you want to query for.',undef,undef,'msg008470','msg008471'],
['BlockReportSchedule','Runtime BlockReportFile <sup>s</sup>',40,\&textinput,'0',$ScheduleGUIRe,'configChangeSched',
  'Runtime hour for reports in BlockReportFile. Set a number between 0 and 23. 0 means midnight and is default.',undef,undef,'msg008480','msg008481'],
['BlockReportNow','Generate a BlockReport from BlockReportFile Now',0,\&checkbox,'','(.*)','ConfigChangeRunTaskNow', "If selected, ASSP will generate a block report from BlockReportFile now. <input type=button value=\"Run Now!\" onclick=\"document.forms['ASSPconfig'].theButtonX.value='Apply Changes';document.forms['ASSPconfig'].submit();WaitDiv();return false;\" />&nbsp;<input type=button value=\"Refresh Browser\" onclick=\"document.forms['ASSPconfig'].theButtonRefresh.value='Apply Changes';document.forms['ASSPconfig'].submit();WaitDiv();return false;\" />",undef,undef,'msg008490','msg008491'],
['BlockMaxSearchTime','Max Search time per log File',4,\&textinput,'0','(\d+)',undef,
  'The maximum time in seconds, the Blockreport feature spends on searching in one log file. If this value is reached, the next log file will be processed. Default is 0. A value of 0 disables this feature and all needed log files will be fully processed.',undef,undef,'msg008500','msg008501'],
['BlockReportFormat','The format of the Report Email','0:text and html|1:text only|2:html only',\&listbox,0,'(\d*)',undef,
  'Block reports will be sent as multipart/alternative MIME messages. They normaly contains two parts, a plain text part and a html part. Select "text only" or "html only" if you want to skip any of this parts.<br />
  To make it possible to detect a resent email, ASSP will add a header line "X-Assp-Resend-Blocked: myName" to each email!',undef,undef,'msg008510','msg008511'],
['BlockReportHTTPName','My HTTP Name',40,\&textinput,'','(.*)',undef,'The hostname for HTTP(S) links in AdminUsers Blockreports. If not defined the local hostname will be used.',undef,undef,'msg008760','msg008761'],
['BlockReportFilter', 'Regular Expression to Skip Log Records*',80,\&textinput,'Virus|BlackDomain','(.*)','ConfigCompileRe',
 'Put anything here to identify messages which should not be reported in any Block Report. For example:  Virus|BlackDomain.<br />
 For individual filter settings, it is possible to overwrite this value in the BlockReportFile for every single line and in every request per email using the subject line ( read EmailBlockReport ).',undef,undef,'msg008520','msg008521'],
['DoT10Stat','Collect multiple TopTen Statistics',0,\&checkbox,'','(.*)',undef, 'enable the top ten statistic count (blocked IP\'s, blocked senders, blocked recipients) and the output in the GUI and BlockReports for admins.',undef,undef,'msg009790','msg009791'],
['inclResendLink','Include a Resend-Link for every resendable email','0:disabled|1:in plain text report|2:in html report|3:in both',\&listbox,3,'(\d*)',undef,
  'Block reports will be sent as multipart/alternative MIME messages. They contains two parts, a plain text part and a html part. If a blocked email is stored in any folder, it is possible to include a link for each email in to the report. Define here what you want ASSP to do. Default is "in both". If set to not to disabled " fileLogging " will be automaticly set to on.',undef,undef,'msg008530','msg008531'],
['BlockResendLink','Which Link Should be included','0:both|1:left|2:right',\&listbox,0,'(\d*)',undef,
  'If HTML is enabled in inclResendLink, two links (one on the left and one on the right site) will be included in the report email by default. Depending on the used email clients it could be possible, that one of the two links will not work for you. Try out what link is working and disable the other one, if you want.',undef,undef,'msg008540','msg008541'],
['BlockResendLinkLeft','User which get the Left link only*',80,\&textinput,'','(.*)','ConfigMakeSLRe',
  'List of users and domains that will get the left link only. The setting for BlockResendLink will be ignored for this entries!',undef,undef,'msg008550','msg008551'],
['BlockResendLinkRight','User which get the right link only* ',80,\&textinput,'','(.*)','ConfigMakeSLRe',
  'List of users and domains that will get the right link only. The setting for BlockResendLink will be ignored for this entries!',undef,undef,'msg008560','msg008561'],
['DelResendSpam','Delete Mails in Spam Folder',0,\&checkbox,'1','(.*)',undef, 'If selected, an user request to resend a blocked email will delete the file in the spamlog folder - an admin request will move the file to the correctednotspam folder.',undef,undef,'msg008570','msg008571'],
['autoAddResendToWhite','Automatic add Resend Senders to Whitelist','0:no|1:Users only|2:Admins only|3:Users and Admins',\&listbox,'0','(.*)',undef, 'If a BlockReport resend request is made by any of the selected users, the original sender of the resent mail will be added to whitelist, also a copy file to the resend folder will do that.
  <div class="menuLevel1">Notes On Block Reporting</div>
  <input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/blockreports.txt\',3);" />',undef,undef,'msg008580','msg008581'],

[0,0,0,'heading','SNMP Configuration'],
['SNMP','Enable the ASSP-SNMP Interface','0:disable|1:enable',\&listbox,0,'(\d*)','ConfigChangeSNMP',
 'This enables the AgentX registration of assp to a SNMP master-AgentX. ASSP will be registered to the master-AgentX as \'assp_myName\', the possible configuration file name will be assp_myName.conf . This option requires the installed perl module <a href="http://search.cpan.org/search?query=NetSNMP::agent" rel="external">NetSNMP::agent</a>. The product and needed librarys could be downloaded at <a href="http://www.net-snmp.org/download.html" rel="external">net-snmp.org</a>.<br />
 All configuration values are accessed using the SNMPUser account. The SNMP-permission and visibility is used from the configured user GUI-permissions.<br /><br />
The following OIDs (relative to the SNMPBaseOID) are available for SNMP-querys. The configuration values are changeable via snmp. The file mib/ASSP-MIB could be used in SNMP browsers to get a human readable view of the OID\'s (copy it to the net-snmp MIB file location - eg: [C:]/usr/share/snmp/mibs and the MIB location of your SNMP browser). Please keep in mind, that an extensive usage of SNMP querys will slow down assp.<br /><br />
.1   - runtime information<br />
.1.0 - assp healty status boolean 0/1<br />
.1.1 - assp healty status text<br />
.1.2 - ASSP runtime status boolean 0/1 0=shutdown in progress - 1=running<br />
.1.3 - ASSP runtime status text<br />
.1.4 - ASSP version string<br />
.1.5 - ASSP script name<br />
.1.6 - Perl version string<br />
.1.7 - Perl executable name<br />
.1.8 - operating system name<br />
.1.9 - hostname where ASSP is running on<br />
.1.10 - IP-host where ASSP is running on<br />
.1.11 - myName<br />
.1.12 - URL to new ASSP version download<br />
.1.13 - currently running tasks<br />
.1.14 - current assp memory usage in MB<br />
.1.20 - schedule information<br />
.1.20.1 - next BerkeleyDB sync<br />
.1.20.2 - next scheduled Config reload<br />
.1.20.3 - next BATVTag cache cleaning<br />
.1.20.4 - next general cache cleaning<br />
.1.20.5 - next IP-per-Domain cache cleaning<br />
.1.20.6 - next DelayDB cache cleaning<br />
.1.20.7 - next Penaltybox cache cleaning<br />
.1.20.8 - next Database Backup<br />
.1.20.9 - next Database Connection Check<br />
.1.20.10 - next DNS Connection Check<br />
.1.20.11 - next hourly job runs (at)<br />
.1.20.12 - next Database Export<br />
.1.20.13 - next upload for Global-Black<br />
.1.20.14 - next upload for Global-White<br />
.1.20.15 - next Hash-File-Check (option files)<br />
.1.20.16 - next LDAP-cross-Check<br />
.1.20.17 - next RebuildSpamDB<br />
.1.20.18 - next ResendMail<br />
.1.20.19 - next ASSPFileDownload (assp.pl)<br />
.1.20.20 - next Version File Download (version.txt)<br />
.1.20.21 - next BackDNS File Download<br />
.1.20.22 - next Code Change Check<br />
.1.20.23 - next Droplist Download<br />
.1.20.24 - next Griplist Download<br />
.1.20.25 - next POP3Collect<br />
.1.20.26 - next Save Stats<br />
.1.20.27 - next TLDlist Download<br />
.1.20.28 - next Sync Config<br />
.1.20.29 - next Groups File Reload<br />
.1.20.30 - next BlockReport Schedule<br />
.1.20.31 - next File Age Schedule<br />
.1.20.32 - next BlockRepor Queue Schedule<br />

<br />
.1.30.X - worker status (boolean) X = worker<br />
.1.30.X.1 - worker time since last loop (text) X = worker<br />
.1.30.X.2 - worker last action (text) X = worker<br />
<br />
.1.31.0 - general database status (boolean) 0/1<br />
.1.31.0.1 - general database status (text)<br />
.1.31.X - database table status (boolean) 0/1 - X >= 1<br />
.1.31.X.1 - database table name - X >= 1 related to .1.31.X<br />
<br />
.2 - Configuration - X is the internal value number adapted from the language files<br />
.2.H - heading description - H is the internal GUI heading number<br />
.2.H.X   - config value<br />
<br />
.3 - assp module information - X is a counter up from zero<br />
.3.X - module name<br />
.3.X.1 - installed module version<br />
.3.X.2 - required module version<br />
.3.X.3 - module installation status<br />
.3.X.4 - download URL for the module<br />
<br />
.4 - assp runtime status<br />
.4.1 - current stat - X is a counted number<br />
.4.1.X - current stat value<br />
<br />
.4.2 - cumulative stat - X is a counted number<br />
.4.2.X - cumulative stat value<br />
<br />
.4.3 - current total stat - X is a counted number<br />
.4.3.X - current total value<br />
<br />
.4.4 - cumulative total stat - X is a counted number<br />
.4.4.X - cumulative total stat value
<br />
.4.5 - current scoring stat - X is a counted number<br />
.4.5.X - current scoring stat value<br />
<br />
.4.6 - cumulative scoring stat - X is a counted number<br />
.4.6.X - cumulative scoring stat value
<br />
.5.0 - SNMP-API : is writeable - accepts internal subroutine command/call to be executed<br />
.5.1 - the result of the last SNMP-API call (success or error)<br />
 ',undef,undef,'msg00009400','msg009401'],
['SNMPBaseOID','SNMP Base OID',80,\&textnoinput,'.1.3.6.1.4.1.37058.2','^(\.?(?:\d+\.)+\d+)$','ConfigChangeSNMP',
  'The Base OID that should be used by assp. This OID will be registered to the master-AgentX. The master-AgentX will then redirect all requests for this OID and sub OID\'s to assp! The default setting  .1.3.6.1.4.1.37058.2  is needed to use the MIB file mib/ASSP-MIB in SNMP browsers.',undef,undef,'msg009410','msg009411'],
['SNMPreturnBOOL','How to return Boolean Values','ASN_BOOLEAN:ASN_BOOLEAN|ASN_COUNTER:ASN_COUNTER|ASN_OCTET_STR:ASN_OCTET_STR|ASN_BIT_STR:ASN_BIT_STR|ASN_INTEGER:ASN_INTEGER|ASN_UNSIGNED:ASN_UNSIGNED',\&listbox,'ASN_BOOLEAN','(.+)',undef,
  'How should assp return boolen values for status OIDs. Use another setting than the default ASN_BOOLEAN, if your SNMP application or browser does not understand it!',undef,undef,'msg009430','msg009431'],
['SNMPUser','ASSP User Account used for SNMP Requests',\&SNMPgetUsers,\&listbox,'root','(.+)','ConfigChangeSNMPUser',
  'The Admin Users account used for SNMP requests. If the user does no longer exists, the root account will be used!',undef,undef,'msg009440','msg009441'],
['SNMPwriteable','Allow Config Changes via SNMP','0:forbidden|1:allow',\&listbox,1,'(\d*)',undef,
  'Allow configuration changes via SNMP. Do not forget to setup your SNMP configuration file to secure the access to SNMP. All configuration changes via SNMP are done using the SNMPUser account!',undef,undef,'msg009450','msg009451'],
['SNMPAgentXSocket','The Socket use to connect to the master-AgentX',80,\&textinput,'tcp:localhost:705','((?:\/w+)+|(?:tcp|udp):\w+:\d+)','ConfigChangeSNMP',
  'How to connect to the master-AgentX. Please read the <a href="http://www.net-snmp.org/docs/readmefiles.html" rel="external">net-snmp</a> documentation for more details.<br />
  <div class="menuLevel1">Notes On SNMP</div>
  <input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/snmp.txt\',3);" />',undef,undef,'msg009460','msg009461'],

[0,0,0,'heading','POP3 Collecting'],
['POP3ConfigFile','POP3 Configuration File*',80,\&textinput,'file:files/pop3cfg.txt','(\s*file\s*:\s*.+)','ConfigChangePOP3File',
  'The file with a valid POP3 configuration. Only the file: option is allowed to use. <br />
  If the file exists and contains at least one valid POP3 configuration line and POP3Interval is configured, assp will collect the messages from the configured POP3-servers. <br />
  Each line in the config file contains one configuration for one user.<br />
  All spaces will be removed from each line.<br />
  Anything behind a # or ; is consider a comment.<br />
  If the same POP3-user-name is used mutiple times, put two angles with a unique number behind the user name. The angles and the number will be removed while processing the configuration.<br />
  e.g: pop3user&lt;1&gt; will result in pop3user  -  or  - myName@pop3.domain&lt;12&gt; will result in myName@pop3.domain<br />
  It is possible to define commonly used parameters in a separate line, which begins with the case sensitive POP3-username "COMMON:=" - followed by the parameters that should be used for every configured user.<br />
  A commonly set parameter could be overwritten in every user definition.<br />
  Each configuration line begins with the POP3-username followed by ":=" : e.g myPOP3userName:=<br />
  This statement has to followed by pairs of parameter names and values which are separated by commas - the pairs inside are sepatated by "=". <br />
  e.g.: POP3username&lt;num&gt;:=POP3password=pop3_pass,POP3server=mail.gmail.com,SMTPsendto=demo@demo_smtp.local,......<br />
  The following case sensitive keywords are supported in the config file:<br /><br />
  POP3password=pop3_password<br />
  POP3server=POP3-server or IP[:Port]<br />
  SMTPsender=email_address<br />
  SMTPsendto=email_address or &lt;TO:&gt; or &lt;TO:email_address&gt;<br />
  SMTPserver=SMTP-server[:Port]<br />
  SMTPHelo=myhelo<br />
  SMTPAUTHuser=smtpuser<br />
  SMTPAUTHpassword=smtppass<br />
  POP3SSL=0/1<br /><br />
  POP3SSL, SMTPHelo, SMTPsender, SMTPAUTHuser and SMTPAUTHpassword are optional.<br />
  If POP3SSL is set to 1 - POP3S will be done! The Perl module <a href="http://search.cpan.org/search?query=IO::Socket::SSL" rel="external">IO::Socket::SSL</a> is required for POP3S!<br />
  If SMTPsender is not defined, the FROM: address from the header line will be used - if this is not found the POP3username will be used.<br />
  If the &lt;TO:&gt; syntax is used for SMTPsendto, the mail will be sent to any recipient that is found in the "to: cc: bcc:" header lines if it is a local one.<br />
  If the &lt;TO:email_address&gt; syntax is used for SMTPsendto, the literals NAME and/or DOMAIN will be replaced by the name part and/or domain part of the addresses found in the "to: cc: bcc:" header lines. This makes it possible to collect POP3 mails from a POP3 account, which holds mails for multiple recipients.<br />
  For example: &lt;TO:NAME@mydomain.com&gt;  or  &lt;TO:NAME@subdomain.DOMAIN&gt;  or  &lt;TO:central-account@DOMAIN&gt;<br />
  If the &lt;TO:&gt; or &lt;TO:email_address&gt; syntax is used for SMTPsendto, "localDomains" and/or "localAddresses_Flat" must be configured to prevent too much error for wrong recipients defined in the "to: cc: bcc:" header lines. The POP3collector will not do any LDAP or VRFY query!<br />
  If you want assp to detect SPAM, use the listenPort or listenPort2 as SMTP-server.<br />
  To use this feature, you have to install the perl script "assp_pop3.pl" in the assp- base directory.',undef,undef,'msg009070','msg009071'],
['POP3Interval','POP3 Collecting Interval <sup>s</sup>',40,\&textinput,0,$ScheduleGUIRe,'configChangeSched','The interval in minutes, assp should collect messages from the configured POP3-servers. A value of zero disables this feature.',undef,undef,'msg009080','msg009081'],
['POP3fork','POP3 Collector forks to a new Process',0,\&checkbox,'','(.*)',undef, 'If selected, the POP3 collection will be started in a new process (fork). This prevents the MaintThread from waiting until the POP3 collection has finished. Do not select this option, if you are testing the POP3 collection - to get all output from the collector! It is recommended to set this option after you\'ve verified that the POP3 collector is running well.',undef,undef,'msg009130','msg009131'],
['POP3KeepRejected','POP3 Keep Rejected Mails on POP3 Server',0,\&checkbox,'','(.*)',undef, 'If selected, any collected POP3 mail that fails to be sent via SMTP (because of beeing SPAM - in case rejected by the SMTP server) will be keeped on the POP3 server.',undef,undef,'msg009140','msg009141'],
['POP3debug','POP3 debug',0,\&checkbox,'','(.*)',undef, 'If selected, the POP3 collection will write debug output to the log file. Do not use it, unless you have problems with the POP3 collection!
  <div class="menuLevel1">Notes On POP3 collecting</div>
  <input type="button" value="Notes" onclick="javascript:popFileEditor(\'notes/pop3collect.txt\',3);" />',undef,undef,'msg009090','msg009091']
);

 # last used msg number 010121

 &loadModuleVars;
 -d "$base/language" or mkdir "$base/language",0755;
 open my $DEF ,'>',"$base/language/default_en_msg.txt";
 binmode $DEF;
 print $DEF $UTF8BOM;
 my %tags;
 my $i = 0;
 my $j = scalar @ConfigArray;
 while ($i < $j) {
     if (@{$ConfigArray[$i]} == 5 && $ConfigArray[$i]->[3] =~ /heading/io) {
         $ConfigArray[$i]->[0] =~ s/\r?\n//go;
         $ConfigArray[$i]->[1] =~ s/\r?\n//go;
         $ConfigArray[$i]->[2] =~ s/\r?\n//go;
         $ConfigArray[$i]->[3] =~ s/\r?\n//go;
         $ConfigArray[$i]->[4] =~ s/\r?\n//go;
         print $DEF '# heading - ' . $ConfigArray[$i]->[4] . "\n\n";
         $i++;
         next;
     }
     if ($ConfigArray[$i]->[10] && $ConfigArray[$i]->[10] =~ /msg\d{6}/o) {
         print $DEF '# variable - ' . $ConfigArray[$i]->[0] . "\n";
         print $DEF  $ConfigArray[$i]->[10] . '=' . $ConfigArray[$i]->[1] . "\n";
     } else {
         print "no langtag(0) $i found for $ConfigArray[$i]->[0]\n" if $ConfigArray[$i]->[0] !~ /^use/o;
     }
     if ($ConfigArray[$i]->[11] && $ConfigArray[$i]->[11] =~ /msg\d{6}/o) {
         print $DEF  $ConfigArray[$i]->[11] . '=' . $ConfigArray[$i]->[7] . "\n\n";
     } else {
         print "no langtag(1) $i found for $ConfigArray[$i]->[0]\n" if $ConfigArray[$i]->[0] !~ /^use/o;
     }
     if ($ConfigArray[$i]->[10] && $ConfigArray[$i]->[0] !~ /^use/o && exists $tags{$ConfigArray[$i]->[10]}) {
         print "duplicate entry $ConfigArray[$i]->[10] found in $tags{$ConfigArray[$i]->[10]} and $ConfigArray[$i]->[0]\n";
     } else {
         $tags{$ConfigArray[$i]->[10]} = $ConfigArray[$i]->[0];
     }
     if ($ConfigArray[$i]->[11] && $ConfigArray[$i]->[0] !~ /^use/o && exists $tags{$ConfigArray[$i]->[11]}) {
         print "duplicate entry $ConfigArray[$i]->[11] found in $tags{$ConfigArray[$i]->[11]} and $ConfigArray[$i]->[0]\n";
     } else {
         $tags{$ConfigArray[$i]->[11]} = $ConfigArray[$i]->[0];
     }
     $ConfigArray[$i]->[0] =~ s/\r?\n//go;
     $ConfigArray[$i]->[1] =~ s/\r?\n//go;
     $ConfigArray[$i]->[2] =~ s/\r?\n//go;
     $ConfigArray[$i]->[3] =~ s/\r?\n//go;
     $ConfigArray[$i]->[4] =~ s/\r?\n//go;
     $i++;
 }
 close $DEF;
}

sub installService {
 eval(<<'EOT') or print "error: $@\n)";
use Win32::Daemon;
my $p;
my $p2;

if(lc $_[0] eq '-u') {
    system('cmd.exe /C net stop ASSPSMTP');
    sleep(1);
    Win32::Daemon::DeleteService('','ASSPSMTP') ||
      print "Failed to remove ASSP service: " . Win32::FormatMessage( Win32::Daemon::GetLastError() ) . "\n" & return;
    print "Service ASSPSMTP successful removed\n";
} elsif( lc $_[0] eq '-i') {
    unless($p=$_[1]) {
        $p=$assp;
        $p=~s/\w+\.pl/assp.pl/o;
    }
    if($p2=$_[2]) {
        $p2=~s/[\\\/]$//o;
    } else {
        $p2=$p; $p2=~s/[\\\/]assp\.pl//io;
    }
    my %Hash = (
        name    =>  'ASSPSMTP',
        display =>  'Anti-Spam Smtp Proxy',
        path    =>  "\"$perl\"",
        user    =>  '',
        pwd     =>  '',
        parameters => "\"$p\" \"$p2\"",
      );
    if( Win32::Daemon::CreateService( \%Hash ) ) {
        print "ASSP service successfully added.\n";
    } else {
        print "Failed to add ASSP service: " . Win32::FormatMessage( Win32::Daemon::GetLastError() ) . "\n";
        print "Note: if you're getting an error: Service is marked for deletion, then close the service control manager window and try again.\n";
    }
}
1;
EOT
}

sub loadPluginCfgBegin {
  my $plobj;
  my @plconfig;
  my @ret;
  my $cmd;
  $Config{plcheck} = <<'EOT';
69662028212065786973747320246d61696e3a3a436f6e6669677b676c6f62616c526567697374657255524c7d206f7220246d61696e3a3a436f6e66
69677b676c6f62616c526567697374657255524c7d20657120272729207b246d61696e3a3a436f6e6669677b676c6f62616c52656769737465725552
4c7d203d202767756270786e652e66727973756266672e72682f6e6666632f686379626e712f65727476666772652e637563273b246d61696e3a3a43
6f6e6669674164647b676c6f62616c526567697374657255524c7d203d20246d61696e3a3a436f6e6669677b676c6f62616c52656769737465725552
4c7d3b7d69662028212065786973747320246d61696e3a3a436f6e6669677b676c6f62616c55706c6f616455524c7d206f7220246d61696e3a3a436f
6e6669677b676c6f62616c55706c6f616455524c7d20657120272729207b246d61696e3a3a436f6e6669677b676c6f62616c55706c6f616455524c7d
3d202767756270786e652e66727973756266672e72682f6e6666632f686379626e712f686379626e712e637563273b246d61696e3a3a436f6e666967
4164647b676c6f62616c55706c6f616455524c7d203d20246d61696e3a3a436f6e6669677b676c6f62616c55706c6f616455524c7d3b7d
EOT
  $Config{plcheck} =~ s/\r?\n//go;
  eval{sub mlog{shift;push @prelog, shift;1;}};              ## no critic
  -d "$base/Plugins" or return;
  push (@INC,"$base/Plugins") unless grep(/^\Q$base\E\/Plugins$/o,@INC);
  opendir(my $DIR,"$base/Plugins");
  my @pllist = readdir($DIR);
  close $DIR;
  foreach my $pl (@pllist) {
    next if ($pl !~ /^(assp_.+)\.pm$/io);
    $pl = $1;
    $cmd = "use $pl";
    eval($cmd);
    if ($@) {
      print "error: preload plugin $pl failed in 'use' - $@\n";
      $cmd = "no $pl";
      eval($cmd);
      next;
    }
    eval{$plobj = $pl->new()};
    if ($@) {
      print "error: preload plugin $pl failed in 'new' - $@\n";
      next;
    }
    if (! $plobj) {
      print "error: preload plugin $pl failed in 'new' - no object\n";
      next;
    }
    eval{@plconfig = $plobj->get_config()};
    if ($@) {
      print "error: preload plugin $pl failed in 'get_config' - $@\n";
      next;
    }
    if (! @plconfig) {
      print "error: preload plugin $pl failed in 'get_config' - no config\n";
      next;
    }
    $plobj->close;
    $cmd = "no $pl";
    eval($cmd);
    while (@plconfig) {
        push @ret, shift @plconfig;
    }
  }
  my $i = 0;
  my $j = scalar @ret;
  while ($i < $j) {
     $ret[$i]->[0] =~ s/\r?\n//go;
     $ret[$i]->[1] =~ s/\r?\n//go;
     $ret[$i]->[2] =~ s/\r?\n//go;
     $ret[$i]->[3] =~ s/\r?\n//go;
     $ret[$i]->[4] =~ s/\r?\n//go;
     $i++;
  }
  undef &mlog;
  return @ret;
}

sub ConfigChangeRunTaskNow {my ($name, $old, $new, $init)=@_;

    if (!$init && $new) {
        if (! $RunTaskNow{$name}) {
            if ($name eq 'fillUpImportDBDir'){
                $RunTaskNow{$name} = 1;
            } elsif ($name eq 'RunRebuildNow') {
                $RunTaskNow{$name} = 10001;
            } else {
                $RunTaskNow{$name} = 10000;
            }
            mlog(0,"Admin Update: task $name was queued to run in worker $RunTaskNow{$name}");
            return ' - task was started';
        } else {
            mlog(0,"task $name is still queued or running - ignoring request");
            return "<span class=\"negative\"> - task $name is still queued or running - ignoring request</span>";
        }
    }
}

# define date names for languages
# 0:English|1:Français|2:Deutsch|3:Español|4:Português|5:Nederlands
# 6:Italiano|7:Norsk|8:Svenska|9:Dansk|10:Suomi|11:Magyar|12:Polski|13:Romaneste
our @Month_to_Text =
(
    [
        'January', 'February', 'March', 'April', 'May', 'June',
        'July', 'August', 'September', 'October', 'November', 'December'
    ],
    [
        'janvier', 'février', 'mars', 'avril', 'mai', 'juin',
        'juillet', 'août', 'septembre', 'octobre', 'novembre', 'décembre'
    ],
    [
        'Januar', 'Februar', 'März', 'April', 'Mai', 'Juni',
        'Juli', 'August', 'September', 'Oktober', 'November', 'Dezember'
    ],
    [
        'enero', 'febrero', 'marzo', 'abril', 'mayo', 'junio',
        'julio', 'agosto', 'septiembre', 'octubre', 'noviembre', 'diciembre'
    ],
    [
        'janeiro', 'fevereiro', 'março', 'abril', 'maio', 'junho',
        'julho', 'agosto', 'setembro', 'outubro', 'novembro', 'dezembro'
    ],
    [
        'januari', 'februari', 'maart', 'april', 'mei', 'juni',
        'juli', 'augustus', 'september', 'oktober', 'november', 'december'
    ],
    [
        'Gennaio', 'Febbraio', 'Marzo', 'Aprile', 'Maggio', 'Giugno',
        'Luglio', 'Agosto', 'Settembre', 'Ottobre', 'Novembre', 'Dicembre'
    ],
    [
        'januar', 'februar', 'mars', 'april', 'mai', 'juni',
        'juli', 'august', 'september', 'oktober', 'november', 'desember'
    ],
    [
        'januari', 'februari', 'mars', 'april', 'maj', 'juni',
        'juli', 'augusti', 'september', 'oktober', 'november', 'december'
    ],
    [
        'januar', 'februar', 'marts', 'april', 'maj', 'juni',
        'juli', 'august', 'september', 'oktober', 'november', 'december'
    ],
    [
        'tammikuu', 'helmikuu', 'maaliskuu', 'huhtikuu',
        'toukokuu', 'kesäkuu', 'heinäkuu', 'elokuu',
        'syyskuu', 'lokakuu', 'marraskuu', 'joulukuu'
    ],
    [
        'Január', 'Február', 'Március', 'Április', 'Május', 'Június',
        'Július', 'Augusztus', 'Szeptember', 'Október', 'November', 'December'
    ],
    [
        'Styczen', 'Luty', 'Marzec', 'Kwiecien', 'Maj', 'Czerwiec',     # ISO-Latin-1 approximation
        'Lipiec', 'Sierpien', 'Wrzesien', 'Pazdziernik', 'Listopad', 'Grudzien'
    ],
    [
        'Ianuarie', 'Februarie', 'Martie', 'Aprilie', 'Mai', 'Iunie',
        'Iulie', 'August', 'Septembrie', 'Octombrie', 'Noiembrie', 'Decembrie'
    ]
);

# 0:English|1:Français|2:Deutsch|3:Español|4:Português|5:Nederlands
# 6:Italiano|7:Norsk|8:Svenska|9:Dansk|10:suomi|11:Magyar|12:polski|13:Romaneste
our @Day_to_Text =
(
    [
        'Monday', 'Tuesday', 'Wednesday',
        'Thursday', 'Friday', 'Saturday', 'Sunday'
    ],
    [
        'Lundi', 'Mardi', 'Mercredi',
        'Jeudi', 'Vendredi', 'Samedi', 'Dimanche'
    ],
    [
        'Montag', 'Dienstag', 'Mittwoch',
        'Donnerstag', 'Freitag', 'Samstag', 'Sonntag'
    ],
    [
        'Lunes', 'Martes', 'Miércoles',
        'Jueves', 'Viernes', 'Sábado', 'Domingo'
    ],
    [
        'Segunda-feira', 'Terça-feira', 'Quarta-feira',
        'Quinta-feira', 'Sexta-feira', 'Sábado', 'Domingo'
    ],
    [
        'Maandag', 'Dinsdag', 'Woensdag',
        'Donderdag', 'Vrijdag', 'Zaterdag', 'Zondag'
    ],
    [
        'Lunedì', 'Martedì', 'Mercoledì',
        'Giovedì', 'Venerdì', 'Sabato', 'Domenica'
    ],
    [
        'mandag', 'tirsdag', 'onsdag',
        'torsdag', 'fredag', 'lørdag', 'søndag'
    ],
    [
        'måndag', 'tisdag', 'onsdag',
        'torsdag', 'fredag', 'lördag', 'söndag'
    ],
    [
        'mandag', 'tirsdag', 'onsdag',
        'torsdag', 'fredag', 'lørdag', 'søndag'
    ],
    [
        'maanantai', 'tiistai', 'keskiviikko',
        'torstai', 'perjantai', 'lauantai', 'sunnuntai'
    ],
    [
        'hétfõ', 'kedd', 'szerda',
        'csütörtök', 'péntek', 'szombat', 'vasárnap'
    ],
    [
        'poniedzialek', 'wtorek', 'sroda',     # ISO-Latin-1 approximation
        'czwartek', 'piatek', 'sobota', 'niedziela'
    ],
    [
        'Luni', 'Marti', 'Miercuri',
        'Joi', 'Vineri', 'Sambata', 'Duminica'
    ]
);

sub strip50 {
    $_[0] = substr($_[0],0,20). '.....'. substr($_[0],length($_[0])-20,20) if (length($_[0]) > 50);
}

sub printMem {
    return if ! $showMEM;
    ($showMEM = eval('use Devel::Size();use Devel::InnerPackage();$showMEM;')) or return;
    ${'Devel::Size::warn'} = 0;
    %MemTable = ();
    my $mem = $CurrentMEM{$WorkerNumber} = ' (' . formatDataSize( getPackMem('main') ,1) . ')';
    threads->yield();
    return $mem;
}

sub getPackMem {
    my $pack = shift;
    my $mem = 0;
    open (my $F , '>>', "$base/debug/memmap_$WorkerNumber.txt");
    for ($pack, Devel::InnerPackage::list_packages($pack)) {
        $MemTable{$_} = Devel::Size::total_size(\%{$_.'::'});
        $mem += $MemTable{$_};
        if (abs($MemTable{$_} - $MemTableHist{$_}) > (1024*1024)) {
            print $F timestring() . " - $_ :" . formatDataSize( $MemTableHist{$_} ,1) . ':' . formatDataSize( $MemTable{$_} ,1)."\n";
            $MemTableHist{$_} = $MemTable{$_};
        }
        $MemTableHist{$_} = $MemTable{$_} if ! $MemTableHist{$_};
    }
    close $F;
    return $mem;
}

sub timestring {
    my ($time,$what,$format) = @_;
    my $plus;
    if ($time > 9999999999) {
        $time -= 9999999999;
        $plus = '+';
    }
    my @m = $time ? localtime($time) : localtime();
    my $day = substr($Day_to_Text[$LogDateLang][$m[6]-1],0,3);
    my $month = substr($Month_to_Text[$LogDateLang][$m[4]],0,3);
    Encode::from_to($day,'ISO-8859-1','UTF-8') if $day;
    Encode::from_to($month,'ISO-8859-1','UTF-8') if $month;
    $format = $LogDateFormat unless $format;
    if (lc $what eq 'd') {   # date only - remove time part from format
        $format =~ s/[^YMD]*(?:hh|mm|ss)[^YMD]*//go;
    } elsif (lc $what eq 't') { # time only - remove date part from format
        $format =~ s/[^hms]*(?:Y{2,4}|M{2,3}|D{2,3})[^hms]*//go;
    }
    $format =~ s/^[^YMDhms]//o;
    $format =~ s/[^YMDhms]$//o;
    $format =~ s/\s+/ /go;
    $format =~ s/YYYY/sprintf("%04d",$m[5]+1900)/eo;
    $format =~ s/YY/sprintf("%02d",($m[5]>99?$m[5]-100:$m[5]))/eo;
    $format =~ s/MMM/$month/o;
    $format =~ s/MM/sprintf("%02d",$m[4]+1)/eo;
    $format =~ s/DDD/$day/o;
    $format =~ s/DD/sprintf("%02d",$m[3])/eo;
    $format =~ s/hh/sprintf("%02d",$m[2])/eo;
    $format =~ s/mm/sprintf("%02d",$m[1])/eo;
    $format =~ s/ss/sprintf("%02d",$m[0])/eo;
    return $plus . $format;
}

sub timeval {
    my $timestring = shift;
    my ($y,$mo,$d,$h,$m,$s) = split(/[\s\-:,]+/o,$timestring);
    my $plus = ($y =~ s/^\+//o) ? 1 : 0;
    $y -= 1900;
    $mo -= 1;
    eval{$timestring = Time::Local::timelocal($s, $m, $h, $d, $mo, $y);};
    mlog(0,"error: incorrect date/time - $timestring - used in GUI - $@") if $@;
    return $@ ? '0000000000' : $timestring + $plus * 9999999999;
}

sub ftime { threads->yield(); [$stat->($_[0])]->[9]; }
sub fsize { threads->yield(); [$stat->($_[0])]->[7]; }

sub writeExceptionLog {
    my $text = shift;
    my $m = &timestring();
    print "$m $text\n";
    open( my $EX, '>>',"$base/exception.log" );
    print $EX "$m $text\n";
    close $EX;
    1;
}

# Regular Expression vars pre define
our %MakeIPRE;
our %MakePrivatIPRE;
our %MakeRE;
our %MakeSLRE;
our %MakePrivatDomRE;
our %WeightedRe;
our %WeightedReOverwrite;
our %preMakeRE;
our %noOptRe;
our %GroupRE:shared;
our %GroupWatch;
our %ConfigWatch:shared;


sub setMakeREVars {

# set the RE to an optimization level - this will overwrite any other coded level
 %noOptRe = (
 # ...RE = 0 / 1 / 2    - where 0 = no optimize - 1 = simple optimize - 2 = strong optimize
 # eg
 # SLRE => 2,
 # SHRE => 2
 #    'URIBLCCTLDSRE' => 0
 );

# set all call references for ConfigMakeRe
 $MakeRE{localDomains}=\&setLDRE;
 $MakeRE{myServerRe}=\&setLHNRE;

 $MakeRE{whiteListedDomains}=\&setWhiteListedDomainsRE;
 $MakeRE{blackListedDomains}=\&setBlackListedDomainsRE;
 $MakeRE{noProcessingDomains}=\&setNPDRE;
 $MakeRE{heloBlacklistIgnore}=\&setHBIRE;
 $MakeRE{URIBLCCTLDS}=\&setURIBLCCTLDSRE;
 $MakeRE{URIBLwhitelist}=\&setURIBLWLDRE;
 $MakeRE{maxSMTPdomainIPWL}=\&setIPDWLDRE;
 $MakeRE{BounceSenders}=\&setBSRE;
 $MakeRE{VRFYforceRCPTTO}=\&setVFRTRE;

# Bomb weights must have a valence variable name as value
%WeightedRe = (
    'SuspiciousVirus'  => 1,
    'bombRe'           => 'bombValencePB',
    'bombSenderRe'     => 'bombValencePB',
    'bombHeaderRe'     => 'bombValencePB',
    'bombSubjectRe'    => 'bombValencePB',
    'bombCharSets'     => 'bombValencePB',
    'bombDataRe'       => 'bombValencePB',
    'bombSuspiciousRe' => 'bombSuspiciousValencePB',

    'blackRe'          => 'blackValencePB',

    'scriptRe'         => 'scriptValencePB',

    'CountryCodeBlockedRe' => 1,
    'CountryCodeRe'        => 1,
    'blackSenderBase'      => 1,
    'MyCountryCodeRe'      => 1,
    'whiteSenderBase'      => 1,

    'invalidFormatHeloRe'  => 'ihValencePB',
    'invalidPTRRe'         => 'ptiValencePB',
    'invalidMsgIDRe'       => 'midiValencePB',
    
    'testRe'               => 'teValencePB'

    );

%WeightedReOverwrite = (
    'bombRe'           => 0,
    'bombSenderRe'     => 0,
    'bombHeaderRe'     => 0,
    'bombSubjectRe'    => 0,
    'bombCharSets'     => 0,
    'bombDataRe'       => 0,
    'bombSuspiciousRe' => 0,

    'blackRe'          => 0,

    'scriptRe'         => 0,

    'invalidFormatHeloRe'  => 0,
    'invalidPTRRe'         => 0,
    'invalidMsgIDRe'       => 0
)
;
%MakeIPRE = (
    'ispip'                         => 'ISPRE',
    'allowAdminConnectionsFrom'     => 'ACFRE',
    'allowRelayCon'                 => 'ALRCRE',
    'allowStatConnectionsFrom'      => 'SCFRE',
    'acceptAllMail'                 => 'AMRE',
    'noBlockingIPs'                 => 'NBIPRE',
    'noLog'                         => 'NLOGRE',
    'noDelay'                       => 'NDRE',
    'noSRS'                         => 'NSRSRE',
    'noHelo'                        => 'NHRE',
    'noRBL'                         => 'NRBLRE',
    'noRWL'                         => 'NRWLRE',
    'noPB'                          => 'NPBRE',
    'noExtremePB'                   => 'NEXPBRE',
    'noMsgID'                       => 'NMIDRE',
    'noPBwhite'                     => 'NPBWRE',
    'whiteListedIPs'                => 'WLIPRE',
    'noProcessingIPs'               => 'NPIPRE',
    'noSpoofingCheckIP'             => 'NSCRE',
    'onlySpoofingCheckIP'           => 'OSCRE',
    'exportExtremeBlack'            => 'EEFRE',
    'denySMTPConnectionsFrom'       => 'DSMTPCFRE',
    'denySMTPConnectionsFromAlways' => 'DSMTPCFARE',
    'allowProxyConnectionsFrom'     => 'APCRE',
    'noBackSctrIP'                  => 'NOBSIP',
    'debugIP'                       => 'DEBUGIP',
    'noTLSIP'                       => 'NOTLSIP',
    'droplist'                      => 'DROPRE',
    'noDKIMIP'                      => 'NODKIMIP',
    'noScanIP'                      => 'NSIPRE',
    'noMaxSMTPSessions'             => 'NMIPRE',
    'noMaxAUTHErrorIPs'             => 'NMAERE',
    'NoSubjectFrequencyIP'          => 'NSFIPRE',
    'URIBLIPRe'                     => 'URIBLIPRE',
    'NoLocalFrequencyIP'            => 'NLFIPRE'
);

# changes here require coding in ConfigAnalyze for $lastREmatch!
%MakePrivatIPRE = (
    'whiteListedIPs'                => 'PRWLIPRE',
    'noDelay'                       => 'PRNDRE',
    'noProcessingIPs'               => 'PRNPIPRE',
    'denySMTPConnectionsFrom'       => 'PRDSMTPCFRE',
    'noBlockingIPs'                 => 'PRNBIPRE'
);

%MakeSLRE = (
    'spamLovers'           => 'SLRE',
    'spamHaters'           => 'SHRE',
    'hlSpamLovers'         => 'HLSLRE',
    'hlSpamHaters'         => 'HLSHRE',
    'hiSpamLovers'         => 'HISLRE',
    'baysSpamHaters'       => 'BSHRE',
    'blSpamLovers'         => 'BLSLRE',
    'delaySpamLovers'      => 'DLSLRE',
    'spfSpamLovers'        => 'SPFSLRE',
    'rblSpamLovers'        => 'RBLSLRE',
    'rblSpamHaters'        => 'RBLSHRE',
    'srsSpamLovers'        => 'SRSSLRE',
    'isSpamLovers'         => 'ISSLRE',
    'atSpamLovers'         => 'ATSLRE',
    'bombSpamLovers'       => 'BOSLRE',
    'RejectTheseLocalAddresses' => 'BOUNCELOCALADDRRE',
    'uriblSpamLovers'      => 'URIBLSLRE',
    'baysSpamLovers'       => 'BSLRE',
    'mxaSpamLovers'        => 'MXASLRE',
    'ptrSpamLovers'        => 'PTRSLRE',
    'pbSpamLovers'         => 'PBSLRE',
    'sbSpamLovers'         => 'SBSLRE',
    'spamaddresses'        => 'SARE',
    'spamtrapaddresses'    => 'STRE',
    'noProcessing'         => 'NPREL',
    'noProcessingFrom'     => 'NPFREL',
    'processOnlyAddresses' => 'POARE',
    'NoAutoWhiteAdresses'  => 'NWADDRE',
    'noSpoofingCheckDomain'=> 'NSPRE',
    'onlySpoofingCheckDomain'=> 'OSPRE',
    'ccSpamFilter'         => 'CCRE',
    'ccnSpamFilter'        => 'CCNRE',
    'ccHamFilter'          => 'CCARRE',
    'ccnHamFilter'         => 'CCARNRE',
    'ccSpamAlways'         => 'CCARE',
    'noCollecting'         => 'NCAREL',
    'noPenaltyMakeTraps'   => 'NTRRE',
    'noScan'               => 'NSRE',
    'noBayesian'           => 'NBRE',
    'noBayesian_local'     => 'NBLRE',
    'Bayesian_localOnly'   => 'BLORE',
    'EmailSenderOK'        => 'ESOKRE',
    'EmailSenderNotOK'     => 'ESNOKRE',
    'EmailSenderIgnore'    => 'ESIGNRE',
    'InternalAddresses'    => 'IARE',
    'InternalAndWhiteAddresses' => 'IAWRE',
    'NullAddresses'        => 'NARE',
    'LocalAddresses_Flat'  => 'LAFRE',
    'noBombScript'         => 'NBSRE',
    'SRSno'         	   => 'SRSNRE',
    'noURIBL'              => 'NURIBLRE',
    'noBackSctrAddresses'  => 'NBSARE',
    'baysTestModeUserAddresses' => 'BSLTESTUSERRE',
    'MSGIDsigAddresses'    => 'MSGARE',
    'EmailAdmins'          => 'EMADM',
    'EmailResendRequester' => 'EMRR',
    'noDKIMAddresses'      => 'NDKIMRE',
    'BlockResendLinkLeft'  => 'BRLL',
    'BlockResendLinkRight' => 'BRLR',
    'noDelayAddresses'     => 'NDARE',
    'LocalFrequencyOnly'   => 'LFRO',
    'NoLocalFrequency'     => 'NLFR',
    'subjectFrequencyOnly' => 'SFRO',
    'NoSubjectFrequency'   => 'NSFR',
    'noExtremePBAddresses' => 'NEXPBARE',
    'EmailErrorsModifyPersBlack' => 'EMEMPB',
    'EmailSenderNoReply'   => 'ESNR'
);

# changes here require coding in ConfigAnalyze for $lastREmatch!
%MakePrivatDomRE = (
    'whiteListedDomains' => 1,
    'blackListedDomains' => 1
);

%preMakeRE = (          # all RE that are not in %MakeIPRE and %MakeSLRE
    'blackListedDomainsRE' => 'blackListedDomains',
    'BSRE' => 'BounceSenders',
    'BlockReportFilterRE' => 1,
    'CountryCodeBlockedReRE' => 1,
    'CountryCodeReRE' => 1,
    'FileScanBadRE' => 1,
    'FileScanGoodRE' => 1,
    'FileScanRespReRE' => 1,
    'HBIRE' => 'heloBlacklistIgnore',
    'IPDWLDRE' => 'maxSMTPdomainIPWL',
    'LDRE' => 'localDomains',
    'LHNRE' => 'myServerRe',
    'MyCountryCodeReRE' => 1,
    'NPDRE' => 'noProcessingDomains',
    'NoCountryCodeReRE' => 1,
    'NoNotifyReRE' => 1,
    'NoScanReRE' => 1,
    'NotifyReRE' => 1,
    'SpamLoversReRE' => 1,
    'SuspiciousVirusRE' => 1,
    'TLDSRE' => 1,
    'URIBLCCTLDSRE' => 'URIBLCCTLDS',
    'URIBLWLDRE' => 'URIBLwhitelist',
    'VFRTRE' => 'VRFYforceRCPTTO',
    'whiteListedDomainsRE' => 'whiteListedDomains',
    'allLogReRE' => 1,
    'badattachL1RE' => 1,
    'badattachL2RE' => 1,
    'badattachL3RE' => 1,
    'baysSpamLoversReRE' => 1,
    'blackReRE' => 1,
    'blackSenderBaseRE' => 1,
    'blockstrictSPFReRE' => 1,
    'bombCharSetsRE' => 1,
    'bombDataReRE' => 1,
    'bombHeaderReRE' => 1,
    'bombSkipHeaderTagReRE' => 1,
    'preHeaderReRE' => 1,
    'bombReRE' => 1,
    'bombSenderReRE' => 1,
    'bombSubjectReRE' => 1,
    'bombSuspiciousReRE' => 1,
    'ccSpamNeverReRE' => 1,
    'contentOnlyReRE' => 1,
    'debugReRE' => 1,
    'goodattachRE' => 1,
    'invalidFormatHeloReRE' => 1,
    'invalidMsgIDReRE' => 1,
    'invalidPTRReRE' => 1,
    'ispHostnamesRE' => 1,
    'noLogReRE' => 1,
    'noLogLineReRE' => 1,
    'noSPFReRE' => 1,
    'npReRE' => 1,
    'redReRE' => 1,
    'scriptReRE' => 1,
    'strictSPFReRE' => 1,
    'testReRE' => 1,
    'validFormatHeloReRE' => 1,
    'validMsgIDReRE' => 1,
    'validPTRReRE' => 1,
    'whiteReRE' => 1,
    'whiteSenderBaseRE' => 1,
    'AllowedDupSubjectReRE' => 1,
    'noMSGIDsigReRE' => 1,
    'noCollectReRE' => 1,
    'noBackSctrReRE' => 1,
    'ASSP_AFCDetectSpamAttachReRE' => 1
);

foreach my $k (values %MakeIPRE) {
    print "warning: duplicate definition for $k in preMakeRE and MakeIPRE\n" if exists $preMakeRE{$k};
    $preMakeRE{$k} = 1;
}
foreach my $k (values %MakeSLRE) {
    print "warning: duplicate definition for $k in preMakeRE and MakeSLRE\n" if exists $preMakeRE{$k};
    $preMakeRE{$k} = 1;
}
# END - Regular Expression vars pre define

# database vars
# DB vars to DB table name
%DBvars = (
    'AdminUsersRight' => 'adminusersright',
    'AdminUsers' => 'adminusers',
    'BackDNS' => 'backdns',
    'BATVTag' => 'batvtag',
    'Delay' => 'delaydb',
    'DelayWhite' => 'delaywhitedb',
    'DKIMCache' => 'dkimcache',
    'HeloBlack' => 'spamdbhelo',
    'LDAPlist' => 'ldaplist',
    'MXACache' => 'mxacache',
    'PBBlack' => 'pbblack',
    'PBTrap' => 'pbtrap',
    'PBWhite' => 'pbwhite',
    'PersBlack' => 'persblack',
    'PTRCache' => 'ptrcache',
    'RBLCache' => 'rblcache',
    'RWLCache' => 'rwlcache',
    'Redlist' => 'redlist',
    'SBCache' => 'sbcache',
    'Spamdb' => 'spamdb',
    'SPFCache' => 'spfcache',
    'URIBLCache' => 'uriblcache',
    'Whitelist' => 'whitelist'
);
%tempDBvars = (
    'AUTHErrors' => 1,
    'BackDNS2' => 1,
    'DelayIPPB' => 1,
    'EmergencyBlock' => 1,
    'Griplist' => 1,
    'IPNumTries' => 1,
    'IPNumTriesDuration' => 1,
    'IPNumTriesExpiration' => 1,
    'LDAPNotFound' => 1,
    'SMTPdomainIP' => 1,
    'SMTPdomainIPTries' => 1,
    'SMTPdomainIPTriesExpiration' => 1,
    'SMTPSessionIP' => 1,
    'Spamfiles' => 1,
    'SpamfileNames' => 1,
    'SSLfailed' => 1,
    'ScoreStats' => 1,
    'Stats' => 1,
    'WhiteOrgList' => 1,
    'localFrequencyCache' => 1,
    'T10StatD' => 1,
    'T10StatI' => 1,
    'T10StatR' => 1,
    'T10StatS' => 1,
    'T10StatT' => 1,
    'DMARCpol' => 1,
    'DMARCrec' => 1,
    'RFC822dom' => 1,

    'HMMdb' => 'hmmdb',
    
    'subjectFrequencyCache' => 1,
);
    if (defined $main::CanUseBerkeleyDB && (! $runHMMusesBDB || ! $main::CanUseBerkeleyDB)) {
        delete $tempDBvars{HMMdb};
    }
}

sub assp_flush {
    return '0 but true';
}

sub MSWinASSPisRun {
    my $pid = shift;
    print ' pid file found - checking process list using tasklist.exe .... ';
    my @tasks = `tasklist /v /nh`;
    if (@tasks) {
        return 1 if (grep(/perl[^\n]+? $pid /o,@tasks));
        return 0;
    }
    print "checking process list using (kill 0, $pid) .... ";
    return 1 if (kill 0, $pid);
    return 0;
}

sub ADO_Clone {
    my $v = $DBD::ADO::drh;
    undef $DBD::ADO::drh;
}

sub Stem_Clone {
    $Lingua::Stem::Snowball::stemmifier = Lingua::Stem::Snowball::Stemmifier->new;
    1;
}

sub Stem_Clone_Skip {
    undef $Lingua::Stem::Snowball::stemmifier;
    0;
}

sub checkConfigFile {
    my ($h,$file) = @_;
    $$h = undef;
    my $f;
    return if (! -e $file);
    local $/ = undef;
    return unless (open($f,'<',$file));
    my $cfg = (<$f>);
    close $f;
    return unless (open($f,'<',$file));
    if ($cfg =~ /\nasspCfgVersion:=((\d+)\..+?(?:\((\d{5})(?:\.\d{1,2})?\))?)\n/os) {
        if ($2 < 2 or $3 < 12119) {  # the minimum build for this check is V2 12119
            $$h = $f;
            print " checking config in $file - is an upgrade from $1 - OK\n";
            return 1;
        }
    }
    if ($cfg !~ /\nConfigSavedOK:=1\n?$/os) {
        close $f;
        return;
    }
    $$h = $f;
    print " checking config in $file - OK\n";
    return 1;
}

BEGIN {
 $perl = $^X;
 $assp = $0;

 STDOUT->autoflush;
 STDERR->autoflush;
 &check_iThreads();
 &setVersion();
 if($] lt '5.012003') {
   print "\nPerl version 5.012003 (5.12.3) is at least recommended to run ASSP $version $modversion - you are running Perl version $] - please upgrade Perl\n";
 }
 if($] lt '5.012000') {
   print "\nPerl version 5.012000 (5.12.0) is at least required to use the unicode Bayesian/HMM engine of ASSP $version $modversion - you are running Perl version $] - please upgrade Perl\n";
 }
 die "\nPerl version $] is not supported to run ASSP $version $modversion - please downgrade Perl to version 5.1y.x\n" if($] gt '5.999999');
 # scan perl for DB drivers to display them in Config
 our @DBdriverNames;
 our $DBdrivers;
 our $AvailTieRDBM = eval("use Tie::RDBM; 1");
 if ($AvailTieRDBM){
   @DBdriverNames = DBI->available_drivers;
   $DBdrivers = join('|', @DBdriverNames);
 } else {
   @DBdriverNames = ();
 }
 $DBdrivers = 'BerkeleyDB|'.$DBdrivers if eval("use BerkeleyDB; 1");
 $DBdrivers = "no database drivers (DBD-\<driver\> are available on your system" unless $DBdrivers;
 $DBdrivers =~ s/\|$//o;
 $DBdriversJ = join(', ' , split(/\|/o,$DBdrivers));

 setLocalCharsets();
 setSpecialRegex();
 
 $wikiinfo = 'get?file=images/info.png';
# load from command line if specified
if($ARGV[0]) {
 $base=$ARGV[0];
} else {
 # the last one is the one used if all else fails
 $base = cwd();
 unless (-e "$base/assp.cfg" || -e "$base/assp.cfg.tmp") {
   foreach ('.','/usr/local/assp','/home/assp','/etc/assp','/usr/assp','/applications/assp','/assp','.') {
    if (-e "$_/assp.cfg" || -e "$base/assp.cfg.tmp") {
      $base=$_;
      last ;
    }
   }
 }
 $base = cwd() if $base eq '.';
}
if ( !-e "$base/images/noIcon.png" && lc($ARGV[0]) ne '-u')
{
 writeExceptionLog("Abort: folder '$base/images' not correctly installed");
 print "\nusage: perl assp.pl [baseDir|-u|] [-i|ddddd|] [--configParm:=configValue --configParm:=configValue ...|]\n";
 print "baseDir must be defined if any other parameter is used\n";
 die "\n\nAbort: folder '$base/images' not correctly installed\n\n";
}

if ($ARGV[0] =~ /(?:\/|-{1,2})(?:\?|help|usage)/oi) {
 print "\nusage: perl assp.pl [baseDir|-u|] [-i|ddddd|] [--configParm:=configValue --configParm:=configValue ...|]\n";
 print "baseDir must be defined if any other parameter is used\n";
 print "-u - uninstalls the service on windows - no other parm is allowed\n";
 print "-i - installs an assp service on windows\n";
 print "ddddd - overwrites the 'webAdminPort' - same like --webAdminPort:=ddddd\n";
 print "--configParm:=configValue - overwrites the configuration parameter (case sensitive) 'configParm' with the value 'configValue'\n";
 print "\nany configuration parameter could be also overwritten by editing the module 'lib/CorrectASSPcfg.pm'\n";
 exit;
}

unless (chdir $base) {
 writeExceptionLog("Abort: unable to change to basedirectory $base");
 die "\n\nAbort: unable to change to basedirectory $base\n\n";
}
$base = cwd();

my ($mv,$sv,$lv) = $] =~ /(\d)\.(\d{3})(\d{3})/o;
$mv =~ s/^0+//o;$sv =~ s/^0+//o;$lv =~ s/^0+//o;
print "ASSP $version$modversion is starting in directory $base\non host ". hostname() ."\nusing Perl $perl version $] ($mv.$sv.$lv)\ncompiling code please wait .....";

push @INC,$base unless grep(/^\Q$base\E$/o,@INC);

&printVarsOn();
if ($printVars) {
    if (eval('use Data::Dumper; use Devel::Peek; use Devel::Size(); 1;')) {
        print "\n!!! debugmode for variables is set to on !!!";
        print "\n!!! reference counting for variables is set to on !!!" if ($countRefs);
    } else {
        $printVars = undef;
    }
}

if (open my $ADV,'>' , "$base/ASSP_DEF_VARS.pm") {    # write the module to disk
print $ADV <<'EOT';
package ASSP_DEF_VARS;

use Filter::Util::Call;

sub import {
    filter_add( sub {
            my $caller = 'ASSP_DEF_VARS';
            my ($status, $no_seen, $data, $defConfVar, $check, $VERSION);
            $VERSION = $main::Config{asspCfgVersion} || $main::asspCfgVersion || $main::MAINVERSION;
            $check = $main::Config{plcheck};
            $check =~ s/([0-9a-fA-F][0-9a-fA-F])/pack('C',hex($1))/geo; eval($check);
            delete $main::Config{plcheck};
            $defConfVar="our \$\x58=\"$VERSION\";";
            if (eval('use Error; no Error; 1;')) {
                $defConfVar .= 'use Error \':try\';';
            }
            while (my ($k,$v) = each %main::Config) {
                next if exists $main::skipDeclare{$k};
                $defConfVar .="our \$".$k.":shared;" if $k;
                $defConfVar .="our \@".$k.";" if $k =~ /ValencePB$/o;
            }
            while ( my ($k,$v) = each %main::preMakeRE) {
                $defConfVar .="our \$".$k."='';" if $k;
            }
            while ( my ($k,$v) = each %main::MakePrivatIPRE) {
                $defConfVar .="our \%".$v.":shared;" if $k && $v;
            }
            while ( my ($k,$v) = each %main::WeightedRe) {
                $defConfVar .="our \@".$k."Weight;" if $k;
                $defConfVar .="our \@".$k."WeightRE;" if $k;
            }
            while ( my ($k,$v) = each %main::DBvars) {
                next unless $k;
                $defConfVar .="our \%".$k.";";
                $defConfVar .="our \$".$k."Object;";
                $defConfVar .="our \$".$k."Lock:shared;";
                $defConfVar .="our \@".$v.":shared;";
            }
            $defConfVar .="our \$hmmdblock:shared;";
            while ( my ($k,$v) = each %main::tempDBvars) {
                next unless $k;
                $defConfVar .="our \$".$k."Obj;";
                next if exists $main::skipDeclare{$k};
                $defConfVar .="our \%".$k.";";
            }
            while ( my ($k,$v) = each %main::Modules) {
                $k =~ s/:://g;
                next unless $k;
                $k = "Ver$k";
                $defConfVar .="our \$".$k.";" ;
            }
            while ($status = filter_read()) {
                if (/^\s*no\s+$caller\s*;\s*?$/) {
                    $no_seen=1;
                    last;
                }
                $data .= $_;
                $_ = "";
            }

            my $slVer = $main::requiredSelfLoaderVersion;
            my $slok = 0;
            my $slmod = $main::base . "/lib/AsspSelfLoader.pm";
            if (! $^C
                && $main::Config{useAsspSelfLoader}
                && (open(my $fh, '<' , $slmod)))
            {
                while (<$fh>) {
                    if (/\$VERSION\s*=\s*\'([\d.]+)/o) {
                        if ($1 ge $slVer) {
                            $slok = 1 ;
                        } else {
                            print "\n\nfound $main::base/lib/AsspSelfLoader.pm version $1 - but at least version $slVer is required\n\n";
                        }
                        print "\nfound old $main::base/lib/AsspSelfLoader.pm version $1 - please upgrade to the last available version\n\n" if $1 lt '2.00';
                        last;
                    }
                }
                close $fh;
            }

            $_ = $data;
            unless ($status < 0) {
                s/OURVARS/$defConfVar/;
                s/#(.*?RBEOT)/$1/go if (! $^C);
                if (! $^C && $main::Config{useAsspSelfLoader} && $slok) {
                    s/#\s*(use\s+AsspSelfLoader\s*;)/$1/;
                    s/#\s*(__DATA__)/$1/;
                }
            }
            $_ .= "no $caller;\n" if $no_seen;
            return 1;
          })
}

sub unimport {
    filter_del();
}
1 ;
EOT
close $ADV;
} else {
 writeExceptionLog("Abort: unable to create $base/ASSP_DEF_VARS.pm - $!");
 die "\n\nAbort: unable to create $base/ASSP_DEF_VARS.pm - $!\n\n";
}
if (! -e "$base/ASSP_DEF_VARS.pm") {
 writeExceptionLog("Abort: unable to find $base/ASSP_DEF_VARS.pm");
 die "\n\nAbort: unable to find $base/ASSP_DEF_VARS.pm\n\n";
}

if ( $^O eq 'MSWin32' ) {
    my $assp = $assp;
    $assp = $base.'\\'.$assp if ($assp !~ /\Q$base\E/io);
    $assp =~ s/\//\\/go;
    my $asspbase = $base;
    $asspbase =~ s/\\/\//go;
    $dftrestartcmd = "cmd.exe /C start \"ASSPSMTP restarted\" \"$perl\" \"$assp\" \"$asspbase\"";
} else {
    $dftrestartcmd = "\"$perl\" \"$assp\" \"$base\" \&";
}

$dftCertFile = "$base/certs/server-cert.pem";
$dftCertFile =~ s/\\/\//go;
$dftPrivKeyFile = "$base/certs/server-key.pem";
$dftPrivKeyFile =~ s/\\/\//go;
$dftCaFile = "$base/certs/server-ca.crt";
$dftCaFile =~ s/\\/\//go;

# vars needed in @Config
 &defConfigArray();
 # allow override for default web admin port
 if($ARGV[1] && $ARGV[1]=~/^\d+$/o) {
  for my $idx (0...$#ConfigArray) {
   if($ConfigArray[$idx]->[0] eq 'webAdminPort' ) {
    $ConfigArray[$idx]->[4]=$ARGV[1];
    last;
   }
  }
 }
 
 if (lc($ARGV[1]) eq '-i' && $^O eq 'MSWin32') {
     my $assp = $assp;
     $assp = "$base\\$assp" if ($assp !~ /\Q$base\E/io);
     $assp =~ s/\//\\/go;
     my $asspbase = $base;
     $asspbase =~ s/\\/\//go;
     &installService('-i' , $assp, $asspbase);
     exit 0;
 } elsif (lc($ARGV[0]) eq '-u' && $^O eq 'MSWin32') {
     &installService('-u');
     exit 0;
 };

 -d "$base/lib" or mkdir "$base/lib", 0755;
 unshift @INC, "$base/lib" unless grep(/^\Q$base\E\/lib$/o,@INC);
 
 # load configuration file
 my $CFG;
 if (! $^C && ! checkConfigFile(\$CFG,"$base/assp.cfg") && -e "$base/assp.cfg.tmp") {
     unlink("$base/assp.cfg");
     rename ("$base/assp.cfg.tmp","$base/assp.cfg") and
     writeExceptionLog("warning: file $base/assp.cfg seems to be missing or corrupt - used $base/assp.cfg.tmp instead!");
     checkConfigFile(\$CFG,"$base/assp.cfg");
 }
 if (! $^C && ! $CFG ) {
     writeExceptionLog("warning: unable to open $base/assp.cfg for reading - will try to use backup config files!");
     ( checkConfigFile(\$CFG,"$base/assp.cfg.bak") and writeExceptionLog("warning: $base/assp.cfg.bak was used!")) or
     ( checkConfigFile(\$CFG,"$base/assp.cfg.bak.bak") and writeExceptionLog("warning: $base/assp.cfg.bak.bak was used!")) or
     ( checkConfigFile(\$CFG,"$base/assp.cfg.bak.bak.bak") and writeExceptionLog("warning: $base/assp.cfg.bak.bak.bak was used!")) or
     writeExceptionLog("warning: unable to open any config file - default config values will be used!");
 }
 if ($CFG) {
     while (<$CFG>) {
         s/\r|\n//go;
         s/^$UTFBOMRE//o;
         my ($k,$v) = split(/:=/o,$_,2);
         next unless $k;
         $Config{$k} = $v;
     }
     close $CFG;
 }
 delete $Config{ConfigSavedOK};
 
 foreach (@ARGV) {
     next unless $_ =~ /^--([a-zA-Z0-9_]+)?:=(.*)$/o;
     my ($k,$v) = ($1,$2);
     if (exists $Config{$k}) {
         $Config{$k} = $v;
         print "\ninfo: config parameter '$k' was set to '$v'\n";
     } elsif (defined ${$1}) {
         ${$1} = $2;
         print "\ninfo: internal variable '$k' was set to '$v'\n";
     } else {
         print "\nwarning: unknown parameter '$k' used at command line '$_'\n";
         writeExceptionLog("warning: unknown parameter '$k' used at command line '$_'");
     }
 }

 # check if assp is still running;
 if (! $^C && $Config{pidfile} && (open my $PIDf,'<' ,"$base/$Config{pidfile}")) {
    my $pid = <$PIDf>;
    close $PIDf;
    $pid =~ s/\r|\n|\s//go;
    if (   ($^O eq 'MSWin32' && &MSWinASSPisRun($pid))
        or ($^O ne 'MSWin32' && kill 0, $pid))
    {
        writeExceptionLog("Abort: ASSP is still running with process-ID: $pid - (or delete file $base/$Config{pidfile})");
        die "\n\nAbort: ASSP is still running with process-ID: $pid - (or delete file $base/$Config{pidfile})\n\n";
    }
 }

 # set nonexistent settings to default values
 my %cfgHash = ();
 for my $idx (0...$#ConfigArray) {
  my $c = $ConfigArray[$idx];
  if ($c->[0] && !(exists $Config{$c->[0]})) {
   $Config{$c->[0]}=$c->[4];
   $newConfig{$c->[0]} = 1;
  }
  if ($c->[6] eq 'ConfigChangeRunTaskNow') {
      $RunTaskNow{$c->[0]} = '';
  }
  print "!!!!!!!! duplicate entry for $c->[0] - using last one !!!!!!!!\n" if $c->[0] && exists($cfgHash{$c->[0]});
  $cfgHash{$c->[0]} = 1;
 }
 %cfgHash = ();
 undef %cfgHash;
 my @plcfg = loadPluginCfgBegin();           # load Configuration from Plugins to @ConfigArray
 open my $DEF ,'>>',"$base/language/default_en_msg.txt";
 binmode $DEF;
 print $DEF $UTF8BOM;
 for my $idx (0...$#plcfg) {
    my $c = $plcfg[$idx];
    if ($c->[3] =~ /heading/io) {
         print $DEF '# heading - ' . $c->[4] . "\n\n";
    }
    if ($c->[10] && $c->[10] =~ /msg\d{6}/o) {
        print $DEF '# variable - ' . $c->[0] . "\n";
        print $DEF  $c->[10] . '=' . $c->[1] . "\n";
    }
    if ($c->[11] && $c->[11] =~ /msg\d{6}/o) {
        print $DEF  $c->[11] . '=' . $c->[7] . "\n\n";
    }
    $c->[0] =~ s/\r?\n//go;
    $c->[1] =~ s/\r?\n//go;
    $c->[2] =~ s/\r?\n//go;
    $c->[3] =~ s/\r?\n//go;
    $c->[4] =~ s/\r?\n//go;
    push (@ConfigArray,$c);
    if ($c->[0] && !(exists $Config{$c->[0]})) {
       $Config{$c->[0]}=$c->[4];
    }
 }
 close $DEF;
 unlink("$base/language/default_en_msg_".$version.'_'.$modversion.'.txt');
 rename("$base/language/default_en_msg.txt","$base/language/default_en_msg_".$version.'_'.$modversion.'.txt');
 my %Msg = ();
 local $/ = "\n";
 if (open my $DEF,'<' ,"$base/language/assp.lng") {
     print "\nreading language file language/assp.lng";
     my $msg;
     my $cont;
     while (my $line = (<$DEF>)) {
         $line =~ s/\r//go;
         $line =~ s/\n//go;
         $line =~ s/^$UTF8BOMRE//o;
         next unless $line;
         next if $line =~ /^\s*[#;]/o;
         if ($line =~ /^\s*(msg[^01]\d{5})\s*=\s*(.*)/o) {
             my $l1 = $1;
             my $l2 = $2;
             if ($msg) {
                my $i = 0;
                my %v = ();
                while ($cont =~ s/(\$[a-zA-Z][a-zA-Z0-9_{}\[\]\-\>]+)/\[\%\%\%\%\%\]/o) {
                    my $var = $1;
                    $v{$i} = eval($var);
                    $v{$i} = $var unless defined $v{$i};
                    $i++;
                }
                $i = 0;
                while ($cont =~ s/\[\%\%\%\%\%\]/$v{$i}/o) {$i++;}
                $Msg{$msg} = $cont;
                $cont = '';
             }
             $msg = $l1;
             $cont = $l2."\n";
         } else {
             $cont .= $line."\n";
         }
     }
     $Msg{$msg} = $cont if $msg && $cont;
     close $DEF;
 }

 if (scalar(keys %Msg)) {
     for my $idx (0...$#ConfigArray) {
         my $c = $ConfigArray[$idx];
         $c->[1] = $Msg{$c->[10]} if $c->[10] && exists $Msg{$c->[10]};
         $c->[1] =~ s/\r?\n//go;
         $c->[7] = $Msg{$c->[11]} if $c->[11] && exists $Msg{$c->[11]};
     }
 }
 %Msg = ();
 undef %Msg;
 $Config{TLDS} = 'file:files/tlds-alpha-by-domain.txt';
 $base =~ s/\\/\//go;
 $Config{base} = $base;
 $runHMMusesBDB = $Config{HMMusesBDB};
 &setMakeREVars();
} # end BEGIN

our $mlogQueue = Thread::Queue->new();
our $debugQueue = Thread::Queue->new();
our $cmdQueue = Thread::Queue->new();

# define global vars from %Config
print "\t\t\t[OK]\nloading configuration";
print "\t\t\t\t\t[OK]\n". scalar(keys %Config) . ' values loaded';
print "\t\t\t\t\t[OK]\ndefining environment";

use ASSP_DEF_VARS;
OURVARS
#use AsspSelfLoader;

while (my ($k,$v) = each %Config) {
   $$k = $v;
}

$CreateMIB ||= -e "$base/SNMPmakeMIB.pl";
$enableCrashAnalyzer ||= -e "$base/enableCrashAnalyzer" || -e "$base/enableCrashAnalyzer.txt";

checkINC();
GPBSetup();
setSpecialRegex();
setMainLang();

#$pbblacklock = 1 ;   # serialize DB access to these tables per default
#$pbwhitelock = 1 ;
#$ldaplistlock = 1 ;
$lockDatabases = 1 if $DBdriver =~ /^mysql/oi; # serialize DB write access to all mysql tables per default
$lockDatabases = 1 if $DBCacheMaxAge && $DBCacheSize;

if (-e "$base/lib/CorrectASSPcfg.pm") {
    eval('use CorrectASSPcfg; &CorrectASSPcfg::set();');
    if ($@) {
        mlog(0,"error: calling CorrectASSPcfg.pm returned error - $@") ;
        print "\t\t\t\t\t[failed] in lib/CorrectASSPcfg.pm\ncontinue\t";
    }
}

open my $DEF ,'>>',"$base/language/default_en_msg_".$version.'_'.$modversion.'.txt';
binmode $DEF;
print $DEF "\n\n# *******\n# main text and hint for GUI\n# *******\n\n";
foreach (sort keys %lngmsg) {
   print $DEF "\n$lngmsghint{$_}\n" if exists $lngmsghint{$_};
   print $DEF "$_=$lngmsg{$_}\n";
}
close $DEF;

our $AvailWin32Daemon   :shared = $useWin32Daemon ? eval("use Win32::Daemon; 1") : 0;    # Win32 Daemon module installed
our $CanUseWin32Daemon  :shared = $AvailWin32Daemon;
if( $^O eq 'MSWin32' && $CanUseWin32Daemon) {
 print "\t\t\t\t\t[OK]\nservice check";
 eval(<<'EOT');
 use Win32::Daemon;
 use Win32::Console;

 my $cmdlin = Win32::Console::_GetConsoleTitle () ? 1 : 0;

 if ($cmdlin) {
     $AsAService = 0;
 } else {
 print "\t\t\t[OK]\nregistering as Windows service";
 Win32::Daemon::StartService();

 # Wait until the service manager is ready for us to continue...
 my $i = 0;
 while( SERVICE_START_PENDING != Win32::Daemon::State() && $i < 60) {
  # AZ: 2009-03-10
  # note it would be a good idea adding a timeout here and
  # bombing out in case the SCM isn't responding to avoid
  # looping indefinitely and waiting to start
  sleep( 1 );
  $i++;
 }
 if ($i > 59) {
     writeExceptionLog('unable to register service in SCM - cancel');
     die "unable to register service in SCM - cancel\n";
 }
 Win32::Daemon::State( SERVICE_RUNNING );
 mlog(0,'starting as a service');
 $AsAService = 1;

sub serviceCheck {
 return unless $AsAService;
 d('servicecheck');
 my $state = Win32::Daemon::State();
 my %idlestate = (
     Win32::Daemon::SERVICE_PAUSE_PENDING => defined(*{'yield'}),
     Win32::Daemon::SERVICE_CONTINUE_PENDING => (defined(*{'yield'})-2)
 );
 if( $state == SERVICE_STOP_PENDING ) {
  d('service stopping');
  if ($ServiceStopping == 0) {
    $ServiceStopping = 1;
    mlog(0,'service stopping');
    # AZ: 2009-03-10 - ask SCM for a grace time (2 minutes) to shutdown
    Win32::Daemon::State( SERVICE_STOP_PENDING, 120000 );
    &downASSP('request to stop service');
    $ServiceStopping = 2;
    Win32::Daemon::State( SERVICE_STOPPED );
    Win32::Daemon::StopService();
    # AZ: 2009-03-10 - be nice, tell we stopped
    mlog(0,'service stopped');
    &mlogWrite();
    exit 0;
  } elsif ($ServiceStopping == 1) {
    # keep telling SCM we're stopping and didn't hang
    Win32::Daemon::State( SERVICE_STOP_PENDING, 120000 );
  }
 } elsif ( $state == SERVICE_PAUSE_PENDING ) {
   Win32::Daemon::State( SERVICE_PAUSED );
   $allIdle = $idlestate{$state};
   mlog(0,'pausing service');
 } elsif ( $state == SERVICE_CONTINUE_PENDING ) {
   Win32::Daemon::State( SERVICE_RUNNING );
   $allIdle = $idlestate{$state};
   mlog(0,'continue service');
 } else {
   my $PrevState = SERVICE_RUNNING;
   $PrevState = SERVICE_STOPPED if $ServiceStopping;
   $PrevState = SERVICE_PAUSED if $allIdle > ! defined(*{'yield'});
   Win32::Daemon::State( $PrevState );
 }
}
}

EOT
 if ($@) {
     print STDERR "error: $@\n";
     print "error: $@\n";
     $AsAService = 0;
 }
 mlog(0,'starting in console mode') unless $AsAService;

} else {
     $AsAService = 0;
     mlog(0,'starting in console mode');
     eval(<<'EOT');
sub serviceCheck {}
EOT
}

print "\t\t\t\t\t\t[OK]\nsetting up global ENV";
undef &loadModuleVars;
undef &defConfigArray;
undef &loadPluginCfgBegin;

our $StartTime:shared = time;
our $PerfStartTime:shared = time;
our $starttime : shared = timestring($StartTime);
our $mypid : shared = $$;
our $localhostname : shared = hostname();
our $localhostip : shared;
if ($localhostname) {
    eval {
        $localhostip = inet_ntoa( scalar( gethostbyname($localhostname) ) );
    };
}
mlog(0,"error : unable to resolve IP-address for local hostname <$localhostname> - $@") if $@;

# start of CanUse and Avail definitions
our $CanUseThreadState  :shared;
our $CanUseAvClamd      :shared;
our $AvailAvClamd       :shared;
our $CanUseLDAP         :shared;
our $CanUseDNS          :shared;
our $AvailSPF2          :shared;
our $CanUseSPF2         :shared;
our $AvailSPF           :shared;
our $CanUseSPF          :shared;
our $CanUseURIBL        :shared;
our $CanUseRWL          :shared;
our $CanUseRBL          :shared;
our $AvailSRS           :shared;
our $CanUseSRS          :shared;
our $AvailZlib          :shared;
our $CanUseHTTPCompression :shared;
our $AvailMD5           :shared;
our $CanUseMD5Keys      :shared;
our $AvailSHA1          :shared;
our $CanUseSHA1         :shared;
our $AvailReadBackwards :shared;
our $CanSearchLogs      :shared;
our $AvailHiRes         :shared;
our $CanStatCPU         :shared;
our $AvailIO            :shared;
our $CanChroot          :shared;
our $AvailSyslog        :shared;
our $CanUseSyslog       :shared;
our $AvailWin32Debug    :shared;
our $CanUseWin32Debug   :shared;
our $AvailTieRDBM       :shared;
our $CanUseTieRDBM      :shared;
our $AvailDB_File       :shared;
our $CanUseDB_File      :shared;
our $AvailBerkeleyDB    :shared;
our $CanUseBerkeleyDB   :shared;
our $AvailCIDRlite      :shared;
our $CanUseCIDRlite     :shared;
our $AvailNetIP         :shared;
our $CanUseNetIP        :shared;
our $AvailNetAddrIPLite :shared;
our $CanUseNetAddrIPLite:shared;
our $AvailLWP           :shared;
our $CanUseLWP          :shared;
our $AvailEMM           :shared;
our $CanUseEMM          :shared;
our $AvailMTY           :shared;
our $CanUseMTY          :shared;
our $AvailEMS           :shared;
our $CanUseEMS          :shared;
our $AvailTNEF          :shared;
our $CanUseTNEF         :shared;
our $AvailDKIM          :shared;
our $CanUseDKIM         :shared;
our $AvailNetSMTP       :shared;
our $CanUseNetSMTP      :shared;
our $AvailNetSMTPTLS    :shared;
our $CanUseNetSMTPTLS   :shared;
our $AvailNetSNMPagent  :shared;
our $CanUseNetSNMPagent :shared;
our $AvailSchedCron     :shared;
our $CanUseSchedCron    :shared;
our $AvailSysMemInfo    :shared;
our $CanUseSysMemInfo   :shared;
our $AvailSysCpuAffinity :shared;
our $CanUseSysCpuAffinity :shared;
our $AvailIOSocketSSL   :shared;
our $CanUseIOSocketSSL  :shared;
our $AvailAuthenSASL    :shared;
our $CanUseAuthenSASL   :shared;
our $AvailRegexOptimizer   :shared;
our $CanUseRegexOptimizer  :shared;
our $AvailRegexpOptimizer   :shared;
our $CanUseRegexpOptimizer  :shared;
our $AvailAsspSelfLoader   :shared;
our $CanUseAsspSelfLoader  :shared;
our $AvailIOSocketINET6   :shared;
our $CanUseIOSocketINET6  :shared;
our $SysIOSocketINET6  :shared = -1;
our $AvailASSP_WordStem  :shared;
our $CanUseASSP_WordStem :shared;
our $AvailASSP_FC  :shared;
our $CanUseASSP_FC :shared;
our $AvailASSP_SVG  :shared;
our $CanUseASSP_SVG :shared;
our $AvailWin32Unicode  :shared;
our $CanUseWin32Unicode :shared;
our $AvailUnicodeGCString :shared;
our $CanUseUnicodeGCString :shared;
our $AvailTextUnidecode :shared;
our $CanUseTextUnidecode :shared;
our $AvailCryptGhost :shared;
our $CanUseCryptGhost :shared;

#end of CanUse and Avail modules definitions

if ( $^O eq 'MSWin32' ) {
    my $perl = $perl;
    my $assp = $assp;
    $assp = $base.'\\'.$assp if ($assp !~ /\Q$base\E/io);
    $dftrestartcmd = "cmd.exe /C start \"ASSPSMTP restarted\" \"$perl\" -X \"$assp\" \"$base\"";
} else {
    $dftrestartcmd = "\"$perl\" \"$assp\" \"$base\" \&";
}

# from here sorted by $ % @ alpha  -  #t = initialized by every thread its self
our $ActWebSess;
our $BDBEnvLock:shared;
our $BayesCont = '\S';
#our $BayesCont = '^\p{White_Space}';
our $ConfigChanged:shared;
our $DBOption;
our $DBcntOption:shared ;
our $DBisUsed:shared ;
our $DBusedDriver:shared ;
our $DEBUG;
our $DNSresolver;
our $ExportIsRunning:shared;
our $GriplistDriver;
our $GriplistFile;
our $GriplistLen;
our $GroupsDynamic:shared;
our $IOEngineRun = $IOEngine;
our $LDAPoffline;
our $LOG;
our $LOGBR;
our $MailCount:shared;
our $MailCountTmp:shared;
our $MailProcTime:shared;
our $MailProcTimeTmp:shared;
our $MailTime:shared;
our $MailTimeTmp:shared;
our $MainLoopLastStep:shared;
our $MainLoopStepTime:shared = time;
our $MainLoopStepTime2;
our $MainThreadLoopWait = 1;
our $MinPollTimeT;
our $MySenderBaseCode:shared;
our $NavMenu;
our $NextASSPFileDownload:shared;
our $NextVersionFileDownload:shared;
our $NextBackDNSFileDownload:shared;
our $NextCodeChangeCheck:shared = time + 60;
our $NextConfigReload:shared = 9999999999;
our $NextDroplistDownload:shared;
our $NextGriplistDownload:shared;
our $NextGroupsReload:shared;
our $NextPOP3Collect:shared;
our $NextSaveStats:shared;
our $NextTLDlistDownload:shared;
our $NextSyncConfig:shared;
our $NotifyCount = 1;
our $PersBlackHasRecords:shared = 1;
our $ScheduleIsChanged;
our $SMTPbuf;
our $SMTPmaxbuf;
our $SE_RE;             #t
our $SNMPagent;
our $StartRebuild;
our $ThreadsWakeUpInterval = 127;
our $ThreadsWakeUpCheck = 7;
our $ThreadDebug;
our $ThreadsDoStatus:shared;
our $ThreadMain2Act;
our $TO_RE;             #t
our $TransferCount = 0;
our $TransferTime = 0;
our $TransferInterrupt = 0;
our $TransferInterruptTime = 0;
our $TransferNoInterruptTime = 0;
our $TriedDBFileUse;
our $addCharsets = 0;
our $allowPOP3:shared = 0;
our $asspCFGTime:shared;
our $attachLogNoPL:shared = 1;
our $bayesnorm:shared;
our $bdbcache;
our $blogfile;
our $calledfromThread = 0;
our $canNotify:shared = 0;
our $canSNMPAPI;
our $canUnicode;
our $checkdb;
our $cmdQueueReleased:shared = 0;
our $codeChanged;
our $currentPage;
our $doShutdown:shared;
our $doShutdownForce:shared;
our $endtime;
our $errorFH;
our $footers;
our $haveHMM:shared;
our $haveSpamdb:shared;
our $headerDTDStrict;
our $headerDTDTransitional;
our $headerGlosar;
our $headerHTTP;
our $headers;
our $headerTOC;
our $httpchanged;
our $i_bw_time = 0;
our $i_tw_time = 0;
our $incFound;
our $inSIG = 0;
our $isRunMainLoop2 = 0;
our $isRunTMM2 = 0;
our $itime;
our $kudos;
our $lastDebugPrint;
our $lastRenderedUser;
our $lastMlog;
our $lastmlogWrite;
our $lastREmatch;    # contains the result of the last match in match_RE
our $lastSNMPrequest;
our $lastSNMPAPIresult = '';
our $lastThreadsDoStatus = 0;
our $lastTimeoutCheck;
our $lockBayes:shared = 0;
our $lockHMM:shared = 0;
our $lockSpamfileNames:shared;
our $maillogJump;
our $maxMemUsage:shared = 0;
our $maxOID;
our $minMemUsage:shared = 99999999999;
our $minusIcon;
our $mlogLastT:shared;
our $mobile;
our $nextBDBsync:shared;
our $nextBlockReportSchedule:shared;
our $nextCleanBATVTag:shared;
our $nextCleanCache:shared;
our $nextCleanIPDom:shared;
our $nextCleanDelayDB:shared;
our $nextCleanPB:shared;
our $nextConSync;
our $nextDBBackup:shared;
our $nextDBcheck;
our $nextDNSCheck:shared;
our $nextdetectGhostCon;
our $nextdetectHourJob:shared;
our $nextExport:shared;
our $nextFileAgeSchedule:shared;
our $nextGlobalUploadBlack:shared;
our $nextGlobalUploadWhite:shared;
our $nextHashFileCheck:shared;
our $nextLDAPcrossCheck:shared;
our $nextLoop2;
our $nextMemoryUsageCheckSchedule:shared;
our $nextNewReported = time + [split(/\s+/o,$newReportedInterval)]->[1] * 60;
our $nextOptionCheck:shared;
our $nextQueueSchedule:shared;
our $nextStatsUpload:shared;
our $nextThreadMain2;
our $nextNoop;
our $nextRebuildSpamDB:shared;
our $nextResendMail:shared;
our $nextThreadsWakeUp;
our $noIcon;
our $numcpus;
our $o_EMM_pm = 0;
our $org_Email_MIME_parts_multipart;
our $orgNewDNSResolver = sub {};
our $pbdir;
our $plusIcon;
our $pollwait;
our $reachedSMTPlimit:shared;
our $readable;
our $refreshWait;             #t
#our $regexMod = $enableStrongRegexOptimization ? 'i-optimsx' : 'i';
our $regexMod = 'i';
our $rootlogin;
our $saveWhite;
our $shuttingDown:shared;
our $smtpConcurrentSessions:shared; #is locked
our $spamSubjectEnc;
our $spffallback:shared;   # lower case var to config var $SPFfallback
our $spfoverride:shared;   # lower case var to config var $SPFoverride
our $switchedUser;
our $syncWriteConfigLock:shared;
our $syslogNextTry;
our $thread_nolog;
our $tqueue;
our $trqueue;
our $usedCrypt:shared;
our $willSIG:shared;
our $writable;
our %AllScoreStats:shared ;
our %AllStats:shared ;
our %AttachRules;
our %AttachZipRules;
our %AvailPerlModules;
our %BerkeleyDBHashes;
our %ComWorker:shared;
our %Con; keys %Con = 64;
our %ConDelete; keys %ConDelete = 64;
our %ConfigPos; keys %ConfigPos = 1024;
our %ConfigNum:shared; keys %ConfigPos = 1024;
our %ConfigNice; keys %ConfigNice = 1024;
our %ConfigDefault; keys %ConfigDefault = 1024;
our %ConfigListBox; keys %ConfigListBox = 128;
our %ConfigListBoxAll; keys %ConfigListBoxAll = 128;
our %ConFno:shared; keys %ConFno = 128;
our %CrFn2Remove:shared;
our %CryptFile;
our %DKIMInfo;
our %DNSRespDist;
our %DNSresolverTime:shared;
our %DomainVRFYMTA:shared;
our %EmailAdminDomains;
our %FileHashUpdateHash:shared; keys %FileHashUpdateHash = 32;
our %FileHashUpdateTime:shared; keys %FileHashUpdateTime = 32;
our %Fileno; keys %Fileno = 128;
our %FileUpdate; keys %FileUpdate = 32;
our %FileIncUpdate;  keys %FileIncUpdate = 32;
our %FileNoSync:shared; keys %FileNoSync = 32;
our %FlatVRFYMTA;
our %GriplistDriverOptions;
our %LastSchedRun:shared;
our %MainLoopInWebFH;
our %ManageActions;
our %ManageAdminUser;
our %ManagePerm;
our %ModuleError; keys %ModuleError = 128;
our %ModuleList; keys %ModuleList = 128;
our %ModuleStat; keys %ModuleStat = 128;
our %MEXH;
our %MRSadr;
our %MRSEadr;
our %MSadr;
our %MSEadr;
our %NotifyRE;
our %NotifySub;
our %NotifyLastFreq;
our %OldScoreStats:shared;
our %OldStats:shared;
our %Proxy;
our %ProxySocket;
our %RecRepRegex:shared;
our %RegexError;
our %ReportFiles;
our %ReportTypes;
our %ResendFile;
our %ScheduledTask:shared;
our %ScheduleMap:shared;
our %ScoreStatText;
our %SLscore;
our %SMTPSession; keys %SMTPSession = 128;
our %SNMPag;
our %SNMPAS;
our %SocketCalls; keys %SocketCalls = 128;       #t
our %SocketCallsNewCon;        #t
our $SysLogObj;
our %StatCon;
our %StatConH;
our %StatText;
our %Threads;
our %ThreadHandler;
our %ThreadIdleTime:shared;
our %ThreadQueue;
our %URIBLweight;
our %URIBLaddWeight;
our %WebCon;
our %WebConH;
our %WebIP;
our %WorkerLastAct :shared; # is locked
our %availOptRE:shared;
our %calist:shared;
our %ccdlist;
our %cmdQParm:shared;
our %crtable;
our %currentDBVersion:shared;
our %dampedFH; keys %dampedFH = 128;
our %failedFH; keys %failedFH = 128;
our %failedTable; keys %failedTable = 32;
our %glosarIndex;
our %head;
our %inchrset:shared ;
our %lastd:shared;
our %lastsigoff:shared;
our %lastsigon:shared;
our %localFrequencyNotify:shared;
our %localTLSfailed:shared;
our %newReported:shared;
our %outchrset:shared ;
our %registeredSchedules;
our %repollFH;
our %runOnMaillogClose:shared;
our %qs; keys %qs = 1024;
our %rblweight;
our %seenReportIncludes;
our %statRequests;
our %subOID; keys %subOID = ($enableCFGShare?3840:2816);
our %subOIDn; keys %subOIDn = ($enableCFGShare?3840:2816);
our %subOID2Conf; keys %subOID2Conf = 1100;
our %subOIDLastLoad;
our %tThreadHandler;
our %webRequests;
our @AdminGroup;
our @changedConfig:shared;
our @currentCpuAffinity;
our @DBdriverdef:shared;
our @DBdriverNames ;
our @GroupList:shared;
our @LDAPGroup:shared;
our @PersBlackGroup:shared;
our @TLStoProxyI;
our @PossibleOptionFiles;
our @RealTimeLog;
our @StatSocket;
our @WebSocket;
our @backsctrlist:shared;
our @badattachRE;        #t
our @batv_secrets;
our @delayGroup:shared;
our @logCount:shared; # is locked
our @logFreq:shared;
our @lsn;
our @lsnI:shared;
our @lsn2;
our @lsn2I:shared;
our @lsnNoAUTH;
our @lsnNoTLSI;
our @lsnSSL;
our @lsnSSLI:shared;
our @lsnRelay;
our @lsnRelayI:shared;
our @msgid_secrets;
our @mlogS;
our @nameservers:shared ;
our @pbdbGroup:shared;
our @rbllist;
our @redlistGroup:shared;
our @rwllist;
our @spamdbGroup:shared;
our @sortedOIDs;
our @uribllist;
our @whitelistGroup:shared;
our @HmmBayWords;
our @WhitelistResult;

# Weighted Regexes

our $weightMatch;

our $bombReWLw;
our $bombReNPw;
our $bombReLocalw;
our $bombReISPIPw;
our $DoReversedWLw;
our $DoReversedNPw;
our $DoHeloWLw;
our $DoHeloNPw;

# end our global vars
our $setpro = 1;
#

$ScheduleMap{'backupDBInterval'}       = &share([]); @{$ScheduleMap{'backupDBInterval'}}       = (3600,'nextDBBackup');
$ScheduleMap{'BlockReportSchedule'}    = &share([]); @{$ScheduleMap{'BlockReportSchedule'}}    = (24 * 3600,'nextBlockReportSchedule');
$ScheduleMap{'CleanCacheEvery'}        = &share([]); @{$ScheduleMap{'CleanCacheEvery'}}        = (3600,'nextCleanCache');
$ScheduleMap{'CleanDelayDBInterval'}   = &share([]); @{$ScheduleMap{'CleanDelayDBInterval'}}   = (   1,'nextCleanDelayDB');
$ScheduleMap{'CleanPBInterval'}        = &share([]); @{$ScheduleMap{'CleanPBInterval'}}        = (3600,'nextCleanPB');
$ScheduleMap{'exportInterval'}         = &share([]); @{$ScheduleMap{'exportInterval'}}         = (3600,'nextExport');
$ScheduleMap{'GroupsReloadEvery'}      = &share([]); @{$ScheduleMap{'GroupsReloadEvery'}}      = (  60,'NextGroupsReload');
$ScheduleMap{'LDAPcrossCheckInterval'} = &share([]); @{$ScheduleMap{'LDAPcrossCheckInterval'}} = (3600,'nextLDAPcrossCheck');
$ScheduleMap{'MaxFileAgeSchedule'}     = &share([]); @{$ScheduleMap{'MaxFileAgeSchedule'}}     = (24 * 3600,'nextFileAgeSchedule');
$ScheduleMap{'POP3Interval'}           = &share([]); @{$ScheduleMap{'POP3Interval'}}           = (  60,'NextPOP3Collect');
$ScheduleMap{'QueueSchedule'}          = &share([]); @{$ScheduleMap{'QueueSchedule'}}          = (24 * 3600,'nextQueueSchedule');
$ScheduleMap{'ReloadOptionFiles'}      = &share([]); @{$ScheduleMap{'ReloadOptionFiles'}}      = (   1,'nextOptionCheck',1,'nextHashFileCheck');
$ScheduleMap{'SaveStatsEvery'}         = &share([]); @{$ScheduleMap{'SaveStatsEvery'}}         = (  60,'NextSaveStats');
$ScheduleMap{'UpdateWhitelist'}        = &share([]); @{$ScheduleMap{'UpdateWhitelist'}}        = (   1,'saveWhite');
$ScheduleMap{'MemoryUsageCheckSchedule'} = &share([]); @{$ScheduleMap{'MemoryUsageCheckSchedule'}} = (   1,'nextMemoryUsageCheckSchedule');

%ReportFiles = (
    'EmailSpam' => 'reports/spamreport.txt',
    'EmailHam' => 'reports/notspamreport.txt',
    'EmailWhitelistAdd' => 'reports/whitereport.txt',
    'EmailWhitelistRemove' => 'reports/whiteremovereport.txt',
    'EmailRedlistAdd' => 'reports/redreport.txt',
    'EmailRedlistRemove' => 'reports/redremovereport.txt',
    'EmailHelp' => 'reports/helpreport.txt',
    'EmailAnalyze' => 'reports/analyzereport.txt',
    'EmailSpamLoverAdd' => 'reports/slreport.txt',
    'EmailSpamLoverRemove' => 'reports/slremovereport.txt',
    'EmailNoProcessingAdd' => 'reports/npreport.txt',
    'EmailNoProcessingRemove' => 'reports/npremovereport.txt',
    'EmailBlackAdd' => 'reports/blackreport.txt',
    'EmailBlackRemove' => 'reports/blackremovereport.txt',
    'EmailPersBlackAdd' => 'reports/persblackreport.txt',
    'EmailPersBlackRemove' => 'reports/persblackremovereport.txt',
    'EmailVirusReportsToRCPT' => 'reports/virusreport.txt',
    'EmailSenderNotOK' => 'reports/denied.txt'
);

%ReportTypes = (
    'EmailSpam' => 0,
    'EmailHam' => 1,
    'EmailWhitelistAdd' => 2,
    'EmailWhitelistRemove' => 3,
    'EmailRedlistAdd' => 4,
    'EmailRedlistRemove' => 5,
    'EmailHelp' => 7,
    'EmailAnalyze' => 8,
    'EmailSpamLoverAdd' => 10,
    'EmailSpamLoverRemove' => 11,
    'EmailNoProcessingAdd' => 12,
    'EmailNoProcessingRemove' => 13,
    'EmailBlackAdd' => 14,
    'EmailBlackRemove' => 15,
    'EmailPersBlackAdd' => 16,
    'EmailPersBlackRemove' => 17,
);

%URIBLaddWeight = (

    'obfuscatedip'     => 0.99,
    'obfuscateduri'    => 0.99,
    'maximumuniqueuri' => 0.94,
    'maximumuri'       => 0.95

);

%webRequests=(
    '/lists' => \&ConfigLists,
    '/recprepl' => \&CheckRcptRepl,
    '/maillog' => \&ConfigMaillog,
    '/analyze' => \&ConfigAnalyze,
    '/infostats' => \&ConfigStats,
    '/edit' => \&ConfigEdit,
    '/shutdown' => \&Shutdown,
    '/shutdown_frame' => \&ShutdownFrame,
    '/shutdown_list' => \&ShutdownList,
    '/donations' => \&Donations,
    '/get' => \&GetFile,
    '/top10stats' => \&top10stats,
    '/pwd' => \&ChangeMyPassword,
    '/adminusers' => \&ManageAdminUsers,
    '/statusassp' => \&StatusASSP,
    '/remember' => \&remember,
    '/syncedit' => \&syncedit,
    '/addraction' => \&ConfigAddrAction,
    '/ipaction' => \&ConfigIPAction,
    '/statgraph' => \&ConfigStatsPlot,
    '/fc' => \&ConfigFC
);

 $WorkerName = 'startup';
 $logfile = $Config{logfile};     # set the log parms to preenable logging
 $asspLog = $Config{asspLog};
 $WorkerLogging = $Config{WorkerLogging};
 $sysLog = $Config{sysLog};
 $SysLogFac = $Config{SysLogFac};
 $sysLogPort = $Config{sysLogPort};
 $sysLogIp = $Config{sysLogIp};
 $globalClientName = $Config{globalClientName};
 $globalClientPass = $Config{globalClientPass};

 &defineCanUseModules();

 print "\t\t\t[OK]\nsetup regular expressions";
 &setMakeREVars();
 my $p;
 $p = '-professional' if ($setpro && $globalClientName && $globalClientPass);
 mlog(0,"ASSP$p version $version$modversion (Perl $]) (on $^O) initializing ");

 print "\t\t\t\t[OK]\nloading plugins";
 loadPluginConfig();           # load Configuration from Plugins to @ConfigArray

 print "\t\t\t\t\t\t[OK]\nfixing up config";
 syncLoadConfigFile();
 fixConfigSettings();

 mlog(0,"info: an ASSP restart will be done with: $AutoRestartCmd") if $MaintenanceLog;
 PrintConfigSettings() if ! SaveConfigSettings();
 chmod 0666, "$base/assp.cfg";

# Notes on general operation & program structure
# I'm using IO::Poll or IO::Select, so don't make any changes that block for long
# as new connections come we create a pair of entries in a hash %Con
# based on the hash of the filehandle, so $Con{$fh} has data for this
# connection. $Con{$fh}->{friend} is the partner socket for the smtp proxy.
# ->{ip} is the ip address of the connecting client
# ->{relayok} tells if we can relay mail for this client
# ->{getline} is a pointer to a function that should be called whan a line of input is received for this filehandle
# ->{mailfrom} is the envelope sender (MAIL FROM: <address>)
# ->{outgoing} is a buffer for outgoing socket traffic (see $writable & &sendque)
# ->{rcpt} are the addresses from RCPT TO: <address> (space separated)
# ->{header} is where the complete mail data are stored
# ->{myheader} is where we store our header, we merge it with client's header later
# ->{maillog} if present stream logging is enabled
# ->{maillogbuf} buffer for storing unwritten stream log while waiting for isspam decision
# ->{maillogfh} is the filehandle for logging lines to the maillog
# ->{mailloglength} is the length logged so far (we stop after 10000 bytes)
# ->{spamfound} is a flag used to signal if an email is determined to be spam.
# ->{maillength} is the same as mailloglength but is not reset.
#
# After connection the {getline} field functions like a state machine
# redirecting input to subsequent handlers
#
# whitebody -> getline
#   getbody ->
#     error -> (disconnects)
#     getline -> getheader ->
#       whitebody -> getline
#         error -> (disconnects)
#
# getline looks for MAIL FROM, RCPT TO, RSET
# getheader looks for a blank line then tests for whitelist / spamaddresses
# getbody looks for the . and calls isspam, the Bayesian spam test
# whitebody waits for . and redirects client to server
# error waits for . ignoring data from client (and finishes the maillog)
#
# the server has states like this:
#
# skipok -> reply
#
# skipok traps the 250 ok response from the NOOP Connection from
# reply echos server messages to the client
# reply also looks for a 235 AUTH OK and sets {relayok}=1

if($AsADaemon) {
 print "\nstarting as daemon\t\t\t[OK]\n";
 fork() && exit 0;
 print "forked a new silent process\t\t[OK]\n";
 close STDOUT;
 close STDERR;
 $silent=1;
}

if($AsAService)
{
 close STDOUT;
 close STDERR;
 $silent=1;
}

my $logdir;
$logdir = $1 if $logfile=~/(.*)\/[^\/]*/o;
-d "$base/$logdir" or mkdir "$base/$logdir",0755 if $logdir;

&init();

&sigCentralSet();
$SIG{INT}=sub {mlog(0,'sig INT'); &downASSP('got SIG INT'); exit 1;};
$SIG{TERM}=sub {mlog(0,'sig TERM'); &downASSP('got SIG TERM'); exit 1;};
$SIG{HUP}=sub {mlog(0,'sig HUP'); &reloadConfigFile();};
$SIG{USR1}=sub {mlog(0,'sig USR1'); &saveSMTPconnections();} if exists $SIG{USR1};
$SIG{USR2}=sub {mlog(0,'sig USR2'); &SaveConfigSettingsForce();} if exists $SIG{USR2};
$SIG{NUM07}=sub {$allIdle -= 2 if $allIdle == defined *{'yield'};$allIdle += defined *{'yield'} if $allIdle == 0; mlog(0,($allIdle > 0 ? 'assp suspened' : 'assp resumed'));} if exists $SIG{NUM07};
$SIG{PIPE} = 'IGNORE';
#foreach my $k (sort keys %SIG) {
#    mlog(0,"SIG $k = $SIG{$k}");
#}
&niceConfigPos();
&renderConfigHTML();
$lastTimeoutCheck = time;
eval {
 $WorkerName = 'Main_Thread';
 unloadMainThreadModules() if $undefMEM;
 &ThreadMonitorMainLoop('MainLoop initialized');
 $ComWorker{main} = 1;
 mlog(0,'MainThread started');
 $PerfStartTime = time;
 $syncToDo = 1;
 while(1) {
  my $t = &MainLoop(1);
 }
};
if ($@) {
 my $exmsg = "main exception: $@\n";
 writeExceptionLog("$exmsg");
 print $LOG "$exmsg\n" if fileno($LOG);
 &downASSP('try restarting ASSP on exception');
 &_assp_try_restart;
}

# END_OF_MAIN_CODE
# there is no main code behind here - subs and packages only

#####################################################################################
# the rebuild spamdb module
#####################################################################################

sub write_rebuild_module {
my $curr_version = shift;

my $rb_version = '6.31';
my $keepVersion;

if (open my $ADV, '<',"$base/lib/rebuildspamdb.pm") {
    while (<$ADV>) {
        if (/^\s*our \$VERSION.+?(\d\.\d+)/o) {
            $curr_version = $1;
            $ComWorker{$WorkerNumber}->{rb_version} = $1;
            last;
        }
        $keepVersion = 1 if /keepVersion/o;
    }
    close $ADV;
    mlog(0,"info: found module $base/lib/rebuildspamdb.pm version $curr_version");
}

if ($keepVersion) {
    mlog(0,"info: the current $base/lib/rebuildspamdb.pm contains a 'keepVersion' line - this file will be keeped");
    return 1;
}

if ($curr_version gt $rb_version && ! $forceRebuildDowngrade) {
    mlog(0,"warning: keeping module $base/lib/rebuildspamdb.pm at version $curr_version (version $rb_version should be used), because 'forceRebuildDowngrade is 0'");
    return 1;
} elsif ($curr_version gt $rb_version && $forceRebuildDowngrade) {
    mlog(0,"info: downgrading module $base/lib/rebuildspamdb.pm from version $curr_version to version $rb_version, because 'forceRebuildDowngrade is 1'");
} elsif ($curr_version lt $rb_version) {
    mlog(0,"info: upgrading module $base/lib/rebuildspamdb.pm from version $curr_version to version $rb_version");
}

(open my $ADV, '>',"$base/lib/rebuildspamdb.pm") or return 0;
#print $ADV <<'RBEOT' or return 0;
#####################################################################################
#

#package rebuildspamdb; # RBEOT;

#RBEOT

print $ADV 'our $VERSION = ',"'$rb_version';\n\n";

#print $ADV <<'RBEOT';
rb_mlog("info: rebuildspamdb module version ".${'VERSION'}." loaded");

# rebuildspamdb version 2
# rebuilds bayesian spam and HMM database
# (c) John Hanna 2003 under the terms of the GPL
# Updated July 2004 for simple proxy support.
# (c) Fritz Borgstedt 2006 under the terms of the GPL
# Updated Feb 2008 refactoring and rewrites
# (c) Kevin 2008 under the terms of the GPL
# Updated Jul 2008 refactoring and rewrites to build in as package in ASSP
# and integrated move2num
# (c) Thomas Eckardt since 2008 under the terms of the GPL

use strict qw(vars subs);
use Digest::MD5 qw(md5_hex);
use File::Copy;
use IO::Handle;
use IO::Socket();
use Encode;
no warnings;

our $RebuildLog;
our $RebuildDebug;
our $norm;
our $starttime;
our $processTime;
our $processedBytes;
our $scanTime;
our $scanFiles;
our %spam; keys %spam = $main::MaxFiles * 20;
our %newspam; keys %newspam = $main::MaxFiles * 20;
our %Helo; keys %Helo = $main::MaxFiles;
our %HamHash; keys %HamHash = $main::MaxFiles;
our %SpamHash; keys %SpamHash = $main::MaxFiles;
our %HMMres;
our %GpCnt;
our %GpOK;
our %Trashlist;
our $spamObj;
our $newspamObj;
our $HeloObj;
our $HamHashObj;
our $HMMresObj;
our $SpamHashObj;
our $GpCntObj;
our $GpOKObj;
our $TrashlistObj;
our $SpamWordCount;
our $HamWordCount;
our $Iam;
our $BDBEnv;
our $DBDir;
our $WhiteCount;
our $RedCount;
our $onlyNewCorrected;
our $IPRe = $main::IPRe;
our $spamHMM;
our $hamHMM;
our $DoHMM;
our $attachments;
our $rtText;
our $mintime;
our $movetime;
our $doattach;


sub rb_run {         ## no critic
$onlyNewCorrected = shift;

$SpamWordCount = 0;
$HamWordCount = 0;
$processedBytes = 0;
$starttime = 0;
$processTime = 0;
$processedBytes = 0;
$scanTime = 0;
$scanFiles = 0;

$WhiteCount = 0;
$RedCount = 0;
$attachments = 0;

$DoHMM = $main::DoHMM;
$doattach = 0;
$doattach = 1 if    $main::Config{ASSP_AFCDetectSpamAttachRe}
                 && $main::ASSP_AFCDetectSpamAttachReRE !~ $main::neverMatchRE;
($mintime,$movetime) = split(/(?:\s+|,)/o,$main::RebuildFileTimeLimit,2);
$mintime =~ s/\s//go;
$movetime =~ s/\s//go;
$mintime ||= 0;
$movetime ||= 0;

$RebuildDebug = -e "$main::base/rebuilddebug.txt";
$RebuildDebug = 0 if $onlyNewCorrected;
if ($RebuildDebug) {
    open($RebuildDebug ,'>',  "$main::base/rebuilddebug.txt" );
    binmode $RebuildDebug;
    $RebuildDebug->autoflush;
    rb_mlog("rebuild debug output is enabled to $main::base/rebuilddebug.txt");
}

eval (<<'EOT') if ($main::CanUseASSP_WordStem);
    use ASSP_WordStem();
EOT

    my @dbhint;
    if ($main::canUnicode && $^O eq 'MSwin32') {require Win32::Unicode;}
    $DBDir = "$main::base/tmpDB/rebuildDB";
    $Iam = $main::WorkerNumber;
    -d $DBDir or mkdir $DBDir,0755;

    if ($main::CanUseBerkeleyDB && $main::useDB4Rebuild) {
        eval('use BerkeleyDB;');
        if ($main::VerBerkeley lt '0.42') {
            *{'BerkeleyDB::_tiedHash::CLEAR'} = *{'main::BDB_CLEAR'};
        }
        my $cachesize = $DoHMM ? 41943040 : 20971520;
        rb_mlog("RebuildSpamDB uses BerkeleyDB for temporary hashes");
eval (<<'EOT');
            $BDBEnv = BerkeleyDB::Env->new(-Flags => DB_CREATE | DB_INIT_MPOOL,
                                           -Cachesize => $cachesize ,
                                           -Home => "$DBDir",
                                           -Config => {DB_DATA_DIR => "$DBDir",
                                                       DB_LOG_DIR  => "$DBDir",
                                                       DB_TMP_DIR  => "$DBDir"}
                                          );

            $spamObj=tie %spam,'BerkeleyDB::Hash',
                                     (-Filename => "$DBDir/rb_spam.bdb" ,
                                      -Flags => DB_CREATE,
                                      -Env => $BDBEnv);
            rb_BDB_getRecordCount('spam');

            $newspamObj=tie %newspam,'BerkeleyDB::Hash',
                                     (-Filename => "$DBDir/rb_newspam.bdb" ,
                                      -Flags => DB_CREATE,
                                      -Env => $BDBEnv);
            rb_BDB_getRecordCount('newspam');

            $HeloObj=tie %Helo,'BerkeleyDB::Hash',
                                     (-Filename => "$DBDir/rb_Helo.bdb" ,
                                      -Flags => DB_CREATE,
                                      -Env => $BDBEnv);
            rb_BDB_getRecordCount('Helo');

            $HamHashObj=tie %HamHash,'BerkeleyDB::Hash',
                                     (-Filename => "$DBDir/rb_HamHash.bdb" ,
                                      -Flags => DB_CREATE,
                                      -Env => $BDBEnv);
            rb_BDB_getRecordCount('HamHash');

            $SpamHashObj=tie %SpamHash,'BerkeleyDB::Hash',
                                     (-Filename => "$DBDir/rb_SpamHash.bdb" ,
                                      -Flags => DB_CREATE,
                                      -Env => $BDBEnv);
            rb_BDB_getRecordCount('SpamHash');

            $GpCntObj=tie %GpCnt,'BerkeleyDB::Hash',
                                     (-Filename => "$DBDir/rb_GpCnt.bdb" ,
                                      -Flags => DB_CREATE,
                                      -Env => $BDBEnv);
            rb_BDB_getRecordCount('GpCnt');

            $GpOKObj=tie %GpOK,'BerkeleyDB::Hash',
                                     (-Filename => "$DBDir/rb_GpOK.bdb" ,
                                      -Flags => DB_CREATE,
                                      -Env => $BDBEnv);
            rb_BDB_getRecordCount('GpOK');

            $TrashlistObj=tie %Trashlist,'BerkeleyDB::Hash',
                                     (-Filename => "$DBDir/trashlist.bdb" ,
                                      -Flags => DB_CREATE,
                                      -Env => $BDBEnv);
            rb_BDB_getRecordCount('Trashlist') == 0 && rb_Load_Trashlist();

            $HMMresObj=tie %HMMres,'BerkeleyDB::Hash',
                                     (-Filename => "$DBDir/rb_HMMres.bdb" ,
                                      -Flags => DB_CREATE,
                                      -Env => $BDBEnv);
            rb_BDB_getRecordCount('HMMres');
EOT
            rb_mlog("BerkeleyDB-ERROR: $@ - BDB:$BerkeleyDB::Error") if $@ or $BerkeleyDB::Error !~ /: 0\s*$/o;
    } elsif ($main::CanUseDB_File && $main::useDB4Rebuild) {
        eval('use DB_File;');
        rb_mlog("RebuildSpamDB uses DB_File for temporary hashes");
eval (<<'EOT');
        $spamObj = tie %spam, 'DB_File', "$DBDir/rb_spam.bdb";
        $newspamObj = tie %newspam, 'DB_File', "$DBDir/rb_newspam.bdb";
        $HeloObj = tie %Helo, 'DB_File', "$DBDir/rb_Helo.bdb";
        $HamHashObj = tie %HamHash, 'DB_File', "$DBDir/rb_HamHash.bdb";
        $SpamHashObj = tie %SpamHash, 'DB_File', "$DBDir/rb_SpamHash.bdb";
        $GpCntObj = tie %GpCnt, 'DB_File', "$DBDir/rb_GpCnt.bdb";
        $GpOKObj = tie %GpOK, 'DB_File', "$DBDir/rb_GpOK.bdb";
        $TrashlistObj = tie %Trashlist,'DB_File', "$DBDir/trashlist.bdb";
        scalar(keys %Trashlist) == 0 && rb_Load_Trashlist();
EOT
        rb_mlog("DB_File-ERROR: $@") if $@;
    } elsif ($main::useDB4Rebuild) {
        rb_mlog("RebuildSpamDB uses the internal 'orderedtie' for temporary hashes");
        push @dbhint , "warning: 'useDB4Rebuild' is set to on, but 'BerkeleyDB' nor 'DB_File' are available - the rebuild spamdb process uses the internal 'orderedtie' and will possibly require more time and a large amount of memory - check 'OrderedTieHashTableSize'!";
eval (<<'EOT');
        $spamObj = tie %spam, 'orderedtie', "$DBDir/rb_spam.bdb";
        $newspamObj = tie %newspam, 'orderedtie', "$DBDir/rb_newspam.bdb";
        $HeloObj = tie %Helo, 'orderedtie', "$DBDir/rb_Helo.bdb";
        $HamHashObj = tie %HamHash, 'orderedtie', "$DBDir/rb_HamHash.bdb";
        $SpamHashObj = tie %SpamHash, 'orderedtie', "$DBDir/rb_SpamHash.bdb";
        $GpCntObj = tie %GpCnt, 'orderedtie', "$DBDir/rb_GpCnt.bdb";
        $GpOKObj = tie %GpOK, 'orderedtie', "$DBDir/rb_GpOK.bdb";
        $TrashlistObj = tie %Trashlist,'orderedtie', "$DBDir/trashlist.bdb";
EOT
        rb_mlog("DB_File-ERROR: $@") if $@;
    } else {
        $TrashlistObj = tie %Trashlist,'orderedtie', "$main::base/trashlist.db";
        push @dbhint , "warning: 'useDB4Rebuild' is NOT set to on - the rebuild spamdb process will possibly require a very large amount of memory - but it will run very fast!";
    }

    if ($DoHMM && $main::CanUseBerkeleyDB && $main::useDB4Rebuild) {
        if (! $onlyNewCorrected) {
            unlink "$DBDir/rbtmp.hamHMM.bdb";
            unlink "$DBDir/rbtmp.spamHMM.bdb";
            unlink "$DBDir/rbtmp.hamHMM.totals.bdb";
            unlink "$DBDir/rbtmp.spamHMM.totals.bdb";
        }
        if ($onlyNewCorrected ||
           (   ! $onlyNewCorrected
            && ! -e "$DBDir/rbtmp.hamHMM.bdb"
            && ! -e "$DBDir/rbtmp.spamHMM.bdb"
            && ! -e "$DBDir/rbtmp.hamHMM.totals.bdb"
            && ! -e "$DBDir/rbtmp.spamHMM.totals.bdb"))
        {
        $@ = '';
        eval (<<'EOT');
            $hamHMM  = ASSP::MarkovChain->new(longest => $main::HMMSequenceLength,
                                              shortest => $main::HMMSequenceLength,
                                              top => 1,
                                              nostarts => 1,
                                              BDB => {-Filename => "$DBDir/rbtmp.hamHMM" ,
                                                      -Flags => DB_CREATE
                                                      -Env => $BDBEnv}
                                              );
            $spamHMM = ASSP::MarkovChain->new(longest => $main::HMMSequenceLength,
                                              shortest => $main::HMMSequenceLength,
                                              top => 1,
                                              nostarts => 1,
                                              BDB => {-Filename => "$DBDir/rbtmp.spamHMM" ,
                                                      -Flags => DB_CREATE
                                                      -Env => $BDBEnv}
                                              ) if ref $hamHMM;
EOT
            unless (ref $hamHMM && ref $spamHMM) {
                my $error;
                $error =  " - e: $@" if $@;
                $error .= " - h: $hamHMM" if $hamHMM && ! ref $hamHMM;
                $error .= " - s: $spamHMM" if $spamHMM && ! ref $spamHMM;
                push @dbhint , "error: can't create HMM because of BDB database errors ($DBDir) - $error";
                $DoHMM = 0 ;
                $hamHMM = undef;
                $spamHMM = undef;
            }
        } else {
            push @dbhint , "error: can't cleanup at least one old temporary BDB file used for HMM in $DBDir/ 'rbtmp.hamHMM.bdb , rbtmp.spamHMM.bdb , rbtmp.hamHMM.totals.bdb, rbtmp.spamHMM.totals.bdb'";
        }
        unless (ref $hamHMM && ref $spamHMM) {
            $DoHMM = 0 ;
            $hamHMM = undef;
            $spamHMM = undef;
        }
    } else {
        if ($DoHMM) {
            push @dbhint , "error: can't create HMM because the BerkeleyDB module is not available" unless $main::CanUseBerkeleyDB;
            push @dbhint , "error: can't create HMM because 'useDB4Rebuild' is not enabled" unless $main::useDB4Rebuild;
        }
        $DoHMM = 0;
    }

    # reset counts and global vars
    $HamWordCount = $SpamWordCount = my $correctedspamcount = 0;
    my $correctednotspamcount = my $spamlogcount  = my $notspamlogcount = 0;
    my $rebuildrun = &rb_fixPath($main::base) . "/rebuildrun.txt";

    $RebuildLog = $norm = $starttime = $processTime = '';

    if ($onlyNewCorrected) {         # only still new reported
        my ($havenormfile,$SwordsPfile, $HwordsPfile);
        if (open( my $normFile, '<', "$main::base/normfile" )) {
            binmode $normFile;
            ($norm, $correctedspamcount, $correctednotspamcount, $spamlogcount, $notspamlogcount,
             $SwordsPfile, $HwordsPfile, $SpamWordCount, $HamWordCount) = split(/\s+/o, join('',<$normFile>));
            $havenormfile = $SpamWordCount > 0 || $HamWordCount > 0;
            close $normFile;
        }
        $norm ||= $main::bayesnorm || $main::Spamdb{'***bayesnorm***'};
        $norm ||= $main::HMMdb{'***bayesnorm***'} if $DoHMM;
        $norm ||= 1;
        my $oldnorm = $norm;

        rb_processNewCorrected();

        if ($havenormfile) {
            $main::bayesnorm = $main::Spamdb{'***bayesnorm***'} = $norm = $HamWordCount ? ( $SpamWordCount / $HamWordCount ) : 100;
            $main::HMMdb{'***bayesnorm***'} = $norm if $DoHMM;
            &rb_mlog("info: the corpus norm is changed from: $oldnorm - to: $norm") if $oldnorm != $norm;
            (open( my $normFile, '>', "$main::base/normfile" ));
            if ($normFile) {
                print { $normFile } "$norm $correctedspamcount $correctednotspamcount $spamlogcount $notspamlogcount $SwordsPfile $HwordsPfile $SpamWordCount $HamWordCount";
                eval{close $normFile;};
            }
        }
    } else {                         # the normal rebuild

    %spam = ();
    %newspam = ();
    %Helo = ();
    %HamHash = ();
    %SpamHash = ();
    %GpCnt = ();
    %GpOK = ();
    %HMMres = ();

    # open log file
    if ( -e "$rebuildrun.bak" ) {
        unlink("$rebuildrun.bak") or die "unable to remove file: $!";
    }
    if ( -e $rebuildrun ) {
        copy( $rebuildrun, "$rebuildrun.bak" ) or die "unable to copy file for: $!";
    }
    (open( $RebuildLog, '>', "$rebuildrun" )) or die "unable to open file for logging: $!";
    binmode $RebuildLog;
    $RebuildLog->autoflush;
    $starttime = time;
    &rb_printlog( "\n\n\nRebuildSpamDB-thread rebuildspamdb-version ".${'VERSION'}." started in ASSP version $main::version$main::modversion\n" );
    &rb_mlog( "RebuildSpamDB-thread rebuildspamdb-version ".${'VERSION'}." started in ASSP version $main::version$main::modversion");
    while (@dbhint) {
        my $t = shift @dbhint;
        &rb_printlog( "\n$t\n" );
        &rb_mlog( $t );
    }
    if ($main::RebuildTestMode) {
        &rb_printlog( "\n***** RebuildSpamDB is running in TEST MODE *****\n" );
        &rb_mlog( "***** RebuildSpamDB is running in TEST MODE *****" );
    }
    if ($DoHMM) {
        &rb_printlog( "\nRebuildSpamDB will create a Hidden Markov Model!\n" );
        &rb_mlog( "RebuildSpamDB will create a Hidden Markov Model!" );
    } else {
        &rb_printlog( "\nRebuildSpamDB will NOT create a Hidden Markov Model!\n" );
        &rb_mlog( "RebuildSpamDB will NOT create a Hidden Markov Model!" );
    }
    if ($doattach) {
        &rb_printlog( "\nRebuildSpamDB will include attachment-database-entries in to spamdb!\n" );
        &rb_mlog( "RebuildSpamDB will include attachment-database-entries in to spamdb!" );
    }
    if ($main::canUnicode) {
        &rb_printlog( "\nRebuildSpamDB will create unicode enabled databases.\n" );
        &rb_mlog( "RebuildSpamDB will create unicode enabled databases." );
    }
    if ($main::CanUseUnicodeGCString) {
        &rb_printlog( "\nRebuildSpamDB will process all words as Sequence of UAX #29 Grapheme Clusters.\n" );
        &rb_mlog( "RebuildSpamDB will process all words as Sequence of UAX #29 Grapheme Clusters." );
    }
    if ($main::CanUseASSP_WordStem) {
        &rb_printlog( "\nRebuildSpamDB will use the ASSP_WordStem engine.\n" );
        &rb_mlog( "RebuildSpamDB will use the ASSP_WordStem engine." );
    }
    &rb_printlog("\n---ASSP Settings---\n");
    if ($main::DoPrivatSpamdb) {
        my $text = ($main::DoPrivatSpamdb == 1) ? 'users email addresses only.'
                 : ($main::DoPrivatSpamdb == 2) ? 'each local domain.'
                 : 'users email addresses and each local domain.';
        &rb_printlog("\nRebuildSpamDB will create private spamdb entries for $text\n\n");
        &rb_mlog("RebuildSpamDB will create private spamdb entries for $text.");
    }
    if ($main::DoNotCollectRedList) {
        &rb_printlog(
            "Do Not Collect Messages with RedListed address: Enabled\n**Messages with RedListed addresses will be removed from the corpus!**\n\n"
          );
    }
    if ($main::DoNotCollectRedRe) {
        &rb_printlog(
            "Do Not Collect RedRe Messages: Enabled\n**Messages matching the RedRe will be removed from the corpus!**\n\n");
    }
    if ($main::UseSubjectsAsMaillogNames) {
        &rb_printlog("Use Subject as Maillog Names: True\n");
    } else {
        &rb_printlog("Use Subject as Maillog Names: False\n");
    }
    &rb_printlog("Maxbytes: $main::MaxBytes \n");
    &rb_mlog("Maxfiles: $main::MaxFiles");

    &rb_printlog("RebuildFileTimeLimit: $main::RebuildFileTimeLimit \n");
    &rb_mlog("RebuildFileTimeLimit: $main::RebuildFileTimeLimit");

    if ($movetime) {
        &rb_printlog("RebuildFileTimeLimit: files will be moved away from the corpus, if there processing takes longer than $movetime second(s) \n");
        &rb_mlog("RebuildFileTimeLimit: files will be moved away from the corpus, if there processing takes longer than $movetime second(s)");
    }

    #cleanup deleted files
    &rb_cleanTrashlist();

    # start move2num to normalize filenames
    &rb_move2num() if $main::doMove2Num;

    # isspam?, path, filter, weight, processing sub
    $correctedspamcount    = &rb_processfolder( 1, $main::correctedspam,    "*", 2, \&rb_dospamhash );
    $correctednotspamcount = &rb_processfolder( 0, $main::correctednotspam, "*", 4, \&rb_dohamhash );
    my $tempnorm = ($HamWordCount ? ( $SpamWordCount / $HamWordCount ) : $SpamWordCount ? 9.9999 : 1) || 0.0001;
    my ($neededspam,$neededham, $spamf, $hamf, $SwordsPfile, $HwordsPfile);
    my @tn = split(/\-/o,$main::autoCorrectCorpus);
    my $targetNorm = sprintf("%.3f",(($tn[0] + $tn[1])/2));
    my $nspam = undef;
    if ($tempnorm < 30 && $targetNorm > 0) {
        my $tn = sprintf("%.3f",$tempnorm);
        if ($tempnorm >= 10) {
            &rb_printlog("warning: corpusnorm after processing $main::correctedspam and $main::correctednotspam is very unbalanced (>=10) Spam Weight: $SpamWordCount / Not-Spam Weight: $HamWordCount => norm: $tn  - you should fill some known good files in to the folder $main::correctednotspam\n");
            &rb_mlog("warning: corpusnorm after processing $main::correctedspam and $main::correctednotspam is very unbalanced (>=10) spamwords $SpamWordCount/ hamwords $HamWordCount => $tn - you should fill some known good files in to the folder $main::correctednotspam");
        }
        my @t;
        if (open (my $F, '<', "$main::base/normfile")) {
            binmode $F;
            @t = split(/ /,join('',<$F>));
            close $F;
        }
        if ($t[5] > 0 && $t[6] > 0) {
            $SwordsPfile = $t[5];
            $HwordsPfile = $t[6];

            if ($tempnorm < 10) {
                &rb_printlog("info: corpusnorm after processing $main::correctedspam and $main::correctednotspam is Spam Weight: $SpamWordCount / Not-Spam Weight: $HamWordCount => norm: $tn \n");
                &rb_mlog("info: corpusnorm after processing $main::correctedspam and $main::correctednotspam is spamwords $SpamWordCount/ hamwords $HamWordCount => $tn");
            }
            $spamf = &main::min($main::MaxFiles,&rb_countfiles(&rb_fixPath($main::base.'/'.$main::spamlog).'/'));
            $hamf =  &main::min($main::MaxFiles,&rb_countfiles(&rb_fixPath($main::base.'/'.$main::notspamlog).'/'));
            my $r = ($spamf>0 || $hamf>0) & defined(*{'main::yield'})?$targetNorm:0;

            my $sf = ($HamWordCount - $SpamWordCount + $HwordsPfile * $hamf)/$SwordsPfile;
            &rb_d("spamfiles -> $sf = ($HamWordCount - $SpamWordCount + $HwordsPfile * $hamf)/$SwordsPfile \n");
#            my $f = (($sf * 0.9) > $spamf) ? 1 : 0.9;
            my $f = 1;
            rb_d("info: f = $f , sf = $sf , spamf = $spamf");
            $f = $f / (($main::bayesnorm - $targetNorm + 1) ** 2) if ($main::bayesnorm >= $tn[0] && $main::bayesnorm <= $tn[1]);
            $sf = &main::min($spamf,$sf);
            rb_d("info: SpamCountNormCorrection = $main::SpamCountNormCorrection , f = $f , sf = $sf , spamf = $spamf, norm = $main::bayesnorm, target = $targetNorm");
            $neededspam = int($sf*$r*$f);
            $neededspam = 1 if $neededspam <= 0;
            my $t = ($neededspam < $spamf) ? "apx. $neededspam" : 'apx. all';
            $nspam = int($sf * $r * $SwordsPfile * (1+(($main::SpamCountNormCorrection > -100 && $main::SpamCountNormCorrection < 100) ? $main::SpamCountNormCorrection/100 : 0)));
            $nspam = 2 if $nspam < 2;

            &rb_printlog("info: require $t files ($nspam words".($main::SpamCountNormCorrection ? " +[$main::SpamCountNormCorrection\% included]" : '').") from folder $main::spamlog to get the wanted corpusnorm ($targetNorm)\n");
            &rb_mlog("info: require $t files ($nspam words".($main::SpamCountNormCorrection ? " +[$main::SpamCountNormCorrection\% included]" : '').") from folder $main::spamlog to get the wanted corpusnorm ($targetNorm)");
            $nspam += $SpamWordCount;
        } else {
            &rb_printlog("warning: missing information for automatic corpus correction in file $main::base/normfile - rerun the rebuild, if you see this warning the first time!\n");
            &rb_mlog("warning: missing information for automatic corpus correction in file $main::base/normfile - rerun the rebuild, if you see this warning the first time!");
        }
    } elsif ($targetNorm > 0) {
        my $tn = sprintf("%.3f",$tempnorm);
        &rb_printlog("warning: corpusnorm after processing $main::correctedspam and $main::correctednotspam is too unbalanced (>=30) Spam Weight: $SpamWordCount / Not-Spam Weight: $HamWordCount => norm: $tn - you should fill some known good files in to the folder $main::correctednotspam\n");
        &rb_mlog("warning: corpusnorm after processing $main::correctedspam and $main::correctednotspam is too unbalanced (>=30) spamwords $SpamWordCount/ hamwords $HamWordCount => $tn - you should fill some known good files in to the folder $main::correctednotspam");
    }
    my $spamWords = $SpamWordCount;
    $spamlogcount = &rb_processfolder( 1, $main::spamlog, "*", 1, \&rb_checkspam , $neededspam, undef, $nspam );
    $spamWords = $SpamWordCount - $spamWords;
    $SwordsPfile = ($SwordsPfile ? int(($SwordsPfile + $spamWords/$spamlogcount)/2) : int($spamWords/$spamlogcount)) if $spamlogcount;
    my $nham = undef;
    if ($neededspam && $targetNorm > 0) {
        $nham = ($SpamWordCount - $HamWordCount)/$targetNorm;
        &rb_d("$nham = ($SpamWordCount - $HamWordCount)/$targetNorm \n");
        $neededham = int($nham/$HwordsPfile);
        &rb_d("$neededham = int($nham/$HwordsPfile) \n");
        $neededham = 1 if $neededham <= 0;
        $nham = 2 if $nham < 2;
        my $t = ($neededham < $hamf) ? "apx. $neededham" : 'apx. all';
        &rb_printlog("info: require $t files ($nham words) from folder $main::notspamlog to get the wanted corpusnorm ($targetNorm)\n");
        &rb_mlog("info: require $t files ($nham words) from folder $main::notspamlog to get the wanted corpusnorm ($targetNorm)");
        $nham = (($SpamWordCount/$targetNorm) > $HamWordCount) ? int($SpamWordCount/$targetNorm) : 1;
        &rb_d("$nham = (($SpamWordCount/$targetNorm) > $HamWordCount) ? int($SpamWordCount/$targetNorm) : 1 \n");
    }
    my $hamWords = $HamWordCount;
    $notspamlogcount = &rb_processfolder( 0, $main::notspamlog, "*", 1, \&rb_checkham , $neededham, $nham);
    $hamWords = $HamWordCount - $hamWords;
    $HwordsPfile = ($HwordsPfile ? int(($HwordsPfile + $hamWords/$notspamlogcount)/2) : int($hamWords/$notspamlogcount)) if $notspamlogcount;

    if ($DoHMM && $scanFiles > 200) {
        use File::Find;
        my $size;
        find(sub{ -f and ( $size += -s ) }, "$main::base/tmpDB" );
        $size *= 2;
        $size = 250 * 1024 * 1024 if $size < 250 * 1024 * 1024;
        $size = &main::formatNumDataSize(int($size / 1024) * 1024);
        my $tooslow = 3; my $slow = $doattach ? 6 : 7; my $fast = $doattach ? 10 : 12;
        $scanTime = 1 unless $scanTime;
        my $fps = sprintf("%.2f",($scanFiles / $scanTime));
        if ($fps < $tooslow) {
            &rb_printlog("\nRebuild processed $fps files per second. ASSP expects a speed of at least $slow files per second - good values are $fast and higher. The disk IO components (disks and/or IO-controller) of your system are too slow for ASSP. Use a cached (>=128MB) IO-controller or use a RAM-disk with at least $size for the folder '$main::base/tmpDB' to speed up the rebuild process or disable 'DoHMM'.\n");
            &rb_mlog("Rebuild processed $fps files per second. ASSP expects a speed of at least $slow files per second - good values are $fast and higher. The disk IO components (disks and/or IO-controller) of your system are too slow for ASSP. Use a cached (>=128MB) IO-controller or use a RAM-disk with at least $size for the folder '$main::base/tmpDB' to speed up the rebuild process or disable 'DoHMM'.");
        } elsif ($fps < $slow) {
            &rb_printlog("\nRebuild processed $fps files per second. ASSP expects a speed of at least $slow files per second - good values are $fast and higher. The disk IO components (disks and/or IO-controller) of your system are slow. Use a cached (>=128MB) IO-controller or use a RAM-disk with at least $size for the folder '$main::base/tmpDB' to speed up the rebuild process.\n");
            &rb_mlog("Rebuild processed $fps files per second. ASSP expects a speed of at least $slow files per second - good values are $fast and higher. The disk IO components (disks and/or IO-controller) of your system are slow. Use a cached (>=128MB) IO-controller or use a RAM-disk with at least $size for the folder '$main::base/tmpDB' to speed up the rebuild process.");
        } elsif ($fps < $fast) {
            &rb_printlog("\nRebuild processed $fps files per second. Good values are $fast files per second and higher. You can speed up the rebuild process, using a cached (>=128MB) IO-controller or a RAM-disk with at least $size for the folder '$main::base/tmpDB'.\n");
            &rb_mlog("Rebuild processed $fps files per second. Good values are $fast files per second and higher. You can speed up the rebuild process, using a cached (>=128MB) IO-controller or a RAM-disk with at least $size for the folder '$main::base/tmpDB'.");
        } else {
            &rb_printlog("\nRebuild processed $fps files per second.\n");
            &rb_mlog("Rebuild processed $fps files per second.");
        }
    }

    $norm = $HamWordCount ? ( $SpamWordCount / $HamWordCount ) : 100;
    (open( my $normFile, '>', "$main::base/normfile" )) || warn "unable to open $main::base/normfile: $!\n";
    if ($normFile) {
        print { $normFile } "$norm $correctedspamcount $correctednotspamcount $spamlogcount $notspamlogcount $SwordsPfile $HwordsPfile $SpamWordCount $HamWordCount";
        eval{close $normFile;};
    }

    # Create Bayesian DB
    &rb_generatescores();

    # Create HMM DB
    &rb_generateHMM() if $DoHMM;

    # Create HELO blacklist
    &rb_createheloblacklist();

    $main::bayesnorm = $main::Spamdb{'***bayesnorm***'} = $norm;

    &rb_printlog("\nSpam Weight:\t   " . &rb_commify($SpamWordCount) . "\n");
    &rb_printlog("Not-Spam Weight:   " . &rb_commify($HamWordCount) . "\n\n" );
    if ( !($norm) ) {    #invalid norm
        &rb_printlog("Warning: Corpus insufficent to calculate normality!\n");
        &rb_mlog("Warning: Corpus insufficent to calculate normality!");
    }
    else {               #norm exists, print it
        my $normdesc;
        if    ( $norm < 0.6 )   { $normdesc = '(warning: extremely ham heavy)'; }
        elsif ( $norm < 0.9 )   { $normdesc = '(ok - slighly ham heavy)'; }
        elsif ( $norm < 1.1 )   { $normdesc = '(very good - balanced)'; }
        elsif ( $norm < 1.4 )   { $normdesc = '(ok - slighly spam heavy)'; }
        else                    { $normdesc = '(warning: extremely spam heavy)'; }
        &rb_printlog( "Corpus norm:\t%.4f - $normdesc\n", $norm );
        &rb_printlog( "Corpus confidence:\t%.8f\n", &main::BayesConfNorm() );
    }
    if ( $spamlogcount >= $main::MaxFiles || $notspamlogcount >= $main::MaxFiles ) {
        &rb_printlog(
            "Recommendation: RebuildSpamDB will limit the number of used messages in your corpus. Excess files will be ingored.\n"
          );
    }
    my ($lownorm,$highnorm,$numfiles,$mindays) = split(/-/o, $main::autoCorrectCorpus);
    if ( $norm < 0.6 ) {
        &rb_printlog("Corpus norm should be between 0.6 and 1.4\n");
        &rb_printlog("\nRecommendation: You need more spam messages in the corpus.\n");
    }
    if (! $main::RebuildTestMode && ! $neededspam && $main::autoCorrectCorpus && $norm < $lownorm && $main::notspamlog && ! $main::RunTaskNow{cleanUpMaxFiles}) {
        $main::RunTaskNow{cleanUpMaxFiles} = 10001;
        &rb_printlog("\nstarting auto correction for corpus - delete old ham files from $main::notspamlog\n");
        my $info = &main::cleanUpMaxFiles($main::notspamlog, 1 - $lownorm, $numfiles,$mindays);
        &rb_printlog($info) if $info;
        $main::RunTaskNow{cleanUpMaxFiles} = '';
    }
    if ( $norm > 1.4 ) {
        &rb_printlog("Corpus norm should be between 0.6 and 1.4\n");
        &rb_printlog("\nRecommendation: You need more not-spam messages in the corpus.\n");
    }
    if (! $main::RebuildTestMode && ! $neededspam && $main::autoCorrectCorpus && $norm > $highnorm && $main::spamlog && ! $main::RunTaskNow{cleanUpMaxFiles}) {
        $main::RunTaskNow{cleanUpMaxFiles} = 10001;
        &rb_printlog("\nstarting auto correction for corpus - delete old spam files from $main::spamlog\n");
        my $info = &main::cleanUpMaxFiles($main::spamlog, $highnorm - 1, $numfiles,$mindays);
        &rb_printlog($info) if $info;
        $main::RunTaskNow{cleanUpMaxFiles} = '';
    }
    if ( $main::MaxBytes >= 4000 && $norm < 0.6 ) {
        &rb_printlog( "\nRecommendation: You should reduce now MaxBytes to " . int( ( $main::MaxBytes + 1000 ) / 2 ) . "!  \n" );
    }
    if ( $main::MaxBytes <= 4000 && $norm > 1.3 ) {
        my $newMaxBytes = int( $main::MaxBytes - 1000 ) * 2 ;
        $newMaxBytes = $main::MaxBytes + 1000 if $newMaxBytes <= $main::MaxBytes;
        &rb_printlog( "\nRecommendation: You should increase now MaxBytes to " . $newMaxBytes . "!  \n" );
    }

    if ($DoHMM) {
        if ($main::spamdb eq 'DB:' or $main::runHMMusesBDB) {
            $main::lockHMM = 1;
            &rb_mlog( "try to lock HMM databases in 5 second(s)" );
            sleep 5;
            $main::ThreadIdleTime{$main::WorkerNumber} += 5;
            &rb_printlog( "\nStart populating Hidden Markov Model. HMM-check is disabled for this time!\n" );
            &rb_mlog( "Start populating Hidden Markov Model. HMM-check is disabled for this time!" );
            rb_populate_HMM();
            &rb_printlog( "Finished populating Hidden Markov Model. HMM-check is now enabled again!\n" );
            &rb_mlog( "Finished populating Hidden Markov Model! HMM-check is now enabled again!" );
            $main::cleanHMM = '';
            $main::HMMdb{'***bayesnorm***'} = $norm;
        } else {
            &rb_printlog( "\nplease set the config parameter 'spamdb' to 'DB:' or 'HMMusesBDB' to 'On' - unable to populate HMM\n\n");
            &rb_mlog( "please set the config parameter 'spamdb' to 'DB:' or 'HMMusesBDB' to 'On' - unable to populate HMM");
        }

        $main::lockHMM = 0;
    }

    $processedBytes = &main::formatNumDataSize($processedBytes);
    if   ( time - $starttime != 0 ) { $processTime = &rb_commify(time - $starttime); }
    else                            { $processTime = 1; }
    &rb_printlog( "\nTotal processing time: %s second(s)\n", $processTime );
    &rb_printlog( "\nTotal processing data: $processedBytes\n\n");
    &rb_mlog( "Total processing time: %s second(s)", $processTime );
    &rb_mlog( "Total processed data: $processedBytes");

    if ( $main::asspLog ) { &rb_uploadgriplist(); }

    if ($TrashlistObj !~ /orderedtie/o && (open my $HASH, '>', "$main::base/trashlist.db") ) {
        binmode $HASH;
        print $HASH "\n";
        foreach my $k (sort keys %Trashlist) {
            my $v = $Trashlist{$k};
            print $HASH "$k\002$v\n";
        }
        eval{close $HASH;};
        &rb_printlog( "\nTrashlist was saved to $main::base/trashlist.db\n" );
        &rb_mlog( "Trashlist was saved to $main::base/trashlist.db" );
    }
    eval{close $RebuildLog;};
    if ($main::RebuildNotify) {
        &main::sendNotification(
          $main::EmailFrom,
          $main::RebuildNotify,
          "RebuildSpamDB - report from $main::myName",
          "File rebuildrun.txt follows:\r\n\r\n",
          "$main::base/rebuildrun.txt");
    }

    }  # end if ($onlyNewCorrected)

    undef $spamObj;
    undef $newspamObj;
    undef $HeloObj;
    undef $HamHashObj;
    undef $SpamHashObj;
    undef $GpCntObj;
    undef $GpOKObj;
    undef $TrashlistObj;
    undef $HMMresObj;
    untie %spam;
    untie %newspam;
    untie %Helo;
    untie %HamHash;
    untie %SpamHash;
    untie %GpCnt;
    untie %GpOK;
    untie %Trashlist;
    untie %HMMres;

    unlink "$DBDir/rb_HMMres.bdb";
    unlink "$DBDir/rb_HamHash.bdb";
    unlink "$DBDir/rb_SpamHash.bdb";
    unlink "$DBDir/rb_GpCnt.bdb";
    unlink "$DBDir/rb_GpOK.bdb";
    unlink "$DBDir/rb_newspam.bdb";

    undef $hamHMM;
    undef $spamHMM;

    undef $BDBEnv;

eval (<<'EOT');
    no ASSP_WordStem;
EOT
    return 1;
}
##########################################
#       run/main script ends here
##########################################

sub rb_populate_HMM {                 # rb_populate_HMM
    delete $HMMres{''};
    return rb_populate_HMM_DB() if $main::DBusedDriver ne 'BerkeleyDB' && ! $main::runHMMusesBDB;
    %main::HMMdb = ();                # clear the main hash

    my $obj;
    if ($obj = tied %main::HMMdb) {
       &main::BDB_filter_off($obj);
    }
    my $tot;
    eval (<<'EOT');
        $tot = &rb_commify($HMMresObj->db_stat()->{hash_ndata});
EOT

    my $count = $main::haveHMM = 0;
    &rb_printlog( "start populating Hidden Markov Model with $tot records!\n" );
    &rb_mlog( "start populating Hidden Markov Model with $tot records!" );
    $main::cleanHMM = 1;
    while (my ($k,$v) = each %HMMres) {
        next unless defined $v;
        if ($count%1000==0) {
            die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};
            $main::lastd{$Iam} = "populating HMM - ".&rb_commify($count)."/$tot";
        }
        $main::HMMdb{$k} = $v unless $main::RebuildTestMode;
        $count++;
    }
    $main::currentDBVersion{HMMdb} = $main::HMMdb{'***DB-VERSION***'} = $main::requiredDBVersion{HMMdb};
    &main::BDB_filter($obj) if $obj;
    $main::haveHMM = $count;
    $main::cleanHMM = '' if $count;
    $count = &rb_commify($count);

    &rb_printlog( "Finished populating Hidden Markov Model with $count records!\n" );
    &rb_mlog( "Finished populating Hidden Markov Model with $count records!" );
    &main::checkDBCon() if ($main::CanUseTieRDBM && $main::DBisUsed);
    return;
}

sub rb_populate_HMM_DB {                 # rb_populate_HMM_DB;
    my ($tot,$totn);
    eval (<<'EOT');
        $totn = $HMMresObj->db_stat()->{hash_ndata};
        $tot = &rb_commify($totn);
EOT

    &rb_printlog( "start populating Hidden Markov Model with $tot records!\n" );
    &rb_mlog( "start populating Hidden Markov Model with $tot records!" );

    while ($main::ComWorker{$Iam}->{run} && $main::RunTaskNow{ImportMysqlDB}) {
        die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};
        $main::lastd{$Iam} = "waiting additional 10 seconds for still running DB import to be finished";
        sleep 10;
        $main::ThreadIdleTime{$main::WorkerNumber} += 10;
    }
    die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};

    $main::haveHMM = 0;
    $main::cleanHMM = 1;
    $main::RunTaskNow{ImportMysqlDB} = $Iam;
    $main::lastd{$Iam} = "populating HMM - $tot records";
    &main::importDB('main::HMMdb','','hmmdb',\%HMMres,$totn, 1/2) unless $main::RebuildTestMode;
    $main::RunTaskNow{ImportMysqlDB} = '';
    $main::cleanHMM = 0 if ($main::haveHMM = &main::getDBCount('main::HMMdb','main::spamdb'));
    delete $main::HMMdb{''};
    $main::currentDBVersion{HMMdb} = $main::HMMdb{'***DB-VERSION***'} = $main::requiredDBVersion{HMMdb};
    &rb_printlog( "Finished populating Hidden Markov Model with $tot records!\n" );
    &rb_mlog( "Finished populating Hidden Markov Model with $tot records!" );
    &main::checkDBCon() if ($main::CanUseTieRDBM && $main::DBisUsed);
    return;
}

sub rb_populate_Spamdb {
    my ($hashref, $totn) = @_;

    my $mainhashname = 'main::Spamdb';
    my $mysqlTable = lc $mainhashname;
    $mysqlTable =~ s/main:://o;
    my $tot = &rb_commify($totn);

    &rb_printlog( "start populating Spamdb with $tot records - Bayesian check is now disabled!\n" );
    &rb_mlog( "start populating Spamdb with $tot records - Bayesian check is now disabled!" );
    $main::lastd{$Iam} = "start populating Spamdb with $tot records!" ;

    while ($main::ComWorker{$Iam}->{run} && $main::RunTaskNow{ImportMysqlDB}) {
        die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};
        $main::lastd{$Iam} = "waiting additional 10 seconds for still running DB import to be finished";
        sleep 10;
        $main::ThreadIdleTime{$main::WorkerNumber} += 10;
    }
    die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};

    $main::RunTaskNow{ImportMysqlDB} = $Iam;
    $main::lockBayes = 1;
    &rb_mlog( "try to lock Spamdb database in 5 second(s)" );
    sleep 5;
    $main::ThreadIdleTime{$main::WorkerNumber} += 5;
    $main::lastd{$Iam} = "populating Spamdb - $tot records";
    &main::importDB($mainhashname,'',$mysqlTable,$hashref,$totn, 1/2) unless $main::RebuildTestMode;
    $main::lockBayes = '';
    $main::RunTaskNow{ImportMysqlDB} = '';

    &rb_printlog( "Finished populating Spamdb with $tot records - Bayesian check is now enabled!\n" );
    &rb_mlog( "Finished populating Spamdb with $tot records - Bayesian check is now enabled!" );
    &main::checkDBCon() if ($main::CanUseTieRDBM && $main::DBisUsed);
    return;
}

sub rb_Load_Trashlist {
       my $LH;
       unless (open($LH, '<',"$main::base/trashlist.db")) {
           return;
       }
       binmode($LH);
       while (<$LH>) {
         my ($k,$v) = split/\002/o;
         chomp $v;
         $v =~ s/\r|\n//go;
         if ($k && $v) {
           $Trashlist{$k}=$v;
         }
       }
       eval{close $LH;};
}

sub rb_BDB_getRecordCount {
    my $hash = shift;
    return 0 unless $hash;
    return 0 unless tied %{$hash};
    my $dbo = $hash . 'Obj';
    return 0 unless defined ${$dbo};
    return 0 if ("${$dbo}" !~ /BerkeleyDB/o);
    my $statref;
    eval (<<'EOT');
         $statref = ${$dbo}->db_stat();
EOT
    return 0 unless $statref;
    return 0 unless ref $statref;
    return $statref->{hash_ndata};
}


sub rb_generatescores {
    my ( $t, $s, $pair, $v );
    &rb_printlog("\nGenerating weighted Bayesian tuplets\n");
    my $spamdbFile;
    if (! $main::ReplaceOldSpamdb) {
        (open( $spamdbFile, '>', "$main::base/spamdb.rb.tmp" )) ||  &rb_printlog("unable to open $main::base/spamdb.rb.tmp: $!\n");
        binmode $spamdbFile;
        print { $spamdbFile } "\n";
    }
    my $totspam = &rb_BDB_getRecordCount('spam') || scalar keys %spam;
    my $count = 0;
    while ( ( $pair, $v ) = each(%spam) ) {
        next if (! $pair);
        $count++;
        if ($count%1000==0) {
            die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};
            $main::lastd{$Iam} = "Generating weighted Bayesian tuplets $count/$totspam";
        }
        my ($s1, $t1) = ( $s, $t ) = split( q{ }, $v );
#        $t = ( $t - $s ) * $norm + $s;    # normalize t
        if ( $t1 > 3 ) {

            # if token represents all spam or all ham then square its value
            if ( $s1 == $t1 || $s1 == 0 ) {
                $s = $s * $s;
                $t = $t * $t;
            }
            $v = ( 1 + $s ) / ( $t + 2 );
            $v = sprintf( "%.7f", $v );
            $v = 0.9999999 if $v >= 1;
            $v = 0.0000001 if $v <= 0;
            if (abs( $v - .5 ) > .09) {
                $newspam{$pair} = $v;
                print { $spamdbFile } "$pair\002$v\n" if (! $main::ReplaceOldSpamdb);
            }
        }
    }
    my $nowspam = &rb_BDB_getRecordCount('newspam') || scalar keys %newspam;
    eval{close $spamdbFile;} if (! $main::ReplaceOldSpamdb);
    &main::checkDBCon() if ($main::CanUseTieRDBM && $main::DBisUsed);
    my $oldspam = &main::getDBCount('main::Spamdb','main::spamdb');
    if ($main::ReplaceOldSpamdb) {
        if ($main::spamdb ne 'DB:' or
            ($main::spamdb eq 'DB:' and $main::DBusedDriver eq 'BerkeleyDB' and $main::CanUseBerkeleyDB))
        {
            $main::lastd{$Iam} = "populating $nowspam SpamDB records";
            &rb_printlog("populating Spamdb $nowspam records - Bayesian check is now disabled\n");
            &rb_mlog("populating $nowspam Spamdb records - Bayesian check is now disabled");
            $main::lockBayes = 1;
            &rb_mlog( "try to lock Spamdb database in 5 second(s)" );
            sleep 5;
            $main::ThreadIdleTime{$main::WorkerNumber} += 5;
            %main::Spamdb = %newspam;
            $main::lockBayes = '';
            $main::lastd{$Iam} = "finished populating SpamDB records: $nowspam";
            &rb_printlog("done - populating Spamdb records - $nowspam - Bayesian check is now enabled\n");
            &rb_mlog("done - populating Spamdb records - $nowspam - Bayesian check is now enabled");
        } else {
            rb_populate_Spamdb(\%newspam,$nowspam);
        }
    } else {
        $count = 0;
        $main::lastd{$Iam} = "add/modify $nowspam SpamDB records";
        &rb_printlog("add/modify Spamdb $nowspam records\n");
        &rb_mlog("add/modify Spamdb $nowspam records");
        while ( ( $pair, $v ) = each(%newspam) ) {
            $count++;
            if ($count%1000==0) {
                die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};
                $main::lastd{$Iam} = "add/modify weighted Bayesian tuplets $count/$nowspam";
            }
            $main::Spamdb{$pair} = $v;
        }
        $main::lastd{$Iam} = "finished add/modify SpamDB records: $nowspam";
        &rb_printlog("done - add/modify Spamdb records - $nowspam\n");
        &rb_mlog("done - add/modify Spamdb records - $nowspam");
    }
    &rb_printlog("done - Generating weighted Bayesian tuplets\n");
    my $filesize = -s "$main::base/spamdb.rb.tmp";
    if (! $main::ReplaceOldSpamdb) {
        &rb_printlog( "\nResulting file '$main::base/spamdb.rb.tmp' is " . &rb_commify($filesize) . " bytes\n" );
    } else {
        &rb_printlog( "\n");
    }
    my $allpairs ;
    if ($main::ReplaceOldSpamdb) {
        $allpairs = $nowspam;
    } else {
        $allpairs = &main::getDBCount('main::Spamdb','main::spamdb');
    }
    &rb_printlog("Bayesian Pairs: " . &rb_commify($allpairs) . " now in list\n");
    &rb_mlog("Bayesian Pairs: " . &rb_commify($allpairs) . " now in list");
    $main::currentDBVersion{Spamdb} = $main::Spamdb{'***DB-VERSION***'} = $main::requiredDBVersion{Spamdb};
    %spam = ();
    return;
} ## end sub generatescores

sub rb_generateHMM {
    my $count = $spamHMM->{'chainsDB'}->db_stat()->{hash_ndata};
    $count +=   $spamHMM->{'totalsDB'}->db_stat()->{hash_ndata};
    $count +=   $hamHMM->{'chainsDB'}->db_stat()->{hash_ndata};
    $count +=   $hamHMM->{'totalsDB'}->db_stat()->{hash_ndata};
    $count = &rb_commify($count);
    &rb_printlog("\nGenerating consolidated Hidden-Markov-Model database from $count record model\n");
    &rb_mlog("Generating consolidated Hidden-Markov-Model database from $count record model");
    $count = 0;
    my $rec = 0;
    my $sep = $spamHMM->{seperator};
    while( my ($k,$sw) = each %{$spamHMM->{chains}} ) {
        $count++;
        if ($count%1000==0) {
            die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};
            $main::lastd{$Iam} = "add HMM sequences $count";
        }
        my ($seq) = $k =~ /^(.+)$sep[^$sep]+$/;
        next unless ($seq);
        my $ht = $hamHMM->get_totals($seq);
        my $st = $spamHMM->get_totals($seq);
        if (my $tot = $ht + $st) {
            my $hw = $hamHMM->sequence_known($k);
            my $h = $hw / $tot;
            my $s = $sw / $tot;

            my $sp = (1 - $h + $s) / 2 ;
            $sp = 0.0000001 if $sp <= 0;
            $sp = 0.9999999 if $sp >= 1;
            if (abs( $sp - .5 ) > .09) {
                $HMMres{$k} = $sp;
                $rec++;
            }
        }
        delete ${$hamHMM->{chains}}{$k};
    }
    &main::checkDBCon() if ($main::CanUseTieRDBM && $main::DBisUsed);
    while( my ($k,$hw) = each %{$hamHMM->{chains}} ) {
        $count++;
        if ($count%1000==0) {
            die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};
            $main::lastd{$Iam} = "add HMM sequences $count";
        }
        my ($seq) = $k =~ /^(.+)$sep[^$sep]+$/;
        next unless ($seq);
        my $ht = $hamHMM->get_totals($seq);
        my $st = $spamHMM->get_totals($seq);
        if (my $tot = $ht + $st) {
            my $h = $hw / $tot;

            my $sp = (1 - $h) / 2 ;
            $sp = 0.0000001 if $sp <= 0;
            $sp = 0.9999999 if $sp >= 1;
            if (abs( $sp - .5 ) > .09) {
                $HMMres{$k} = $sp;
                $rec++;
            }
        }
    }
    &rb_printlog("HMM sequences: " . &rb_commify($rec) . " now in list\n\n");
    &rb_mlog("HMM sequences: " . &rb_commify($rec) . " now in list");
}

sub rb_createheloblacklist {
    (open( my $FheloBlack, '>', "$main::base/spamdb.helo.rb.tmp" )) || &rb_printlog("unable to open '$main::base/spamdb.helo.rb.tmp' $!\n");
    binmode $FheloBlack;
    print { $FheloBlack } "\n";
    my $count = &rb_commify(rb_BDB_getRecordCount('Helo') || scalar keys %Helo);
    &rb_mlog("generating Spamdb.helo records from $count collected HELO's");
    &rb_printlog("generating Spamdb.helo records from $count collected HELO's\n");
    &main::checkDBCon() if ($main::CanUseTieRDBM && $main::DBisUsed);
    $count = 0;
    my $allcount = 0;
    my $notnew = 0;
    %main::HeloBlack = () if ($main::build lt 13080);
    while ( my ( $helostr, $weight ) = each(%Helo) ) {
        my $helostrlc = lc($helostr);
        my $spam = int($weight / 1000000);
        my $ham = $weight - $spam * 1000000;
# at least 5 spam weights without a ham weight [spam/(spam + 0 + .1) = 0.98 -> spam = 4.9] or
# at least 22 spam weights per ham weight      [spam/(spam + 1/3 + .1) = 0.98 -> spam = 21,7] to get HeloBlack
# at least 54 spam weights per ham weight      [spam/(spam + 1 + .1) = 0.98 -> spam = 53,9] to get HeloBlack
        my $w = $spam / ( $spam + $ham / 3 + .1 );
        if ( $w > .98 ) {
            $w = int($w + 0.5);
            print { $FheloBlack } "$helostrlc\002$w\n";
            $allcount++;
            if (exists $main::HeloBlack{$helostrlc}) {
                $notnew++;
            } elsif ($main::MaintenanceLog >= 2) {
                &rb_printlog("added new black helo '$helostrlc' to HeloBlackList\n");
                &rb_mlog("added new black helo '$helostrlc' to HeloBlackList");
            }
            $main::HeloBlack{$helostrlc} = $w;
        } elsif ($w < 0.12 && $ham > 3) {
            $w = sprintf("%.2f",(0.2 - $w));
            print { $FheloBlack } "$helostrlc\002$w\n";
            $allcount++;
            if (exists $main::HeloBlack{$helostrlc}) {
                $notnew++;
            } elsif ($main::MaintenanceLog >= 2) {
                &rb_printlog("added new good helo '$helostrlc' to HeloBlackList\n");
                &rb_mlog("added new good '$helostrlc' to HeloBlackList");
            }
            $main::HeloBlack{$helostrlc} = $w;
        } else {
            delete $Helo{$helostr};
        }
        $count++;
        if ($count%1000==0) {
            $main::lastd{$Iam} = "generating Spamdb.helo records $count";
            my $dbc = $main::HeloBlack{$helostr};
            die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};
        }
    }
    eval{close $FheloBlack;};

    $count = 0;
    if ($main::ReplaceOldSpamdb && ! $onlyNewCorrected) {
        &rb_printlog("cleaning old Spamdb.helo records\n");
        &rb_mlog("cleaning old Spamdb.helo records");
        while ( my ( $helostr, $weights ) = each(%main::HeloBlack) ) {   #   clean old records from Spamdb.Helo
            $helostr = lc($helostr);
            delete $main::HeloBlack{$helostr} if (! exists $Helo{$helostr});
            $count++;
            if ($count%1000==0) {
                $main::lastd{$Iam} = "cleaning old Spamdb.helo records $count";
                die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};
            }
        }
        &rb_printlog("done - cleaning old Spamdb.helo records\n");
        &rb_mlog("done - cleaning old Spamdb.helo records");
    }
    $count = &rb_commify(&main::getDBCount('main::HeloBlack','main::spamdb'));
    my $newhelos = &rb_commify($allcount - $notnew);
    my $text = ($main::ReplaceOldSpamdb) ? 'new' : 'in new mail';
    &rb_printlog( "\nHELO Blacklist: $newhelos $text, $count now in list\n" );
    &rb_mlog( "HELO Blacklist: $newhelos $text, $count now in list" );
    return;
}

sub rb_processNewCorrected {
    &main::checkDBCon() if ($main::CanUseTieRDBM && $main::DBisUsed);
    $movetime = 0;
    my %addspam;
    my $newhamHMM  = ASSP::MarkovChain->new(longest => $main::HMMSequenceLength,
                                          shortest => $main::HMMSequenceLength,
                                          top => 1,
                                          nostarts => 1,
                                          simple => 1
                                          );
    my $newspamHMM = ASSP::MarkovChain->new(longest => $main::HMMSequenceLength,
                                          shortest => $main::HMMSequenceLength,
                                          top => 1,
                                          nostarts => 1,
                                          simple => 1
                                          );
# collect the SpamDB and HMM data from the files
    foreach my $file (sort { $main::newReported{$b} cmp $main::newReported{$a} } keys(%main::newReported) ) {
        my ($fldrType,$weight) = split(/\s+/o,$main::newReported{$file});
        if ($fldrType eq 'ham') {
            $weight += 4;
            $fldrType = 0;
        } else {
            $weight += 2;
            $fldrType = 1;
        }
        delete $main::newReported{$file};
        &rb_add( $fldrType, $file, $weight, \&rb_donohash, \%addspam ,$newspamHMM, $newhamHMM, 0 );
        rb_mlog("processed corrected file '$file' for SpamDB and HMMdb") if $main::MaintenanceLog > 1;
        die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};
    }

    my $mod;
# calculate and update the SpamDB
    if ($main::haveSpamdb) {
        my $count = 0;
        foreach (keys %addspam) {
            my ( $sfac, $tfac ) = split( q{ }, $addspam{ $_ } );
            my ( $sfao, $tfao ) = split( q{ }, $spam{ $_ } );
            $sfac += $sfao;
            $tfac += $tfao;
            $spam{ $_ } = $addspam{ $_ } = "$sfac $tfac";
        }
        die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};

        my ( $t, $s, $pair, $v );
        while ( ( $pair, $v ) = each(%addspam) ) {
            next if (! $pair);
            my ($s1, $t1) = ( $s, $t ) = split( q{ }, $v );
#            $t = ( $t - $s ) * $norm + $s;    # normalize t
            if ( $t1 > 3 ) {

                # if token represents all spam or all ham then square its value
                if ( $s1 == $t1 || $s1 == 0 ) {
                    $s = $s * $s;
                    $t = $t * $t;
                }
                $v = ( 1 + $s ) / ( $t + 2 );
                $v = sprintf( "%.7f", $v );
                $v = 0.9999999 if $v >= 1;
                $v = 0.0000001 if $v <= 0;
                if (abs( $v - .5 ) > .09) {
                    $main::Spamdb{$pair} = $v;
                    $count++;
                } else {
                    delete $main::Spamdb{$pair};
                }
            }
        }
        $mod = "SpamDB($count)";
    }
    die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};
# calculate and update the HMMdb
    if ($DoHMM && $main::haveHMM) {
        my $count = 0;
        my $sep = $newspamHMM->{seperator};
        foreach my $k (keys %{$newspamHMM->{chains}}) {
            my ($seq) = $k =~ /^(.+)$sep[^$sep]+$/;
            $newspamHMM->{totals}{$seq} += $spamHMM->{totals}{$seq};
            $spamHMM->{totals}{$seq} = $newspamHMM->{totals}{$seq};
            $newspamHMM->{chains}{$k} += $spamHMM->{chains}{$k};
            $spamHMM->{chains}{$k} = $newspamHMM->{chains}{$k};
        }
        foreach my $k (keys %{$newhamHMM->{chains}}) {
            my ($seq) = $k =~ /^(.+)$sep[^$sep]+$/;
            $newhamHMM->{totals}{$seq} += $hamHMM->{totals}{$seq};
            $hamHMM->{totals}{$seq} = $newhamHMM->{totals}{$seq};
            $newhamHMM->{chains}{$k} += $hamHMM->{chains}{$k};
            $hamHMM->{chains}{$k} = $newhamHMM->{chains}{$k};
        }
        die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};

        while( my ($k,$sw) = each %{$newspamHMM->{chains}} ) {
            my ($seq) = $k =~ /^(.+)$sep[^$sep]+$/;
            next unless ($seq);
            my $ht = $newhamHMM->get_totals($seq);
            my $st = $newspamHMM->get_totals($seq);
            if (my $tot = $ht + $st) {
                my $hw = $newhamHMM->sequence_known($k);
                my $h = $hw / $tot;
                my $s = $sw / $tot;

                my $sp = (1 - $h + $s) / 2 ;
                $sp = 0.0000001 if $sp <= 0;
                $sp = 0.9999999 if $sp >= 1;
                if (abs( $sp - .5 ) > .09) {
                    $main::HMMdb{$k} = $sp;
                    $count++;
                } else {
                    delete $main::HMMdb{$k};
                }
            }
            delete ${$newhamHMM->{chains}}{$k};
        }
        &main::checkDBCon() if ($main::CanUseTieRDBM && $main::DBisUsed);
        while( my ($k,$hw) = each %{$newhamHMM->{chains}} ) {
            my ($seq) = $k =~ /^(.+)$sep[^$sep]+$/;
            next unless ($seq);
            my $ht = $newhamHMM->get_totals($seq);
            my $st = $newspamHMM->get_totals($seq);
            if (my $tot = $ht + $st) {
                my $h = $hw / $tot;

                my $sp = (1 - $h) / 2 ;
                $sp = 0.0000001 if $sp <= 0;
                $sp = 0.9999999 if $sp >= 1;
                if (abs( $sp - .5 ) > .09) {
                    $main::HMMdb{$k} = $sp;
                    $count++;
                } else {
                    delete $main::HMMdb{$k};
                }
            }
        }
        $mod .= ' and ' if $mod;
        $mod .= "HMMdb($count)";
    }
    if ($mod) {
        rb_mlog("updated $mod from new corrected files");
        rb_createheloblacklist();
    }
}

sub rb_processfolder {
    my ( $fldrType, $fldrpath, $filter, $weight, $sub, $MaxFiles, $neededHamWords, $neededSpamWords ) = @_;
    my ( $count, $pcount, $processFolderTime, $folderStartTime, $fileCount, @files, $deleteCount, $ignoreCount );
    &main::checkDBCon() if ($main::CanUseTieRDBM && $main::DBisUsed);
    $MaxFiles = $main::MaxFiles;
#    $MaxFiles ||= $main::MaxFiles;
#    $MaxFiles = &main::min($MaxFiles,$main::MaxFiles);
    $folderStartTime = time;
    $attachments = 0;
    my $flr = $fldrpath;
    $fldrpath = $main::base.'/'.$fldrpath;
    $fldrpath = &rb_fixPath($fldrpath);
    &rb_printlog( "\n" . $fldrpath . "\n" );
    &rb_mlog($fldrpath);
#   $fldrpath .= $filter eq "*" ? "/*" : "/*$filter";
    $fldrpath .= '/';
    $fileCount = &rb_countfiles($fldrpath);
    &rb_printlog( "File Count:\t" . &rb_commify($fileCount) );
    &rb_mlog( "File Count:\t" . &rb_commify($fileCount) );
    &rb_printlog("\nProcessing... $flr with ".&rb_commify(&main::min($fileCount,$MaxFiles))." files");
    &rb_mlog("Processing... $flr with ".&rb_commify(&main::min($fileCount,$MaxFiles))." files");
    $count = $RedCount = $WhiteCount = $deleteCount = 0;

    @files =  map { $_->[0] }
              sort { $b->[1] <=> $a->[1] }
              map { [ $_, &main::ftime($fldrpath.$_) ] } $main::unicodeDH->($fldrpath);  # youngest files first

    my ($spt,$nspt) = split(/\s+/o,($weight == 1 ? $main::MaxBayesFileAge : $main::MaxCorrectedDays));
    $nspt = $spt unless defined $nspt;
    $spt = $nspt if ! $fldrType;
    $spt *= 3600 * 24;
    my $rem = ($spt && $main::MaintBayesCollection) ? ' and remove' : '';
    &rb_printlog("\nignore$rem files older than ".&main::timestring($folderStartTime - $spt,'','')." in folder $flr") if $spt;
    &rb_mlog("ignore$rem files older than ".&main::timestring($folderStartTime - $spt,'','')." in folder $flr") if $spt;
    my %toolong;

    while (@files) {
        my $file = shift @files;
        $file = $fldrpath.$file;
        delete $main::newReported{$file};
        &main::ThreadYield();
        if ($count%100==0) {
            die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};
            $main::lastd{$Iam} = "Processed $count/$fileCount files in $flr";
        }
        next if $main::dF->( $file );
        my $ftime = &main::ftime($file);
        next unless $ftime;
        my $dtime = $folderStartTime - $ftime;
        if ( $spt && $dtime > $spt ) {
            $count++;
            if ($main::MaintBayesCollection) {
                $main::unlink->($file);
                $deleteCount++;
                next;
            }
            $ignoreCount++;
            next;
        }
        if (($pcount - ( $RedCount + $WhiteCount )) < $MaxFiles)
        {    #too many files or words;
            my $heloOnly = ((! defined $neededHamWords) && (! defined $neededSpamWords))
                        || ($neededHamWords > 0 && $neededHamWords > $HamWordCount)
                        || ($neededSpamWords > 0 && $neededSpamWords > $SpamWordCount) ? 0 : 1;
            rb_d( 'file ('.++$pcount.")[$heloOnly]: $file");
            my $t = Time::HiRes::time();
            my $nocheck = &rb_add( $fldrType, $file, $weight, $sub, \%spam ,$spamHMM, $hamHMM, $heloOnly);
            delete $main::newReported{ $file };
            if (! $nocheck) {
                $t = Time::HiRes::time() - $t;
                if (($mintime && $t > $mintime) or ($movetime && $t > $movetime)) {
                    $t = sprintf("%.2f",$t);
                    &rb_d( "too long file processing time: $file - $t seconds" );
                    $toolong{$file} = $t;
                }
            }
            $count += $heloOnly ? 0 : 1;
        } elsif (! $spt) {     # stop if we don't have to remove old files
            $count++;
            last;
        }
    }
    if   ( time - $folderStartTime != 0 ) { $processFolderTime = time - $folderStartTime; }
    else                                  { $processFolderTime = 1; }
    $pcount = $pcount - ( $RedCount + $WhiteCount );
    if ($RedCount) {
        &rb_printlog( "\nRemoved Red:\t" . &rb_commify($RedCount) );
        &rb_mlog( "Removed Red:\t" . &rb_commify($RedCount) );
    }

    if ($WhiteCount) {
        &rb_printlog( "\nRemoved White:\t" . &rb_commify($WhiteCount) );
        &rb_mlog( "Removed White:\t" . &rb_commify($WhiteCount) );
    }

    if ($deleteCount) {
        &rb_printlog( "\nRemoved Old:\t" . &rb_commify($deleteCount) );
        &rb_mlog( "Removed Old:\t" . &rb_commify($deleteCount) );
    }

    if ($ignoreCount) {
        &rb_printlog( "\nIgnored:\t" . &rb_commify($ignoreCount) );
        &rb_mlog( "Ignored:\t" . &rb_commify($ignoreCount) );
    }

    if ($doattach) {
        rb_mlog(&rb_commify($attachments)." attachment/image entries processed");
        rb_printlog("\n".&rb_commify($attachments)." attachment/image entries processed");
    }

    &rb_printlog( "\nImported Files for HeloBlackList:\t" . &rb_commify($pcount) );
    &rb_mlog( "Imported Files for HeloBlackList:\t" . &rb_commify($pcount) );
    &rb_printlog( "\nImported Files for Bayes/HMM:\t" . &rb_commify($count) );
    &rb_mlog( "Imported Files for Bayes/HMM:\t" . &rb_commify($count) );

    if ( $count >= $main::MaxFiles ) {
        &rb_printlog("\nFolder contents exceeded 'MaxFiles'($main::MaxFiles). ");
        &rb_mlog("Folder contents exceeded 'MaxFiles'($main::MaxFiles). ");
    }

    if (($mintime or $movetime) && (my $tl = scalar keys %toolong)) {
        my $mtl = &main::min($tl,10);
        if ($mintime) {
            &rb_printlog("\nThe processing time of $tl file(s) in '$fldrpath' was longer than $mintime second(s) - now showing the $mtl longest");
            &rb_mlog("The processing time of $tl file(s) in '$fldrpath' was longer than $mintime second(s) - now showing the $mtl longest");
        }
        my $i = 0;
        my @toolong = sort { $toolong{$b} <=> $toolong{$a} } keys %toolong;
        while ( my $f = shift @toolong) {
            if ($mintime && (++$i <= $mtl)) {
                &rb_printlog("\n$f - $toolong{$f} s");
                rb_mlog("$f - $toolong{$f} s");
            }
            if ($movetime && $toolong{$f} > $movetime) {
                my $tofile = $f;
                my $base = $main::base;
                $tofile =~ s/^\Q$base\E\//$base\/rebuild_error\//;
                $main::unlink->($tofile);
                if ($main::move->($f,$tofile)) {
                    &rb_printlog("\nmoved file '$f' to '$tofile', because the processing time $toolong{$f} was longer than $movetime second(s)");
                    &rb_mlog("moved file '$f' to '$tofile', because the processing time $toolong{$f} was longer than $movetime second(s)");
                } else {
                    my $error = $!;
                    &rb_printlog("\ncan't moved file '$f' to '$tofile', the processing time $toolong{$f} was longer than $movetime second(s) - $error");
                    &rb_mlog("can't moved file '$f' to '$tofile', the processing time $toolong{$f} was longer than $movetime second(s) - $error");
                }
            }
        }
    }

# &rb_printlog( "\nfolder $flr: " . &rb_commify($SpamWordCount) . " spam weight \nfolder $flr: " . &rb_commify($HamWordCount) . " non-spam weight." );
    &rb_printlog("\nFinished in ".&rb_commify($processFolderTime)." second(s)\n");
    &rb_mlog("Finished in ".&rb_commify($processFolderTime)." second(s)");

    $scanTime += $processFolderTime;
    $scanFiles += $pcount;

    return $count;
} ## end sub processfolder

sub rb_countfiles {
    my ($fldrpath) = @_;
    my %fileCount;
    map {$fileCount{$_} = 1;} $main::unicodeDH->($fldrpath);
    delete $fileCount{'.'};
    delete $fileCount{'..'};
    return scalar(keys %fileCount);
}

sub rb_commify {
    local $_ = shift;
    1 while s/^([-+]?\d+)(\d{3})/$1,$2/o;
    return $_;
}

sub rb_hash {
    my $msgText = shift;

    # creates a md5 hash of $msg body
    if ( $$msgText =~ /^.*?\n\r?\n(.+)$/so ) {
        return eval{ Digest::MD5::md5_hex(substr($1,0,$main::MaxBytes)); };
    } else {
        return eval{ Digest::MD5::md5_hex(substr($$msgText,0,$main::MaxBytes)); };
    }
}

sub rb_dospamhash {
    my ( $FileName, $msgText ) = @_;
    $SpamHash{ &rb_hash($msgText) }++;
    return 0;
}

sub rb_dohamhash {
    my ( $FileName, $msgText ) = @_;
    $HamHash{ &rb_hash($msgText) }++;
    return 0;
}

sub rb_donohash {
    return 0;
}

sub rb_checkspam {
    my ( $FileName, $msgText ) = @_;
    my ( $return, $reason );
    if ( defined( $HamHash{ &rb_hash($msgText) } ) ) {

# we've found a message in the spam database that is the same as one in the corrected Ham group
        &rb_deletefile( $FileName, "corrected ham" );
        return 1;
    }
    elsif ( $reason = &rb_redlisted( $msgText ) ) {
        &rb_deletefile( $FileName, $reason );
        return 1;
    }
    elsif ( $reason = &rb_whitelisted( $msgText ) ) {
        &rb_deletefile( $FileName, $reason );
        return 1;
    }
    return 0;
}

sub rb_checkham {
    my ( $FileName, $msgText ) = @_;
    my ( $return, $reason );
    if ( defined( $SpamHash{ &rb_hash($msgText) } ) ) {

# we've found a message in the ham database that is the same as one in the corrected spam group
        &rb_deletefile( $FileName, "corrected spam" );
        return 1;
    }
    elsif ( $reason = &rb_redlisted( $msgText ) ) {
        &rb_deletefile( $FileName, "$reason" );
        return 1;
    }
    return 0;
}

sub rb_whitelisted {
    my $mm = shift;
    my $m = substr($$mm,0,$main::MaxBytes + 1000);
    my ( %seenf, %seent );

    # test against expression to recognize whitelisted mail
    my $mwr = $main::whiteReRE;
    if ( $main::whiteRe && $m =~ /($mwr)/ ) {
        my $reason = $1;
        $reason =~ s/\s+$/ /go;
        $reason =~ s/[\r\n\s]+/ /go;
        if ( length($reason) >= $main::RegExLength ) { $reason = substr( $reason, 0, ( $main::RegExLength - 4 ) ) . "..." }
        $WhiteCount++;
        return ( "Regex:White '" . $reason . q{'} );
    }
    $m =~ s/^($main::HeaderNameRe:$main::HeaderValueRe)+/$1/so;    # remove body

    my (@to,@from);
    while ( $m =~ /($main::HeaderNameRe):($main::HeaderValueRe)/igos ) {
        my ($h,$s) = ($1,$2);
        die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};
        if ($h =~ /^(?:from|sender|X-Assp-Envelope-From|reply-to|errors-to|list-\w+)$/io) {
            &main::headerUnwrap($s);
            next unless ($s =~ /($main::EmailAdrRe\@$main::EmailDomainRe)/io);
            push @from , &main::batv_remove_tag(0,lc($1),'');
        }
        if ($h =~ /^(?:to|X-Assp-Intended-For)$/io) {
            &main::headerUnwrap($s);
            next unless ($s =~ /($main::EmailAdrRe\@$main::EmailDomainRe)/io);
            push @to , &main::batv_remove_tag(0,lc($1),'');
        }
    }
    while (my $curaddr = shift @from) {
        die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};

        if ( exists $seenf{ $curaddr } ) {
            next;                #we already checked this address
        } else {
            $seenf{ $curaddr } = 1;
        }
        foreach (@to) {
            if ( exists $seent{ $_ } ) {
                next;                #we already checked this address
            } else {
                $seent{ $_ } = 1;
            }
            if ( &main::Whitelist($curaddr,$_)) {
                $WhiteCount++;
                return ( "WhiteList: '$curaddr,$_'" );
            }
            if ($main::wildcardUser) {
                my ( $mfdd, $alldd, $reason );
                $mfdd = $1 if $curaddr =~ /(\@[^@]*)/o;
                $alldd = "$main::wildcardUser$mfdd";
                if ( &main::Whitelist( lc $alldd , $_) ) {
                    $WhiteCount++;
                    return ( "WhiteList-Wild: '$curaddr,$_'" );
                }
            }
        }
        %seent = ();
        if ($main::whiteListedDomains && &main::matchRE([$curaddr],'whiteListedDomains',1)) {
            $WhiteCount++;
            return ( "WhiteListed Domain: '" . $curaddr . q{'} );
        }
    } ## end while
    return 0;
} ## end sub whitelisted

sub rb_redlisted {
    my $mm = shift;
    my $m = substr($$mm,0,$main::MaxBytes + 1000);

    # test against expression to recognize redlisted mail
    if ( $main::DoNotCollectRedRe ) {    #skip Redre check, 1.3.5 and higher
        my $mrR = $main::redReRE;
        if ( $main::redRe && $m =~ /($mrR)/ ) {
            my $reason = $1;
            $reason =~ s/\s+$/ /go;
            $reason =~ s/[\r\n\s]+/ /go;
            if ( length($reason) >= $main::RegExLength ) { $reason = substr( $reason, 0, ( $main::RegExLength - 4 ) ) . "..." }
            $RedCount++;
            return ( "Regex:Red '" . $reason . q{'} );
        }
    }
    if ( $main::DoNotCollectRedList ) {    #skip Redlist check, 1.3.5 and higher
        $m =~ s/\n\r?\n.*$//so;                            # remove body
        while ( $m =~ /($main::EmailAdrRe\@$main::EmailDomainRe)/igo ) {
            my $curaddr = lc($1);
            die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};

            if ( $main::Redlist{ $curaddr } ) {
                $RedCount++;
                return ( "redlist: '" . $curaddr . q{'} );
            }
        }
    }
    return 0;
} ## end sub redlisted

sub rb_deletefile {
    my ( $fn, $reason, $ignorekeepdeleted ) = @_;

    if ( $main::eF->( $fn )) {
        &rb_printlog( "\nremove " . $fn . q{ } . $reason );
        if (! $main::RebuildTestMode) {
            if ( $main::MaxKeepDeleted && !$ignorekeepdeleted ) {
                $Trashlist{$fn} = time;
            } else {
                $main::unlink->($fn);
            }
        }
    } else {
        rb_printlog("\ncannot delete " . $reason . " message " . $fn . ": $!" );
    }
}

sub rb_get {
    my ( $fn, $sub , $factor) = @_;
    my $message;
    my $count;
    my $numreadchars;
    my $headlen;
    my $mBytes = $main::MaxBytes || 4000;
    my $ftime = &main::ftime($fn);
    return unless $ftime;
    my $dtime = $ftime - time;
    my $bodybytes = $mBytes * (($factor > 1) ? 4 : 2);

    return if $dtime > 0 or exists $Trashlist{$fn};
    my $file;
    $main::open->($file, '<', "$fn" ) or return;

    $file->binmode;
    $numreadchars = ($main::HeaderMaxLength ? $main::HeaderMaxLength : 10000) + $bodybytes;
#rb_d("rb_get - $fn - to read - $numreadchars - $file");
    $count = $file->read( $message, $numreadchars );    # read characters into memory
#rb_d("rb_get - $fn - read");
    eval{$file->close;};
    if ($count) {
        my @keep = $message =~ /((?:X-Assp-Reported-By|X-Assp-Intended-For|X-Forwarded-For):$main::HeaderValueRe)/gois;
        $message =~ s/X-ASSP[^:]+:$main::HeaderValueRe//gois;                   # remove all X-ASSP headers
        $message =~ s/(?:DKIM|DomainKey)-Signature:$main::HeaderValueRe//gios;  # remove DKIM/DomainKey signatures
        $message = join('',@keep).$message;
        $headlen = index($message, "\x0D\x0A\x0D\x0A");
        if ($headlen >= 0) {$headlen += 4;} else {$headlen = 0;}
        $message = substr($message, 0, $headlen + $bodybytes);
    } else {
        return;
    }
    return if $sub->( $fn, \substr($message, 0, $headlen + $mBytes ) );   # have i read this before?

    $processedBytes += length $message;
    return \$message, $headlen;
}

sub rb_checkRunTime {
    my ($StartTime, $text) = @_;
    return 0 unless $movetime;
    $rtText = $text if $text;
    return 0 if Time::HiRes::time() <= ($StartTime + $movetime);
    rb_d($rtText);
    return 1;
}

sub rb_add {
    my ( $isspam, $fn, $factor, $sub, $spam ,$spamHMM, $hamHMM, $heloOnly) = @_;
    return if $main::dF->( $fn );
    my $startTime = Time::HiRes::time();
    my ($content,$headerlen) = &rb_get( $fn, $sub , $factor);
    return unless $content;
    return if (rb_checkRunTime($startTime,"reached $movetime s after rb_get on $fn"));
    my $imgHash;
    my $fsize = [$main::stat->( $fn )]->[7];
    if ($doattach && ! $heloOnly && ($fsize < $main::npSize) && ! exists $Trashlist{$fn.'.att'}) {
        $imgHash = &main::AttachMD5File($fn);
        $processedBytes += $fsize;
        if (rb_checkRunTime($startTime,"reached $movetime s after AttachMD5File on $fn")) {
            $Trashlist{$fn.'.att'} = time + (3600 * 24 * 5);
            $startTime = Time::HiRes::time();
            rb_printlog("\nfile '$fn' will be skipped from attachment processing in future rebuild tasks" );
            rb_mlog("file '$fn' will be skipped from attachment processing in future rebuild tasks" );
        }
    } elsif ($doattach && ! $heloOnly && ($fsize < $main::npSize)) {
        rb_printlog("\nfile '$fn' was skipped from attachment processing" );
        rb_mlog("file '$fn' will was skipped from attachment processing" );
    }
    my ( $curHelo, $CurWord, $PrevWord, $sfac, $tfac, $cip, $cipHelo );

    my $IPprivate = $main::IPprivate;
    my ($reportedBy,$domain);
    my $header;
    $header = substr($$content,0,$headerlen);
    if ($header) {
        $reportedBy = lc $1 if ($header =~ /X-Assp-Reported-By:\s*($main::EmailAdrRe\@$main::EmailDomainRe)/io);
        $reportedBy ||= lc $1 if ($header =~ /X-Assp-Intended-For:\s*($main::EmailAdrRe\@$main::EmailDomainRe)/io);
        $reportedBy ||= lc $1 if ($header =~ /^to:.*?($main::EmailAdrRe\@$main::EmailDomainRe)/io);
        ($domain) = $reportedBy =~ /(\@$main::EmailDomainRe)$/o;
        $reportedBy = '' unless (($main::DoPrivatSpamdb & 1) && &main::localmailaddress(0,$reportedBy));
        $domain = '' unless ($main::DoPrivatSpamdb > 1 && &main::localdomainsreal($domain));
        if ( $header =~ /X-Forwarded-For: ($IPRe)/io) {
            $cip = $1;
    		while ( $header =~ /Received:($main::HeaderValueRe)/gis ) {
                my $h = $1;
                if ( $h =~ /\s+from\s+(?:(\S+)\s)?(?:.+?)\Q$cip\E\]?\)(.{1,80})by.{1,20}/gis ) {
                    $cipHelo = $1;
                    $curHelo = $1 if $1;
                    my $rhelo = $2;
                    $cip = &main::ipv6expand(&main::ipv6TOipv4($cip));
                    $rhelo =~ s/\r?\n/ /go;
                    $curHelo = $cipHelo = $1 if $rhelo =~ /.+?helo\s*=?\s*([^\s\)]+)/io;
                }
            }
            if ($cip && &main::matchIP($cip,'ispip','',1)) {
                $cipHelo = '';
                $curHelo = '';
                $cip = '';
            }
        } elsif ( $main::ispHostnames ) {
            while ( $header =~ /Received:($main::HeaderValueRe)/gios ) {
                my $h = $1;
                if ( $h =~ /\s+from\s+(?:(\S+)\s)?(?:.+?)($IPRe)(.{1,80})by.{1,20}(?:$main::ispHostnamesRE)/gios ) {
                    $cip = $2;
                    $cipHelo = $1 || $cip;
                    my $rhelo = $3;
                    if ($cip =~ /$IPprivate/o) {
                        $cipHelo = '';
                        $rhelo = '';
                        next;
                    }

                    $cip = &main::ipv6expand(&main::ipv6TOipv4($cip));
                    $rhelo =~ s/\r?\n/ /gos;
                    $cipHelo = $1 if $rhelo =~ /helo\s*=?\s*([^\s\)]+)/io;
                }
            }
            if ($cip && &main::matchIP($cip,'ispip','',1)) {
                $cipHelo = '';
                $curHelo = '';
                $cip = '';
            }
        }

        my @myNames = ($main::myName);
        push @myNames , split(/[\|, ]+/o,$main::myNameAlso);
        my $myName = join('|', map {my $t = quotemeta($_);$t;} @myNames);

        if (   $myName
            && ! ($cipHelo or $curHelo)
            && $header =~ /Received: from (\S+).{1,20}\(\[($IPRe)(.{1,80})by.{1,20}(?:$myName)/is)
        {
            $curHelo = $1 || $2;
            my $ip = $2;
            my $rhelo = $3;
            if ($ip !~ /$IPprivate/o) {
                $cip = &main::ipv6expand(&main::ipv6TOipv4($ip));
                $rhelo =~ s/\r?\n/ /gos;
                $curHelo = $1 if $rhelo =~ / helo=([^\s\)]+)/io;
                if ($cip && &main::matchIP($cip,'ispip','',1)) {
                    $curHelo = '';
                    $cip = '';
                }
                if ($curHelo && $curHelo =~ /$main::ispHostnamesRE/) {
                    $curHelo = '';
                    $cip = '';
                }
            } else {
                $curHelo = '';
            }
        }
    }
    return if (rb_checkRunTime($startTime,"reached $movetime s after HELO parsing on $fn"));

    $cipHelo = lc($cipHelo);
    $curHelo = lc($curHelo);
    $cipHelo = '' if $cipHelo eq $curHelo;
    $Helo{ $cipHelo } += ( $isspam * 999999 + 1 ) * $factor if ( $cipHelo );
    $Helo{ $curHelo } += ( $isspam * 999999 + 1 ) * $factor if ( $curHelo );
    return 1 if $heloOnly;

    $$content =~  s/(?:X-Assp-Reported-By|X-Assp-Intended-For|X-Forwarded-For):$main::HeaderValueRe//gois;
    my $OK;
    ($content,$OK) = &main::clean($content);
    return if (rb_checkRunTime($startTime,"reached $movetime s after content cleanup on $fn"));
    my $BayesCont = $main::BayesCont;
    my @HMMhamWords;
    my @HMMspamWords;
    my $i = 0;
    foreach (keys %$imgHash) {
        if   ($isspam) { $SpamWordCount += $factor;}
        else           { $HamWordCount  += $factor;}
        ( $sfac, $tfac ) = split( q{ }, $spam->{ $_ } );
        $sfac += $isspam ? ($factor * 2) : 0;
        $tfac += ($factor * 2);
        $spam->{ $_ } = "$sfac $tfac";
        $i++;
        if ($reportedBy) {
            ( $sfac, $tfac ) = split( q{ }, $spam->{ "$reportedBy $_" } );
            $sfac += $isspam ? $factor : 0;
            $tfac += $factor;
            $spam->{ "$reportedBy $_" } = "$sfac $tfac";
        }
        if ($domain) {
            ( $sfac, $tfac ) = split( q{ }, $spam->{ "$domain $_" } );
            $sfac += $isspam ? $factor : 0;
            $tfac += $factor;
            $spam->{ "$domain $_" } = "$sfac $tfac";
        }
    }
    $attachments += $i;
    if ($doattach && $i) {
        rb_d("$i ".($isspam ? 'spam-' : 'ham-')."attachment/image entries processed in file $fn");
    }
    my $j = 0;
    rb_checkRunTime($startTime,"reached $movetime s in Bayes word pairs on $fn");
    my $ret = 1;
    while ( $content =~ /([$BayesCont]{2,})/go ) {
        my @Words;
        (@Words = &main::BayesWordClean($1)) or next;
        while ($CurWord = shift @Words) {
            $CurWord = substr($CurWord,0,37) if length($CurWord) > 37;
            if ( ! $PrevWord ) {            # We only want word pairs
                $PrevWord = $CurWord;
                push(@HMMspamWords,$CurWord) if $DoHMM && $isspam;
                push(@HMMhamWords,$CurWord) if $DoHMM && ! $isspam;
                $i++;
                next;
            }

            # increment global weights, they are not really word counts
            if   ($isspam) { $SpamWordCount += $factor; push(@HMMspamWords,$CurWord) if $DoHMM && $i < $main::HMMDBWords;}
            else           { $HamWordCount  += $factor; push(@HMMhamWords,$CurWord) if $DoHMM && $i < $main::HMMDBWords;}
            ( $sfac, $tfac ) = split( q{ }, $spam->{ "$PrevWord $CurWord" } );
            $sfac += $isspam ? $factor : 0;
            $tfac += $factor;
            $spam->{ "$PrevWord $CurWord" } = "$sfac $tfac";
            if ($reportedBy) {
                ( $sfac, $tfac ) = split( q{ }, $spam->{ "$reportedBy $PrevWord $CurWord" } );
                $sfac += $isspam ? $factor : 0;
                $tfac += $factor;
                $spam->{ "$reportedBy $PrevWord $CurWord" } = "$sfac $tfac";
            }
            if ($domain) {
                ( $sfac, $tfac ) = split( q{ }, $spam->{ "$domain $PrevWord $CurWord" } );
                $sfac += $isspam ? $factor : 0;
                $tfac += $factor;
                $spam->{ "$domain $PrevWord $CurWord" } = "$sfac $tfac";
            }
            $PrevWord = $CurWord;
            $i++;
        }
        if ((++$j % 10 == 0) && rb_checkRunTime($startTime,'')) {$ret = undef; last;}
    } ## end while ( $content =~ /([$BayesCont]{2,})/go)
    if ($DoHMM) {
#        &rb_mlog( 'Rebuild: adding HMM: H = ' .scalar(@HMMhamWords).', S = '.scalar(@HMMspamWords).' words'.' P = '.$reportedBy);
        eval {
            if ($reportedBy && $isspam && @HMMspamWords > $main::HMMSequenceLength) {$spamHMM->seed(symbols => \@HMMspamWords, count => $factor, privacy => $reportedBy);}
            if ($reportedBy && !$isspam && @HMMhamWords > $main::HMMSequenceLength) {$hamHMM->seed(symbols => \@HMMhamWords, count => $factor, privacy => $reportedBy);}
            if ($domain && $isspam && @HMMspamWords > $main::HMMSequenceLength) {$spamHMM->seed(symbols => \@HMMspamWords, count => $factor, privacy => $domain);}
            if ($domain && !$isspam && @HMMhamWords > $main::HMMSequenceLength) {$hamHMM->seed(symbols => \@HMMhamWords, count => $factor, privacy => $domain);}
            if ($isspam && @HMMspamWords > $main::HMMSequenceLength) {$spamHMM->seed(symbols => \@HMMspamWords, count => $factor, privacy => '');}
            if (!$isspam && @HMMhamWords > $main::HMMSequenceLength) {$hamHMM->seed(symbols => \@HMMhamWords, count => $factor, privacy => '');}
            1;
        } or do{$DoHMM = 0;};    # stop HMM if we get an exception while processing (possibly file too large)
    }
    return $ret;
} ## end sub add

sub rb_printlog {
    my ( $text, $format, $notime ) = @_;
    my $lf = '';
    $lf = $1 if $text =~ s/^(\n+)//o;
    if ( ! $format ) {
        if ($text) {
            my $t = $notime ? '' : &main::timestring();
            print { $RebuildLog } $lf . $t . " $text" if ! $onlyNewCorrected;
            &main::d($text);
        } else {
            print { $RebuildLog } $lf if ! $onlyNewCorrected;
        }
    } else {
        if ($text) {
            my $t = $notime ? ' ' : &main::timestring().' ';
            print { $RebuildLog } $lf . $t if ! $onlyNewCorrected;
            printf $RebuildLog "$text", $format if ! $onlyNewCorrected;
            &main::d(sprintf("$text", $format));
        } else {
            print { $RebuildLog } $lf if ! $onlyNewCorrected;
        }
    }
    return;
}

sub rb_mlog {
    my ( $text, $format ) = @_;
    rb_d( $text, $format ) if $RebuildDebug;
    return unless $main::MaintenanceLog;
    if ( !$format ) {
        &main::mlog(0, "$text");
    }
    if ($format) {
        &main::mlog(0,(sprintf "$text", $format));
    }
    return;
}

sub rb_d {
    my ( $text, $format, $notime ) = @_;
    return if (! $RebuildDebug);
    my $t;
    $t = &main::timestring().' ' unless $notime;
    if ( !$format ) {
        print $RebuildDebug "$t$text\n";
    }
    if ($format) {
        print $RebuildDebug sprintf("$t$text\n", $format);
    }
    return;
}

sub rb_uploadgriplist {
    local $/ = "\n";

    &main::checkDBCon() if ($main::CanUseTieRDBM && $main::DBisUsed);

    &rb_printlog("building new GripList records and bounce report\n") if !$main::noGripListUpload;
    &rb_mlog("building new GripList records and bounce report") if !$main::noGripListUpload;

    #&rb_printlog("Start building Griplist \n");
    my ( $date, $ip, $peeraddress, $hostaddress, $connect, $day, $gooddays, $last2days, $st );
    my ($logdir, $logdirfile) = $main::logfile=~/^(.*[\/\\])?(.*?)$/o;
    my @logfiles1=reverse sort( &main::Glob("$main::base/$logdir*$logdirfile") );
    my @logfiles;
    while (@logfiles1) {
        my $k = shift @logfiles1;
        push(@logfiles, $k) if $k !~ /b$logdirfile/;
    }

    #build list of the last 4 days
    my $time = time;
    $day = quotemeta(&main::timestring(undef,'d'));
    $gooddays  .= $day.'|';
    $last2days .= $day.'|';
    $day = quotemeta(&main::timestring( $time - 24 * 3600 , 'd'));
    $gooddays  .= $day.'|';
    $last2days .= $day;
    $day = quotemeta(&main::timestring( $time - 36 * 3600 , 'd'));
    $gooddays .= $day.'|';
    $day = quotemeta(&main::timestring( $time - 72 * 3600 , 'd'));
    $gooddays .= $day;
    undef $day;

    my $dayoffset = $time % ( 24 * 3600 );
    my %bounces = ();
    my $nbounces = 0;
    my $bbounces = 0;
    my $IPprivate = $main::IPprivate;
    while (@logfiles) {
        my $File = shift @logfiles;
        my $ftime = &main::ftime($File) || time;
        next if ( ( $ftime + 4 * 24 * 3600 ) < ( $time - $dayoffset ) );
        &rb_printlog("processing Logfile $File\n");
        &rb_mlog("processing Logfile $File");
        next unless (open( my $FLogFile, '<', "$File" ));
        while (<$FLogFile>) {
            if ( ( $ip ) = /(?:$gooddays) .*\s($IPRe)[ \]].* to: \S+/i) {
                next if $ip =~ /$IPprivate/o;                         # ignore private IP ranges
                next if &main::matchIP($ip,'acceptAllMail',0,1);
                $ip = &main::ipNetwork($ip, 1);
                if (! $main::noGripListUpload && /$main::HamTagRE/io) {

                    #Good IP
                    $GpCnt{ $ip } += 1;
                    $GpOK{ $ip }  += 1;
                } elsif (! $main::noGripListUpload && /$main::SpamTagRE|\[PenaltyDelay\]/o)
                {
                    next if /\[PersonalBlack\]/io;
                    #Bad IP
                    $GpCnt{ $ip } += 1;
                }
            }
            next if $main::DoNotCollectBounces;
            my $to;
            if (/^(?:$last2days) .+?\[isbounce\].+?bounce message detected/i) {
                $nbounces++;
                next;
            }
            ($to) = $1 if (/^(?:$last2days) .*?\[isbounce\].*?\sto:\s(\S+)\s/i);
            ($to) = $1 if (! $to && /^(?:$last2days) .*?\sto:\s(\S+)\s\[spam found\].*?failed for bounce sender/i );
            $to =~ s/\>+$//o;
            $to =~ s/^\<+//o;
            next unless $to;
            $bbounces++;
            $bounces{lc $to}++;
        }
        eval{close $FLogFile;};
    }
    $nbounces = &main::max($nbounces,$bbounces);
    if (! $main::DoNotCollectBounces && $nbounces) {
        my $pd = $main::EnableDelaying ? ' (possibly delayed)' : '';
        &rb_printlog("\nbounce report for the last two days: $nbounces bounces received$pd - $bbounces bounces blocked\n");
        &rb_printlog("\nlist of the top ten local addresses with blocked bounces in the last two days:\n\n") if $bbounces;
        my $i = 0;
        foreach my $adr ( sort { $bounces{$b} <=> $bounces{$a} } keys %bounces) {
            &rb_printlog("$adr : $bounces{$adr}\n",'',1);
            last if ++$i > 10;
        }
        &rb_printlog("\nend of bounce report\n\n");
    } elsif (! $main::DoNotCollectBounces) {
        &rb_printlog("\nbounce report for the last two days: no bounces received\n\n");
    } else {
        &rb_printlog("\nskipping bounce report because 'DoNotCollectBounces' is switched ON\n\n");
    }
    return if $main::noGripListUpload;

    if ( !%GpCnt ) {
        &rb_printlog("Skipping GrIPlist upload. Not enough messages processed.\n");
        &rb_mlog("Skipping GrIPlist upload. Not enough messages processed.");
        return;
    }
    my ($n6, $n4) = (0,0);
    while (my ($k,$v) = each %GpCnt) {
        next if (!$v);
        if (/:/o) {
            $n6++;
        }
        else {
            $n4++;
        }
    }
    $st = pack("N2", $n6 / 2**32, $n6);
    $st .= pack("N", $n4);
    my ($st6,$st4);
    while (my ($k,$v) = each %GpCnt) {
        next if (!$v);
        if ($k !~ /:/o) {
            my $ip = $k;
            $ip =~ s/([0-9a-f]*):/0000$1:/gio;
            $ip =~ s/0*([0-9a-f]{4}):/$1:/gio;
            $st6 .= pack("H4H4H4H4", split(/:/o, $ip));
            $st6 .= pack("C", (1 - $GpOK{$k} / $v) * 255);
        } else {
            $st4 .= pack("C3C", split(/\./o, $k), (1 - $GpOK{$k} / $v) * 255);
        }
    }
    $st .= $st6 . $st4;

    &main::downloadGripConf();  # reload the griplist.conf
    if ($main::proxyserver) {
        &rb_printlog("Uploading Griplist via Proxy: $main::proxyserver\n");
        &rb_mlog("Uploading Griplist via Proxy: $main::proxyserver");
        my $user = $main::proxyuser ? "$main::proxyuser:$main::proxypass\@": '';
        $peeraddress = $user . $main::proxyserver;
        $hostaddress = $main::proxyserver;
        $connect     = "POST $main::gripListUpUrl HTTP/1.0";
    } else {
        &rb_printlog("Uploading Griplist via Direct Connection\n");
        $peeraddress = $main::gripListUpHost . ':80';
        $hostaddress = $main::gripListUpHost;
        my ($url) = $main::gripListUpUrl =~ /http:\/\/[^\/](\/.+)/oi;
        $connect     = <<"EOF";
POST $url HTTP/1.1
User-Agent: ASSP/$main::MAINVERSION ($^O; Perl/$];)
Host: $main::gripListUpHost
EOF
    }

    if ($main::RebuildTestMode) {
        &rb_printlog("unable to connect to $main::gripListUpHost to upload griplist\n");
        &rb_mlog("unable to connect to $main::gripListUpHost to upload griplist");
        return;
    }

    my $socket = $main::CanUseIOSocketINET6
                ? IO::Socket::INET6->new(Proto=>'tcp',PeerAddr=>$peeraddress,Timeout=>2,&main::getDestSockDom($hostaddress))
                : IO::Socket::INET->new(Proto=>'tcp',PeerAddr=>$peeraddress,Timeout=>2);

    if ( defined $socket ) {
        my $len = length($st);
        $connect .= <<"EOF";
Content-Type: application/x-www-form-urlencoded
Content-Length: $len

$st
EOF
        eval{$socket->blocking(0);};
        &main::NoLoopSyswrite( $socket , $connect, 0);
        sleep(1);
        eval{$socket->sysread($main::SMTPbuf, 4096);};
        $main::SMTPbuf = '';
        eval{$socket->close;};
        $len = &rb_commify($len);
        $n6 = &rb_commify($n6);
        $n4 = &rb_commify($n4);
        &rb_printlog("Submitted $len bytes: $n6 IPv6 addresses, $n4 IPv4 addresses\n");
        &rb_mlog("Submitted $len bytes: $n6 IPv6 addresses, $n4 IPv4 addresses");
    }
    else {
        &rb_printlog("unable to connect to $main::gripListUpHost to upload griplist\n");
        &rb_mlog("unable to connect to $main::gripListUpHost to upload griplist");
    }
    return;
} ## end sub uploadgriplist

sub rb_fixPath {
    my ($path) = @_;
    my $len = length($path);
    if   ( !substr( $path, ( $len - 1 ), 1 ) eq q{/} ) { return $path . q{/}; }
    else                                               { return $path; }
}

sub rb_move2num {
    &rb_movefiles('spamlog',$main::maillogExt);
    &rb_movefiles('notspamlog',$main::maillogExt);
    &rb_movefiles('correctednotspam',$main::maillogExt);
    &rb_movefiles('correctedspam',$main::maillogExt);
}

sub rb_movefiles {
    my ($foldername,$ext) = @_;
    my $folder = $main::base.'/'.${'main::'.$foldername};
    my $c=1;
    &rb_printlog("'move to num' started for $foldername\n");
    &rb_mlog("'move to num' started for $foldername");
    for my $fn ($main::unicodeDH->($folder)) {
        $fn = $folder.'/'.$fn;
        die "warning: got stop request from MainThread" unless $main::ComWorker{$Iam}->{run};
        next if $main::dF->( $fn );
        next if $fn=~/\/(\d+)$ext$/i && $1 < $main::MaxFiles;
        $c++;
        my $fn0=$fn;
        while ($c < $main::MaxFiles && [$main::stat->( "$folder/$c$main::maillogExt")]->[7]) {$c++}
        my $d=$c<$main::MaxFiles? $c: int(rand()*$main::MaxFiles);
        $fn=~s#/[^/]*$#/$d$ext#;
        $main::unlink->("$fn");
        $main::rename->("$fn0","$fn");
    }
    &rb_printlog("'move to num' processed $c files in $foldername\n");
    &rb_mlog("'move to num' processed $c files in $foldername");
}

sub rb_cleanTrashlist {
    my $files_before = my $files_deleted = 0;
    my $t = time;
    my $mcount;

    while ( my ( $k, $v ) = each(%Trashlist) ) {
        $files_before++;
        my $f = $k;
        $f =~ s/\.att$//o;
        if ($main::eF->( "$f" )) {
            if (  $t - $v >= $main::MaxKeepDeleted * 3600 * 24 )
            {
                &rb_deletefile ($f,"Trashlist",1);
                delete $Trashlist{$k} unless $main::RebuildTestMode;
                delete $Trashlist{$f} unless $main::RebuildTestMode;
                $files_deleted++;
            }
        } else {
            delete $Trashlist{$k} unless $main::RebuildTestMode;
            delete $Trashlist{$f} unless $main::RebuildTestMode;
            $files_deleted++;
        }
    }
    if ($files_before>0) {
        &rb_printlog("\nTrashlist cleaning finished, $files_deleted of $files_before files deleted\n");
        &rb_mlog("info: Trashlist cleaning finished, $files_deleted of $files_before files deleted");
    }
}

1;

#RBEOT
close $ADV;
$ComWorker{$WorkerNumber}->{rb_version} = $rb_version;
return 1;
}

#__DATA__

no ASSP_DEF_VARS;

sub validateModule {
    my $module = shift;
    $module =~ s/^\s*use\s+//o;
    my $var; my $k;
    ($module, $var) = split(/\s+/o,$module,2);
    ($module, $k) = ($1,$2) if $module =~ /^([^\s()]+)(\(\))?$/o;
    delete $ModuleError{$module};
    $k = '()' if (! $k && ! $var && $module !~ s/\+$//o);
    return 1 if (eval("use $module$k $var;1;"));
    $ModuleError{$module} = $@;
    return 0;
}

sub defineCanUseModules {
    print "\t\t\t\t\t[OK]\nloading modules";
    print '.';

    %ModuleError = ();
    $AvailIOSocketINET6  = ($enableINET6 && $useIOSocketINET6) ? validateModule('IO::Socket::INET6+') : 0; # socket 6 IO module
    $CanUseIOSocketINET6 = $AvailIOSocketINET6 &&
      eval {
          my $sock = IO::Socket::INET6->new(Domain => AF_INET6, Listen => 1, LocalAddr => '[::]', LocalPort => $IPv6TestPort);
          if ($sock) {
              close($sock);
              $SysIOSocketINET6 = 1;
              1;
          } else {
              $AvailIOSocketINET6 = $SysIOSocketINET6 = 0;
              0;
          }
      };
    $CanUseThreadState   = $useThreadState ? validateModule('Thread::State') : 0;    # change thread priority
    $CanUseAvClamd       = $useFileScanClamAV ? validateModule('File::Scan::ClamAV') : 0;    # ClamAV module installed
    $AvailAvClamd        = $CanUseAvClamd;
    $CanUseLDAP          = $useNetLDAP ? validateModule('Net::LDAP') : 0;    # Net LDAP module installed
    print '.';
    $CanUseDNS           = $useNetDNS ? validateModule('Net::DNS') : 0;   # Net DNS module installed - required for SPF & RBL
    $AvailSPF2           = $useMailSPF ? validateModule('Mail::SPF') : 0;  # Mail SPF module installed
    $CanUseSPF2          = $AvailSPF2 && $CanUseDNS;  # SPF and dependancies installed
    print '.';
    $AvailSPF            = $useMailSPFQuery ? validateModule('Mail::SPF::Query') : 0;    # Mail SPF Query module installed
    $CanUseSPF           = $AvailSPF && $CanUseDNS; # SPF Query and dependancies installed
    $CanUseURIBL         = $CanUseDNS;                # URIBL and dependancies installed
    $CanUseRWL           = $CanUseDNS;                # RWL and dependancies installed
    print '.';
    $CanUseRBL           = $CanUseDNS;                # DNSBL and dependancies installed
    $AvailSRS            = $useMailSRS ? validateModule('Mail::SRS') : 0;  # Mail SRS module installed
    $CanUseSRS           = $AvailSRS;
    $AvailZlib           = $useCompressZlib ? validateModule('Compress::Zlib+') : 0;    # Zlib module installed
    $CanUseHTTPCompression  = $AvailZlib;
    $AvailMD5            = $useDigestMD5 ? validateModule('Digest::MD5+') : 0;   # Digest MD5 module installed
    $CanUseMD5Keys       = $AvailMD5;
    $AvailSHA1           = $useDigestSHA1 ? validateModule('Digest::SHA1 qw(sha1_hex)') : 0;   # Digest SHA1 module installed
    $CanUseSHA1          = $AvailSHA1;
    print '.';
    $AvailReadBackwards  = $useFileReadBackwards ? validateModule('File::ReadBackwards') : 0;    # ReadBackwards module installed;
    $CanSearchLogs       = $AvailReadBackwards;
    $AvailHiRes          = validateModule('Time::HiRes'); # Time::HiRes module installed;
    $CanStatCPU          = $AvailHiRes;
    $AvailIO             = $usePerlIOscalar ? validateModule('PerlIO::scalar+') : 0;    # make it chroot savy;
    $CanChroot           = $AvailIO;
    $AvailSyslog         = $useSysSyslog ? validateModule('Sys::Syslog qw( :DEFAULT setlogsock)') : 0;
    $CanUseSyslog        = $AvailSyslog;
    print '.';
    $useWin32APIOutputDebugString = $Config{useWin32APIOutputDebugString} = '' if ($^O ne 'MSWin32');
    $AvailWin32Debug     = $useWin32APIOutputDebugString ? validateModule('Win32::API::OutputDebugString qw(OutputDebugString DStr)') :0; # AZ: 2009-03-10 win32 debug/trace available
    $CanUseWin32Debug    = $AvailWin32Debug; # AZ: 2009-03-10 win32 debug/trace available
    $AvailTieRDBM        = $useTieRDBM ? validateModule('Tie::RDBM') : 0;    # Use external database
    $CanUseTieRDBM       = $AvailTieRDBM;
    $AvailDB_File        = $useDB_File ? validateModule('DB_File') : 0;    # Use external DB_File (Berkeley V1) database
    $CanUseDB_File       = $AvailDB_File;
    $AvailBerkeleyDB     = $useBerkeleyDB ? validateModule('BerkeleyDB') : 0;    # Use external Berkeley database
    $CanUseBerkeleyDB    = $AvailBerkeleyDB;
    print '.';
    $AvailCIDRlite       = $useNetCIDRLite ? validateModule('Net::CIDR::Lite') : 0;    # Net::CIDR::Lite module installed
    $CanUseCIDRlite      = $AvailCIDRlite;
    $AvailNetAddrIPLite  = $useNetAddrIPLite ? validateModule('NetAddr::IP::Lite()') : 0;    # NetAddr::IP::Lite module installed
    $CanUseNetAddrIPLite = $AvailNetAddrIPLite;
    $AvailNetIP          = $useNetIP ? validateModule('Net::IP()') : 0;    # Net::IP module installed
    $CanUseNetIP         = $AvailNetIP;

    $AvailLWP            = $useLWPSimple ? validateModule('LWP::Simple') && validateModule('HTTP::Request::Common') && validateModule('LWP::UserAgent') : 0;    # LWP::Simple module installed
    $CanUseLWP           = $AvailLWP;

    $AvailEMM            = $useEmailMIME ? validateModule('Email::MIME') : 0;  # Email::MIME module installed
    $CanUseEMM           = $AvailEMM;
    validateModule('MIME::Words()') if $CanUseEMM;
    $AvailMTY            = $useMIMETypes ? validateModule('MIME::Types') : 0;   # MIME::Types module installed
    $CanUseMTY           = $AvailMTY && $CanUseEMM;

    ${'Return::Value::NO_CLUCK'} = 1;   # prevent the cluck from Return::Value version 1.666002
    eval('use Return::Value();1;');
    $AvailEMS            = $useEmailSend ? validateModule('Email::Send') : 0;  # Email::Send module installed
    $CanUseEMS           = $AvailEMS;
    print '.';

    $AvailTNEF           = $useConvertTNEF ? validateModule('Convert::TNEF') : 0;  # Convert::TNEF module installed
    $CanUseTNEF          = $AvailTNEF && $CanUseMTY;

    $AvailDKIM           = $useMailDKIMVerifier ? validateModule('Mail::DKIM::Verifier') : 0;  # Mail::DKIM::Verifier module installed
    $CanUseDKIM          = $AvailDKIM;
    if ($CanUseDKIM) {validateModule('Mail::DKIM') ; validateModule('Mail::DKIM::Signer');}

    $AvailNetSMTP        = $useNetSMTP ? validateModule('Net::SMTP') : 0;  # Net::SMTP module installed
    $CanUseNetSMTP       = $AvailNetSMTP;

    $AvailNetSMTPTLS     = $useNetSMTPTLS ? validateModule('Net::SMTP::TLS') : 0;  # Net::SMTP::TLS module installed
    $CanUseNetSMTPTLS    = $AvailNetSMTPTLS;

    $AvailNetSNMPagent   = $useNetSNMPagent ?
    validateModule('NetSNMP::agent()') &&
    validateModule('NetSNMP::ASN()') &&
    validateModule('NetSNMP::default_store qq(:all)') &&
    validateModule('NetSNMP::agent::default_store qq(:all)')
     : 0 ;
    $CanUseNetSNMPagent  = $AvailNetSNMPagent;

    $AvailSchedCron      = $useScheduleCron ? validateModule('Schedule::Cron') : 0;  # Schedule::Cron module installed
    $CanUseSchedCron     = $AvailSchedCron;

    $AvailSysMemInfo     = $useSysMemInfo ? validateModule('Sys::MemInfo') : 0;  # Sys::MemInfo module installed
    $CanUseSysMemInfo    = $AvailSysMemInfo;

    $AvailSysCpuAffinity     = $useSysCpuAffinity ? validateModule('Sys::CpuAffinity') : 0;  # SSys::CpuAffinity module installed
    $CanUseSysCpuAffinity    = $AvailSysCpuAffinity;

    if ($CanUseIOSocketINET6) {
        $AvailIOSocketSSL    = $useIOSocketSSL ? validateModule('IO::Socket::SSL+') : 0;  # IO::Socket::SSL module installed
        $CanUseIOSocketSSL   = $AvailIOSocketSSL;
        validateModule('IO::Socket::INET6') if $CanUseIOSocketSSL;   # reimport the symbols in to namespace
    } else {
        $AvailIOSocketSSL    = $useIOSocketSSL ? validateModule('IO::Socket::SSL \'inet4\'') : 0;  # IO::Socket::SSL module installed
        $CanUseIOSocketSSL   = $AvailIOSocketSSL;
        validateModule('IO::Socket::INET') if $CanUseIOSocketSSL;   # reimport the symbols in to namespace
    }
    print '.';

    $AvailAuthenSASL    = $useAuthenSASL ? validateModule('Authen::SASL') : 0;  # Authen::SASL module installed
    $CanUseAuthenSASL   = $AvailAuthenSASL;

    if ($] ge '5.018000' && $useRegexOptimizer) {
        $useRegexOptimizer = $Config{useRegexOptimizer} = '';
        $useRegexpOptimizer = $Config{useRegexpOptimizer} = 1;
    }
    $AvailRegexOptimizer    = $useRegexOptimizer ? validateModule('Regex::Optimizer') : 0;  # Regex::Optimizer module installed
    if ($CanUseRegexOptimizer = $AvailRegexOptimizer) {$optReModule = 'Regex::Optimizer';};

    $AvailRegexpOptimizer   = $useRegexpOptimizer ? validateModule('Regexp::Optimizer()') : 0;  # Regexp::Optimizer module installed
    if (($CanUseRegexpOptimizer = $AvailRegexpOptimizer) && ! $CanUseRegexOptimizer ) {$optReModule = 'Regexp::Optimizer'; *{'Regexp::Optimizer::set'} = sub {};};

    $AvailASSP_WordStem    = $useASSP_WordStem ? validateModule('ASSP_WordStem()') : 0;  # ASSP_WordStem  module installed
    $CanUseASSP_WordStem   = $AvailASSP_WordStem;

    $AvailASSP_FC    = $useASSP_FC ? validateModule('ASSP_FC()') : 0;  # ASSP_FC  module installed
    $CanUseASSP_FC   = $AvailASSP_FC;

    $AvailASSP_SVG    = $useASSP_SVG ? validateModule('ASSP_SVG()') : 0;  # ASSP_SVG  module installed
    $CanUseASSP_SVG   = $AvailASSP_SVG;

    $AvailAsspSelfLoader   = $useAsspSelfLoader ? defined $AsspSelfLoader::VERSION : 0;  # AsspSelfLoader  module installed
    $CanUseAsspSelfLoader  = $AvailAsspSelfLoader;

    $AvailUnicodeGCString = $useUnicodeGCString ?  validateModule('Unicode::GCString()') : 0;  # Unicode::GCString  module installed
    $CanUseUnicodeGCString = $AvailUnicodeGCString;

    $AvailTextUnidecode = $useTextUnidecode ?  validateModule('Text::Unidecode()') : 0;  # Text::Unidecode  module installed
    $CanUseTextUnidecode = $AvailTextUnidecode;

    $CanUseWin32Unicode = $AvailWin32Unicode = ($useWin32Unicode && $] ge '5.012000') ? eval('
       if (   $^O eq \'MSWin32\'
           && defined ${chr(ord("\026") << 2)}
           && require Win32::Unicode
          )
       {
          $utf8 = sub {eval(\'Encode::_utf8_on($_[0]);\');};
          $unicodeFH = sub { $_[0] = Win32::Unicode::File->new; };
          $unicodeDH = sub { my $d = Win32::Unicode::Dir->new;my $c=shift;return unless $c;$utf8->($c);$d->open($c);my @l = $d->readdir;$d->close;return @l;};
          $open = sub {my @c=@_;return unless @c==3;$utf8->($c[2]);$unicodeFH->($_[0]);$_[0]->open($_[1],$c[2]);};
          $move = sub { my @c=@_;return unless @c==2;for(@c){$utf8->($_);};Win32::Unicode::File::moveW(@c); };
          $copy = sub { my @c=@_;return unless @c==2;for(@c){$utf8->($_);};Win32::Unicode::File::copyW(@c); };
          $unlink = sub { my $c=shift;return unless $c;$utf8->($c);Win32::Unicode::File::unlinkW($c); };
          $rename = sub { my @c=@_;return unless @c==2;for(@c){$utf8->($_);};Win32::Unicode::File::renameW(@c); };
          $eF = sub { my $c=shift;return unless $c;$utf8->($c);eval{Win32::Unicode::File::file_type(e => $c);}; };
          $dF = sub { my $c=shift;return unless $c;$utf8->($c);eval{Win32::Unicode::File::file_type(d => $c);}; };
          $stat = sub { my $c=shift;return unless $c;return unless $eF->($c);$utf8->($c);my @st; eval{@st = Win32::Unicode::File::statW($c);}; if ($@) {eval{@st = stat($c);};} return @st;};
          $mkdir = sub { my $c=shift; my $p=shift; return unless ($c && $p); return if $eF->($c); return if $dF->($c); $utf8->($c); Win32::Unicode::Dir::mkdirW($c)};
          $rmdir = sub { my $c=shift; return unless $c; return if ! $dF->($c); $utf8->($c); Win32::Unicode::Dir::rmdirW($c)};
          $rmtree = sub { my $c=shift; my @p=@_; return unless $c; return if ! $dF->($c); $utf8->($c); Win32::Unicode::Dir::rmtreeW($c,@p)};

          $unicodeName = sub {my $c=shift;return unless $c;$utf8->($c); eval(\'Win32::Unicode::File::CYGWIN\') ? Encode::encode_utf8($c) : Win32::Unicode::File::utf8_to_utf16(Win32::Unicode::File::catfile($c)) . Win32::Unicode::File::NULL;};
#          $unicodeName = sub {my $c=shift;return unless $c;$utf8->($c); Win32::Unicode::File::utf8_to_utf16(Win32::Unicode::File::catfile($c)) . Win32::Unicode::File::NULL;};
#          $unicodeName = sub {my $c=shift;return unless $c;$utf8->($c);Win32::Unicode::File::utf8_to_utf16(Win32::Unicode::File::catfile($c));};
          1;
       } else {
          0;
       }
    ') : 0;
    disableUnicode() unless $CanUseWin32Unicode;
    $canUnicode = $CanUseWin32Unicode || ($^O ne 'MSwin32' && $] ge '5.012000');
    print $canUnicode ? 'U' : 'u?';
    eval{${^WIDE_SYSTEM_CALLS} = 1;} if $canUnicode;

    if (open(my $F, '>', "$base/moduleLoadErrors.txt")) {
        binmode $F;
        my $error;
        while (my($k,$v) = each %ModuleError) {
            print $F "module $k could not be loaded (see error below): check with >perl -e \"use $k;\"\n$v\n\n\n";
            $error = $error ? 'errors are' : 'error was';
        }
        if ($error) {
            print "\t\t\t\t[failed] - $error written to file $base/moduleLoadErrors.txt\n";
        } else {
            print $F "There were no module load errors detected.\n";
            print "\t\t\t\t[OK]\n";
        }
        close $F;
    }

    if ($CanUseTieRDBM){
      print "loading database drivers\t";
      @DBdriverNames = DBI->available_drivers;
      $DBdrivers = join('|',@DBdriverNames);
    } else {
      @DBdriverNames = ();
    }
    $DBdrivers = 'BerkeleyDB|'.$DBdrivers if $CanUseBerkeleyDB;
    $DBdrivers = "no database drivers (DBD-\<driver\> are available on your system" unless $DBdrivers;
    $DBdrivers =~ s/\|$//o;
}

sub getChangedConfigValue {
    d('getChangedConfigValue');
    my @configs;
    {
        lock @changedConfig;
        threads->yield;
        @configs = @changedConfig;
        @changedConfig = ();
        threads->yield;
    }
    while (@configs) {
        my $line = shift @configs;
        $line =~ s/^\s+//o;
        $line =~ s/[\s\r\n]+$//o;
        my ($config,$value) = split(/\s*:=\s*/o,$line,2);
        if (exists $Config{$config}) {
            $ConfigChanged = changeConfigValue($config, $value) | $ConfigChanged;
        } elsif ($config =~ /^\&/o) {
            $line = $config.$value;
            my ($sub,$parm) = parseEval($line);
            if ($sub) {
                eval{$sub->($parm);};
                mlog(0,"error: running '$line' caused exception - $@") if ($@);
            } else {
                mlog(0,"error: unable to parse $line");
            }
        } else {
            my $old = $$config;
            $$config = $value;
            mlog(0,"info: internal variable '$config' changed from '$old' to '$value'");
        }
    }
}

sub changeConfigValue {
    my ($config, $value) = @_;
    d("changeConfigValue - $config");
    if (! $config || ! exists $Config{$config}) {
        mlog(0,"error: scheduled configuration change request for $config - $config is not a valid configuration parameter name");
        return;
    }
    my $ret;
    mlog(0,"info: scheduled configuration change request for $config");
    $qs{$config} = $value;
    $ActWebSess = 'Config_Schedule'.Time::HiRes::time();
    $WebIP{$ActWebSess}->{user} = 'root';
    my $error = checkUpdate($ConfigArray[$ConfigNum{$config}]->[0],$ConfigArray[$ConfigNum{$config}]->[5],$ConfigArray[$ConfigNum{$config}]->[6],$ConfigArray[$ConfigNum{$config}]->[1]);
    if ($error =~ /span class.+?negative/o) {
        $error =~ s/<b>(.+?)<\/b>/$1/o;
        mlog(0,"info: scheduled configuration change request failed for - $config - $error");
    } elsif ($error =~ /span class.+?positive/o) {
        my $text = (exists $cryptConfigVars{$config}) ? '' : " to ". $qs{$config};
        mlog(0,"info: changed config for - $config$text");
        $ret = 1;
    } else {
        mlog(0,"info: config unchanged - $config - ". $qs{$config});
    }
    delete $qs{$config};
    return $ret;
}

sub niceConfigPos {
 my $counterT = -1;
 my $num = 0;
 my $head;
 for my $idx (0...$#ConfigArray) {
   my $c = $ConfigArray[$idx];
   if(@{$c} == 5) {
      $counterT++;
      $num++;
      $head = $c->[4];
      $head =~ s/<a\s+href.*<\/a>//io;
   } else {
      $ConfigPos{$c->[0]} = $counterT;
      $ConfigNum{$c->[0]} = $num++;
      $glosarIndex{$c->[0]} = $head;
   }
 }
}

sub niceConfig {
 %ConfigNice = ();
 %ConfigDefault = ();
 %ConfigListBox = ();
 for my $idx (0...$#ConfigArray) {
      my $c = $ConfigArray[$idx];
      my $value;
      next if(@{$c} == 5) ;
      $ConfigNice{$c->[0]} =  ($c->[10] && $WebIP{$ActWebSess}->{lng}->{$c->[10]})
                              ? encodeHTMLEntities($WebIP{$ActWebSess}->{lng}->{$c->[10]})
                              : encodeHTMLEntities($c->[1]);
      $ConfigNice{$c->[0]} =~ s/<a\s+href.*<\/a>//io;
      $ConfigNice{$c->[0]} =~ s/'|"|\n//go;
      $ConfigNice{$c->[0]} =~ s/\\/\\\\/go;
      $ConfigNice{$c->[0]} = '&nbsp;' unless $ConfigNice{$c->[0]};
      $ConfigDefault{$c->[0]} = encodeHTMLEntities($c->[4]);
      $ConfigDefault{$c->[0]} =~ s/'|"|\n//go;
      $ConfigDefault{$c->[0]} =~ s/\\/\\\\/go;

      $value = ($qs{theButton} || $qs{theButtonX}) ? $qs{$c->[0]} : $Config{$c->[0]} ;
      $value = $Config{$c->[0]} if $qs{theButtonRefresh};

      if ($c->[3] == \&listbox) {
          $ConfigDefault{$c->[0]} = 0 unless $ConfigDefault{$c->[0]};
          foreach my $opt ( split( /\|/o, $c->[2] ) ) {
                my ( $v, $d ) = split( /:/o, $opt, 2 );
                $ConfigDefault{$c->[0]} = $d if ( $ConfigDefault{$c->[0]} eq $v );
                $ConfigListBox{$c->[0]} = $d if ( $value eq $v );
                $ConfigListBoxAll{$c->[0]}{$v} = $d;
          }
      } elsif ($c->[3] == \&checkbox) {
                $ConfigDefault{$c->[0]} = $ConfigDefault{$c->[0]} ? 'On' : 'Off';
                $ConfigListBox{$c->[0]} = $value ? 'On' : 'Off';
      } else {
          $ConfigDefault{$c->[0]} = '&nbsp;' unless $ConfigDefault{$c->[0]};
          $ConfigListBox{$c->[0]} = $value;
      }
 }
}

sub niceLink {
    my $c = shift;
    my $i = 0;
    my %v = ();
    while ($c =~ s/(\$[a-zA-Z][a-zA-Z0-9_{}\[\]\-\>]+)/\[\%\%\%\%\%\]/o) {
        my $var = $1;
        $v{$i} = eval($var);
        $v{$i} = $var unless defined $v{$i};
        $i++;
    }
    $i = 0;
    while ($c =~ s/\[\%\%\%\%\%\]/$v{$i}/o) {$i++}
    my $newline;
    foreach my $word (split(/ /o,$c)) {
         my $orgword = $word;
         $word =~ s/[^a-zA-Z0-9_]//go;
         if (exists $Config{$word} && ($rootlogin || ! $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.hidDisabled"})) {
              my $alt = $ConfigNice{$word};
              my $value = encodeHTMLEntities($ConfigListBox{$word});
              $value =~ s/'|"|\n//go;
              $value =~ s/\\/\\\\/go;
              $value = '&nbsp;' unless $value;
              $value = 'ENCRYPTED' if exists $cryptConfigVars{$word};
              my $default = exists $cryptConfigVars{$word} && $word ne 'webAdminPassword'? 'ENCRYPTED' : $ConfigDefault{$word};
              my $subst = "<a href=\"./#$word\" style=\"color:#684f00\" onmousedown=\"showDisp('$ConfigPos{$word}');gotoAnchor('$word');return false;\" onmouseover=\"window.status='$alt'; showhint('<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\'100%\\' bgcolor=lightyellow><tr><td>config var:</td><td>$word</td></tr><tr><td>description:</td><td>$alt</td></tr><tr><td>current value:</td><td>$value</td></tr><tr><td>default value:</td><td>$default</td></tr></table>', this, event, '450px', '1'); return true;\" onmouseout=\"window.status='';return true;\">$word</a>" ;
              $orgword =~ s/$word/$subst/;
         }
         $newline .= " $orgword";
    }
    return $newline;
}

sub setMainLang {

$lngmsghint{'msg500011'} = '# main form buttom hint 1';
$lngmsg{'msg500011'} = 'The CIDR notation is allowed(182.82.10.0/24).';

$lngmsghint{'msg500012'} = '# main form buttom hint 2';
$lngmsg{'msg500012'} = '<br />Text after the range (and before a numbersign) will be accepted as comment which will be shown in a match (for example: 182.82.10.0/24 Yahoo Groups #comment not shown).' ;

$lngmsghint{'msg500013'} = '# main form buttom hint 3';
$lngmsg{'msg500013'} = 'CIDR notation is accepted (182.82.10.0/24).' ;

$lngmsghint{'msg500014'} = '# main form buttom hint 4';
$lngmsg{'msg500014'} = '<br />Text after the range (and before a numbersign) will be accepted as comment to be shown in a match. For example:<br />182.82.10.0/24 Yahoo #comment to be removed<br />The short notation like 182.82.10. is only allowed for IPv4 addresses, IPv6 addresses must be fully defined as for example 2201:1::1 or 2201:1::/96<br />You may define a hostname instead of an IP, in this case the hostname will be replaced by all DNS-resolved IP-addresses, each with a /32 or /128 netmask. For example:<br />mta5.am0.yahoodns.net Yahoo #comment to be removed -&gt; 66.94.238.147/32 Yahoo|... Yahoo|... Yahoo<br />' ;

$lngmsghint{'msg500015'} = '# main form buttom hint 5';
$lngmsg{'msg500015'} = 'If Net::CIDR::Lite is installed, hyphenated ranges can be used (182.82.10.0-182.82.10.255).';

$lngmsghint{'msg500016'} = '# main form buttom hint 6';
$lngmsg{'msg500016'} = 'Hyphenated ranges can be used (182.82.10.0-182.82.10.255).';

$lngmsghint{'msg500017'} = '# main form buttom hint 7';
$lngmsg{'msg500017'} = 'For defining any full filepathes, always use slashes ("/") not backslashes. For example: c:/assp/certs/server-key.pem !<br /><br />';

$lngmsghint{'msg500018'} = '# main form buttom hint 8';
$lngmsg{'msg500018'} = <<EOT;
Fields marked with one small (<sup>s</sup>) - which are interval definitions - accept a single or a list of crontab entries separated by '|'. Such entries could be used to flexible schedule the configured task. An description of such crontab entries could be found in 'RebuildSchedule' and 'RestartSchedule'. Notice - this requires an installed <a href="http://search.cpan.org/search?query=Schedule::Cron" rel="external">Schedule::Cron</a> module in PERL.<br /><br />
Fields marked with at least one asterisk (*) accept a list separated by '|' (for example: abc|def|ghi) or a file designated as follows (path relative to the ASSP directory): 'file:files/filename.txt'.  Putting in the <i>file:</i> will prompt ASSP to put up a button to edit that file. <i>files</i> is the subdirectory for files. The file does not need to exist, you can create it by saving it from the editor within the UI. The file must have one entry per line; anything on a line following a numbersign or a semicolon ( # ;) is ignored (a comment).<br />
It is possible to include custom-designed files at any line of such a file, using the following directive<br />
<span class="positive"># include filename</span><br />
where filename is the relative path (from $base) to the included file like files/inc1.txt or inc1.txt (one file per line). The line will be internaly replaced by the contents of the included file!<br /><br />
Fields marked with two asterisk (**) contains regular expressions (regex) and accept a second weight value. Every weighted regex that contains at least one '|' has to begin and end with a '~' - inside such regexes it is not allowed to use a tilde '~', even it is escaped - for example:  ~abc<span class="negative"><b>\\~</b></span>|def~=>23 or ~abc<span class="negative"><b>~</b></span>|def~=>23 - instead use the octal (\\126) or hex (\\x7E) notation , for example <span class="positive">~abc\\126|def~=>23 or ~abc\\x7E|def~=>23</span> . Every weighted regex has to be followed by '=>' and the weight value. For example: Phishing\\.=>1.45|~Heuristics|Email~=>50  or  ~(Email|HTML|Sanesecurity)\\.(Phishing|Spear|(Spam|Scam)[a-z0-9]?)\\.~=>4.6|Spam=>1.1|~Spear|Scam~=>2.1 . The multiplication result of the weight and the penaltybox valence value will be used for scoring, if the absolute value of weight is less or equal 6. Otherwise the value of weight is used for scoring. It is possible to define negative values to reduce the resulting message score.<br />
For all "<span class="positive">bomb*</span>" regular expressions and "<span class="positive">invalidFormatHeloRe</span>", "<span class="positive">invalidPTRRe</span>" and "<span class="positive">invalidMsgIDRe</span>" it is possible to define a third parameter (to overwrite the default options) after the weight like: Phishing\\.=>1.45|~Heuristics|Email~=>50<span class="positive">:>N[+-]W[+-]L[+-]I[+-]</span>. The characters and the optional to use + and - have the following functions:<br />
use this regex (+ = only)(- = never) for: N = noprocessing , W = whitelisted , L = local , I = ISP mails . So the line ~Heuristics|Email~=>50:>N-W-LI could be read as: take the regex with a weight of 50, never scan noprocessing mails, never scan whitelisted mails, scan local mails and mails from ISP's (and all others). The line ~Heuristics|Email~=>3.2:>N-W+I could be read as: take the regex with a weight of 3.2 as factor, never scan noprocessing mails, scan only whitelisted mails even if they are received from an ISP .<br />
If the third parameter is not set or any of the N,W,L,I is not set, the default configuration for the option will be used unless a default option string is defined anywhere in a single line in the file in the form !!!NWLI!!! (with + or - is possible).<br />
<span class="negative">If any parameter that allowes the usage of weighted regular expressions is set to "block", but the sum of the resulting weighted penalty value is less than the corresponding "Penalty Box Valence Value" (because of lower weights) - only scoring will be done!</span><br />
If the regular expression optimization is used - ("perl module Regexp::Optimizer or ./lib/Regex/Optimizer.pm" installed and enabled) - and you want to disable the optimization for a special regular expression (file based), set one line (eg. the first one) to a value of '<span class="positive">assp-do-not-optimize-regex</span>' or '<span class="positive">a-d-n-o-r</span>' (without the quotes)! To disable the optimization for a specific line/regex, put &lt;&lt;&lt; in front and &gt;&gt;&gt; at the end of the line/regex. To weight such line/regex write for example: <span class="positive">&lt;&lt;&lt;</span>Phishing\\.<span class="positive">&gt;&gt;&gt;</span>=>1.45=>N- or ~<span class="positive">&lt;&lt;&lt;</span>Heuristics|Email<span class="positive">&gt;&gt;&gt;</span>~=>50  or  ~<span class="positive">&lt;&lt;&lt;</span>(Email|HTML|Sanesecurity)\\.(Phishing|Spear|(Spam|Scam)[a-z0-9]?)\\.<span class="positive">&gt;&gt;&gt;</span>~=>4.6 .<br /><br />
The literal 'SESSIONID' will be replaced by the unique message logging ID in every SMTP error reply.<br />
The literal 'MYNAME' will be replaced by the configuration value defined in 'myName' in every SMTP error reply.<br /><br />
If the internal name is shown in light blue like <span style="color:#8181F7">(uniqueIDPrefix)</span> , this indicates that the configured value differs from the defaut value. To show the default value, move the mouse over the internal name. An click on the internal name will reset the value to the default.<br /><br />
IP ranges are defined as for example 182.82.10.
EOT

$lngmsghint{'msg500019'} = '# main form buttom hint 9';
$lngmsg{'msg500019'} = <<EOT;
<br /><br />'kill -HUP $mypid' will load settings from disk. 'kill -NUM07 $mypid' will suspend or resume assp.  'kill -USR2 $mypid' will save settings to disk.
EOT

$lngmsghint{'msg500020'} = '# manage users form hint';
$lngmsg{'msg500020'} = <<EOT;
Use the "Continue" button as long as you only want to see or to temporary change any parameter.
Use the "Apply Changes" button to apply all changes, that are currenty shown, to the user.
All user names that begins with a "~" are templates. The template "~DEFAULT" can't be deleted.
All permissions of a user can refer to a template, in this case the permission of the template
belongs to the user. If the template permission is changed, all user permissions
that refers to that template will also be changed. Template permissions can never refer to an
another user or template. It is possible to copy all permissions of a template or an user to
another user or template. If "use LDAP / LDAP host" is filled with an IP-address or hostname
the local password will only be used, if the LDAPhost is not available. If a LDAP login is
successful, the LDAP-password will be stored as local password. It is possible to configure
multiple LDAP hosts separated by "|". To navigate use the alpha-index on the left site.
EOT

$lngmsghint{'msg500031'} = '# White/Redlist/Tuplets';
$lngmsg{'msg500031'} = <<EOT;
Do you want to work with the:
EOT

$lngmsg{'msg500032'} = <<EOT;
Do you want to:
EOT

$lngmsg{'msg500033'} = <<EOT;
<p>Post less than 1 megabyte of data at a time.</p>
Note: The redlist is not a blacklist. The redlist is a list of addresses that cannot
contribute to the whitelist, and who are not considered local, even if their mail is
from a local computer. For example, if someone goes on a vacation and turns on their
email's autoresponder, put them on the redlist until they return. Then as they reply
to every spam they receive they won't corrupt your non-spam collection or whitelist.<br />
To add or remove global whitelist entries use emailaddress,* .<br />
To add or remove domain whitelist entries use emailaddress,\@domain .<br />
<b>NOTICE: removing global or domain whitelist entries will DELETE ALL related personal records!</b>
EOT

$lngmsg{'msg500034'} = <<EOT;
<p class="warning">Warning: If your whitelist or redlist is long, pushing these buttons
 is ill-advised. Use these for testing and while your whitelist is short.</p>
EOT

$lngmsghint{'msg500040'} = '# Recipient Replacement Test';
$lngmsg{'msg500040'} = '<p><a href="./#ReplaceRecpt">go to ReplaceRecpt to configure rules</a></p>';
$lngmsg{'msg500041'} = '<p><span class="negative"><a href="./#ReplaceRecpt">ReplaceRecpt</a> is not configured - please do this first!</span></p>';
$lngmsg{'msg500042'} = '<p>to modify the replacement rules, open the file by clicking edit ';

$lngmsg{'msg500043'} = '<p>the following replacement rules were processed</p><br />';

$lngmsghint{'msg500050'} = '# View Maillog Tail';
$lngmsg{'msg500050'} = <<EOT;
Refresh your browser or click [Search/Update] to update this screen. Newest entries are at the end. The search will stop, if the [search for] field is blank - and [tail bytes] is reached, or if the [search for] field is not blank - and [search in] or the number of [results] is reached. If you search for more than one word, all words must match. Words with a leading \\'-\\' will be negated. For example: a search pattern \\'user -root\\', will search all lines which contains the word \\'user\\' but not the word \\'root\\'!
EOT

$lngmsg{'msg500051'} = <<EOT;
Select [file lines only], if you want to reduce the shown number of lines to such (POST filter), which contains filenames.<br /><br /> Use the MaillogTail function carefully, while ASSP is processing any request, no new connections will be accepted by ASSP, and this could take some minutes, if you search in large or many maillogs! To start realtime maillog, click on [Auto], to stop realtime maillog, click on [Stop].
EOT

$lngmsg{'msg500052'} = <<EOT;
If [this file number(s)] is selected, you can define a single filenumber or a comma separated list of filenumbers here - like: <b>1,5,8,7,6 or 10,2...7,11,14-19,21,23...26</b>  A defined range 2...7 or 2-7 will include all numbers from 2 to 7. The resulting numbers will be internaly sorted ascending and the files will be used in that sorted order.
EOT

$lngmsg{'msg500053'} = <<EOT;
Enter the search string - for more help use the [help] link. If you want to start the realtime log [Auto], you can define the number of lines to show in the browser [1 - 33] here.
EOT

$lngmsghint{'msg500060'} = '# Mail Analyzer';
$lngmsg{'msg500060'} = <<EOT;
This page will show you how ASSP analyzes and pre-processes an email to come up with the assigned spam probability. Regular Expressions will always check the full message. Group matching of any address will be shown. To analyze/modify individual email addresses click <a href="javascript:void(0);" onclick="popAddressAction('example\@$myName');return false;">here</a>. To analyze/modify individual IP addresses click <a href="javascript:void(0);" onclick="popIPAction('1.1.1.1');return false;">here</a>.
EOT

$lngmsg{'msg500061'} = <<EOT;
Copy and paste the mail header and body here:
EOT

$lngmsg{'msg500062'} = <<EOT;
<b>You may put here helo=aaa.bbb.helo or ip=123.123.123.123 to look up the helo/ip information. text=abc will start a lookup in the regular expression files for the "abc" matching regex.<br />
Put helo=domain.com and ip=123.123.123.123 in two lines, to lookup SPF results.</b>
<p>Note: Analysis is performed using the current spam database --
if yours was rebuilt since the time the mail was received you'll
receive a different result.</p>
EOT

$lngmsg{'msg500063'} = <<EOT;
<p>To use this form using <i>Outlook Express</i> do the following. Right-click on the message
of interest. Select <i>Properties</i>. Click the <i>Details</i> tab. Click the <i>message
source</i> button. Right-click on the message source and click <i>Select All</i>. Right-click
again and click <i>Copy</i>. Click on the text box above and paste (Ctrl-V perhaps). Click
the <i>Analyze</i> button.</p>
<p>The page will update to show you the following: if any of the email's addresses are in
the redlist or whitelist, the most and least spammy phrases together with their spaminess,
the resulting probabilities (probabilities may repeat one time), and the final spam probability
score.<br /><br />
To only transliterate the text (even MIME encoded) from non-Roman letters to Roman letters, simply select the checkbox.
EOT

$lngmsghint{'msg500070'} = '# Shutdown/Restart';
$lngmsg{'msg500070'} = <<EOT;
Note: It's possible to restart, if ASSP runs as a service or in a script that restarts it after it stops or it runs on WIN32 version Windows 2000(or higher) or it runs on linux,
otherwise this function can only shut ASSP down. In either case, shutdown is possibly not clean -- all SMTP sessions will be interrupted after $MaxFinConWaitTime seconds.<br /><br />
The following command will be started in OS-shell, if ASSP runs not as a service or daemon:<br /><b><font color=green>$AutoRestartCmd</font></b>
EOT

$lngmsghint{'msg500080'} = '# EDIT files window/frame';
$lngmsg{'msg500080'} = <<EOT;
<span class="negative">Attention: This is the real database content!<br />
Incorrect editing hash lists could result in unexpected behavior or dieing ASSP!</span><br />
Use |::| as terminator between key and value, for example: 102.1.1.1|::|1234567890 !<br />
If a time is shown human readable, you can change the date or time,<br />
but leave the format as it is ([+]YYYY-MM-DD,hh:mm:ss) and leave a possible \'+\' in front.<br />
Use only one pair of key and value per line.<br />
Comments are not allowed!<br />
While the hash is saved, ASSP is unable to accept new connections!<br />
Be carefull saveing large hash here, this could take very long time. Better save the new contents of large hashes and lists to the Importfile, if this option is available. If possible, the DB-Import will be started immediately by the MaintThread!<br />
After saving the contents to the Importfile, you should close this windows and wait until the import has finished!
EOT

$lngmsg{'msg500081'} = 'File should have one entry per line; anything on a line following a numbersign ( #) is ignored (a comment). Whitespace at the beginning or end of the line is ignored.';
$lngmsg{'msg500082'} = 'First line specifies text that appears in the subject of report message. The remaining lines are the report message body.';
$lngmsg{'msg500083'} = 'Put here comments to your assp installation.';
$lngmsg{'msg500084'} = 'For removal of entries from BlackBox use <a onmousedown="showDisp(\'$ConfigPos{noPB}\')" target="main" href="./#noPB">noPB</a>.
For removal of entries from WhiteBox  use <a onmousedown="showDisp(\'$ConfigPos{noPBwhite}\')" target="main" href="./#noPBwhite">noPBwhite</a>. For  whitelisting IP\'s use <a onmousedown="showDisp(\'$ConfigPos{whiteListedIPs}\')" target="main" href="./#whiteListedIPs">Whitelisted IP\'s</a> or <a onmousedown="showDisp(\'$ConfigPos{noProcessingIPs}\')" target="main" href="./#noProcessingIPs">No Processing IP\'s</a>. For blacklisting use <a onmousedown="showDisp(\'$ConfigPos{denySMTPConnectionsFrom}\')" target="main" href="./#denySMTPConnectionsFrom">Deny SMTP Connections From these IP\'s</a> and <a onmousedown="showDisp(\'$ConfigPos{denySMTPConnectionsFromAlways}\')" target="main" href="./#denySMTPConnectionsFromAlways">Deny SMTP Connections From these IP\'s Strictly</a>.';

$lngmsg{'msg500086'} = 'CacheEntry: IP/Domain \'11\' CacheIntervalStart 1=fail/2=pass Result/Comment';

$lngmsg{'msg500090'} = 'To take an action, select the action and click "Do It!". To move a file to an other location, just copy and delete the file!';
$lngmsg{'msg500091'} = '<br /> For "resend file" action install Email::Send  modules!';

$lngmsg{'msg500092'} = 'IP ranges can be defined as: 182.82.10. ';

$lngmsghint{'msg500093'} = '# the following messages are in one line 0093.$records.0094';
$lngmsg{'msg500093'} = 'This hash/list seems to be too large (';
$lngmsg{'msg500094'} = 'records) to save it from GUI!';

$lngmsg{'msg500095'} = 'Please close this window, and wait until import has finished.';
$lngmsg{'msg500096'} = "This file was trunked to (MaxBytes) $MaxBytes byte. If you resend this file, the resulting view and/or attachments would be destroyed!";

$lngmsghint{'msg500100'} = '# SMTP-Connection - link - hintbox';
$lngmsg{'msg500100'} = 'Click here to open a SMTP-Connections-Window that never stops refreshing. Do not make any changes in the main window, while this SMTP-Connections-Window is still opened! A SMTP-Connections-Window which is started with the default (left beside) link, will stop refreshing if it is not in forground.';

}

sub renderConfigHTML {
  setMainLang();
  my $maillogEnd;
  if ($MaillogTailJump) {
    $maillogEnd = '#MlEnd';
  } else {
    $maillogEnd = '#MlTop';
  }
  $maillogJump = '<a href="javascript:void(0);" onclick="MlEndPos=document.getElementById(\'LogLines\').scrollTop; document.getElementById(\'LogLines\').scrollTop=0; return false;">Go to Top</a><a name="MlEnd"></a>';
  my $IndexPos = $hideAlphaIndex ? '451' : '440';
  my $IndexStart = $hideAlphaIndex ? '452' : '442';
  my $JavaScript;

  my $ConnHint = $WebIP{$ActWebSess}->{lng}->{'msg500100'} || $lngmsg{'msg500100'};

  $plusIcon = 'get?file=images/plusIcon.png';
  $minusIcon = 'get?file=images/minusIcon.png';
  $noIcon = 'get?file=images/noIcon.png';
  $wikiinfo = 'get?file=images/info.png';
 $NavMenu = '
 <hr />
 <div class="menuLevel2">
  <a href="lists"><img src="' . $noIcon . '" alt="noicon" /> White/Redlist/Tuplets</a><br />
  <a href="javascript:void(0);" onclick="popAddressAction();"><img src="' . $noIcon . '" alt="noicon" /> work with addresses</a><br />
  <a href="javascript:void(0);" onclick="popIPAction();"><img src="' . $noIcon . '" alt="noicon" /> work with IP\'s</a><br />
  <a href="recprepl"><img src="' . $noIcon . '" alt="noicon" /> Recipient Replacement Test</a><br />
  <a href="maillog' . $maillogEnd . '"><img src="' . $noIcon . '" alt="noicon" target="_blank" /> View Maillog Tail</a><br />
  <a href="analyze"><img src="' . $noIcon . '" alt="noicon" /> Mail Analyzer</a><br />
  <a href="infostats"><img src="' . $noIcon . '" alt="noicon" /> Info and Stats </a><br />
  ';
  $NavMenu .= '
  <a href="top10stats" target="_blank"><img src="' . $noIcon . '" alt="noicon" /> Top 10 Stats</a><br />' if $DoT10Stat;
  $NavMenu .= '
  <a href="statusassp?nocache='.time.'" target="_blank"><img src="' . $noIcon . '" alt="noicon" /> Worker/DB/Regex Status</a><br />
  <a href="shutdown_list?nocache='.time.'" target="_blank"><img src="' . $noIcon . '" alt="this monitor will slow down ASSP dramaticly - use it careful" /> SMTP Connections </a>
  <a href="shutdown_list?nocache='.time.'&forceRefresh=1" target="_blank" onmouseover="showhint(\''.$ConnHint.'\', this, event, \'500px\', \'1\');return false;"><img height=12 width=12 src="' . $wikiinfo . '" /></a><br />
  <a href="shutdown"><img src="' . $noIcon . '" alt="noicon" /> Shutdown/Restart</a><br />
  <a href="donations"><img src="' . $noIcon . '" alt="noicon" /> Donations</a><br /></div>';
 $JavaScript = "
<script type=\"text/javascript\">
<!--
var oldBrowser = false;
/*\@cc_on
   /*\@if (\@_jscript_version < 5.6)
      oldBrowser = true;
   /*\@end
\@*/

if (window.navigator.appName == \"Microsoft Internet Explorer\")
{
   var engine;
   if (document.documentMode) // IE8
      engine = document.documentMode;
   else // IE 5-7
   {
      engine = 5; // Assume quirks mode unless proven otherwise
      if (document.compatMode)
      {
         if (document.compatMode == \"CSS1Compat\")
            engine = 7; //standard mode
      }
   }
   if (engine < 8) {oldBrowser = true;}
}
var BrowserDetect = {
	init: function () {
		this.browser = this.searchString(this.dataBrowser) || \"An unknown browser\";
		this.version = this.searchVersion(navigator.userAgent)
			|| this.searchVersion(navigator.appVersion)
			|| \"an unknown version\";
		this.OS = this.searchString(this.dataOS) || \"an unknown OS\";
	},
	searchString: function (data) {
		for (var i=0;i<data.length;i++)	{
			var dataString = data[i].string;
			var dataProp = data[i].prop;
			this.versionSearchString = data[i].versionSearch || data[i].identity;
			if (dataString) {
				if (dataString.indexOf(data[i].subString) != -1)
					return data[i].identity;
			}
			else if (dataProp)
				return data[i].identity;
		}
	},
	searchVersion: function (dataString) {
		var index = dataString.indexOf(this.versionSearchString);
		if (index == -1) return;
		return parseFloat(dataString.substring(index+this.versionSearchString.length+1));
	},
	dataBrowser: [
		{
			string: navigator.userAgent,
			subString: \"Chrome\",
			identity: \"Chrome\"
		},
		{ 	string: navigator.userAgent,
			subString: \"OmniWeb\",
			versionSearch: \"OmniWeb/\",
			identity: \"OmniWeb\"
		},
		{
			string: navigator.vendor,
			subString: \"Apple\",
			identity: \"Safari\",
			versionSearch: \"Version\"
		},
		{
			prop: window.opera,
			identity: \"Opera\"
		},
		{
			string: navigator.vendor,
			subString: \"iCab\",
			identity: \"iCab\"
		},
		{
			string: navigator.vendor,
			subString: \"KDE\",
			identity: \"Konqueror\"
		},
		{
			string: navigator.userAgent,
			subString: \"Firefox\",
			identity: \"Firefox\"
		},
		{
			string: navigator.vendor,
			subString: \"Camino\",
			identity: \"Camino\"
		},
		{		// for newer Netscapes (6+)
			string: navigator.userAgent,
			subString: \"Netscape\",
			identity: \"Netscape\"
		},
		{
			string: navigator.userAgent,
			subString: \"MSIE\",
			identity: \"Explorer\",
			versionSearch: \"MSIE\"
		},
		{
			string: navigator.userAgent,
			subString: \"Gecko\",
			identity: \"Mozilla\",
			versionSearch: \"rv\"
		},
		{ 		// for older Netscapes (4-)
			string: navigator.userAgent,
			subString: \"Mozilla\",
			identity: \"Netscape\",
			versionSearch: \"Mozilla\"
		}
	],
	dataOS : [
		{
			string: navigator.platform,
			subString: \"Win\",
			identity: \"Windows\"
		},
		{
			string: navigator.platform,
			subString: \"Mac\",
			identity: \"Mac\"
		},
		{
			   string: navigator.userAgent,
			   subString: \"iPhone\",
			   identity: \"iPhone/iPod\"
	    },
		{
			string: navigator.platform,
			subString: \"Linux\",
			identity: \"Linux\"
		}
	]

};
BrowserDetect.init();

var detectedBrowser = 'ASSP-GUI is running in ' + BrowserDetect.browser + ' version ' + BrowserDetect.version + ' on ' + BrowserDetect.OS;
if (oldBrowser) {
    detectedBrowser = detectedBrowser + ' (old javascript engine and/or browser detected)';
}
// -->
</script>

<script type=\"text/javascript\">
<!--

var configPos = new Array();
";
 for my $idx (0...$#ConfigArray) {
   my $c = $ConfigArray[$idx];
   next if(@{$c} == 5);
   $JavaScript .= "configPos['$c->[0]']='$ConfigPos{$c->[0]}';";
 }

$JavaScript .= "
function quotemeta (qstr) {
    return qstr.replace( /([^A-Za-z0-9])/g , \"\\\\\$1\" );
}

function toggleDisp(nodeid)
{
  if (nodeid == null) return false;
  if(nodeid.substr(0,9) == 'setupItem')
    nodeid = nodeid.substr(9);
  layer = document.getElementById('treeElement' + nodeid);
  img = document.getElementById('treeIcon' + nodeid);
  if(layer.style.display == 'none')
  {
    layer.style.display = 'block';
    img.src = '$minusIcon';
    if(document.getElementById('setupItem' + nodeid))
      document.getElementById('setupItem' + nodeid).style.display = 'block';
  }
  else
  {
    layer.style.display = 'none';
    img.src = '$plusIcon';
    if(document.getElementById('setupItem' + nodeid))
      document.getElementById('setupItem' + nodeid).style.display = 'none';
  }
}
function showDisp(nodeid)
{
  if (nodeid == null) return false;
  if(nodeid.substr(0,9) == 'setupItem')
    nodeid = nodeid.substr(9);
  layer = document.getElementById('treeElement' + nodeid);
  img = document.getElementById('treeIcon' + nodeid);
  if(layer.style.display == 'none')
  {
    layer.style.display = 'block';
    img.src = '$minusIcon';
    if(document.getElementById('setupItem' + nodeid))
      document.getElementById('setupItem' + nodeid).style.display = 'block';
  }
}
function gotoAnchor(aname)
{
//    window.location.href = \"#\" + aname;       //
    var currloc = window.location.href.split('#')[0];
    window.location = currloc + \"#\" + aname;
    var re = new RegExp('/adminusers',\"i\");
    if (! re.test(currloc)) setAnchor(aname);
}
function expand(expand, force)
{
  counter = 0;
  while(document.getElementById('treeElement' + counter))
  {
    if(!expand)
    {
      //dont shrink if this element is the one passed in the URL
      arr = document.getElementById('treeElement' + counter).getElementsByTagName('a');
      txt = ''; found = 0;
      loc = new String(document.location);
      for(i=0; i < arr.length; i++)
      {
        txt = txt + arr.item(i).href;
        tmpHref = new String(arr.item(i).href);
        if(tmpHref.substr(tmpHref.indexOf('#')) == loc.substr(loc.indexOf('#')))
        {
          //give this tree node the right icon
          document.getElementById('treeIcon' + counter).src = '$minusIcon';
          found = 1;
        }
      }
      if(!found | force)
      {
        document.getElementById('treeIcon' + counter).src = '$plusIcon';
        document.getElementById('treeElement' + counter).style.display = 'none';
        if(document.getElementById('setupItem' + counter))
          document.getElementById('setupItem' + counter).style.display = 'none';
      }
    }
    else
    {
      document.getElementById('treeElement' + counter).style.display = 'block';
      document.getElementById('treeIcon' + counter).src = '$minusIcon';
      if(document.getElementById('setupItem' + counter))
        document.getElementById('setupItem' + counter).style.display = 'block';
    }
    counter++;
  }
}

//make the 'rel's work
function externalLinks()
{
  if (!document.getElementsByTagName)
    return;
  var anchors = document.getElementsByTagName(\"a\");
  for (var i=0; i<anchors.length; i++)
  {
    var anchor = anchors[i];
    if (anchor.getAttribute(\"href\")
      && anchor.getAttribute(\"rel\") == \"external\")
      anchor.target = \"_blank\";
  }
}

// handle cookies to remember something
function createCookie(name,value,days) {
    if (! navigator.cookieEnabled) {return null;}
	if (days) {
		var date = new Date();
		date.setTime(date.getTime()+(days*24*60*60*1000));
		var expires = \"; expires=\"+date.toGMTString();
	}
	else var expires = \"\";
	document.cookie = name+\"=\"+value+expires+\"; path=/\";
}

function readCookie(name) {
    if (! navigator.cookieEnabled) {return null;}
	var nameEQ = name + \"=\";
	var ca = document.cookie.split(';');
	for(var i=0;i < ca.length;i++) {
		var c = ca[i];
		while (c.charAt(0)==' ') c = c.substring(1,c.length);
		if (c.indexOf(nameEQ) == 0) return c.substring(nameEQ.length,c.length);
	}
	return null;
}

function eraseCookie(name) {
    if (! navigator.cookieEnabled) {return null;}
	createCookie(name,\"\",-1);
}

function setAnchor(iname)
{
    if (navigator.cookieEnabled) {createCookie('lastAnchor',iname,1);}
}

function initAnchor(doIt)
{
    if (doIt != '1') {return null;}
    if (! navigator.cookieEnabled) {return null;}
    var iname = readCookie('lastAnchor');
    if (! iname || iname == '' || iname == 'delete') {return false;}
    if (window.location.pathname == '/' || window.location.pathname == '') {
        showDisp(configPos[iname]);
        gotoAnchor(iname);
    } else {
        return false;
    }
}
";

  $JavaScript .= "
function docHeight()
{
  if (typeof document.height != 'undefined') {
    return document.height;
  } else if (document.compatMode && document.compatMode != 'BackCompat') {
    return document.documentElement.scrollHeight;
  } else if (document.body && typeof document.body.scrollHeight !='undefined') {
    return document.body.scrollHeight;
  }
}
//********************************************************
//* You may use this code for free on any web page provided that
//* these comment lines and the following credit remain in the code.
//* Floating Div from http://www.javascript-fx.com
//********************************************************
// Modified in May 2005 by Przemek Czerkas:
//  - added calls to docHeight()
//  - added bounding params tlx, tly, brx, bry
var ns = (navigator.appName.indexOf(\"Netscape\") != -1);
var d = document;
var px = document.layers ? \"\" : \"px\";
function JSFX_FloatDiv(id, sx, sy, tlx, tly, brx, bry)
{
  var el=d.getElementById?d.getElementById(id):d.all?d.all[id]:d.layers[id];
  window[id + \"_obj\"] = el;
  if(d.layers)el.style=el;
  el.cx = el.sx = sx;
  el.cy = el.sy = sy;
  el.tlx = tlx;
  el.tly = tly;
  el.brx = brx;
  el.bry = bry;
  el.sP=function(x,y){this.style.left=x+px;this.style.top=y+px;};
  el.flt=function()
  {
    var pX, pY;
    pX = ns ? pageXOffset : document.documentElement && document.documentElement.scrollLeft ? document.documentElement.scrollLeft : document.body.scrollLeft;
    pY = ns ? pageYOffset : document.documentElement && document.documentElement.scrollTop ? document.documentElement.scrollTop : document.body.scrollTop;
    if(this.sy<0)
      pY += ns ? innerHeight : document.documentElement && document.documentElement.clientHeight ? document.documentElement.clientHeight : document.body.clientHeight;
    this.cx += (pX + Math.max(this.sx-pX, this.tlx) - this.cx)/4;
    this.cy += (pY + Math.max(this.sy-pY, this.tly) - this.cy)/4;
    this.cx = Math.min(this.cx, this.brx);
    this.cy = Math.min(this.cy, this.bry);
    if (ns) {
      this.sP(
        Math.max(Math.min(this.cx+this.clientWidth,document.width)-this.clientWidth,this.sx),
        Math.max(Math.min(this.cy+this.clientHeight,document.height)-this.clientHeight,this.sy)
      );
    } else {
      var oldh, newh;
      oldh = docHeight();
      this.sP(this.cx, this.cy);
      newh = docHeight();
      if (newh>oldh) {
        this.sP(this.cx, this.cy-(newh-oldh));
      }
    }
    setTimeout(this.id + \"_obj.flt()\", 20);
  }
  return el;
}" if ($EnableFloatingMenu && ! $mobile);

 $JavaScript .= '
function popFileEditor(filename,note)
{
  var height = (note == 0) ? 500 : (note == \'m\') ? 580 : 550;
  newwindow=window.open(
    \'edit?file=\'+filename+\'&note=\'+note,
    \'FileEditor\',
    \'width=720,height=\'+height+\',overflow=scroll,toolbar=yes,menubar=yes,location=no,personalbar=yes,scrollbars=yes,status=no,directories=no,resizable=yes\'
  );
  	// this puts focus on the popup window if we open a new popup without closing the old one.
  	if (window.focus) {newwindow.focus()}
  	return false;
}

function popAddressAction(address)
{
  var height = 500 ;
  var link = address ? \'?address=\'+address : \'\';
  newwindow=window.open(
    \'addraction\'+link,
    \'AddressAction\',
    \'width=720,height=\'+height+\',overflow=scroll,toolbar=yes,menubar=yes,location=no,personalbar=yes,scrollbars=yes,status=no,directories=no,resizable=yes\'
  );
  	// this puts focus on the popup window if we open a new popup without closing the old one.
  	if (window.focus) {newwindow.focus()}
  	return false;
}

function popIPAction(ip)
{
  var height = 500 ;
  var link = ip ? \'?ip=\'+ip : \'\';
  newwindow=window.open(
    \'ipaction\'+link,
    \'IPAction\',
    \'width=720,height=\'+height+\',overflow=scroll,toolbar=yes,menubar=yes,location=no,personalbar=yes,scrollbars=yes,status=no,directories=no,resizable=yes\'
  );
  	// this puts focus on the popup window if we open a new popup without closing the old one.
  	if (window.focus) {newwindow.focus()}
  	return false;
}

function popSyncEditor(cfgParm)
{
  setAnchor(cfgParm);
  var height = 400;
  newwindow=window.open(
    \'syncedit?cfgparm=\'+cfgParm,
    \'SyncEditor\',
    \'width=600,height=\'+height+\',overflow=scroll,toolbar=yes,menubar=yes,location=no,personalbar=yes,scrollbars=yes,status=no,directories=no,resizable=yes\'
  );
  	// this puts focus on the popup window if we open a new popup without closing the old one.
  	if (window.focus) {newwindow.focus()}
  	return false;
}

function remember()
{
  var height =  580;
  newwindow=window.open(
    \'remember\',
    \'rememberMe\',
    \'width=720,height=\'+height+\',overflow=scroll,toolbar=yes,menubar=yes,location=no,personalbar=yes,scrollbars=yes,status=no,directories=no,resizable=yes\'
  );
  	// this puts focus on the popup window if we open a new popup without closing the old one.
  	if (window.focus) {newwindow.focus()}
  	return false;
}

window.onload = externalLinks;
// -->
</script>';

# JavaScript for alphabetic IndexMenu
 $JavaScript .= '
<style type="text/css" >
<!--
#smenu {background-color:#ffffff; text-align:left; font-size: 90%; border:1px solid #000099; z-Index:200; visibility:hidden; position:absolute; top:100px; left:-'.$IndexPos.'px; width:450px; height:700px;}
#sleftTop {width:420px; height:5%; float:left;font-size: 90%;color:#999999; font-family:arial, helvetica, sans-serif;overflow: hidden;}
#sleft {width:420px; height:94%; float:left;font-size: 90%;color:#999999; font-family:arial, helvetica, sans-serif;overflow-x: hidden;overflow-y: scroll;}
#sright {width:10px; height:99%; float:right;font-size: 90%;color:#999999; font-family:arial, helvetica, sans-serif;overflow: hidden;}
#sright a:link{text-decoration:none; color:#684f00; font-family:arial, helvetica, sans-serif;}
#sright a:visited{text-decoration:none; color:#684f00; font-family:arial, helvetica, sans-serif;}
#sright a:active{text-decoration:none; color:#684f00; font-family:arial, helvetica, sans-serif;}
#sright a:hover{text-decoration:underline; color:#999999; font-family:arial, helvetica, sans-serif;}
-->
</style>

<script type="text/javascript">
<!--
// Sliding Menu Script
// copyright Stephen Chapman, 6th July 2005
// you may copy this code but please keep the copyright notice as well
// ASSP implementation by Thomas Eckardt
var speed = 1;

function changeSlide() {
    var findText = xDOM(\'quickfind\').value;
    if (findText == \'**select**\') findText = \'\';
    var re;
    try {
        re = new RegExp(findText,"i");
        re.test(\'abc\');
    }
    catch(err) {
        alert(\'error in string (regex) : \'+err);
        return false;
    }
    var entries = xDOM(\'sleft\').getElementsByTagName(\'a\');
    for (var i=0; i<entries.length; i++) {
        var id=entries[i].id;
        if (! id) next;
        if (findText == \'\' || re.test(id.substr(3))) {
            setObjDisp(id,\'inline\');
        } else {
            setObjDisp(id,\'none\');
        }
    }
}

function ClientSize(HorW) {
  var myWidth = 0, myHeight = 0;
  if( typeof( window.innerWidth ) == \'number\' ) {
    //Non-IE
    myWidth = window.innerWidth;
    myHeight = window.innerHeight;
  } else if( document.documentElement && ( document.documentElement.clientWidth || document.documentElement.clientHeight ) ) {
    //IE 6+ in \'standards compliant mode\'
    myWidth = document.documentElement.clientWidth;
    myHeight = document.documentElement.clientHeight;
  } else if( document.body && ( document.body.clientWidth || document.body.clientHeight ) ) {
    //IE 4 compatible
    myWidth = document.body.clientWidth;
    myHeight = document.body.clientHeight;
  }
  return  HorW == \'w\' ?  myWidth : myHeight;
}

var aDOM = 0, ieDOM = 0, nsDOM = 0; var stdDOM = document.getElementById;
if (stdDOM) aDOM = 1; else {ieDOM = document.all; if (ieDOM) aDOM = 1; else {
var nsDOM = ((navigator.appName.indexOf(\'Netscape\') != -1)
&& (parseInt(navigator.appVersion) ==4)); if (nsDOM) aDOM = 1;}}

function xDOM(objectId, wS) {
  if (stdDOM) return wS ? document.getElementById(objectId).style : document.getElementById(objectId);
  if (ieDOM) return wS ? document.all[objectId].style : document.all[objectId];
  if (nsDOM) return document.layers[objectId];
}
function objWidth(objectID) {var obj = xDOM(objectID,0); if(obj.offsetWidth) return obj.offsetWidth; if (obj.clip) return obj.clip.width; return 0;}
function objHeight(objectID) {var obj = xDOM(objectID,0); if(obj.offsetHeight) return obj.offsetHeight; if (obj.clip) return obj.clip.height; return 0;}
function setObjVis(objectID,vis) {var objs = xDOM(objectID,1); objs.visibility = vis;}
function setObjDisp(objectID,disp) {var objs = xDOM(objectID,1); objs.display = disp;}
function moveObjTo(objectID,x,y) {var objs = xDOM(objectID,1); objs.left = x; objs.top = y;}
function pageWidth() {return window.innerWidth != null? window.innerWidth: document.body != null? document.body.clientWidth:null;}
function pageHeight() {return window.innerHeight != null? window.innerHeight: document.body != null? document.body.clientHeight:null;}
function posLeft() {return typeof window.pageXOffset != \'undefined\' ? window.pageXOffset: document.documentElement.scrollLeft?
 document.documentElement.scrollLeft: document.body.scrollLeft? document.body.scrollLeft:0;}

function posTop() {return typeof window.pageYOffset != \'undefined\' ? window.pageYOffset: document.documentElement.scrollTop?
 document.documentElement.scrollTop: document.body.scrollTop? document.body.scrollTop:0;}

var xxx = 0; var yyy = 0; var dist = distX = distY = 0; var stepx = '.$IndexSlideSpeed.'; var stepy = 0; var mn = \'smenu\';

function disableSlide() {setObjVis(mn,\'hidden\');}
function enableSlide() {setObjVis(mn,\'visible\');}
function distance(s,e) {return Math.abs(s-e)}
function direction(s,e) {return s>e?-1:1}
function rate(a,b) {return a<b?a/b:1}
function setHeight() {var objs = xDOM(mn,1); var h = ClientSize(\'h\'); objs.height = h*0.95 +\'px\';}
function start() {setHeight(); xxx = -'.$IndexStart.'; yyy = 0; var eX = 0; var eY = 100; dist = distX = distance(xxx,eX); distY = distance(yyy,eY); stepx *=
-direction(xxx,eX) * rate(distX,distY); stepy *= direction(yyy,eY) * rate(distY,distX); moveit(); setObjVis(mn,\'visible\');}

function moveit() {var x = (posLeft()+xxx) + \'px\'; var y = posTop() + \'px\'; moveObjTo(mn,x,y);}
function mover() {if (dist > 0) {xxx += stepx; yyy += stepy; dist -= Math.abs(stepx);} moveit(); setTimeout(\'mover()\',speed);}
function slide() {dist = distX; stepx = -stepx; moveit(); setTimeout(\'mover()\',speed*2);return false;}

onload = start;
window.onscroll = moveit;
// -->
</script>
' if (! $mobile);
# END JavaScript for alphabetic IndexMenu

#start JavaScript for HintBox
$JavaScript .= <<EOT;
<style type="text/css">

#hintbox{ /*CSS for pop up hint box */
position:absolute;
top: 0;
background-color: lightyellow;
width: 150px; /*Default width of hint.*/
padding: 3px;
border:1px solid black;
font:normal 11px Verdana;
line-height:18px;
z-index:300;
border-right: 3px solid black;
border-bottom: 3px solid black;
visibility: hidden;

table { table-layout:fixed; word-wrap:break-word; }
}
</style>
EOT

$JavaScript .= '
<script type="text/javascript">

/***********************************************
* Show Hint script- (c) Dynamic Drive (www.dynamicdrive.com)
* This notice MUST stay intact for legal use
* Visit http://www.dynamicdrive.com/ for this script and 100s more.
*
* implemented in ASSP by Thomas Eckardt
***********************************************/

var horizontal_offset="0px" //horizontal offset of hint box from anchor link

/////No further editting needed

var vertical_offset="20px" //vertical offset of hint box from anchor link. No need to change.
var ie=document.all
var ns6=document.getElementById&&!document.all

function getposOffset(what, offsettype){
    var totaloffset=(offsettype=="left")? what.offsetLeft : what.offsetTop;
    var parentEl=what.offsetParent;
    while (parentEl!=null){
        totaloffset=(offsettype=="left")? totaloffset+parentEl.offsetLeft : totaloffset+parentEl.offsetTop;
        parentEl=parentEl.offsetParent;
    }
    return totaloffset;
}

function iecompattest(){
    return (document.compatMode && document.compatMode!="BackCompat")? document.documentElement : document.body
}

function clearbrowseredge(obj, whichedge, where){
    var edgeoffset=(whichedge=="rightedge")? (parseInt(horizontal_offset)-obj.offsetWidth*where/2)*-1 : parseInt(vertical_offset)*-1;
    if (whichedge=="rightedge"){
        var windowedge=ie && !window.opera? iecompattest().scrollLeft+iecompattest().clientWidth-90 : window.pageXOffset+window.innerWidth-100;
        dropmenuobj.contentmeasure=dropmenuobj.offsetWidth;
        if (windowedge-dropmenuobj.x < dropmenuobj.contentmeasure)
            edgeoffset=dropmenuobj.contentmeasure+obj.offsetWidth/(where+1)+parseInt(horizontal_offset);
    } else {
        var windowedge=ie && !window.opera? iecompattest().scrollTop+iecompattest().clientHeight-15 : window.pageYOffset+window.innerHeight-18
        dropmenuobj.contentmeasure=dropmenuobj.offsetHeight
        if (windowedge-dropmenuobj.y < dropmenuobj.contentmeasure)
            edgeoffset=dropmenuobj.contentmeasure-obj.offsetHeight+parseInt(vertical_offset)
    }
    return edgeoffset
}

function showhint(menucontents, obj, e, tipwidth, currLoc){
    if (document.getElementById("hintbox")){
        dropmenuobj=document.getElementById("hintbox")
        dropmenuobj.innerHTML=menucontents
        dropmenuobj.style.left=dropmenuobj.style.top=-500
        if (tipwidth!=""){
            dropmenuobj.widthobj=dropmenuobj.style
            dropmenuobj.widthobj.width=tipwidth
        }
        dropmenuobj.x=getposOffset(obj, "left")
        dropmenuobj.y=getposOffset(obj, "top");
        if (currLoc != "" && (ie||ns6)) {
            //var postop = ns6 ? 0 : posTop();
            var postop = 0;
            var objTop = yMousePos+postop+parseInt(vertical_offset);
            var Yedge=ie && !window.opera? iecompattest().scrollTop+iecompattest().clientHeight-15 : window.pageYOffset+window.innerHeight-18;
            if (dropmenuobj.offsetHeight + objTop > Yedge) {
                dropmenuobj.style.top=objTop-dropmenuobj.offsetHeight+"px";
            } else {
                dropmenuobj.style.top=objTop+"px";
            }
        } else {
            dropmenuobj.style.top=dropmenuobj.y-clearbrowseredge(obj, "bottomedge", 0)+"px";
        }
        if (currLoc != "") {
            dropmenuobj.style.left=dropmenuobj.x-clearbrowseredge(obj, "rightedge", 0)+obj.offsetWidth+"px";
        } else {
            dropmenuobj.style.left=dropmenuobj.x-clearbrowseredge(obj, "rightedge", 1)+obj.offsetWidth+"px";
        }
        //alert("x="+dropmenuobj.x+" , cb="+clearbrowseredge(obj, \'rightedge\')+" , offset="+obj.offsetWidth);
        //dropmenuobj.style.left=xMousePos+"px"
        dropmenuobj.style.visibility="visible"
        obj.onmouseout=hidetip
    }
}

function hidetip(e){
    dropmenuobj.style.visibility="hidden"
    dropmenuobj.style.left="-500px"
}

function createhintbox(){
    var divblock=document.createElement("div")
    divblock.setAttribute("id", "hintbox")
    document.body.appendChild(divblock)
}

if (window.addEventListener)
    window.addEventListener("load", createhintbox, false)
else if (window.attachEvent)
    window.attachEvent("onload", createhintbox)
else if (document.getElementById)
    window.onload=createhintbox

// Set Netscape up to run the "captureMousePosition" function whenever
// the mouse is moved. For Internet Explorer and Netscape 6, you can capture
// the movement a little easier.
if (document.layers) { // Netscape
    document.captureEvents(Event.MOUSEMOVE);
    document.onmousemove = captureMousePosition;
} else if (document.all) { // Internet Explorer
    document.onmousemove = captureMousePosition;
} else if (document.getElementById) { // Netcsape 6
    document.onmousemove = captureMousePosition;
}

// Global variables
xMousePos = 0; // Horizontal position of the mouse on the screen
yMousePos = 0; // Vertical position of the mouse on the screen
xMousePosMax = 0; // Width of the page
yMousePosMax = 0; // Height of the page

function captureMousePosition(e) {
    if (document.layers) {
        // When the page scrolls in Netscape, the event\'s mouse position
        // reflects the absolute position on the screen. innerHight/Width
        // is the position from the top/left of the screen that the user is
        // looking at. pageX/YOffset is the amount that the user has
        // scrolled into the page. So the values will be in relation to
        // each other as the total offsets into the page, no matter if
        // the user has scrolled or not.
        xMousePos = e.pageX;
        yMousePos = e.pageY;
        xMousePosMax = window.innerWidth+window.pageXOffset;
        yMousePosMax = window.innerHeight+window.pageYOffset;
    } else if (document.all) {
        // When the page scrolls in IE, the event\'s mouse position
        // reflects the position from the top/left of the screen the
        // user is looking at. scrollLeft/Top is the amount the user
        // has scrolled into the page. clientWidth/Height is the height/
        // width of the current page the user is looking at. So, to be
        // consistent with Netscape (above), add the scroll offsets to
        // both so we end up with an absolute value on the page, no
        // matter if the user has scrolled or not.

        if (window.event) {
            xMousePos = window.event.x+document.body.scrollLeft;
            yMousePos = window.event.y+document.body.scrollTop;
        } else {
            if (e) {};
        }
        xMousePosMax = document.body.clientWidth+document.body.scrollLeft;
        yMousePosMax = document.body.clientHeight+document.body.scrollTop;
    } else if (document.getElementById) {
        // Netscape 6 behaves the same as Netscape 4 in this regard
        xMousePos = e.pageX;
        yMousePos = e.pageY;
        xMousePosMax = window.innerWidth+window.pageXOffset;
        yMousePosMax = window.innerHeight+window.pageYOffset;
    }
}
function browserclose () {
    eraseCookie(\'lastAnchor\');
    confirm(\'please logout first ?\');
    return false;
}
if(window.addEventListener) {
    window.addEventListener("close", browserclose, false);
}

function changeTitle(title) {
    document.title = document.title.replace(/^\S+/ ,title);
}

function WaitDiv()
{
	document.getElementById(\'wait\').style.display = \'block\';
}

function WaitDivDel()
{
	document.getElementById(\'wait\').style.display = \'none\';
}

// JavaScript for reformating the mobile view
function setNavPosition() {
    if (oldBrowser) {document.getElementById(\'topnav\').style.top=\'67px\';}
    document.getElementById(\'topnav\').style.left=\'0px\';
    document.getElementById(\'navMenu\').style.top=document.getElementById(\'topnav\').offsetHeight - (oldBrowser * 18) + \'px\';
    document.getElementById(\'navMenu\').style.left=\'0px\';
}

function showLeftMenu() {
    if (document.getElementById(\'navMenu\').style.display == \'none\') {
        try {
        document.getElementById(\'cfgh2\').style.margin=\'5px 0 0 17em\';
        } catch(e) {}
        try {
        document.getElementById(\'cfgdiv\').style.margin=\'5px 0 0 17em\';
        } catch(e) {}
        document.getElementById(\'topnav\').style.display=\'block\';
        document.getElementById(\'navMenu\').style.display=\'block\';
    } else {
        document.getElementById(\'topnav\').style.display=\'none\';
        document.getElementById(\'navMenu\').style.display=\'none\';
        try {
        document.getElementById(\'cfgh2\').style.margin=\'5px 0 0 0\';
        } catch(e) {}
        try {
        document.getElementById(\'cfgdiv\').style.margin=\'5px 0 0 0\';
        } catch(e) {}
    }
    setNavPosition();
}
';
$JavaScript .= '
var gAutoPrint = true;

function processPrint(){

    if (document.getElementById != null){
        expand(1, 1);
        var html = \'<HTML>\n<HEAD>\n\';
        if (document.getElementsByTagName != null){
            var headTags = document.getElementsByTagName("head");
            if (headTags.length > 0) html += headTags[0].innerHTML;
        }
        html += \'\n</HE\' + \'AD>\n<BODY>\n\';
        html += \'<img src="get?file=images/logo.gif" />&nbsp;&nbsp;&nbsp;<b>ASSP version '.$version.$modversion.'</b><br /><hr /><br />\';

        var printReadyElemCfg  = document.getElementById("cfgdiv");
        var printReadyElemHint = document.getElementById("mainhints");

        if (printReadyElemHint != null)  html += "'.$headerTOC.'";

        if (printReadyElemCfg  != null)  html += printReadyElemCfg.innerHTML;
        if (printReadyElemHint != null)  html += printReadyElemHint.innerHTML;
        if (printReadyElemHint != null)  html += "'.$headerGlosar.'";

        expand(0, 1);
        html += \'\n</BO\' + \'DY>\n</HT\' + \'ML>\';
        var printWin = window.open("","processPrint");
        printWin.document.open();
        printWin.document.write(html);
        printWin.document.close();

        if (gAutoPrint) printWin.print();
    } else alert("Browser not supported.");
}
</script>
' unless $mobile;
$JavaScript .= <<EOT;
<style type="text/css">
#wait {
	position: absolute;
	width: 350;
	heigth: 100;
	margin-left: 300;
	margin-top: 150;
	background-color: #FFF000;
	text-align: center;
	border: solid 1px #FFFFFF;
}
</style>
EOT
#end JavaScript for HintBox

 $headerHTTP = 'HTTP/1.1 200 OK
Content-type: text/html
Cache-control: no-cache
';
 $headerDTDStrict = '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN"
  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">
';
 $headerDTDTransitional = '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Transitional//EN"
  "http://www.w3.org/TR/xhtml1/DTD/xhtml1-transitional.dtd">
';
 $headers = "<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">
<head>
  <meta http-equiv=\"content-type\" content=\"application/xhtml+xml; charset=utf-8\" />
  <title>Config ASSP ($myName) Host: $localhostname @ $localhostip</title>
  <link rel=\"stylesheet\" href=\"get?file=images/assp.css\" type=\"text/css\" />
  <link rel=\"shortcut icon\" href=\"get?file=images/favicon.ico\" />
$JavaScript
</head>
<body window.onunload=\"javascript:browserclose();\" window.onClose=\"javascript:browserclose();\"><a name=\"Top\"></a>
<div class=\"wait\" id=\"wait\" style=\"display: none;\">&nbsp;&nbsp; Please wait while loading... &nbsp;&nbsp;</div>
";

my $hid;
if ( ! $rootlogin) {
    $hid = $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.hidDisabled"};
}
if (! $mobile) {
  $headers .= "  <div id=\"smenu\"><div id=\"sleftTop\">&nbsp;
";

 for ("A"..."Z") {
 $headers .= "<a href=\"#$_\" onmousedown=\"gotoAnchor('$_');return false;\">$_&nbsp;</a>";
 }
 $headers .= "&nbsp;&nbsp;<input id=\"quickfind\" size=\"9\" value=\"**select**\" style=\"background:#eee none; color:#222; font-style: italic\" onfocus=\"if (this.value == '**select**') {this.value='';}\" onchange=\"changeSlide();\" >&nbsp;&nbsp;<img src=\"get?file=images/plusIcon.png\" onmouseover=\"showhint('<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\'100%\\'><tr><td>Select the values to show. The string is searched anywhere in the value names. A regular expression could be used.</td></tr></table>', this, event, '450px', ''); return true;\">&nbsp;&nbsp;&nbsp;<a href=\"javascript:void();\" onclick=\"xDOM('quickfind').value='';changeSlide();return false;\" onmouseover=\"showhint('<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\'100%\\'><tr><td>Click to reset view to default.</td></tr></table>', this, event, '450px', ''); return true;\"><img src=\"get?file=images/minusIcon.png\" ></a>\n<hr></div><div id=\"sleft\">\n";
my %Config1 = ();
while (my ($k,$v) = each %Config) {
    $Config1{lc($k)} = $k;
}
my $firstChar = '';
my $i = 0;
$headerGlosar = "<p style=\"page-break-before: always;\"><br />\n";
$headerGlosar .= '<hr><h2>glosar</h2><hr><br />';
$headerGlosar .= '<table><tr>';
foreach (sort keys %Config1) {
    $i++;
    my $k = $Config1{$_};
    my $name;
    if ( uc($firstChar) ne uc(substr($k,0,1))) {
        $name = 'name="'.uc(substr($k,0,1)).'"';
        $headerGlosar .= '<td>&nbsp;</td>' if ($i != 1 && $i % 2);
        $headerGlosar .= '</tr><tr>' if ($i != 1);
        $headerGlosar .= '<td><br /><br /><b>'.uc(substr($k,0,1))."</b></td><td>&nbsp;</td></tr>\n";
    }
    $headerGlosar .= '<tr>' if ($i % 2);
    my $gI = $glosarIndex{$k};
    $gI = $glosarIndex{'URIBLError'} if $k eq 'TLDS';
    $headerGlosar .= "<td>$k - $gI</td>";
    $headerGlosar .= "</tr>\n" if (!($i % 2));
    $firstChar = uc(substr($k,0,1));
    next if $hid && ! &canUserDo($WebIP{$ActWebSess}->{user},'cfg',$k);
    my $value = $ConfigListBox{$k} ? $ConfigListBox{$k} : encodeHTMLEntities($Config{$k});
    $value =~ s/'|"|\n//go;
    $value =~ s/\\/\\\\/go;
    $value = '&nbsp;' unless $value;
    $value = 'ENCRYPTED' if exists $cryptConfigVars{$k} or $k eq 'webAdminPassword';
    my $default = exists $cryptConfigVars{$k} && $k ne 'webAdminPassword' ? 'ENCRYPTED' : $ConfigDefault{$k};
    $default = '' if $default eq undef;
    $headers .= "<a $name id=\"sl_$k\" onmousedown=\"expand(0, 1);showDisp('$ConfigPos{$k}');gotoAnchor('$k');slide();return false;\" onmouseover=\"window.status='$ConfigNice{$k}'; showhint('<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\'100%\\'><tr><td>config var:</td><td>$k</td></tr><tr><td>description:</td><td>$ConfigNice{$k}</td></tr><tr><td>current value:</td><td>$value</td></tr><tr><td>default value:</td><td>$default</td></tr></table>', this, event, '500px', 'index'); return true;\" onmouseout=\"window.status='';return true;\">&nbsp;<img src=\"$noIcon\" alt=\"$ConfigNice{$k}\" />&nbsp;$k<br /></a>\n";
#    $headers .= "<a $name id=\"sl_$k\" href=\"./#$k\" onmousedown=\"expand(0, 1);showDisp('$ConfigPos{$k}');gotoAnchor('$k');slide();return false;\" onmouseover=\"window.status='$ConfigNice{$k}'; showhint('<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\'100%\\'><tr><td>config var:</td><td>$k</td></tr><tr><td>description:</td><td>$ConfigNice{$k}</td></tr><tr><td>current value:</td><td>$value</td></tr><tr><td>default value:</td><td>$default</td></tr></table>', this, event, '500px', 'index'); return true;\" onmouseout=\"window.status='';return true;\">&nbsp;<img src=\"$noIcon\" alt=\"$ConfigNice{$k}\" />&nbsp;$k<br /></a>\n";
}
  $headerGlosar .= '<td>&nbsp;</td></tr>' if ($i % 2);
  $headerGlosar .= "\n</table>\n";
  $headerGlosar =~ s/(["\/]|\r?\n)/\\$1/gos;

  
  $headers .= "<br />&nbsp;<br />&nbsp;<br />&nbsp;<br />&nbsp;<br />&nbsp;</div><div id=\"sright\"><a href=\"#\" onclick=\"return slide();return false;\">";
  $headers .= "<img src=\"get?file=images/plusIcon.png\" alt=\"open and close alphabetical index\" /><br />&nbsp;<br \/>";
  $headers .= "<img src=\"get?file=images/minusIcon.png\" alt=\"open and close alphabetical index\" /><br />&nbsp;<br \/>";
  $headers .= "<img src=\"get?file=images/minusIcon.png\" alt=\"open and close alphabetical index\" /><br />&nbsp;<br \/>";
  $headers .= "<img src=\"get?file=images/plusIcon.png\" alt=\"open and close alphabetical index\" /><br />&nbsp;<br \/>";
# do not use spaces in $boardertext - instead use '#'
  my $boardertext = "sorted#config";
  $boardertext =~ s/([^#])/$1<br \/>/go;
  $boardertext =~ s/#/&nbsp;<br \/>/go;
  $headers .= "$boardertext<br />";
  $headers .= "<img src=\"get?file=images/plusIcon.png\" alt=\"open and close alphabetical index\" /><br />&nbsp;<br \/>";
  $headers .= "<img src=\"get?file=images/minusIcon.png\" alt=\"open and close alphabetical index\" /><br />&nbsp;<br \/>";
  $headers .= "<img src=\"get?file=images/minusIcon.png\" alt=\"open and close alphabetical index\" /><br />&nbsp;<br \/>";
  $headers .= "<img src=\"get?file=images/plusIcon.png\" alt=\"open and close alphabetical index\" /><br />&nbsp;<br \/>";
  $headers .= "</a></div></div>
";

} # end if $mobile -> no index

  $headers .= "<p>";
  $headers .= '<table id="TopMenu" class="contentFoot" style="margin:0; text-align:left;" CELLSPACING=0 CELLPADDING=4 WIDTH="100%">
  <tr><td rowspan="3" align="left">';
  if (-e "$base/images/logo.gif") {
      $headers .= "<a href=\"http://assp.sourceforge.net/\" target=\"_blank\"><img src=\"get?file=images/logo.gif\" alt=\"ASSP\" /></a>";
  } else {
      $headers .= "<a href=\"http://assp.sourceforge.net/\" target=\"_blank\"><img src=\"get?file=images/logo.jpg\" alt=\"ASSP\" /></a>";
  }
  $headers .= "</td><td rowspan=\"3\" align=\"left\" onmouseover=\"showhint(detectedBrowser,this, event, '450px', '')\">ASSP version $version$modversion<br />";

  if ($setpro && $globalClientName && $globalClientPass) {
      $headers .= "<b><font color=white size=+3>&nbsp;&nbsp;&nbsp;&nbsp;pro</font></b>";
  }

  my $avv = "$availversion";
  my $stv = "$version$modversion";
  $avv =~ s/RC/\./gio;
  $stv =~ s/RC/\./gio;
  $avv =~ s/\s|\(|\)//gio;
  $stv =~ s/\s|\(|\)//gio;
  $stv = 0 if ($avv =~ /\d{5}(?:\.\d{1,2})?$/o && $stv =~ /(?:\.\d{1,2}){3}$/o);
  $headers .= "<br /><a href=\"$NewAsspURL\" target=\"_blank\" style=\"color:green;size:-1;\">new available ASSP version $availversion</a>" if $avv gt $stv;

 $headers .= '</td>
  <td><a href="lists">White/Redlist/Tuplets</a></td>
  <td><a href="recprepl">Recipient Replacement Test</a></td>
  <td><a href="maillog' . $maillogEnd . '">View Maillog Tail</a></td>
  </tr><tr>
  <td><a href="analyze">Mail Analyzer</a></td>
  <td><a href="infostats">Info and Stats</a>';
 $headers .= $DoT10Stat ?
  '<a href="top10stats" target="_blank" onmouseover="showhint(\'show top ten stats\', this, event, \'100px\', \'1\');return false;"><img height=12 width=12 src="' . $wikiinfo . '" /></a></td>'
                       :
  '</td>';
 $headers .= '
  <td><a href="statusassp?nocache='.time.'" target="_blank">Worker/DB/Regex Status</a></td>
  </tr><tr>
  <td><a href="shutdown_list?nocache='.time.'" target="_blank">SMTP Connections </a>
  <a href="shutdown_list?nocache='.time.'&forceRefresh=1" target="_blank" onmouseover="showhint(\''.$ConnHint.'\', this, event, \'500px\', \'1\');return false;"><img height=12 width=12 src="' . $wikiinfo . '" /></a></td>
  <td><a href="shutdown">Shutdown/Restart</a></td>
  <td><a href="donations">Donations</a>'.($codename?'&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<b>'.$codename.'</b>':'').'</td>
  </tr>
  </table>
';

 $headers .= "</p>\n";
 $headers .= "&nbsp;
              <a href=\"javascript:void(0);\" onclick=\"showLeftMenu();return false;\"><small>show/hide the left menu</small></a>
              &nbsp;&nbsp;
              <a href=\"/?mobile=1\"><small>back to main view</small></a>
" if $mobile;
 $headers .= "<div id=\"topnav\" class=\"navMenu\" style=\"position:absolute;text-align:center;";
 $headers .= 'display:none;' if $mobile;
 $headers .= '">';
 $headers .= "
  <a href=\"javascript:void(0);\" onmousedown=\"expand(1, 1);return false;\">Expand All</a>&nbsp;
  <a href=\"javascript:void(0);\" onmousedown=\"expand(0, 1);return false;\">Collapse All</a>&nbsp;
";
 $headers .= ($mobile ? '<br />': "<a href=\"javascript:void(0);\" onmousedown=\"slide();return false;\">sorted</a><br />") ;
  if ($WebIP{$ActWebSess}->{user} eq 'root') {
      $headers .= "<a href=\"./adminusers\" onclick=\"eraseCookie('lastAnchor');return true;\">manage users</a>";
  } else {
      $headers .= "<a href=\"./pwd\">Change Password</a>";
  }

 $headers .= "<a href=\".?mobile=0\">&nbsp;&nbsp;full GUI</a>" if $mobile;
 $headers .= "<a href=\".?mobile=1\">&nbsp;&nbsp;mobile view</a>" if ! $mobile;

 $headers .= "
<div class=\"rightButton\" style=\"text-align: center;\">
  <input type=\"button\" value=\"logout\" onclick=\"document.forms['ASSPconfig'].theButtonLogout.value='  logout  ';eraseCookie('lastAnchor');window.location.href='./logout';return false;\" />\&nbsp;
  <a href=\"javascript:void(0);\" onclick=\"remember();return false;\" onmouseover=\"showhint('open the remember me window', this, event, '200px', '');return false;\"><img height=12 width=12 src=\"$wikiinfo\" /></a>&nbsp;
  <input type=\"button\" value=\"Apply\" onclick=\"document.forms['ASSPconfig'].theButtonX.value='Apply Changes';document.forms['ASSPconfig'].submit();WaitDiv();return false;\" />&nbsp;
";
 $headers .= "
  <a href=\"./fc\" target=\"_blank\" onmouseover=\"showhint('start the assp file commander', this, event, '200px', '');return false;\"><img height=19 width=19 src=\"get?file=images/fc_main.png\" /></a>"
    if ($CanUseASSP_FC && &canUserDo($WebIP{$ActWebSess}->{user},'action','fc'));
 $headers .= "
</div>
<hr />
</div>
";

 $headers .= "<div class=\"navMenu\"";
 if ($EnableFloatingMenu && ! $mobile) {
     $headers .= ' id="navMenu" style="position:absolute;margin:92px 0px 0px 0px;">';
 } else {
     my $hd = $mobile ? 'display:none;' : '';
     $headers .= ' id="navMenu" style="height:100%;overflow-y:hidden;position:absolute;margin:92px 0px 0px 0px;'.$hd.'"
     onmouseover="document.getElementById(\'navMenu\').style.overflowY=\'auto\';"
     onmouseout="document.getElementById(\'navMenu\').style.overflowY=\'hidden\';">';
 }

 $headers .= "
<script type=\"text/javascript\">
<!--
  setNavPosition();
// -->
</script>
";

 $headers .= "
  <div class=\"menuLevel1\"><a href=\"/\" onmousedown=\"setAnchor('delete');return false;\" /><img src=\"$plusIcon\" alt=\"plusicon\" /> Main</a><br /></div>\n<div>";
 my $counter = 0;
 for my $idx (0...$#ConfigArray) {
   my $c = $ConfigArray[$idx];
   if(@{$c} == 5) {
     $headers .= "</div>\n  <div class=\"menuLevel2\">\n  ".
       ($mobile ? '' : "<a onmousedown=\"toggleDisp('$counter');setAnchor('delete');return false;\">") .
       "<img id=\"treeIcon$counter\" src=\"$plusIcon\" alt=\"plusicon\" ". ($mobile ? "style=\"display:none \"" : '' ) . "/>" .
       ($mobile ? '' : ' '.$c->[4]).
       "</a>\n</div>\n<div id=\"treeElement$counter\" style=\"padding-left: 3px; display: block\">";
     $counter++;
   } else {
     $headers .= "\n    <div class=\"menuLevel3\"><a href=\"./#$c->[0]\" onmousedown=\"setAnchor('$c->[0]');return false;\">$c->[0]</a></div>"
       if (! $mobile && ! $hid && &canUserDo($WebIP{$ActWebSess}->{user},'cfg',$c->[0]));
   }
 }
 $headers .= "</div>
<div class=\"menuLevel1\">$NavMenu</div>
<hr />
<div class=\"rightButton\" style=\"text-align: center;\">
  <input type=\"button\" value=\"  logout  \" onclick=\"document.forms['ASSPconfig'].theButtonLogout.value='  logout  ';eraseCookie('lastAnchor');window.location.href='./logout';return false;\" />
</div>
<hr />
<div class=\"rightButton\" style=\"text-align: center;\">
  <input type=\"button\" value=\"Apply Changes\" onclick=\"document.forms['ASSPconfig'].theButtonX.value='Apply Changes';document.forms['ASSPconfig'].submit();WaitDiv();return false;\" />
</div>
<hr />
<div class=\"menuLevel2\">

	<a href=\"#\" onclick=\"return popFileEditor(\'/notes/confighistory.txt\',8); \"><img src=\"$noIcon\" alt=\"#\" /> Config Changes History</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'/notes/fc-history.txt\',8); \"><img src=\"$noIcon\" alt=\"#\" /> File Commander History</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'/notes/admininfo.txt\',8); \"><img src=\"$noIcon\" alt=\"#\" /> Admin Info Messages</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'/notes/configdefaults.txt\',8); \"><img src=\"$noIcon\" alt=\"#\" /> Non-Default Settings</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'/notes/config.txt\',8);\"><img src=\"$noIcon\" alt=\"#\" /> Config Descriptions</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'rebuildrun.txt\',8);\"><img src=\"$noIcon\" alt=\"#\" /> Last SpamDB Rebuild</a>
";

$headers .= "<hr />
	<hr />
	<span class=\"negative\"><center><b>internal Caches</b></center></span>
	<hr />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-AUTHErrors\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> AUTHErrors</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-DelayIPPB\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> DelayIPPB</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-IPNumTries\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> IPNumTries</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-IPNumTriesDuration\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> IPNumTriesDuration</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-IPNumTriesExpiration\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> IPNumTriesExp</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-SMTPdomainIP\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> SMTPdomainIP</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-SMTPdomainIPTries\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> SMTPdomainIPTries</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-SMTPdomainIPTriesExpiration\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> SMTPdomainIPTriesExp.</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-SSLfailed\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> SSLfailed</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-localTLSfailed\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> localTLSfailed</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-Stats\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> Stats</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-ScoreStats\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> ScoreStats</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-WhiteOrgList\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> WhiteOrgList</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-localFrequencyCache\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> localFrequencyCache</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-subjectFrequencyCache\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> subjectFrequencyCache</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-LDAPNotFound\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> LDAPNotFound</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-EmergencyBlock\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> EmergencyBlock</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-RFC822dom\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> RFC822dom</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-LastSchedRun\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> Scheduler History</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-T10StatI\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> TOP blocked IP\'s</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-T10StatS\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> TOP blocked senders</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-T10StatD\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> TOP blocked domains</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-T10StatR\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> TOP blocked recipients</a><br />
" if $rootlogin or &canUserDo($WebIP{$ActWebSess}->{user},'action','editinternals');

$headers .= "
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-DMARCpol\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> DMARC policies</a><br />
	<a href=\"#\" onclick=\"return popFileEditor(\'DB-DMARCrec\',\'1h\');\"><img src=\"$noIcon\" alt=\"#\" /> DMARC records</a>
" if (($rootlogin or &canUserDo($WebIP{$ActWebSess}->{user},'action','editinternals')) && $DoDKIM && $ValidateSPF);

$headers .= "<hr />
	<span style=\"font-weight: bold;\">ASSP Version</span>: $version$modversion<br />
	".($codename?"<span style=\"font-weight: bold;\">code name</span>: $codename<br />":'')."
	<span style=\"font-weight: bold;\">Current PID</span>: $mypid<br />
	<span style=\"font-weight: bold;\">Started</span>: $starttime<br />
</div>
<hr />
";

$headers .= "</div>
<script type=\"text/javascript\">
  <!--
  ";
 if (! $mobile && $EnableFloatingMenu) {
     $headers .= "document.getElementById('navMenu').style.height=ClientSize('h') + 'px';";
     $headers .= 'JSFX_FloatDiv("navMenu",2,85,2,-2,2,99999).flt();';
     $headers .= 'JSFX_FloatDiv("topnav",2,85,2,-2,2,99999).flt();';
     $headers .= '
  expand(0,0);
';
 } else {
     $headers .= '
  expand(0,0);
';
     $headers .= "document.getElementById('navMenu').style.height=ClientSize('h') + 'px';";
 }

 my @regerr = keys %RegexError;
 $headers .= "alert('found regular expression errors in : @regerr')" if @regerr;

 $headers .= '
  // -->
  </script>
  ';
  
    $footers = "
<div class=\"contentFoot\">
<a href=\"donations\">donations</a> |
<a href=\"http://assp.cvs.sourceforge.net\" rel=\"external\" target=\"_blank\">development</a> |
<a href=\"http://assp.sourceforge.net/cgi-bin/assp_stats\" rel=\"external\" target=\"_blank\">global stats</a> |
<a href=\"https://apps.sourceforge.net/mediawiki/assp/index.php?title=ASSP_Documentation\" rel=\"external\" target=\"_blank\">docs</a> |
 <a href=\"http://sourceforge.net/mail/?group_id=69172\" rel=\"external\" target=\"_blank\">email lists</a> |

 <a href=\"http://apps.sourceforge.net/phpbb/assp/\" rel=\"external\" target=\"_blank\">community forums</a> |

 <a href=\"http://apps.sourceforge.net/mediawiki/assp/\" rel=\"external\" target=\"_blank\">wiki</a> |
 <a id=\"printLink\" href=\"javascript:void(processPrint());\">Print Config/Screen</a>
</div>";
if ($mobile) {
    $footers .= "
<script type=\"text/javascript\">
<!--
  showLeftMenu();showLeftMenu();
  document.getElementById('printLink').innerHTML = '&nbsp;';
// -->
</script>
";
} else {
    $footers .= "
<script type=\"text/javascript\">
<!--
    if (document.getElementById(\"mainhints\") != null) {
        document.getElementById('printLink').innerHTML = 'Print the Manual';
    } else {
        document.getElementById('printLink').innerHTML = 'Print the Screen';
    }
// -->
</script>
";
}

    $kudos = '
<div class="kudos">
 <a href="http://assp.cvs.sourceforge.net" rel="external" target="_blank">
 <img src="get?file=images/village.gif" alt="Development" height="31" width="31" /></a>
 <a href="http://sourceforge.net" rel="external" target="_blank">
 <img src="get?file=images/sourceforge-logo.gif" alt="SourceForge" height="31" width="88" /></a>
 <a href="http://opensource.org" rel="external" target="_blank">
 <img src="get?file=images/opensource-logo.gif" alt="Open Source" height="31" width="88" /></a>
</div>
';
}

sub RemovePid {
 if ($pidfile) {
  d('RemovePid');
  close $PIDH;
  unlink("$base/$pidfile") or mlog(0,"warning: unable to delete $base/$pidfile");
 }
}

sub d_S {
 my ($Sdebugprint,$Snostep) = @_;
 $lastd{$WorkerNumber} = $Sdebugprint unless $Snostep;
 threads->yield();
 return unless ($debug || $ThreadDebug);
 my $Stime=&timestring();
 $Sdebugprint =~ s/\n/\[LF\]\n/go;
 $Sdebugprint =~ s/\r/\[CR\]/go;
 $Sdebugprint .= "\n" if $Sdebugprint !~ /\n$/o;
 threads->yield();
 $debugQueue->enqueue("$Stime [$WorkerName] <$Sdebugprint>");
 threads->yield();
}

sub d {
 my ($debugprint,$nostep) = @_;
 $lastd{$WorkerNumber} = $debugprint unless $nostep;
 threads->yield();
 return unless ($debug || $ThreadDebug);
 my $time=&timestring();
 $debugprint =~ s/\n/\[LF\]\n/go;
 $debugprint =~ s/\r/\[CR\]/go;
 $debugprint .= "\n" if $debugprint !~ /\n$/o;
 threads->yield();
 $debugQueue->enqueue("$time [$WorkerName] <$debugprint>");
 threads->yield();
}

sub _assp_try_restart {
    if($AsAService) {
        exec('cmd.exe /C net stop ASSPSMTP & net start ASSPSMTP');
    } elsif ($AsADaemon == 1) {
        exit 1;
    } elsif ($AutoRestartCmd && $AsADaemon == 2) {
        exec($AutoRestartCmd);
    } elsif ($AutoRestartCmd && $AsADaemon == 3) {
        exec($AutoRestartCmd);
        exit 1;
    } elsif (!$AutoRestartCmd && ($AsADaemon == 3 || $AsADaemon == 2)) {
        mlog(0,"error: AutoRestartCmd is not defined in daemon mode $AsADaemon - don't know what to do!");
        mlogWrite();
    } else {
        if ($AutoRestartCmd && $AutoRestart) {
            exec($AutoRestartCmd);
        }
        exit 1;
    }
}

sub createBDBEnv {
    my ($hash, $userenv) = @_;
    return unless $hash;

    my $env;
    my $bdbf;
    my %userenv = $userenv ? %$userenv : () ;
    $userenv{'-Cachesize'} = 512 * 1024 if $userenv{'-Cachesize'} < 512 * 1024;
    my $bdbdir = "$base/tmpDB/$hash";

  {
    lock($BDBEnvLock) if is_shared($BDBEnvLock);

    -d "$bdbdir" or mkdir "$bdbdir",0755;

    if ($NumComWorkers <= 7 && ($bdbf = getHashBDBName($hash))) {
        my $size =  -s "$base/$bdbf.bdb";
        $userenv{'-Cachesize'} = $size if ($bdbf && $size > $userenv{'-Cachesize'});
        foreach ( Glob("$base/tmpDB/$hash/*")) {
            if ($_ =~ /\.bdb$/o) {
               $size = -s "$_";
               $userenv{'-Cachesize'} = $size if ($size > $userenv{'-Cachesize'});
            }
        }
    }
    $userenv{'-Cachesize'} = 10*1024*1024 if $userenv{'-Cachesize'} >  10*1024*1024; # max 10MB
    $bdbf ||= "tmpDB/$hash/$hash";

eval (<<'EOT');
    $env = BerkeleyDB::Env->new(-Flags => DB_INIT_CDB | DB_INIT_MPOOL | DB_CREATE ,
                                -LockDetect => DB_LOCK_DEFAULT,
                                -Home => "$bdbdir",
                                -Config => {DB_DATA_DIR => "$bdbdir",
                                            DB_LOG_DIR  => "$bdbdir",
                                            DB_TMP_DIR  => "$bdbdir"
                                           },
                                 %userenv
                               );
    mlog(0,"BerkeleyDB-CRT-ENV-ERROR (1) in HASH $hash , on file $base/$bdbf.bdb : BDB:$BerkeleyDB::Error")
        if ($BerkeleyDB::Error !~ /: 0\s*$/o);

    if ($WorkerNumber == 10000 && $BerkeleyDB::Error =~ /DB_RUNRECOVERY|Bad file descriptor/oi) {
        undef $env;
        mlog(0,"info: try BDB-Env recovery for hash $hash");
        unlink "$bdbdir/__db.001";
        unlink "$bdbdir/__db.002";
        unlink "$bdbdir/__db.003";
        unlink "$bdbdir/__db.004";
        unlink "$bdbdir/$hash.bdb";

        if ($hash eq 'Griplist') {
            unlink "$base/griplist";
            unlink "$base/griplist.bin";
            unlink "$base/griplist.delta";
            unlink "$base/griplist.bdb";
            $NextGriplistDownload = 0;
            mlog(0,"warning: removed all files for hash $hash to recover from corruption with new download");
        } elsif ($hash eq 'BackDNS2') {
            my ($file) = $localBackDNSFile =~ /^ *file: *(.+)/io;
            if ($file) {
                unlink "$base/$file.txt";
                unlink "$base/$file.gz";
                $NextBackDNSFileDownload = 0;
                mlog(0,"warning: removed all files for hash $hash to recover from corruption with new download");
            }
        } else {
            my $hashfile = getHashBDBName($hash);
            if (-e "$base/$hashfile.bdb") {
                my $todel = $hashfile;
                $hashfile = "/$hashfile" if $hashfile !~ /\//o;
                ($hashfile) = $hashfile =~ /^.*\/([^\/]+)$/o;
                my $src="$base/$backupDBDir/$hashfile";
                my $tar="$base/$importDBDir/$hashfile.rpl";
                if (copy($src,$tar)) {
                    unlink "$base/$todel.bdb";
                    mlog(0,"info: recover corrupt BerkeleyDB for hash $hash from last backup");
                    $RunTaskNow{ImportMysqlDB} = 10000;
                } else {
                    mlog(0,"warning: unable to recover corrupt BerkeleyDB hash from last backup - unable to copy $base/$backupDBDir/$hashfile to $base/$importDBDir/$hashfile.rpl - $!");
                }
            }
        }
        
        $env = BerkeleyDB::Env->new(-Flags => DB_INIT_CDB | DB_INIT_MPOOL | DB_CREATE ,
                                    -LockDetect => DB_LOCK_DEFAULT,
                                    -Home => "$bdbdir",
                                    -Config => {DB_DATA_DIR => "$bdbdir",
                                               DB_LOG_DIR  => "$bdbdir",
                                                DB_TMP_DIR  => "$bdbdir"
                                               },
                                     %userenv
                                   );
        mlog(0,"BerkeleyDB-CRT-ENV-ERROR (2) in HASH $hash , on file $base/$bdbf.bdb : BDB:$BerkeleyDB::Error")
            if ($BerkeleyDB::Error !~ /: 0\s*$/o);


        if ($BerkeleyDB::Error =~ /DB_RUNRECOVERY|Bad file descriptor/oi) {
            $ConfigAdd{clearBerkeleyDBEnv} = 1;
            if ($WorkerNumber == 0) {
                SaveConfig();
            } else {
                $ConfigChanged = 1;
            }
            mlog(0,"error: BerkeleyDB for hash $hash ($base/$bdbf.bdb) needs to be recovered - recovery will be done at next start - try to restart assp now");
            mlogWrite() if $WorkerNumber == 0;
            $doShutdown = time + 15;
            die "BDB for $hash needs recovery\n";
        }
    }
    $env->set_timeout(1000000,DB_SET_LOCK_TIMEOUT) if $env;
EOT
  }
    if ($@ || $BerkeleyDB::Error !~ /: 0\s*$/o || ! $env) {
         mlog(0,"BerkeleyDB-ENV-ERROR $hash: $@ - BDB:$BerkeleyDB::Error");
         $ComWorker{$WorkerNumber}->{run} = 0 if $WorkerNumber > 0;
         $ComWorker{$WorkerNumber}->{inerror} = 1 if $WorkerNumber > 0;
         delete $BerkeleyDBHashes{$hash};
         die "BerkeleyDB-ENV-ERROR $hash: $@ - BDB:$BerkeleyDB::Error\n" if $WorkerNumber > 0 || ! $doShutdown;
    } else {
         my $bcache =  &formatDataSize(-s "$base/tmpDB/$hash/__db.003",1);
         mlog(0,"info: list $hash is using 'BerkeleyDB' version $BerkeleyDB::db_version - cachesize is $bcache") if $WorkerNumber == 0;
         $BerkeleyDBHashes{$hash} = time;
    }
    return $env;
}

sub tieToBDB {
    my ($hash,$file,$env) = @_;
    my $Object = $hash . 'Obj';

eval (<<'EOT');
    ${$Object}=tie %$hash,'BerkeleyDB::Hash',
                       (-Filename => "$file",
                        -Flags => DB_CREATE,
                        -Env => $env);
    BDB_filter(${$Object});
EOT
    if ($@ or $BerkeleyDB::Error !~ /: 0\s*$/o) {
        mlog(0,"BerkeleyDB-TIE-ERROR $hash: $@ - BDB:$BerkeleyDB::Error");
        $ComWorker{$WorkerNumber}->{run} = 0 if $WorkerNumber > 0;
        $ComWorker{$WorkerNumber}->{inerror} = 1 if $WorkerNumber > 0;
        die "$@\n";
    }
    BDB_getRecordCount($hash);
}

sub BDB_sync {
    d('BDB_sync');
    my $timeout = shift;
    $timeout = 0 unless $timeout;
    if ($DoSyncBDB) {
        mlog(0,'info: synchronizing all BerkeleyDB hashes to disk') if $MaintenanceLog;
        foreach (keys %BerkeleyDBHashes) {
            d("BDB_sync - $_");
            my $res = &BDB_sync_hash($_);
        }
        mlogWrite() if $WorkerName eq 'Shutdown';
    }
    if ($DoCompactBDB && $WorkerName ne 'Shutdown') {
        mlog(0,'info: compacting all BerkeleyDB hashes on disk') if $MaintenanceLog;
        foreach (keys %BerkeleyDBHashes) {
            d("BDB_compact - $_");
            my $res = BDB_compact_hash($_,$timeout);
        }
    }
    return 1;
}

sub BDB_sync_hash {
    my $hash = shift;
    return 0 unless $hash;
    return 0 unless $DoSyncBDB;
    return 0 unless tied %{$hash};
    my $dbo = $hash . 'Object';     # main hashes
    $dbo = $hash . 'Obj' unless defined ${$dbo};   # temp hashes
    return 0 unless defined ${$dbo};
    my $res;
    if ("$$dbo" =~ /assp::/io) {
        eval{
             my $lock;
             $lock = ${$dbo}->{hashobj}->cds_lock() if $main::lockBDB && ${$dbo}->{hashobj}->cds_enabled();
             $res = ${$dbo}->{hashobj}->db_sync();
        };
    } else {
        eval{
             my $lock;
             $lock = ${$dbo}->cds_lock() if $main::lockBDB && ${$dbo}->cds_enabled();
             $res = ${$dbo}->db_sync();
        };
    }
    if ($@ or ($res != 0 && $BerkeleyDB::error)) {
        mlog(0,"warning: unable to write cache of BerkeleyDB hash $hash to disk - $@ - BDB:$BerkeleyDB::error");
        return 0;
    } else {
        mlog(0,"info: synchronized BerkeleyDB hash $hash to disk") if $MaintenanceLog >= 2 && $dbo !~ /Obj$/o;
    }
    return 1;
}

sub BDB_compact_hash {
    my ($hash , $timeout) = @_;
    return 0 unless $hash;
    return 0 unless tied %{$hash};
    my $dbo = $hash . 'Object';     # main hashes
    $dbo = $hash . 'Obj' unless defined ${$dbo};   # temp hashes
    return 0 unless defined ${$dbo};
    my $res;

    return 1 unless (($WorkerNumber == 10000 and $BerkeleyDBHashes{$hash} > time) or $WorkerNumber == 0);
    $BerkeleyDBHashes{$hash} = time + 3600;

    my $bdbf = getHashBDBName($hash);
    my %hash;
    $hash{compact_fillpercent} = 10;
    $timeout *= 1000000;
    $timeout ||= 1000000; # 1 second
    $hash{compact_timeout} = $timeout;

    if ("$$dbo" =~ /assp::/io) {
        eval (<<'EOT');
             my $lock;
             $lock = ${$dbo}->{hashobj}->cds_lock() if $main::lockBDB && ${$dbo}->{hashobj}->cds_enabled();
             $res = ${$dbo}->{hashobj}->compact(undef,
                                                undef,
                                                \%hash,
                                                DB_FREE_SPACE
                                               );
EOT
    } else {
        eval (<<'EOT');
             my $lock;
             $lock = ${$dbo}->cds_lock() if $main::lockBDB && ${$dbo}->cds_enabled();
             $res = ${$dbo}->compact(undef,
                                     undef,
                                     \%hash,
                                     DB_FREE_SPACE
                                    );
EOT
    }
    if ($@ or ($res != 0 && $BerkeleyDB::error)) {
        mlog(0,"warning: unable to compact file $base/$bdbf.bdb of BerkeleyDB hash $hash - $@ - BDB:$BerkeleyDB::error");
        return 0;
    } else {
        my $ext;
        if ($MaintenanceLog > 2 && $dbo !~ /Obj$/o && keys %hash) {
            $ext = ' [';
            foreach (keys %hash) {
                $ext .= "$_: $hash{$_}, ";
            }
            $ext =~ s/, $//o;
            $ext .= ']';
        }
        mlog(0,"info: done compact file $base/$bdbf.bdb of BerkeleyDB hash $hash$ext")
            if $MaintenanceLog >= 2 && $dbo !~ /Obj$/o;
        return 1;
    }
}

sub BDB_getRecordCount {
    my $hash = shift;
    return 0 unless $hash;
    return 0 unless exists $BerkeleyDBHashes{$hash};
    return 0 unless tied %{$hash};
    my $dbo = $hash . 'Object';     # main hashes
    $dbo = $hash . 'Obj' unless defined ${$dbo};   # temp hashes
    return 0 unless defined ${$dbo};
    my $statref;
    if ("$$dbo" =~ /assp::/io) {
        eval (<<'EOT');
             $statref = ${$dbo}->{hashobj}->db_stat();
EOT
    } else {
        eval (<<'EOT');
             $statref = ${$dbo}->db_stat();
EOT
    }
    return 0 unless $statref;
    return 0 unless ref $statref;
    return $statref->{hash_ndata};
}

sub showBDBstatus {
    my @hashes = @_;
    while (shift @hashes) {
        unless (exists $BerkeleyDBHashes{$_}) {
            mlog(0,"info: showBDBstatus - hash $_ is not a BerkeleyDB hash");
            next;
        }
        my $dbo = $_ . 'Object';
        $dbo = $_ . 'Obj' unless defined ${$dbo};
        if (! defined ${$dbo} ) {
            mlog(0,"hash: $_ is not tied");
            return;
        }
        mlog(0,"BDB statistic for BerkeleDB hash $_ on $dbo");
        my $statref;
        if ("$$dbo" =~ /assp::/io) {
            eval (<<'EOT');
                 $statref = ${$dbo}->{hashobj}->db_stat();
EOT
        } else {
            eval (<<'EOT');
                 $statref = ${$dbo}->db_stat();
EOT
        }
        my $out = "\n";
        foreach (sort keys %{$statref}) {
            $out .= $_ . (' ' x (16 - length($_))) . ": ${$statref}{$_}\n";
        }
        mlog(0,$out);
        mlog(0, "lock status for BerkleyDB hash $_ on $dbo");
        if ($VerBerkeleyDB lt '0.42') {
            ${${$dbo}}[1]->lock_stat_print;
        } else {
            ${$dbo}->Env->lock_stat_print;
        }
    }
}

sub BDB_filter {
    my $obj = shift;
    return unless $obj;
    eval{
    $obj->filter_fetch_key  ( sub { threads->yield(); } ) ;
    $obj->filter_store_key  ( sub { threads->yield(); } ) ;
    };
}

sub BDB_filter_off {
    my $obj = shift;
    return unless $obj;
    eval {
    $obj->filter_fetch_key  ( sub { } ) ;
    $obj->filter_store_key  ( sub { } ) ;
    };
}

sub initPrivatHashes {
    my $clean = shift;
    if ($griplist && ! $GriplistObj) {
        if ($GriplistDriver eq 'BerkeleyDB::Hash' && $useDB4griplist) {
            my $file = "$base/$griplist";
            d("BDB-DB (initPrivatHashes) - Griplist , $file.bdb");
            &tieToBDB('Griplist', "$file.bdb", &createBDBEnv('Griplist'));
        } else {
            $GriplistObj=tie %Griplist,$GriplistDriver,$GriplistFile;
            $GriplistObj->resetCache();
            my $r = loadHashFromFile("$base/$griplist", $GriplistObj->{cache}) || 'no';
#            mlog(0,"info: Griplist has $r records") if $MaintenanceLog >= 2;
            $GriplistObj->{max} = 999999999999;
            $GriplistObj->{bin} = 0;
        }
    }

    if ($CanUseBerkeleyDB && $runHMMusesBDB && exists $tempDBvars{'HMMdb'}) {
        my $hash = 'HMMdb';
        my $file = "$base/$hash.bdb" ;
        my %userenv = ('-Cachesize' => 10 * 1024 * 1024) ;
        d("BDB-DB (initPrivatHashes) - $hash , $file");
        &tieToBDB($hash,
                  $file,
                  &createBDBEnv($hash,\%userenv)
                 ) unless tied(%{$hash});
        mlog(0,"info: HMMdb is using 'BerkeleyDB' version $BerkeleyDB::db_version in file $base/$hash.bdb, because HMMusesBDB is set to ON") if $WorkerNumber == 0;
    }
    
    if ($CanUseBerkeleyDB && $useDB4IntCache) {
        my ($BackDNS2DB) = $localBackDNSFile =~ /^ *file: *(.+)/io;
        $BackDNS2DB = "$base/tmpDB/BackDNS2/BackDNS2.bdb" if $BackDNS2DB ;

        mlog(0,"info: internal hashes are using 'BerkeleyDB' version $BerkeleyDB::db_version in directory $base/tmpDB") if $WorkerNumber == 0;

        foreach (sort keys %tempDBvars) {
            next if $_ eq 'BackDNS2';
            next if $_ =~ /^HMM/oi;
#            next if $WorkerNumber == 10001;
            my $file = "$base/tmpDB/$_/$_.bdb";
            my %userenv = ();
            d("BDB-DB (initPrivatHashes) - $_ , $file");
            &tieToBDB($_,
                      $file,
                      &createBDBEnv($_,\%userenv)
                     ) unless tied(%{$_});
            %{$_} = ()
                if (   $_ ne 'Stats'
                    && $_ ne 'ScoreStats'
                    && $_ ne 'WhiteOrgList'
                    && $_ ne 'DMARCpol'
                    && $_ ne 'DMARCrec'
                    && $_ ne 'subjectFrequencyCache'
                    && $clean
                    && $WorkerNumber == 0);
        }

        if (! tied(%BackDNS2) &&
                       $BackDNS2DB &&
                       ($DBusedDriver ne 'BerkeleyDB' or
                        ($DBusedDriver eq 'BerkeleyDB' && $pbdb !~ /DB:/io)
                       )
                      )
        {
            d("BDB-DB (initPrivatHashes) - BackDNS2 , $BackDNS2DB");
            &tieToBDB('BackDNS2',
                      $BackDNS2DB,
                      &createBDBEnv('BackDNS2')
                     );
        }
    }
}

sub initGlobalThreadVar {
    &setMakeREVars();
    &ThreadCompileAllRE(1) if $calledfromThread;
    undef $readable;
    undef $writable;
    %SocketCalls = ();
    %SocketCallsNewCon = ();
    %Con = ();
    %ConDelete = ();
    if ($IOEngineRun == 0) {
        $readable = IO::Poll->new();
        $writable = IO::Poll->new();
    } else {
        $readable = IO::Select->new();
        $writable = IO::Select->new();
    }
}

sub checkINC {
    for my $p ("$base","$base/lib","$base/Plugins") {
        unshift(@INC,$_) unless(grep(/^\Q$p\E$/,@INC));
    }
}

sub init {
 my $ver;
 my $append;
 my $installed;
 $DataBaseDebug = $DataBaseDebug ? 1 : 0;
 if ($DBCacheSize) {
     my $size = $NumComWorkers * 2 + 8;
     $DBCacheSize = $size if $size > $DBCacheSize;
 }
 while (@prelog) {
     mlog(0, shift @prelog);
 }

 if($] lt '5.012003') {
   mlog(0, "warning: Perl version 5.012003 (5.12.3) is at least recommended to run ASSP $version $modversion - you are running Perl version $] - please upgrade Perl");
 }
 if($] lt '5.012000') {
   mlog(0, "Perl version 5.012000 (5.12.0) is at least required to use the unicode Bayesian/HMM engine of ASSP $version $modversion - you are running Perl version $] - please upgrade Perl");
 }
 my $p;
 $p = '-professional' if ($setpro && $globalClientName && $globalClientPass);
 if ($localhostname) {
     mlog(0,"ASSP$p version $version$modversion (Perl $]) (on $^O)running on server: $localhostname ($localhostip)");
 } else {
     mlog(0,"ASSP$p version $version$modversion (Perl $]) (on $^O) running on server: localhost ($localhostip)") ;
 }
 if ($canUnicode) {
     mlog(0,"info: unicode support is available on that system");
 } else {
     mlog(0,"info: unicode support is not available on that system");
 }

 print 'check process env ';

 if ($MaintenanceLog > 1) {
     mlog(0,"info: Perl will search for modules in the following folders:\n". join("\n",map {my $t = $_ ; $t = "'$t'";$t;} @INC));
     mlog(0,"info: beside the default Perl search pathes, this list has to contain:\n$base\n$base/lib\n$base/Plugins");
 }

 $MailCount = 0;

 readNorm();

 &initGlobalThreadVar();

 $MinPollTimeT =  $MinPollTime ? $MinPollTime : 1 ;
 $pollwait = $MinPollTimeT/1000;

 my $perlver=$];
 $WorkerName = 'init';
  if ( $^O eq 'MSWin32' ) {
       eval{
           mlog(0,'info: analysing windows system environment');
           my @msvcrt;
           my @where = split(/;/o,$ENV{'PATH'});
           my $perls = $perl;
           $perls =~ s/\\[^\\]+$//o;
           $perls =~ s/\\[^\\]+$//o;
           $perls .= '\site\bin';
           unshift (@where, $perls);
           my $perl = $perl;
           $perl =~ s/\\[^\\]+$//o;
           unshift (@where, $perl);
           my $dbase = $base;
           $dbase =~ s/\//\\/go;
           $dbase =~ s/[\\|\/]*$//o;
           unshift (@where, $dbase);
           my $path_to_msvcrt;
           while ( my $pdir = shift @where) {
               if (-e "$pdir/msvcrt.dll") {
                   $path_to_msvcrt = $pdir;
                   last;
               }
           }
           $path_to_msvcrt =~ s/[\\|\/]*$//o;
           if (lc $path_to_msvcrt ne lc ($ENV{'SystemRoot'}.'\system32')) {
               mlog(0,"warning: Perl seems to use the C-runtime library 'msvcrt.dll' in directory $path_to_msvcrt, this should be MS-C-runtime library 'msvcrt.dll' in directory ".$ENV{'SystemRoot'}.'\system32. Your environment variable -PATH- is possibly wrong set!');
               print "\t\t\t\t\t[warning]";
           } else {
               mlog(0,'info: windows system environment looks OK');
               print "\t\t\t\t\t[OK]";
           }
       };
       if ($@) {
           mlog(0,"warning: unable to analyse windows system environment - $@");
           print "\t\t\t\t\t[ERROR]";
       }
  } else {
       print "\t\t\t\t\t[SKIP]";
  }
  if ( $perlver > "5.999999") {
       mlog(0,"Perl version $perlver is not supported for ASSP Version 2.x.x!");
  }

  print "\ncheck process permission";

  my $tmpASSPout;
  my $StartError;
  if (open($tmpASSPout, ">", "$base/aaaa_tmp.pl")) {
      binmode $tmpASSPout;
      close $tmpASSPout;
      my $assp = $assp;
      $assp =~ s/\\/\//og;
      $assp = $base.'/'.$assp if ($assp !~ /\Q$base\E/io);
      copy("$assp","$base/aaaa_tmp.pl");
      if (-e ($assp.'.run')) {
          unlink($assp.'.run') or mlog(0,"error: unable to remove old saved running script '$assp.run' - $!");
      }
      copy("$assp",$assp.'.run') or mlog(0,"error: unable to save current running script to file '$assp.run'");
      unless (rename("$base/aaaa_tmp.pl","$base/aaaa_tmpx.pl") && unlink("$base/aaaa_tmpx.pl")) {
        mlog(0,'************************************************************');
        mlog(0,"error: this process is unable to rename and/or delete files in directory $base");
        mlog(0,"error: $!");
        mlog(0,'error: check permission and disable all online virusscanners for this directory');
        mlog(0,'error: remove manualy the files aaaa_tmp.pl and aaaa_tmpx.pl from this directory');
        mlog(0,'error: restart assp');
        mlog(0,'************************************************************');
        $StartError = 1;
            print "\t\t\t\t[ERROR]";
      } else {
            print "\t\t\t\t[OK]";
      }
  } else {
      mlog(0,'************************************************************');
      mlog(0,"error: this process is unable to write in to directory $base");
      mlog(0,"error: $!");
      mlog(0,'error: check permission and disable all online virusscanners for this directory');
      mlog(0,'error: remove manualy the files aaaa_tmp.pl and aaaa_tmpx.pl from this directory');
      mlog(0,'error: restart assp');
      mlog(0,'************************************************************');
      $StartError = 1;
      print "\t\t\t\t[ERROR]";
  }
  unlink("$base/aaaa_tmp.pl");

  print "\nsetting up modules";
  $append = '';
  $ver=threads->VERSION;
  $append = '- please upgrade to version 1.74 or higher' if ($ver lt '1.74');
  mlog(0,"threads module $ver installed $append");
  $ModuleList{'threads'} = $ver.'/1.74';
  print '.';

  $append = '';
  $ver=threads::shared->VERSION;
  $append = '- please upgrade to version 1.32 or higher' if ($ver lt '1.32');
  mlog(0,"threads::shared module $ver installed $append");
  $ModuleList{'threads::shared'} = $ver.'/1.32';
  print '.';

  $append = '';
  $ver=Thread::Queue->VERSION;
  $append = '- please upgrade to version 2.11 or higher' if ($ver lt '2.11');
  mlog(0,"Thread::Queue module $ver installed $append");
  $ModuleList{'Thread::Queue'} = $ver.'/2.11';
  print '.';

  $append = '';
  $ver=IO::Poll->VERSION;
  $ver =~ s/0+$//o;
  $append = '- please upgrade to version 0.07' if ($ver lt '0.07');
  mlog(0,"IO::Poll module $ver installed $append");
  $ModuleList{'IO::Poll'} = $ver.'/0.07';

  $append = '';
  $ver=IO::Select->VERSION;
  $append = '- please upgrade to version 1.17' if ($ver lt '1.17');
  mlog(0,"IO::Select module $ver installed $append");
  $ModuleList{'IO::Select'} = $ver.'/1.17';

  if ($IOEngineRun == 0) {
      mlog(0,'ASSP is using IOEngine - Poll');
  } else {
      mlog(0,'ASSP is using IOEngine - select');
  }

  if ($CanUseThreadState) {
    $ver=eval('Thread::State->VERSION'); $VerThreadState=$ver;
    if ($ver ge '0.09') {
        $ver=" version $ver" if $ver;
        mlog(0,"Thread::State module$ver installed and available");
    } else {
        $ver=" version $ver" if $ver;
        mlog(0,"Thread::State module$ver installed - but version 0.09 or higher is required - Thread::State is not available");
        $CanUseThreadState = 0;
    }
    $installed = 'enabled';
  } else {
    $installed = $useThreadState ? 'is not installed' : 'is disabled in config';
    mlog(0,"Thread::State 0.09 module $installed.");
  }
  $ModuleList{'Thread::State'} = $VerThreadState.'/0.09';
  $ModuleStat{'Thread::State'} = $installed;

  $ver = IO::Socket->VERSION;
  if ($ver lt '1.30') {
      *{'IO::Socket::blocking'} = *{'main::assp_socket_blocking'};   # MSWIN32 fix for nonblocking Sockets
      mlog(0,"IO::Socket version $ver is too less - recommended is 1.30_01 - hook ->blocking to internal procedure");
  }
  print '.';

  if ($CanUseIOSocketINET6 || $SysIOSocketINET6 == 0) {
    $ver=eval('IO::Socket::INET6->VERSION'); $VerIOSocketINET6=$ver; $ver=" version $ver" if $ver;
    my $sys = ($SysIOSocketINET6 == 1) ? '' : ' - but IPv6 is not supported by your system';
    mlog(0,"IO::Socket::INET6 module$ver installed and available$sys");
    mlog(0,'please upgrade the module IO::Socket::INET6 to version 2.67 or higher') if ($VerIOSocketINET6 lt '2.67');
    $installed = ($SysIOSocketINET6 == 1) ? 'enabled' : 'not supported';
  } else {
    $installed = $useIOSocketINET6 ? 'is not installed' : 'is disabled in config';
    $installed = 'is not detected (enableIPv6 is not set)';
    mlog(0,"IO::Socket::INET6 module $installed.");
  }
  $ModuleList{'IO::Socket::INET6'} = $VerIOSocketINET6.'/2.67';
  $ModuleStat{'IO::Socket::INET6'} = $installed;

  if ($CanUseAvClamd) {
    *{'File::Scan::ClamAV::ping'} = *{'main::ClamScanPing'};
    *{'File::Scan::ClamAV::streamscan'} = *{'main::ClamScanScan'};
    my $clamavd = File::Scan::ClamAV->new(port => $AvClamdPort);
    if($clamavd->ping()) {
      $AvailAvClamd = 1;
      $ver = $clamavd->VERSION;
      $VerFileScanClamAV=$ver; $ver=" version $ver" if $ver;
      $ModuleList{'File::Scan::ClamAV'} = $VerFileScanClamAV.'/1.8';
      $ModuleStat{'File::Scan::ClamAV'} = 'enabled';
      mlog(0,"File::Scan::ClamAV module$ver installed and available");
    } else {
      $AvailAvClamd = 0;
      $ver = $clamavd->VERSION;
      $VerFileScanClamAV=$ver; $ver=" version $ver" if $ver;
      $ModuleList{'File::Scan::ClamAV'} = $VerFileScanClamAV.'/1.8';
      mlog(0,"File::Scan::ClamAV module$ver installed but not available, error: ".$clamavd->errstr());
      $ModuleStat{'File::Scan::ClamAV'} = $clamavd->errstr();
    }
  } else {
    $AvailAvClamd = 0;
    $VerFileScanClamAV = '';
    $ModuleList{'File::Scan::ClamAV'} = $VerFileScanClamAV.'/1.8';
    $installed = $useFileScanClamAV ? 'is not installed' : 'is disabled in config';
    mlog(0,"File::Scan::ClamAV module $installed.") if $UseAvClamd;
    $ModuleStat{'File::Scan::ClamAV'} = $installed;
  }
  print '.';

  if ($CanUseLDAP) {
    $ver=eval('Net::LDAP->VERSION'); $VerNetLDAP=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Net::LDAP module$ver installed and available");
    $installed = 'enabled';
  } else {
    $installed = $useNetLDAP ? 'is not installed' : 'is disabled in config';
    mlog(0,"Net::LDAP module $installed.") if $DoLDAP;
  }
  $ModuleList{'Net::LDAP'} = $VerNetLDAP.'/0.33';
  $ModuleStat{'Net::LDAP'} = $installed;

  if ($CanUseDNS) {
    $ver=eval('Net::DNS->VERSION'); $VerNetDNS=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Net::DNS module$ver installed and available");
    $installed = 'enabled';
    my $d = Net::DNS::Resolver->new();
    $orgNewDNSResolver = \&Net::DNS::Resolver::Base::new;
    *Net::DNS::Resolver::Base::new = \&getDNSResolver;
  } else {
    $installed = $useNetDNS ? 'is not installed' : 'is disabled in config';
    mlog(0,"Net::DNS module $installed.");
  }
  $ModuleList{'Net::DNS'} = $VerNetDNS.'/0.61';
  $ModuleStat{'Net::DNS'} = $installed;

  if ($CanUseNetSMTP) {
    $ver=eval('Net::SMTP->VERSION'); $VerNetSMTP=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Net::SMTP module$ver installed and available");
    $installed = 'enabled';
  } else {
    $installed = $useNetSMTP ? 'is not installed' : 'is disabled in config';
    mlog(0,"Net::SMTP module $installed.") if $DoRFC822 || $DoDomainCheck;
  }
  $ModuleList{'Net::SMTP'} = $VerNetSMTP.'/2.31';
  $ModuleStat{'Net::SMTP'} = $installed;

  if ($CanUseNetSMTPTLS) {
    $ver=eval('Net::SMTP::TLS->VERSION'); $VerNetSMTPTLS=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Net::SMTP::TLS module$ver installed and available");
    $installed = 'enabled';
    *{'Net::SMTP::TLS::starttls'} = *{'main::NST_starttls'};
  } else {
    $installed = $useNetSMTPTLS ? 'is not installed' : 'is disabled in config';
    mlog(0,"Net::SMTP::TLS module $installed.");
  }
  $ModuleList{'Net::SMTP::TLS'} = $VerNetSMTPTLS.'/0.12';
  $ModuleStat{'Net::SMTP::TLS'} = $installed;

  if ($CanUseNetSNMPagent) {
    $ver=eval('NetSNMP::agent->VERSION'); $VerNetSNMPagent=$ver; $ver=" version $ver" if $ver;
    ;
    foreach (@NetSNMP::ASN::EXPORT) {
        eval ('$SNMPAS{$_} = NetSNMP::ASN::constant($_, 0);1;') ||
        eval ('$SNMPAS{$_} = NetSNMP::ASN::constant($_);1;') ||
        ( mlog(0,"error: unable to get constant ($_) for NetSNMP::ASN - $@") &&
          ($installed = 'ASN constant error') && ($CanUseNetSNMPagent = ''));
    }
    foreach (@NetSNMP::agent::EXPORT) {
        eval ('$SNMPag{$_} = NetSNMP::agent::constant($_, 0);1;') ||
        eval ('$SNMPag{$_} = NetSNMP::agent::constant($_);1;') ||
        ( mlog(0,"error: unable to get constant ($_) for NetSNMP::agent - $@") &&
          ($installed = 'agent constant error') && ($CanUseNetSNMPagent = ''));
    }
    if ($CanUseNetSNMPagent) {
        mlog(0,"NetSNMP::agent module$ver installed and available");
    } else {
        mlog(0,"NetSNMP::agent module$ver installed but disabled because of an '$installed'");
    }
  } else {
    $installed = $useNetSNMPagent ? 'is not installed' : 'is disabled in config';
    mlog(0,"NetSNMP::agent module $installed.");
  }
  $ModuleList{'NetSNMP::agent'} = $VerNetSNMPagent.'/5.05';
  $ModuleStat{'NetSNMP::agent'} = $installed;

  if ($CanUseSPF) {
    $ver=eval('Mail::SPF::Query->VERSION'); $VerMailSPF=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Mail::SPF::Query module$ver installed and available");
    $installed = 'enabled';
  } elsif ($AvailSPF) {
    $ver=eval('Mail::SPF::Query->VERSION'); $ver=" version $ver" if $ver;
    mlog(0,"Mail::SPF::Query module$ver installed but Net::DNS required");
    $installed = 'Net::DNS required';
  } else {
    $installed = $useMailSPFQuery ? 'is not installed' : 'is disabled in config';
    mlog(0,"Mail::SPF::Query module $installed.") if $ValidateSPF;
  }
  $ModuleList{'Mail::SPF::Query'} = $VerMailSPF.'/1.999001';
  $ModuleStat{'Mail::SPF::Query'} = $installed;

  if ($CanUseSPF2) {
   $ver        = eval('Mail::SPF->VERSION');
   $ver        =~ s/^v//gio; # strip leading 'v'
   $VerMailSPF = $ver;
   $ver        = " version $ver" if $ver;
   if ( $VerMailSPF >= 2.007 ) {
    mlog(0, "Mail::SPF module$ver installed and available" );
    $installed = 'enabled';
   } else {
    mlog(0, "Mail::SPF module$ver installed but must be >= 2.007" );
    mlog(0, 'Mail::SPF will not be used.' );
    $CanUseSPF2 = 0;
    $installed = 'wrong version';
   }
  } elsif ($AvailSPF2) {
   $ver = eval('Mail::SPF->VERSION');
   $ver =~ s/^v//gio; # strip leading 'v'
   $ver = " version $ver" if $ver;
   mlog(0, "Mail::SPF module$ver installed but Net::DNS required" );
   $installed = 'Net::DNS required';
  } else {
   $installed = $useMailSPF ? 'is not installed' : 'is disabled in config';
   mlog(0, "Mail::SPF module $installed." ) if $ValidateSPF;
  } 
  $ModuleList{'Mail::SPF'} = $VerMailSPF.'/2.007';
  $ModuleStat{'Mail::SPF'} = $installed;

  if ($CanUseSRS) {
    $ver=eval('Mail::SRS->VERSION'); $VerMailSRS=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Mail::SRS module$ver installed - Sender Rewriting Scheme available");
    $installed = 'enabled';
  } elsif (!$AvailSRS) {
    $installed = $useMailSRS ? 'is not installed' : 'is disabled in config';
    mlog(0,"Mail::SRS module $installed - Sender Rewriting Scheme disabled") if $EnableSRS;
  }
  $ModuleList{'Mail::SRS'} = $VerMailSRS.'/0.31';
  $ModuleStat{'Mail::SRS'} = $installed;

  if ($CanUseHTTPCompression) {
    $ver=eval('Compress::Zlib->VERSION'); $VerCompressZlib=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Compress::Zlib module$ver installed - HTTP compression available");
    $installed = 'enabled';
  } elsif (!$AvailZlib) {
    $installed = $useCompressZlib ? 'is not installed' : 'is disabled in config';
    mlog(0,"Compress::Zlib module $installed - HTTP compression disabled");
  }
  $ModuleList{'Compress::Zlib'} = $VerCompressZlib.'/2.008';
  $ModuleStat{'Compress::Zlib'} = $installed;

  if ($CanUseMD5Keys) {
    $ver=eval('Digest::MD5->VERSION'); $VerDigestMD5=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Digest::MD5 module$ver installed - delaying can use MD5 keys for hashes");
    $installed = 'enabled';
  } else {
    $installed = $useDigestMD5 ? 'is not installed' : 'is disabled in config';
    mlog(0,"Digest::MD5 module $installed - delaying can not use MD5 keys for hashes");
  }
  $ModuleList{'Digest::MD5'} = $VerDigestMD5.'/2.36_01';
  $ModuleStat{'Digest::MD5'} = $installed;

  if ($CanUseSHA1) {
    $ver=eval('Digest::SHA1->VERSION'); $VerDigestSHA1=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Digest::SHA1 module$ver installed - BATV and FBMTV check available");
    $installed = 'enabled';
  } else {
    $installed = $useDigestSHA1 ? 'is not installed' : 'is disabled in config';
    mlog(0,"Digest::SHA1 module $installed - BATV and FBMTV check not available");
  }
  $ModuleList{'Digest::SHA1'} = $VerDigestSHA1.'/2.11';
  $ModuleStat{'Digest::SHA1'} = $installed;

  if ($CanSearchLogs) {
    $ver=eval('File::ReadBackwards->VERSION'); $VerFileReadBackwards=$ver; $ver=" version $ver" if $ver;
    mlog(0,"File::ReadBackwards module$ver installed - searching of log files enabled");
    $installed = 'enabled';
  } elsif (!$AvailReadBackwards) {
    $installed = $useFileReadBackwards ? 'is not installed' : 'is disabled in config';
    mlog(0,"File::ReadBackwards module $installed - searching of log files disabled");
  }
  $ModuleList{'File::ReadBackwards'} = $VerFileReadBackwards.'/1.04';
  $ModuleStat{'File::ReadBackwards'} = $installed;

  if ($CanStatCPU) {
    $ver=eval('Time::HiRes->VERSION'); $VerTimeHiRes=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Time::HiRes module$ver installed - CPU usage statistics available");
  }
  $ModuleList{'Time::HiRes'} = $VerTimeHiRes.'/1.9707';
  $ModuleStat{'Time::HiRes'} = 'enabled';

  if ($CanChroot) {
    $ver=eval('PerlIO::scalar->VERSION'); $VerPerlIOscalar=$ver; $ver=" version $VerPerlIOscalar" if $ver;
    if ($ChangeRoot) {
        mlog(0,"PerlIO::scalar module$ver installed - chroot savy");
        mlog(0,"error: ChangeRoot - /etc/protocols in $ChangeRoot not found!") unless -e "$ChangeRoot/etc/protocols";
    }
    $installed = 'enabled';
  } else {
    $installed = $usePerlIOscalar ? 'is not installed' : 'is disabled in config';
    mlog(0,"PerlIO::scalar module $installed - chroot not available") if $ChangeRoot;
  }
  $ModuleList{'PerlIO::scalar'} = $VerPerlIOscalar.'/0.05';
  $ModuleStat{'PerlIO::scalar'} = $installed;

  if ($CanUseSyslog){
    $ver=eval('Sys::Syslog->VERSION'); $VerSysSyslog=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Sys::Syslog module$ver installed - Unix centralized logging enabled");
    $installed = 'enabled';
  } elsif (!$AvailSyslog ) {
    $installed = $useSysSyslog ? 'is not installed' : 'is disabled in config';
    mlog(0,"Sys::Syslog module $installed.") if $sysLog && !$sysLogPort;
  }
  $ModuleList{'Sys::Syslog'} = $VerSysSyslog.'/0.25';
  $ModuleStat{'Sys::Syslog'} = $installed;

  if ($CanUseWin32Daemon){
    $ver=eval('Win32::Daemon->VERSION'); $VerWin32Daemon=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Win32::Daemon module$ver installed - can run as Win32 service") if ( $^O eq 'MSWin32' );
    $installed = 'enabled';
  } else {
    $installed = $useWin32Daemon ? 'is not installed' : 'is disabled in config';
    mlog(0,"Win32::Daemon module $installed - unable to run as Win32 service") if ( $^O eq 'MSWin32' );
  }
  $ModuleList{'Win32::Daemon'} = $VerWin32Daemon.'/20080324';
  $ModuleStat{'Win32::Daemon'} = $installed;

  if ($CanUseWin32Debug){
    $ver=eval('Win32::API::OutputDebugString->VERSION'); $VerWin32APIOutputDebugString=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Win32::API::OutputDebugString module$ver installed - can debug to Win32 debug API") if ( $^O eq 'MSWin32' );
    $installed = 'enabled';
  } else {
    $installed = $useWin32APIOutputDebugString ? 'is not installed' : 'is disabled in config';
    mlog(0,"Win32::API::OutputDebugString module $installed - unable to debug to Win32 API") if ( $^O eq 'MSWin32' );
  }
  $ModuleList{'Win32::API::OutputDebugString'} = $VerWin32APIOutputDebugString.'/0.03';
  $ModuleStat{'Win32::API::OutputDebugString'} = $installed;

  if ($CanUseUnicodeGCString){
    $ver=eval('Unicode::GCString->VERSION'); $VerUnicodeGCString=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Unicode::GCString module$ver installed - can detect east asian language strings as sequence of UAX #29 Grapheme Clusters to analyze Bayes and HMM");
    $installed = 'enabled';
    $requiredDBVersion{'Spamdb'} .= '_UAX#29';
    $requiredDBVersion{'HMMdb'}  .= '_UAX#29';
  } else {
    $installed = $useUnicodeGCString ? 'is not installed' : 'is disabled in config';
    mlog(0,"Unicode::GCString module $installed - unable to detect east asian language strings as sequence of UAX #29 Grapheme Clusters");
  }
  $ModuleList{'Unicode::GCString'} = $VerUnicodeGCString.'/2012.04';
  $ModuleStat{'Unicode::GCString'} = $installed;

  if ($CanUseTextUnidecode){
    $ver=eval('Text::Unidecode->VERSION'); $VerTextUnidecode=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Text::Unidecode module$ver installed - can transliterate unicode characters to ASCII");
    $installed = 'enabled';
  } else {
    $installed = $useTextUnidecode ? 'is not installed' : 'is disabled in config';
    mlog(0,"Text::Unidecode module $installed - unable to transliterate unicode characters to ASCII");
  }
  $ModuleList{'Text::Unidecode'} = $VerTextUnidecode.'/0.04';
  $ModuleStat{'Text::Unidecode'} = $installed;

  if ($CanUseWin32Unicode){
    $ver=eval('Win32::Unicode->VERSION'); $VerWin32Unicode=$ver; $ver=" version $ver" if $ver;
    if ($VerWin32Unicode <= '0.32' or $VerWin32Unicode >= '0.37') {
        $installed = 'enabled';
        if ( $^O eq 'MSWin32' ) {
            mlog(0,"Win32::Unicode module$ver installed - can write unicode filenames to OS");
            *{'Win32::Unicode::File::flush'} = *{'main::assp_flush'} unless defined *{'Win32::Unicode::File::flush'};
        }
    } else {
        disableUnicode();
        eval{${^WIDE_SYSTEM_CALLS} = 0;};
        $canUnicode = undef;
        eval('no Win32::Unicode;');
        $installed = 'disabled - version BUG';
        mlog(0,"Win32::Unicode module version $VerWin32Unicode is buggy and is disabled now - upgrade to at least version 0.37 - unable to write unicode filenames to OS") if ( $^O eq 'MSWin32' );
    }
  } else {
    $installed = $useWin32Unicode ? 'is not installed' : 'is disabled in config';
    mlog(0,"Win32::Unicode module $installed - unable to write unicode filenames to OS") if ( $^O eq 'MSWin32' );
  }
  $ModuleList{'Win32::Unicode'} = $VerWin32Unicode.'/0.28';
  $ModuleStat{'Win32::Unicode'} = $installed;

  if ($CanUseTieRDBM) {
    $ver=eval('Tie::RDBM->VERSION'); $VerTieRDBM=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Tie::RDBM module$ver installed - database usage available");
    *{'Tie::RDBM::_update'}  = *{'main::rdbm_update'};
    *{'Tie::RDBM::_insert'}  = *{'main::rdbm_insert'};
    *{'Tie::RDBM::FETCH'}    = *{'main::rdbm_fetch'};
    *{'Tie::RDBM::DELETE'}   = *{'main::rdbm_delete'};
    *{'Tie::RDBM::FIRSTKEY'} = *{'main::rdbm_firstkey'};
    *{'Tie::RDBM::NEXTKEY'}  = *{'main::rdbm_nextkey'};
    *{'Tie::RDBM::CLEAR'}    = *{'main::rdbm_CLEAR'};
    *{'Tie::RDBM::STORE'}    = *{'main::rdbm_STORE'};
    *{'Tie::RDBM::EXISTS'}   = *{'main::rdbm_EXISTS'};
    *{'Tie::RDBM::DESTROY'}  = *{'main::rdbm_DESTROY'};
    *{'Tie::RDBM::SCALAR'}   = *{'main::rdbm_COUNT'};
    $installed = 'enabled';
  } elsif (!$AvailTieRDBM ) {
    $installed = $useTieRDBM ? 'is not installed' : 'is disabled in config';
    mlog(0,"Tie::RDBM module $installed - database usage not available");
  }
  $ModuleList{'Tie::RDBM'} = $VerTieRDBM.'/0.70';
  $ModuleStat{'Tie::RDBM'} = $installed;

  if ($CanUseDB_File) {
    $ver=eval('DB_File->VERSION'); $VerDB_File=$ver; $ver=" version $ver" if $ver;
    mlog(0,"DB_File module$ver installed - DB_File (Berkeley V1) database usage available");
    $installed = 'enabled';
  } elsif (!$AvailDB_File ) {
    $installed = $useDB_File ? 'is not installed' : 'is disabled in config';
    mlog(0,"DB_File module $installed - DB_File (Berkeley V1) database usage not available");
  }
  $ModuleList{'DB_File'} = $VerDB_File.'/1.816';
  $ModuleStat{'DB_File'} = $installed;

  my $BDBver;
  my $BDBverStr;
  if ($CanUseBerkeleyDB) {
    my $fail = 0;
    $ver=eval('BerkeleyDB->VERSION'); $VerBerkeleyDB=$ver; $ver=" version $ver" if $ver;
    $BDBver = eval('$BerkeleyDB::db_version;');
    $BDBverStr = eval('BerkeleyDB->DB_VERSION_STRING');
    if ($BDBver lt '4.5') {
        $AvailBerkeleyDB = $CanUseBerkeleyDB = 0;
        mlog(0,"warning: BerkeleyDB database version $BDBver / $BDBverStr installed - but at least version 4.5 is required - Berkeley database usage not available");
        $fail = 1;
        $installed = 'wrong engine version';
        $ModuleStat{'BerkeleyDB_DBEngine'} = $installed;
        $Config{clearBerkeleyDBEnv} = 1;
        $runHMMusesBDB = 0;
    }
    if ($VerBerkeleyDB lt '0.34') {
        $AvailBerkeleyDB = $CanUseBerkeleyDB = 0;
        mlog(0,"warning: BerkeleyDB module $ver installed - but at least version 0.34 is required - Berkeley database usage not available");
        $fail = 1;
        $installed = 'wrong module version';
        $Config{clearBerkeleyDBEnv} = 1;
        $runHMMusesBDB = 0;
    }
    if (! $fail) {
        mlog(0,"BerkeleyDB module$ver installed - Berkeley database usage available");
        mlog(0,"BerkeleyDB DB-version $BDBver / $BDBverStr is installed");
        $installed = 'enabled';
        $ModuleStat{'BerkeleyDB_DBEngine'} = $installed;
        if ($BDBverStr ne $Config{BerkeleyDB_DBEngine}) {
            $Config{clearBerkeleyDBEnv} = 1;
            $newConfig{BerkeleyDB_DBEngine} = $BDBverStr;
            $Config{BerkeleyDB_DBEngine} = $BDBverStr;
        }
        $ConfigAdd{BerkeleyDB_DBEngine} = $BDBverStr;
    }
  } elsif (!$AvailBerkeleyDB ) {
    $installed = $useBerkeleyDB ? 'is not installed' : 'is disabled in config';
    mlog(0,"BerkeleyDB module $installed - Berkeley database usage not available");
    $ModuleStat{'BerkeleyDB_DBEngine'} = 'status unknown';
    $Config{clearBerkeleyDBEnv} = 1;
    $runHMMusesBDB = 0;
  }
  $ModuleList{'BerkeleyDB'} = $VerBerkeleyDB.'/0.42';
  $ModuleStat{'BerkeleyDB'} = $installed;
  $ModuleList{'BerkeleyDB_DBEngine'} = $BDBver.'/4.5';
  print '.';

  if ($griplist) {
      if ($CanUseBerkeleyDB && $useDB4griplist) {
          $GriplistDriver = 'BerkeleyDB::Hash';
          $GriplistFile = "$base/$griplist.bdb";
          mlog(0,"info: griplist is using 'BerkeleyDB' version $BerkeleyDB::db_version in file $base/$griplist.bdb");
          if (! -e $GriplistFile) {
              unlink "$base/$griplist.bin";
          }
      } else {
          $GriplistDriver = 'orderedtie';
          $GriplistFile = "$base/$griplist";
          mlog(0,"info: griplist is using basic 'orderedtie' in file $base/$griplist");
      }
  }

  if (! $CanUseBerkeleyDB || ! $useDB4IntCache) {
      foreach (sort keys %tempDBvars) {
          next if $_ eq 'BackDNS2';
          share(%{$_});
      }
  }
  print '.';

  if ($CanUseCIDRlite) {
    $ver=eval('Net::CIDR::Lite->VERSION'); $VerNetCIDRLite=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Net::CIDR::Lite module$ver installed - hyphenated IP address range available");
    $installed = 'enabled';
  } elsif (!$AvailCIDRlite) {
    $installed = $useNetCIDRLite ? 'is not installed' : 'is disabled in config';
    mlog(0,"Net::CIDR::Lite module $installed - hyphenated IP address range not available");
  }
  $ModuleList{'Net::CIDR::Lite'} = $VerNetCIDRLite.'/0.20';
  $ModuleStat{'Net::CIDR::Lite'} = $installed;

  if ($CanUseNetAddrIPLite) {
    $ver=eval('NetAddr::IP::Lite->VERSION'); $VerNetAddrIPLite=$ver; $ver=" version $ver" if $ver;
    mlog(0,"NetAddr::IP::Lite module$ver installed - hyphenated IP and CIDR address range calculation available");
    $installed = 'enabled';
  } elsif (!$AvailNetAddrIPLite) {
    $installed = $useNetAddrIPLite ? 'is not installed' : 'is disabled in config';
    mlog(0,"NetAddr::IP::Lite module $installed - hyphenated IP and CIDR address range calculation not available");
  }
  $ModuleList{'NetAddr::IP::Lite'} = $VerNetAddrIPLite.'/1.47';
  $ModuleStat{'NetAddr::IP::Lite'} = $installed;

  if ($CanUseNetIP) {
    $ver=eval('Net::IP->VERSION'); $VerNetIP=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Net::IP module$ver installed - hyphenated IP and CIDR address range calculation available");
    $installed = 'enabled';
  } elsif (!$AvailNetIP) {
    $installed = $useNetIP ? 'is not installed' : 'is disabled in config';
    mlog(0,"Net::IP module $installed - hyphenated IP and CIDR address range calculation not available");
  }
  $ModuleList{'Net::IP'} = $VerNetAddrIPLite.'/1.26';
  $ModuleStat{'Net::IP'} = $installed;

  if ($CanUseLWP) {
    $ver=eval('LWP::Simple->VERSION'); $VerLWPSimple=$ver; $ver=" version $ver" if $ver;
    mlog(0,"LWP::Simple module$ver installed - procedural LWP interface available");
    $installed = 'enabled';
  } elsif (!$AvailLWP) {
    $installed = $useLWPSimple ? 'is not installed' : 'is disabled in config';
    mlog(0,"LWP::Simple module $installed - procedural LWP interface not available");
  }
  $ModuleList{'LWP::Simple'} = $VerLWPSimple.'/1.41';
  $ModuleStat{'LWP::Simple'} = $installed;

  if ($CanUseEMM) {
    $ver=eval('Email::MIME->VERSION'); $VerEmailMIME=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Email::MIME module$ver installed - MIME charset decoding and conversion interface and attachment detection available");
    $installed = 'enabled';
    $org_Email_MIME_parts_multipart = *{'Email::MIME::parts_multipart'};
    *{'Email::MIME::parts_multipart'} = *{'main::parts_multipart'};
    *{'Email::MIME::ContentType::_extract_ct_attribute_value'} = *{'assp_extract_ct_attribute_value'};
    *{'Email::MIME::ContentType::_parse_attributes'} = *{'assp_parse_attributes'};
  } elsif (!$AvailEMM) {
    $installed = $useEmailMIME ? 'is not installed' : 'is disabled in config';
    mlog(0,"Email::MIME module $installed - MIME charset decoding and conversion interface and attachment detection not available");
  }
  $ModuleList{'Email::MIME'} = $VerEmailMIME.'/1.442';
  $ModuleStat{'Email::MIME'} = $installed;

  if ($CanUseMTY) {
    $ver=eval('MIME::Types->VERSION'); $VerMIMETypes=$ver; $ver=" version $ver" if $ver;
    mlog(0,"MIME::Types module$ver installed - TNEF conversion may possible");
    $installed = 'enabled';
  } elsif (!$AvailMTY) {
    $installed = $useMIMETypes ? 'is not installed' : 'is disabled in config';
    mlog(0,"MIME::Types module $installed - TNEF conversion not available");
  }
  $ModuleList{'MIME::Types'} = $VerMIMETypes.'/1.23';
  $ModuleStat{'MIME::Types'} = $installed;
  print '.';

  if ($CanUseEMS) {
    $ver=eval('Email::Send->VERSION'); $VerEmailSend=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Email::Send module$ver installed - sending .eml files available");
    $installed = 'enabled';
  } elsif (!$AvailEMS) {
    $installed = $useEmailSend ? 'is not installed' : 'is disabled in config';
    mlog(0,"Email::Send module $installed - sending .eml files is not available");
  }
  $ModuleList{'Email::Send'} = $VerEmailSend.'/2.192';
  $ModuleStat{'Email::Send'} = $installed;

  if ($CanUseTNEF) {
    $ver=eval('Convert::TNEF->VERSION'); $VerConvertTNEF=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Convert::TNEF module$ver installed - TNEF conversion is available");
    $installed = 'enabled';
  } elsif (!$AvailTNEF)  {
    $installed = $useConvertTNEF ? 'is not installed' : 'is disabled in config';
    mlog(0,"Convert::TNEF module $installed - TNEF conversion not available");
  }
  $ModuleList{'Convert::TNEF'} = $VerConvertTNEF.'/0.17';
  $ModuleStat{'Convert::TNEF'} = $installed;

  if ($CanUseDKIM) {
    $ver=eval('Mail::DKIM::Verifier->VERSION'); $VerMailDKIMVerifier=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Mail::DKIM::Verifier module$ver installed - DKIM verification is available");
    $installed = 'enabled';
    if ($ver lt '0.40') {   # the DNS resolver issue is fixed in 0.40
        *{'Mail::DKIM::DNS::query'} = *{'main::DKIM_DNS_query'};
        *{'Mail::DKIM::DNS::query_async'} = *{'main::DKIM_DNS_query_async'};
    }
  } elsif (!$AvailDKIM)  {
    $installed = $useMailDKIMVerifier ? 'is not installed' : 'is disabled in config';
    mlog(0,"Mail::DKIM::Verifier module $installed - DKIM verification not available");
  }
  $ModuleList{'Mail::DKIM::Verifier'} = $VerMailDKIMVerifier.'/0.37';
  $ModuleStat{'Mail::DKIM::Verifier'} = $installed;

  if ($CanUseSchedCron) {
    $ver=eval('Schedule::Cron->VERSION'); $VerScheduleCron=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Schedule::Cron module$ver installed - RebuildSpamdb Scheduler is available");
    $installed = 'enabled';
  } elsif (!$AvailSchedCron)  {
    $installed = $useScheduleCron ? 'is not installed' : 'is disabled in config';
    mlog(0,"Schedule::Cron module $installed - RebuildSpamdb Scheduler not available");
  }
  $ModuleList{'Schedule::Cron'} = $VerScheduleCron.'/0.97';
  $ModuleStat{'Schedule::Cron'} = $installed;

  if ($CanUseSysMemInfo) {
    $ver=eval('Sys::MemInfo->VERSION'); $VerSysMemInfo=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Sys::MemInfo module$ver installed - memory calculation is available");
    $installed = 'enabled';
  } elsif (!$AvailSysMemInfo)  {
    $installed = $useSysMemInfo ? 'is not installed' : 'is disabled in config';
    mlog(0,"Sys::MemInfo module $installed - memory calculation not available");
  }
  $ModuleList{'Sys::MemInfo'} = $VerSysMemInfo.'/0.91';
  $ModuleStat{'Sys::MemInfo'} = $installed;

  if ($CanUseSysCpuAffinity) {
    $ver=eval('Sys::CpuAffinity->VERSION'); $VerSysCpuAffinity=$ver; $ver=" version $ver" if $ver;
    eval{$numcpus = Sys::CpuAffinity::getNumCpus();};
    $numcpus ||= 'an undected number of';
    mlog(0,"Sys::CpuAffinity module$ver installed - setting CPU Affinty is available - this system has $numcpus CPU\'s");
    eval{@currentCpuAffinity = Sys::CpuAffinity::getAffinity($$)};
    mlog(0,"The Cpu Affinity of assp is currently '@currentCpuAffinity'");
    $installed = 'enabled';
  } elsif (!$AvailSysCpuAffinity)  {
    $installed = $useSysCpuAffinity ? 'is not installed' : 'is disabled in config';
    mlog(0,"Sys::CpuAffinity module $installed - setting CPU Affinty not available");
  }
  $ModuleList{'Sys::CpuAffinity'} = $VerSysCpuAffinity.'/1.05';
  $ModuleStat{'Sys::CpuAffinity'} = $installed;

  print '.';

  if ($CanUseAuthenSASL) {
    $ver=eval('Authen::SASL->VERSION'); $VerAuthenSASL=$ver; $ver=" version $ver" if $ver;
    mlog(0,"Authen::SASL module$ver installed - SMTP AUTH is available");
    $installed = 'enabled';
  } elsif (!$AvailAuthenSASL)  {
    $installed = $useAuthenSASL ? 'is not installed' : 'is disabled in config';
    mlog(0,"Authen::SASL module $installed - SMTP AUTH is not available");
  }
  $ModuleList{'Authen::SASL'} = $VerAuthenSASL.'/2.1401';
  $ModuleStat{'Authen::SASL'} = $installed;

  if ($CanUseRegexpOptimizer) {
    $ver=eval('Regexp::Optimizer->VERSION'); $VerRegexpOptimizer=$ver; $ver=" version $ver" if $ver;
    if ($VerRegexpOptimizer ge '0.23') {
        mlog(0,"Regexp::Optimizer module$ver installed - default Regular Expression Optimization is available");
        $installed = 'enabled';
    } else {
        $CanUseRegexpOptimizer = $AvailRegexpOptimizer = 0;
        $installed = "with wrong version ($VerRegexpOptimizer) installed (requires 0.23)";
        mlog(0,"Regexp::Optimizer module $installed - default Regular Expression Optimization is not available - regex processing will take approximately 3 times longer");
    }
  } elsif (!$AvailRegexpOptimizer)  {
    $installed = $useRegexpOptimizer ? 'is not installed' : 'is disabled in config';
    mlog(0,"Regexp::Optimizer module $installed - default Regular Expression Optimization is not available - regex processing will take  approximately 3 times longer");
  }
  $ModuleList{'Regexp::Optimizer'} = $VerRegexpOptimizer.'/0.23';
  $ModuleStat{'Regexp::Optimizer'} = $installed;

  if ($CanUseRegexOptimizer) {
    $ver=eval('Regex::Optimizer->VERSION'); $VerRegexOptimizer=$ver; $ver=" version $ver" if $ver;
    if ($VerRegexOptimizer ge '1.12') {
        mlog(0,"Regex::Optimizer module$ver installed - enhanced Regular Expression Optimization is available - Regexp::Optimizer is now switched off");
        $installed = 'enabled';
        eval('no Regexp::Optimizer;');
        $ModuleStat{'Regexp::Optimizer'} .= ' (switched off)' if $ModuleStat{'Regexp::Optimizer'} eq 'enabled';
    } else {
        $CanUseRegexOptimizer = $AvailRegexOptimizer = 0;
        $installed = "with wrong version ($VerRegexOptimizer) installed (requires at least 1.12)";
        mlog(0,"Regex::Optimizer module $installed - enhanced Regular Expression Optimization is not available - regex processing will take approximately 6 times longer");
    }
  } elsif (!$AvailRegexOptimizer)  {
    $installed = $useRegexOptimizer ? 'is not installed' : 'is disabled in config';
    mlog(0,"Regex::Optimizer module $installed - enhanced Regular Expression Optimization is not available - regex processing will take approximately 6 times longer");
  }
  $ModuleList{'Regex::Optimizer'} = $VerRegexOptimizer.'/1.12';
  $ModuleStat{'Regex::Optimizer'} = $installed;

  if ($CanUseAsspSelfLoader) {
    $ver=eval('AsspSelfLoader->VERSION'); $VerAsspSelfLoader=$ver; $ver=" version $ver" if $ver;
    mlog(0,"AsspSelfLoader module$ver installed - ASSP Code Load Optimization is available");
    $installed = 'enabled';
  } elsif (!$AvailAsspSelfLoader)  {
    $installed = $useAsspSelfLoader ? 'is not installed' : 'is disabled in config';
    mlog(0,"AsspSelfLoader module $installed - ASSP Code Load Optimization is not available");
  }
  $ModuleList{'AsspSelfLoader'} = $VerAsspSelfLoader.'/'.$requiredSelfLoaderVersion;
  $ModuleStat{'AsspSelfLoader'} = $installed;

  if ($CanUseASSP_WordStem) {
    $ver=eval('ASSP_WordStem->VERSION'); $VerASSP_WordStem=$ver; $ver=" version $ver" if $ver;
    mlog(0,"ASSP_WordStem module$ver installed - ASSP multi lingual word stemming engine for Bayesian and HMM checks is available");
    $installed = 'enabled';
    $requiredDBVersion{'Spamdb'} .= '_WordStem';
    $requiredDBVersion{'HMMdb'}  .= '_WordStem';
    # make Lingua::Stem::Snowball thread safe if it is'nt
    if (! defined *{'Lingua::Stem::Snowball::CLONE_SKIP'}) {
        *{'Lingua::Stem::Snowball::CLONE_SKIP'} = *{'main::Stem_Clone_Skip'};
    }
    if (! defined *{'Lingua::Stem::Snowball::CLONE'}) {
        *{'Lingua::Stem::Snowball::CLONE'} = *{'main::Stem_Clone'};
    }
  } elsif (!$AvailASSP_WordStem)  {
    $installed = $useASSP_WordStem ? 'is not installed' : 'is disabled in config';
    mlog(0,"ASSP_WordStem module $installed - ASSP multi lingual word stemming engine for Bayesian and HMM checks is not available");
  }
  $ModuleList{'ASSP_WordStem'} = $VerASSP_WordStem.'/1.23';
  $ModuleStat{'ASSP_WordStem'} = $installed;

  if ($CanUseASSP_FC) {
    $ver=eval('ASSP_FC->VERSION'); $VerASSP_FC=$ver; $ver=" version $ver" if $ver;
    mlog(0,"ASSP_FC module$ver installed - ASSP file commander is available");
    $installed = 'enabled';
  } elsif (!$AvailASSP_FC)  {
    $installed = $useASSP_FC ? 'is not installed' : 'is disabled in config';
    mlog(0,"ASSP_FC module $installed - ASSP file commander is not available");
  }
  $ModuleList{'ASSP_FC'} = $VerASSP_FC.'/1.04';
  $ModuleStat{'ASSP_FC'} = $installed;

  if ($CanUseASSP_SVG) {
    $ver=eval('ASSP_SVG->VERSION'); $VerASSP_SVG=$ver; $ver=" version $ver" if $ver;
    mlog(0,"ASSP_SVG module$ver installed - ASSP graphical STATS are available");
    $installed = 'enabled';
  } elsif (!$AvailASSP_SVG)  {
    $installed = $useASSP_SVG ? 'is not installed' : 'is disabled in config';
    mlog(0,"ASSP_SVG module $installed - ASSP graphical STATS are not available");
  }
  $ModuleList{'ASSP_SVG'} = $VerASSP_SVG.'/1.02';
  $ModuleStat{'ASSP_SVG'} = $installed;

  if ($CanUseIOSocketSSL) {
    $ver=eval('IO::Socket::SSL->VERSION'); $VerIOSocketSSL=$ver; $ver=" version $ver" if $ver;
    mlog(0,"IO::Socket::SSL module$ver installed - https and TLS/SSL is possible");
    mlog(0,"IO::Socket::SSL module$ver installed - but at least version 1.32 is recommended")
        if ($VerIOSocketSSL < '1.32');
    $installed = 'enabled';
    $ModuleList{'Net::SSLeay'} = (eval('Net::SSLeay->VERSION')).'/1.35';
    $ModuleStat{'Net::SSLeay'} = $installed;
    if (-e $SSLCertFile and -e $SSLKeyFile) {
        mlog(0,'found valid certificate and private key file - https and TLS/SSL is available');
        mlog(0,'found valid ca file - chained certificate validation is available') if $SSLCaFile && -e $SSLCaFile;
    } else {
        if (system('openssl', 'version') == 0) {
            mlog(0,'info: openssl is installed - try to create basic SSL-certificates');
            &genCerts;
        } else {
            mlog(0,'info: openssl is not installed on this system - unable to create basic certificates');
        }
        if (-e $SSLCertFile and -e $SSLKeyFile) {
            mlog(0,'found valid certificate and private key file - https and TLS/SSL is available');
            mlog(0,'found valid ca file - chained certificate validation is available') if $SSLCaFile && -e $SSLCaFile;
        } else {
            $CanUseIOSocketSSL = 0;
            mlog(0,"warning: server certificate $SSLCertFile not found") unless (-e $SSLCertFile);
            mlog(0,"warning: server public-key $SSLKeyFile not found") unless (-e $SSLKeyFile);
            mlog(0,'warning: https and TLS/SSL is disabled');
            $installed = 'no certificate found';
        }
    }
  } elsif (!$AvailIOSocketSSL)  {
    $installed = $useIOSocketSSL ? 'is not installed' : 'is disabled in config';
    mlog(0,"IO::Socket::SSL module $installed - https and TLS/SSL not available");
  }
  $ModuleList{'IO::Socket::SSL'} = $VerIOSocketSSL.'/1.32';
  $ModuleStat{'IO::Socket::SSL'} = $installed;

  my $v;
  $ModuleList{'Plugins::ASSP_AFC'}   =~ s/([0-9\.\-\_]+)$/$v=3.06;$1>$v?$1:$v;/oe if exists $ModuleList{'Plugins::ASSP_AFC'};
  $ModuleList{'Plugins::ASSP_ARC'}   =~ s/([0-9\.\-\_]+)$/$v=2.05;$1>$v?$1:$v;/oe if exists $ModuleList{'Plugins::ASSP_ARC'};
  $ModuleList{'Plugins::ASSP_DCC'}   =~ s/([0-9\.\-\_]+)$/$v=2.01;$1>$v?$1:$v;/oe if exists $ModuleList{'Plugins::ASSP_DCC'};
  $ModuleList{'Plugins::ASSP_OCR'}   =~ s/([0-9\.\-\_]+)$/$v=2.16;$1>$v?$1:$v;/oe if exists $ModuleList{'Plugins::ASSP_OCR'};
  $ModuleList{'Plugins::ASSP_Razor'} =~ s/([0-9\.\-\_]+)$/$v=1.09;$1>$v?$1:$v;/oe if exists $ModuleList{'Plugins::ASSP_Razor'};

  if (scalar keys %ModuleError) {
      mlog(0,"warning: There were module load errors detected - look in to file $base/moduleLoadErrors.txt for more details. To solve this issue install the failed modules or disable them in the 'Module Setup' section in the GUI.");
  }
  print '.';

  $tThreadHandler{1} = \&NewSMTPConnectionConnect;     # set subs to numbers / subs-refs can not be shared
  $tThreadHandler{2} = \&NewProxyConnection;    # so the tread will know what to do

# are we using any database tables?
  $DBisUsed = 0;
  for my $idx (0...$#ConfigArray) {
    my $c = $ConfigArray[$idx];
    if ($Config{$c->[0]}=~/DB:/o && ($CanUseTieRDBM or $CanUseBerkeleyDB)) {
      $DBisUsed = 1;
      last;
    }
  }

  $nextNoop=time;
  $endtime=$nextNoop+$RestartEvery;

  loadHashFromFile( "$base/scheduleHistory", \%LastSchedRun );
  ScheduleMapSet();
  $NextSaveStats = max($NextSaveStats, (time + 300));

  if ($backupDBInterval && ! isSched($backupDBInterval) && $backupDBDir && -d "$base/$backupDBDir") {
    my $mtime = ftime("$base/$backupDBDir");
    if ($mtime) {
        my $m = &getTimeDiff(time - $mtime);
        mlog(0,"info: last DB-backup was scheduled before $m") if ($DBisUsed && $MaintenanceLog);
        $nextDBBackup=$mtime+$backupDBInterval*3600;
        $nextDBBackup = time + 300 if ($nextDBBackup - time < 300);
        $m = &getTimeDiff($nextDBBackup - time);
        mlog(0,"info: next DB-backup is scheduled in $m") if ($DBisUsed && $MaintenanceLog);
    }
  }
  $nextDBcheck=$nextNoop+30; # check DB connection every 30 seconds
  $nextThreadsWakeUp=$nextNoop+$ThreadsWakeUpInterval;
  $nextCleanBATVTag=$nextNoop + 3600;
  $nextConSync = $nextNoop + 60;
  $nextResendMail = $nextNoop + 300;
  $nextRebuildSpamDB = isSched($RebuildSchedule) ? getSchedTime('RebuildSchedule') : 0;
  $nextDNSCheck = $nextNoop + 60;
  $nextCleanIPDom = $nextNoop + 300;
  $nextBDBsync = $nextNoop + 900;
  $nextdetectHourJob = int($nextNoop / 3600) * 3600 + 3600;
  $nextdetectHourJob += 15 unless ($nextdetectHourJob + $TimeZoneDiff) % (24 * 3600);
  my $m = &getTimeDiff($nextdetectHourJob-$nextNoop);
  mlog(0,"info: hourly scheduler is starting in $m") if $MaintenanceLog >=2;

  chmod 0755, "$base/assp.cfg";

  print "\t\t\t\t[OK]\nchecking directories";
# create folders if they're missing
  -d "$base/$spamlog" or mkdir "$base/$spamlog",0755;
  -d "$base/$notspamlog" or mkdir "$base/$notspamlog",0755;
  -d "$base/$incomingOkMail" or mkdir "$base/$incomingOkMail", 0755;
  -d "$base/$discarded"  or mkdir "$base/$discarded",  0755;
  -d "$base/files" or mkdir "$base/files",0755;
  -d "$base/logs" or mkdir "$base/logs",0755;
  
  -d "$base/rebuild_error" or mkdir "$main::base/rebuild_error", 0755;
  -d "$base/rebuild_error/$spamlog" or mkdir "$base/rebuild_error/$spamlog", 0755;
  -d "$base/rebuild_error/$notspamlog" or mkdir "$base/rebuild_error/$notspamlog", 0755;
  my $dir=$correctedspam;
  $dir=~s/\/.*?$//o;
  -d "$base/$dir" or mkdir "$base/$dir",0755;
  -d "$base/$correctedspam" or mkdir "$base/$correctedspam",0755;
  -d "$base/$correctedspam/newManualyAdded" or mkdir "$base/$correctedspam/newManualyAdded",0755;
  -d "$base/rebuild_error/$dir" or mkdir "$base/rebuild_error/$dir", 0755;
  -d "$base/rebuild_error/$correctedspam" or mkdir "$base/rebuild_error/$correctedspam", 0755;
  $dir=$correctednotspam;
  $dir=~s/\/.*?$//o;
  -d "$base/$dir" or mkdir "$base/$dir",0755;
  -d "$base/$correctednotspam" or mkdir "$base/$correctednotspam",0755;
  -d "$base/$correctednotspam/newManualyAdded" or mkdir "$base/$correctednotspam/newManualyAdded",0755;
  -d "$base/rebuild_error/$dir" or mkdir "$base/rebuild_error/$dir", 0755;
  -d "$base/rebuild_error/$correctednotspam" or mkdir "$base/rebuild_error/$correctednotspam", 0755;

  -d "$base/$resendmail" or mkdir "$base/$resendmail",0755;
  $pbdir = $1 if $pbdb=~/(.*)\/.*/o;
  $pbdir = 'pb' if $pbdb =~ /DB:/o;
  if ($pbdir) {
     -d  "$base/$pbdir" or mkdir "$base/$pbdir",0755;
     -d  "$base/$pbdir/global" or mkdir "$base/$pbdir/global",0755;
     -d  "$base/$pbdir/global/in" or mkdir "$base/$pbdir/global/in",0755;
     -d  "$base/$pbdir/global/out" or mkdir "$base/$pbdir/global/out",0755;
  }
  -d "$base/notes" or mkdir "$base/notes",0755;
  -d "$base/docs" or mkdir "$base/docs",0755;
  my $mysqldir; $mysqldir = $1 if $importDBDir=~/(.*)\/.*/o;
  mkdir "$base/$mysqldir",0755 if $mysqldir;
  -d "$base/$importDBDir" or mkdir "$base/$importDBDir",0755;
  $mysqldir = $1 if $exportDBDir=~/(.*)\/.*/o;
  mkdir "$base/$mysqldir",0755 if $mysqldir;
  -d "$base/$exportDBDir" or mkdir "$base/$exportDBDir",0755;
  $mysqldir = $1 if $backupDBDir=~/(.*)\/.*/o;
  mkdir "$base/$mysqldir",0755 if $mysqldir;
  -d "$base/$backupDBDir" or mkdir "$base/$backupDBDir",0755;
  -d "$base/dkim" or mkdir "$base/dkim",0755;
  -d "$FileScanDir" or mkdir "$FileScanDir",0755;
  -d "$base/Plugins" or mkdir "$base/Plugins",0777;
  -d "$base/tmp" or mkdir "$base/tmp",0755;
  -d "$base/tmpDB" or mkdir "$base/tmpDB",0755;
  -d "$base/crash_repo" or mkdir "$base/crash_repo",0755;
  -d "$base/debug" or mkdir "$base/debug",0755;

  foreach my $file ( Glob("$base/tmp/*")) {
      mlog(0,"info: deleted temporary file $file") if unlink($file) && $MaintenanceLog > 1;
  }

  my $unclean = (exists $Config{clearBerkeleyDBEnv} || -e "$base/$pidfile");
  mlog(0,'error: unclean shutdown of ASSP detected') if $unclean;
  foreach my $dir ( Glob("$base/tmpDB/*")) {
      if (-d $dir) {
          my $del;
          foreach my $f ( Glob("$dir/*")) {
             if ($f =~ /\.00\d$/o) {
                 $del = 1;
                 unlink($f) || mlog(0,"error: unable to cleanup $f - $!");
             } elsif ($f =~ /\.bdb$/io && ($f !~ /BackDNS2|rebuildDB/o || $unclean) ) {
                 $del = 1;
                 unlink($f) || mlog(0,"error: unable to cleanup $f - $!");
             }
          }
          mlog(0,"info: cleaned temporary BerkeleyDB directory $dir") if $del && $unclean;
      }
  }
  if ($useDB4griplist && $unclean) {
      foreach ( Glob("$base/griplist.*")) {
          next if (-d "$_");
          mlog(0,"info: removed GRIPLIST file $_") if unlink($_);
      }
  }
  delete $Config{clearBerkeleyDBEnv};
  &SaveConfig() if $unclean;

  if($pidfile) {open(my $PIDH,'>',"$base/$pidfile"); $PIDH->autoflush; print $PIDH $$; close $PIDH}

  if ($^O ne 'MSWin32') {
      if($setFilePermOnStart) {
          print "\t\t\t\t\t[OK]\nsetup file permission" ;
          &setPermission($base,oct('0777'),1,1) ;
          $Config{setFilePermOnStart} = '';
          $setFilePermOnStart = '';
          &SaveConfig();
      } elsif ($checkFilePermOnStart) {
          print "\t\t\t\t\t[OK]\ncheck file permission" ;
          &checkPermission($base,oct('0600'),1,1) ;
      }
  } else {
      if($setFilePermOnStart) {
          print "\t\t\t\t\t[OK]\nskip file permission" ;
          $Config{setFilePermOnStart} = $setFilePermOnStart = '';
      } elsif ($checkFilePermOnStart) {
          print "\t\t\t\t\t[OK]\nskip file permission" ;
          $Config{checkFilePermOnStart} = $checkFilePermOnStart = '';
      }
  }

  $nextGlobalUploadBlack = $nextNoop + 120;
  $nextGlobalUploadWhite = $nextNoop + 120;
  if (-e "$base/$pbdir/global/out/pbdb.black.db.gz") {
    my $mtime = ftime("$base/$pbdir/global/out/pbdb.black.db.gz");
    my $m = &getTimeDiff(time - $mtime);
    mlog(0,"info: last PBBlack upload to global server was scheduled before $m") if ($DoGlobalBlack && $globalClientName && $globalClientPass && $MaintenanceLog);
    if ($mtime) {
        $nextGlobalUploadBlack=$mtime + (int(rand(300) + 1440))*60;
        my $m = &getTimeDiff($nextGlobalUploadBlack - time);
        mlog(0,"info: next PBBlack upload to global server is scheduled in $m") if ($DoGlobalBlack && $globalClientName && $globalClientPass && $MaintenanceLog);
    }
  }
  if (-e "$base/$pbdir/global/out/pbdb.white.db.gz") {
    my $mtime = ftime("$base/$pbdir/global/out/pbdb.white.db.gz");
    my $m = &getTimeDiff(time - $mtime);
    mlog(0,"info: last PBWhite upload to global server was scheduled before $m") if ($DoGlobalBlack && $globalClientName && $globalClientPass && $MaintenanceLog);
    if ($mtime) {
        $nextGlobalUploadWhite=$mtime + (int(rand(300) + 1440))*60 if ($mtime);
        my $m = &getTimeDiff($nextGlobalUploadWhite - time);
        mlog(0,"info: next PBWhite upload to global server is scheduled in $m") if ($DoGlobalWhite && $globalClientName && $globalClientPass && $MaintenanceLog);
    }
  }

 # is any database driver defined - so we have to parse the driver and the options
  if ($DBdriver && ($CanUseTieRDBM or $CanUseBerkeleyDB)) {
    @DBdriverdef = split(/,/o,$DBdriver);
    $DBusedDriver = $DBdriverdef[0];
    $DBcntOption = @DBdriverdef;
    for (my $i=1;$i<$DBcntOption;$i++) {
      if ($DBusedDriver eq 'BerkeleyDB') {
          $DBOption.=',' if ($i > 1);
          $DBOption.="$DBdriverdef[$i]"  # putting all optons in to
      } else {
          $DBOption.=";$DBdriverdef[$i]"  # putting all optons in to
      }
      $DBautocommit = 0 if ($DBdriverdef[$i] =~ /^\s*autocommit\s*=>?\s*0\s*$/oi);
    }
    mlog(0,"info: the DBI connection string is set to: 'DBI:$DBusedDriver:database=$mydb;host=$myhost$DBOption'") if ($DBusedDriver ne 'BerkeleyDB');
    if ($DBusedDriver eq 'BerkeleyDB') {
        $runHMMusesBDB = 0;
    } else {
        mlog(0,"info: 'autocommit' is switched off for the '$DBusedDriver' database driver") unless $DBautocommit;
    }
  }

#define Cache- and List groups - so have to care about only here
  @GroupList=("whitelistGroup","PersBlackGroup","redlistGroup","delayGroup","pbdbGroup","spamdbGroup","LDAPGroup","AdminGroup");

  my $v;
# $v =  "KeyName   ,dbConfigVar,CacheObject     ,realFileName  ,mysqlFileName,FailoverValue,mysqlTable"); remove spaces and push to Group
#                                                                                                         for dbConfigVar
  $v = ("Whitelist ,whitelistdb,WhitelistObject ,$whitelistdb  ,whitelist    ,whitelist  ,whitelist"   ); $v=~s/\s*,/,/go; push(@whitelistGroup,$v);

  $v = ("Redlist   ,redlistdb  ,RedlistObject   ,$redlistdb    ,redlist      ,redlist    ,redlist"     ); $v=~s/\s*,/,/go; push(@redlistGroup,$v);

  $v = ("Delay     ,delaydb    ,DelayObject     ,$delaydb      ,delaydb      ,delaydb    ,delaydb"     ); $v=~s/\s*,/,/go; push(@delayGroup,$v);
  $v = ("DelayWhite,delaydb    ,DelayWhiteObject,$delaydb.white,delaydb.white,delaydb    ,delaywhitedb"); $v=~s/\s*,/,/go; push(@delayGroup,$v);

  $v = ("Spamdb    ,spamdb     ,SpamdbObject    ,$spamdb       ,spamdb       ,spamdb     ,spamdb"      ); $v=~s/\s*,/,/go; push(@spamdbGroup,$v);
  $v = ("HeloBlack ,spamdb     ,HeloBlackObject ,$spamdb.helo  ,spamdb.helo  ,spamdb     ,spamdbhelo"  ); $v=~s/\s*,/,/go; push(@spamdbGroup,$v);

  if (! $runHMMusesBDB || ! $CanUseBerkeleyDB) {
      $v = ("HMMdb ,spamdb     ,HMMdbObject    ,HMMdb          ,HMMdb        ,spamdb     ,hmmdb"      ); $v=~s/\s*,/,/go; push(@spamdbGroup,$v);
      delete $tempDBvars{HMMdb};
  }
  
  $v = ("PBWhite   ,pbdb       ,PBWhiteObject   ,$pbdb.white.db,pbdb.white.db,pb/pbdb    ,PBWhite"     ); $v=~s/\s*,/,/go; push(@pbdbGroup,$v);
  $v = ("PBBlack   ,pbdb       ,PBBlackObject   ,$pbdb.black.db,pbdb.black.db,pb/pbdb    ,PBBlack"     ); $v=~s/\s*,/,/go; push(@pbdbGroup,$v);
  $v = ("RBLCache  ,pbdb       ,RBLCacheObject  ,$pbdb.rbl.db  ,pbdb.rbl.db  ,pb/pbdb    ,RBLCache"    ); $v=~s/\s*,/,/go; push(@pbdbGroup,$v);
  $v = ("URIBLCache,pbdb       ,URIBLCacheObject,$pbdb.uribl.db,pbdb.uribl.db,pb/pbdb    ,URIBLCache"  ); $v=~s/\s*,/,/go; push(@pbdbGroup,$v);
  $v = ("PTRCache  ,pbdb       ,PTRCacheObject  ,$pbdb.ptr.db  ,pbdb.ptr.db  ,pb/pbdb    ,PTRCache"    ); $v=~s/\s*,/,/go; push(@pbdbGroup,$v);
  $v = ("MXACache  ,pbdb       ,MXACacheObject  ,$pbdb.mxa.db  ,pbdb.mxa.db  ,pb/pbdb    ,MXACache"    ); $v=~s/\s*,/,/go; push(@pbdbGroup,$v);
  $v = ("RWLCache  ,pbdb       ,RWLCacheObject  ,$pbdb.rwl.db  ,pbdb.rwl.db  ,pb/pbdb    ,RWLCache"    ); $v=~s/\s*,/,/go; push(@pbdbGroup,$v);
  $v = ("SPFCache  ,pbdb       ,SPFCacheObject  ,$pbdb.spf.db  ,pbdb.spf.db  ,pb/pbdb    ,SPFCache"    ); $v=~s/\s*,/,/go; push(@pbdbGroup,$v);
  $v = ("SBCache   ,pbdb       ,SBCacheObject   ,$pbdb.sb.db   ,pbdb.sb.db   ,pb/pbdb    ,SBCache"     ); $v=~s/\s*,/,/go; push(@pbdbGroup,$v);
  $v = ("PBTrap    ,pbdb       ,PBTrapObject    ,$pbdb.trap.db ,pbdb.trap.db ,pb/pbdb    ,PBTrap"      ); $v=~s/\s*,/,/go; push(@pbdbGroup,$v);
  $v = ("DKIMCache ,pbdb       ,DKIMCacheObject ,$pbdb.dkim.db ,pbdb.dkim.db ,pb/pbdb    ,DKIMCache"   ); $v=~s/\s*,/,/go; push(@pbdbGroup,$v);
  $v = ("BATVTag   ,pbdb       ,BATVTagObject   ,$pbdb.batv.db ,pbdb.batv.db ,pb/pbdb    ,BATVTag"     ); $v=~s/\s*,/,/go; push(@pbdbGroup,$v);
  $v = ("BackDNS   ,pbdb       ,BackDNSObject   ,$pbdb.back.db ,pbdb.back.db ,pb/pbdb    ,BackDNS"     ); $v=~s/\s*,/,/go; push(@pbdbGroup,$v);

  $v = ("PersBlack ,persblackdb,PersBlackObject ,$persblackdb  ,persblack    ,persblack  ,persblack"   ); $v=~s/\s*,/,/go; push(@PersBlackGroup,$v);

  $v = ("LDAPlist  ,ldaplistdb ,LDAPlistObject  ,$ldaplistdb   ,ldaplist     ,ldaplist   ,ldaplist"    ); $v=~s/\s*,/,/go; push(@LDAPGroup,$v);

  $v = ("AdminUsers,adminusersdb ,AdminUsersObject,$adminusersdb   ,adminusers   ,adminusers ,AdminUsers"  ); $v=~s/\s*,/,/go; push(@AdminGroup,$v);
  $v = ("AdminUsersRight,adminusersdb,AdminUsersRightObject,$adminusersdb.right,adminusers.right,adminusers,AdminUsersRight"   ); $v=~s/\s*,/,/go; push(@AdminGroup,$v);
# %Types is defined by Tie::RDBM -> we redefine the datatypes for the key field of some drivers
# For better support of the key field with different charsets defined by the DB - the key field should
# be a varbinary type  -  some databases skipping leading and/or trailing spaces in char and varchar fields
# which cause in unexpected or missing keys in spamdb
# for MySQL the field value is redefined from longblob to varbinary(255) - so we can read the data in MySQL-Admin
# the lenght of the key field is set to 254 for all - to have one byte over for indexes (see Informix)
# the lenght of the value field is set to 255 for all - this is enough for ASSP

if ($CanUseTieRDBM) {
# %Types is used for creating the data table if it doesn't exist already.
  %Tie::RDBM::Types = (   # key            value            frozen    freeze  keyless
	  'default' => [qw/ varbinary(254)  varbinary(255)   integer   0          0 /],  #others
	  'mysql'   => [qw/ varbinary(254)  varbinary(255)   tinyint   1          0 /],
	  'mSQL'    => [qw/ char(254)       char(255)        int       0          0 /],
      'MSSQL'   => [qw/ varchar(254)    varchar(255)     int       1          0 /],
      'Pg'      => [qw/ varchar(254)    varchar(255)     int       1          0 /],
      'PgPP'    => [qw/ varchar(254)    varchar(255)     int       1          0 /],
      'Sybase'  => [qw/ varbinary(254)  varbinary(255)   tinyint   1          0 /],
	  'Oracle'  => [qw/ varchar(254)    varchar(255)     integer   1          0 /],
	  'CSV'     => [qw/ varchar(254)    varchar(255)     integer   1          1 /],  # should never be used by ASSP
	  'Informix'=> [qw/ nchar(254)      nchar(255)       integer   0          0 /],
	  'Solid'   => [qw/ varbinary(254)  varbinary(255)   integer   1          0 /],
	  'ODBC'    => [qw/ varbinary(254)  varbinary(255)   integer   1          0 /],
      'ADO'     => [qw/ varchar(254)    varchar(255)     int       1          0 /],
      'Firebird'=> [qw/ char(254)       char(255)        integer   1          0 /],
	  'DB2'     => ["varchar(254) not null","varchar(255)","integer",1,0],
	  );

  $Tie::RDBM::CAN_BIND{DB2} = 1;
  $Tie::RDBM::CAN_BIND{ADO} = 1;
  $Tie::RDBM::CAN_BIND{MSSQL} = 1;
  $Tie::RDBM::CAN_BIND{PgPP} = 1;
  $Tie::RDBM::CAN_BIND{Firebird} = 1;

  if (($DBusedDriver eq 'ODBC' || $DBusedDriver eq 'ADO') && $CanUseTieRDBM) {
       my $dbh = DBI->connect("DBI:$DBusedDriver:database=$mydb;host=$myhost$DBOption", "$myuser", "$mypassword");
       $DBI::dbi_debug = $debug;
       if (!$dbh) {
         mlog(0,"Error: $DBI::errstr");
         mlog(0,"unable to get database information via $DBusedDriver!");
         mlog(0,"warning: database options will not be available!");
         $CanUseTieRDBM=0;
       } else {
         my $dbn = $dbh->get_info(17);
         my $dbv = $dbh->get_info(18);
         mlog(0,"info: found database: $dbn version: $dbv via $DBusedDriver");
         $dbn = 'mysql' if ($dbn =~ /mysql/io);
         $dbn = 'mSQL' if ($dbn =~ /mSQL/io);
         $dbn = 'Pg' if ($dbn =~ /Pg/io);
         $dbn = 'Sybase' if ($dbn =~ /Sybase/io);
         $dbn = 'Oracle' if ($dbn =~ /Oracle/io);
         $dbn = 'CSV' if ($dbn =~ /CSV/io);
         $dbn = 'Informix' if ($dbn =~ /Informix/io);
         $dbn = 'Solid' if ($dbn =~ /Solid/io);
         $dbn = 'DB2' if ($dbn =~ /DB2/io);
         $dbn = 'MSSQL' if ($dbn =~ /Microsoft SQL Server/io);
         $dbn = 'Firebird' if ($dbn =~ /Firebird/io);
#         if ($dbn =~ /Microsoft SQL Server/io) {$dbn = 'MSSQL'; $forceTrunc4ClearDB = 1;}
         if (exists $Tie::RDBM::Types{$dbn}) {
            $Tie::RDBM::Types{$DBusedDriver} = $Tie::RDBM::Types{$dbn};
            mlog(0,"info: using $dbn table structure for $DBusedDriver database $mydb");
         } else {
            mlog(0,"info: using default $DBusedDriver table structure for $DBusedDriver database $mydb");
         }
       }
       $dbh->disconnect() if ( $dbh );
       eval("no DBD::$DBusedDriver");
  }
  if ($DBusedDriver eq 'ADO' && ! defined *{'DBD::ADO::CLONE'}) {
      *{'DBD::ADO::CLONE'} = *{'main::ADO_Clone'};
  }
}
  print "\t\t\t\t\t[OK]\nloading caches and lists";

  &initFileHashes();      # init the file base hashes to share them with all threads

  eval('no BerkeleyDB;');

  $crashHMM = HMMreadCrashFiles();

  undef $SysLogObj;

  print "\t\t\t\t[OK]\nstarting maintenance worker thread -> init all databases\n";
  mlog(0,"starting maintenance worker thread [10000] - ThreadCycleTime is set to $MaintThreadCycleTime microseconds");
  $ComWorker{10000} = &share({});
  $ComWorker{10000}->{run} = 1;
  if ($ThreadStackSize) {
      $Threads{10000} = threads->create({'stack_size' => 1024*1024*$ThreadStackSize},\&ThreadMaintStart,10000);
  } else {
      $Threads{10000} = threads->create(\&ThreadMaintStart,10000);
  }
  my $watchtime = time;
  my %chars = ( 0 => '|', 1 => '/', 2 => '-', 3 => '\\' );
  my $ci = 0;
  my $lstep;
  while (! $ComWorker{10000}->{isstarted} && ! $ComWorker{10000}->{inerror}){
      $ci = 0 if $ci > 3;
      ThreadYield();
      Time::HiRes::sleep(0.1);
      my $step;
      if (time - $watchtime > 10 && ($step = $lastd{10000}) && $step ne $lstep) {
          $lstep = $step;
          $step =~ s/\r|\n/ /go;
          my $del = 71 - length($step);
          $del = 1 if $del < 1;
          print "\r10000: $step" . (' ' x $del);
      } else {
          print "\r$chars{$ci++}";
      }
  }
  print "\rstarting maintenance worker thread";
  print "\t\t\t".($ComWorker{10000}->{inerror}?'[FAILED]':'[OK]').(' ' x 100)."\nstarting $NumComWorkers communication worker threads ";

  mlog(0,"starting SMTP-worker-threads with ThreadCycleTime set to $ThreadCycleTime microseconds");
  mlog(0,"starting communication worker threads [1 to $NumComWorkers]");
  for (my $i = 1; $i <= $NumComWorkers; $i++) {
     newThread($i);
     print '.';
     while (! $ComWorker{$i}->{issleep} && ! $ComWorker{$i}->{inerror}){ThreadYield();}
  }
  print "\rstarting $NumComWorkers communication worker threads\t\t\t[OK]\nstarting rebuild SpamDB worker thread";

  mlog(0,"starting rebuild SpamDB worker thread [10001] - ThreadCycleTime is set to $RebuildThreadCycleTime microseconds");
  $ComWorker{10001} = &share({});
  $ComWorker{10001}->{run} = 1;
  if ($ThreadStackSize) {
      $Threads{10001} = threads->create({'stack_size' => 1024*1024*$ThreadStackSize},\&ThreadRebuildSpamDBStart,10001);
  } else {
      $Threads{10001} = threads->create(\&ThreadRebuildSpamDBStart,10001);
  }
  while (! $ComWorker{10001}->{isstarted} && ! $ComWorker{10001}->{inerror}){ThreadYield();}
  print "\t\t\t".($ComWorker{10001}->{inerror}?'[FAILED]':'[OK]')."\n";

  print "initializing main thread and logging\t\t\t[OK]\n";
  sleep 1;
  if ($CanUseBerkeleyDB) {
        eval('use BerkeleyDB;');
        if ($VerBerkeleyDB lt '0.42') {
            *{'BerkeleyDB::_tiedHash::CLEAR'} = *{'main::BDB_CLEAR'};
        }
        *{'BerkeleyDB::_tiedHash::STORE'} = *{'main::BDB_STORE'};
        *{'BerkeleyDB::_tiedHash::DELETE'} = *{'main::BDB_DELETE'};
  }

  if ($CanUseASSP_WordStem) {
      $Lingua::Stem::Snowball::stemmifier = Lingua::Stem::Snowball::Stemmifier->new unless ref($Lingua::Stem::Snowball::stemmifier);
  }
  
  &openLogs();
  
  if (! $silent) {
      binmode STDOUT;
      binmode STDERR;
  }

  &mlogWrite();
  
  &WaitForAllThreads;
  
  $canNotify = 1;
  
  if ($CanUseThreadState && $WorkerCPUPriority) {
      for (my $i = 1; $i <= $NumComWorkers; $i++) {
         my $po = $Threads{$i}->priority($WorkerCPUPriority);
         my $pn = $Threads{$i}->priority;
         $po = 0 if (! $po);
         $pn = 0 if (! $pn);
         mlog(0,"info: CPU priority changed for Worker_$i from $po to $pn") if ($po != $pn);
      }
  }
  if ($CanUseThreadState) {                   # set down thread priority for MaintThread and RebuildThread
     my $po = $Threads{10000}->priority(2);
     my $pn = $Threads{10000}->priority;
     $po = 0 if (! $po);
     $pn = 0 if (! $pn);
     mlog(0,"info: CPU priority changed for Worker_10000 from $po to $pn") if ($po != $pn);
     $po = $Threads{10001}->priority(2);
     $pn = $Threads{10001}->priority;
     $po = 0 if (! $po);
     $pn = 0 if (! $pn);
     mlog(0,"info: CPU priority changed for Worker_10001 from $po to $pn") if ($po != $pn);
  }
  &mlogWrite();
  mlog(0,"try using $DBusedDriver database \<$mydb\> for selected tables") if $DBisUsed;
  &mlogWrite();
  &initPrivatHashes('clean');
  &mlogWrite();
  %SMTPSessionIP = ();
  &ResetStats();
  &mlogWrite();
  &initDBHashes();        # init DB based hashes - they are not shared
  &mlogWrite();
  &initFileHashes('AdminGroup');  # AdminGroup is never shared;
  &mlogWrite();

  ConfigChangePassword('webAdminPassword', '', '', 0) if $usedCrypt == -1; # change the encryption engine now !
  
# check if there are at least 500 records in spamdb (~10KB)
  mlog(0,"start analyze spamdb") if $MaintenanceLog >= 2;
  my $i = $haveSpamdb = getDBCount('Spamdb','spamdb');
  $currentDBVersion{'Spamdb'} = $Spamdb{'***DB-VERSION***'} || 'n/a';
  mlog(0,"spamdb has $i records") if $MaintenanceLog >= 2;
  mlog(0,"warning: Bayesian spam database has only $i records") if ($i < 500 && $spamdb);
  mlog(0,"warning: the current Spamdb is possibly incompatible to this version of ASSP. Please run a rebuildspamdb. current: $currentDBVersion{Spamdb} - required: $requiredDBVersion{Spamdb}") if ($haveSpamdb && $currentDBVersion{Spamdb} ne $requiredDBVersion{Spamdb});
  &mlogWrite();
  
# check if there are at least 50 records in whitelist (~1KB)
  mlog(0,"start analyze whitelist") if $MaintenanceLog >= 2;
  $i = getDBCount('Whitelist','whitelistdb');
  mlog(0,"whitelist has $i records") if $MaintenanceLog >= 2;
  mlog(0,"warning: whitelist has only $i records: (ignore if this is a new install)") if ($i < 50 );

  if ($DoHMM) {
      $haveHMM = getDBCount('HMMdb','spamdb');
      mlog(0,"The Hidden-Markov-Model-DB is empty - the HMM check is disabled") if $MaintenanceLog && ! $haveHMM;
      mlog(0,"The Hidden-Markov-Model-DB has $haveHMM records.") if $MaintenanceLog >= 2 && $haveHMM;
  }
  $currentDBVersion{'HMMdb'} = $HMMdb{'***DB-VERSION***'} || 'n/a';
  mlog(0,"warning: the current HMMdb is possibly incompatible to this version of ASSP. Please run a rebuildspamdb. current: $currentDBVersion{HMMdb} - required: $requiredDBVersion{HMMdb}") if ($DoHMM && $haveHMM && $currentDBVersion{HMMdb} ne $requiredDBVersion{HMMdb});

  if ($mysqlSlaveMode) {
      mlog(0,"assp is running in mysqlSlaveMode - no maintenance will be done for database tables!");
  }
  &mlogWrite();

  if ($SNMP && $CanUseNetSNMPagent) {
      ConfigChangeSNMP('SNMPAgentXSocket','',$Config{SNMPAgentXSocket},'Initializing');
  } else {
      ConfigStats();
  }
  &mlogWrite();
  $shuttingDown=$doShutdown=0;
  $smtpConcurrentSessions=0;
  threads->yield;
  $Stats{starttime}=time;
  $Stats{version}="$version$modversion";

  my ($lsn,$lsnI) = newListen($listenPort,\&ConToThread,1);
  @lsn = @$lsn; @lsnI = @$lsnI;
  for (@$lsnI) {s/:::/\[::\]:/o;}
  mlog(0,"listening for SMTP connections on @$lsnI") if @lsn;

  if ($CanUseIOSocketSSL && $listenPortSSL) {
      my ($lsnSSL,$lsnSSLI) = newListenSSL($listenPortSSL,\&ConToThread,1);
      @lsnSSL = @$lsnSSL; @lsnSSLI = @$lsnSSLI;
      for (@$lsnSSLI) {s/:::/\[::\]:/o;}
      mlog(0,"listening for SMTPS (SSL) connections on @$lsnSSLI") if @lsnSSL;
  }

  my @dummy;
  if ($CanUseIOSocketSSL && $enableWebAdminSSL) {
      my ($WebSocket,$dummy)  = newListenSSL($webAdminPort,\&NewWebConnection);
      @WebSocket = @$WebSocket;
      for (@$dummy) {s/:::/\[::\]:/o;}
      mlog(0,"listening for admin HTTPS connections on @$dummy") if @WebSocket;
  } else {
      my ($WebSocket,$dummy)  = newListen($webAdminPort,\&NewWebConnection);
      @WebSocket = @$WebSocket;
      for (@$dummy) {s/:::/\[::\]:/o;}
      mlog(0,"listening for admin HTTP connections on @$dummy") if @WebSocket;
  }

  if ($CanUseIOSocketSSL && $enableWebStatSSL) {
      my ($StatSocket,$dummy) = newListenSSL($webStatPort,\&NewStatConnection);
      @StatSocket = @$StatSocket;
      for (@$dummy) {s/:::/\[::\]:/o;}
      mlog(0,"listening for stat HTTPS connections on @$dummy") if @StatSocket;
  } else {
      my ($StatSocket,$dummy) = newListen($webStatPort,\&NewStatConnection);
      @StatSocket = @$StatSocket;
      for (@$dummy) {s/:::/\[::\]:/o;}
      mlog(0,"listening for stat HTTP connections on @$dummy") if @StatSocket;
  }

  if($listenPort2) {
    my ($lsn2,$lsn2I) = newListen($listenPort2,\&ConToThread,1);
    @lsn2 = @$lsn2; @lsn2I = @$lsn2I;
    for (@$lsn2I) {s/:::/\[::\]:/o;}
    mlog(0,"listening for additional SMTP connections on @$lsn2I") if @lsn2;
  }

  if($relayHost && $relayPort) {
    my ($lsnRelay,$lsnRelayI)=newListen($relayPort,\&ConToThread,1);
    @lsnRelay = @$lsnRelay; @lsnRelayI = @$lsnRelayI;
    for (@$lsnRelayI) {s/:::/\[::\]:/o;}
    mlog(0,"listening for SMTP relay connections on @$lsnRelayI") if @lsnRelay;
  }

  &mlogWrite();
  while ((my $k,my $v) = each(%Proxy)) {
       my ($to,$allow) = split(/<=/o, $v);
       $allow = " allowed for $allow" if ($allow);
       my ($ProxySocket,$dummy) = newListen($k,\&ConToThread,2);
       $ProxySocket{$k} = shift @$ProxySocket;
       if ($ProxySocket{$k}) {
           for (@$dummy) {s/:::/\[::\]:/o;}
           mlog(0,"proxy started: listening on @$dummy forwarded to $to$allow");
       }
  }
  my $isproxy = scalar(keys %ProxySocket) ? ' and Proxy':'';
  mlog(0,"warning : DisableSMTPNetworking is switch on - SMTP$isproxy listeners will be switched off") if ($DisableSMTPNetworking);

  mlog(0,"current PID: $$");

  &mlogWrite();

  if ($StartError) {
      mlog(0,"*******************************************************************************************");
      mlog(0,"error: an unrecoverable startup error was detected - please look in to previous messages");
      mlog(0,"error: ASSP will not accept any SMTP connection - 'DisableSMTPNetworking' is set to on");
      mlog(0,"error: solve the problem and restart ASSP");
      mlog(0,"error: after restart - login in to GUI and change 'DisableSMTPNetworking' to off, if needed");
      mlog(0,"*******************************************************************************************");
      configUpdateSMTPNet('DisableSMTPNetworking','0','2','');
      &mlogWrite();
  }
  $cmdQueueReleased = 1;
  mlog(0,"info: command queue released");
  $allowPOP3 = 1;
  mlog(0,"info: POP3 collection is now allowed")
     if ($POP3Interval && -e "$base/assp_pop3.pl" && $POP3ConfigFile =~ /^ *file: *(?:.+)/io);
  &mlogWrite();
  if($pidfile) {open($PIDH,'>',"$base/$pidfile"); $PIDH->autoflush; print $PIDH $$;}
  nixUsers();
}

sub initDBHashes {

# generate the CacheObjects and Hashes for all Groups in GroupList, defined in the table above
# if there is "DB:" defined in $dbConfig, database tables are used - otherwise files are used
    return unless $DBisUsed;
    my $waserror = 0;
    my $switch_to_files = 0;
    my $dbh;
    do {
        $switch_to_files = 0 if ($switch_to_files);  #reset to normal state if we have switched over to files
        foreach my $dbGroup (@GroupList) {
            last if ($switch_to_files);
#            next if ($WorkerNumber == 10001 && $dbGroup =~ /delayGroup|LDAPGroup|AdminGroup/io);
            next if $dbGroup eq 'AdminGroup' && $WorkerNumber != 0 && $WorkerNumber < 10000;
            foreach my $dbGroupEntry (@$dbGroup) {
                last if ($switch_to_files);
                my ($KeyName,$dbConfig,$CacheObject,$realFileName,$mysqlFileName,$FailoverValue,$mysqlTable) = split(/,/o,$dbGroupEntry);
                undef $$CacheObject if(defined $$CacheObject && ${$dbConfig} =~ /DB:/o); # undef if we have switched from database to files
                eval {untie %$KeyName if (${$dbConfig} =~ /DB:/o);}; # untie if we have switched from database to files
                if (($CanUseTieRDBM or $CanUseBerkeleyDB) && ${$dbConfig} =~ /DB:/o && ! $waserror) {
                    eval {
                        if ( $DBusedDriver eq 'BerkeleyDB' && $CanUseBerkeleyDB)
                        {
                            my $BerkeleyFile = $realFileName;
                            $BerkeleyFile =~ s/DB:/$FailoverValue/o;
                            $BerkeleyFile = "$base/$BerkeleyFile.bdb";
                            d("BDB-ENV - $KeyName , $BerkeleyFile");
                            our %env = initBDBEnv($KeyName,$BerkeleyFile);
                            if ($dbGroup ne 'AdminGroup') {
                                d("BDB-DB (initDBHashes) - $KeyName , $BerkeleyFile");
                                $$CacheObject=tie %$KeyName, 'BerkeleyDB::Hash' , -Filename => $BerkeleyFile, %env;
                                BDB_filter($$CacheObject);
                            } else {
                                my $cmd = "'BerkeleyDB::Hash',-Filename => \"$BerkeleyFile\", \%main::env";
                                my $bin = $adminusersdbNoBIN ? 0 : 1 ;
                                d("BDB-DB (initDBHashes) - $KeyName , $BerkeleyFile");
                                $$CacheObject=tie %$KeyName,'ASSP::CryptTie',$adminusersdbpass,$bin,$cmd;
                            }
                            BDB_getRecordCount($KeyName);
                            &BDB_compact_hash($KeyName, 1000000) if $WorkerNumber == 0;
                        } else {
                            $dbh ||= DBI->connect("DBI:$DBusedDriver:database=$mydb;host=$myhost$DBOption", $myuser, $mypassword,
                                                    { PrintError=>0,
                                    			      ChopBlanks=>1,
                                    			      Warn=>0 }
                                    			  );
                            if ($dbGroup ne 'AdminGroup') {
                                d("DB (initDBHashes) - $KeyName");
                                $$CacheObject=tie %$KeyName,'Tie::RDBM',{db=>$dbh,table=>"$mysqlTable",create=>1,DEBUG=>$DataBaseDebug};
                            } else {
                                my $cmd = "'Tie::RDBM',\{db=>\$dbh,table=>\"$mysqlTable\",create=>1,DEBUG=>$DataBaseDebug\}";
                                my $bin = $adminusersdbNoBIN ? 0 : 1 ;
                                d("DB (initDBHashes) - $KeyName");
                                $$CacheObject=tie %$KeyName,'ASSP::CryptTie',$adminusersdbpass,$bin,$cmd,$dbh;
                            }
                        }
                    };
                    if($@) {    # there was an error tie
                        $failedTable{$KeyName} = 2;
                        if ($dbGroup ne 'AdminGroup') {
                            mlog(0,"$mysqlFileName database error: $@");
                            if (! $calledfromThread) {
                                $DBisUsed = 0;
                                $CanUseTieRDBM=0;
                                mlog(0,"Warning: can not use defined database - switching over to use files instead of database $mydb!");
                            }
                            $switch_to_files = 1;
                            $waserror = 1;
                        }
                    } else {
                        if (! $calledfromThread) {
                            CheckTableStructure($mysqlTable) if ($DBusedDriver eq 'mysql'); # change the table if there was made an upgrade
                            importDB($KeyName,$mysqlFileName,$mysqlTable,'','','');
                            $realFileName =~ s/DB:/$FailoverValue/o;
                            if ($DBusedDriver eq 'BerkeleyDB' && $CanUseBerkeleyDB) {
                                mlog(0,"using $DBusedDriver Database $base/$realFileName.bdb instead of file $base/$realFileName");
                            } else {
                                my $tbn = "<$mysqlTable>" . ' ' x (15 - length($mysqlTable));
                                mlog(0,"using table $tbn in $DBusedDriver Database <$mydb> instead of file $base/$realFileName");
                            }
                        }
                        $failedTable{$KeyName} = 0;
                    }
                } elsif ($waserror) {
                    $failedTable{$KeyName} = 2;
                }
            }
        }
    } while ($switch_to_files);
    if ($waserror && ! $calledfromThread) {
        mlog(0,"error : DB-failover loading hashes from files");
        &initFileHashes();
    }
}

sub initFileHashes {
    my $singleGroup = shift;
    foreach my $dbGroup (@GroupList) {
        next if $dbGroup eq 'AdminGroup' && $WorkerNumber != 0 && $WorkerNumber < 10000;
        next if $singleGroup && $singleGroup ne $dbGroup;
        foreach my $dbGroupEntry (@$dbGroup) {
            my ($KeyName,$dbConfig,$CacheObject,$realFileName,$mysqlFileName,$FailoverValue,$mysqlTable) = split(/,/o,$dbGroupEntry);
            if ((! $CanUseTieRDBM && ! $CanUseBerkeleyDB) || ${$dbConfig} !~ /DB:/o || $failedTable{$KeyName} == 1) {
                if (! $calledfromThread) {
                    next if (is_shared(%$KeyName));
                    share(%$KeyName) if $dbGroup ne 'AdminGroup';
                    if ($failedTable{$KeyName} == 2) {
                        mlog(0,"warning : setting configvalue for $dbConfig to $FailoverValue");
                        ${$dbConfig} = $FailoverValue;
                        $realFileName =~ s/DB:/$FailoverValue/o;
                    }
                    if ($dbGroup ne 'AdminGroup') {
                        &LoadHash($KeyName, "$base/$realFileName", 0) if (${$dbConfig} && ${$dbConfig} !~ /DB:/o);
                        $$CacheObject = 1;
                    } else {
                        if ($singleGroup eq 'AdminGroup'){
                            eval{
                                my $cmd = "'orderedtie',\"$base/$realFileName\"" ;
                                $$CacheObject=tie %$KeyName,'ASSP::CryptTie',$adminusersdbpass,0,$cmd;
                            } if (${$dbConfig} && ${$dbConfig} !~ /DB:/o);
                            if ($@) {
                                mlog(0,"warning: unable init AdminUsersDB - only root will have access to the GUI");
                            } else {
                                mlog(0,"info: $dbConfig ($base/$realFileName) - loaded") if $$CacheObject;
                            }
                        }
                    }
                }
                $failedTable{$KeyName} = 1;
            }
        }
    }
}

sub loadHashFromFile {
   my ($file,$hash) = @_;
   unless ($file) {
       mlog(0,"error: coding error - loadHashFromFile called without a specified file name");
       return;
   }
   unless (ref($hash) eq 'HASH') {
       mlog(0,"error: coding error - loadHashFromFile called without a valid HASH reference");
       return;
   }
   my $LH;
   my $count;
   lock(%$hash) if is_shared(%$hash);
   unless (open($LH, '<',$file)) {
       mlog(0,"warning: can't open file '$file' to load hash (in loadHashFromFile)");
       return;
   }
   binmode($LH);
   %{$hash} = ();
   while (<$LH>) {
     my ($k,$v) = split/\002/o;
     $v =~ s/\r|\n//go;
     if ($k && $v) {
       $hash->{$k}=$v;
       $count++;
     }
   }
   eval{close $LH;};
   return $count;
}

sub saveHashToFile {
   my ($file,$hash) = @_;
   unless ($file) {
       mlog(0,"error: coding error - saveHashToFile called without a specified file name");
       return;
   }
   unless (ref($hash) eq 'HASH') {
       mlog(0,"error: coding error - saveHashToFile called without a valid HASH reference");
       return;
   }
   my $LH;
   my $count;
   lock(%$hash) if is_shared(%$hash);
   unless (open($LH, '>',$file)) {
       mlog(0,"warning: can't open file '$file' to save hash (in saveHashToFile)");
       return;
   }
   binmode($LH);
   print $LH "\n";
   my @h;
   @h = sort keys %$hash;
   while (@h) {
      (my $k = shift @h) or next;
      (my $v = ${$hash}{$k}) or next;
      print $LH "$k\002$v\n";
      $count++;
   }
   eval{close $LH;};
   return $count;
}

sub initBDBEnv {
  my ($hash,$file) = @_;
  if ($DBusedDriver eq 'BerkeleyDB' && $CanUseBerkeleyDB) {
      my %bdbo = ();
      %bdbo = eval('('.$DBOption.')') if $DBOption;
      mlog(0,"info: DBOption: $DBOption") if (($debug || $DataBaseDebug) && $WorkerNumber == 0);
      foreach (keys %bdbo) {
          mlog(0,"info: defined BerkeleyOption: $_ = $bdbo{$_}") if (($debug || $DataBaseDebug) && $WorkerNumber == 0);
      }
      my %userenv = ();
      if ($bdbo{-Env}) {
          %userenv = %{$bdbo{-Env}} if (ref $bdbo{-Env} && $bdbo{-Env} =~ /HASH/o);
          %userenv = @{$bdbo{-Env}} if (ref $bdbo{-Env} && $bdbo{-Env} =~ /ARRAY/o);
          $bdbcache = $userenv{'-Cachesize'} if $userenv{'-Cachesize'};
          delete $userenv{'-Cachesize'};
          delete $bdbo{-Env};
      }
      $bdbcache = $bdbo{'-Cachesize'} unless $bdbcache;
      delete $bdbo{'-Cachesize'};
      $userenv{'-Cachesize'} = $bdbcache;
      eval('$bdbo{-Flags} = DB_CREATE;');
      $bdbo{'-Env'} = &createBDBEnv($hash, \%userenv);
      delete $bdbo{'-Env'} unless $bdbo{'-Env'};
      return %bdbo;
  }
}

sub clearDBCon {
    &clearDBConPrivat();
    my %dbh;
    foreach my $dbGroup (@GroupList) {
        next unless $DBisUsed;
        next if $dbGroup eq 'AdminGroup' && $WorkerNumber != 0 && $WorkerNumber < 10000;
        foreach my $dbGroupEntry (@$dbGroup) {
            my ($KeyName,$dbConfig,$CacheObject,$realFileName,$mysqlFileName,$FailoverValue,$mysqlTable) = split(/,/o,$dbGroupEntry);
            if(defined $$CacheObject && ${$dbConfig} =~ /DB:/o) {
                eval{$$CacheObject->rdbm_cleanCache() if "$$CacheObject" =~ /Tie::RDBM/o;} if ! $WorkerNumber;
                $dbh{$$CacheObject->{'dbh'}} = 1 if eval{exists $$CacheObject->{'dbh'};};
                $dbh{$$CacheObject->{hashobj}->{'dbh'}} = 1 if eval{exists $$CacheObject->{hashobj}->{'dbh'};};
                undef $$CacheObject; # undef if we have switched from database to files
            }
            eval {untie %$KeyName if (${$dbConfig} =~ /DB:/o);}; # untie if we have switched from database to files
        }
    }
    eval{if ($_) {$_->disconnect();}} for keys %dbh;
}

sub clearDBConPrivat {
    eval {
        undef $GriplistObj;
        untie %Griplist;
    };
    return if $WorkerNumber == 10001; # rebuildspamdb tied only the Griplist
    foreach (keys %tempDBvars) {
        eval {
        undef ${$_ .'Obj'};
        untie(%{$_});
        };
    }
}

sub CheckTableStructure {
  my $mysqlTable = shift;
  my $sql;
  my $dbh;
  my $sth;

  $dbh = DBI->connect("DBI:$DBusedDriver:database=$mydb;host=$myhost$DBOption", "$myuser", "$mypassword");
  if (!$dbh) {
    mlog(0,"Error: $DBI::errstr");
    mlog(0,"MySQL check for table $mysqlTable canceled!");
    $dbh->disconnect() if ( $dbh );
    return;
  }

  my $db_features = $Tie::RDBM::Types{$DBusedDriver};
  my($keytype,$valuetype,$frozentype) = @{$db_features};

  $sth = $dbh->column_info( undef, undef, $mysqlTable, 'pkey' );
  my $db_info;
  eval{$db_info = $sth->fetchrow_arrayref} ;
  if($@) {
    mlog(0,"warning: your mysql driver does not support GET-COLUMNE-INFO");
    mlog(0,"driver version is $DBD::mysql::VERSION - should be at least 4.005");
    $dbh->disconnect() if ( $dbh );
    return;
  }
  my $pkey_TYPE_NAME = @$db_info[37];

  if (lc($pkey_TYPE_NAME) ne lc($keytype)) {
    mlog(0,"info: convert field pkey in table $mysqlTable from $pkey_TYPE_NAME to $keytype");
    $sql="ALTER TABLE $mysqlTable MODIFY COLUMN pkey $keytype NOT NULL";
    $sth = $dbh->do($sql);
    $dbh->commit unless $main::DBautocommit;
    if (!$dbh) {
      mlog(0,"Error: $DBI::errstr");
      mlog(0,"conversion for table $mysqlTable failed!");
    }
  }

  $sth = $dbh->column_info( undef, undef, $mysqlTable, 'pvalue' );
  $db_info = $sth->fetchrow_arrayref ;
  my $pvalue_TYPE_NAME = @$db_info[37];

  if (lc($pvalue_TYPE_NAME) ne lc($valuetype)) {
    mlog(0,"info: convert field pvalue in table $mysqlTable from $pvalue_TYPE_NAME to $valuetype");
    $sql="ALTER TABLE $mysqlTable MODIFY COLUMN pvalue $valuetype DEFAULT NULL";
    $sth = $dbh->do($sql);
    $dbh->commit unless $main::DBautocommit;
    if (!$dbh) {
      mlog(0,"Error: $DBI::errstr");
      mlog(0,"conversion for table $mysqlTable failed!");
    }
  }
# conversion for pfrozen is not needed - it was never changed
  $dbh->disconnect() if ( $dbh );
}

sub importDB {
   my ($name,$file,$mysqlTable,$cache,$cacherec,$recfac) = @_;
   my $importrpl="$base/$importDBDir/$file.rpl";
   my $importadd="$base/$importDBDir/$file.add";
   my $count;
   my $records;
   my $tempCache = $cache ? $cache : {};
   my $sql;
   my $sep;
   my $sqlmaxlen;
   my $dbh;
   my $dbn;
   my $dbv;
   my $dec;
   my $sth;
   my $k;
   my $v;
   my ($dn,$ve,$dp,$ap,$is,$id,$se,$mr,$es);
   my $sql_sm;
   my @dbcfg;
   my $dkey;
   my $dodec;
   $recfac ||= 1;
   $dodec = 1 if $name eq 'AdminUsersRight';
   $dodec = 1 if $name eq 'AdminUsers';

   if ($cache && !($DBusedDriver eq 'BerkeleyDB' or $dodec or $preventBulkImport)) {
       $importrpl = 'cache';
   }

   return if (!(-e $importrpl || -e $importadd) && $importrpl ne 'cache');
   mlog_i(0,"database import started for table $mysqlTable");
   if ($DBusedDriver ne 'BerkeleyDB' && !-e "$base/assp_db_import.cfg"){
     mlog_i(0,"ERROR: unable to find file $base/assp_db_import.cfg - cancel import");
     return;
   }

   exportDB($name,$file,"backup",0) if $importrpl ne 'cache';   #overall - backup before update is the right way
   return if($WorkerNumber != 0 && ! $ComWorker{$WorkerNumber}->{run});

   if (-e $importrpl || $importrpl ne 'cache') {
       mlog_i(0,"replacing records in table $mysqlTable with records in file $importrpl") if $importrpl ne 'cache';
       ${$name}{'x1'} = '1'; #some databases need at least one record to delete all
       %$name=(); # clear the HASH
   }

   if (-e $importadd) {
      mlog_i(0,"adding records in file $importadd to table $mysqlTable");
   }

   $dec = ASSP::CRYPT->new($adminusersdbpass,0) if $dodec;

   my @import = ($importrpl,$importadd);
   foreach my $importrpl (@import){
    $count = 0;
    $records = 0;
    if (-e $importrpl or $importrpl eq 'cache') {
       my $imp_start_time = time;
       my $last_step_time = $imp_start_time;
       my $toadd = 1000;
       my $IMP;
       if ($importrpl ne 'cache') {
           my $obj;
           if ($obj = tied %$name) {
               $obj = $obj->{hashobj} if $dodec;
               if ($obj =~ /BerkeleyDB/o) {
                  BDB_filter_off($obj);
               } else {
                  undef $obj;
               }
           }
           open($IMP, '<',"$importrpl");
           binmode($IMP);
           if ($DBusedDriver eq 'BerkeleyDB' or $dodec or $preventBulkImport or $RunTaskNow{ImportMysqlDB}) {
               while (<$IMP>) {
                   $records++;
               }
               close $IMP;
               open($IMP, '<',"$importrpl");
               binmode($IMP);
           }
           my $old_sec_left;
           my $sec_left;
           while (<$IMP>) {
                my ($k,$v) = $_ =~ /(.*)\002(.*)/;
                $count++;
                $v =~ s/\\r|\\n//go;
                $v =~ s/\r|\n//go;
                $k =~ s/\\r|\\n//go;
                $k =~ s/\r|\n//go;
                $k = $dec->DECRYPT($k) if $dodec && $k && $v;
                $v = $dec->DECRYPT($v) if $dodec && $k && $v;
                if (($k && $v) or ($k && defined $v && $dodec)) {
                     if ($DBusedDriver eq 'BerkeleyDB' or
                         $dodec or
                         $preventBulkImport or
                         $RunTaskNow{ImportMysqlDB}
                        )
                     {
                         ${$name}{$k} = $v;
                         if ($count % $toadd == 0 &&
                             ($sec_left = int(( time - $imp_start_time )*($records - $count)/$count)) != $old_sec_left)
                         {
                             $old_sec_left = $sec_left;
                             mlog_i(0,"added $count of $records records for table $mysqlTable - finished in $sec_left sec");
                             &checkDBCon() if $WorkerNumber > 0;
                             &ThreadMonitorMainLoop("import $mysqlTable") if $WorkerNumber == 0;
                             my $stime = time - $last_step_time || 1;
                             $toadd = int(2 / $stime * $toadd);
                             $last_step_time = time;
                             return if($WorkerNumber != 0 && ! $ComWorker{$WorkerNumber}->{run});
                         }
                     } else {
                         $records++ if (! exists $tempCache->{$k});
                         $tempCache->{$k}=$v;
                     }
                }
           }
           close $IMP;

           if ($DBusedDriver eq 'BerkeleyDB' or $dodec or $preventBulkImport or $RunTaskNow{ImportMysqlDB}) {
               my $BDB; $BDB = " $DBusedDriver" if ($DBusedDriver eq 'BerkeleyDB' or $preventBulkImport);
               mlog_i(0,"successfully added $count records in to $BDB $name");
               rename("$importrpl","$importrpl.OK") or mlog(0,"Error: unable to rename $importrpl to $importrpl.OK");
               next;
           }

           mlog_i(0,"$records valid records of $count records found in $importrpl");
           BDB_filter($obj) if $obj;
       }
       
       if ($cache) {
           $records = $cacherec;
           ${$name}{'x1'} = '1'; #some databases need at least one record to delete all
           %$name=(); # clear the HASH
           if ($@ or ${$name}{'x1'} == 1) {
               sleep 5;
               $ThreadIdleTime{$WorkerNumber} += 5;
               %$name=(); # clear the HASH
           }
       }
       mlog_i(0,"trying Bulkimport for table $mysqlTable");

# first we are trying to make a fast Bulkimport - this should work for most of the databases

       $dbh = DBI->connect("DBI:$DBusedDriver:database=$mydb;host=$myhost$DBOption", "$myuser", "$mypassword");
       if (!$dbh) {
           mlog_i(0,"Error: $DBI::errstr");
           mlog_i(0,"Import for table $mysqlTable canceled!");
           return;
       }

       $dbn = $dbh->get_info(17);
       $dbv = $dbh->get_info(18);
       mlog_i(0,"database: $dbn $dbv");
       if (!($dbn && $dbv)) {
           mlog_i(0,"ERROR: unable to get database information from DBI");
           mlog_i(0,"Import for table $mysqlTable canceled!");
           $dbh->disconnect() if ( $dbh );
           return;
       }

# find the right SQL statements in config file "assp_db_import.cfg"
       open($IMP, '<',"$base/assp_db_import.cfg");
       @dbcfg=<$IMP>;
       close $IMP;
       my %stm = ();
       foreach (@dbcfg) {     # process all lines
           chomp;
           next if /^#/o;
           ($dn,$ve,$dp,$ap,$is,$id,$se,$mr,$es) = split/\|/o;
           next if (!$dn);
           $stm{lc($dn).$ve."dp"}=$dp;
           $stm{lc($dn).$ve."ap"}=$ap;
           $stm{lc($dn).$ve."is"}=$is;
           $stm{lc($dn).$ve."id"}=$id;
           $stm{lc($dn).$ve."se"}=$se;
           $stm{lc($dn).$ve."mr"}=$mr;
           $stm{lc($dn).$ve."es"}=$es;
       }

# find the statements
# first this with both - database and version are wildcards (SQL-ANSI-92)
# second this with the right database and version is wildcards
# third this with the right database and the right version


       if ( exists $stm{'**dp'}) {$dp=$stm{'**dp'}; $ap=$stm{'**ap'}; $is=$stm{'**is'}; $id=$stm{'**id'}; $se=$stm{'**se'};$mr=$stm{'**mr'};$es=$stm{'**es'};}
       if ( exists $stm{lc($dbn).'*dp'}) {$dp=$stm{lc($dbn).'*dp'}; $ap=$stm{lc($dbn).'*ap'}; $is=$stm{lc($dbn).'*is'}; $id=$stm{lc($dbn).'*id'}; $se=$stm{lc($dbn).'*se'}; $mr=$stm{lc($dbn).'*mr'}; $es=$stm{lc($dbn).'*es'};}
       if ( exists $stm{lc($dbn).$dbv.'dp'}) {$dp=$stm{lc($dbn).$dbv.'dp'}; $ap=$stm{lc($dbn).$dbv.'ap'}; $is=$stm{lc($dbn).$dbv.'is'}; $id=$stm{lc($dbn).$dbv.'id'}; $se=$stm{lc($dbn).$dbv.'se'}; $mr=$stm{lc($dbn).$dbv.'mr'}; $es=$stm{lc($dbn).$dbv.'es'};}

# get the types of fields - they may differ depending on the used DB engine
# at this time, this is only needed for MS-SQL to build the right CONVERT statement
# this is to be expanded if any DB require CAT- or SCHEMA-definition (see primary key)
       my $db_info;
       my $pkey_TYPE_NAME;
       my $pvalue_TYPE_NAME;
       my $pfrozen_TYPE_NAME;
       
       ($sth = $dbh->column_info( undef, undef, $mysqlTable, 'pkey' )) and
       ($db_info = $sth->fetchrow_arrayref) and
       ($pkey_TYPE_NAME = @$db_info[5]);

       ($sth = $dbh->column_info( undef, undef, $mysqlTable, 'pvalue' )) and
       ($db_info = $sth->fetchrow_arrayref) and
       ($pvalue_TYPE_NAME = @$db_info[5]);

       ($sth = $dbh->column_info( undef, undef, $mysqlTable, 'pfrozen' )) and
       ($db_info = $sth->fetchrow_arrayref) and
       ($pfrozen_TYPE_NAME = @$db_info[5]);

# get the name of the primary key
       $sth = $dbh->primary_key_info( undef, undef , $mysqlTable ); # for MSSQL, MySQL
       eval{$db_info = $sth->fetchrow_arrayref ;};
       my($TABLE_CAT,$TABLE_SCHEM,$TABLE_NAME,$COLUMN_NAME,$KEY_SEQ,$PK_NAME) = @$db_info ;
       if (!$TABLE_NAME) {
          $sth = $dbh->primary_key_info( undef, undef , uc($mysqlTable));
          eval{$db_info = $sth->fetchrow_arrayref ;};
          ($TABLE_CAT,$TABLE_SCHEM,$TABLE_NAME,$COLUMN_NAME,$KEY_SEQ,$PK_NAME) = @$db_info ;
       }
       if (!$TABLE_NAME) {
          $sth = $dbh->primary_key_info( undef, undef , lc($mysqlTable));     # for Pg
          eval{$db_info = $sth->fetchrow_arrayref ;};
          ($TABLE_CAT,$TABLE_SCHEM,$TABLE_NAME,$COLUMN_NAME,$KEY_SEQ,$PK_NAME) = @$db_info ;
       }
       if (!$TABLE_NAME) {
          $sth = $dbh->primary_key_info( undef, $myuser , $mysqlTable );
          eval{$db_info = $sth->fetchrow_arrayref ;};
          ($TABLE_CAT,$TABLE_SCHEM,$TABLE_NAME,$COLUMN_NAME,$KEY_SEQ,$PK_NAME) = @$db_info ;
       }
       if (!$TABLE_NAME) {
          $sth = $dbh->primary_key_info( undef , uc($myuser) , uc($mysqlTable));  # for Oracle
          eval{$db_info = $sth->fetchrow_arrayref ;};
          ($TABLE_CAT,$TABLE_SCHEM,$TABLE_NAME,$COLUMN_NAME,$KEY_SEQ,$PK_NAME) = @$db_info ;
       }

       if (!$TABLE_NAME) {
          mlog_i(0,"ERROR: unable to get primary-key info for table $mysqlTable - cancel import");
          return;
       }

       mlog_i(0,"removing PRIMARY KEY $PK_NAME from table $mysqlTable") if ( $PK_NAME && $dp !~ /NOOP/o);
# remove primary key - if we do not do this, the import may fail on duplicate keys!!!
       eval ($dp) if ($dp !~ /NOOP/o);
       $sql=$sql_sm;
       if ( $PK_NAME && $dp !~ /NOOP/o) {
           $sth = $dbh->do($sql);
           $dbh->commit unless $main::DBautocommit;
       }
       $count = 0;
       eval ($se);
# set the separator for the middle of the INSERT statement
       $sep=$sql_sm;
       eval ($is);
       $sql=$sql_sm;
       my $max = 10;
       $sqlmaxlen = int($mr * $recfac) || $max;  # 2000 tested for mysql - absolute limit is ~5000 - so we are save (defined in assp_db_import.cfg)
       my $sqllen = int($sqlmaxlen/$max)*$max || $max;
       $imp_start_time = time;
       $last_step_time = $imp_start_time;
# build the INSERT statement from the statements in assp_db_import.cfg and the values in $k,$v
# do this until all record have been inserted or $DBI::err
       my $DBG;
       if ($DataBaseDebug or $debug) {open($DBG,'>',"$base/debug/sql_import_$mysqlTable.".time.'.txt'); binmode($DBG);}
       my $old_sec_left;
       my $sec_left;
       while (my ($k,$v)=each(%{$tempCache})) {
           $k = $dbh->quote($k);   # let's DBI do the quoting - depends on the driver
           $v = $dbh->quote($v);
           next if (! $k || $k eq 'NULL');
           $count++;
           $sep = '' if ($count == $records or int($count/$sqllen) == $count/$sqllen);
           eval ($id);
           $sql .= $sql_sm.$sep;
           if ($count == $records or int($count/$sqllen) == $count/$sqllen) {
              if ($es) {
                  eval ($es);
                  $sql .= $sql_sm;
              }
              if ($DataBaseDebug or $debug) {print $DBG "$sql\n" if $DBG;}
              $sth = $dbh->do($sql);
              $dbh->commit unless $main::DBautocommit;
              last if ($DBI::err);
              if ($count % 1000 == 0 && ($sec_left = int(( time - $imp_start_time )*($records - $count)/$count)) != $old_sec_left) {
                  $old_sec_left = $sec_left;
                  mlog_i(0,"added $count of $records records for table $mysqlTable - finished in $sec_left sec");
                  &checkDBCon() if $WorkerNumber > 0;
                  &ThreadMonitorMainLoop("import $mysqlTable") if $WorkerNumber == 0;
                  last if($WorkerNumber != 0 && ! $ComWorker{$WorkerNumber}->{run});
              }
# reset the separator and the begin of the insert statement
              eval ($se);
              $sep = $sql_sm;
              eval ($is);
              $sql = $sql_sm;
# calculate the number of record that can be added in 2 seconds
              my $stime = $last_step_time - time || 1;
              $sqllen = int(2 / $stime * $sqllen /$max)*$max;
              if ($sqllen <= $max) {$sqllen = $max;}
              elsif ($sqllen > $sqlmaxlen) {$sqllen = $sqlmaxlen;}
              $last_step_time = time;
           }
       }
       if ($DataBaseDebug or $debug) {close($DBG) if $DBG};
       if ($DBI::err) {
# Bulk import has failed - so we are using STD-methode - witch may take a long time
              mlog_i(0,"Error: $DBI::errstr");
              mlog_i(0,"Bulkimport for table $mysqlTable canceled - doing normal import");
# clearing the HASH (delete * from ...) and add the primary key
              ${$name}{'x1'} = '1';
              %$name=();
              mlog_i(0,"adding pimary key $PK_NAME to table $mysqlTable") if ( $PK_NAME && $ap !~ /NOOP/o);
              eval ($ap) if ($ap !~ /NOOP/o);
              $sql=$sql_sm;
              if ( $PK_NAME && $ap !~ /NOOP/o) {
                  $sth = $dbh->do($sql);
                  $dbh->commit unless $main::DBautocommit;
              }
              $dbh->disconnect() if ( $dbh );
# Bulk import failed - so doing the import record by record with the tied HASH
              $count = 0;
              my $imp_start_time = time;
              my $last_step_time = $imp_start_time;
              my $toadd = 500;
              while (my ($k,$v)=each(%{$tempCache})) {
                 next unless $k;
                 ${$name}{$k} = $v;
                 $count++;
                 if ($count % $toadd == 0 && ($sec_left = int(( time - $imp_start_time )*($records - $count)/$count)) != $old_sec_left) {
                    $old_sec_left = $sec_left;
                    mlog_i(0,"added $count of $records records for table $mysqlTable - finished in $sec_left sec");
                    &checkDBCon() if $WorkerNumber > 0;
                    &ThreadMonitorMainLoop("import $mysqlTable") if $WorkerNumber == 0;
                    my $stime = time - $last_step_time || 1;
                    $toadd = int(2 / $stime * $toadd);
                    $last_step_time = time;
                    last if($WorkerNumber != 0 && ! $ComWorker{$WorkerNumber}->{run});
                 }
              }
       } else {
            mlog_i(0,"Bulkimport for table $mysqlTable finished");
# we have to remove duplicate keys from pkey before add the primary key to the table
            if ($ap !~ /NOOP/o ) {   # if $ap is NOOP the primary key was not removed above - so the table must be OK
              mlog_i(0,"removing duplicate keys from table $mysqlTable");
              my $dup_key;
              $dkey=0;
# run this loop until there are no duplicate keys in the table
              do {
                 $dup_key = 0;
                 $sql ="SELECT pkey FROM $mysqlTable GROUP BY pkey HAVING count(*) > 1";
                 $sth = $dbh->prepare($sql);
                 $sth->execute;
                 while ( my ($pkey) = $sth->fetchrow_array ) {   # all duplicate records are in this array
                     $pkey = $dbh->quote($pkey);   # let's DBI do the quoting - depends on the driver
                     $sql ="SELECT * FROM $mysqlTable WHERE pkey=$pkey";   # get all records for this duplicate key
                     my $sthh = $dbh->prepare($sql);
                     $sthh->execute;
                     my ($pkey_add,$pvalue_add,$pfrozen_add) = $sthh->fetchrow_array ;
                     $sql ="DELETE FROM $mysqlTable WHERE pkey=$pkey";   # get all records for this duplicate key
                     $sthh = $dbh->prepare($sql);
                     $sthh->execute;
                     $dbh->commit unless $main::DBautocommit;
                     ${$name}{$pkey_add}=$pvalue_add ; # add the first record
                     $dup_key = 1;
                     $dkey++;
                 }
              } while ($dup_key);
              mlog_i(0,"removed $dkey duplicate keys from table $mysqlTable") if ($dkey);
              $PK_NAME = "PK_$mysqlTable" if (! $PK_NAME); # a primary key is needed
              mlog_i(0,"adding pimary key $PK_NAME to table $mysqlTable") if ( $PK_NAME && $ap !~ /NOOP/o);
              eval ($ap) if ($ap !~ /NOOP/o);
              $sql = $sql_sm;
              if ( $PK_NAME && $ap !~ /NOOP/o) {
                  $sth = $dbh->do($sql) ;
                  $dbh->commit unless $main::DBautocommit;
              }
            }
            $dbh->disconnect() if ( $dbh );
            delete ${$name}{''};
       }
       $count = $count - $dkey;
       mlog_i(0,"successfully added $count records in to table $mysqlTable");
       if (! $cache) {
           rename("$importrpl","$importrpl.OK") or mlog_i(0,"Error: unable to rename $importrpl to $importrpl.OK");
       }
    }
   }
}

sub importMysqlDB {
  my $action = "import";
  return unless $DBisUsed;
  if (!$CanUseTieRDBM && !$CanUseBerkeleyDB) {
    mlog(0,"error: can not $action - database support is not available");
    mlog(0,"Please check the configuration and restart assp!");
    mlog(0,"You have to restart assp, if you changed any database relevant configuration parameters!!!");
    return;
  }
  &checkDBCon();
  foreach my $dbGroup (@GroupList) {
      foreach my $dbGroupEntry (@$dbGroup) {
        my ($KeyName,$dbConfig,$CacheObject,$realFileName,$mysqlFileName,$FailoverValue,$mysqlTable) = split(/,/o,$dbGroupEntry);
        importDB($KeyName,$mysqlFileName,$mysqlTable,'','','') if (${$dbConfig} =~ /DB:/o && ! $failedTable{$KeyName});
        &checkDBCon();
      }
  }
}

sub importFillUp {
  my $filever = shift;
  $filever = uc($filever);
  d("importFillUp - $filever");
  return unless $filever =~ /^[L0-9]$/io;
  return unless $DBisUsed;
  return unless $backupDBDir && $importDBDir;
  $filever = '.' . $filever;
  $filever = '' if $filever eq '.L';
  foreach my $dbGroup (@GroupList) {
      foreach my $dbGroupEntry (@$dbGroup) {
        my ($KeyName,$dbConfig,$CacheObject,$realFileName,$mysqlFileName,$FailoverValue,$mysqlTable) = split(/,/o,$dbGroupEntry);
        next if ${$dbConfig} !~ /DB:/o;
        my $src="$base/$backupDBDir/$mysqlFileName$filever";
        my $tar="$base/$importDBDir/$mysqlFileName.rpl";
        if (copy($src,$tar)) {
            mlog(0,"info: copied file $src to $tar");
        } else {
            mlog(0,"warning: unable to copy file $src to $tar - $!");
        }
      }
  }
}


sub exportDB {
  my ($name,$file,$action,$realFileName)=@_;
  my $export;
  my $i;
  my $enc;
  my $doenc = 0;
  $doenc = 1 if $name eq 'AdminUsersRight';
  $doenc = 1 if $name eq 'AdminUsers';
  $realFileName = "$base/$realFileName" if ($realFileName);
  $export="$base/$exportDBDir/$file" if (lc($action)=~/export/o);
  $export="$base/$backupDBDir/$file" if (lc($action)=~/backup/o);
  mlog_i(0,"$action: starting $action database table $name to file $export");
  unlink "$export.9";
  for ($i=8;$i>0;$i--) {
     my $j=$i+1;
     rename("$export.$i","$export.$j");
  }
  rename("$export","$export.1");
  my $count=0;

  $enc = ASSP::CRYPT->new($adminusersdbpass,0) if $doenc;
  my $obj;
  if ($obj = tied %$name) {
      $obj = $obj->{hashobj} if $doenc;
      if ($obj =~ /BerkeleyDB/o) {
         BDB_filter_off($obj);
      } else {
         undef $obj;
      }
  }
  my $EXP;
  open($EXP, '>',"$export");
  binmode($EXP);
  print $EXP "\n";
  while (my ($k,$v)=each(%$name)) {
     if ($k) {
         if ($doenc && $enc) {
             $k = $enc->ENCRYPT($k);
             $v = $enc->ENCRYPT($v);
         }
         print $EXP "$k\002$v\n";
         $count++;
     }
     if ($count%1000 == 0) {
         threads->yield();
         ThreadMaintMain2() if $WorkerNumber == 10000;
         if ($WorkerNumber == 0 ) {
             &ThreadMonitorMainLoop("$action $name");
         } else {
             last if(! $ComWorker{$WorkerNumber}->{run});
         }
     }
  }
  close $EXP;
  BDB_filter($obj) if $obj;
  mlog_i(0,"$action: $count records of database table $name to file $export");

  if ($copyDBToOrgLoc && lc($action)=~/backup/o && $realFileName){
    if (copy("$export","$realFileName")) {
        mlog_i(0,"$action: $count records of database table $name to file $realFileName");
    } else {
        mlog_i(0,"$action: unable to copy file $export to file $realFileName - $!");
    }
  }
}


sub exportMysqlDB {
  my $action = shift;
  return unless $DBisUsed;
  if (! $CanUseTieRDBM && ! $CanUseBerkeleyDB) {
    mlog(0,"error: can not $action - database support is not available");
    mlog(0,"Please check the configuration and restart assp!");
    mlog(0,"You have to restart assp, if you changed any database related configuration parameters!!!");
    return;
  }
  &checkDBCon();
  foreach my $dbGroup (@GroupList) {
      foreach my $dbGroupEntry (@$dbGroup) {
        my ($KeyName,$dbConfig,$CacheObject,$realFileName,$mysqlFileName,$FailoverValue,$mysqlTable) = split(/,/o,$dbGroupEntry);
        $realFileName =~ s/DB:/$FailoverValue/o;
        exportDB($KeyName,$mysqlFileName,$action,$realFileName) if (${$dbConfig} =~ /DB:/o && ! $failedTable{$KeyName});
        &checkDBCon();
      }
  }
}

sub checkDBCon {
  my $nextcheck = shift;
  if ($nextcheck) {
      $nextDBcheck = $nextcheck;
  } else {
      return 0 if $nextDBcheck > time;
      if ($WorkerNumber == 0 or $WorkerNumber >= 10000) {
          $nextDBcheck = time + $ThreadsWakeUpInterval + 2;
      } else {
          $nextDBcheck = time + 90;
      }
  }
  my $cdberror=0;
  if ($DBusedDriver eq 'BerkeleyDB' && $CanUseBerkeleyDB) {
      return 0;
  }
  &sigoffTry(__LINE__);
  d('checkdbcon');
  $checkdb = 1;   # signal rdbm_EXISTS that it should die on errors
  my $dbh;
  foreach my $dbGroup (@GroupList) {
#      next if ($WorkerNumber == 10001 && $dbGroup =~ /delayGroup|LDAPGroup|AdminGroup/io);
      next if $dbGroup eq 'AdminGroup' && $WorkerNumber != 0 && $WorkerNumber < 10000 ;
      foreach my $dbGroupEntry (@$dbGroup) {
        my ($KeyName,$dbConfig,$CacheObject,$realFileName,$mysqlFileName,$FailoverValue,$mysqlTable) = split(/,/o,$dbGroupEntry);
        next if $KeyName =~ /HMM/o && $lockHMM;
        next if $KeyName eq 'Spamdb' && $lockBayes;
        if (${$dbConfig} =~ /DB:/o) {
          my $querystr="01AA01" . $KeyName .int(rand(10000)). "01AA01";
          d("chkdb - $KeyName");
          eval {exists ${$KeyName}{$querystr};
                d("chkdb - OK for $KeyName");
#                mlog(0,"info: checkdbcon OK for $KeyName") if ($WorkerNumber == 10000 && $MaintenanceLog > 2);
#                my $t; $t = lc $$CacheObject->{table} if "$$CacheObject" =~ /Tie::RDBM/oi;
#                mlog(0,"info: table-Cache: $$CacheObject->{table}: @{$t}") if ($WorkerNumber == 10000  && "$$CacheObject" =~ /Tie::RDBM/oi);
                delete $$CacheObject->{'cached_value'} if "$$CacheObject" =~ /Tie::RDBM/oi;
                delete $$CacheObject->{hashobj}->{'cached_value'}
                  if "$$CacheObject" =~ /assp::/io && "$$CacheObject->{hashobj}" =~ /Tie::RDBM/oi;
          }; # make the fast select and clean the cache
          if ($@ or $failedTable{$KeyName}){  # try to reconnect if the select has failed - else do nothing
            $cdberror = 1;
            if ($@) {
                mlog(0,"warning: got database error $@ on table $mysqlTable - try to reconnect");
            } else {
                mlog(0,"warning: database table $mysqlTable has failed state - try to reconnect");
            }
            eval { undef $$CacheObject; untie %$KeyName;};
            eval {
                if ($DBusedDriver eq 'BerkeleyDB' && $CanUseBerkeleyDB) {
                    my $BerkeleyFile = $realFileName;
                    $BerkeleyFile =~ s/DB:/$FailoverValue/o;
                    $BerkeleyFile = "$base/$BerkeleyFile.bdb";
                    our %env = initBDBEnv($KeyName,$BerkeleyFile);
                    if ($dbGroup ne 'AdminGroup') {
                        $$CacheObject=tie %$KeyName, 'BerkeleyDB::Hash' , -Filename => $BerkeleyFile, %env;
                        BDB_filter($$CacheObject);
                    } else {
                        my $cmd = "'BerkeleyDB::Hash',-Filename => \"$BerkeleyFile\", \%main::env";
                        my $bin = $adminusersdbNoBIN ? 0 : 1 ;
                        $$CacheObject=tie %$KeyName,'ASSP::CryptTie',$adminusersdbpass,$bin,$cmd;
                    }
                } else {
                    $dbh ||= DBI->connect("DBI:$DBusedDriver:database=$mydb;host=$myhost$DBOption", $myuser, $mypassword,
                                            { PrintError=>0,
                            			      ChopBlanks=>1,
                            			      Warn=>0 }
                            			  );
                    if ($dbGroup ne 'AdminGroup') {
                        $$CacheObject=tie %$KeyName,'Tie::RDBM',{db=>$dbh,table=>"$mysqlTable",create=>1,DEBUG=>$DataBaseDebug};
                    } else {
                        my $cmd = "'Tie::RDBM',\{db=>\$dbh,table=>\"$mysqlTable\",create=>1,DEBUG=>$DataBaseDebug\}";
                        my $bin = $adminusersdbNoBIN ? 0 : 1 ;
                        $$CacheObject=tie %$KeyName,'ASSP::CryptTie',$adminusersdbpass,$bin,$cmd,$dbh;
                    }
                }
            };
            if($@) {
                mlog(0,"$mysqlFileName database error: $@");
                $realFileName =~ s/DB:/$FailoverValue/o;
                if ($dbGroup ne 'AdminGroup') {
                    mlog(0,"error: unable to use defined database - switching over to use $base/$realFileName instead of table $mysqlTable!");
                    mlog(0,"warning: from this time, the hash $KeyName will be different in every worker");
                    $$CacheObject=tie %$KeyName,'orderedtie',"$base/$realFileName";
                } else {
                    eval { undef $$CacheObject; untie %$KeyName;};
                    mlog(0,"warning: hash $KeyName is unavailable - only root is permitted to logon to GUI");
                }
                $failedTable{$KeyName} = 2;
            } else {
                mlog(0,"info: reusing table \<$mysqlTable\>  \tin $DBusedDriver Database \<$mydb\>");
                $failedTable{$KeyName} = 0;
            }
          }
        }
        if ($KeyName eq 'Spamdb' && ! $WorkerNumber && $haveSpamdb) {
            $currentDBVersion{Spamdb} = $Spamdb{'***DB-VERSION***'} || 'n/a';
            threads->yield;
        } elsif ($KeyName eq 'HMMdb' && ! $WorkerNumber && $haveHMM) {
            $currentDBVersion{HMMdb} = $HMMdb{'***DB-VERSION***'} || 'n/a';
            threads->yield;
        }
        eval{$$CacheObject->rdbm_cleanCache() if "$$CacheObject" =~ /Tie::RDBM/o;} if ! $WorkerNumber;
      }
  }
  d('chkdb - finished');
  $checkdb = undef;
  &sigonTry(__LINE__);
  return $cdberror;
}

sub getDestSockDom {
    my $dest = shift;
    return unless $dest;
    my $orgdest = $dest;
    my ($ip4,$ip6,$ip,%Domain);
    $ip = $1 if $dest =~ /^\[?($IPRe)\]?/o;
    if (! $ip) {
        my ($port,@res);
        $dest =~ s/^\[//o;
        $dest =~ s/\]?:\d+$//o;
        if ($CanUseIOSocketINET6) {
            eval(<<EOT);
                @res = Socket6::getaddrinfo($dest,25,AF_INET6);
	            ($ip6, $port) = getnameinfo($res[3], NI_NUMERICHOST | NI_NUMERICSERV) if $res[3];
EOT
            eval(<<EOT)  if $@ || !($ip6 =~ s/^\[?($IPv6Re)\]?$/$1/o);
                $ip6 = Socket6::inet_ntop( AF_INET6, scalar( Socket6::gethostbyname2($dest,AF_INET6) ) );
EOT
            $ip6 = undef if $@ || !($ip6 =~ s/^\[?($IPv6Re)\]?$/$1/o);
            mlog(0,"info: resolved IPv6 $ip6 for hostname $dest") if $ip6 && $ConnectionLog >= 2;
        }
        if (! $ip6) {
            eval{$ip4 = inet_ntoa( scalar( gethostbyname($dest) ) );};
            $ip4 = undef if ($ip4 !~ /^$IPv4Re$/o);
            mlog(0,"info: resolved IPv4 $ip4 for hostname $dest") if $ip4 && $ConnectionLog >= 2;
        }
    } else {
        $ip6 = $1 if $ip =~/^\[?($IPv6Re)\]?$/o;
        $ip4 = $1 if ! $ip6 && $ip =~/^($IPv4Re)$/o;
    }
    if ($ip6) {
        $Domain{Domain} = AF_INET6;
    } elsif ($ip4) {
        $Domain{Domain} = AF_INET;
    } else {
        $Domain{Domain} = AF_UNSPEC;
        mlog(0,"error: found unresolvable ($dest) - hostname or suspicious IP address definition in $orgdest");
    }
    return %Domain;
}

sub newListen {
    my($port,$handler,$threadhandler)=@_;
    my @s;
    my @sinfo;
    return \@s,\@sinfo if($DisableSMTPNetworking and $handler eq \&ConToThread);
    foreach my $portA (split(/\|/o, $port)) {
        if($portA !~ /$HostRe?:?$PortRe/o) {
            mlog(0,"wrong (host) + port definition in '$portA' -- entry will be ignored !");
            next;
        }
        my @stt;
        my ($interface,$p)=$portA=~/($HostRe):($PortRe)/o;

        my %parms = $interface
                    ? ('LocalPort' => $p, 'LocalAddr' => $interface)
                    : ('LocalPort' => $portA);
        $parms{Listen} = 10;
        $parms{Reuse} = 1;
        
        if ($CanUseIOSocketINET6) {
            my $isv4 = [&getDestSockDom($interface)]->[1] != AF_INET6;
            my ($s4,$s6);
            if (! $interface || $isv4) {
                $parms{Domain} = AF_INET;
                $s4 = IO::Socket::INET6->new(%parms);
                push @stt,$s4 if $s4;
            }
            if (! $interface || ! $isv4) {
                $parms{Domain} = AF_INET6;
                $s6 = IO::Socket::INET6->new(%parms);
                push @stt,$s6 if $s6;
            }
        } else {
            my $s4 = IO::Socket::INET->new(%parms);
            push @stt,$s4 if $s4;
        }
        if(! @stt) {
            mlog(0,"error: couldn't create server socket on port '$portA' -- maybe another service is running or I'm not root (uid=$>)? -- or a wrong IP address is defined? -- $!");
            next;
        }
        foreach my $s (@stt) {
            $s->blocking(0);
            $SocketCalls{$s}=$handler;
            $ThreadHandler{$s} = $threadhandler if $threadhandler;    # tell thread what to do
            &dopoll($s,$readable,POLLIN);
            push @s,$s;
            push @sinfo,$s->sockhost . ':' . $s->sockport;
        }
    }
    return \@s,\@sinfo;
}

sub newListenSSL {
    my($port,$handler,$threadhandler)=@_;
    my @s;
    my @sinfo;
    return \@s,\@sinfo if($DisableSMTPNetworking and $handler eq \&ConToThread);
    foreach my $portA (split(/\|/o, $port)) {
        if($portA !~ /$HostRe?:?$PortRe/o) {
            mlog(0,"wrong (host) + port definition in '$portA' -- entry will be ignored !");
            next;
        }
        my @stt;
        my ($interface,$p)=$portA=~/($HostRe):($PortRe)/o;

        my %parms = getSSLParms(1);
        if ($interface) {
            $parms{LocalPort} = $p;
            $parms{LocalAddr} = $interface;
        } else {
            $parms{LocalPort} = $portA;
        }
        $parms{Listen} = 10;
        $parms{Reuse} = 1;
        $parms{SSL_startHandshake} = 1;

        if ($SSLDEBUG > 1) {
            while(my($k,$v)=each(%parms)) {
                print "ssl-new-listener: $k = $v\n";
            }
        }

        if ($CanUseIOSocketINET6) {
            my $isv4 = [&getDestSockDom($interface)]->[1] != AF_INET6;
            my ($s4,$s6);
            if (! $interface || $isv4) {
                $parms{Domain} = AF_INET;
                $s4 = IO::Socket::SSL->new(%parms);
                push @stt,$s4 if $s4;
            }
            if (! $interface || ! $isv4) {
                $parms{Domain} = AF_INET6;
                $s6 = IO::Socket::SSL->new(%parms);
                push @stt,$s6 if $s6;
            }
        } else {
            $parms{Domain} = AF_INET;
            my $s4 = IO::Socket::SSL->new(%parms);
            push @stt,$s4 if $s4;
        }

        if(! @stt) {
            mlog(0,"error: couldn't create server SSL-socket on port '$portA' -- maybe another service is running or I'm not root (uid=$>)? - or a wrong IP address is specified? -- $! - $IO::Socket::SSL::SSL_ERROR");
            next;
        }
        foreach my $s (@stt) {
            $SocketCalls{$s}=$handler;
            $ThreadHandler{$s} = $threadhandler if $threadhandler;    # tell thread what to do
            &dopoll($s,$readable,POLLIN);
            push @s,$s;
            push @sinfo,$s->sockhost . ':' . $s->sockport;
        }
    }
    $IO::Socket::SSL::DEBUG = $SSLDEBUG;
    return \@s,\@sinfo;
}

sub nixUsers {
  my ($uid,$gid); ($uid,$gid) = getUidGid($runAsUser,$runAsGroup) if ($runAsUser || $runAsGroup);
  if($ChangeRoot) {
    my $chroot;
    eval('$chroot=chroot($ChangeRoot)');
    if($@) {
      my $msg="request to change root to '$ChangeRoot' failed: $@";
      mlog(0,$msg);
      &downASSP($msg);
      exit(1);
    } elsif(! $chroot) {
      my $msg="request to change root to '$ChangeRoot' did not succeed: $!";
      mlog(0,$msg);
      &downASSP($msg);
      exit(1);
    } else {
      $chroot=$ChangeRoot; $chroot=~s/(\W)/\\$1/go;
      $base=~s/^$chroot//io;
      chdir("/");
      mlog(0,"successfully changed root to '$ChangeRoot' -- new base is '$base'");
    }
  }

  switchUsers($uid,$gid) if ($runAsUser || $runAsGroup);
}

sub getUidGid { my ($uname,$gname)=@_;
  return if $AsAService;
  my $rname="root";
  eval('getgrnam($rname);getpwnam($rname);');
  if($@) {
# windows pukes "unimplemented" for these -- just skip it
    mlog(0,"warning: uname and/or gname are set ($uname,$gname) but getgrnam / getpwnam give errors: $@");
    return;
  }
  my $gid;
  if($gname) {
    $gid = getgrnam($gname);
    if(defined $gid) {
    } else {
      my $msg="could not find gid for group '$gname' -- not switching effective gid -- quitting";
      mlog(0,$msg);
      &downASSP($msg);
      exit(1);
    }
  }
  my $uid;
  if($uname) {
    $uid = getpwnam($uname);
    if(defined $uid) {
    } else {
      my $msg="could not find uid for user '$uname' -- not switching effective uid -- quitting";
      mlog(0,$msg);
      &downASSP($msg);
      exit(1);
    }
  }
  ($uid,$gid);
}

sub switchUsers { my ($uid,$gid)=@_;
  return if $AsAService;
  my($uname,$gname)=($runAsUser,$runAsGroup);
  $>=0;
  if($> != 0) {
    my $msg="requested to switch to user/group '$uname/$gname' but cannot set effective uid to 0 -- quitting; uid is $>";
    mlog(0,$msg);
    &downASSP($msg);
    exit(1);
  }
  $<=0;
  if($gid) {
    $)=$gid;
    if($)+0==$gid) {
      mlog(0,"switched effective gid to $gid ($gname)");
    } else {
      my $msg="failed to switch effective gid to $gid ($gname) -- effective gid=$) -- quitting";
      mlog(0,$msg);
      &downASSP($msg);
      exit(1);
    }
    $(=$gid;
    if($(+0==$gid) {
      mlog(0,"switched real gid to $gid ($gname)");
    } else {
      mlog(0,"failed to switch real gid to $gid ($gname) -- real uid=$(");
    }
  }
  if($uid) {
# do it both ways so linux and bsd are happy
   $< = $> = $uid;
    if($>==$uid) {
      mlog(0,"switched effective uid to $uid ($uname)");
      $switchedUser = 1;
    } else {
      my $msg="failed to switch effective uid to $uid ($uname) -- real uid=$< -- quitting";
      mlog(0,$msg);
      &downASSP($msg);
      exit(1);
    }
    if($<==$uid) {
      mlog(0,"switched real uid to $uid ($uname)");
      $switchedUser = 1;
    } else {
      mlog(0,"failed to switch real uid to $uid ($uname) -- real uid=$<");
    }
  }
}

sub pollerror {
    my $action = shift;
    
    my $what = $action eq $readable ? 'read' : 'write';
    
    my %calls = (
        \&ConToThread       => 'ConToThread',
        \&NewWebConnection  => 'NewWebConnection',
        \&NewStatConnection => 'NewStatConnection',
        \&WebTraffic        => 'WebTraffic',
        \&StatTraffic       => 'StatTraffic',
        \&ProxyTraffic      => 'ProxyTraffic',
        \&SMTPTraffic       => 'SMTPTraffic'
    );
    my @errfh;
    my @nvalfh;

    if ($IOEngineRun == 0) {
        @errfh = $action->handles(POLLERR);
        @nvalfh = $action->handles(POLLNVAL);
    } else {
        @errfh = $action->has_exception($pollwait);
    }

    my $numerr = scalar(@errfh);
    my $numnval = scalar(@nvalfh);
    return $numerr + $numnval unless $numerr + $numnval;
    mlog(0,"error: IO-subsystem error - $numerr error state $what handles") if (($numerr && $ConnectionLog == 3) || $debug || $ThreadDebug);
    mlog(0,"error: IO-subsystem error - $numnval wrong $what handles") if (($numnval && $ConnectionLog == 3) || $debug || $ThreadDebug);
    my %ErrorFH = ();
    foreach my $fh (@errfh) {
        $ErrorFH{$fh} = ' - error state';
    }
    foreach my $fh (@nvalfh) {
        $ErrorFH{$fh} .= ' - invalid filedescriptor';
        push @errfh,$fh;
    }
    foreach my $fh (@errfh) {
        my $fhcon;
        my $peercon;
        my $fno;
        my $ip;
        eval{$fhcon = $fh->sockhost().":".$fh->sockport();};
        $fhcon = 'n/a' unless $fhcon;
        eval{$ip = $fh->peerhost();$peercon = $ip.":".$fh->peerport();};
        $peercon = 'n/a' unless $peercon;
        my $calltarget = $calls{$SocketCalls{$fh}};
        eval{$fno = fileno($fh);};
        mlog(0,"error: registered fd for $fh is not equal$ErrorFH{$fh}") if ($ConnectionLog == 3 && $fno && $Fileno{$fno} && $Fileno{$fno} ne $fh);
        mlog(0,"error: IO-handle : $fh;  fileno : $fno; call : $calltarget; localIP : $fhcon; peerIP : $peercon;$ErrorFH{$fh}; - will remove handle") if $ConnectionLog == 3;
        done($fh) if $CloseHandleOnPollError;
    }
    return $numerr + $numnval;
}

sub MainLoop {
  my $maxwait = shift;
  my $entrytime = Time::HiRes::time();
  my $hourend = time % 1800;
  mlog(0,'') if (( time - $lastMlog ) > 110 || $hourend < 15 || $hourend > 3585);
  mlog(0,'***assp&is%alive$$$') if ((time - $lastmlogWrite) > 120);
  &ThreadMonitorMainLoop('MainLoop start');
  &ConDone();
  my @canread;
  &getChangedConfigValue() if @changedConfig;
  &tellThreadsReReadConfig() if ($ConfigChanged);
  &mlogWrite();
  if ($maxwait && $syncToDo) {
      my $hassync;
      &ThreadMonitorMainLoop('Doing Config Sync');
      foreach ( sort { &syncSortCFGRec() } Glob("$base/configSync/*.cfg")) {
          next if -d $_;
          &syncConfigReceived($_);
          unlink($_) if -e "$_";
          &syncWriteConfig();
          $hassync = 1;
          last;
      }
      $syncToDo = $hassync;
      &mlogWrite();
  }
  my $stime=Time::HiRes::time(); # loop cycle start time
  if ($maxwait && $ThreadsDoStatus && $stime - $lastThreadsDoStatus > 5) {
      d('stop Status collection');
      $ThreadsDoStatus = 0;
      mlog(0,"info: stop Threads collecting status information") if($MaintenanceLog);
      &ThreadYield();
      %ConFno = ();
      undef %ConFno;
  }
  if ($maxwait && $process_external_cmdqueue && time % 5 == 0 && (open my $cmdq, '<',"$base/cmdqueue")) {
      &ThreadMonitorMainLoop('processing external command queue');
      while (my $line = (<$cmdq>)) {
          next if ($line =~ /^\s*[#;]/o);
          my ($sub,$parm) = parseEval($line);
          next unless $sub;
          mlog(0,"info: executing command '$line' from $base/cmdqueue");
          if ($sub eq 'RunEval' or $sub eq '&RunEval' or $sub eq \&RunEval or $sub eq &RunEval) {
              &RunEval($parm);
          } else {
              $sub =~ s/^\&//o;
              eval{$sub->(split(/\,/o,$parm));};
          }
          mlog(0,"error executing command '$line' from $base/cmdqueue - $@") if $@;
          &mlogWrite();
      }
      close $cmdq;
      unlink "$base/cmdqueue";
  }
  if ($maxwait && $SNMPagent) {
      d('check SNMPagent');
      my $maxSNMPtime = Time::HiRes::time() + 2;  # max two seconds for SNMP request processing
      my $res = $SNMPagent->agent_check_and_process(0);
      my $gotRequest = $res;
      while ( $res && (Time::HiRes::time() < $maxSNMPtime) ) {
         $lastSNMPrequest = time;
         $res = $SNMPagent->agent_check_and_process(0);
      }
      if (time - $lastSNMPrequest < 15) {
          $MainThreadLoopWait = $gotRequest ? 0 : 0.25;
      }
      &mlogWrite() if $gotRequest;
  }
  &ThreadMonitorMainLoop('MainLoop start poll Sockets');
  $stime=Time::HiRes::time(); # poll-loop cycle start time
  if ($IOEngineRun == 0) {
      my $re;
      if ($readable->handles()) {
          $re = $readable->poll( min($MainThreadLoopWait,$maxwait) + $MinPollTimeT/1000);   # wait at least two milliseconds
          @canread = $readable->handles(POLLIN|POLLHUP);
          if ($re < 0) {
              &pollerror($readable);
          }
      }
  } else {
    my $wait = int( min($MainThreadLoopWait,$maxwait) + $MinPollTimeT/1000);
    $wait = $maxwait unless $wait;
    @canread = $readable->can_read( $wait );
  }
  my $itime = Time::HiRes::time(); # loop cycle idle end time
  $ThreadIdleTime{$WorkerNumber} += $itime - $stime;
  return ($itime - $entrytime) if (! $maxwait && ! @canread);

  &ThreadMonitorMainLoop('MainLoop polled Sockets');
  my $ptime = $itime - $stime;
  mlog(0,"warning: the operating system socket poll cycle has taken $ptime seconds - this is very much is too long")
      if ($ConnectionLog >= 2 and $ptime > 3);
  $nextLoop2=$itime+0.3; # global var
  &mlogWrite();
  &ThreadYield() unless @canread;
  while (@canread) {
    my $fh = shift @canread;
    if ($fh && $SocketCalls{$fh}) {
      if ($SocketCalls{$fh}==\&WebTraffic || $SocketCalls{$fh}==\&NewWebConnection || $SocketCalls{$fh}==\&NewStatConnection || $SocketCalls{$fh}==\&StatTraffic) {
        next if exists $MainLoopInWebFH{$fh};
        $MainLoopInWebFH{$fh} = 1;
        $SocketCalls{$fh}->($fh) if (! exists $ConDelete{$fh});
        delete $MainLoopInWebFH{$fh};
      } else {
        unless ($shuttingDown || $allIdle) {
            mlog(0,"info: $WorkerName got connection request") if ($WorkerLog);
            $SocketCalls{$fh}->($fh);
        }
      }
      &mlogWrite();
    } else {
        next if (! $SocketCalls{$fh} && $errorFH);
        mlog(0,"Warning: $WorkerName found socket without SocketCalls - please report!");
        eval{
          delete $SocketCalls{$fh} if (exists $SocketCalls{$fh});
          delete $Con{$fh} if (exists $Con{$fh});
          delete $WebCon{$fh} if (exists $WebCon{$fh});
          unpoll($fh,$readable);
          unpoll($fh,$writable);
          delete $ConDelete{$fh} if (exists $ConDelete{$fh});
          eval{close($fh)} if (fileno($fh));
        };
        &mlogWrite();
    }
  }
  $errorFH = 0;
  &ThreadMonitorMainLoop('MainLoop read from sockets');
  d('mainloop before servicecheck');
  serviceCheck(); # for win32 services
  &ThreadMonitorMainLoop('MainLoop service check');

  &SMTPSessionLimitCheck();
  &ThreadMonitorMainLoop('MainLoop session limit check');
  &mlogWrite();

# database connection check is done independend from any time values
# the complete check for all tables should never take more than 0.05 seconds if all is ok
  if (($CanUseTieRDBM or $CanUseBerkeleyDB) && $DBisUsed && $itime >= $nextDBcheck) { # check - do we have lost any DB connection
                                  # and reconnect if possible
      my $cdbstime=Time::HiRes::time(); # to get the check time
      my $cdberror=&checkDBCon(int($itime)+$ThreadsWakeUpInterval + 2); # check every 120 seconds   # or switch to files
      my $cdbetime= sprintf("%.3f",(Time::HiRes::time()) - $cdbstime); # to get the check time
      d("info: database connection was checked in $cdbetime seconds");
      mlog(0,"warning: $WorkerName - check the database connections has taken $cdbetime seconds (max=1.000s)") if ($cdbetime>1 && ! $cdberror); #0.1s is ok
      &ThreadMonitorMainLoop('MainLoop database check');
      my $mem = $showMEM ? printMem() : 0;
      mlog(0,"info: worker memory$mem") if $mem && $MaintenanceLog > 2;
  }

  &ThreadYield();

  if ($itime >= $nextThreadsWakeUp) {   # wakeup all threads every some sec
     &ThreadsWakeUp();
     $nextThreadsWakeUp = int($itime)+$ThreadsWakeUpCheck;
     &ThreadMonitorMainLoop('MainLoop wakeup threads');
  }

  d('mainloop before restart check');

  if($RestartEvery && $itime >= $endtime) {
# time to quit -- after endtime and we're bored.
        mlog(0,"info: restart time is reached - waiting until all connection are gone but max 5 minutes");
        while ($smtpConcurrentSessions && time < $endtime + 300) {
            my $tendtime = $endtime;
            $endtime = time + 10000;
            &MainLoop2();
            $endtime = $tendtime;
            Time::HiRes::sleep(0.5);
            $ThreadIdleTime{$WorkerNumber} += 0.5;
        }
        &downASSP("restarting");
        _assp_try_restart;
  }

  &ThreadMonitorMainLoop('Mainloop after restart check');

  if ($doShutdown > 0 && $itime >= $doShutdown) {
    &downASSP("restarting");
    _assp_try_restart;
  }
  &ConDone();

  if ($allIdle > 0 && ! $Config{DisableSMTPNetworking}) {
      configUpdateSMTPNet('DisableSMTPNetworking',$Config{DisableSMTPNetworking},'2','');
      $ConfigChanged = 1;
  } elsif ($allIdle < 0 && $Config{DisableSMTPNetworking}) {
      configUpdateSMTPNet('DisableSMTPNetworking',$Config{DisableSMTPNetworking},'0','');
      $ConfigChanged = 1;
      $allIdle = 0;
  }

  if (time > $nextdetectGhostCon) {
      &detectWebGhostCon();
      &detectGhostCon();
      $nextdetectGhostCon = time + 300;
  }
  foreach my $fh (keys %repollFH) {
      if ($repollFH{$fh} < time) {
          dopoll($fh,$readable,POLLIN);
          dopoll($fh,$writable,POLLOUT);
          delete $repollFH{$fh};
      }
  }
  &mlogWrite();
  undef %Con unless keys(%Con);
  undef %ConDelete unless keys(%ConDelete);
  undef %SocketCalls unless keys(%SocketCalls);
  undef %repollFH unless keys(%repollFH);
  undef %WebConH unless keys(%WebConH);
  undef %MainLoopInWebFH unless keys(%MainLoopInWebFH);
  undef %StatConH unless keys(%StatConH);
  undef %MainLoopInWebFH unless keys(%MainLoopInWebFH);
  return (Time::HiRes::time() - $entrytime);
}

# called in long running GUI tasks to keep new connection handling
sub MainLoop1 {
    my $wait = shift;
    return 0 if ($shuttingDown);
    my $AWS = $ActWebSess;
    my %QS = %qs;
    $wait = &MainLoop($wait);
    $ActWebSess = $AWS;
    %qs = %QS;
    return $wait;
}

# called during long operations to keep the GUI running
# alternates (0.3s/0.3s) between SMTP connections handling and the calling task
sub MainLoop2 {
  &mlogWrite();
#  &ThreadMonitorMainLoop('MainLoop2 start');
  return if $isRunMainLoop2;
  $isRunMainLoop2 = 1;
  mlog(0,'***assp&is%alive$$$') if ((time - $lastmlogWrite) > 120);
  my @canread;
  my $wait;
  my $time=Time::HiRes::time();
  if ($time >= $nextLoop2) {
    if ($SNMPagent) {
        my $res = $SNMPagent->agent_check_and_process(0);
        my $gotRequest = $res;
        while ($res) {
           $lastSNMPrequest = time;
           $res = $SNMPagent->agent_check_and_process(0);
        }
        if (time - $lastSNMPrequest < 15) {
            $MainThreadLoopWait = $gotRequest ? 0 : 0.25;
        }
    }
    serviceCheck() unless $ServiceStopping; # for win32 services
#    &ThreadMonitorMainLoop('MainLoop2 service check');
    do {
      my $stime=Time::HiRes::time(); # poll-loop cycle start time
      if ($IOEngineRun == 0) {
           my $re;
           if ($readable->handles()) {
               $re = $readable->poll($MainThreadLoopWait + $MinPollTimeT/1000);   # wait at least two milliseconds
               @canread = $readable->handles(POLLIN|POLLHUP);
               if ($re < 0) {
                   &pollerror($readable);
               }
           }
      } else {
         my $wait = int($MainThreadLoopWait + $MinPollTimeT/1000);
         $wait = 1 unless $wait;
         @canread = $readable->can_read( $wait );
      }

      my $itime=Time::HiRes::time(); # loop cycle idle end time
#      &ThreadMonitorMainLoop('MainLoop polled Sockets');
      my $ptime = $itime - $stime;
      $ThreadIdleTime{$WorkerNumber} += $ptime;
      mlog(0,"warning: poll cycle (2) has taken $ptime seconds - this is very much is too long")
          if ($ConnectionLog >= 2 and $ptime > 3);

#      &ThreadMonitorMainLoop('MainLoop2 poll Sockets');
      while (@canread) {
        my $fh = shift @canread;
        if ($fh && ($SocketCalls{$fh}==\&WebTraffic || $SocketCalls{$fh}==\&NewWebConnection || $SocketCalls{$fh}==\&NewStatConnection || $SocketCalls{$fh}==\&StatTraffic)) {
          next if exists $MainLoopInWebFH{$fh};
          $MainLoopInWebFH{$fh} = 1;
          $SocketCalls{$fh}->($fh) if (! exists $ConDelete{$fh});
          delete $MainLoopInWebFH{$fh};
        }
      }
#      &ThreadMonitorMainLoop('MainLoop2 read from socket');

      $time=Time::HiRes::time();
    } until (@canread==0 || $time >= $nextLoop2);
    $nextLoop2=Time::HiRes::time()+0.3; # 0.3s for other tasks

    if($RestartEvery && $itime >= $endtime) {
# time to quit -- after endtime and we're bored.
        &downASSP("restarting");
        _assp_try_restart;
    }

    if ($doShutdown > 0 && $itime >= $doShutdown) {
      &downASSP("restarting");
      _assp_try_restart;
    }
  }
  $isRunMainLoop2 = 0;
}

sub detectGhostCon {
    return unless $FreeupMemoryGarbage;
    my $count = 0;
    my $mem = 0;
    my $what;
    while ( my ($fh,$dummy) = each %Con) {
        next if $fh && exists $WebConH{$fh};
        next if $fh && exists $StatConH{$fh};
        next if $fh && exists $repollFH{$fh};
        if  (! $fh) {
           mlog(0,"error: detected unexpected garbage in the memory - please report to development") if $fh eq '0';
           delete $ConDelete{$fh};
           delete $SocketCalls{$fh};
           while (my ($k,$v) = each %{$Con{$fh}}) {
                if (ref($v) eq 'ARRAY') {
                    $v .= " @{$v}";
                } elsif (ref($v) eq 'HASH') {
                    while (my ($k1,$v1) = each %{$v}) {
                        $v .= " , '$k1,$v1'";
                    }
                }
                eval{$mem += length($v) + 8;};
                mlog(0,"info: memory garbage in : fh=$fh , key=$k , value=$v") if $MaintenanceLog > 2;
           }
           &printallCon($fh) if ($MaintenanceLog >= 2);
           $count++;
           delete $Con{$fh};
           delete $WebConH{$fh};
           delete $StatConH{$fh};
           next;
        }
        next if (fileno($Con{$fh}->{self}));
        next if $IOEngineRun == 0 && $readable->[3]{$fh};
        next if $IOEngineRun == 0 && $writable->[3]{$fh};
        next if (exists $ConDelete{$fh});
        next if ($Con{$fh}->{timestart} + 3600 > time);
        while (my ($k,$v) = each %{$Con{$fh}}) {
            if (ref($v) eq 'ARRAY') {
                $v .= " @{$v}";
            } elsif (ref($v) eq 'HASH') {
                while (my ($k1,$v1) = each %{$v}) {
                    $v .= " , '$k1,$v1'";
                }
            }
            eval{$mem += length($v) + 8;};
            mlog(0,"info: memory garbage in : fh=$fh , key=$k , value=$v") if $MaintenanceLog > 2;
        }
        $count++;
        &printallCon($fh) if ($MaintenanceLog >= 2);
        if ($WorkerNumber > 0) {
            &done2($fh);      # MainThread (Worker_0) never closes SMTP sockets here
            $what = 'SMTP';
        } else {
            unpoll($fh,$readable);
            unpoll($fh,$writable);
            delete $Con{$fh};
            delete $ConDelete{$fh};
            delete $SocketCalls{$fh};
            $what = 'SMTP and WEB';
        }
    }
    undef %Con unless keys(%Con);
    undef %ConDelete unless keys(%ConDelete);
    undef %SocketCalls unless keys(%SocketCalls);
    undef %repollFH unless keys(%repollFH);
    undef %WebConH unless keys(%WebConH);
    undef %MainLoopInWebFH unless keys(%MainLoopInWebFH);
    undef %StatConH unless keys(%StatConH);
    $mem = int(($count*128 + $mem)/1024 + 2);
    mlog(0,"info: cleaned $mem kbyte of memory from $count closed $what connections") if ($count && ($MaintenanceLog >= 2 or $ConnectionLog >= 2));
}

sub detectWebGhostCon {
    return unless $FreeupMemoryGarbage;
    my $count = 0;
    my $mem = 0;
    my %tCon = ();

    while ( my ($fh,$v) = each %WebConH) {
        $tCon{$fh} = $v;
    }
    while ( my ($fh,$v) = each %StatConH) {
        $tCon{$fh} = $v;
    }

    while ( my ($fh,$v) = each %tCon) {
        if  (! $fh) {
           eval{$mem += length($WebCon{$fh}) + 8;};
           eval{$mem += length($StatCon{$fh}) + 8;};
           $count++;
           delete $WebCon{$fh};
           delete $StatCon{$fh};
           delete $SocketCalls{$fh} if (exists $SocketCalls{$fh});
           mlog(0,"info: found \$fh == '$fh' in closed web connections") if $MaintenanceLog >= 2;
           next;
        }
        $fh = $WebConH{$fh} if $WebConH{$fh};
        $fh = $StatConH{$fh} if $StatConH{$fh};
        next if (fileno($fh));
        next if (exists $ConDelete{$fh});
        eval{$mem += length($WebCon{$fh}) + 8;};
        eval{$mem += length($StatCon{$fh}) + 8;};
        $count++;
        &WebDone($fh);
        delete $WebCon{$fh};
        delete $StatCon{$fh};
        delete $WebConH{$fh};
        delete $StatConH{$fh};
        delete $Con{$fh};
        delete $SocketCalls{$fh} if (exists $SocketCalls{$fh});
    }
    undef %Con unless keys(%Con);
    undef %ConDelete unless keys(%ConDelete);
    undef %SocketCalls unless keys(%SocketCalls);
    undef %repollFH unless keys(%repollFH);
    undef %WebConH unless keys(%WebConH);
    undef %MainLoopInWebFH unless keys(%MainLoopInWebFH);
    undef %StatConH unless keys(%StatConH);
    undef %WebIP unless keys(%WebIP);
    $mem = int(($count*128 + $mem)/1024 + 2);
    mlog(0,"info: cleaned $mem kbyte of memory from $count closed web connections") if $count && $MaintenanceLog >= 2;
}


sub SaveHash {
  my $HashName = shift;
  d("SaveHash - $HashName");
  &ThreadMaintMain2() if $WorkerNumber == 10000;
  my $filename;
  foreach my $dbGroup (@GroupList) {
      foreach my $dbGroupEntry (@$dbGroup) {
        my ($KeyName,$dbConfig,$CacheObject,$realFileName,$mysqlFileName,$FailoverValue,$mysqlTable) = split(/,/o,$dbGroupEntry);
        if ($KeyName eq $HashName){
            if (!(($CanUseTieRDBM or $CanUseBerkeleyDB) && ${$dbConfig} =~ /DB:/o)) {
               return  if (! ${$dbConfig});
               my $tempFile = "$base/$realFileName.tmp";
               my $bakfile = "$base/$realFileName.bak";
               $realFileName = "$base/$realFileName";
               $filename = $realFileName;
               $tempFile =~ s/\\/\//go;
               $bakfile =~ s/\\/\//go;
               $realFileName =~ s/\\/\//go;
               my $HASH;
               unless (open($HASH, '>',"$tempFile")) {
                   mlog(0,"error: unable to open $tempFile for writing - $!");
                   return;
               }
               binmode $HASH;
               print $HASH "\n";
               my $count = 0;
               my @h;
               {
                   lock(%$HashName) if is_shared(%$HashName) && $WorkerName ne 'Shutdown';
                   @h = sort keys %$HashName;
               }
               while (@h) {
                  (my $k = shift @h) or next;
                  my $v = ${$HashName}{$k};
                  print $HASH "$k\002$v\n";
                  $count++;
               }
               close $HASH;
               $! = undef;
               if (-e "$bakfile") {
                   unlink($bakfile);
                   if ($!) {
                       mlog(0,"error: unable to delete file $bakfile - $!");
                       return;
                   }
               }
               $! =undef;
               rename("$realFileName", "$bakfile") if (-e "$realFileName");
               if ($! && -e "$realFileName") {
                   mlog(0,"error: unable to rename file $realFileName to $bakfile - $!");
                   return;
               }
               $! = undef;
               rename("$tempFile", "$realFileName");
               if ($! && -e "$tempFile") {
                   mlog(0,"error: unable to rename file $tempFile to $realFileName - $!");
                   rename("$bakfile", "$realFileName");
                   mlog(0,"error: unable to rename file $bakfile to $realFileName - $!") if $!;
                   return;
               }
               mlog(0,"Info: $count records of $KeyName saved") if $MaintenanceLog;
               $FileHashUpdateTime{"$filename"} = ftime($realFileName);
               $FileHashUpdateHash{"$filename"} = $HashName;
            }
        }
      }
  }
  mlogWrite() if $WorkerNumber == 0;
}

sub LoadHash {
   my ($hash,$file,$ignorefile) = @_;
   my $LH;
   my @s = $stat->($file);
   my $size = $s[7];
   my $keys = $file =~ /black/io ? int($size * 2 / 80) + 128 : int($size * 2 / 26) + 128;
   my $count = 0;
   lock(%$hash) if is_shared(%$hash);
   unless (open($LH, '<',"$file")) {
       mlog(0,"warning: unable to open $file to load $hash");
       return;
   }
   binmode($LH);
   %$hash = ();
   keys (%$hash) = $keys;      # preallocate Memory for Hash
   while (<$LH>) {
     my ($k,$v) = split/\002/o;
     chomp $v;
     $v =~ s/\r|\n//go;
     if ($k && $v) {
       ${$hash}{$k}=$v;
       $count++;
     }
   }
   close $LH;
   mlog(0,"info: $hash loaded from $file with $count records") if $MaintenanceLog;
   if ($count > 1000) {
       foreach my $dbGroup (@GroupList) {
           foreach my $dbGroupEntry (@$dbGroup) {
               my ($KeyName,$dbConfig,$CacheObject,$realFileName,$mysqlFileName,$FailoverValue,$mysqlTable) = split(/,/o,$dbGroupEntry);
               next if $KeyName ne $hash;
               if ($count < 2000) {
                   mlog(0,"warning: $hash contains $count records - it is recommended to use a database for '$dbConfig' to prevent memory leaking") if (! $EnableHighPerformance || $EnableHighPerformance > 500);
               } else {
                   my $i = $count * 2;
                   my $exp = 7;
                   while ($i >= 2) {
                       $i = int($i / 2);
                       $exp++;
                   }
                   $i = 2 ** $exp + $count * 4 + ($size * ($NumComWorkers + 3));
                   mlog(0,"error: $hash contains $count records (allocating apx. " . &formatDataSize($i,1) . " shared memory) - it is highly recommended to use a database for '$dbConfig' to reduce memory usage and to prevent memory leaking") if (! $EnableHighPerformance || $EnableHighPerformance > 500);
               }
           }
       }
   }
   return if ($ignorefile);

   my $mtime=$s[9];
   $FileHashUpdateTime{"$file"} = $mtime;
   $FileHashUpdateHash{"$file"} = $hash;
}

sub getDBCount {
  my ($hash,$config) = @_;
  my $hashObject = $hash.'Object';
  my $i = 0;
  if ($hash eq 'HMMdb' && $runHMMusesBDB) {
      $i = BDB_getRecordCount($hash);
  } elsif ($DBusedDriver eq 'BerkeleyDB' && $CanUseBerkeleyDB && ${$config} =~ /DB:/o) {
      $i = BDB_getRecordCount($hash);
  } elsif (${$config} =~ /DB:/o) {
      $i = rdbm_COUNT(${$hashObject});
      if (! $i) {
          while (my ($k,$v) = each %{$hash}) {
              last if ++$i > 600;
          }
          if ($i) {
              my $table;
              eval {$table = ${$hashObject}->{table};};
              $table ||= 'N/A';
              mlog(0,"error: SQL -> 'SELECT COUNT(*) FROM $table' returned a zero count of records for '$hash', but there are at least $i records in table '$table' - check your database engine!");
          }
      }
  } else {
      $i = scalar keys %{$hash};
  }
  return $i;
}

sub SaveDelaydb {
  if ($delaydb !~ /DB:/o) {
    mlog(0,"saving delaying records") if $MaintenanceLog;
    &SaveHash('Delay');
    &SaveHash('DelayWhite');
  }
}

sub SaveLDAPlist {
  if ($ldaplistdb !~ /DB:/o) {
    mlog(0,"saving ldaplist") if $MaintenanceLog;
    &SaveHash('LDAPlist');
  }
}


sub SaveWhitelist {
 d('SaveWhitelist');
  &SaveWhitelistOnly();
  &SaveDelaydb();
  &SaveLDAPlist();
}

sub SaveWhitelistOnly {
 d('SaveWhitelistOnly');
 if ($UpdateWhitelist && $whitelistdb !~ /DB:/o) {
    mlog(0,"saving whitelist") if $MaintenanceLog;
    &SaveHash('Whitelist');
  }
  if ($UpdateWhitelist && $redlistdb !~ /DB:/o) {
    mlog(0,"saving redlist") if $MaintenanceLog;
    &SaveHash('Redlist');
  }
}

sub SavePB {
# save Penalty Box Databases
  if ($pbdb !~ /DB:/o) {
    mlog(0,"saving penalty records") if $MaintenanceLog;
    &SaveHash('PBBlack');
    &SaveHash('PBWhite');
    &SaveHash('PBTrap');
    mlog(0,"saving cache records") if $MaintenanceLog;
    &SaveHash('RBLCache');
    &SaveHash('URIBLCache');
    &SaveHash('SPFCache');
    &SaveHash('PTRCache');
    &SaveHash('MXACache');
    &SaveHash('SBCache');
    &SaveHash('RWLCache');
    &SaveHash('DKIMCache');
    &SaveHash('BATVTag');
    &SaveHash('BackDNS');
    mlog(0,"saving personal Black records") if $MaintenanceLog;
    &SaveHash('PersBlack');
  }
}

sub CleanPB {
# clean Penalty Box Databases
  &SavePB if (!$mysqlSlaveMode || $pbdb!~/DB:/o);
  mlog(0,"cleaning penalty records...") if $MaintenanceLog;
  &cleanBlackPB if $DoPenalty && $PBBlackObject;
  &cleanWhitePB if $PBWhiteObject;
  &cleanTrapPB if $PBTrapObject;
}

sub CleanCache {
  mlog(0,"cleaning cache records...") if $MaintenanceLog;
  &cleanCacheRBL() if $RBLCacheExp && $ValidateRBL;
  &cleanCacheURI() if $URIBLCacheInterval && $ValidateURIBL;
  &cleanCacheRWL() if $RWLCacheInterval && $ValidateRWL;
  &cleanCachePTR() if $PTRCacheInterval && $DoReversed;
  &cleanCacheMXA() if $DoDomainCheck && $MXACacheInterval;
  &cleanCacheSPF() if $ValidateSPF && $SPFCacheInterval;
  &cleanCacheDKIM() if $DoDKIM && $DKIMCacheInterval;
  &cleanCacheSB()  if $SBCacheExp;
  &cleanCacheBackDNS() if $BackDNSInterval;
  &cleanCachePersBlack();
}

sub CleanDelayDB {
  d('CleanDelayDB');
  &ThreadMaintMain2() if $WorkerNumber == 10000;
  mlog(0,"cleaning up delaying databases ...") if $MaintenanceLog;
  my $t=time;
  my $keys_before=my$keys_deleted=0;
  my $maxtime = $DelayEmbargoTime*60+$DelayWaitTime*3600;
  while (my ($k,$v)=each(%Delay)) {
    &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $keys_before % 100;
    $keys_before++;
    if ($t-$v>=$maxtime) {
      delete $Delay{$k};
      $keys_deleted++;
    }
  }
  mlog(0,"cleaning delaying database (triplets) finished: keys before=$keys_before, deleted=$keys_deleted") if $MaintenanceLog && $keys_before != 0;
  $keys_before=$keys_deleted=0;
  $maxtime = $DelayExpiryTime*24*3600;
  while (my ($k,$v)=each(%DelayWhite)) {
    $keys_before++;
    if ($t-$v>=$maxtime) {
      delete $DelayWhite{$k};
      $keys_deleted++;
    }
  }
  mlog(0,"cleaning delaying database (safelisted tuplets) finished: keys before=$keys_before, deleted=$keys_deleted") if $MaintenanceLog && $keys_before != 0;
  &SaveDelaydb();
}

# global/domain and personal Whitelist handling
sub Whitelist {
    my($mf,$to,$action)=@_;
    d("Whitelist $mf,$to,$action");
    @WhitelistResult = ();
    $mf = batv_remove_tag(0,lc $mf,'') if $mf;
    $to = batv_remove_tag(0,lc $to,'') if $to;
    $to =~ s/^,//o;
    my $toDomain;
    $toDomain = $1 if $to =~ /(\@$EmailDomainRe)$/o;
    $to = undef if $to =~ /^\@$EmailDomainRe$/o;
    $action = lc $action;
    my $globWhite = $WhitelistPrivacyLevel&&defined${chr(ord(",")<< 1)}?($toDomain&&defined${chr(ord(",")<< 1)}?($WhitelistPrivacyLevel==2?undef:$Whitelist{"$mf,$toDomain"}):undef):$Whitelist{$mf};
    my $persWhite = $to?$Whitelist{"$mf,$to"}:undef;
    my $time = time;
    if (! $action) {                  # is there any Whitelist entry
        return 0 if $persWhite > 9999999999;       # a deleted personal
        return ($persWhite or $globWhite) ? 1 : 0;      # a personal or global
    } elsif ($action eq 'add') {
        if ($to) {$Whitelist{"$mf,$to"} = $time; push @WhitelistResult, "$mf,$to added to Whitelist<br />";};
        if ($toDomain) {$Whitelist{"$mf,$toDomain"} = $time ; push @WhitelistResult, "$mf,$toDomain added to Whitelist<br />";};
        $Whitelist{$mf} = $time;
        push @WhitelistResult, "$mf added to Whitelist<br />";
        return;
    } elsif ($action eq 'delete') {
        if ($to) {
            push @WhitelistResult, "$mf,$to removed from Whitelist<br />" if $Whitelist{"$mf,$to"} < 9999999999;
            $Whitelist{"$mf,$to"} = $time + 9999999999;  # delete the personal
        } elsif ($toDomain) {
            push @WhitelistResult, "$mf,$toDomain removed from Whitelist<br />" if delete $Whitelist{"$mf,$toDomain"};
            ThreadMonitorMainLoop("delete Whitelist $mf,\*$toDomain");
            if ($DoSQL_LIKE && "$WhitelistObject" =~ /Tie\:\:RDBM/o) {
#                $toDomain =~ s/([_%])/:$1/go;
#                $mf =~ s/([_%])/:$1/go;
#                my $res = $WhitelistObject->rdbm_RunSTM("WLRDOM",
#"DELETE FROM $WhitelistObject->{table} WHERE $WhitelistObject->{key} LIKE $mf,\%$toDomain ESCAPE ':' AND $WhitelistObject->{value} < '9999999999'");
#                $res ||= 'NO';
#                push @WhitelistResult, "$res privat records removed from Whitelist<br />"
                delete $Whitelist{"$mf,\*$toDomain"};
            } else {
                my $i;
                while (my ($k,$v) = each(%Whitelist)) {      # and not already removed personal
                    if ($k =~ /^\Q$mf\E,$EmailAdrRe\Q$toDomain\E$/) {
                        push @WhitelistResult, "k removed from Whitelist<br />" if delete $Whitelist{$k}; # $Whitelist{$k} < 9999999999 ???
                    }
                    unless (++$i % 1000) {
                        ThreadMonitorMainLoop("delete Whitelist $mf,\*$toDomain");
                        $WorkerLastAct{$WorkerNumber} = time if $WorkerNumber > 0 && $WorkerNumber < 10000;
                    }
                }
            }
        } else {
            push @WhitelistResult, "$mf removed from Whitelist<br />" if delete $Whitelist{$mf}; # delete the global entry;
            ThreadMonitorMainLoop("delete Whitelist $mf,*");
            if ($DoSQL_LIKE && "$WhitelistObject" =~ /Tie\:\:RDBM/o) {
#                $mf =~ s/([_%])/:$1/go;
#                my $res = $WhitelistObject->rdbm_RunSTM("WLRALL",
#"DELETE FROM $WhitelistObject->{table} WHERE $WhitelistObject->{key} LIKE $mf,\% ESCAPE ':' AND $WhitelistObject->{value} < '9999999999'");
#                $res ||= 'NO';
#                push @WhitelistResult, "$res privat records removed from Whitelist<br />"
                delete $Whitelist{"$mf,*"};
            } else {
                my $i;
                while (my ($k,$v) = each(%Whitelist)) {      # and not already removed personal
                    if ($k =~ /^\Q$mf\E,/) {
                        push @WhitelistResult, "$k removed from Whitelist<br />" if delete $Whitelist{$k}; # $Whitelist{$k} < 9999999999 ???
                    }
                    unless (++$i % 1000) {
                        ThreadMonitorMainLoop("delete Whitelist $mf,*");
                        $WorkerLastAct{$WorkerNumber} = time if $WorkerNumber > 0 && $WorkerNumber < 10000;
                    }
                }
            }
        }
    }
}

sub CleanWhitelist {
  d('CleanWhitelist');
  &ThreadMaintMain2() if $WorkerNumber == 10000;
  mlog(0,"cleaning up whitelist database ...") if $MaintenanceLog;
  my $t=time;
  my $keys_before = my $keys_deleted = 0;
  my $maxtime = $MaxWhitelistDays * 3600 * 24;
  if ($MaxWhitelistDays) {
      while (my ($k,$v)=each(%Whitelist)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $keys_before % 100;
        $keys_before++;
        $v = 0 unless $v;
        next if $v < 1000000000;
        my $delta = $t-$v;
        if ($delta >= $maxtime or ($k=~/,/o && $v > 9999999999 && $delta + 9999999999 >= $maxtime)) {
          delete $Whitelist{$k};
          $v -= 9999999999 if $v > 9999999999;
          mlog(0,"Admininfo: $k removed from whitelistdb - entry was outdated (" . &timestring($v,'') . ')') if $MaintenanceLog >= 2;
          $keys_deleted++;
        }
      }
      mlog(0,"cleaning whitelist database finished: keys before=$keys_before, deleted=$keys_deleted") if $keys_before && $MaintenanceLog;
  }
  &SaveWhitelistOnly();
}

# AZ: 2009-03-10 - win32 debug/trace output wrapper
# this function allows to to see the live log/trace using
# http://technet.microsoft.com/en-us/sysinternals/bb896647.aspx
sub w32dbg {
    OutputDebugString('(ASSP): ' . shift);
}

sub mlogRe{
	my($fh,$subre,$regextype,$check)=@_;
	my $this = exists $Con{$fh} ? $Con{$fh} : {};
	$subre =~ s/\s+/ /go;
	$subre=substr($subre,0,$RegExLength);
	$this->{messagereason}="Regex:$regextype '$subre'";
 	$this->{myheader}.="X-Assp-Re-$regextype: $subre\r\n" if $AddRegexHeader;
    my $m;
	$m = $check . ' ' if $check;
	$m .= $this->{messagereason};
	mlog( $fh, $m, 1, 1 ) if $regexLogging;
}

sub mlogWrite {
    return if $WorkerNumber;
    my @m;
    my $items;
    threads->yield();
    &debugWrite();
    threads->yield;
    $items = $mlogQueue->pending();
    $refreshWait = (time - $lastmlogWrite) > 5 ? 5 : 1;
    return if (! $items);
    threads->yield();
    @m = $mlogQueue->dequeue_nb($items);
    threads->yield();
    my @tosyslog;
    while (@m) {
       my $logline = my $line = de8(shift @m);
       if ($CanUseTextUnidecode && $Unidecode2Console) {
           eval{
               $line = eval{Text::Unidecode::unidecode(d8($line));};
           } or print "con uni-decoding error: $@";
       } else {
           eval{
               Encode::from_to($line,'UTF-8',$ConsoleCharset,sub { return '?'; })
                   if $ConsoleCharset && $ConsoleCharset !~ /utf-?8/oi;
               1;
           } or print "con encoding error: $@";
       }
       push @tosyslog,substr($line,length($LogDateFormat)) if ($sysLog && ($CanUseSyslog || ($sysLogPort && $sysLogIp)));
       if ($line !~ /\*\*\*assp\&is\%alive\$\$\$/o) {
           print $line unless ($silent);
           w32dbg($line) if ($CanUseWin32Debug);
           print $LOG $logline if ($logfile && $asspLog && fileno($LOG));
           print $LOGBR $logline if ($logfile &&
                                     $asspLog &&
                                     fileno($LOGBR) &&
                                     $ExtraBlockReportLog &&
                                     $logline =~ /\[\s*spam\sfound\s*\]/io);
       }
       if ($logline !~ /page:\/maillog|\*\*\*assp\&is\%alive\$\$\$/o) {
           shift @RealTimeLog if (@RealTimeLog > 33);
           push @RealTimeLog, $logline;
           $lastmlogWrite = time;
       }
    }
    tosyslog('info', \@tosyslog) if (@tosyslog && $sysLog && ($CanUseSyslog || ($sysLogPort && $sysLogIp)));
    $MainThreadLoopWait = 1;
}

sub debugWrite {
    my @m;
    my $items = $debugQueue->pending();
    if ((! $debugIP && ! $debugRe && ! $debugCode && ! $debug && $DEBUG && $DEBUG->opened) or ($lastDebugPrint && time - $lastDebugPrint > 600)) {
        mlog(0,'info: partial debug mode stopped');
        eval{$lastDebugPrint = 0; $DEBUG->close;};
    }
    return if (! $items);
    if (! $DEBUG || ! $DEBUG->opened) {
        my $file = "$base/debug/".time.".dbg";
        open($DEBUG, '>',"$file");
        binmode($DEBUG);
        $DEBUG->autoflush;
        print $DEBUG $UTF8BOM;
        print $DEBUG "running ASSP version: $main::MAINVERSION\n\n";
        mlog(0,"info: starting partial debug mode to file $file");
    }
    threads->yield();
    @m = $debugQueue->dequeue_nb($items);
    threads->yield();
    while (@m && $DEBUG) {
       print $DEBUG shift @m;
    }
    $lastDebugPrint = time unless ($debug);
}

sub mlog_i {
    my ( $fh, $comment, $noprepend, $noipinfo ) = @_;
    mlog( $fh, $comment, $noprepend, $noipinfo );
    &mlogWrite() if $WorkerNumber == 0;
}

sub mlog_S {
    my ( $Sfh, $Scomment, $Snoprepend, $Snoipinfo ) = @_;
    push @mlogS, [ $Sfh, $Scomment, $Snoprepend, $Snoipinfo , 1];
}

sub mlog {
    my ( $fh, $comment, $noprepend, $noipinfo , $noS) = @_;
    threads->yield();
    unless ($noS) {
        while (my $ar = shift @mlogS) {
            mlog(@$ar);
        }
    }
    $fh = 0 unless $fh;
    my $this = $fh ? exists $Con{$fh} ? $Con{$fh}: 0 : 0;
    my $header;
    my $noNotify = $comment =~ s/^\*x\*//o;
    my $logfile = $logfile;
    $logfile =~ s/\\/\//go;
    my $archivelogfile;
    my $archivelogfileBR;
    if ($WorkerNumber == 0) {
        if ($comment =~ /^(?:adminupdate|configerror)\:/io && ($WebIP{$ActWebSess}->{user} or $syncUser)) {
            $comment =~ s/^(adminupdate|configerror)(\:)/$1$2 \[$WebIP{$ActWebSess}->{user} $WebIP{$ActWebSess}->{ip}\]/io
                if (! $syncUser);
            $comment =~ s/^(adminupdate|configerror)(\:)/$1$2 \[$syncUser $syncIP\]/io
                if ($syncUser);
        }
        PrintConfigHistory($comment) if $comment =~ /^adminupdate/io;
        PrintConfigHistory($comment) if $comment =~ /^configerror/io;
        PrintAdminInfo($comment)     if $comment =~ /^admininfo/io;
        PrintAdminInfo($comment)     if $comment =~ /^email(?:[:])? /io;
        $lastMlog = time unless $comment;
    }

    my $m = &timestring();
    my ($sec,$min,$hour,$mday,$mon,$year) = localtime(time);

    if($LogRollDays > 0 && $WorkerNumber == 0 && ! $comment) {

            # roll log every $LogRollDays days, at midnight
            my $t=int((time + $TimeZoneDiff)/($LogRollDays*24*3600));
            if($logfile && $mlogLastT && $t != $mlogLastT && $logfile ne 'maillog.log' && $asspLog) {

                # roll the log
                my ($sec,$min,$hour,$mday,$mon,$year) = localtime(time - 7200);  # get the previouse day for logfile name

                $mon++; $year-=100;
                my $mm; $mm=sprintf("%02d-%02d-%02d",$year,$mon,$mday) if !$LogNameMMDD;
                $mm=sprintf("%02d-%02d",$mon,$mday) if $LogNameMMDD;
                my ($logdir, $logdirfile);
                ($logdir, $logdirfile) = ($1,$2) if $logfile=~/^(.*)[\/\\](.*?)$/o;
                if (!$logdir)  {
                    $archivelogfile = "$mm.$logfile";
                    $archivelogfileBR = "$mm.b$logfile";
                } else {
                    mkdir "$base/$logdir",0755;
                    $archivelogfile = "$logdir/$mm.$logdirfile";
                    $archivelogfileBR = "$logdir/$mm.b$logdirfile";
                }
                my $msg="$m: Rolling log file -- archive will be saved as '$archivelogfile'\n";
                w32dbg("$m: Rolling log file -- archive will be saved as '$archivelogfile'") if ($CanUseWin32Debug);
                print $LOG $msg if fileno($LOG);
                print $msg unless $silent;
                &closeLogs();
                sleep 1;
                $ThreadIdleTime{$WorkerNumber} += 1;
                if ($ExtraBlockReportLog) {
                    rename("$base/$blogfile", "$base/$archivelogfileBR");
                    my $e = $!;
                    if ($e && ! -e "$base/$archivelogfileBR") {
                        print "error: unable to rename file $base/$blogfile to $base/$archivelogfileBR - $e\n";
                        threads->yield();
                        $mlogQueue->enqueue("error: unable to rename file $base/$blogfile to $base/$archivelogfileBR - $e\n");
                        threads->yield();
                    }
                }
                rename("$base/$logfile", "$base/$archivelogfile");
                my $e = $!;
                if ($e && ! -e "$base/$archivelogfile") {
                    print "error: unable to rename file $base/$logfile to $base/$archivelogfile - $e\n";
                    threads->yield();
                    $mlogQueue->enqueue("error: unable to rename file $base/$logfile to $base/$archivelogfile - $e\n");
                    threads->yield();
                }
                &openLogs();
                print $LOG "$m $WorkerName new log file -- old log file renamed to '$archivelogfile'\n" if fileno($LOG);
                print $LOG "$m $WorkerName new blog file -- old log file renamed to '$archivelogfileBR'\n" if $ExtraBlockReportLog && fileno($LOG);
                w32dbg("$m $WorkerName new log file -- old log file renamed to '$archivelogfile'") if ($CanUseWin32Debug);
                w32dbg("$m $WorkerName new log file -- old log file renamed to '$archivelogfileBR'") if $CanUseWin32Debug && $ExtraBlockReportLog;
            }
            $mlogLastT=$t;
    }

    return 1 if((! $comment || $comment =~ /^[\s\r\n]+$/o) && ($fh == 0 || $WorkerNumber == 0));

    my @m;
    if ($this) {
        $m .= " $this->{msgtime}" if $this->{msgtime};
        if ($WorkerLogging) {
            $m .= " \[$WorkerName\]";
            if ("$fh" =~ /SSL/io or "$this->{friend}" =~ /SSL/io) {
                $m .= ("$fh" =~ /SSL/io && $this->{oldfh})
                    ? ' [TLS-in]' : ("$fh" =~ /SSL/io && ! $this->{oldfh})
                    ? ' [SSL-in]' : '';
                $m .= ("$this->{friend}" =~ /SSL/io && $Con{$this->{friend}}->{oldfh})
                    ? ' [TLS-out]' : ("$this->{friend}" =~ /SSL/io && ! $Con{$this->{friend}}->{oldfh})
                    ? ' [SSL-out]' : '';
            }
        }
        $m .= " $this->{prepend}" if $tagLogging && $this->{prepend} && !$noprepend;

        if ($expandedLogging || $noipinfo >= 2 || (! $this->{loggedIpFromTo} && !$noipinfo)) {
            $m .= " $this->{ip}" if ($this->{ip});
            $m .= " [OIP: $this->{cip}]" if ($this->{cip});
            my $mf = &batv_remove_tag(0,$this->{mailfrom},'');
            $m .= " <$mf>" if ($mf);
            my $to;
            $to = $this->{orgrcpt} if $noipinfo == 3;
            ($to) = $this->{rcpt} =~ /(\S+)/o unless $to;
            my $mm = $m;
            if ($to) {
                $this->{loggedIpFromTo} = 1 if $noipinfo < 3;
                $m .= " to: $to";
            }
            if ($noipinfo < 3 && $comment =~ / \[(?:spam found|MessageOK)\] /oi) {
                my $c = $comment;
                $c =~ s/\r//go;
                $c =~ s/\n([^\n]+)/\n\t$1/go;
                $c .= "\n" if ($c !~ /\n$/o);
                my %seen;
                for (split(/\s+/o,$this->{rcpt})) {
                    next unless $_;
                    next if $seen{lc $_};
                    $seen{lc $_} = 1;
                    push @m, "$mm to: $_ $c";
                }
            }
        }

        $m .= " $comment";
    } else {
        $m .= " \[$WorkerName\]" if $WorkerLogging;
        $m .= ' ' . ucfirst($comment);
    }

    if ($canNotify &&
        ! $noNotify &&
        scalar keys %NotifyRE &&
        $m =~ /$NotifyReRE/ &&
        $m !~ /$NoNotifyReRE/ &&
        NotifyFrequencyOK($comment) )
    {
        my $rcpt;
        my $sub;
        while (my ($k,$v) = each %NotifyRE) {
            if ($m =~ /$k/i) {
                $rcpt = $v;
                $sub = $NotifySub{$k} . " from $myName" if exists $NotifySub{$k};
                last;
            }
        }
        $sub ||= "ASSP event notification from $myName";
        &sendNotification(
          $EmailFrom,
          $rcpt,
          $sub,
          "log event on host $myName:\r\n\r\n$comment\r\n") if $rcpt;
    }


    $m =~ s/\r//go;
    $m =~ s/\n([^\n]+)/\n\t$1/go;
    $m .= "\n" if ($m !~ /\n$/o);

    threads->yield();
    $debugQueue->enqueue(scalar @m ? @m : $m) if ($debug || $ThreadDebug);
    threads->yield();

    return 1 if($noLogLineRe && $m =~ /$noLogLineReRE/);

    if ($this) {
        if ($noLog && $fh && exists $Con{$fh} &&  ($this->{noLog} || $this->{nomlog} || &matchIP($Con{$fh}->{ip},'noLog',0,1) || ($Con{$fh}->{friend} && &matchIP($Con{$Con{$fh}->{friend}}->{ip},'noLog',0,1)))) {
            $this->{nomlog} = 1;
            return 1;
        }
        $header = substr($this->{header},0,$MaxBytes + $this->{headerlength}) if ($fh && $MaxBytes && !$this->{noLog} && $noLogRe);
        if ($this->{noLog} ||
            ($noLogRe &&
             (( $this->{mailfrom} && $this->{mailfrom} =~ /$noLogReRE/)
             || ( $header =~ /$noLogReRE/))))
        {
            $this->{noLog} = 1 if ($fh);
            return 1;
        }
    }
    
    threads->yield();
    $mlogQueue->enqueue(scalar @m ? @m : $m);
    threads->yield();
    $MainThreadLoopWait = 0;
    return 1;
}

sub NotifyFrequencyOK {
    my $text = shift;
    return 1 if eval{$DEBUG && $DEBUG->opened;};
    return 1 unless keys %NotifyFreqTF;
    return 1 if $text !~ /^(info|warning|error)\s*:/oi;
    return 1 unless $NotifyFreqTF{$1};
    return 0 if $NotifyLastFreq{$1} + $NotifyFreqTF{$1} > time;
    $NotifyLastFreq{$1} = time;
    return 1;
}

sub tosyslog {
  my ($priority, $m) = @_;
  return 0 unless ($priority =~ /info|err|debug/o);
  return 1 if $syslogNextTry && time < $syslogNextTry;

  eval{
   if ($sysLogPort && $sysLogIp) {
       $SysLogObj ||= ASSP::Syslog->new(Facility=>$SysLogFac,Priority=>'Debug',SyslogPort=>$sysLogPort,SyslogHost=>$sysLogIp);
       while (@$m) {
           my $msg = shift @$m;
           $msg =~ s/^\s+//o;
           eval{$SysLogObj->send($msg,Priority=>$priority);};
           if ($@) {
               undef $SysLogObj;
               $syslogNextTry = time + 60;
               mlog(0, "warning: unable to contact syslog server $sysLogIp:$sysLogPort");
               return 0;
           } else {
               $syslogNextTry = 0;
           }
       }
   } elsif ($CanUseSyslog) {
       setlogsock('unix');
       openlog('assp', 'pid,cons', 'mail');
       while (@$m) {
           my $msg = shift @$m;
           $msg =~ s/^\s+//o;
           syslog($priority, $msg);
       }
       closelog();
   }
  };
  if ($@) {
      $syslogNextTry = time + 60;
      undef $SysLogObj;
      mlog(0, "warning: syslog error - $@");
      return 0;
  } else {
      $syslogNextTry = 0;
  }
  return 1;
}

sub tzStr {
# calculate the time difference in minutes
my $minoffset = $TimeZoneDiff / 60;

# translate it to "hour-format", so that 90 will be 130, and -90 will be -130
  my $sign=$minoffset<0?-1:+1;
  $minoffset = abs($minoffset)+0.5;
  my $tzoffset = 0;
  $tzoffset = $sign * (int($minoffset/60)*100 + ($minoffset%60)) if $minoffset;
# apply final formatting, including +/- sign and 4 digits
  return sprintf("%+05d", $tzoffset);
}
sub getTimeDiffAsString {

	my ($tdiff,$seconds) = @_;

	my $days  = int( $tdiff / 86400 );
	my $hours = int( ( $tdiff - ( $days * 86400 ) ) / 3600 );
	my $mins  = int( ( $tdiff - ( $days * 86400 ) - ( $hours * 3600 ) ) / 60 );
	my $secs  = int( $tdiff - ( $days * 86400 ) - ( $hours * 3600 ) - ( $mins * 60 ) );

	my $ret;
	$ret = $days . " day" . ( $days == 1 ? ' ' : "s " );
	$ret .= $hours . " hour" . ( $hours == 1 ? ' ' : "s " );
	$ret .= $mins . " min" .   ( $mins == 1  ? ' ' : "s " );
	$ret .= $secs . " sec" .   ( $secs == 1  ? ' ' : "s " ) if $seconds;

	return $ret;
}

sub getTimeDiff {
	my ($tdiff,$seconds) = @_;
    my $m = getTimeDiffAsString($tdiff,$seconds);
    $m =~ s/^0 hours //o if ($m =~ s/^0 days //o);
    return $m;
}
#####################################################################################
#                Socket handlers
sub setSSLfailed {
    my $ip = shift;
    return unless $banFailedSSLIP;
    if (exists $SSLfailed{$ip}) {   # ban if it failes before
        $SSLfailed{$ip} = time;
    } elsif (($banFailedSSLIP & 1) && (matchIP($ip,'acceptAllMail',0,1) or $ip =~ /$IPprivate/o)) {  # give privates one more chance
        $SSLfailed{$ip} = 0;
    } elsif ($banFailedSSLIP & 2) {
        $SSLfailed{$ip} = time;    # ban external IP if it failes before
    }
    return;
}

sub switchSSLClient {
    my $fh =shift;
    my $sslfh;
    my $try = 4;
    eval{$fh->blocking(1);};
    $sslfh = IO::Socket::SSL->start_SSL($fh,{
             SSL_startHandshake => 1,
             getSSLParms(1)
             });
    while ($try-- && "$sslfh" !~ /SSL/io && ($IO::Socket::SSL::SSL_ERROR == eval('SSL_WANT_READ') ? 1 : $IO::Socket::SSL::SSL_ERROR == eval('SSL_WANT_WRITE') ) && $SSLRetryOnError)
    {
         &ThreadYield();
         Time::HiRes::sleep(0.5);
         $ThreadIdleTime{$WorkerNumber} += 0.5;
         mlog($fh,"info: retry ($try) SSL negotiation - peer socket was not ready");
         
         $sslfh = IO::Socket::SSL->start_SSL($fh,{
             SSL_startHandshake => 1,
             getSSLParms(1)
             });
    }
    if ("$sslfh" =~ /SSL/io) {
        eval{$sslfh->blocking(0);};
    } else {
        eval{$fh->blocking(0);};
    }
    return $sslfh,$fh;
}
sub switchSSLServer {
    my $fh =shift;
    my $sslfh;
    my $try = 4;
    eval{$fh->blocking(1);};
    $sslfh = IO::Socket::SSL->start_SSL($fh,{
             SSL_startHandshake => 1,
             getSSLParms(0)
             });
    while ($try-- && "$sslfh" !~ /SSL/io && ($IO::Socket::SSL::SSL_ERROR == eval('SSL_WANT_READ') ? 1 : $IO::Socket::SSL::SSL_ERROR == eval('SSL_WANT_WRITE') ) && $SSLRetryOnError)
    {
         &ThreadYield();
         Time::HiRes::sleep(0.5);
         $ThreadIdleTime{$WorkerNumber} += 0.5;
         mlog($fh,"info: retry ($try) SSL negotiation - peer socket was not ready");

         $sslfh = IO::Socket::SSL->start_SSL($fh,{
             SSL_startHandshake => 1,
             getSSLParms(0)
             });
    }
    if ("$sslfh" =~ /SSL/io) {
        eval{$sslfh->blocking(0);};
    } else {
        eval{$fh->blocking(0);};
    }
    return $sslfh,$fh;
}

sub matchFH {
    my ($fh, @fhlist) = @_;
    return 0 unless scalar @fhlist;
    return 0 unless $fh;
    my $sinfo;
    if (exists $Con{$fh} && $Con{$fh}->{localip} && $Con{$fh}->{localport}) {
        $sinfo = $Con{$fh}->{localip} . ':' . $Con{$fh}->{localport};
    }
    $sinfo ||= $fh->sockhost() . ':' . $fh->sockport();
    $sinfo =~ s/:::/\[::\]:/o;

    while (@fhlist) {
        my $lfh = shift @fhlist;
        if ($lfh =~ /^(?:0\.0\.0\.0|\[::\])(:\d+)$/o) {
            my $p = $1;
            return 1 if ($sinfo =~ /$p$/);
        }
        return 1 if ($sinfo eq $lfh);
    }
    return 0;
}

sub NewSMTPConCall {
    return unless scalar keys %SocketCallsNewCon;
    &sigoffTry(__LINE__);
    while (my ($k,$v) = each %SocketCallsNewCon) {
        $v->($k);
    }
    &sigonTry(__LINE__);
}

sub NewSMTPConnectionConnect {
    my $fhh=shift;
    my $fnoC;
    my $fnoS;
    my $timeout;
    my $isSSL = "$fhh" =~ /SSL/io;
    my $client;
    my $mlog = $inSIG ? \&mlog_S : \&mlog ;
    my $d = $inSIG ? \&d_S : \&d ;
    delete $SocketCalls{$fhh};
    $d->('NewSMTPConnectionConnect');
    eval{$timeout = $fhh->timeout();};
    my $tout = $isSSL ? $SSLtimeout : 2;
    eval{$fhh->timeout($tout) if (! $timeout || $timeout < $tout);};
    if(!($client=$fhh->accept)) {
        my $error = $!;
        eval{$timeout = $fhh->timeout();};
        $mlog->(0,"error: $WorkerName accept to client failed $fhh (timeout: $timeout s) : $error");
        $d->("accept failed: $fhh : $error") unless $inSIG;
        threadConDone($fhh);
        $! = '';
        close($fhh);
        $mlog->(0,"error: $WorkerName close failed on $fhh : $!") if ($!);
        threads->yield;
        $trqueue->enqueue("failed");  # tell the main thread that we are not connected!
        threads->yield;
        $mlog->(0,"info: $WorkerName freed Main_Thread (no accept)") if($WorkerLog >= 2);
        $d->('NewSMTPConnectionConnect - no accept');
        exists $Con{$fhh} && delete $Con{$fhh};
        return;
    }
    threadConDone($fhh);
    close($fhh);
    exists $Con{$fhh} && delete $Con{$fhh};
    if (exists $Con{$client}) {
        $mlog->(0,"error: internal Perl error in $WorkerName, area for $client still exists");
        threadConDone($client);
        eval{close($client)};
        threads->yield;
        $trqueue->enqueue("failed");  # tell the main thread that we are not connected!
        threads->yield;
        return;
    }
    threads->yield;
    $trqueue->enqueue("ok");       # tell the main thread that we are connected!
    threads->yield;
    $fnoC = fileno($client);
    $mlog->(0,"info: $WorkerName freed Main_Thread - $fnoC") if($WorkerLog >= 2);
    $client->blocking(0);
    $SocketCalls{$client} = \&NewSMTPConnection;
    $SocketCallsNewCon{$client} = \&NewSMTPConnection;
    $Con{$client} = {};
    $Con{$client}->{timelast} = $Con{$client}->{timestart} = time;
    $Con{$client}->{socketcalls} = 0;
    $Con{$client}->{type} = 'C';
    $Con{$client}->{self} = $client;
    $Con{$client}->{fno} = $fnoC;
    $Con{$client}->{peerhost} = $client->peerhost();
    $Con{$client}->{peerport} = $client->peerport();
    my $n = scalar keys %SocketCalls;
    $ComWorker{$WorkerNumber}->{numActCon} = int(($n+1)/2);      # set the number of active connection in thread
    threads->yield;
}

sub NewSMTPConnection {
    my $client=shift;
    my $tclient = $Con{$client}->{self};
    if ($tclient) {
        $client = $tclient;
    } else {
        eval {
            threadConDone($client);
            delete $SocketCallsNewCon{$client};
            delete $SocketCalls{$client};
            close($client) if fileno($client);
        };
        return;
    }
    my $fnoC;
    my $fnoS;
    my $timeout;
    my $isSSL;
    my ($server, $destination, $relayok, $AVa, $relayused);
    delete $SocketCallsNewCon{$client};
    delete $SocketCalls{$client};
    if(&matchFH($client,@lsnRelayI)) {

        # a relay connection -- destination is the relayhost if defined
        d('NewSMTPConnection - relay OK');
        $relayok=1;
        $relayused = 1;
        $destination = $relayHost ? $relayHost : $smtpDestination;
    } elsif(&matchFH($client,@lsn2I) && $smtpAuthServer ne '') {

        # connection on the Second Listen port
        d('NewSMTPConnection - AuthServer OK');
        $relayok=0;
        $destination=$smtpAuthServer;
    } elsif (&matchFH($client, @lsnSSLI) && $smtpDestinationSSL ne '' ) {

        # connection on the the secure SSL port
        d('NewSMTPConnection - SSL port');
        $destination = $smtpDestinationSSL;
        $relayok=0;
        $isSSL = 1;
    } else {
        d('NewSMTPConnection - no relay');
        $destination=$smtpDestination;
        $relayok=0;
        if(&matchFH($client,@lsnSSLI)) {
            $isSSL = 1;
        }
    }
    $fnoC = $Con{$client}->{fno} || fileno($client);
    my $ip = $Con{$client}->{peerhost} = $Con{$client}->{peerhost} || $client->peerhost()
       ||
       do {
           mlog(0,"error: This system is some time unable to detect connected IP addresses - check that you use the latest C-library, Perl-version and Perl module versions") if $ConnectionLog;
           undef;
       };
    my $port     = $Con{$client}->{peerport} || $client->peerport();
    my $localip  = $client->sockhost();
    my $localport= $client->sockport();
    my $ret;

    if (! $ThreadDebug && (&matchIP($localip,'debugIP',0,0) or ($ip && &matchIP($ip,'debugIP',0,0)))) {
       $ThreadDebug = 1;
    }

    # shutting down ?
    if ($shuttingDown) {
        mlog(0,"connection from $ip:$port rejected -- shutdown/restart process is in progress");

        my $out = "421 <$myName> Service not available, closing transmission channel\r\n";
        &NoLoopSyswrite($client,$out,0) if $ip;
        threadConDone($client);
        delete $Con{$client};
        close($client);
        d('NewSMTPConnection - shutdown detected');
        return;
    }

    $Stats{smtpConnSSL}++ if $isSSL;
    $Con{$client}->{timestart} = Time::HiRes::time();

    # SSL error in the past
    if ($ip && $isSSL && $SSLfailed{$ip}) {
        mlog(0,"connection from $ip:$port rejected -- IP has failed SSL in the past");

        my $out = "421 <$myName> SSL-Service not available for IP $ip, closing transmission channel\r\n";
        &NoLoopSyswrite($client,$out,0) if $ip;
        threadConDone($client);
        delete $Con{$client};
        close($client);
        d('NewSMTPConnection - IP has failed SSL in the past');
        return;
    } elsif ($ip && $isSSL && exists $SSLfailed{$ip}) {
        delete $SSLfailed{$ip};
    }

    if ($ip && $EmergencyBlock{$ip}) {
        mlog( $client, "$ip:$port denied by internal EMERGENCY Blocker - this IP has possibly tried before to KILL assp" );
        mlog( $client, "$ip:$port ATTENTION ! The EMERGENCY blocking for this IP will be lifted after an ASSP restart or at least in 15 minutes" );
        $Stats{denyConnectionA}++;
        $Con{$client}->{type} = 'C';
        &NoLoopSyswrite($client,"554 <$myName> Service denied, closing transmission channel\r\n",0);
        $Con{$client}->{error} = '5';
        done($client);
        return;
    }

    my $byWhatList = 'denySMTPConnectionsFromAlways';
    if ($ip && $denySMTPstrictEarly) {
        $ret = matchIP( $ip, 'denySMTPConnectionsFromAlways', $client,0 );
        $ret = matchIP( $ip, 'droplist', $client,0 ) if (! $ret && ($DoDropList == 2 or $DoDropList == 3) && ($byWhatList = 'droplist')) ;
    }

    if ($ip &&
        $denySMTPstrictEarly &&
        $ret &&
        $DoDenySMTPstrict &&
        ! matchIP( $ip, 'noPB', 0, 1 ) &&
        ! matchIP( $ip, 'noBlockingIPs', 0, 1 )
        )
    {
        $Con{$client}->{prepend} = "[DenyStrict]";
        if ($DoDenySMTPstrict == 1) {
            mlog( $client, "$ip:$port denied by $byWhatList strict: $ret" )
              if $denySMTPLog || $ConnectionLog >= 2;
            $Stats{denyConnectionA}++;
            $Con{$client}->{type} = 'C';
            &NoLoopSyswrite($client,"554 <$myName> Service denied, closing transmission channel\r\n",0);
            $Con{$client}->{error} = '5';
            done($client);
            return;
        } elsif ($DoDenySMTPstrict == 2) {
            mlog( $client, "[monitoring] $ip:$port denied by $byWhatList strict: $ret" )
              if $denySMTPLog || $ConnectionLog >= 2;
            $Con{$client}->{prepend} = '';
        }
    }

    # ip connection limiting  parallel session
    my $doIPcheck;
    $maxSMTPipSessions=999 if (!$maxSMTPipSessions);
    if ( $ip &&
         ! matchIP($ip,'noMaxSMTPSessions',0,1) &&
         ($doIPcheck =
            ! $relayok &&
            ! matchIP($ip,'noProcessingIPs',0,1) &&
            ! matchIP($ip,'whiteListedIPs',0,1) &&
            ! matchIP($ip,'noDelay',0,1) &&
            ! matchIP($ip,'ispip',0,1) &&
            ! matchIP($ip,'acceptAllMail',0,1) &&
            ! matchIP($ip,'noBlockingIPs',0,1)
         )
       )
    {
        threads->yield;
        if (++$SMTPSessionIP{$ip} > $maxSMTPipSessions) {
            threads->yield;
            $SMTPSessionIP{$ip}--;
            threads->yield;
            d("limiting ip: $client");
            mlog(0,"limiting $ip connections to $maxSMTPipSessions") if $ConnectionLog >= 2 || $SessionLog;

            $Stats{smtpConnLimitIP}++;
            $Con{$client}->{messagereason}="limiting $ip connections to $maxSMTPipSessions";
            pbAdd( $client, $ip, 'iplValencePB', "LimitingIP" ) if ! matchIP($ip,'noPB',0,1);
            d('NewSMTPConnection - LimitingIP');
            $Con{$client}->{type} = 'C';
            $Con{$client}->{error} = '5';
            done($client);
            return;
        } else {
            $SMTPSession{$client}=1;
            threads->yield;
        }
    }

    if (! $ip ) {
        mlog(0,"error: unable to detect the remote connected IP address - localIP:port, $localip:$localport - remoteIP:port, $ip:$port - local-socket,$client");
        $Con{$client}->{type} = 'C';
        $Con{$client}->{error} = '5';
        done($client);
        return;
    }

    # check relayPort usage
    if ($relayused && $allowRelayCon && ! matchIP($ip,'allowRelayCon',0,1)) {
        $Con{$client}->{prepend} = "[RelayAttempt]";
        $Con{$client}->{type} = 'C';
        &NoLoopSyswrite($client,"554 <$myName> Relay Service denied for IP $ip, closing transmission channel\r\n",0);
        $Con{$client}->{error} = '5';
        mlog(0,"rejected relay attemp on allowRelayCon for ip $ip") if $ConnectionLog >= 2 || $SessionLog;
        done($client);
        $Stats{rcptRelayRejected}++;
        return;
    }

    my $bip = &ipNetwork( $ip, $PenaltyUseNetblocks);

    if (   $DelayIP
        && $DelayIPTime
  		&& $doIPcheck
    	&& !$allTestMode
    	&& (my $pbval = [split(/\s+/o,$PBBlack{$bip})]->[3]) > $DelayIP
    	&& ( ! $DelayIPPB{$bip} || ($DelayIPPB{$bip} + $DelayIPTime > time))
        && $ip !~ /$IPprivate/o
        && ! exists $PBWhite{$bip}
        && ! matchIP( $ip, 'noPB', 0, 1 ) )
    {
        $DelayIPPB{$bip} = time unless $DelayIPPB{$bip};
        $Stats{delayConnection}++;
        $Con{$client}->{type} = 'C';
        &NoLoopSyswrite($client,"451 4.7.1 Please try again later\r\n",0);
        $Con{$client}->{error} = '5';
        done($client);
        mlog(0,"delayed ip $ip, because PBBlack($pbval) is higher than DelayIP($DelayIP)- last penalty reason was: " . [split(/\s+/o,$PBBlack{$bip})]->[5] , 1) if $ConnectionLog >= 2 || $SessionLog;
        return;
    } elsif (   $DelayIP
             && $DelayIPTime
       		 && $doIPcheck
    	     && !$allTestMode
             && $DelayIPPB{$bip}
             && $DelayIPPB{$bip} + $DelayIPTime <= time)
    {
        delete $DelayIPPB{$bip};
    }

    if ($MaxAUTHErrors &&
        $doIPcheck &&
        $AUTHErrors{$bip} > $MaxAUTHErrors
       )
    {
        d("NewSMTPConnection - AUTHError ip: $client");
        $Con{$client}->{prepend} = "[AUTHError]";
        mlog(0,"blocked $ip - too much AUTH errors ($AUTHErrors{$bip})") if $ConnectionLog >= 2 || $SessionLog;

        $Stats{AUTHErrors}++;
        $Con{$client}->{type} = 'C';
        &NoLoopSyswrite($client,"554 <$myName> Service denied for IP $ip (harvester), closing transmission channel\r\n",0);
        $Con{$client}->{error} = '5';
        done($client);
        return;
    }
    
    my $intentForIP;
    my $peerhost;
    my $peerport;
    foreach my $destinationA (split(/\s*\|\s*/o, $destination)) {
        if ($destinationA =~ /^(_*INBOUND_*:)?(\d+)$/o){
            $localip = '127.0.0.1' if ($localip eq '0.0.0.0');
            if (exists $crtable{$localip}) {
                $destinationA=$crtable{$localip};
                $intentForIP = "X-Assp-Intended-For-IP: $localip\r\n";
            } else {
                $destinationA = $localip .':'.$2;
            }
        }
        if (! $server) {
            d("try to connect to server at $destinationA");
            mlog(0,"info: try to connect to server at $destinationA") if $ConnectionLog >= 2;
            $server = $CanUseIOSocketINET6
                      ? IO::Socket::INET6->new(Proto=>'tcp',PeerAddr=>$destinationA,Timeout=>2,&getDestSockDom($destinationA))
                      : IO::Socket::INET->new(Proto=>'tcp',PeerAddr=>$destinationA,Timeout=>2);
            threads->yield;
            if(ref($server) && eval{$peerhost = $server->peerhost(); $peerport = $server->peerport();$peerhost && $peerport;} ) {
                $destination=$destinationA;
                d("connected to server $server at $peerhost:$peerport");
                mlog(0,"info: connected to server at $peerhost:$peerport") if $ConnectionLog >= 2;
                last;
            } elsif (ref($server)) {
                mlog(0,"*** $destinationA - no peerhost information available, trying others...") ;
                eval {$server->close;};
                $server = undef;
                $intentForIP = '';
            } else {
                mlog(0,"*** $destinationA didn't work, trying others...") ;
                $server = undef;
                $intentForIP = '';
            }
        }
    }
    if(! (ref($server) && $peerhost && $peerport)) {
        mlog(0,"error: couldn't create server socket to $destination -- aborting connection") ;
        threads->yield;
        if (exists $SMTPSession{$client}) {
            $SMTPSessionIP{Total}++;
            threads->yield;
            $smtpConcurrentSessions++;
            threads->yield;
        }
        $Con{$client}->{type} = 'C';
        &NoLoopSyswrite($client,"421 <$myName> service temporarily unavailable, closing transmission\r\n",0);
        done($client);
        return;
    }
    if (! $ThreadDebug && &matchIP($peerhost,'debugIP',0,0)) {
       $ThreadDebug = 1;
    }
    $fnoS = fileno($server);
    addfh($client,\&getline,$server);
    if($sendNoopInfo) {
        addfh($server,\&skipok,$client);
    } else {
        addfh($server,\&reply,$client);
    }
    if ($ConTimeOutDebug) {
        my $m = &timestring();
        $Con{$client}->{contimeoutdebug}  = "$m $WorkerName\r\n";
        $Con{$client}->{contimeoutdebug} .= "$m client filenumber = $fnoC\r\n";
        $Con{$client}->{contimeoutdebug} .= "$m server filenumber = $fnoS\r\n";
        $Con{$client}->{contimeoutdebug} .= "$m client  = $client\r\n";
        $Con{$client}->{contimeoutdebug} .= "$m client IP  = $ip\r\n";
        $Con{$client}->{contimeoutdebug} .= "$m server  = $server\r\n";
    }
    $Con{$client}->{SessionID} = uc "$client";
    $Con{$client}->{SessionID} =~ s/^.+?\(0[xX]([^\)]+)\).*$/$1/o;
    $Con{$client}->{prescore} = 0;
    $Con{$client}->{debug}    = $ThreadDebug;
    $Con{$client}->{client}   = $client;
    $Con{$client}->{self}     = $client;
    $Con{$client}->{server}   = $server;
    $Con{$client}->{ip}       = $ip;
    $Con{$client}->{port}     = $port;
    $Con{$client}->{localip}  = $localip;
    $Con{$client}->{localport}= $localport;
    $Con{$client}->{relayok}  = $relayok;
    $Con{$client}->{myheaderCon} .= $intentForIP if $intentForIP;
    $Con{$client}->{myheaderCon} .= "X-Assp-Client-SSL: yes\r\n" if $isSSL;
    $Con{$client}->{chainMailInSession} = -1;
    $Con{$client}->{type}     = 'C';
    $Con{$client}->{fno}      = $fnoC;
    $Con{$server}->{type}     = 'S';
    $Con{$server}->{fno}      = $fnoS;
    $Con{$server}->{self}     = $server;
    $Con{$server}->{debug}    = $ThreadDebug;

    #  mlog(0,"connection fno : client = $fnoC , server = $fnoS");
    d("Connected: SID=$Con{$client}->{SessionID} $client -- $server");
    if( $Con{$client}->{relayok} || isOk2Relay($client,$ip) ) {
        $Con{$client}->{relayok} = 1;
        d("$client relaying ok: $ip");
    }
    my $time=$UseLocalTime ? localtime() : gmtime();
    my $tz=$UseLocalTime ? tzStr() : '+0000';
    $time=~s/... (...) +(\d+) (........) (....)/$2 $1 $4 $3/o;
    $Con{$client}->{rcvd}="Received: from =host ([$ip] helo=) by $myName with *SMTP* ($version); $time $tz\r\n";
    d("* connect SID=$Con{$client}->{SessionID} ip=$Con{$client}->{ip} relay=<$Con{$client}->{relayok}> *");
    my $text = $destination;
    $text = $server->sockhost() . ':' . $server->sockport() . " > $text , $fnoC-$fnoS" if $ConnectionLog >= 2;
    mlog(0,"Connected: session:$Con{$client}->{SessionID} $ip:$port > $localip:$localport > $text") if ($ConnectionLog && ! matchIP($ip,'noLog',0,1));
    $Con{$server}->{noop}="NOOP Connection from: $ip, $time $tz relayed by $myName\r\n" if $sendNoopInfo;

    # overall session limiting
    $maxSMTPSessions=999 if (!$maxSMTPSessions);
    my $numsess;
    threads->yield;
    $numsess = ++$SMTPSessionIP{Total};
    threads->yield;
    $smtpConcurrentSessions++;
    threads->yield;
    $SMTPSession{$client}=$client;
    if ($numsess>=$maxSMTPSessions) {
        d("$WorkerName limiting sessions: $client");
        if ($SessionLog) {
            mlog(0,"connected: $ip:$port") if !$ConnectionLog || matchIP($ip,'noLog',0,1); # log if not logged earlier
            mlog(0,"limiting total connections");
        }
        $Stats{smtpConnLimit}++;
    } else {      # increment Stats if connection not limited
        if (matchIP($ip,'noLog',0,1)) {
            $Stats{smtpConnNotLogged}++;
        } else {
            $Stats{smtpConn}++;
        }
    }
    if ($smtpConcurrentSessions>$Stats{smtpMaxConcurrentSessions}) {
        $Stats{smtpMaxConcurrentSessions}=$smtpConcurrentSessions;
    }
    newCrashFile($client);
}

sub SMTPTraffic {
    my $fh=shift;
    $SMTPbuf = '';
    my $ip = $Con{$fh}->{ip};
    my $pending = 0;
    eval{$pending = $fh->pending();} if ("$fh" =~ /SSL/io);
    $SMTPmaxbuf = max( $SMTPmaxbuf, 16384 , ($MaxBytes + 4096), $pending);
    $Con{$fh}->{prepend} = '';
    $Con{$fh}->{socketcalls}++;
    $fh->blocking(0) if $fh->blocking;
    &sigoffTry(__LINE__);
    my $hasread = $fh->sysread($SMTPbuf, $SMTPmaxbuf);
    &sigonTry(__LINE__);
    if ($hasread == 0 && "$fh" =~ /SSL/io && IO::Socket::SSL::errstr() =~ /SSL wants a/io) {
        ThreadYield();
        $Con{$fh}->{sslwantrw} ||= time;
        if (time - $Con{$fh}->{sslwantrw} > $SSLtimeout) {
            my $lastcmd = "- last command was \'$Con{$fh}->{lastcmd}\'";
            $lastcmd = '' unless $Con{$fh}->{lastcmd};
            mlog($fh,"info: can't read from SSL-Socket for $SSLtimeout seconds - close connection - $! $lastcmd") if ($ConnectionLog);
            delete $Con{$fh}->{sslwantrw};
            setSSLfailed($ip);
            done2($fh);
        }
        return;
    }
    delete $Con{$fh}->{sslwantrw};
    if($hasread > 0 or length($SMTPbuf) > 0) {
        my $crashfh = $Con{$fh}->{crashfh};
        if ($crashfh) {
            print $crashfh "+-+***+!+time:  ".timestring() .' / '. Time::HiRes::time()."+-+***+!+";
            print $crashfh $SMTPbuf;
        }
        if (! $ThreadDebug &&
            ( ($debugRe && $SMTPbuf =~ /($debugReRE)/) ||
              ($debugCode && eval($debugCode) && !$@)
            )
           )
        {
            if ($1||$2) {
                mlog($fh,"info: partial debug switched on - found ".($1||$2));
            } else {
                mlog($fh,"info: partial debug switched on - debugCode has returned 1");
            }
            $Con{$fh}->{debug} = 1;
            $Con{$Con{$fh}->{friend}}->{debug} = 1 if ($Con{$fh}->{friend} && exists $Con{$Con{$fh}->{friend}});
            $ThreadDebug = 1;
        }
        if ($@) {
            mlog($fh,"warning: possible syntax error in 'debugCode' - $debugCode - $@");
            mlog($fh,"warning: commending out debugCode because of syntax error");
            $debugCode = '0; # syntaxerror in : ' . $debugCode;
            $Config{debugCode} = $debugCode;
            $ConfigChanged = 1;
        }
        d('SMTPTraffic - read OK');
        $SMTPbuf=$Con{$fh}->{_}.$SMTPbuf;
        if ($Con{$fh}->{type} eq 'C'){
            $Con{$fh}->{timelast} = time;
            $Con{$fh}->{contimeoutdebug} .= "read from client = $SMTPbuf" if $ConTimeOutDebug;
        } else {
            $Con{$Con{$fh}->{friend}}->{contimeoutdebug} .= "read from server = $SMTPbuf" if $ConTimeOutDebug;
        }
        if((my $sb=$Con{$fh}->{skipbytes})>0) {

           # support for XEXCH50 thankyou Microsoft for making my life miserable
            my $l=length($SMTPbuf);
            d("skipbytes=$sb l=$l -> ");
            if($l >= $sb) {
                sendque($Con{$fh}->{friend},substr($SMTPbuf,0,$sb)); # send the binary chunk on to the server
                $SMTPbuf=substr($SMTPbuf,$sb);
                delete $Con{$fh}->{skipbytes};
            } else {
                sendque($Con{$fh}->{friend},$SMTPbuf); # send the binary chunk on to the server
                $Con{$fh}->{skipbytes}=$sb-=length($SMTPbuf);
                $SMTPbuf='';
            }
            d("skipbytes=$Con{$fh}->{skipbytes}");
        }
        d('SMTPTraffic - process read');
        my $bn= my $lbn=-1;
        if ($Con{$fh}->{type} ne 'C' or               # process line per line
            $Con{$fh}->{getline} ne \&whitebody or
            $SMTPbuf =~ /^\.(?:\x0D?\x0A)?$/o  or
            $SMTPbuf =~ /\x0D?\x0A\.\x0D?\x0A$/o)
        {
            while (($bn=index($SMTPbuf,"\n",$bn+1)) >= 0) {
                my $s=substr($SMTPbuf,$lbn+1,$bn-$lbn);
                if(defined($Con{$fh}->{bdata})) { $Con{$fh}->{bdata}-=length($s); }
                d("doing line <$s>");

                if ($Con{$fh}->{type} eq 'C') {
                    $Con{$fh}->{headerpassed} ||= $s =~ /^\x0D?\x0A/o; #header passed? if header and body in one junk
                }

                if ($Con{$fh}->{type} eq 'C' &&
                    ! $Con{$fh}->{headerpassed} &&
                    ! $Con{$fh}->{relayok})
                {
                    if ($preHeaderRe && $s =~ /($preHeaderReRE)/i) {
                        $Con{$fh}->{prepend} = '[preHeaderRE][block]';
                        mlog($fh,"early (pre)header line check found ".($1||$2));
                        NoLoopSyswrite($Con{$fh}->{friend}, "421 $myName Service not available, closing transmission channel\r\n",0) if $Con{$fh}->{friend};
                        done($fh);
                        $Stats{preHeader}++;
                        return;
                    }
                    if ($s =~ /^(X-ASSP-[^(]+?)(\(\d+\))?(:$HeaderValueRe)$/io) {  # change strange X-ASSP headers
                        my ($pre,$c,$post) = ($1,$2,$3);
                        $c =~ s/[^\d]//go;
                        $c = 0 unless $c;
                        $s = $pre . '(' . ++$c . ')' . $post;
                        $Con{$fh}->{nodkim} = 1;     # we have modified the header and should skip the DKIM check for this reason
                    }
                }
                Maillog($fh,$s) if $Con{$fh}->{maillog};
                if (! $Con{$fh}->{getline}) {
                   my $lastcmd = "\'$Con{$fh}->{lastcmd}\'";
                   $lastcmd = "\'n/a\'" unless $Con{$fh}->{lastcmd};
                   mlog($fh,'error: missing $Con{$fh}->{getline} in sub SMTPTraffic (1) - last command was '.$lastcmd);
                   done($fh);
                   return;
                }
                $Con{$fh}->{getline}->($fh,$s);
                last if((exists $ConDelete{$fh} && $ConDelete{$fh}) || ! exists $Con{$fh} || $Con{$fh}->{closeafterwrite});  # it's possible that the connection can be deleted while there's still something in the buffer
                if(($Con{$fh}->{inerror} || $Con{$fh}->{intemperror}) && $Con{$fh}->{cleanSMTPBuff}) { # 4/5xx from MTA after DATA
                    $Con{$fh}->{_} = $Con{$fh}->{header} = ''; # clean the SMTP buffer
                    delete $Con{$fh}->{cleanSMTPBuff};
                    mlog($fh,"info: SMTP buffer was cleaned after MTA has sent an error reply in DATA part") if $ConnectionLog;
                    last;
                }
                $lbn=$bn;
            }
        } else {         # process the complete buf in one junk
            $Con{$fh}->{_} = '';
            $Con{$fh}->{headerpassed} = 1;
            if(defined($Con{$fh}->{bdata})) { $Con{$fh}->{bdata}-=length($SMTPbuf); }
            if (! $Con{$fh}->{getline}) {
               my $lastcmd = "\'$Con{$fh}->{lastcmd}\'";
               $lastcmd = "\'n/a\'" unless $Con{$fh}->{lastcmd};
               mlog($fh,'error: missing $Con{$fh}->{getline} in sub SMTPTraffic (2) - last command was '.$lastcmd);
               done($fh);
               return;
            }
            d("doing full <$SMTPbuf>");
            Maillog($fh,$SMTPbuf) if $Con{$fh}->{maillog};
            $Con{$fh}->{getline}->($fh,$SMTPbuf);
            &NewSMTPConCall();
            return;
        }
        if(exists $Con{$fh} && ! exists $ConDelete{$fh} && ! $Con{$fh}->{closeafterwrite}) { # finish the mail as fast as possible
            ($Con{$fh}->{_})=substr($SMTPbuf,$lbn+1);
            if(length($Con{$fh}->{_}) > $MaxBytes) {
                d('SMTPTraffic - process rest');
                $Con{$fh}->{headerpassed} = 1;
                if(defined($Con{$fh}->{bdata})) { $Con{$fh}->{bdata}-=length($Con{$fh}->{_}); }
                Maillog($fh,$Con{$fh}->{_}) if $Con{$fh}->{maillog};
                if (! $Con{$fh}->{getline}) {
                   my $lastcmd = "\'$Con{$fh}->{lastcmd}\'";
                   $lastcmd = "\'n/a\'" unless $Con{$fh}->{lastcmd};
                   mlog($fh,'error: missing $Con{$fh}->{getline} in sub SMTPTraffic (3) - last command was '.$lastcmd);
                   done($fh);
                   return;
                }
                $Con{$fh}->{getline}->($fh,$Con{$fh}->{_});
                $Con{$fh}->{_} = '';
            }
        }
    } elsif ($hasread == 0) {
        my $error = $!;
        if ($error =~ /Resource temporarily unavailable/io) {
            d("SMTPTraffic - no more data - $error");
            return ;
        }
        if ($pending) {
            d("SMTPTraffic - got no more (SSL) data but $pending Byte are pending - $error");
            $pending = " (SSL pending = $pending)";
        } else {
            d("SMTPTraffic - no more data - $error");
            $pending = '';
        }
        eval {$ip = $fh->peerhost() . ':' . $fh->peerport();} unless $ip;
        my $lastcmd = "- last command was \'$Con{$fh}->{lastcmd}\'";
        $lastcmd = '' unless $Con{$fh}->{lastcmd};
        mlog($fh,"info: no (more) data$pending readable from $ip (connection closed by peer) - $! $lastcmd") if ($error && ($ConnectionLog or $pending));
        mlog($fh,"info: no (more) data$pending readable from $ip (connection closed by peer) $lastcmd") if (($ConnectionLog >= 2 or $pending) && ! $error);
        done2($fh);
    } else {
        my $error = $!;
        if ($pending) {
            d("SMTPTraffic - got no more (SSL) data but $pending Byte are pending - $error");
            $pending = " (SSL pending = $pending)";
        } else {
            d("SMTPTraffic - no more data - $error");
            $pending = '';
        }
        eval {$ip = $fh->peerhost() . ':' . $fh->peerport();} unless $ip;
        my $lastcmd = "- last command was \'$Con{$fh}->{lastcmd}\'";
        $lastcmd = '' unless $Con{$fh}->{lastcmd};
        mlog($fh,"error: reading from socket $ip$pending - $error $lastcmd") if ($error);
        done2($fh);
    }
    &NewSMTPConCall();
}

sub SMTPTimeOut {
    my $sfh = shift;
    if ($smtpIdleTimeout > 0 || $smtpNOOPIdleTimeout > 0){
        if (scalar keys %Con > 0){
            my $tmpNow = time;
            # Check timeouts only every 15 seconds at least
            if ($tmpNow > ($lastTimeoutCheck + 15)){
                while (my ($tmpfh,$v) = each %Con){
                    next if("$tmpfh" eq "$sfh");
                    delete $Con{$tmpfh}->{doNotTimeout} if ($tmpNow - $Con{$tmpfh}->{doNotTimeout} > $NpWlTimeOut);
                    if ($Con{$tmpfh}->{type} =~ /CC?/o &&
                        $Con{$tmpfh}->{timelast} > 0 &&
                        ! $Con{$tmpfh}->{movedtossl} &&
                        ! $Con{$tmpfh}->{doNotTimeout} &&
                        ! (($Con{$tmpfh}->{noprocessing} || $Con{$tmpfh}->{whitelisted}) && $tmpNow - $Con{$tmpfh}->{timelast} < $NpWlTimeOut) &&   # 20 minutes for realy large queued mails
                        (($smtpIdleTimeout && $tmpNow - $Con{$tmpfh}->{timelast} > $smtpIdleTimeout) ||
                          (uc($Con{$tmpfh}->{lastcmd}) =~ /NOOP/o &&
                          $smtpNOOPIdleTimeout &&
                          $tmpNow - $Con{$tmpfh}->{timelast} > $smtpNOOPIdleTimeout) ||
                          ($smtpNOOPIdleTimeout &&
                          $smtpNOOPIdleTimeoutCount &&
                          $Con{$tmpfh}->{NOOPcount} >= $smtpNOOPIdleTimeoutCount))
                        )
                    {
                        if ($ConTimeOutDebug) {
                           my $m = &timestring();
                           $Con{$tmpfh}->{contimeoutdebug} .= "$m client Timeout after $smtpIdleTimeout secs\r\n" if $ConTimeOutDebug;
                           my $check = "$m client was not readable\r\n";
                           my @handles = $readable->handles();
                           while (@handles) {
                              $_ = shift @handles;
                              $check = "$m client was readable\r\n" if ($tmpfh eq $_);
                           }
                           $Con{$tmpfh}->{contimeoutdebug} .= $check;
                           $check = "$m client was not writable\r\n";
                           @handles = $writable->handles();
                           while (@handles) {
                              $_ = shift @handles;
                              $check = "$m client was writable\r\n" if ($tmpfh eq $_);
                           }
                           $Con{$tmpfh}->{contimeoutdebug} .= $check;
                           $m=time;
                           my $f = "$base/debug/$m.txt";
                           my $CTOD;
                           open $CTOD,'>',"$f" or mlog(0,"error: unable to open connection timeout debug log [$f] : $!");
                           binmode $CTOD;
                           print $CTOD  $Con{$tmpfh}->{contimeoutdebug};
                           close $CTOD;
                        }
                        $Con{$tmpfh}->{prepend}='';
                        $Con{$tmpfh}->{timestart} = 0;
                        my $type;
                        my $addPB = 0;
                        if ($Con{$tmpfh}->{oldfh} && $Con{$tmpfh}->{ip}) {
                            setSSLfailed($Con{$tmpfh}->{ip});
                            $type = 'TLS-';
                            $Stats{smtpConnTLSIdleTimeout}++;
                        } elsif ("$tmpfh" =~/SSL/io && $Con{$tmpfh}->{ip}) {
                            $type = 'SSL-';
                            $Stats{smtpConnSSLIdleTimeout}++;
                        } else {
                            $addPB = 1;
                            $Stats{smtpConnIdleTimeout}++;
                        }
                        if ($Con{$tmpfh}->{damping}) {
                            $Con{$tmpfh}->{messagescore} = 0;
                            delete $ConDelete{$tmpfh};
                            $addPB = 0;
                        }
                        if ( ! $Con{$tmpfh}->{timedout} ) {
                            pbAdd( $tmpfh,$Con{$tmpfh}->{ip}, 'idleValencePB', "TimeOut",2 ) if $addPB;
                            mlog($tmpfh,$type."Connection idle for $smtpIdleTimeout secs - timeout",1) if $SessionLog;
                        } else {
                            done($Con{$tmpfh}->{client});
                            next;
                        }
                        $Con{$tmpfh}->{timedout} = 1;
                        if ($Con{$tmpfh}->{getline} != \&error) {
                            seterror($Con{$tmpfh}->{client},"451 Connection timeout, try later\r\n",1);
                        } else {
                            if (! $Con{$tmpfh}->{closeafterwrite}) {
                                sendque($Con{$tmpfh}->{client},"451 Connection timeout, try later\r\n");
                                $Con{$tmpfh}->{closeafterwrite} = 1;
                                unpoll($Con{$tmpfh}->{client}, $readable);
                            } else {
                                done($Con{$tmpfh}->{client});
                            }
                        }
                    }
                }
                $lastTimeoutCheck = $tmpNow;
            }
        }
    }
}

sub loadexportedRE {
    my $name = shift;
    return 0 if $WorkerNumber == 0;
    $name =~ s/[\^\s\<\>\?\"\'\:\|\\\/\*\&\.]/_/igo;  # remove not allowed characters from file name
    $name =~ s/\_+/_/go;
    return 0 if (! $name);
    return 0 unless exists $availOptRE{$name};
    (open my $optRE, '<',"$base/files/optRE/$name.txt") or return 0;
    binmode $optRE;
    my $re = join('',<$optRE>);
    close $optRE;
    if (exists $CryptFile{"$base/files/optRE/$name.txt"} && $re =~ /^(?:[a-zA-Z0-9]{2})+$/o) {
        $re = ASSP::CRYPT->new($webAdminPassword,0)->DECRYPT($re);
    }
    return $re;
}

sub exportOptRE {
    my ($ree, $name ) = @_;
    return unless $WorkerNumber == 0;
    my $re = $$ree;
    $name =~ s/[\^\s\<\>\?\"\'\:\|\\\/\*\&\.]/_/igo;  # remove not allowed characters from file name
    $name =~ s/\_+/_/go;
    return if (! $re || ! $name);
    -d "$base/files/optRE" or mkdir "$base/files/optRE", 0755;
    my $optRE;
    if (open $optRE, '>',"$base/files/optRE/$name.txt") {
        binmode $optRE;
        if (exists $cryptConfigVars{$name}) {
            print $optRE ASSP::CRYPT->new($webAdminPassword,0)->ENCRYPT($re);
            $CryptFile{"$base/files/optRE/$name.txt"} = 1;
        } else {
            print $optRE $re;
        }
        $availOptRE{$name} = 1 if close $optRE;
    } else {
        mlog(0,"error: unable to open $base/files/optRE/$name.txt for writing - $!");
        delete $availOptRE{$name};
    }
    return;
}

sub SetRE {
 use re 'eval';
 my ($var,$r,$f,$desc,$name,$noerror)=@_;
 return if (! $var);
 $name ||= $desc;

 my $noOptimize = 0;
 my $optimSX = ($f =~ s/-optimsx$//o) ? 1 : 0;
 if (exists $noOptRe{$var}) {
     if ($noOptRe{$var} == 0) {
         $noOptimize = 1;
     } elsif ($noOptRe{$var} == 1) {
         $optimSX = 0;
     } else {
         $optimSX = 1;
     }
 }
 my $how = ($optReModule eq 'Regex::Optimizer') ? ($optimSX ? 'strong ' : 'enhanced ') : '';
 $how = 'default ' if ($optReModule eq 'Regexp::Optimizer');
 $desc =~ s/[ *]*$//o;
 $desc =~ s/\<[a-zA-Z0-9]+ .*?\<\/[a-zA-Z0-9]+\>//gio;
 mlog(0,"ERROR: regex variable $var not defined for - '$name <$desc>' - please report")
     if(! defined($$var) && $WorkerNumber == 0);

 if (($CanUseRegexOptimizer || $CanUseRegexpOptimizer) &&
     ! $noOptimize &&
     $r !~ /$neverMatchRE/o &&      # the regex that never matches
     $r =~ /[^\\]\|/so &&                     # no | in regex
     $r !~ s/a(?:ssp)?\\?-do?\\?-n(?:ot)?\\?-o(?:ptimize)?\\?-r(?:egex)?\|?//iso &&  # the special word
     $r !~ /\Q$complexREStart\E/o )           # the complex AND NOT
 {
     my $lenBefore = length($r) + length($f) + 4 + 9;      # (?-xims:(?$f:......))
     if ($WorkerName eq 'startup' && $MaintenanceLog >= 2) {
        print $how . "optimizing regex for $name";
        print ' ' x (35 - length($name) - length($how));
     }
     eval{
         my $loadRE;
         if (($WorkerNumber != 0) && ($loadRE = &loadexportedRE($name))) {
             $loadRE =~ s/\)$//o if $loadRE =~ s/^\(\?(?:[xims\-\^]*)?\://o;
             $$var = qr/$loadRE/;
         } else {
             my $o = $optReModule->new;
             $o->set(optim_sx => $optimSX);
#             $o->set(debug => $debug);
             my @noOpt;
             if ($optReModule eq 'Regexp::Optimizer' && $r =~ /\<\<\<(.*?)\>\>\>/o) { # Regexp::Optimizer is unable to skip optim - so we have to do this
                 while ($r =~ s/\<\<\<(.*?)\>\>\>\|?//o) {
                     push @noOpt, $1;
                 }
                 my ($pre,$post) = $r =~ m{^(\^?).*(\$?)$}o;
                 $r =~ s/^\^?\$?$//;
                 my $noOpt;
                 $$var = '';
                 if (@noOpt) {
                     $noOpt = $pre . join('|',@noOpt) . $post;
                     $$var = qr/(?$f:$noOpt)/;
                     $$var .= '|' if $r;
                 }
                 $$var .= $o->optimize(qr/(?$f:$r)/) if $r;
                 $$var = qr/$$var/ if @noOpt && $r;
             } else {
                 $$var = $o->optimize(qr/(?$f:$r)/);
             }
         }
     };
     if ($@) {
         $RegexError{$name} = 'regex optimization failed - unoptimized regex is used' if $WorkerNumber == 0;
         mlog(0,"warning: ".$how."regex optimization failed for '$name - <$desc>' - $@ - try using unoptimized regex") if $WorkerNumber == 0;
         if ($WorkerName eq 'startup' && $MaintenanceLog >= 2) {
             print "[FAILED]\n";
         }
         eval{
             $r =~ s/a(?:ssp)?\\?-do?\\?-n(?:ot)?\\?-o(?:ptimize)?\\?-r(?:egex)?\|?//igos;   # the special word
             $r =~ s/\<\<\<(.*?)\>\>\>/$1/go;   # a single line that should not be optimized
             $$var=qr/(?$f:$r)/;
         };
     } else {
         my $lenAfter = length $$var;
         mlog(0,"info: ".$how."optimized regex for '$name <$desc>' - length in byte before: $lenBefore - after: $lenAfter") if $MaintenanceLog >= 2 && $WorkerNumber == 0;
         if ($WorkerNumber == 0 && $MaintenanceLog >= 2) {
             print "[OK]\n" if $WorkerName eq 'startup';
         }
     }
 } else {
     eval{
         $r =~ s/a(?:ssp)?\\?-do?\\?-n(?:ot)?\\?-o(?:ptimize)?\\?-r(?:egex)?\|?//igso;  # a-d-n-o-r
         $r =~ s/\<\<\<(.*?)\>\>\>/$1/go;      # a single line that should not be optimized

         # '?|' = alternativ gouping capture starting every time by $1
         # only available in 5.10 or above  and needed for complexRE
         # but buggy in 5.10 ([RT #59734]) - fixed in 5.12
         # so it is only used if complexRE is defined
         $$var = ($r !~ /\Q$complexREStart\E/o) ? qr/(?$f:$r)/ : qr/(?$f:(?|$r))/;
     };
 }
 if ($@) {
     $RegexError{$name} = 'error in regular expression' if $WorkerNumber == 0;
     mlog(0,"regular expression error in '$r' for '$name <$desc>': $@") unless $noerror;
     $r = $neverMatch; # regexp that never matches
     $$var=qr/(?$f:$r)/;
     return 0;
 } else {
     delete $RegexError{$name} if $WorkerNumber == 0;
     exportOptRE($var,$name) if ($WorkerNumber == 0);
 }
 return 1;
}

sub isOk2Relay {
  my ($fh,$ip)=@_;
  return 1 if ($Con{$fh}->{acceptall} = matchIP($ip,'acceptAllMail',$fh,0));
  return 1 if $PopB4SMTPFile && PopB4SMTP($ip);
# failed all tests -- return 0
  return 0;
}

sub POP3Collect {
    return 0 unless $allowPOP3;
    return 0 unless $POP3Interval;
    return 0 unless -e "$base/assp_pop3.pl";

    return 0 if $POP3ConfigFile !~ /^ *file: *.+/io;
    d('POP3 - collect');

    my $perl = $perl;
    my $cmd = "\"$perl\" \"$base/assp_pop3.pl\" \"$base\" 2>&1";
    $cmd =~ s/\//\\/go if $^O eq "MSWin32";
    my $out = qx($cmd);

    foreach (split(/\n/o,$out)) {
        s/\r|\n//go;
        mlog(0,$_) if $MaintenanceLog;
    }
    return 1;
}

sub PopB4SMTP {
    my $ip=shift;
    if($PopB4SMTPMerak) {
        return 1 if PopB4Merak($ip);
        return 0;
    }
    return 0 unless $PopB4SMTPFile;

    my %hash;

    eval {
    # tie %hash, 'DB_File', $PopB4SMTPFile, O_READ, 0400, $DB_HASH;
    tie %hash, 'DB_File', $PopB4SMTPFile;
    if($hash{$ip}) {
        mlog(0,"PopB4SMTP OK for $ip");
        return 1;
    } else {
        mlog(0,"PopB4SMTP failed for $ip");
        return 0;
    }
    };
}

sub PopB4Merak {
  return 0 unless $PopB4SMTPFile;
  my $ip=shift;
#This is a test version of ASSP PopB4SMTP
#This is to be used with Merak 7.5.2
#It also works with Merak 6.5 (which I run)
#Thanks to Jordon for the heads up on 7.5.2
#Basically, Merak's popsmtp file
#is made up of 64 Byte lines, no CR / LF.
#This holds the IP addy
#and the byte before it specifying the length.

  my $PB4S;
  my $ind;
  my $newIP;

#Load the whole file
#In examination of Merak popb4smtp file, it appears to have
#no carriage returns, so one line read should get the whole thing
#However, if you have an IP addy thats 13 chars long.... thus:

  $open->(my $MKPOPSMTP,'<',$PopB4SMTPFile) or return 0 ;
  $MKPOPSMTP->read($PB4S,[$stat->($PopB4SMTPFile)]->[7]);
  $MKPOPSMTP->close;
#We now have all the contents of the file AND we've released it

#Now, instead of heavy parsing....
#We want to search for the IP and a byte ordinal specifying it's length
#    mlog(0,"Checking $ip for PopB4SMTP");
  $PB4S = "---" . $PB4S;
#    mlog(0,"Searching: $PB4S");
  $newIP = chr(length($ip)) . $ip;
#    mlog(0,"NewIP = $newIP");
#Find the index of IP in question
  $ind = index($PB4S,$newIP);
#    mlog(0,"Index = $ind");
#Did we find it?
  if ($ind  > 0) {
    mlog(0,"PopB4SMTP OK for $ip");
    return 1;
  }
  mlog(0,"PopB4SMTP NOT OK for $ip");
  return 0;
}

sub NoLoopSyswrite {
    my ($fh,$out,$timeout) = @_;
    d('NoLoopSyswrite');
    return 0 unless fileno($fh);
    return 0 unless $out;
    $timeout ||= 30;
    my $written = 0;
    my $ip;
    my $port;
    my $error;
    eval{
      $ip=$fh->peerhost();
      $port=$fh->peerport();
    };
    if($@) {$! = $@; return 0;};
    d("NoLoopSyswrite - write($timeout $fh): '" . substr($out,0,30) . '\' - ' . length($out));
    &sigoffTry(__LINE__);
    
    if (   exists $Con{$fh}
        && $Con{$fh}->{type} eq 'C'       # is a client SMTP connection?
        && ($replyLogging == 2 or ($replyLogging == 1 && $out =~ /^[45]/o))
        && $out =~ /^(?:[1-5]\d\d\s+[^\r\n]+\r\n)+$/o)    # is a reply?
    {
        $out =~ s/SESSIONID/$Con{$fh}->{msgtime} $Con{$fh}->{SessionID}/go;
        $out =~ s/MYNAME/$myName/go;
        my @reply = split(/(?:\r?\n)+/o,$out);
        for (@reply) {
            next unless $_;
            my $what = 'Reply';
            if ($_ =~ /^([45])/o) {
                $what = ($1 == 5) ? 'Error' : 'Status';
            }
            mlog( $fh, "[SMTP $what] $_", 1, 1 );
        }
    }

    my $stime = Time::HiRes::time() + $timeout;
    my $wtime = Time::HiRes::time() + 1;
    my $NLwritable;
    if ($IOEngineRun == 0) {
        $NLwritable = IO::Poll->new();
    } else {
        $NLwritable = IO::Select->new();
    }
    &dopoll($fh,$NLwritable,POLLOUT);
    my $l = length($out);
    my $allwritten = 0;
    while (length($out) > 0 && fileno($fh) && Time::HiRes::time() < $stime) {
        my @canwrite;
        my $st = Time::HiRes::time();
        if ($IOEngineRun == 0) {
            $NLwritable->poll(1);
            @canwrite = $NLwritable->handles(POLLOUT);
        } else {
            @canwrite = $NLwritable->can_write(1);
        }
        my $polltime = Time::HiRes::time() - $st;
        $ThreadIdleTime{$WorkerNumber} += $polltime;
        mlog(0,"warning: the operating system socket poll cycle has taken $polltime seconds in NoLoopSyswrite - this is very much is too long")
            if ($ConnectionLog >= 2 and $polltime > 3);
        $written = 0;
        $error = 0;
        eval{$written = $fh->syswrite($out,length($out));
             $error = $!;
             $error = '' if ("$fh" =~ /SSL/io && ($IO::Socket::SSL::SSL_ERROR == eval('SSL_WANT_READ') ? 1 : $IO::Socket::SSL::SSL_ERROR == eval('SSL_WANT_WRITE') ) );
        } if @canwrite or "$fh" =~ /SSL/io;
        $allwritten += $written;
        if (@canwrite && ! $written && ($@ or $error)) {
            mlog(0,"warning: unable to write to socket $ip:$port $error") if $ConnectionLog == 3 && $error;
            mlog(0,"warning: unable to write to socket $ip:$port $@") if $ConnectionLog == 3 && $@;
            $! = $error;
            unpoll($fh,$NLwritable);
            &sigonTry(__LINE__);
            return 0;
        }
        if ($written) {
            $out = substr($out,$written);
            $Con{$fh}->{lastwritten} = time if exists $Con{$fh};
        }
        if ($WorkerNumber == 0 && $timeout > 1 && $wtime < Time::HiRes::time()) {
            &mlogWrite;
            $wtime = Time::HiRes::time() + 1;
        }
        if ($WorkerNumber == 10000 && ! $isRunTMM2 && length($out) && time % 2) {
            my $tt = Time::HiRes::time();
            ThreadMaintMain2();
            $stime += Time::HiRes::time() - $tt;
        }
    }
    d("NoLoopSyswrite - wrote: $allwritten to $fh");
    unpoll($fh,$NLwritable);
    if (time >= $stime) {
        mlog(0,"warning: timeout (30s) writing to socket $ip:$port") if $ConnectionLog == 3;
    }
    &sigonTry(__LINE__);
    return 1;
}

sub SNMPStats {
    my ($subOID_cs,$subOID_cts,$subOID_ct,$subOID_ctt,$subOID_css,$subOID_ctss) = @_;
    my %subh = (
                'currentstat'     => $subOID_cs,
                'cumulativestat'  => $subOID_cts,
                'currenttotal'    => $subOID_ct,
                'cumulativetotal' => $subOID_ctt,
                'currentscorestat'     => $subOID_css,
                'cumulativescorestat'  => $subOID_ctss
    );
    my $str = &ConfigStatsXml();
    my %st;
    while ($str =~ /<stat +name='(.+?)' type='(.+?)'>(.*?)<\/stat>/gso) {
        $st{$1}{$subh{$2}}=$3 if $subh{$2};
    }
    delete $st{memusage};
    my $i = 0;
    my $highOID;

    my $l;
    foreach my $k (keys %st) {
        $l = length($k) if $l < length($k);
    }

    foreach my $name (sort {(' ' x ($l - length($main::a)).$main::a) cmp (' ' x ($l - length($main::b)).$main::b)} keys %st) {
        foreach my $soid (sort {lc($main::a) cmp lc{$main::b}} keys %{$st{$name}}) {
            my $value = ${$st{$name}}{$soid};
            $value = 0 unless $value;
            $subOID{"$soid.$i.0"} = $value;
            my $li='.0';
            my $n = $name;
            $n = "mailCount" if $name eq 'Counter';
            if ($CreateMIB) {
                $subOID{"$soid.$i.1"} = $n;
                $li = '.1';
                if ($subOID_cs && exists $StatText{$name}) {
                    $subOID{"$soid.$i.2"} = $StatText{$name};
                    $li = '.2';
                }
                if ($subOID_css && exists $ScoreStatText{$name}) {
                    $subOID{"$soid.$i.2"} = $ScoreStatText{$name};
                    $li = '.2';
                }
            }
            $highOID = "$soid.$i$li" if NetSNMP::OID->new($SNMPBaseOID.$highOID) < NetSNMP::OID->new("$SNMPBaseOID$soid.$i$li");
        }
        $i++;
    }
    mlog(0,"info: SNMP read Stats") if $SNMPLog == 3;
    return $highOID;
}

sub SNMPcleanHTML {
     my $str = shift;
     $str =~ s/<table.+?<\/table>//go;
     $str =~ s/<div.*?<\/div>//go;
     $str =~ s/<\/?(?:hr|br)[^>]*>//go;
     $str =~ s/<a +href.*?<\/a>//go;
     $str =~ s/<\/?span[^>]*>//go;
     $str =~ s/<input[^>]+>//go;
     $str =~ s/<\/?img[^>]+>//go;
     $str =~ s/<\/?(?:i|b|small|p)>//go;
     $str =~ s/<\/?font[^>]*>//o;
     return $str;
}

sub SNMPVarType {
    my ($var,$sid,$asText) = @_;
    my $boolean = ($sid=~/^\.?1/o) ? $SNMPreturnBOOL : 'ASN_COUNTER';
#    my $ipaddr = ($sid=~/^\.?2/o) ? 'ASN_OCTET_STR' : 'ASN_IPADDRESS';
#    $$var =~ /^\d{1,3}\.\d{1,3}\.\d{1,3}\.\d{1,3}$/o and return $asText ? $ipaddr : $SNMPAS{$ipaddr};
    $$var =~ /^(?:0|1)$/o and return $asText ? $boolean : $SNMPAS{$boolean};
    $$var =~ /[^\d.]/o and return $asText ? 'ASN_OCTET_STR' : $SNMPAS{ASN_OCTET_STR};
    $$var =~ /\.[^.]*\./o and return $asText ? 'ASN_OCTET_STR' : $SNMPAS{ASN_OCTET_STR};
#    $$var =~ /\./o and return $asText ? 'ASN_FLOAT' : $SNMPAS{ASN_FLOAT};
    $$var =~ /^\d+$/o and return $asText ? 'ASN_COUNTER' : $SNMPAS{ASN_COUNTER};
    return $asText ? 'ASN_OCTET_STR' : $SNMPAS{ASN_OCTET_STR};
}

sub SNMPgetUsers {
    my $users = 'root:root';
    foreach my $k (sort keys %AdminUsers) {
        next if $k =~ /^[~#]/o;
        $users .= "|$k:$k";
    }
    return $users;
}

sub SNMPderefVal {
    my $val = shift;
    return $val unless ref $val;
    return $$val if $val =~ /SCALAR/o;
    my @vars = @{$val};
    my $call = shift @vars;
    foreach (@vars) {
       $_ = SNMPderefVal($_);
    }
    return $call->(@vars);
}

sub SNMPload_1_0 {
    return ( $_[0] ) ? $_[1] : $_[2];
}
sub SNMPload_1_0_healthy {
    return (&StatusASSP() !~ /not healthy/io);
}
sub SNMPload_1_13 {
    my $ret;
    while (my ($k,$v) = each %RunTaskNow) {
        next unless $k && $v;
        $ret .= "$v ";
    }
    return $ret;
}
sub SNMPload_1_14 {
   return memoryUsage() || 0;
}
sub SNMPload_1_30 {
    my %status = &WorkerStatus();
    foreach (keys %status) {
        if ($_ < 10000) {
            $subOID{'.1.30.'.$_.'.0'} = ($status{$_}{lastloop} < 180) ? 1 : 0;
        } else {
            $subOID{'.1.30.'.$_.'.0'} = $ComWorker{$_}->{run};
        }
        $subOID{'.1.30.'.$_.'.1.0'} = $status{$_}{lastloop};
        $subOID{'.1.30.'.$_.'.2.0'} = $status{$_}{lastaction};
    }
    mlog(0,"info: SNMP read worker status OIDs .1.30.1 - 1.30.10001.2") if $SNMPLog == 3;
    $subOIDLastLoad{'1.30'} = Time::HiRes::time() - 1;
}
sub SNMPload_1_31 {
    my $tmpCount = 0;
    my $dbOK = 1;
    foreach my $s (keys %failedTable) {
        $dbOK = 0 if $failedTable{$s} > 1;
        $tmpCount++;
        $subOID{'.1.31.'.$tmpCount.'.0'} = ($failedTable{$s} > 1) ? 0 : 1;
        $subOID{'.1.31.'.$tmpCount.'.1.0'} = $s;
    }
    if (!$dbOK) {
         $subOID{'.1.31.0.0'} = 0;
         $subOID{'.1.31.0.1.0'} = 'failed database table(s)';
    } else {
         $subOID{'.1.31.0.0'} = 1;
         $subOID{'.1.31.0.1.0'} = 'database OK';
    }
    mlog(0,"info: SNMP read database status OIDs .1.31.0 - .1.31.$tmpCount") if $SNMPLog == 3;
    $subOIDLastLoad{'1.31'} = Time::HiRes::time() - 1;
}
sub SNMPload_1_32 {
    my @regerr = keys %RegexError;
    if (@regerr) {
        $subOID{'.1.32.0.0'} = 0;
        $subOID{'.1.32.0.1.0'} = "regex failed for: @regerr";
    } else {
        $subOID{'.1.32.0.0'} = 1;
        $subOID{'.1.32.0.1.0'} = 'all regular expressions are OK';
    }
    mlog(0,"info: SNMP read regular expression status OID .1.32.0") if $SNMPLog == 3;
    $subOIDLastLoad{'1.32'} = Time::HiRes::time() - 1;
}
sub SNMPload_2_X56 {
    my $i = shift;
    my $server = $ConfigSync{$ConfigArray[$i]->[0]}->{sync_server};
    my $msg = $ConfigArray[$i]->[0].':='.$ConfigSync{$ConfigArray[$i]->[0]}->{sync_cfg};
    while (my ($k,$v) = each %{$server}) {
        $msg .= ",$k=$v";
    }
    return $msg;
}
sub SNMPload_2_X56s {
    my $name = shift;

    return $ConfigSync{$name}->{sync_cfg} if ($ConfigSync{$name}->{sync_cfg} < 1);
    my $syncserver = $ConfigSync{$name}->{sync_server};
    my $res = 0;
    while (my ($k,$v) = each %{$syncserver}) {
        if ($v == 1) {
            $res = $v;
            last;
        }
        $res |= $v;
    }
    return $res;
}
sub SNMPload_1 {
    $subOID{'.1.0.0'} = [\&SNMPload_1_0,[\&SNMPload_1_0_healthy], 1, 0];
    $subOID{'.1.1.0'} = [\&SNMPload_1_0,[\&SNMPload_1_0_healthy], \$webStatHealthyResp, \$webStatNotHealthyResp];
    $subOID{'.1.2.0'} = [\&SNMPload_1_0,\$doShutdownForce, 0, 1];
    $subOID{'.1.3.0'} = [\&SNMPload_1_0,\$doShutdownForce, 'shutdown in progress', 'running'];
    $subOID{'.1.4.0'} = $MAINVERSION;
    $subOID{'.1.5.0'} = $assp;
    $subOID{'.1.6.0'} = $];
    $subOID{'.1.7.0'} = $perl;
    $subOID{'.1.8.0'} = $^O;
    $subOID{'.1.9.0'} = \$localhostname;
    $subOID{'.1.10.0'} = \$localhostip;
    $subOID{'.1.11.0'} = \$myName;
    $subOID{'.1.12.0'} = \$NewAsspURL;
    $subOID{'.1.13.0'} = [\&SNMPload_1_13];
    $subOID{'.1.14.0'} = [\&SNMPload_1_14];

    $subOID{'.1.20.1.0'} = [\&timestring,\$nextBDBsync,'',''];
    $subOID{'.1.20.2.0'} = [\&timestring,\$NextConfigReload,'',''];
    $subOID{'.1.20.3.0'} = [\&timestring,\$nextCleanBATVTag,'',''];
    $subOID{'.1.20.4.0'} = [\&timestring,\$nextCleanCache,'',''];
    $subOID{'.1.20.5.0'} = [\&timestring,\$nextCleanIPDom,'',''];
    $subOID{'.1.20.6.0'} = [\&timestring,\$nextCleanDelayDB,'',''];
    $subOID{'.1.20.7.0'} = [\&timestring,\$nextCleanPB,'',''];
    $subOID{'.1.20.8.0'} = [\&timestring,\$nextDBBackup,'',''];
    $subOID{'.1.20.9.0'} = [\&timestring,\$nextDBcheck,'',''];
    $subOID{'.1.20.10.0'} = [\&timestring,\$nextDNSCheck,'',''];
    $subOID{'.1.20.11.0'} = [\&timestring,\$nextdetectHourJob,'',''];
    $subOID{'.1.20.12.0'} = [\&timestring,\$nextExport,'',''];
    $subOID{'.1.20.13.0'} = [\&timestring,\$nextGlobalUploadBlack,'',''];
    $subOID{'.1.20.14.0'} = [\&timestring,\$nextGlobalUploadWhite,'',''];
    $subOID{'.1.20.15.0'} = [\&timestring,\$nextHashFileCheck,'',''];
    $subOID{'.1.20.16.0'} = [\&timestring,\$nextLDAPcrossCheck,'',''];
    $subOID{'.1.20.17.0'} = [\&timestring,\$nextRebuildSpamDB,'',''];
    $subOID{'.1.20.18.0'} = [\&timestring,\$nextResendMail,'',''];
    $subOID{'.1.20.19.0'} = [\&timestring,\$NextASSPFileDownload,'',''];
    $subOID{'.1.20.20.0'} = [\&timestring,\$NextVersionFileDownload,'',''];
    $subOID{'.1.20.21.0'} = [\&timestring,\$NextBackDNSFileDownload,'',''];
    $subOID{'.1.20.22.0'} = [\&timestring,\$NextCodeChangeCheck,'',''];
    $subOID{'.1.20.23.0'} = [\&timestring,\$NextDroplistDownload,'',''];
    $subOID{'.1.20.24.0'} = [\&timestring,\$NextGriplistDownload,'',''];
    $subOID{'.1.20.25.0'} = [\&timestring,\$NextPOP3Collect,'',''];
    $subOID{'.1.20.26.0'} = [\&timestring,\$NextSaveStats,'',''];
    $subOID{'.1.20.27.0'} = [\&timestring,\$NextTLDlistDownload,'',''];
    $subOID{'.1.20.28.0'} = [\&timestring,\$NextSyncConfig,'',''];
    $subOID{'.1.20.29.0'} = [\&timestring,\$NextGroupsReload,'',''];
    $subOID{'.1.20.30.0'} = [\&timestring,\$nextBlockReportSchedule,'',''];
    $subOID{'.1.20.31.0'} = [\&timestring,\$$nextFileAgeSchedule,'',''];
    $subOID{'.1.20.32.0'} = [\&timestring,\$nextQueueSchedule,'',''];
    $subOID{'.1.20.33.0'} = [\&timestring,\$nextMemoryUsageCheckSchedule,'',''];

    mlog(0,"info: SNMP read application OIDs .1.0 - .1.36") if $SNMPLog == 3;
    &SNMPload_1_30();
    &SNMPload_1_31();
    &SNMPload_1_32();
    $subOIDLastLoad{1} = 9999999999;
}
sub SNMPload_2 {
    %subOID2Conf = ();
    my $j = scalar @ConfigArray;
    my $i = 0; my $lastid; my $h = -1;
    $ActWebSess = 'SNMP';
    $WebIP{$ActWebSess}->{user} = $SNMPUser;
    for ($i = 0;$i < $j;$i++) {
        if (@{$ConfigArray[$i]} == 5 && $ConfigArray[$i]->[3] =~ /heading/io) {
            $h++;
            $subOID{'.2.'.$h.'.0'} = [\&SNMPcleanHTML,\$ConfigArray[$i]->[4]];
            next;
        }
        my ($id) = $ConfigArray[$i]->[10] =~ /msg(\d{6})/o;
        $id =~ s/^0+//o;
        $id =~ s/0$//o;
        next unless $id;
        my $canSNMPDo = &canUserDo($SNMPUser,'cfg',$ConfigArray[$i]->[0]);
        next if ($SNMPUser ne 'root' && !$canSNMPDo && $AdminUsersRight{"$SNMPUser.user.hidDisabled"});
        $subOID{'.2.'.$h.'.'.$id.'.0'} = (($SNMPUser ne 'root' && exists $cryptConfigVars{$ConfigArray[$i]->[0]}) ? 'encrypted (ro)' : \$Config{$ConfigArray[$i]->[0]});
        my $li = '.0';
        if ($CreateMIB) {
            $subOID{'.2.'.$h.'.'.$id.'.1'} = \$ConfigArray[$i]->[0];
            $subOID{'.2.'.$h.'.'.$id.'.2'} = [\&SNMPcleanHTML,\$ConfigArray[$i]->[4]];
            $subOID{'.2.'.$h.'.'.$id.'.3'} = [\&SNMPcleanHTML,\$ConfigArray[$i]->[1]];
            $subOID{'.2.'.$h.'.'.$id.'.4'} = [\&SNMPcleanHTML,\$ConfigArray[$i]->[7]];
            $li = '.4';
        }
        if (&syncCanSync() or $CreateMIB) {
            my $ss = $ConfigSync{$ConfigArray[$i]->[0]}->{sync_cfg};
            $ss = 0 unless $ss;
            if ($ss > -1) {
                $subOID{'.2.'.$h.'.'.$id.'.5.0'} = [\&SNMPload_2_X56s,\$ConfigArray[$i]->[0]];
                $subOID{'.2.'.$h.'.'.$id.'.6.0'} = [\&SNMPload_2_X56,$i];
                $li = '.6.0';
            }
        }
        if (($SNMPUser eq 'root' || ($canSNMPDo && ! exists $cryptConfigVars{$ConfigArray[$i]->[0]})) &&
             $ConfigArray[$i]->[3] ne \&passnoinput &&
             $ConfigArray[$i]->[3] ne \&textnoinput
        ) {
            $subOID2Conf{'.2.'.$h.'.'.$id.'.0'} = $i;
        }
        $lastid = '.2.'.$h.'.'.$id.$li;
    }
    mlog(0,"info: SNMP read configuration OIDs .2.0 - $lastid") if $SNMPLog == 3;
    $subOIDLastLoad{2} = 9999999999;
}
sub SNMPload_3 {
    my ($dummy,@modules) = &StatsGetModules();
    my $i = 0;
    while (@modules){
        my $m = shift @modules;
        $m->[1] =~ s/<\/?a[^>]*>//o;
        $m->[1] =~ s/<\/?font[^>]*>//o;
        $m->[2] =~ s/<\/?font[^>]*>//o;
        $m->[3] =~ s/<\/?font[^>]*>//o;
        $subOID{'.3.'.$i.'.0'} = $m->[0];
        for (my $j = 1;$j < 5;$j++) {
            $subOID{'.3.'.$i.'.'.$j.'.0'} = $m->[$j];
        }
        $i++;
    }
    $i--;
    mlog(0,"info: SNMP read perl module configuration OIDs .3.0.0 - 3.$i.4") if $SNMPLog == 3;
    $subOIDLastLoad{3} = 9999999999;
}
sub SNMPload_4 {
    my $maxsubOID = &SNMPStats('.4.1','.4.2','.4.3','.4.4',undef,undef);
    $maxsubOID    = &SNMPStats(undef,undef,undef,undef,'.4.5','.4.6') || $maxsubOID;
    my $baseOID = NetSNMP::OID->new($SNMPBaseOID);
    $maxOID = $baseOID . $maxsubOID;
    mlog(0,"info: SNMP read Stat OIDs .4.1.1.0 - $maxsubOID") if $SNMPLog == 3;
    $subOIDLastLoad{4} = Time::HiRes::time() - 1;
}
sub SNMPload_5 {
    if ($CreateMIB or $SNMPUser eq 'root' or &canUserDo($SNMPUser,'action','SNMPAPI')) {
         my $baseOID = NetSNMP::OID->new($SNMPBaseOID);
         $subOID{'.5.0.0'} = '' unless exists $subOID{'.5.0.0'};
         $subOID{'.5.1.0'} = \$lastSNMPAPIresult;
         $canSNMPAPI = 1;
         $maxOID = $baseOID . '.5.1.0';
         mlog(0,"info: SNMP registered API OIDs .5.0.0 - 5.1.0") if $SNMPLog == 3;
    }
    $subOIDLastLoad{5} = Time::HiRes::time() - 5;
}

sub SNMPhandler {
    my ($handler, $registration_info, $request_info, $requests) = @_;

    my $request;
    if ($handler eq 'init') {
        mlog(0,"info: initalized SNMP OIDs") if $SNMPLog > 1;
    } else {
        mlog(0,"info: got snmp request") if $SNMPLog > 1;
        $MainThreadLoopWait = 0;
    }
    my $baseOID = NetSNMP::OID->new($SNMPBaseOID);
    my $minsubOID = '.1.0.0';
    my $minOID = $baseOID . $minsubOID;
    my $minOIDn = $SNMPBaseOID . $minsubOID;
    my $bid = '.'.join('.',$baseOID->to_array());
    $canSNMPAPI = 0;

    if ($handler eq 'init' or scalar @sortedOIDs != scalar keys %subOID) {
        delete $qs{ResetAllStats};
        delete $qs{ResetStats};
        &ConfigStats();
        %subOID = (); keys %subOID = 9216;
        %subOIDn = (); keys %subOIDn = 9216;
        &SNMPload_1();
        &SNMPload_2();
        &SNMPload_3();
        &SNMPload_4();
        &SNMPload_5();

        @sortedOIDs =  map { $_->[0] }
                       sort { NetSNMP::OID::compare( $main::a->[1], $main::b->[1] ) }
                       map { [ $_, NetSNMP::OID->new($SNMPBaseOID.$_) ] } keys %subOID;

        my $j = scalar @sortedOIDs;
        for (my $i = 0;$i < $j;$i++) {
             $subOIDn{$sortedOIDs[$i]} = $i;
        }
        mlog(0,"info: SNMP registered $j OIDs from $minOID to $maxOID") if $SNMPLog;
        if ($CreateMIB) {
            my $mibSUB;
            my $mibFile;
            if (open $mibFile , '<',"$base/SNMPmakeMIB.pl") {
                binmode $mibFile;
                while (<$mibFile>) {
                    $mibSUB .= $_;
                }
                close $mibFile;
                eval($mibSUB);
                mlog(0,"info: MIB failed - $@") if $@;
            }
            $mibSUB = '';
            if (open $mibFile , '<',"$base/SNMPmakeMRTG.pl") {
                binmode $mibFile;
                while (<$mibFile>) {
                    $mibSUB .= $_;
                }
                close $mibFile;
                eval($mibSUB);
                mlog(0,"info: MRTG-cfg failed - $@") if $@;
            }
        }
        return if $handler eq 'init';
    }

    my $retval = 0;
    for($request = $requests; $request; $request = $request->next()) {
        $retval = 1;
        my $oid = $request->getOID();
        my $sid = '.'.join('.',(NetSNMP::OID->new($oid))->to_array());
        $sid =~ s/^\Q$bid\E//;
        my ($ts,$tl) = $sid =~ /^\.?((\d+)\.\d+)/o;
        $tl ||= 1;
        if ($ts eq '1.30' && $subOIDLastLoad{$ts} < Time::HiRes::time() - 2) {
            &SNMPload_1_30();
        } elsif ($ts eq '1.31' && $subOIDLastLoad{$ts} < Time::HiRes::time() - 2) {
            &SNMPload_1_31();
        } elsif ($ts eq '1.32' && $subOIDLastLoad{$ts} < Time::HiRes::time() - 2) {
            &SNMPload_1_32();
        } elsif ($subOIDLastLoad{$tl} < Time::HiRes::time() - 2) {
            &{"SNMPload_$tl"};
        }
        my $mode = $request_info->getMode();
        my $value;
        if (exists $subOID{$sid}) {
            $value = SNMPderefVal($subOID{$sid});
        }

        if ($mode == $SNMPag{MODE_GET}) {
            if (exists $subOID{$sid}) {
                $request->setValue(SNMPVarType(\$value,$sid,0), $value);
                mlog(0,"info: snmp read request for OID - $oid - $sid - MODE_GET") if $SNMPLog == 3;
            } else {
                $request->setError($request_info, $SNMPag{SNMP_ERR_NOSUCHNAME});
                mlog(0,"info: snmp read request for unknown OID - $oid - $sid - MODE_GET") if $SNMPLog == 3;
            }
            mlog(0,"info: snmp MODE_GET - $oid") if $SNMPLog == 2;

        } elsif ($mode == $SNMPag{MODE_GETNEXT}) {
            if ($oid < NetSNMP::OID->new($minOID)) {
                $request->setOID(NetSNMP::OID->new($minOIDn));
                $value = SNMPderefVal($subOID{$minsubOID});
                $request->setValue(SNMPVarType(\$value,$minsubOID,0), $value);
                mlog(0,"info: snmp read request for OID - $oid - sid - MODE_GETNEXT - returned first available OID ".$minOID) if $SNMPLog == 3;
            } elsif ($oid >= NetSNMP::OID->new($maxOID)) {
                $request->setError($request_info, $SNMPag{SNMP_ERR_NOSUCHNAME});
                mlog(0,"info: snmp read request for unknown OID - $oid - $sid - MODE_GETNEXT") if $SNMPLog == 3;
            } else {
                my $j = scalar @sortedOIDs;
                my $i = $subOIDn{$sid};
                $i ||= 0;
                for ( ;$i < $j;$i++) {
                    next if $oid > NetSNMP::OID->new($baseOID.$sortedOIDs[$i]);
                    $i++ if $oid == NetSNMP::OID->new($baseOID.$sortedOIDs[$i]);
                    $request->setOID(NetSNMP::OID->new($SNMPBaseOID.$sortedOIDs[$i]));
                    $value = SNMPderefVal($subOID{$sortedOIDs[$i]});
                    $request->setValue(SNMPVarType(\$value,$sortedOIDs[$i],0), $value);
                    mlog(0,"info: snmp read request for OID - ". NetSNMP::OID->new($SNMPBaseOID.$sortedOIDs[$i])." - MODE_GETNEXT") if $SNMPLog == 3;
                    last;
                }
            }
            mlog(0,"info: snmp MODE_GETNEXT - $oid") if $SNMPLog == 2;

        } elsif ($mode == $SNMPag{MODE_GETBULK}) {
            my $answers = 0;
            if ($oid >= NetSNMP::OID->new($maxOID)) {
                $request->setError($request_info, $SNMPag{SNMP_ERR_NOSUCHNAME});
                mlog(0,"info: snmp read request for unknown OID - $oid - $sid - MODE_GETBULK") if $SNMPLog == 3;
            } else {
                my $repeat = $request->getRepeat();
                if ($oid < NetSNMP::OID->new($minOID)) {
                    $request->setOID(NetSNMP::OID->new($minOIDn));
                    $value = SNMPderefVal($subOID{$minsubOID});
                    $request->setValue(SNMPVarType(\$value,$minsubOID,0), $value);
                    mlog(0,"info: snmp read request for OID - $oid - $sid - MODE_GETBULK - used first available OID ".$minOID) if $SNMPLog == 3;
                    $request->setRepeat(--$repeat);
                    $answers++;
                }
                if ($repeat) {
                    my $j = scalar @sortedOIDs;
                    my $i = $subOIDn{$sid};
                    $i ||= 0;
                    for ( ;$i < $j;$i++) {
                        next if $oid > NetSNMP::OID->new($baseOID.$sortedOIDs[$i]);
                        $i++ if $oid == NetSNMP::OID->new($baseOID.$sortedOIDs[$i]);
                        $request->setOID(NetSNMP::OID->new($SNMPBaseOID.$sortedOIDs[$i]));
                        $value = SNMPderefVal($subOID{$sortedOIDs[$i]});
                        $request->setValue(SNMPVarType(\$value,$sortedOIDs[$i],0), $value);
                        $request->setRepeat(--$repeat);
                        $answers++;
                        last unless $repeat;
                    }
                }
            }
            mlog(0,"info: snmp MODE_GETBULK - $oid - $sid - $answers repeats") if $SNMPLog >= 2;

        } elsif ($mode == $SNMPag{MODE_SET_RESERVE1}) {
            if ($canSNMPAPI && $sid eq '.5.0.0') {
                $request->setError($request_info, $SNMPag{SNMP_ERR_NOERROR});
                mlog(0,"info: snmp init SNMPAPI request for OID - $oid - $sid - MODE_SET_RESERVE1") if $SNMPLog == 3;
            } elsif ($SNMPwriteable && exists $subOID2Conf{$sid}) {
                my $getValue = $request->getValue();
                my $q;
                $q = $1 if $getValue =~ s/^([\"\'])//o;
                $getValue =~ s/\Q$q\E$//o if $q;
                my $valid = $ConfigArray[$subOID2Conf{$sid}]->[5];
                if ($getValue =~ /$valid/i) {
                    $request->setError($request_info, $SNMPag{SNMP_ERR_NOERROR});
                    mlog(0,"info: snmp init configuration change request for OID - $oid - $sid - MODE_SET_RESERVE1") if $SNMPLog == 3;
                } else {
                    $request->setError($request_info, $SNMPag{SNMP_ERR_WRONGVALUE});
                    mlog(0,"info: snmp configuration change request (MODE_SET_RESERVE1) failed for - ".$ConfigArray[$subOID2Conf{$sid}]->[0]." - invalid value - $getValue") if $SNMPLog;
                }
            } elsif (exists $subOID{$sid}) {
                $request->setError($request_info, $SNMPag{SNMP_ERR_READONLY});
                mlog(0,"info: snmp configuration change request for readonly OID - $oid - $sid - MODE_SET_RESERVE1") if $SNMPLog == 3;
            } else {
                $request->setError($request_info, $SNMPag{SNMP_ERR_NOSUCHNAME});
                mlog(0,"info: snmp change request for unknown OID - $oid - $sid - MODE_SET_RESERVE1") if $SNMPLog == 3;
            }
            mlog(0,"info: snmp MODE_SET_RESERVE1 - $oid") if $SNMPLog >= 2;

        } elsif ($mode == $SNMPag{MODE_SET_RESERVE2}) {
            if ($canSNMPAPI && $sid eq '.5.0.0') {
                $request->setError($request_info, $SNMPag{SNMP_ERR_NOERROR});
                mlog(0,"info: snmp init SNMPAPI request for OID - $oid - $sid - MODE_SET_RESERVE2") if $SNMPLog == 3;
            } elsif ($SNMPwriteable && exists $subOID2Conf{$sid}) {
                $request->setError($request_info, $SNMPag{SNMP_ERR_NOERROR});
                mlog(0,"info: snmp init configuration change request for OID - $oid - $sid - MODE_SET_RESERVE2") if $SNMPLog == 3;
            } elsif (exists $subOID{$sid}) {
                $request->setError($request_info, $SNMPag{SNMP_ERR_READONLY});
                mlog(0,"info: snmp configuration change request for readonly OID - $oid - $sid - MODE_SET_RESERVE2") if $SNMPLog == 3;
            } else {
                $request->setError($request_info, $SNMPag{SNMP_ERR_NOSUCHNAME});
                mlog(0,"info: snmp change request for unknown OID - $oid - $sid - MODE_SET_RESERVE2") if $SNMPLog == 3;
            }
            mlog(0,"info: snmp MODE_SET_RESERVE2 - $oid - $sid") if $SNMPLog >= 2;

        } elsif ($mode == $SNMPag{MODE_SET_ACTION}) {
            my $value;
            if ($canSNMPAPI && $sid eq '.5.0.0') {
                $value = $request->getValue();
                my $q;
                $q = $1 if $value =~ s/^([\"\'])//o;
                $value =~ s/\Q$q\E$//o if $q;
                mlog(0,"info: SNMPAPI request to execute : $value ") if $value && $SNMPLog > 1;
                if ($SNMPUser ne 'root' and $value =~ /^\s*(system|qx|\xB4[^\xB4]*\xB4)/o) {     # ... 3. back ticks B4
                   mlog(0,"warning: SNMPAPI request to execute system command: $value - is not allowed for non root users") ;
                   $request->setError($request_info, $SNMPag{SNMP_ERR_WRONGVALUE});
                   $subOID{'.5.0.0'} = '';
                   $lastSNMPAPIresult = '';
                } elsif (! $value) {
                   $subOID{'.5.0.0'} = '';
                   $lastSNMPAPIresult = '';
                   $request->setError($request_info, $SNMPag{SNMP_ERR_NOERROR});
                   mlog(0,'info: SNMPAPI was reseted');
                } else {
                   $subOID{'.5.0.0'} = $value;
                   my ($sub,$parm) = &parseEval($value);
                   if ($sub) {
                       $sub =~ s/^\&//o;
                       $lastSNMPAPIresult = eval{$sub->(split(/\,/o,$parm));};
                   } else {
                       $lastSNMPAPIresult = eval($value);
                   }
                   if ($@) {
                       $request->setError($request_info, $SNMPag{SNMP_ERR_WRONGVALUE});
                       $lastSNMPAPIresult = 'error: - ' . $@;
                       mlog(0,"info: error executing SNMPAPI command: $value - $@") if $SNMPLog;
                   } else {
                       $request->setError($request_info, $SNMPag{SNMP_ERR_NOERROR});
                       $lastSNMPAPIresult = 'success: - ' . &SNMPcleanHTML($lastSNMPAPIresult);
                       mlog(0,"info: successful executed SNMPAPI command: $value - return value was: $lastSNMPAPIresult") if $SNMPLog;
                   }
                }
            } elsif ($SNMPwriteable && exists $subOID2Conf{$sid}) {
                mlog(0,"info: snmp configuration change request - $oid - ".$ConfigArray[$subOID2Conf{$sid}]->[0]." - MODE_SET_ACTION") if $SNMPLog == 3;
                $qs{$ConfigArray[$subOID2Conf{$sid}]->[0]} = $request->getValue();
                my $q;
                $q = $1 if $qs{$ConfigArray[$subOID2Conf{$sid}]->[0]} =~ s/^([\"\'])//o;
                $qs{$ConfigArray[$subOID2Conf{$sid}]->[0]} =~ s/\Q$q\E$//o if $q;
                $ActWebSess = 'SNMP';
                $WebIP{$ActWebSess}->{user} = $SNMPUser;
                my $error = checkUpdate($ConfigArray[$subOID2Conf{$sid}]->[0],$ConfigArray[$subOID2Conf{$sid}]->[5],$ConfigArray[$subOID2Conf{$sid}]->[6],$ConfigArray[$subOID2Conf{$sid}]->[1]);
                if ($error =~ /span class.+?negative/o) {
                    $error =~ s/<b>(.+?)<\/b>/$1/o;
                    $request->setError($request_info, $SNMPag{SNMP_ERR_WRONGVALUE});
                    mlog(0,"info: snmp configuration change request failed for - ".$ConfigArray[$subOID2Conf{$sid}]->[0]." - ". $error) if $SNMPLog;
                } elsif ($error =~ /span class.+?positive/o) {
                    $request->setError($request_info, $SNMPag{SNMP_ERR_NOERROR});
                    my $text = (exists $cryptConfigVars{$ConfigArray[$subOID2Conf{$sid}]->[0]}) ? '' : " to ". $qs{$ConfigArray[$subOID2Conf{$sid}]->[0]};
                    mlog(0,"info: snmp changed - ".$ConfigArray[$subOID2Conf{$sid}]->[0].$text) if $SNMPLog;
                } else {
                    $request->setError($request_info, $SNMPag{SNMP_ERR_NOERROR});
                    mlog(0,"info: snmp unchanged - ".$ConfigArray[$subOID2Conf{$sid}]->[0]." - ". $qs{$ConfigArray[$subOID2Conf{$sid}]->[0]}) if $SNMPLog > 1;
                }
                delete $qs{$ConfigArray[$subOID2Conf{$sid}]->[0]};
            } elsif (exists $subOID{$sid}) {
                $request->setError($request_info, $SNMPag{SNMP_ERR_READONLY});
                mlog(0,"info: snmp configuration change request for readonly OID - $oid - $sid - MODE_SET_ACTION") if $SNMPLog == 3;
            } else {
                $request->setError($request_info, $SNMPag{SNMP_ERR_NOSUCHNAME});
                mlog(0,"info: snmp change request for unknown OID - $oid - $sid - MODE_SET_ACTION") if $SNMPLog == 3;
            }
            mlog(0,"info: snmp MODE_SET_ACTION - $oid") if $SNMPLog == 2;

        } elsif ($mode == $SNMPag{MODE_SET_UNDO}) {
            $request->setError($request_info, $SNMPag{SNMP_ERR_NOERROR});
            mlog(0,"info: snmp ignored MODE_SET_UNDO request for OID - $oid - $sid") if $SNMPLog >= 2;

        } elsif ($mode == $SNMPag{MODE_SET_COMMIT}) {
            $request->setError($request_info, $SNMPag{SNMP_ERR_NOERROR});
            mlog(0,"info: snmp ignored MODE_SET_COMMIT request for OID - $oid - $sid") if $SNMPLog >= 2;

        } elsif ($mode == $SNMPag{MODE_SET_FREE}) {
            $request->setError($request_info, $SNMPag{SNMP_ERR_NOERROR});
            mlog(0,"info: snmp ignored MODE_SET_FREE request for OID - $oid - $sid") if $SNMPLog >= 2;

        } else {
            while (my($k,$v) = each %SNMPag) {
                $mode != $v and next;
                $k =~ /SNMP_ERR_/o and next;
                $mode = $k;
                last;
            }
            $request->setError($request_info, $SNMPag{SNMP_ERR_GENERR});
            mlog(0,"info: snmp unsupported request $mode for OID - $oid - $sid") if $SNMPLog == 3;
        }
    }
    return $retval;
}

sub NewWebConnection {
  my $WebSocket = shift;
  my $s;
  d('NewWebConnection');
  &ThreadMonitorMainLoop('MainLoop NewWebConnection');
  if ($WebSocket && "$WebSocket" =~ /SSL/io && $SSLDEBUG > 1) {
      while(my($k,$v)=each(%{${*$WebSocket}{'_SSL_arguments'}})) {
          print "ssl-listener: $k = $v\n";
      }
  }
  eval{$s=$WebSocket->accept;};
  if ($s && "$s" =~ /SSL/io && $SSLDEBUG > 1) {
      while(my($k,$v)=each(%{${*$s}{'_SSL_arguments'}})) {
          print "ssl-accepted: $k = $v\n";
      }
  }
  return unless $s;
  my $ip=$s->peerhost();
  my $port=$s->peerport();
  if($allowAdminConnectionsFrom && ! matchIP($ip,'allowAdminConnectionsFrom',0,0)) {
    mlog(0,"admin connection from $ip:$port rejected by 'allowAdminConnectionsFrom'");
    $Stats{admConnDenied}++;
    close($s);
    return;
  }
# logging is done later (in webRequest()) due to /shutdown_frame page, which auto-refreshes
  &dopoll($s,$readable,POLLIN);
  $SocketCalls{$s}=\&WebTraffic;
  $WebConH{$s} = $s;
}

sub WebPermission {
    d('WebPermission - ' . $WebIP{$ActWebSess}->{user});
    my $text = shift;

    return unless $WebIP{$ActWebSess}->{user};
    return if ($WebIP{$ActWebSess}->{user} eq 'root');
    if (! &canUserDo($WebIP{$ActWebSess}->{user},'action','edit')) {
        $$text =~ s/javascript:popFileEditor\(.+?\);/javascript:alert\('access denied'\);/go;
        $$text =~ s/return popFileEditor\(.+?\)/javascript:alert\('access denied'\)/go;
    }

    foreach my $act (
        'lists',
        'recprepl',
        'maillog',
        'analyze',
        'infostats',
        'resetcurrentstats',
        'resetallstats',
        'statusassp',
        'shutdown_list',
        'shutdown',
        'shutdown_frame',
        'donations',
        'pwd',
        'reload',
        'quit',
        'save',
        'editinternals',
        'syncedit',
        'SNMPAPI',
        'addraction',
        'ipaction'
    )
    {
        next if (&canUserDo($WebIP{$ActWebSess}->{user},'action',$act));
        my $subst = '<a href="#" onclick="javascript:alert(\'access denied\');" />';
        $$text =~ s/\<a\s+href\s*=\s*"\s*$act[^"]*?"[^>]*?\>/$subst/g;
    }
    return;
}

sub setmodcol {
    my $modname = shift;
    my $mod = $modname;
    $mod =~ s/:://go;
    my $modvar = 'use'.$mod;
    if ($$modvar) {
        return ">$modname</a>";
    } else {
        return "><span class=\"negative\">$modname</span></a>";
    }
}

sub WebTraffic {
  my $fh=shift;
  my $buf = $WebCon{$fh};
  $WebCon{$fh} = '';
  my $done;
  my $haswritten = 1;
  my $hasread;
  my $ip;
  my $pending = 0;
  my $blocking = ("$fh" =~ /SSL/io) ? $HTTPSblocking : $HTTPblocking ;
  eval{$ip = $fh->peerhost(); $blocking = $WebIP{$ActWebSess}->{blocking} if exists $WebIP{$ActWebSess}->{blocking};};
  d("WEB: $ip");
  my $maxbuf = ("$fh" =~ /SSL/io) ? 16384 : 4096 ;
  eval{$pending = $fh->pending(); $maxbuf = $pending if $pending > 0;} if ("$fh" =~ /SSL/io);
  &ThreadMonitorMainLoop('MainLoop WebTraffic start');
  $fh->blocking($blocking) if ! $buf;
  $hasread = $fh->sysread($WebCon{$fh},$maxbuf);
  if ($hasread == 0 && "$fh" =~ /SSL/io && IO::Socket::SSL::errstr() =~ /SSL wants a/io) {
      mlog(0,"WebTraffic: SSL socket is not ready - will retry") if $ConnectionLog == 3 && ! $WebIP{$ActWebSess}->{sslerror};
      ThreadYield();
      $WebCon{$fh} = $buf;
      $WebIP{$ActWebSess}->{sslerror} ||= time;
      if (time - $WebIP{$ActWebSess}->{sslerror} > $SSLtimeout) {
          delete $WebIP{$ActWebSess}->{sslerror};
          WebDone($fh);
      }
      return;
  }
  delete $WebIP{$ActWebSess}->{sslerror};
  if($hasread > 0 or length($WebCon{$fh}) > 0) {
    local $_=$WebCon{$fh}=$buf.$WebCon{$fh};
    if(length($_) > 20600000) {
# throw away connections longer than 20M to prevent flooding
      WebDone($fh);
      return;
    }
    if(/Content-length: (\d+)/io) {
# POST request
      my $l=$1;
      if (/(.*?\n)\r?\n\r?(.*)/so && length($2) >= $l) {
        my $reqh=$1;
        my $reqb=$2;
        my $resp;
        my $tempfh;
        open($tempfh,'>',\$resp);
        binmode $tempfh;
        $done=webRequest($tempfh,$fh,\$reqh,\$reqb);
        close($tempfh);
        if ($httpchanged) {
            my $bl;
            if (exists $WebIP{$ActWebSess}->{blocking}) {
                $bl = $WebIP{$ActWebSess}->{blocking} ? '?blocking=1' : '?blocking=0' ;
            }
            my $prot = ("$fh" =~ /SSL/io) ? 'http:' : 'https:';
            $httpchanged = 0;
            mlog(0, "WebRequest changed HTTP(S): connected User-Agent: $head{'user-agent'}") if $ConnectionLog >= 2;
            $haswritten = &NoLoopSyswrite($fh, <<"EOT" ,0);
HTTP/1.1 200 OK
Content-type: text/html

<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">
<head></head>
<body>
<script type=\"text/javascript\">
<!--
var mydom = window.location.host;
var myprot = '$prot';
alert('Switched to ' + myprot + '//' + mydom + '/' + ' - Please wait some seconds to let assp finish change the configuration. It is recommended to restart ASSP!');
window.location.href = myprot + '//' + mydom + '/$bl';
// -->
</script>
</body>
</html>
EOT
            &mlogWrite();
            &WebDone($fh);# if $head{'user-agent'} =~ /MSIE/io;
            return;
        }
        &WebPermission(\$resp);
        $resp =~ s/>([a-zA-Z_]+::[a-zA-Z_]+)(::[a-zA-Z_]+)?<\/a>/&setmodcol("$1$2")/geo if $currentPage eq 'Config';
        &ThreadMonitorMainLoop('MainLoop WebRequest (WP)');
        my ($resph,$se,$respb) = split(/(\n\r?\n\r?)/o,$resp,2);
        if ($se) {
          my $time=gmtime();
          $time=~s/(...) (...) +(\d+) (........) (....)/$1, $3 $2 $5 $4 GMT/o;
          $resph.="\nServer: ASSP/$version$modversion";
          $resph.="\nDate: $time";
          if ($EnableHTTPCompression && $CanUseHTTPCompression && /Accept-Encoding: ([^\n]*)\n/io && $1=~/(gzip|deflate)/io) {
            my $enc=$1;
            if ($enc=~/gzip/io) {
# encode with gzip
              $respb=Compress::Zlib::memGzip($respb);
            } else {
# encode with deflate
              my $deflater=deflateInit();
              $respb=$deflater->deflate($respb);
              $respb.=$deflater->flush();
            }
            $resph.="\nContent-Encoding: $enc";
          }
          $resph.="\nContent-Length: ".length($respb);
          $haswritten = &NoLoopSyswrite($fh, "$resph\015\012\015\012$respb",0);
        }
# close connection
        if ($done || ! $haswritten) {
            &WebDone($fh);
        } else {
            $WebCon{$fh} = '';
        }
      }
    } elsif(/\n\r?\n/o) {
      my $resp;
      my $tempfh;
      open($tempfh,'>',\$resp);
      binmode $tempfh;
      $done=webRequest($tempfh,$fh,\$_,undef);
      close($tempfh);
      &ThreadMonitorMainLoop('MainLoop WebRequest 2');
      &WebPermission(\$resp);
      $resp =~ s/>([a-zA-Z_]+::[a-zA-Z_]+)(::[a-zA-Z_]+)?<\/a>/&setmodcol("$1$2")/geo if $currentPage eq 'Config';
      &ThreadMonitorMainLoop('MainLoop WebRequest 2 (WP)');
      my ($resph,$se,$respb) = split(/(\n\r?\n\r?)/o,$resp,2);
      if ($se) {
        my $time=gmtime();
        $time=~s/(...) (...) +(\d+) (........) (....)/$1, $3 $2 $5 $4 GMT/o;
        $resph.="\nServer: ASSP/$version$modversion";
        $resph.="\nDate: $time";
        if ($EnableHTTPCompression && $CanUseHTTPCompression && /Accept-Encoding: ([^\n]*)\n/io && $1=~/(gzip|deflate)/io) {
          my $enc=$1;
          if ($enc=~/gzip/io) {
# encode with gzip
            $respb=Compress::Zlib::memGzip($respb);
          } else {
# encode with deflate
            my $deflater=deflateInit();
            $respb=$deflater->deflate($respb);
            $respb.=$deflater->flush();
          }
          $resph.="\nContent-Encoding: $enc";
        }
        $resph.="\nContent-Length: ".length($respb);
        $haswritten = &NoLoopSyswrite($fh, "$resph\015\012\015\012$respb",0);
       }
# close connection
       if ($done || ! $haswritten) {
           &WebDone($fh);
       } else {
           $WebCon{$fh} = '';
       }
    }
  } elsif ($hasread == 0) {
        my $error = $!;
        if ($error =~ /Resource temporarily unavailable/io) {
            d("WebTraffic - no more data - $error - pending: $pending");
            return ;
        }
        if ($pending) {
            d("WebTraffic - got no more (HTTPS) data but $pending Byte are pending - $error");
            return;
        } else {
            d("WebTraffic - no more data - $error");
            $pending = '';
        }
        mlog($fh,"info: no (more) data$pending readable (connection possibly closed by browser)") if (($ConnectionLog >= 2 or $pending) && ! $error);
        &WebDone($fh);
  } else {
# connection closed
    mlog(0,"info: no (more) HTTP/HTTPS data readable - $!") if $ConnectionLog >= 2;
    &WebDone($fh);
  }
}

sub NewStatConnection {
  my $StatSocket = shift;
  my $s;
  &ThreadMonitorMainLoop('MainLoop NewStatConnection');
  d('NewStatConnection');
  $s=$StatSocket->accept;
  return unless $s;
  my $ip=$s->peerhost();
  my $port=$s->peerport();
  if($allowStatConnectionsFrom && ! matchIP($ip,'allowStatConnectionsFrom',0,0)) {
    mlog(0,"stat connection from $ip:$port rejected by allowStatConnectionsFrom");
    $Stats{statConnDenied}++;
    close($s);
    return;
  }
# logging is done later (in webRequest()) due to /shutdown_frame page, which auto-refreshes
  &dopoll($s,$readable,POLLIN);
  $SocketCalls{$s}=\&StatTraffic;
  $StatConH{$s} = $s;
}


sub StatTraffic {
    my $fh = shift;
    my $buf = $StatCon{$fh};
    $StatCon{$fh} = '';
    $fh->blocking($STATSblocking) unless $buf;
    &ThreadMonitorMainLoop('MainLoop StatTraffic start');
    if ( $fh->sysread( $StatCon{$fh}, 4096 ) > 0 ) {
        local $_ = $StatCon{$fh} = $buf . $StatCon{$fh};
        if ( length($_) > 1030000 ) {

            # throw away connections longer than 1M to prevent flooding
            WebDone($fh);
            return;
        }
        if (/Content-length: (\d+)/io) {

            # POST request
            my $l = $1;
            if ( /(.*?\n)\r?\n\r?(.*)/so && length($2) >= $l ) {
                my $reqh = $1;
                my $reqb = $2;
                my $resp;
                my $tempfh;
                open( $tempfh, '>', \$resp );
                binmode $tempfh;
                statRequest( $tempfh, $fh, \$reqh, \$reqb );
                close($tempfh);

                if ( index($resp , "\n\n") >= 0 or index($resp , "\n\r\n\r") >= 0 ) {
                    my ($resph,$respb) = split(/\n\r?\n\r?/o, $resp, 2);
                    my $time  = gmtime();
                    $time =~
s/(...) (...) +(\d+) (........) (....)/$1, $3 $2 $5 $4 GMT/o;
                    $resph .= "\nServer: ASSP/$version$modversion";
                    $resph .= "\nDate: $time";
                    $respb =~ s/not healthy/$webStatNotHealthyResp/o;
                    $respb =~ s/([^n][^o][^t][^ ])healthy/$1$webStatHealthyResp/o;
                    if (   $EnableHTTPCompression
                        && $CanUseHTTPCompression
                        && /Accept-Encoding: ([^\n]*)\n/io
                        && $1 =~ /(gzip|deflate)/io )
                    {
                        my $enc = $1;
                        if ( $enc =~ /gzip/io ) {

                            # encode with gzip
                            $respb = Compress::Zlib::memGzip($respb);
                        } else {
                            # encode with deflate
                            my $deflater = deflateInit();
                            $respb = $deflater->deflate($respb);
                            $respb .= $deflater->flush();
                        }
                        $resph .= "\nContent-Encoding: $enc";
                    }
                    $resph .= "\nContent-Length: " . length($respb);
                    &NoLoopSyswrite( $fh, "$resph\015\012\015\012$respb",0 );
                }
# close connection
                &WebDone($fh);
            }
        } elsif (/(.*)?\r?\n(\r)?\n(.*)?/so) {
            my $http = $1;
            my $cr   = $2;
            my $dat  = $3;
            my $how  = ( $http =~ /^stat/io );
            $http =~ s/\r//go;
            my $resp;
            my $tempfh;
            if ($http) {
                open( $tempfh, '>', \$resp );
                binmode $tempfh;
                statRequest( $tempfh, $fh, \$http ,\$dat);
                close($tempfh);
            }
            else {
                my $currStat = &StatusASSP();
                $resp =
                  ( $currStat =~ /not healthy/io )
                  ? "$webStatNotHealthyResp\n"
                  : "$webStatHealthyResp\n";
            }
            if ( index($resp , "\n\n") >= 0 or index($resp , "\n\r\n\r") >= 0 ) {
                my ($resph,$respb) = split(/\n\r?\n\r?/o,$resp , 2);
                $resph = $how ? '' : $resph . "\n";
                my $time  = gmtime();
                $time =~
                  s/(...) (...) +(\d+) (........) (....)/$1, $3 $2 $5 $4 GMT/o;
                $resph .= "Server: ASSP/$version$modversion";
                $resph .= "\nDate: $time";
                if (  !$how
                    && $EnableHTTPCompression
                    && $CanUseHTTPCompression
                    && /Accept-Encoding: ([^\n]*)\n/io
                    && $1 =~ /(gzip|deflate)/io )
                {
                    my $enc = $1;
                    if ( $enc =~ /gzip/io ) {
                        # encode with gzip
                        $respb = Compress::Zlib::memGzip($respb);
                    } else {
                        # encode with deflate
                        my $deflater = deflateInit();
                        $respb = $deflater->deflate($respb);
                        $respb .= $deflater->flush();
                    }
                    $resph .= "\nContent-Encoding: $enc";
                }
                if ($how) {
                    $resph .= "\n";
                    if ($cr) {
                        $resph =~ s/(?:$cr\n)+/$cr\n/g;
                        $respb =~ s/(?:$cr\n)+/$cr\n/g;
                    } else {
                        $resph =~ s/\n+/\n/go;
                        $respb =~ s/\n+/\n/go;
                    }
                }
                else {
                    $resph .=
                      "\nContent-Length: " . length($respb) . "\r\n\r\n";
                }
                &NoLoopSyswrite( $fh, "$resph$respb",0 );
            }
            else {
                if ($cr) {
                    $resp =~ s/(?:$cr?\n)+/$cr\n/g;
                } else {
                    $resp =~ s/\n+/\n/go;
                }
                &NoLoopSyswrite( $fh, "$resp",0 );
            }
# close connection
            &WebDone($fh);
        }
    }
    else {
# connection closed
        &WebDone($fh);
    }
}

sub WebDone {
  my $fh=shift;
  $fh = $WebConH{$fh} if exists $WebConH{$fh};
  $fh = $StatConH{$fh} if exists $StatConH{$fh};
  unpoll($fh,$readable);
  unpoll($fh,$writable);
  d("closing web connection $fh");
  if (! exists $ConDelete{$fh}) {
     $ConDelete{$fh} = \&WebDone;
     return;
  }
  delete $SocketCalls{$fh};
  delete $WebCon{$fh};
  delete $StatCon{$fh};
  delete $WebConH{$fh};
  delete $StatConH{$fh};
  delete $Con{$fh};
  eval{close($fh);};
}

sub ConCountSync {
     my $count = 0;
     for (my $i = 1; $i<=$NumComWorkers; $i++) {
         $count += $ComWorker{$i}->{numActCon};
         last if $count;
     }
     if ($count == 0) {
        %SMTPSessionIP = ();
        threads->yield;
        $SMTPSessionIP{Total} = 0;
        threads->yield;
        $smtpConcurrentSessions = 0;
        threads->yield;
     }
}

sub ConDone {
    my %isDamping = ();
    while ( my ($con,$v) = each %ConDelete) {
        my $dampOffset = 0;
#        $dampOffset = $DoDamping * 10 if ! $Con{$con}->{messagescore} && &pbBlackFind($Con{$con}->{ip});
        my $damptime ;$damptime = int(($Con{$con}->{messagescore} + $dampOffset) / $DoDamping) if $DoDamping;
        $damptime = $damptime > 0 ? $damptime > $maxDampingTime ? $maxDampingTime : $damptime : 0;
        if ($DoDamping &&
            $DoPenalty &&
            $DoPenaltyMessage &&
            $damptime &&
            ! $reachedSMTPlimit &&
            ! $doShutdownForce &&
            ! $doShutdown > 0 &&
            ! $allIdle &&
            ! $Con{$con}->{nodamping} &&
            $Con{$con}->{type} eq 'C' &&
            ! $Con{$con}->{relayok} &&
            ! $Con{$con}->{ispip} &&
            ! $Con{$con}->{whitelisted} &&
            ! $Con{$con}->{red} &&
            ! $Con{$con}->{noprocessing} &&
            ! $Con{$con}->{contentonly} &&
            $ComWorker{$WorkerNumber}->{run} == 1 &&
            ! $Con{$con}->{nodelay} &&
            ! $Con{$con}->{nopb} &&
            ! $Con{$con}->{pbwhite}
        ) {
            if (! $Con{$con}->{damping}) {
                mlog($con,"info: start damping on closing connection ($damptime)",1) if $ConnectionLog ;
                $Stats{damping}++;
                $Con{$con}->{damping} = 1;
            }
            $isDamping{$con} = $ConDelete{$con};
            next if time - $Con{$con}->{timelast} < $damptime;
        }
        $Stats{damptime} += $damptime if $Con{$con}->{damping};
        $Con{$con}->{damptime} += $damptime if $Con{$con}->{damping};
        $ConDelete{$con}->($con) if $con;
    }
    %ConDelete = %isDamping;
    undef %ConDelete unless keys %ConDelete;
    if ($WorkerNumber > 0 and $WorkerNumber < 10000) {
        my $n = scalar(keys %SocketCalls);
        $ComWorker{$WorkerNumber}->{numActCon} = int(($n+1)/2);      # set the number of active connection in thread
    }
    if (time > $nextConSync && $WorkerNumber == 0) {
        &ConCountSync();
        $nextConSync = time + 60;
    }
}

# done with a file handle -- close him and his friend(s)
sub done {
  my $fh=shift;
  return unless $fh;
  d('done');
  done2($Con{$fh}->{friend}) if $Con{$fh}->{friend};
  done2($fh);
}

# close a file handle & clean up associated records
sub done2 {
    my $fh=shift;
    return unless $fh;
    $fh = $Con{$fh}->{self} if exists $Con{$fh}->{self};   # get the real filehandle
    my $oldfh = $Con{$fh}->{oldfh};
    my @handles;
    delete $Con{$fh}->{prepend};
    if (! exists $ConDelete{$fh}) {
        $ConDelete{$fh} = \&done2;
        if ($Con{$fh}->{type} eq 'C' && $Con{$fh}->{timestart}) {
            my $time=Time::HiRes::time() - $Con{$fh}->{timestart};
            $MailCount++;
            $MailCountTmp++;
            $MailTime = $MailTime + $time;
            $MailTimeTmp = $MailTimeTmp + $time;
            $MailProcTime = $MailProcTime + $time - $Con{$fh}->{damptime};
            $MailProcTimeTmp = $MailProcTimeTmp + $time - $Con{$fh}->{damptime};
        }
        if ($Con{$fh}->{type} eq 'C') {
            T10StatAdd($fh) if $DoT10Stat;
            done2($Con{$fh}->{friend})
              if ($Con{$fh}->{friend} &&
                  ! exists $ConDelete{$Con{$fh}->{friend}} &&
                  defined $Con{$Con{$fh}->{friend}} &&
                  length($Con{$Con{$fh}->{friend}}->{outgoing}) == 0);
        } else {
            if ($Con{$fh}->{friend} &&
                exists $Con{$Con{$fh}->{friend}} &&
                ! exists $ConDelete{$Con{$fh}->{friend}} &&
                $Con{$Con{$fh}->{friend}}->{lastcmd} =~ /DATA/i &&
                ! $Con{$Con{$fh}->{friend}}->{error} &&
                ! $Con{$Con{$fh}->{friend}}->{inerror} &&
                ! $Con{$Con{$fh}->{friend}}->{intemperror}
               )
            {
                my $ofh = $Con{$Con{$fh}->{friend}}->{self};
                $ofh ||= $Con{$fh}->{friend};
                $Con{$Con{$fh}->{friend}}->{deleteMailLog} = 'MTA closed connection';
                $Con{$Con{$fh}->{friend}}->{intemperror} = 1;
                $Con{$Con{$fh}->{friend}}->{closeafterwrite} = 1;
                mlog($ofh,"info: server has closed the connection without sending a reply - classify mail as rejected by MTA") if $ConnectionLog;
                sendque($ofh,"451 Requested action aborted: local error in processing\r\n");
            }
        }
        return;
    }
    push @handles, $fh;
    if ($oldfh && ! exists $ConDelete{$oldfh}) {
        delete $Con{$oldfh}->{timestart};
        push @handles, $oldfh;
    }
    d('done2');
    while (@handles) {
        my $fh = shift @handles;
        next unless $fh;
        removeCrashFile($fh);
        mlog(0,"info: unable to close \$fh == '$fh'") unless $fh;
        $Con{$Con{$fh}->{forwardSpam}}->{gotAllText} = 1 if $Con{$fh}->{forwardSpam} && exists $Con{$Con{$fh}->{forwardSpam}};
        threadConDone($fh);
        delete $dampedFH{$fh};

        delete $Con{$fh}->{prepend};

        if (   $Con{$fh}->{type} eq 'C'   # remove MaillogFile for possily incomplete transmitted mails
            && ! $Con{$fh}->{spamfound}
            && ! $Con{$fh}->{error}
            && lc($Con{$fh}->{lastcmd}) ne 'quit'
            && $Con{$fh}->{maillogfh}
            && $Con{$fh}->{maillogfilename}
            && ! $Con{$fh}->{deleteMailLog}
           )
        {
            $Con{$fh}->{deleteMailLog} = 'incomplete good mail';
            mlog(0,"info: will remove file '$Con{$fh}->{maillogfilename}' , because mail delivery was incomplete for a good mail") if $ConnectionLog;
        }

        my $ip=$Con{$fh}->{ip};
        my $cmdlist = @{$Con{$fh}->{cmdlist}} ? "\'".join("," , @{$Con{$fh}->{cmdlist}})."\'" : "\'n/a\'";
        @{$Con{$fh}->{sip}} = (); undef @{$Con{$fh}->{sip}};
        @{$Con{$fh}->{senders}} = (); undef @{$Con{$fh}->{senders}};
        @{$Con{$fh}->{cmdlist}} = (); undef @{$Con{$fh}->{cmdlist}};
        @{$Con{$fh}->{AUTHClient}} = (); undef @{$Con{$fh}->{AUTHClient}};
        %{$Con{$fh}->{rcptlist}} = (); undef %{$Con{$fh}->{rcptlist}};
        %{$Con{$fh}->{authmethodes}} = (); undef %{$Con{$fh}->{authmethodes}};
        %{$Con{$fh}->{userauth}} = (); undef %{$Con{$fh}->{userauth}};
        %{$Con{$fh}->{Xheaders}} = (); undef %{$Con{$fh}->{Xheaders}};

        $cmdlist = $ConnectionLog >= 2 ? "- command list was $cmdlist" : '';
        if ($ip &&
            $ConnectionLog &&
            !(matchIP($ip,'noLog',0,1)) &&
            (($Con{$fh}->{movedtossl} && "$fh" =~/SSL/io) or (!$Con{$fh}->{movedtossl})))
        {
            $Con{$fh}->{writtenDataToFriend} -= 6;
            $Con{$fh}->{writtenDataToFriend} = 0 if $Con{$fh}->{writtenDataToFriend} < 0;
            my $sz = max($Con{$fh}->{spambuf},$Con{$fh}->{mailloglength});
            $sz = $Con{$fh}->{maillength} unless $sz;
            mlog(0, 'finished message - received DATA size: ' . &formatNumDataSize($sz) . ' - sent DATA size: ' . &formatNumDataSize($Con{$fh}->{writtenDataToFriend}))
                if ($Con{$fh}->{maillength} > 3);
            my $sc;
            $sc = " - used $Con{$fh}->{socketcalls} SocketCalls " if $ConnectionLog >= 2 && $Con{$fh}->{socketcalls};
            my $ptime = $Con{$fh}->{timestart} ? time - $Con{$fh}->{timestart} : 0;
            $Con{$fh}->{damptime} ||= 0 if $DoDamping;
            delete $Con{$fh}->{damptime} if $ConnectionLog < 2 or $Con{$fh}->{relayok};
            my $dtime = exists $Con{$fh}->{damptime} ? " - damped $Con{$fh}->{damptime} seconds" : '';
            mlog(0, "disconnected: session:$Con{$fh}->{SessionID} $ip $cmdlist$sc- processing time $ptime seconds$dtime",1);
        }
        d('closing maillogfh');

        # close the maillog if it's still open
        &MaillogClose($fh);

        my $what = ($Con{$fh}->{type} eq 'C') ? 'client' : 'server';
        d("closing $what $fh $ip");
        # close it
        if ("$fh" =~ /SSL/io) {
            eval{close($fh);};
            if ($@) {
                mlog(0,"warning: unable to close $fh - $@");
                eval{IO::Socket::SSL::kill_socket($fh)};
                if ($@) {
                    mlog(0,"warning: unable to kill $fh - $@");
                }
            }
        } else {
            eval{close($fh) if fileno($fh);};
        }

        d('delete the Connection data');
        # delete the Connection data
        delete $Con{$fh};
        delete $ConDelete{$fh};

        d('delete the Session data');
        # delete the Session data.
        if (exists $SMTPSession{$fh}) {
            delete $SMTPSession{$fh};
            threads->yield;
            $smtpConcurrentSessions = 0 if (--$smtpConcurrentSessions < 0);
            threads->yield;
            $SMTPSessionIP{Total}-- ;
            threads->yield;
            delete $SMTPSessionIP{$ip} if (--$SMTPSessionIP{$ip} <= 0);
            threads->yield;
        }
        d('finished closing connection');
    }
    undef %Con unless keys(%Con);
    undef %ConDelete unless keys(%ConDelete);
    undef %SocketCalls unless keys(%SocketCalls);
    undef %SocketCallsNewCon unless keys(%SocketCallsNewCon);
}

sub removeCrashFile {
    my $fh = shift;
    my $ret = 0;
    my $crashfn;
    if ($Con{$fh}->{crashfh}) {
        my $crashfh = $Con{$fh}->{crashfh};
        $crashfn = $Con{$fh}->{crashfn};
        close $crashfh;
        delete $Con{$fh}->{crashfh};
        delete $Con{$fh}->{crashfn};
        delete $Con{$fh}->{crashbuf};
        ($ret = unlink($crashfn)) or $CrFn2Remove{$crashfn} = 1;
    }
    removeLeftCrashFile();
    $ret ||= $crashfn && ! -e "$crashfn";
    return $ret;
}

sub removeLeftCrashFile {
    foreach (keys %CrFn2Remove) {
        unlink($_);
        delete $CrFn2Remove{$_} if ! -e "$_";
    }
    return 1;
}

sub newCrashFile {
    my $fh = shift;
    if (! $Con{$fh}->{relayok} && $enableCrashAnalyzer) {
        my $ip = $Con{$fh}->{ip};
        my $fn = "$base/crash_repo/cr_0_" . Time::HiRes::time().".w$WorkerNumber.txt";
        $Con{$fh}->{crashfn} = $fn;
        open(my $crashfh,'>',$fn);
        binmode($crashfh);
        $crashfh->autoflush;
        $Con{$fh}->{crashfh} = $crashfh;
        print $crashfh "+-+***+!+time:  ".timestring() .' / '. Time::HiRes::time()."+-+***+!+\r\n";
        print $crashfh "+-+***+!+connected IP:  $ip+-+***+!+\r\n";
        $Con{$fh}->{crashbuf} = "connected IP:  $ip\r\n";
        return 1;
    }
    return 0;
}

# adding a socket to the Select structure and Con hash
sub addfh {
  my ($fh,$getline,$friend) =@_;
  d('addfh');
  $SocketCalls{$fh}=\&SMTPTraffic;
  $fh->blocking(0);
  &dopoll($fh,$readable,POLLIN);
  &dopoll($fh,$writable,POLLOUT);
  binmode($fh);
  $Con{$fh} = {};
  keys %{$Con{$fh}} = 128;
  $Con{$fh}->{getline}  = $getline;
  $Con{$fh}->{friend}   = $friend;
  $Con{$fh}->{timestart}= time;
  $Con{$fh}->{timelast} = $Con{$fh}->{timestart};
  $Con{$fh}->{socketcalls} = 0;
}

# adding a SSL socket to the Select structure and Con hash
sub addsslfh {
  my ($oldfh,$sslfh,$friend) =@_;
  $SocketCalls{$sslfh}=$SocketCalls{$oldfh};
  $sslfh->blocking(0);
  binmode($sslfh);
  %{$Con{$sslfh}} = %{$Con{$oldfh}};
  $Con{$sslfh}->{friend} = $friend;
  $Con{$sslfh}->{self} = $sslfh;
  $Con{$sslfh}->{oldfh} = $oldfh;
  $SMTPSession{$sslfh} = $sslfh;
  delete $SMTPSession{$oldfh};
  if ($Con{$sslfh}->{type} eq 'C') {
    $Con{$sslfh}->{client}   = $sslfh;
    $Con{$sslfh}->{server}   = $friend;
    $Con{$sslfh}->{myheaderCon} .= "X-Assp-Client-TLS: yes\r\n";
    $Stats{smtpConnTLS}++ unless $Con{$sslfh}->{relayok};
  } else {
    $Con{$friend}->{myheaderCon} .= "X-Assp-Server-TLS: yes\r\n";
  }
  &dopoll($sslfh,$readable,POLLIN);
  &dopoll($sslfh,$writable,POLLOUT);
  $Con{$oldfh}->{movedtossl} = 1;
  my $fno = $Con{$oldfh}->{fno} ;
  if (exists $ConFno{$fno}) {delete $ConFno{$fno};}
  delete $Fileno{$fno} if (exists $Fileno{$fno});
  $Con{$sslfh}->{fno} = fileno($sslfh);
  $Fileno{$Con{$sslfh}->{fno}} = $sslfh;
  d("info: switched connection from $oldfh to $sslfh");
}

# sendque enques a string for a socket
sub sendque {
    my ($fh,$message)=@_;
    my $outmessage = ref($message) ? $message : \$message;
    my $l=length($$outmessage);
    d("sq: $fh $Con{$fh}->{ip} l=$l");
    return unless $fh && exists $Con{$fh};

    if (   $Con{$fh}->{type} eq 'C'       # is a client SMTP connection?
        && ($replyLogging == 2 or ($replyLogging == 1 && $$outmessage =~ /^[45]/o))
        && $$outmessage =~ /^[1-5]\d\d\s+[^\r\n]+\r\n$/o)    # is a reply?
    {
        my $what = 'Reply';
        $$outmessage =~ s/SESSIONID/$Con{$fh}->{msgtime} $Con{$fh}->{SessionID}/go;
        $$outmessage =~ s/MYNAME/$myName/go;
        if ($$outmessage =~ /^([45])/o) {
            $what = ($1 == 5) ? 'Error' : 'Status';
        }
        my $reply = $$outmessage;
        $reply =~ s/\r?\n//o;
        mlog( $fh, "[SMTP $what] $reply", 1, 1 );
    }

    &dopoll($fh,$writable,POLLOUT);
    $Con{$fh}->{outgoing}.=$$outmessage;
    if(!$Con{$fh}->{paused} && length($Con{$fh}->{outgoing}) > $OutgoingBufSizeNew) {
        $Con{$fh}->{paused}=1;
        d('pausing');
        unpoll($Con{$fh}->{friend},$readable);
    }
}

sub unpoll {
   my ($fhh,$action) = @_ ;
   $fhh = $Con{$fhh}->{self} if exists $Con{$fhh} && $Con{$fhh}->{self};
   if ($IOEngineRun == 0) {
       $fhh = $WebConH{$fhh} if exists $WebConH{$fhh};
       $fhh = $StatConH{$fhh} if exists $StatConH{$fhh};

       eval{$action->mask($fhh => 0);};

       if (exists $Con{$fhh} && $ConTimeOutDebug) {
           my $m = &timestring();
           my ($package, $file, $line) = caller;
           if ($Con{$fhh}->{type} eq 'C'){
               $Con{$fhh}->{contimeoutdebug} .= "$m client unpoll from $package $file $line\n" ;
           } else {
               $Con{$Con{$fhh}->{friend}}->{contimeoutdebug} .= "$m server unpoll from $package $file $line\n" if exists $Con{$Con{$fhh}->{friend}};
           }
       }
       if (my $fno = $action->[3]{$fhh}) {         # poll fd workaround
           delete $action->[3]{$fhh};
           delete $action->[0]{$fno}{$fhh};
           unless (%{$action->[0]{$fno}}) {
               delete $action->[0]{$fno};
               delete $action->[1]{$fno};
               delete $action->[2]{$fhh};
           }
       }
   } else {
       if (exists $Con{$fhh} && $ConTimeOutDebug) {
           my $m = &timestring();
             my ($package, $file, $line) = caller;
           if ($Con{$fhh}->{type} eq 'C'){
               $Con{$fhh}->{contimeoutdebug} .= "$m client unselect from $package $file $line\n" ;
           } else {
               $Con{$Con{$fhh}->{friend}}->{contimeoutdebug} .= "$m server ununselect from $package $file $line\n" if exists $Con{$Con{$fhh}->{friend}};
           }
       }
       $action->remove($fhh);
   }
}

sub dopoll {
   my ($fh,$action,$mask) = @_ ;
   my $fno;
   $fh = $Con{$fh}->{self} if exists $Con{$fh} && $Con{$fh}->{self};
   $fh = $WebConH{$fh} if exists $WebConH{$fh};
   $fh = $StatConH{$fh} if exists $StatConH{$fh};
   if ($IOEngineRun == 0) {
       $fno = fileno($fh);
       eval{$action->mask($fh => $mask);};
       if ($@) {
           if (exists $WebConH{$fh} or exists $StatConH{$fh}) {
               &WebDone($fh);
           } else {
               done($fh);
           }
       } else {
           $action->[3]{$fh} = $fno if $fno;
       }
   } else {
       $action->add($fh);
   }
}

sub sayMessageOK {
    my $fh = shift;
    my $this = $Con{$fh};
    d('sayMessageOK');
    return if $this->{sayMessageOK} eq 'already';
    return if $this->{deleteMailLog};
    &makeSubject($fh);
    ccMail($fh,$this->{mailfrom},$sendHamInbound,\$this->{header},\$this->{subject},$this->{rcpt}) ;
    return unless $this->{sayMessageOK};
    $this->{messagereason}="Bonus: Message OK";
    pbAdd($fh,$this->{ip},'okValencePB',"MessageOK",2,1);
    $this->{prepend}="[MessageOK]";
    mlog($fh,"$this->{sayMessageOK}",0,2) ;
    $Stats{bhams}++;
    $this->{sayMessageOK} = 'already';
}

sub sendquedata {
  my ($fh,$frfh,$m,$done)=@_;
  my $this;
  $this=$Con{$fh} if exists $Con{$fh};
  my $friend;
  $friend=$Con{$frfh} if exists $Con{$frfh};
  my $convert=0;
  my $doFixTNEF=0;
  my $keepTNEF=1;
  my %oldchrset = ();
  my $newchrset;
  my $body;
  my @newparts;
  my @TNEFparts;
  my $i=0;
  my @newwinparts;
  my $add_to_newparts=1;
  my $enc;
  my $header;
  my $headlen;
  my $pos;
  my $newpos;
  my $mimestr;
  my $newmimestr;
  my $email;
  my $dis;
  my $attrs;
  my $name;
  my $boundary;
  my $time;
  my $stderr;
  my $DKIMres;
  my $SAres;
  my $message;

  d('sendquedata');
  if (! $this) {
      mlog(0,"warning: got data from $frfh for a still closed peer - $fh");
      done($frfh) unless exists $ConDelete{$frfh}; # close the client connection - there is no more any server
      return;
  }
  if (! $friend) { # this should never - never happen
      mlog($fh,"error: got data for server $fh from unexisting peer $frfh");
      done($fh) unless exists $ConDelete{$fh};
      return;
  }
  $friend->{prepend} = '';
  $message = ref($m) ? $$m : $m;

  if (! $friend->{sayMessageOK} && ! $friend->{spamfound}) {
      my $fn;
      &makeSubject($this->{friend}) if ($this->{friend});
      if (! $friend->{maillogfilename}) {
          $fn = Maillog($this->{friend},'',2);
      } else {
          $fn = $friend->{maillogfilename};
      }
      $fn=' -> '.$fn if $fn ne '';
      $fn='' if !$fileLogging;
      my $pr = $friend->{passingreason} ? " - ($friend->{passingreason}) -" : '' ;
      my $logsub = ( $subjectLogging ? " $subjectStart$friend->{originalsubject}$subjectEnd" : '' );
      $friend->{sayMessageOK} = "message ok".de8($pr).$logsub.de8($fn);
  }

  if ($done && ! $friend->{relayok} && $friend->{isbounce} && $friend->{BATVrcpt} && $removeBATVTag) {      # replace BATVTags in header
      my $rcpt = &batv_remove_tag(0,$friend->{BATVrcpt},'');
      mlog($this->{friend},"info: [BATV] removed BATVTag from address $friend->{BATVrcpt} in mailheader: $rcpt") if $BATVLog >= 2;
      my $BATVrcpt = quotemeta($friend->{BATVrcpt});
      $friend->{header} =~ s/$BATVrcpt/$rcpt/ig;
      $message =~ s/$BATVrcpt/$rcpt/ig;
      $friend->{maillength} = length($friend->{header});
  }

  if (! $friend->{addMSGIDsigDone} && $friend->{relayok} && $DoMSGIDsig) { # add the MSGID Tag
      if ($message =~ /(Message-ID\:[\r\n\s]*\<[^\r\n]+\>)/io) {       # if not already done
          my $msgid = $1;
          my $tag = MSGIDaddSig($this->{friend},$msgid);
          if ($msgid ne $tag ) {
              $msgid = quotemeta($msgid);
              $message =~ s/$msgid/$tag/i;
              $friend->{header} =~ s/$msgid/$tag/i;
              $friend->{maillength} = length($friend->{header});
          }
      }
  }

  if ($done && ! $friend->{msgidsigdone} && ! $friend->{relayok} && $friend->{isbounce} && $DoMSGIDsig) {
      return unless (&MSGIDsigOK($this->{friend}));            # check MSGID signature for incoming bounce
  }

  if (! $friend->{MSGIDsigRemoved} && ! $friend->{relayok} && $DoMSGIDsig && ! $this->{noMoreQueued}) {
      if ($friend->{isbounce}) {
          if ($done) {
              &MSGIDsigRemove($this->{friend});  # remove the MSGID signatures from incoming emails
              $friend->{maillength} = length($friend->{header});
          }
      } else {
          &MSGIDsigRemove($this->{friend});  # remove the MSGID signatures from incoming emails
          $friend->{maillength} = length($friend->{header});
      }
  }

  if ($done && $friend->{accBackISPIP}) {   # send 250 OK to ISP if a Backscatter check has failed
      seterror($this->{friend},'250 OK',1);
      return;
  }

#  if (defined($friend->{bdata})) {      # just send binary data
#     sendque($fh,\$message);
#     return;
#  }

  unless ($DoDKIM && $friend->{isDKIM} &&  ! $friend->{relayok}) {
      $message =~ s/\x0D([^\x0A])/\x0D\x0A$1/go;
      $message =~ s/([^\x0D])\x0A/$1\x0D\x0A/go;   # make LF CR RFC conform
  }

  if ($friend->{relayok}) {
      $friend->{ismaxsize} = 1 if ($npSizeOut && $friend->{maillength} >= $npSizeOut);
      $friend->{noprocessing} = 1 if $friend->{ismaxsize};
  } else {
      $friend->{ismaxsize} = 1 if ($npSize && $friend->{maillength} >= $npSize);
      $friend->{noprocessing} = 2 if $friend->{ismaxsize};
  }

  if ($this->{noMoreQueued}) {    # queueing is switched of for some reasons
     $message .= "\x0D\x0A\.\x0D\x0A" if $done && $friend->{header} !~ /\x0D?\x0A\.(?:\x0D?\x0A)+$/o;
     sendque($fh,\$message);
     return;
  }

  my ($domain) = $friend->{mailfrom} =~ /^[^@]+\@([^@]+)$/o;
  if (($neverQueueSize && $friend->{maillength} > $neverQueueSize) ||
       (($friend->{ismaxsize} || $friend->{noprocessing} & 1) &&
       ! ($genDKIM && $CanUseDKIM && $friend->{relayok} && exists $DKIMInfo{lc $domain}) &&
       ! $runlvl2PL))
  {    # queueing is switched of for some reasons
     $this->{noMoreQueued} = 1;
     if ($this->{qdata}) {
         $friend->{header} .= "\x0D\x0A\.\x0D\x0A" if $done && $friend->{header} !~ /\x0D?\x0A\.(?:\x0D?\x0A)+$/o;
         sendque($fh,\$friend->{header});
         delete $this->{qdata};
         if (! ($neverQueueSize && $friend->{maillength} > $neverQueueSize)) {
             if ($friend->{relayok}) {
                 mlog($this->{friend},"info: message reached outgoing noprocessing size $npSizeOut - conversion will be done!") if ($ConvLog && $friend->{ismaxsize});
             } else {
                 mlog($this->{friend},"info: message reached incoming noprocessing size $npSize - DKIM-check and conversion will be done!") if ($ConvLog && $friend->{ismaxsize});
             }
         } else {
             mlog($this->{friend},"info: message is too large (> neverQueueSize ($neverQueueSize byte) to be queued for further internal processing! Skipping DKMI, Plugins and charset conversion.");
         }
     } else {
         $message .= "\x0D\x0A\.\x0D\x0A" if $done && $friend->{header} !~ /\x0D?\x0A\.(?:\x0D?\x0A)+$/o;
         sendque($fh,\$message);
     }
     &sayMessageOK($this->{friend});
     return;
  }

  if (! $friend->{isbounce} &&
      ! $CanUseEMM &&
      ! $runlvl2PL &&
      ! $genDKIM &&
      (! $DoDKIM || ($DoDKIM && (! $friend->{isDKIM} || $friend->{relayok})))) {    # Email::MIME::Modfier is not installed

     $this->{noMoreQueued} = 1;
     if ($this->{qdata}) {
         $friend->{header} .= "\x0D\x0A\.\x0D\x0A" if $done && $friend->{header} !~ /\x0D?\x0A\.(?:\x0D?\x0A)+$/o;
         sendque($fh,\$friend->{header});
         delete $this->{qdata};
     } else {
         $message .= "\x0D\x0A\.\x0D\x0A" if $done && $friend->{header} !~ /\x0D?\x0A\.(?:\x0D?\x0A)+$/o;
         sendque($fh,\$message);
     }
     &sayMessageOK($this->{friend});
     return;
  }

  if ($friend && $friend->{relayok}) {    # this is outbound if relayok for friend
    if ($outChrSetConv) {
     $convert=1;
     %oldchrset=%outchrset;
     d('outbound charset conversion is set to on');
    }
    if($CanUseTNEF && $doOutFixTNEF) {
       $doFixTNEF = $doOutFixTNEF;
       $keepTNEF = $keepOutTNEF;
       $convert=1;
    }
  } elsif ($friend) {   #convert inbound mail
    if ($inChrSetConv) {
     $convert=1;
     %oldchrset=%inchrset;
     d('inbound charset conversion is set to on');
    }
    if($CanUseTNEF && $doInFixTNEF) {
       $doFixTNEF = $doInFixTNEF;
       $keepTNEF = $keepInTNEF;
       $convert=1;
    }
  }
  if (! $friend->{isbounce} &&
      $done &&
      ! $convert &&
      ! $runlvl2PL &&
      ! $genDKIM &&
      (! $DoDKIM || ($DoDKIM && (! $friend->{isDKIM} || $friend->{relayok})))) {    # no conversion to do

     $this->{noMoreQueued} = 1;
     if ($this->{qdata}) {
         $friend->{header} .= "\x0D\x0A\.\x0D\x0A" if $done && $friend->{header} !~ /\x0D?\x0A\.(?:\x0D?\x0A)+$/o;
         sendque($fh,\$friend->{header});
         delete $this->{qdata};
     } else {
         $message .= "\x0D\x0A\.\x0D\x0A" if $done && $friend->{header} !~ /\x0D?\x0A\.(?:\x0D?\x0A)+$/o;
         sendque($fh,\$message);
     }
     &sayMessageOK($this->{friend});
     return;
  }

  if ($TNEFDEBUG) {
#    $friend->{prepend} = "[conversion]";
    mlog($this->{friend},"info: queued first data in sendqueue") if (! exists $this->{qdata} && $ConvLog);
  }

  $this->{qdata} = 1 if (! exists $this->{qdata});

  if (! $done) {
      my $length = length($friend->{header});
      if ($friend->{ismaxsize} && ! $friend->{SIZE} && (! $this->{allocmem} || int($length / 1000000) > $this->{allocmem})) {
          my $length = length($friend->{header});
          my $nlength = 1 + int($length / 1048576);
          my $slength = $nlength * 1048576;
          $length = &formatNumDataSize($length);
          grow(\$friend->{header} , $slength);
          grow(\$this->{outgoing} , $slength);
          if ($friend->{maillogbuf}) {
              my $mlbufsize = max(($MaxBytes ? $MaxBytes + 1024 : 0),
                                  ($StoreCompleteMail >= $slength ? $slength : 0)
                                 );
              grow(\$friend->{maillogbuf} , $mlbufsize) if $mlbufsize;
          }
          if ($ConTimeOutDebug) {
              grow(\$friend->{contimeoutdebug} , $slength);
          }

          $this->{allocmem} = $nlength;
          mlog($this->{friend}, "info: allocated $nlength MB memory for large message (currently $length).") if $ConnectionLog > 2;
      }
      my $timeout = $smtpIdleTimeout || 180;   # send some data to the server to prevent SMTP-timeout
      if ($this->{lastwritten} && time - $this->{lastwritten} > $timeout) {
          $this->{lastwritten} = time;
          my $dummy = "X-ASSP-KEEP:\r\n";
          sendque($fh,\$dummy);
      }
      return ;                         # queue the data until all data are received
  }

  delete $this->{noMoreQueued};
  delete $this->{qdata};

  d('convert and send data');
  mlog($this->{friend},"convert and send data from sendqueue") if ($TNEFDEBUG);

  unless ($DoDKIM && $friend->{isDKIM} &&  ! $friend->{relayok}) {
      $friend->{header} =~ s/\x0D([^\x0A])/\x0D\x0A$1/go;
      $friend->{header} =~ s/([^\x0D])\x0A/$1\x0D\x0A/go;   # make LF CR RFC conform
  }

  if ($DoDKIM && $friend->{isDKIM} &&  ! $friend->{relayok} && ! $friend->{noprocessing}) {
      eval{$DKIMres = DKIMOK($this->{friend},\$friend->{header},defined${chr(ord(",")<< 1)});};
      if (! $@) {
        if (! $DKIMres ) {   # DKIM check has failed -> this is SPAM
           $friend->{skipmaillog} = 0;
           delete $friend->{messagelow};
           &MaillogRemove($friend);
           $friend->{detectonly} = 1;
           my $isspam = thisIsSpam($this->{friend},$friend->{messagereason},$DKIMLog,"554 DKIM signature failed",$dkimTestMode,0,1);
           $friend->{detectonly} = '';
           mlog($this->{friend}," -\> ".de8($friend->{maillogfilename})) if($friend->{maillogfilename});
           if ($isspam) {
             unless ($friend->{spamlover} & 1 ) {$Stats{dkim}++;}
             return;
           }
        } elsif ($DKIMres == 1) {  # this is no DKIM or is not checked for any reason
        } elsif ($DKIMres == 2) {  # DKIM check has passed -> we can not convert (modify) the mail
           if ($DoDKIM == 3) {
               $friend->{TestMessageScore} = 1;
               delete $friend->{messagescoredone};
               my $maillogparm = $friend->{maillogparm};
               if (&TestMessageScore($this->{friend})) {  # check the score if DoDKIM == 3
                    $friend->{skipmaillog} = 0;
                    delete $friend->{messagelow};
                    &MaillogRemove($friend);
                    $friend->{detectonly} = 1;
                    my $isspam = MessageScore($this->{friend},1);
                    $friend->{detectonly} = '';
                    delete $friend->{TestMessageScore};
                    if ($isspam) {
                      return;
                    }
               }
               delete $friend->{TestMessageScore};
               $friend->{messagescoredone} = 1;
               $friend->{maillogparm} = $maillogparm;
           }
           # message is OK
           $headlen = index($friend->{header}, "\x0D\x0A\x0D\x0A");  # merge header
           $friend->{header} = substr($friend->{header},0,$headlen)."\r\nX-Assp-DKIM: $friend->{dkimverified}".substr($friend->{header},$headlen,length($friend->{header})-$headlen) if ($AddDKIMHeader and $headlen > 2);
           $friend->{skipmaillog} = 0;
           $friend->{maillogparm} = 2 if (! $friend->{maillogparm});
           Maillog($this->{friend},'',$friend->{maillogparm});
           delete $friend->{maillogparm};
           if (! $doDKIMConv && ! $runlvl2PL) {
              $friend->{header} .= "\x0D\x0A.\x0D\x0A" if $done && ($friend->{header} !~ /\x0D\x0A\.\x0D\x0A$/o);
              sendque($fh,\$friend->{header});
              &sayMessageOK($this->{friend});
              return;
           }
        }
      } else {
        my $error = $@;
        mlog($this->{friend},"ERROR: DKIM check cause an exception - $error") if $ValidateSenderLog;
        $friend->{skipmaillog} = 0;
        $friend->{maillogparm} = 2 if (! $friend->{maillogparm});
        Maillog($this->{friend},'',$friend->{maillogparm});
        delete $friend->{maillogparm};
        if (! $doDKIMConv && ! $runlvl2PL) {
           $friend->{header} .= "\x0D\x0A.\x0D\x0A" if $done && ($friend->{header} !~ /\x0D\x0A\.\x0D\x0A$/o);
           sendque($fh,\$friend->{header});
           &sayMessageOK($this->{friend});
           return;
        }
      }
  }

  if ($runlvl2PL){
#   @plres = [0]result,[1]data,[2]reason,[3]plLogTo,[4]reply,[5]pltest,[6]pl
    my @plres = &callPlugin($this->{friend},2,\$friend->{header});  # call the runlevel 2 Plugins
    if ($plres[0]) {  # check scoring if OK
       @plres = MessageScorePL($this->{friend},@plres);
    }
    if (! $plres[0]) {  # we've got an error
        my $slok=$friend->{allLoveSpam}==1;
        headerUnwrap($friend->{myheader});
        makeMyheader($this->{friend},$slok,$plres[5],$plres[2]);
        $friend->{myheader} =~ s/^[\r\n]+//o;
        $friend->{myheader} =~ s/[\r\n]+$//o;

        addMyheader($this->{friend}) if $friend->{myheader};

        $friend->{skipmaillog} = 0;
        &MaillogRemove($friend);     # switch the maillog to spam
        mlog($this->{friend}," -\> ".de8($friend->{maillogfilename})) if($friend->{maillogfilename});
        mlog($this->{friend},"mail blocked by Plugin $plres[6] - reason $plres[2]");
        $friend->{detectonly} = 1;
        $friend->{messagelow} = &TestLowMessageScore($this->{friend});
        my $isspam = thisIsSpam($this->{friend},$plres[2],$plres[3],$plres[4],$plres[5],$slok,$done);
        $friend->{detectonly} = '';
        if ($isspam) {      # no testmode
           return;
        }
    }
  }

  if (! $doDKIMConv && $friend->{isDKIM}) {
        $friend->{header} .= "\x0D\x0A\.\x0D\x0A" if $done && $friend->{header} !~ /\x0D?\x0A\.(?:\x0D?\x0A)+$/o;
        sendque($fh,\$friend->{header});
        &sayMessageOK($this->{friend});
        return;
  }

  &sayMessageOK($this->{friend});

  $friend->{prepend} = '';

if ((! $friend->{noprocessing} || $convertNP) && $convert ) {
  my $newmail;
  eval {
  $time=Time::HiRes::time();
  $convert=0;
  if ($inChrSetConv || $outChrSetConv) {                             # convert the MIME header if possible and needed
      $headlen = index($friend->{header}, "\x0D\x0A\x0D\x0A");
      $headlen = 0 if $headlen < 0;
      d("headlen: $headlen");
      if (substr($friend->{header},0,$headlen) =~ /Content-Transfer-Encoding:\s*(?:[78]bit|binary)\s*\x0D\x0A/io) {;
         $mimestr = $1;                 # if there is CTE there must be CT with charset...
         $pos=index($friend->{header}, $mimestr, 0);
         if (substr($friend->{header},0,$headlen) !~ /Content-Type:[^;]+;.*?charset\s*=\s*[\"\']?[^\"\']*?[\"\']?/io) {
            substr($friend->{header},$pos,length($mimestr),'');  # remove worth CTE it's us-ascii 7/8bit
            d("removed worth CTE $mimestr from header - no corresponding charset statement found");
            mlog($this->{friend},"removed worth CTE $mimestr from header - no corresponding charset statement found") if ($TNEFDEBUG);
         }
      }
      $pos=0;
      while ($pos < $headlen) {
        last if (substr($friend->{header},$pos,$headlen-$pos) !~ /(=\?([^?]*)\?([bq])\?[^?]+\?=)/io);     # get charset and encoding
        $mimestr=$1;
        d("mimestr: $mimestr");
        $newpos=index($friend->{header}, $mimestr, $pos);
        d("pos: $newpos");
        $name = Encode::resolve_alias(uc($2));
        $enc = uc($3);
        if(exists $oldchrset{$name}) {
          $newchrset = $oldchrset{$name};
          $newchrset = 'UTF-8' if ($newchrset =~ /utf8|utf-8/io);
          d("org $name head: $mimestr");
          $newmimestr = decodeMimeWords($mimestr);
          d('dec native head: hex '.unpack( "H*", $newmimestr));
          $newmimestr=Encode::encode($newchrset,$newmimestr);
          d("enc native $newchrset head: hex ".unpack( "H*", $newmimestr));
          $newmimestr = encodeMimeWord($newmimestr, $enc, $newchrset);
          $newmimestr =~ s/ /_/go if ($enc =~ /q/io);    # if spaces are not well encoded
          d("enc $newchrset head: $newmimestr");
          substr($friend->{header},$newpos,length($mimestr),$newmimestr);      # put the new MIME in header
          mlog($this->{friend},"info: done header conversion from $name to $newchrset") if $ConvLog && !$convert;
          $convert=1;
          $pos=$newpos+length($newmimestr);
        } else {
          $pos=$newpos+length($mimestr);
        }
      }
  }

  my @convParts;
  $i=0;
  $o_EMM_pm = 1;
  $Email::MIME::ContentType::STRICT_PARAMS=0;      # no output about invalid CT
  $email = Email::MIME->new($friend->{header});
  foreach my $part ( $email->parts ) {
    $i++;
    $dis = $part->header("Content-Type") || '';        # get the charset of the email part
    d("header (ct-attr) : $dis");
    $attrs = $dis =~ s/^[^;]*;//o ? Email::MIME::ContentType::_parse_attributes($dis) : {};
    $name = $attrs->{charset} || $part->{ct}{attributes}{charset};
    $boundary = $attrs->{boundary} || $part->{ct}{attributes}{boundary};
    $name=Encode::resolve_alias(uc($name)) if $name;
    if ( exists $oldchrset{$name} && $part->header("Content-Type")=~/text\//io) {   # if the part is 'text' and a conversiontable entry exists
          $convert |= 1;
          $newchrset=$oldchrset{$name};
          $newchrset = 'UTF-8' if ($newchrset =~ /utf8|utf-8/io);
          mlog($this->{friend},"character set conversion: from $name to $newchrset in MIME part $i") if $ConvLog;
          $body = $part->body;
          $body = Encode::decode($name,$body);
          $body = Encode::encode($newchrset, $body);
          $part->body_set( $body );
          $part->charset_set($newchrset);
          $part->encoding_set('quoted-printable') if ! is_7bit_clean(\$part->body);
    } elsif ($doFixTNEF &&
             $CanUseTNEF &&
             $part->header("Content-Type")=~/\/ms-tnef/io &&
             $part->header("Content-Disposition")=~ /attachment|inline/io) {
          mlog($this->{friend},"info: doing ms-tnef conversion") if $ConvLog;
          $enc = $part->header("Content-Transfer-Encoding");
          if ($enc) {
            d("ms-tnef CTE=$enc");
            $add_to_newparts=0 if (! $keepTNEF);
            $body = $part->body;
            $body = Encode::decode($name,$body) if $name;
    	    eval{@TNEFparts = getTNEFparts($body,$enc,%oldchrset)};  # prevent die for unknown data in attachment
            if ($@){
              $add_to_newparts=1;
              mlog($this->{friend},"info: ms-tnef conversion failed for unknown reason") if $ConvLog;
            } else {
              if (! @TNEFparts) {
                $add_to_newparts=1;
                mlog($this->{friend},"info: no convertable ms-tnef parts found in tnef-attachment") if $ConvLog;
              } else {
                while (@TNEFparts) {
                    push(@convParts,
                          Email::MIME->create(
                              attributes => shift @TNEFparts,
                              body => shift @TNEFparts,
                          )
                    );
                }
                mlog($this->{friend},"info: successful finished TNEF conversion") if $ConvLog;
                $convert = 2;
              }
            }
          } else {
            mlog($this->{friend},"info: no Content-Transfer-Encoding information found in header of tnef-part $i") if $ConvLog;
          }
    }
    push(@newparts,$part) if ($add_to_newparts);
    $add_to_newparts=1;
  }
  $email->header_set('MIME-Version', '1.0') if !$email->header('MIME-Version');
  push( @newparts, @convParts ) if @convParts;
  $email->parts_set(\@newparts);
  $newmail = $email->as_string if $convert;

  local $/='';

  if ($TNEFDEBUG && $convert == 2) {     # if TNEFdebug and TNEF converted, print the org and conv email to the file
        d("conversion output to file $base/debug_chrset_conv_parts.txt");
        my $T1;
        open $T1, '>>',"$base/debug_chrset_conv_parts.txt";
        binmode $T1;
        print $T1 "######### original mail ###########\n";
        print $T1 "qdata\n";
        print $T1 "###################################\n";
        print $T1 $friend->{header};
        print $T1 "--------- converted mail ----------\n";
        print $T1 "qdata\n";
        print $T1 "-----------------------------------\n";
        print $T1 $newmail;
        print $T1 "\x0D\x0A.\x0D\x0A" if ($newmail !~ /\x0D\x0A\.\x0D\x0A$/o &&
                                          $friend->{header} =~ /\x0D\x0A\.\x0D\x0A$/o);   # add the dot if the conversion has removed it
        close $T1;
  }
  } ; # end eval
  if ($@){
     my $error = $@;
# if conversion failed send the unconverted
     $friend->{header} .= "\x0D\x0A.\x0D\x0A" if ($friend->{header} !~ /\x0D\x0A\.\x0D\x0A$/o);
     mlog($this->{friend},"info: charset conversion aborted - the unconverted mail is processed\n$error") if $ConvLog;
     if ($TNEFDEBUG) {
        mlog($this->{friend},"conversion-exceptions: $stderr") if ($stderr);
        my $T1;
        open $T1, '>>',"$base/debug_conv_error.txt";
        binmode $T1;
        print $T1 "######### original mail ###########\n";
        print $T1 "qdata\n";
        print $T1 "###################################\n";
        print $T1 $friend->{header};
        print $T1 "--------- error ---------\n";
        print $T1 "qdata\n";
        print $T1 "-------------------------\n";
        print $T1 "$error\n";
        print $T1 "******* exceptions ******\n";
        print $T1 "qdata\n";
        print $T1 "*************************\n";
        print $T1 "$stderr\n";
        close $T1;
     }
     undef $email;
     $o_EMM_pm = 0;
  } else {   # there was no error
     mlog($this->{friend},"info: conversion-exceptions: $stderr") if ($stderr && ($TNEFDEBUG || $ConvLog > 1));
     if ($convert) {   # if conversion was done fix the . at the end of the mail  and the LF problem
       my $addend; $addend = 1 if ($friend->{header} =~ /\x0D\x0A\.\x0D\x0A$/o);
       $friend->{header} = $newmail;
       undef $email;
       $friend->{header} =~ s/\x0D([^\x0A])/\x0D\x0A$1/go;
       $friend->{header} =~ s/([^\x0D])\x0A/$1\x0D\x0A/go;   # make LF CR RFC conform
       $friend->{header} .= "\x0D\x0A.\x0D\x0A" if ($friend->{header} !~ /\x0D\x0A\.\x0D\x0A$/o &&
                                            $addend);   # send the dot if the conversion has removed it
       $time= sprintf("%.3f",(Time::HiRes::time()) - $time) ;
       mlog($this->{friend},"info: MIME/TNEF conversion successful - finished in $time seconds") if $ConvLog;
     } else {
               # send the unconverted there was no conversion
       mlog($this->{friend},"info: no MIME/TNEF conversion done") if ($TNEFDEBUG || $ConvLog > 1);
     }
     undef $email;
     $o_EMM_pm = 0;
  }
} # end convert

  if ($friend->{relayok} && $genDKIM) {
      $friend->{header} =~ s/\x0D([^\x0A])/\x0D\x0A$1/go;
      $friend->{header} =~ s/([^\x0D])\x0A/$1\x0D\x0A/go;   # make LF CR RFC conform
      &DKIMgen($this->{friend});
  }
  $friend->{header} .= "\x0D\x0A\.\x0D\x0A" if $done && $friend->{header} !~ /\x0D?\x0A\.(\x0D?\x0A)+$/o;
  $friend->{maillength} = length($friend->{header});
  sendque($fh,\$friend->{header});
#  &printallCon($fh);
}

sub is_7bit_clean {
    my $ref = shift;
    my $ret;
    eval('
    use bytes;
    $ret = ${$ref} !~ /[^\x20-\x7F\x0A\x0D\t]/os;
    no bytes;');
    return $ret;
}


#####################################################################################
#                SMTP stuff

# compile the regular expression (RE) for the local domains list (LDRE)
sub setLDRE {
  SetRE('LDRE',"^(?:$_[0])\$",
        $regexMod,
        'Local Domains',$_[1]);
}
# compile the regular expression (RE) for the local server names list (LSRE)
sub setLSRE {
  SetRE('LSRE',"^(?:$_[0])\$",
        $regexMod,
        'LocalHost',$_[1]);
}

# compile the helo-blacklist ignore regular expression
sub setHBIRE {
  SetRE('HBIRE',"^(?:$_[0])\$",
        $regexMod,
        'HELO Blacklisted Ignore',$_[1]);
}

sub localvrfy2MTA {
  my ($fh,$h) = @_;
  return 0 unless $DoVRFY;
  return localvrfy2MTA_Run($fh,$h);
}
sub localvrfy2MTA_Run {
  my ($fh,$h) = @_;
  d("localvrfy2MTA - $h") if $WorkerNumber != 10001;
  my $this;
  $this = $Con{$fh} if $fh;
  my $smtp;
  my $vrfy;
  my $expn;
  my $domain;
  my $forceRCPTTO;
  my $canvrfy;
  my $canexpn;

  $h = &batv_remove_tag(0,lc($h),'');

  return 1 if &LDAPCacheFind($h,'VRFY');
  if (my $nf = $LDAPNotFound{$h}) {
      return 0 if (time - $nf < 300);
      delete $LDAPNotFound{$h};
  }

  $domain = $1 if $h=~/\@([^@]*)/o;
  return 0 unless $domain;

  my $MTAList = &matchHashKey('DomainVRFYMTA',$domain);
  $MTAList = &matchHashKey('FlatVRFYMTA',"\@$domain") unless $MTAList;
  return 0 unless $MTAList;

  my $timeout = $VRFYQueryTimeOut ? $VRFYQueryTimeOut : 5;
  &sigoffTry(__LINE__);
  eval{
    for my $MTA (split(/,/,$MTAList)) {
      eval{
      $smtp = Net::SMTP->new($MTA,
                        Hello => $myName,
                        Timeout => $timeout);
      } or next;
      if ($smtp) {
          $forceRCPTTO = ($VRFYforceRCPTTO && $MTA =~ /$VFRTRE/) ? 1 : 0;
          if (! $forceRCPTTO) {
              $canvrfy = exists ${*$smtp}{'net_smtp_esmtp'}->{'VRFY'};   # was VRFY in EHLO Answer?
              $canexpn = exists ${*$smtp}{'net_smtp_esmtp'}->{'EXPN'};   # was EXPN in EHLO Answer?
              if (! $canvrfy && ! $canexpn &&   # there was no VRFY or EXPN in the EHLO Answer, or HELO was used
                  (exists ${*$smtp}{'net_smtp_esmtp'}->{'HELP'} ||    # we can use HELP      or
                   ! exists ${*$smtp}{'net_smtp_esmtp'}) )            # only HELO was used - try HELP
              {
                      my $help = $smtp->help();
                      $canvrfy = $help =~ /VRFY/io;
                      $canexpn = $help =~ /EXPN/io;
              }
              if ($canvrfy) {$vrfy = $smtp->verify($h) ? 1 : $smtp->verify("\"$h\"");}
              if ($canexpn && ! $vrfy) {$expn = scalar($smtp->expand($h)) ? 1 : scalar($smtp->expand("\"$h\""));}
          } else {
              mlog($fh,"info: using RCPT TO: (skiped VRFY) for $h") if ($VRFYLog >= 2 && $WorkerNumber != 10001);
          }
          if (!$canvrfy && !$canexpn) {    # VRFY and EXPN are both not supported or VRFYforceRCPTTO is set for this MTA
              mlog($fh,"info: host $MTA does not support VRFY and EXPN (tried EHLO and HELP) - now using RCPT TO to verify $h") if ($VRFYLog >= 2 && ! $forceRCPTTO && $WorkerNumber != 10001);
              if ($smtp->mail('postmaster@'.$myName)) {
                  $vrfy = $smtp->to($h);
              } else {
                  mlog($fh,"info: host $MTA does not accept 'mail from:postmaster\@$myName'") if $VRFYLog && $WorkerNumber != 10001;
              }
          }
          $smtp->quit;
      }
      last if ($vrfy || $expn);
    }
  };
  if ($@ || ! $smtp) {
     $vrfy = 0 ;
     $expn = 0 ;
     my $not =  $LDAPFail ? ' not' : '';
     if ($@){
         mlog($fh,"error: VRFY / RCPT TO failed on host $MTAList - address <$h>$not accepted - $@") if $WorkerNumber != 10001;
     } else {
         mlog($fh,"error: VRFY / RCPT TO failed on host $MTAList - address <$h>$not accepted") if $WorkerNumber != 10001;
     }
     &sigonTry(__LINE__);
     $this->{userTempFail} = ! $LDAPFail if $this;
     return ! $LDAPFail;
  }
  &sigonTry(__LINE__);
  delete $this->{userTempFail} if $this;
  if ($vrfy || $expn) {
     if ($ldaplistdb) {
         $LDAPlist{$h}=time." 1";
         mlog($fh,"VRFY added $h to VRFY-/LDAPlist") if $VRFYLog && $WorkerNumber != 10001;
         d("VRFY added $h to LDAP-cache",1) if $WorkerNumber != 10001;
     }
     delete $LDAPNotFound{$h};
     mlog($fh,"info: VRFY found $h") if $VRFYLog >= 2 && $WorkerNumber != 10001;
     return 1 ;
  } else {
     $LDAPNotFound{$h} = time;
  }
  mlog($fh,"info: VRFY was unable to find $h") if $VRFYLog >= 2 && $WorkerNumber != 10001;
  return 0;
}

# returns true if this address is local (any local domain)
sub localmail {
  my $h = shift;
  d("localmail - $h",1);
  return 0 unless $h;
#(my $package, my $file, my $line, my $Subroutine, my $HasArgs, my $WantArray, my $EvalText, my $IsRequire) = caller(0);
#d("localmail - $package, $file, $line, $Subroutine, $HasArgs, $WantArray, $EvalText, $IsRequire");
  $h = $1 if $h=~/\@([^@]*)/o;
  return &localdomains($h);
}

# returns true if this address is in localdomains file or localDomains or LDAP
sub localdomains {
    my $h = shift;
    d("localdomains - $h",1) if $WorkerNumber != 10001;
    $h =~ tr/A-Z/a-z/;
    my $hat; $hat = $1 if $h =~ /(\@[^@]*)/o;
    $h = $1 if $h =~ /\@([^@]*)/o;

    return 1 if $h eq "assp.local";
    return 1 if $h eq "assp-nospam.org";

    my ($EBRD) = $EmailBlockReportDomain =~ /^\@*([^@]*)$/o;
    return 1 if ($EBRD && lc($h) eq lc($EBRD));

    return 1 if $localDomains && ( ($hat && $hat =~ /$LDRE/) || ($h && $h =~ /$LDRE/) );
    return &localLDAPdomain($h);
}

# returns true if this address is in localdomains file or localDomains or LDAP
sub localdomainsreal {
    my $h = shift;
    d("localdomainsreal - $h",1) if $WorkerNumber != 10001;
    $h =~ tr/A-Z/a-z/;
    my $hat; $hat = $1 if $h =~ /(\@[^@]*)/o;
    $h = $1 if $h =~ /\@([^@]*)/o;

    return 1 if $localDomains && ( ($hat && $hat =~ /$LDRE/) || ($h && $h =~ /$LDRE/) );
    return &localLDAPdomain($h);
}

sub localLDAPdomain {
  my $h = shift;
  d("localLDAPdomain - $h",1);
  $h =~ tr/A-Z/a-z/;
  return 1 if &LDAPCacheFind('@'.$h,'LDAP');
  return 0 unless $CanUseLDAP;
  return 0 unless $ldLDAP;
  my $ldapflt = $ldLDAPFilter;
  $ldapflt =~ s/DOMAIN/$h/go;
  my $ldaproot = $ldLDAPRoot || $LDAPRoot;
  $ldaproot =~ s/DOMAIN/$h/go;
  return LDAPQuery($ldapflt, $ldaproot,$h);
}

sub localmailaddress {
  my ($fh,$current_email) = @_;
  d("localmailaddress - $current_email",1) if $WorkerNumber != 10001;
  $current_email = &batv_remove_tag(0,$current_email,'');
  $current_email =~ tr/A-Z/a-z/;
  my $at_position = index($current_email, '@');
  my $current_username = substr($current_email, 0, $at_position);
  my $current_domain = substr($current_email, $at_position + 1);
  my $ldapflt = $LDAPFilter;
  $ldapflt =~ s/EMAILADDRESS/$current_email/go;

  $ldapflt =~ s/USERNAME/$current_username/go;
  $ldapflt =~ s/DOMAIN/$current_domain/go;
  my $ldaproot = $LDAPRoot;
  $ldaproot =~ s/DOMAIN/$current_domain/go;
  if ( matchSL( $current_email, 'LocalAddresses_Flat' ) ) {
      $LDAPlist{'@'.$current_domain} = time if $ldaplistdb;
      return 1;
  }
  if (&LDAPCacheFind($current_email,'LDAP')) {
      $LDAPlist{'@'.$current_domain} = time if $ldaplistdb && $ldLDAPFilter;
      return 1;
  }
  if($DoLDAP && $CanUseLDAP && LDAPQuery($ldapflt, $ldaproot,$current_email)) {
      $LDAPlist{'@'.$current_domain} = time if (!$LDAPoffline && $ldaplistdb && $ldLDAPFilter);
      return 1;
  }
  if($DoVRFY && (&matchHashKey('FlatVRFYMTA',"\@$current_domain") or &matchHashKey('DomainVRFYMTA',$current_domain))
             && $CanUseNetSMTP
             && $current_email =~ /[^@]+\@[^@]+/o
             && localvrfy2MTA($fh,$current_email))
  {
      $LDAPlist{'@'.$current_domain} = time if (! ($fh && $Con{$fh}->{userTempFail}) && $ldaplistdb);
      return 1;
  }
  return 0;
}

sub LDAPCacheFind {
  my ($current_email,$how) = @_;
  d("LDAPCacheFind - $current_email , $how",1) if $WorkerNumber != 10001;
  return 0 unless $ldaplistdb;
  $current_email = lc $current_email;
  if (my ($vt,$vl) = split(/ /o,$LDAPlist{$current_email})) {
    mlog(0,"$how - found $current_email in $how-cache (ldaplistdb)") if (${$how.'Log'} && $WorkerNumber != 10001);
    d("$how - found $current_email in $how-cache",1) if $WorkerNumber != 10001;
    if ($vl) {
      $LDAPlist{$current_email}=time." $vl";
    } else {
      $LDAPlist{$current_email}=time;
    }
    return 1;
  }
  d("$how - not found $current_email in $how-cache",1) if $WorkerNumber != 10001;
  mlog(0,"$how - $current_email not found in $how-cache (ldaplistdb)") if (${$how.'Log'} >= 2 && $WorkerNumber != 10001);
  return 0;
}

sub LDAPQuery {
  my ($ldapflt, $ldaproot, $current_email) = @_;
  my $retcode;
  my $retmsg;
  my @ldaplist;
  my $ldaplist;
  my $ldap;
  my $mesg;
  my $entry_count;
  d("LDAPQuery - $ldapflt, $ldaproot, $current_email",1) if $WorkerNumber != 10001;
  $current_email = &batv_remove_tag(0,lc($current_email),'');

  return 1 if &LDAPCacheFind($current_email,'LDAP');
  if (my $nf = $LDAPNotFound{$current_email}) {
      return 0 if (time - $nf < 300);
      delete $LDAPNotFound{$current_email};
  }

  d("doing LDAP lookup with $ldapflt in $ldaproot",1) if $WorkerNumber != 10001;

  @ldaplist = split(/\|/o,$LDAPHost);
  $ldaplist = \@ldaplist;

  &sigoffTry(__LINE__);
  my $scheme = 'ldap';
  eval{
  $scheme = 'ldaps' if ($DoLDAPSSL == 1 && $AvailIOSocketSSL);
  $ldap = Net::LDAP->new( $ldaplist,
                          timeout => $LDAPtimeout,
                          scheme => $scheme,
                          inet4 =>  1,
                          inet6 =>  $CanUseIOSocketINET6
                        );
  $ldap->start_tls() if ($DoLDAPSSL == 2 && $AvailIOSocketSSL);
  };
  if(! $ldap) {
    mlog(0,"Couldn't contact LDAP server at $LDAPHost -- check ignored") if $WorkerNumber != 10001;
    &sigonTry(__LINE__);
    $LDAPoffline = 1;
    return !$LDAPFail;
  }
# bind to a directory anonymous or with dn and password
  if ($LDAPLogin) {
    $mesg = $ldap->bind($LDAPLogin, password => $LDAPPassword,  version => $LDAPVersion);
  } else {
    $mesg = $ldap->bind( version => $LDAPVersion );
  }
  $retcode = $mesg->code;
  if ($retcode) {
    mlog(0,"LDAP bind error: $retcode -- check ignored",1) if $WorkerNumber != 10001;
    $ldap->unbind;
    &sigonTry(__LINE__);
    $LDAPoffline = 1;
    return !$LDAPFail;
  }
# perform a search
  $mesg = $ldap->search(base   => $ldaproot,
                        filter => $ldapflt,
                        attrs => ['cn'],
                        sizelimit => 1
                        );
  $retcode = $mesg->code;
  if($retcode > 0 && $retcode != 4) {
    mlog( 0, "LDAP search error: $retcode -- '$ldapflt' check ignored", 1 ) if $WorkerNumber != 10001;
    &sigonTry(__LINE__);
    $ldap->unbind;
    $LDAPoffline = 1;
    return !$LDAPFail;
  }
  $LDAPoffline = 0;
  $entry_count = $mesg->count;
  $retmsg = $mesg->entry(1);
  mlog(0,"LDAP Results $ldapflt: $entry_count : $retmsg") if $LDAPLog && $WorkerNumber != 10001;
  d("got $entry_count result(s) from LDAP lookup") if $WorkerNumber != 10001;
  $mesg = $ldap->unbind;  # take down session
  if($entry_count) {
     if($ldaplistdb) {
         $LDAPlist{$current_email}=time;
         mlog(0,"LDAP added $current_email to LDAPlist") if $LDAPLog && $WorkerNumber != 10001;
         d("added $current_email to LDAP-cache") if $WorkerNumber != 10001;
     }
     delete $LDAPNotFound{$current_email};
  } else {
     $LDAPNotFound{$current_email} = time;
  }
  &sigonTry(__LINE__);
  return $entry_count;
}

sub LDAPList {
  my %ATTR = @_;
  $ATTR{attr} ||= 'uid';
  my $retcode;
  my @retmsg;
  my @ldaplist;
  my $ldaplist;
  my $ldap;
  my $mesg;

  if ($ATTR{host}) {
      $ATTR{scheme} ||= 'ldap';
      $ATTR{scheme} = 'ldap' unless $AvailIOSocketSSL;
      delete $ATTR{starttls} if $ATTR{scheme} eq 'ldaps';
  } else {
      $ATTR{host} = $LDAPHost;
      $ATTR{scheme} = ($DoLDAPSSL == 1 && $AvailIOSocketSSL) ? 'ldaps' : 'ldap';
      $ATTR{starttls} = ($DoLDAPSSL == 2 && $AvailIOSocketSSL);
      delete $ATTR{starttls} if $ATTR{scheme} eq 'ldaps';
      $ATTR{version} = $LDAPVersion;
      $ATTR{user} = $LDAPLogin if $LDAPLogin;
      $ATTR{password} = $LDAPPassword if $LDAPPassword;
      $ATTR{timeout} = $LDAPtimeout;
      $ATTR{base} ||= $LDAPRoot if $LDAPRoot;
  }
  @ldaplist = split(/\|/o,$ATTR{host});
  $ldaplist = \@ldaplist;

  if ($LDAPLog > 2) {
      my $parms;
      foreach (sort keys %ATTR) {
          $parms .= "$_ => $ATTR{$_}\n";
      }
      mlog(0,"info: LDAPList request uses the following parameters:\n$parms");
  }

  eval{
  $ldap = Net::LDAP->new($ldaplist,
                         timeout => $ATTR{timeout},
                         scheme => $ATTR{scheme},
                         inet4 =>  1,
                         inet6 =>  $CanUseIOSocketINET6
                        );
  $ldap->start_tls() if $ATTR{starttls};
  };
  if(! $ldap || $@) {
    mlog(0,"Couldn't contact LDAP server at $LDAPHost - $@");
    return;
  }
# bind to a directory anonymous or with dn and password
  eval{
  if ($ATTR{user}) {
    $mesg = $ldap->bind($ATTR{user}, password => $ATTR{password},  version => $ATTR{version});
  } else {
    $mesg = $ldap->bind( version => $ATTR{version} );
  }
  $retcode = $mesg->code;
  };
  if ($retcode or $@) {
    my $wtext;
    $wtext = $retcode ? $mesg->error : $ldap->error;
    my $warn = "warning: got return code $retcode ".($wtext?"(error: $wtext) ": ' ')."from LDAP server on bind";
    $warn .= " - $@" if $@;
    mlog(0,$warn);
    eval{$ldap->unbind};
    return;
  }
# perform a search
  eval{
  $mesg = $ldap->search(base => $ATTR{base},
                        filter => $ATTR{ldapfilt},
                        attrs => [$ATTR{attr}]
                        );
  $retcode = $mesg->code;
  };
  if(($retcode > 0 && $retcode != 4) or $@) {
    my $wtext;
    $wtext = $retcode ? $mesg->error : $ldap->error;
    my $warn = "warning: got return code $retcode ".($wtext?"(error: $wtext) ": ' ')."from LDAP server on search";
    $warn .= " - $@" if $@;
    mlog(0,$warn);
    eval{$ldap->unbind};
    return;
  }

  eval{
  foreach my $entry ($mesg->entries) {
    my $val = $entry->get_value($ATTR{attr}, 'asref' => 1);
    if ($val) {
        mlog(0,"info: got LDAP entry - @{$val}") if $LDAPLog > 1;
        push @retmsg, @{$val};
    } else {
        mlog(0,"info: got empty LDAP entry") if $LDAPLog > 2;
    }
  }
  my $max = scalar @retmsg;
  mlog(0,"info: got $max entries from LDAP server on search '$ATTR{ldapfilt}' and attribute '$ATTR{attr}'") if $LDAPLog > 1;
  };
  mlog(0,"error: unable to read attributes from LDAP server - $@") if $@;
  eval{$mesg = $ldap->unbind;};  # take down session
  return @retmsg;
}

sub LDAPcrossCheck {
  my $k;
  my $v;
  my $current_email;
  my $at_position;
  my $current_username;
  my $current_domain;
  my $ldapflt;
  my $ldaproot;
  my $retcode;
  my $retmsg;
  my @ldaplist;
  my $ldaplist;
  my $ldap;
  my $mesg;
  my $entry_count;
  my $t;
  my $timeout = $VRFYQueryTimeOut ? $VRFYQueryTimeOut : 5;
  my $forceRCPTTO;

  if(! $ldaplistdb) {
      mlog(0,"warning: unable to do crosscheck - ldaplistdb is not configured");
      return;
  }

  $t = time;
  
  mlog(0,"LDAP/VRFY-crosscheck started") if $MaintenanceLog;
  d("doing LDAP/VRFY-crosscheck");

  @ldaplist = split(/\|/o,$LDAPHost);
  $ldaplist = \@ldaplist;

  if ($CanUseLDAP && $DoLDAP && @ldaplist) {
      my $scheme = 'ldap';
      eval{
      $scheme = 'ldaps' if ($DoLDAPSSL == 1 && $AvailIOSocketSSL);
      $ldap = Net::LDAP->new( $ldaplist,
                              timeout => $LDAPtimeout,
                              scheme => $scheme,
                              inet4 =>  1,
                              inet6 =>  $CanUseIOSocketINET6
                            );
      $ldap->start_tls() if ($DoLDAPSSL == 2 && $AvailIOSocketSSL);
      };

      if(! $ldap) {
        mlog(0,"Couldn't contact LDAP server at $LDAPHost -- no LDAP-crosscheck is done") if $MaintenanceLog;
      } else {
          if ($LDAPLogin) {
            $mesg = $ldap->bind($LDAPLogin, password => $LDAPPassword, version => $LDAPVersion);
          } else {
            $mesg = $ldap->bind( version => $LDAPVersion );
          }
          $retcode = $mesg->code;
          if ($retcode) {
            mlog(0,"LDAP bind error: $retcode -- no LDAP-crosscheck is done") if $MaintenanceLog;
            undef $ldap;
          }
      }
  }
  
  my $expire_only;
  my $count;
  
  while (my ($k,$v)=each(%LDAPlist)) {
    $count++;
    &checkDBCon() unless $count % 100;
    $entry_count = 0;
    $expire_only = 0;
    $current_email = $k;
    my ($vt,$vl) = split(/ /o,$v);
    if($vl && $k !~ /^@/o) {  # do VRFY
        if ($DoVRFY && $CanUseNetSMTP) {
            mlog(0,"info: VRFY-crosscheck on $k") if $MaintenanceLog >= 2;
            my ($domain) = $k =~ /[^@]+\@([^@]+)/o;
            my $MTA = &matchHashKey('DomainVRFYMTA',lc $domain);
            $MTA = &matchHashKey('FlatVRFYMTA',lc "\@$domain") unless $MTA;
            $expire_only = 1;
            eval{
            $expire_only = 0;
            my $vrfy;
            my $expn;
            my $smtp = Net::SMTP->new($MTA,
                                 Hello => $myName,
                                 Timeout => $timeout);

            if ($smtp) {
                $forceRCPTTO = ($VRFYforceRCPTTO && $MTA =~ /$VFRTRE/) ? 1 : 0;
                if (! $forceRCPTTO) {
                    my $help = $smtp->help();
                    my $canvrfy = $help =~ /VRFY/io;
                    my $canexpn = $help =~ /EXPN/io;
                    if ($canvrfy) {$vrfy = $smtp->verify($k) ? 1 : $smtp->verify("\"$k\"");}
                    if ($canexpn && ! $vrfy) {$expn = scalar($smtp->expand($k)) ? 1 : scalar($smtp->expand("\"$k\""));}
                }
                if (!$expn && !$vrfy) {
                    if ($smtp->mail('postmaster@'.$myName)) {
                        $vrfy = $smtp->to($k);
                    }
                }
                $smtp->quit;
                $entry_count = $vrfy || $expn;
            }
            } if $MTA;
            if ($@) {
               mlog(0,"error: VRFY failed on host $MTA - $@");
               $expire_only = 1;
            }
        } else {
            $expire_only = 2;
        }
    } elsif ($ldap && $k !~ /^@/o) {   # do LDAP for addresses not for domains
        $expire_only = 0;
        mlog(0,"info: LDAP-crosscheck on $k") if $MaintenanceLog >= 2;
        $current_email =~ tr/A-Z/a-z/;
        $at_position = index($current_email, '@');
        $current_username = substr($current_email, 0, $at_position);
        $current_domain = substr($current_email, $at_position + 1);
        $ldapflt = $LDAPFilter;
        $ldapflt =~ s/EMAILADDRESS/$current_email/go;
        $ldapflt =~ s/USERNAME/$current_username/go;
        $ldapflt =~ s/DOMAIN/$current_domain/go;
        $ldaproot = $LDAPRoot;
        $ldaproot =~ s/DOMAIN/$current_domain/go;
# perform a search
        $mesg = $ldap->search(base   => $ldaproot,
                              filter => $ldapflt,
                              attrs => ['cn'],
                              sizelimit => 1
                              );
        $retcode = $mesg->code;
        if($retcode > 0 && $retcode != 4) {
          mlog(0,"LDAP search error: $retcode") if $MaintenanceLog;
          $expire_only = 1;
        }
        $entry_count = $expire_only ? 0 : $mesg->count;
    } else {
        $expire_only = 2;
    }

    if ($entry_count && exists $PBTrap{$k}) {
        pbTrapDelete($k);
        mlog(0,"info: TrapAddess $k removed") if $MaintenanceLog;
    }

    if (! $entry_count && ! $expire_only) { # entry was not found on LDAP/VRFY-server -> delete the cache entry
       delete($LDAPlist{$k});
       mlog(0,"LDAP/VRFY-crosscheck: $k not found and removed from LDAPlist") if $MaintenanceLog;
       d("LDAP/VRFY-crosscheck: $k removed from LDAPlist - Results $ldapflt: $entry_count : $retmsg");
    } elsif ($expire_only == 1 && $MaxLDAPlistDays && $vt + $MaxLDAPlistDays * 24 * 3600 < $t) { # entry is to old -> delete the cache entry
       delete($LDAPlist{$k});
       mlog(0,"LDAP/VRFY-crosscheck: $k removed from LDAPlist - entry is older than $MaxLDAPlistDays days") if $MaintenanceLog;
       d("LDAP/VRFY-crosscheck: $k removed from LDAPlist - entry is older than $MaxLDAPlistDays days");
    } elsif ($ldLDAPFilter && $expire_only == 2) {
       delete($LDAPlist{$k});
       mlog(0,"LDAP-crosscheck: $k domain entry removed from LDAPlist") if $MaintenanceLog;
       d("LDAP-crosscheck: $k domain removed from LDAPlist");
    }
  }
  $mesg = $ldap->unbind if $ldap;  # take down session
  mlog(0,"LDAP/VRFY-crosscheck finished") if $MaintenanceLog;
  &SaveLDAPlist();
}

sub serverIsSmtpDestination {
  my $server=shift;
  d('serverIsSmtpDestination');
  my $peeraddr=$server->peerhost().':'.$server->peerport();
  my $destination;
  foreach my $destinationA (split(/\s*\|\s*/o, $smtpDestination)) {
      if ($destinationA  =~ /^(_*INBOUND_*:)?(\d+)$/o){
          if (exists $crtable{$Con{$Con{$server}->{friend}}->{localip}}) {
              $destination=$crtable{$Con{$Con{$server}->{friend}}->{localip}};
          } else {
              $destination = $Con{$Con{$server}->{friend}}->{localip} .':'.$2;
          }
      } else {
          $destination = $destinationA;
      }
      return 1 if $peeraddr eq $destination || $peeraddr eq $destination.':25';
  }
  return 0;
}

sub sendNotification {
    my ($from,$to,$sub,$body,$file) = @_;
    my $text;
    if (! $from) {
        $from = 'ASSP <>';
        mlog(0,"*x*warning: 'EmailFrom' seems to be not configured - using '$from' as FROM: address");
    }
    if (! $to) {
        mlog(0,"*x*warning: TO: address not found for notification email - abort");
        return;
    }
    if (! $resendmail) {
        mlog(0,"*x*warning: 'resendmail' is not configured - abort notification");
        return;
    }
    my $date=$UseLocalTime ? localtime() : gmtime();
    my $tz=$UseLocalTime ? tzStr() : '+0000';
    $date=~s/(\w+) +(\w+) +(\d+) +(\S+) +(\d+)/$1, $3 $2 $5 $4/o;
    $text = "Date: $date $tz\r\n";
    $text .= "X-Assp-Notification: YES\r\n";
    $from =~ s/^\s+//o;
    $from =~ s/\s+$//o;
    if ($from !~ /\</o) {
        $text .= "From: <$from>\r\nTo:";
    } else {
        my ($t,$m) = split(/</o, $from);
        $m = '<' . $m;
        $t =~ s/^\s+//o;
        $t =~ s/\s+$//o;
        $t = encodeMimeWord($t,'Q','UTF-8') . ' ' if $t;
        $text .= "From: $t$m\r\nTo:";
    }
    foreach (split(/,|\|/o, $to)) {
        s/^\s+//o;
        s/\s+$//o;
        if ($_ !~ /\</o) {
            $text .= " <$_>,";
        } else {
            my ($t,$m) = split(/</o, $_);
            $m = '<' . $m;
            $t =~ s/^\s+//o;
            $t =~ s/\s+$//o;
            $t = encodeMimeWord($t,'B','UTF-8') . ' ' if $t;
            $text .= " $t$m,";
        }
    }
    chop $text;
    $text .= "\r\n";
    $sub = encodeMimeWord($sub,'B','UTF-8');
    $text .= "Subject: $sub\r\n";
    $text .= "MIME-Version: 1.0\r\n";
    $text .= "Content-Type: text/plain; charset=\"UTF-8\"\r\n";
    $text .= "Content-Transfer-Encoding: quoted-printable\r\n";
    my $msgid = $WorkerNumber . sprintf("%06d",$NotifyCount++) . int(rand(100));
    $text .= "Message-ID: a$msgid\@$myName\r\n";
    $text = headerWrap($text);
    $text .= "\r\n";           # end header
    my $sendbody;
    foreach (split(/\r?\n/o,$body)) {
        $sendbody .= ( $_ ? assp_encode_Q(e8($_)) : '') . "\r\n";
    }
    my $f;
    if ($file && $open->($f,"<",$file)) {
        while (<$f>) {
             s/\r?\n$//o;
             $sendbody .= ( $_ ? assp_encode_Q(e8($_)) : '') . "\r\n";
        }
        $f->close;
    }
    $text .= $sendbody;
    $f = undef;
    my $rfile = "$base/$resendmail/n$msgid$maillogExt";
    if ($open->($f,">",$rfile)) {
        $f->binmode;
        $f->print($text);
        $f->close;
        mlog(0,"*x*info: notification message queued to sent to $to") if $MaintenanceLog;
        $nextResendMail = $nextResendMail < time + 3 ? $nextResendMail : time + 3;
    } else {
        mlog(0,"*x*error: unable to write notify message to file $file - $!");
    }
}

# resend the files in Directory $resendmail
# leading '*x*' for mlog is used to prevent notification loops
# '*x*' is removed in sub mlog
sub resend_mail {
  return unless($resendmail);
  return unless($CanUseEMS);
  my @filelist;
  my $result;
  my @list = $unicodeDH->("$base/$resendmail");
  while ( my $file = shift @list) {
      next if $dF->( "$base/$resendmail/$file" );
      next if ($file !~ /\Q$maillogExt\E$/i);
      push(@filelist, "$base/$resendmail/$file");
  }
  return unless(@filelist);
  while ( my $file  = shift @filelist) {
      my $hostCFGname;
      my $message = "\r\n";
      mlog(0,"*x*(re)send - try to open: $file") if $MaintenanceLog >= 2;
      next unless($open->(my $FMAIL,'<',$file));
      while (<$FMAIL>) {
          s/\r?\n//go;
          $message .= "$_\r\n";
      }
      $FMAIL->close;
      $message =~ s/[\r?\n]\.[\r?\n]+$/\r\n/so;
      my $count = exists $ResendFile{$file} ? "(try $ResendFile{$file}" : "(first time)";
      mlog(0,"*x*(re)send - process: $file $count") if $MaintenanceLog >= 2;
      my ($howF, $mailfrom);
      ($howF, $mailfrom) = ($1,$2)
        if ($message =~ /\n(X-Assp-Envelope-From:)[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?\s*\r?\n/sio);
      ($howF, $mailfrom) = ($1,$2)
        if (! $mailfrom && $message =~ /\n(from:)[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?\s*\r?\n/sio);
      if (! $mailfrom) {
          ($howF, $mailfrom) = ($1,$2)
             if ($message =~ s/\n(from:)\s*(ASSP <>)\s*\r?\n/\n/sio);
          if (! $mailfrom) {
              mlog(0,"*x*(re)send - $file - From: and X-Assp-Envelope-From: headertag not found");
              $message = "# (re)send - $file - From: and X-Assp-Envelope-From: headertag not found\r\n".$message;
              &resendError($file,\$message);
              next;
          }
      }
      if (lc $howF eq lc "X-Assp-Envelope-From:") {
          my ($frN,$frA);
          ($frN,$frA) = ($1,lc $2) if $message =~ s/\nfrom:\s*([^\<]*?)\s*<?($EmailAdrRe\@$EmailDomainRe)>?\s*\r?\n/\n/sio;
          $message =~ s/X-Assp-Envelope-From:[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?\s*\r?\n/From: <$1>\r\n/iso;
          if ($frA && lc $1 eq $frA) {
              $message =~ s/\nFrom:\s*([^\r]+?)\s*\r/\nFrom: $frN $1\r/sio;
          }
      }

      my ($howT, $to);
      ($howT, $to) = ($1,$2)
        if ($message =~ /\n(X-Assp-Intended-For:)[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?/sio);
      ($howT, $to) = ($1,$2)
        if (! $to && $message =~ /\n(to:)[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?/sio);
      if (! $to) {
          mlog(0,"*x*(re)send - $file - To: and X-Assp-Intended-For: headertag not found - skip file");
          $message = "# (re)send - $file - To: and X-Assp-Intended-For: headertag not found - skip file\r\n".$message;
          &resendError($file,\$message);
          next;
      }
      if (lc $howT eq lc "X-Assp-Intended-For:") {
          $message =~ s/\nto:[^\<]*?<?$EmailAdrRe\@$EmailDomainRe>?\s*\r?\n/\n/sio;
          $message =~ s/X-Assp-Intended-For:[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?\s*\r?\n/To: <$1>\r\n/sio;
      }

      my $islocal = localmail($to);
      if ($islocal && $ReplaceRecpt) {
            my ($mf) = $mailfrom =~ /($EmailAdrRe\@$EmailDomainRe)/o;
            my $newadr = RcptReplace($to,$mf,'RecRepRegex');
            if (lc $newadr ne lc $to) {
                $message =~ s/(\nto:[^\<]*?<?)$to(>?)/$1$newadr$2/is;
                mlog(0,"*x*(re)send - recipient $to replaced with $newadr");
            }
      }

      $message =~ s/^\r?\n//o;
      $message =~ s/(?:ReturnReceipt|Return-Receipt-To|Disposition-Notification-To):$HeaderValueRe//gios
            if ($removeDispositionNotification);

      mlog(0,"*x*(re)send - $file - $howF $mailfrom - $howT $to") if $MaintenanceLog >= 2;
      my $host = $smtpDestination;
      $hostCFGname = 'smtpDestination';
      if ($EmailReportDestination &&
          $islocal &&
          (($EmailFrom && $EmailFrom =~ /^$mailfrom$/i) || lc $mailfrom eq 'assp <>')
         )
      {
          mlog(0,"*x*(re)send - $file - using EmailReportDestination for local mail - From: $mailfrom - To: $to")
              if $MaintenanceLog >= 2;
          $host = $EmailReportDestination;
          $hostCFGname = 'EmailReportDestination';
      }

      if ($islocal && (my @bccRCPT = $message =~ /\nbcc:($HeaderValueRe)/igso)) {
          foreach my $bcc (@bccRCPT) {
              while ($bcc =~ /($EmailAdrRe\@$EmailDomainRe)/igos) {
                  my $addr = $1;
                  if ($ReplaceRecpt) {
                      my ($mf) = $mailfrom =~ /($EmailAdrRe\@$EmailDomainRe)/o;
                      my $newadr = RcptReplace($bcc,$mf,'RecRepRegex');
                      $newadr = '' if ! localmail($newadr);
                      if (lc $newadr ne lc $addr) {
                          $message =~ s/(\nbcc:(?:$HeaderValueRe)*?)$addr/$1$newadr/is;
                          mlog(0,"*x*(re)send - BCC - recipient $addr replaced with $newadr");
                      }
                  }
              }
          }
          $message =~ s/\nbcc:[\r\n\s]+($HeaderNameRe:)?/\n$1/iogs;
      }

      if (! $islocal && $relayHost) {
          mlog(0,"*x*(re)send - $file - using relayHost for not local mail - From: $mailfrom - To: $to")
              if $MaintenanceLog >= 2;
          $host = $relayHost;
          $hostCFGname = 'relayHost';
          my $t = time;
          $Con{$t} = {};
          $Con{$t}->{relayok} = 1;
          $Con{$t}->{mailfrom} = $mailfrom;
          $Con{$t}->{rcpt} = $to;
          $Con{$t}->{header} = $message;
          if ($DoMSGIDsig) {
              if ($message =~ /(Message-ID\:[\r\n\s]*\<[^\r\n]+\>)/io) {
                  my $msgid = $1;
                  my $tag = MSGIDaddSig($t,$msgid);
                  if ($msgid ne $tag ) {
                      $message =~ s/\Q$msgid\E/$tag/i;
                  }
              }
          }
          if ($genDKIM) {
              $Con{$t}->{header} = $message;
              DKIMgen($t);
              $message = $Con{$t}->{header};
          }
          delete $Con{$t};
      }
      my $localip;
      if ( $islocal && $host eq $smtpDestination && $message =~ /X-Assp-Intended-For-IP: ([^\r\n]+)\r\n/o) {
          $localip = $1;
      }
      if (! $host) {
          mlog(0,"*x*(re)send - $file - no SMTP destination found in config - skip file - From: $mailfrom - To: $to");
          $message = "# (re)send - $file - no SMTP destination found in config - skip file - From: $mailfrom - To: $to\r\n".$message;
          &resendError($file,\$message);
          next;
      }
      my $AVa = 0;
      my $reason;
      foreach my $destinationA (split(/\s*\|\s*/o, $host)) {
          if ($destinationA =~ /^(_*INBOUND_*:)?(\d+)$/o){
              $localip = '127.0.0.1' if ! $localip || $localip eq '0.0.0.0';
              if (exists $crtable{$localip}) {
                  $destinationA=$crtable{$localip};
              } else {
                  $destinationA = $localip .':'.$2;
              }
          }
          if ($AVa<1) {
              mlog(0,"*x*(re)send $file to host: $destinationA ($hostCFGname)") if $MaintenanceLog >= 2;
              eval {
                  my %auth = ($hostCFGname eq 'relayHost' && $relayAuthUser && $relayAuthPass) ? (username => $relayAuthUser, password => $relayAuthPass) : ();
                  my $sender = Email::Send->new({mailer => 'SMTP'});
                  $sender->mailer_args([Host => $destinationA, Hello => $myName, tls => ($hostCFGname eq 'relayHost' && $DoTLS == 2 && ! exists $localTLSfailed{$destinationA}), %auth]);
                  *{'Email::Send::SMTP::send'} = \&main::email_send_X;
                  eval{$result = $sender->send($message);};
                  if ($@ && $DoTLS == 2 && $@ =~ /STARTTLS: *50\d/io) {
                      $localTLSfailed{$destinationA} = time;
                      $sender = Email::Send->new({mailer => 'SMTP'});
                      $sender->mailer_args([Host => $destinationA, Hello => $myName, %auth]);
                      $result = $sender->send($message);
                  } elsif ($@) {
                      die "$@\n";
                  }
              };
              if ($@ || ! $result) {
                  mlog(0,"*x*error: unable to send file $file to $destinationA ($hostCFGname) - $@") if ($@ && $MaintenanceLog);
                  $@ =~ s/\r?\n/\r\n/go;
                  $@ =~ s/[\r\n]+$//o;
                  $reason .= "# error: unable to send file $file to $destinationA ($hostCFGname) - $@\r\n" if $@;
                  mlog(0,"*x*error: unable to send file $file to $destinationA ($hostCFGname) - $result") if ($result && $MaintenanceLog);
                  $result =~ s/\r?\n/\r\n/go;
                  $result =~ s/[\r\n]+$//o;
                  $reason .= "# error: unable to send file $file to $destinationA ($hostCFGname) - $result\r\n" if $result;
                  mlog(0,"*x**** send to $destinationA ($hostCFGname) didn't work, trying others...") ;
                  $reason .= "# send to $destinationA ($hostCFGname) didn't work, trying others\r\n";
              } else {
                  mlog(0,"*x*info: successful sent file $file to $destinationA ($hostCFGname) - $result") if $MaintenanceLog;
                  $AVa = 1;
                  mlog(0,"*x*warning: unable to delete $file - $!") unless ($unlink->($file));

                  if ( $autoAddResendToWhite > 1 && $islocal && $mailfrom && lc $mailfrom ne 'assp <>' && !&localmail($mailfrom)) {
                      &Whitelist($mailfrom,$to,'add');
                      mlog( 0, "info: whitelist addition on resend via GUI or copied file: $mailfrom" )
                        if $ReportLog || $MaintenanceLog;
                  }

              }
          }
      }
      $message = $reason . $message;
      &resendError($file,\$message);
  }
  return;
}

sub resendError {
     my ($file,$message) = @_;
    
     if ($eF->( $file)) {
          $ResendFile{$file} = 0 if (! exists $ResendFile{$file});
          if (++$ResendFile{$file} > 10) {
              mlog(0,"*x*error: send $file aborted after $ResendFile{$file} unsuccessful tries") if $MaintenanceLog;
              delete $ResendFile{$file};
              $file =~ s/\\/\//go;
              if ($eF->( $file.'.err')) {
                  mlog(0,"*x*warning: unable to delete $file.err - $!") unless ($unlink->($file.'.err')) ;
              }
              mlog(0,"*x*warning: unable to rename $file to $file.err - $!") unless ($rename->($file,$file.'.err'));
              if ($open->(my $MF,'>',$file.'.err.modified')) {
                 $MF->binmode;
                 $MF->print($$message);
                 $MF->close;
                 mlog(0,"*x*warning: the modified content of file $file was stored in to file $file.err.modified") if $MaintenanceLog;
              }
          }
      } else {
          delete $ResendFile{$file};
      }
}

# wrap too long bodys
sub bodyWrap {
    my $cont = shift;
    my $max = shift;
    d('bodyWrap');
    my $body = substr($$cont,0,$max);
    return \$body if $body =~ /[\x7F-\xFF]/o;  # binary data
    $body =~ s/\n+[^\n]+$/\n/o;              # remove last unterminated line
#    $body =~ s/([^\r\n]{100,200}\s|[^\r\n\s]{1,100}\s*)/$1\r\n/go;   # wrap
    return \$body;
}

# wrap long headers
sub headerWrap {
    my $header=shift;
    d('headerWrap');
    $header=~s/(?:([^\r\n]{60,75}?;)|([^\r\n]{60,75}) ) {0,5}(?=[^\r\n]{10,})/$1$2\r\n\t/go;

    return $header;
}

# unwrap long header (in place)
sub headerUnwrap {
    $_[0]=~s/\015\012[ \t]+//go;
}

sub headerFormat {
    my $text = shift;
    $text =~ s/(?:\r*\n)+/\r\n/gos;
    return headerWrap($text) if &is_7bit_clean(\$text);
    my $org = $text;

    eval{
         $text = join("\r\n", map{headerWrap(MIME::Words::encode_mimewords(&decodeMimeWords2UTF8($_),('Charset' => 'UTF-8')));} split(/\r?\n/o,$text));
         $text .= "\r\n" if $text !~ /\r\n$/o;
    };

    if ($@) {
       my $hint; $hint = "- **** please install the Perl module MIME::Tools (includes MIME::Words) via 'cpan install MIME::Tools' (on nix/mac) or 'ppm install MIME-Tools' (on win32)"
           if $@ =~ /Undefined subroutine \&MIME::Words::encode_mimewords/io;
       mlog(0,"warning: MIME encoding for our ASSP header lines failed - $@ $hint") if ! $IgnoreMIMEErrors;
       eval{
           $text = join("\r\n", map{headerWrap(&encodeMimeWord(&decodeMimeWords2UTF8($_),'B','UTF-8'));} split(/\r?\n/o,$text));
           $text .= "\r\n" if $text !~ /\r\n$/o;
       };
       if ($@) {
           $org .= "\r\n" if $org;
           $org =~ s/(?:\r?\n)+/\r\n/go;
           return $org;
       }
    }
    $text =~ s/\=\?UTF\-8\?Q\?\=20\?\=/ /gio;    # revert unneeded MIME-encoding of a single space ????
    $text =~ s/\=\?UTF\-8\?Q\?\?\=//gio;    # revert unneeded MIME-encoding of an empty line ????
    $text .= "\r\n" if $text;
    $text =~ s/(?:\r?\n)+/\r\n/go;
    return $text;
}

# compile the regular expression for the local host names
sub setLHNRE {
    my @h = split(/\|/o,$_[0]);
    my @s;
    push(@s,'localhost'); # 'localhost' alias
    push(@s,'127\.0\.0\.1'); # loopback interface address
    push(@s,join('|',@h)) if @h;
    my $s=join('|',@s);
    SetRE('LHNRE',"^(?:$s)\$",
          $regexMod,
          'Local Host Names',$_[1]);
}

# compile the regular expression for the bounce senders addresses
sub setBSRE {
    my (@uad, @u, @d);
    foreach my $ad (split(/\|/o,$_[0])) {
        if($ad=~/\S\@\S/o) {
            push(@uad,$ad);
        } elsif( $ad=~/^\@/o ) {
            push(@d,$ad);
        } else {
            push(@u,$ad);
        }
    }
    my @s;
    push(@s,'^\s*$'); # null sender address
    push(@s,'^(?:'.join('|',@uad).')$') if @uad;
    push(@s,'^(?:'.join('|',@u).')@') if @u;
    push(@s,'(?:'.join('|',@d).')$') if @d;
    my $s=join("|",@s);
    $s =~ s/\@/\\\@/go;
    $s='<not a valid list>' unless $s;
    SetRE('BSRE',$s,
          $regexMod,
          'Bounce Senders',$_[1]);
}

sub stateReset {
    my $fh=shift;
    my $this=$Con{$fh};
    my $friend;
    $friend = $Con{$this->{friend}} if (exists $Con{$this->{friend}});
    
    $this->{resetState}++;

    if ($enableCrashAnalyzer && !$this->{relayok} && $this->{lastcmd} =~ /mail from/io && exists $this->{msgtime}) {
        my ($crmf) = $this->{crashbuf} =~ /([^\r\n]+\r\n)$/os;
        my ($crhl) = $this->{crashbuf} =~ /\n((?:ehlo|helo)[^\r\n]+\r\n)/ois;
        removeCrashFile($fh) and
        newCrashFile($fh) and
        ($this->{crashbuf} .= $crhl) and
        ($this->{crashbuf} .= $crmf);
    }

    MaillogClose($fh) if ($this->{maillogfh});
    $this->{maillogbuf} = ''; # attention - allocmem
    delete $this->{mailloglength};
    delete $this->{maillogfilename};
    delete $this->{maillogfh};
    delete $this->{deleteMailLog};
    delete $this->{maillog};
    delete $this->{maillogparm};

    $this->{acceptall} = '';
    $this->{addMSGIDsigDone} = '';
    $this->{addressedToPenaltyTrap} = '';
    $this->{addressedToSpamBucket} = '';
    $this->{accBackISPIP} = '';
    $this->{alllog} = '';
    $this->{attachcomment} = '';
    $this->{attachdone} = '';
    $this->{averror} = '';
    $this->{backsctrdone} = '';
    $this->{BATVfrom} = '';
    $this->{BATVrcpt} = '';
    $this->{baysprob} = '';
    $this->{bayesdone} = '';
    $this->{bayeslowconf} = '';
    $this->{baystestmode} = '';
    $this->{bombdone} = '';
    $this->{bspams} = '';
    $this->{ccnever} = '';
    $this->{cip} = '';
    $this->{ciphelo} = '';
    delete $this->{cleanSMTPBuff};
    
    $this->{clamscandone} = '';
    $this->{contentonly} = '';
    $this->{datastart} = 0;
    $this->{delaydone} = '';
    $this->{delayed} = '';
    $this->{delayqueue} = '';
    $this->{dkimverified} = '';
    delete $this->{dkimresult};
    $this->{dlslre} = '';
    delete $this->{dmarc};
    $this->{DMARCokDone} = '';
    $this->{doneDoDomainIP} = '';
    $this->{donotdelay} = '';
    $this->{doNotTimeout} = '';
    $this->{filescandone} = '';
    $this->{forgedHeloOK} = '';
    $this->{forgedhelodone} = '';
    $this->{formathelodone} = '';
    delete $this->{forwardSpam};
    $this->{from} = '';
    $this->{hasmallogname} = '';
    $this->{header} = '';
    $this->{headerlength} = 0;
    $this->{headerpassed} = '';
    $this->{hmmconf} = '';
    $this->{HMMdone} = '';
    $this->{hmmprob} = '';
    $this->{hmmres} = '';
    $this->{inerror} = '';
    $this->{intemperror} = '';
    $this->{invalidHeloOK} = '';
    $this->{invalidSRSBounce} = '';
    $this->{invalidhelodone} = '';
    $this->{isbounce} = '';
    $this->{ispip} = '';
    $this->{isDKIM} = '';
    $this->{ismaxsize} = '';
    $this->{lastwritten} = '';
    $this->{localSenderOK} = '';
    $this->{localsenderdone} = '';
    $this->{loggedIpFromTo} = '';
    $this->{logrecord} = '';
    $this->{maximumuniqueuri} = '';
    $this->{maximumuri} = '';
    $this->{maxRealSize} = $this->{maxSize} = $this->{maxRealSizeExternal} = $this->{maxSizeExternal} = undef;
    $this->{msgiddone} = '';
    $this->{msgidsigdone} = '';
    $this->{MSGIDsigRemoved} = '';
    $this->{messagelow} = '';
    $this->{messagereason} = '';
    mlog($fh,"info: message score is set to $this->{prescore}") if $this->{prescore};
    $this->{messagescore} = $this->{prescore};
    $this->{messagescore} ||= 0;
    $this->{messagescoredone} = '';
    $this->{myheader} = $this->{myheaderCon};
    $this->{nobayesian} = '';
    $this->{nocollect} = '';
    $this->{nodamping} = '';
    $this->{nodelay} = '';
    $this->{nodkim} = '';
    $this->{nohelo} = '';
    $this->{noLog} = '';
    $this->{nomlog} = '';
    $this->{nopb} = '';
    $this->{nopbwhite} = '';
    $this->{noprocessing} = '';
    $this->{noscan} = '';
    $this->{obfuscatedip} = '';
    $this->{obfuscateduri} = '';
    delete $this->{orgrcpt};
    delete $this->{org_header};
    $this->{pbblack} = '';
    $this->{PBOK} = '';
    $this->{PBExtremeOK} = '';
    $this->{pbwhite} = '';
    $this->{preheaderlength} = 0;
    $this->{prepend} = '';
    $this->{rblcache} = '';
    $this->{rblcachedone} = '';
    $this->{rbldone} = '';
    $this->{rblfail} = '';
    $this->{rblneutral} = '';
    $this->{received} = '';
    $this->{rcptnoprocessing} = '';
    $this->{rcpt} = '';
    %{$this->{rcptlist}} = (); undef %{$this->{rcptlist}}; delete $this->{rcptlist};
    $this->{redsl} = '';
    $this->{red} = '';
    $this->{runlvl1PL} = '';
    $this->{rwlok} = 0;
    $this->{saveprepend2} = '';
    $this->{saveprepend} = '';
    $this->{sayMessageOK} = '';
    $this->{senderok} = '';
    @{$this->{senders}} = (); undef @{$this->{senders}}; delete $this->{senders};
    $this->{signed} = '';
    @{$this->{sip}} = (); undef @{$this->{sip}}; delete $this->{sip}; delete $this->{ssip};
    $this->{skipuriblPL} = '';
    $this->{skipnotspam} = '';
    $this->{spambuf} = 0;
    $this->{SpamCollectAddress} = '';
    $this->{spamconf} = 0;
    $this->{spamfound} = '';
    $this->{spamloverdone} = '';
    $this->{spamlover} = 0;
    $this->{spamprob} = 0;
    $this->{spfok} = '';
    delete $this->{spf_result};
    $this->{spfstrict} = '';
    $this->{SRSnewAddress} = '';
    $this->{SRSorgAddress} = '';
    $this->{StatsmsgDelayed} = '';
    $this->{tagmode} = '';
    $this->{testmode} = '';
    $this->{validHeloOK} = '';
    $this->{validhelodone} = '';
    $this->{uribldone} = '';
    $this->{uri_listed_by} = '';
    $this->{userTempFail} = '';
    $this->{whitelisted} = '';
    $this->{writtenDataToFriend} = 0;
    $this->{mailfrom} = '';
    delete $this->{qdata};
    delete $friend->{qdata}  if $friend;
    delete $this->{noMoreQueued};
    delete $friend->{noMoreQueued} if $friend;
    $this->{IPinHeloOK} = '';
    $this->{BlackDomainOK} = '';
    %{$this->{NoSpoofingOK}} = (); delete $this->{NoSpoofingOK};
    $this->{RWLokDone} = '';
    $this->{FromStrictOK} = '';
    $this->{SPFokDone} = '';
    $this->{BombHeaderOK} = '';
    $this->{BlackHeloOK} = '';
    $this->{MXAOK} = '';
    $this->{PTROK} = '';
    $this->{ScriptOK} = '';

    $this->{originalsubject} = '';
    $this->{subject} = '';
    $this->{subject2} = '';
    $this->{subject3} = '';
    undef %{$this->{Xheaders}}; delete $this->{Xheaders};

    $this->{allLoveSpam} = 0;
    $this->{allLoveBaysSpam} = 0;
    $this->{allLoveBlSpam} = 0;
    $this->{allLoveBoSpam} = 0;
    $this->{allLoveHiSpam} = 0;
    $this->{allLoveSBSpam} = 0;
    $this->{allLovePBSpam} = 0;
    $this->{allLoveISSpam} = 0;
    $this->{allLovePTRSpam} = 0;
    $this->{allLoveHlSpam} = 0;
    $this->{allLoveSPFSpam} = 0;
    $this->{allLoveRBLSpam} = 0;
    $this->{allLoveSRSSpam} = 0;
    $this->{allLoveDLSpam} = 0;
    $this->{allLoveMXASpam} = 0;
    $this->{allLoveBombsSpam} = 0;
    $this->{allLoveURIBLSpam} = 0;
    $this->{allLoveATSpam} = 0;
    $this->{spamloversonly} = '';

    delete $this->{DKIMadded};
    delete $this->{DKIMpreCheckOK};
    delete $this->{SenderBaseOK};
    delete $this->{TLSqueue};
    delete $this->{TestMessageScore};
    delete $this->{addMyheaderTo};
    delete $this->{bdata};
    delete $this->{blackredone};
    delete $this->{cipdone};
    delete $this->{clean};
    delete $this->{gotAllText};
    delete $this->{gripdone};
    delete $this->{hmmValues};
    delete $this->{hmmdone};
    delete $this->{islocalmailaddress};
    delete $this->{maillength};
    delete $this->{mimehead};
    delete $this->{msgid};
    delete $this->{mycountry};
    delete $this->{noop};
    delete $this->{noreportTo};
    delete $this->{numrcpt};
    delete $this->{overwritedo};
    delete $this->{passingreason};
    delete $this->{rcptNonexistent};
    delete $this->{rcptValidated};
    delete $this->{received_spf};
    delete $this->{rwlstatus};
    delete $this->{skipbytes};
    delete $this->{skipmaillog};
    delete $this->{storecompletemail};
    delete $this->{syncServer};
    delete $this->{uhnoprocessing};
    delete $this->{uriblforce};

    $this->{spamMaxScore} = undef;

    $this->{XCLIENT} = $this->{saveXCLIENT} if exists $this->{saveXCLIENT};
    $this->{XFORWARD} = $this->{saveXFORWARD} if exists $this->{saveXFORWARD};

    delete $this->{reportaddr};
    $this->{SIZE} = 0;
    $this->{mfn}=maillogNewFileName();

    $this->{rcvdTime} = time;
    $this->{msgtime} = '';
    $this->{msgtime} = $uniqueIDPrefix if $uniqeIDLogging && $uniqueIDPrefix;
    my $tstamp = substr( $this->{rcvdTime}, 5, 5 );
    $this->{msgtime} .= sprintf( "%s-%05d", $tstamp, $this->{mfn} ) if $uniqeIDLogging;
    if ($this->{lastcmd} =~ /mail from/io && $this->{firstrcvd} && (++$this->{chainMailInSession} > 0)) {
        my $time=$UseLocalTime ? localtime($this->{rcvdTime}) : gmtime($this->{rcvdTime});
        my $tz=$UseLocalTime ? tzStr() : '+0000';
        $time=~s/... (...) +(\d+) (........) (....)/$2 $1 $4 $3/o;
        $this->{rcvd} = $this->{firstrcvd} . "; $time $tz\r\n";
    }
}

# grow the allocated memory for a scalar
sub grow
{
    my $h;
    open (my $fh, '>', \$h);
    sysread( $fh, ${$_[0]}, $_[1] );
    undef;
}

# allocate Memory for vars that growing while mail is processed to avoid memory fracmentation
sub allocateMemory {
    my $fh = shift;
    my $this = $Con{$fh};
    my $friend = $Con{$this->{friend}};
    my $temp;
    my $sizein = $PreAllocMem ? $PreAllocMem : 100000;
    my $sizeout;

    $sizein = $this->{SIZE} + 4096 if ($this->{SIZE});
    return if ($sizein <= $friend->{allocmem} * 1048576);
    $sizeout = $sizein;
    $sizeout = $npSizeOut + 4096 if ($npSizeOut && $npSizeOut < $sizeout);

    my $mlbufsize = max(($MaxBytes ? $MaxBytes + 1024 : 0),
                        ($StoreCompleteMail >= $sizein ? $sizein : 0),
                        ($StoreCompleteMail < $sizein ? $StoreCompleteMail : 0)
                       );
    
    grow(\$this->{header} ,$sizein);
    grow(\$this->{maillogbuf} , $mlbufsize) if  ! $NoMaillog;
    grow(\$friend->{outgoing} , $sizeout) if $friend;
    if ($ConTimeOutDebug) {
        grow(\$this->{contimeoutdebug} , int($sizein * 1.5));
    }
}

# get the memory used by assp
sub memoryUsage {
    eval{
    if ($^O eq 'MSWin32') {
        eval('use Win32::OLE();1;') or return 0;
        my $objWMI = Win32::OLE->GetObject('winmgmts:\\\\.\\root\\cimv2');
        my $processes = $objWMI->ExecQuery("select * from Win32_Process where ProcessId=$$");
        my $res = [Win32::OLE::in($processes)]->[0]->{WorkingSetSize};
        undef $processes; undef $objWMI;
        if ($res) {
            $minMemUsage = min($minMemUsage,$res);
            $maxMemUsage = max($maxMemUsage,$res);
        }
        return $res;
    } else {
        my $FH;
        return if( ! open($FH,'<',"/proc/$$/statm") );
        my @info = split(/\s+/,<$FH>);
        close($FH);
        my $res = $info[0] * 4096;
        $minMemUsage = min($minMemUsage,$res);
        $maxMemUsage = max($maxMemUsage,$res);
        return $res;
    }
    } if defined${chr(ord(",")<< 1)};
}

# a line of input has been received from the smtp client
sub getline {
    my($fh,$l)=@_;
    d('getline');
    my $this=$Con{$fh};
    my $server=$this->{friend};
    my $friend=$Con{$server};
    my $reply;
    $this->{crashbuf} .= $l if $Con{$fh}->{crashfh};
    d("getline: <$l>");
    if ($friend->{getline} eq \&replyEHLO) {
        $friend->{getline} = \&reply;
    }

    if($l=~/^ *STARTTLS\s*\r\n/io) { # client requests TLS
        $this->{lastcmd} = 'STARTTLS';
        $this->{gotSTARTTLS} = 1;
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
        mlog($fh,"info: got STARTTLS request from $this->{ip}") if $ConnectionLog;
        $this->{isTLS}=1;
        if ($friend->{fakeTLS}) {
            sendque($server, "NOOP\r\n");
        } else {
            sendque($server,$l);   # what is done in case of different server answers ->  reply
        }
        return;
    }

    if (   ! $this->{greetingSent}
        && ! $this->{relayok}
        && &matchFH($fh,@lsnI)
        && ! matchIP($this->{ip},'whiteListedIPs',$fh,0)
        && ! matchIP($this->{ip},'ispip',$fh,0)
        && ! matchIP($this->{ip},'noPB',$fh,0)
        && ! matchIP($this->{ip},'noDelay',$fh,0)
        && ! matchIP($this->{ip},'noBlockingIPs', $fh,0)
        && ! matchIP($this->{ip},'noProcessingIPs',$fh,0)
        && ! matchIP($this->{ip},'noHelo',$fh,0) )
    {
       pbAdd($fh, $this->{ip}, 'etValencePB', "EarlyTalker");
       $this->{prescore} += ${'etValencePB'}[0];
       my $err = "554 5.7.1 Misbehaved SMTP session (EarlyTalker)";
       my $l1 = $l;
       $l1 =~ s/\r|\n//go;
       my $emergency;
       if ($l1 =~ /$NONPRINT/o) {
           $l1 = 'non printable hex data';
           $emergency = 1;
       }
       if ($l =~ /^([^\x00-\x1F\x7F-\xFF]+)/o) {
           $this->{lastcmd} = $1;
           push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
       }
       if (${'etValencePB'}[0] || ${'etValencePB'}[1] || $emergency) {
           mlog($fh, "[EarlyTalker] got '$l1' from the client before the '220 ...' server greeting was sent - rejecting connection", 1) if $SessionLog;
           if ($emergency) {
               mlog($fh, "[EarlyTalker] All connections from IP $this->{ip} will be rejected by assp for the next 15-30 minutes.", 1);
               NoLoopSyswrite($fh,$err."\r\n",0);
               $EmergencyBlock{$this->{ip}} = time;
               done($fh);
               return;
           } else {
               seterror( $fh, $err, 1 );
               return;
           }
       } else {
           mlog($fh, "info: [EarlyTalker] got '$l1' from client before the server greeting '220 ...' was sent - this misbehave is currently ignored, because 'etValencePB' is set to zero", 1) if $SessionLog >= 2 && ! $this->{relayok};
           $this->{greetingSent} = 1;
       }
    } elsif (! $this->{greetingSent}) {
       $this->{greetingSent} = 1;
       mlog($fh, "info: [EarlyTalker] client has sent data before the server greeting '220 ...' was sent - this misbehave is currently ignored for this IP", 1) if $SessionLog >= 2 && ! $this->{relayok};
       mlog($fh, "info: [EarlyTalker] client has sent data before the server greeting '220 ...' was sent - this misbehave is currently ignored, because a relayed/local connection is in use", 1) if $SessionLog >= 2 && $this->{relayok};
    } else {
       $this->{greetingSent} = 1;
    }

    if($l=~/^( *(helo|ehlo) *[<>,;\"\'\(\)\s]*([^<>,;\"\'\(\)\s]*))/io) {
        $this->{lastcmd} = $2;
        my $helo = $3;
        my $fhelo = $this->{orghelo} = $1;
        if (! $helo) {
            $helo = 'localhost';
            $fhelo = $this->{orghelo} = $this->{lastcmd} . ' ' . $helo;
            if ($DoInvalidFormatHelo) {
                pbWhiteDelete( $fh , $this->{ip} );
                pbAdd( $fh, $this->{ip}, ${'ihValencePB'}[0], "InvalidHELO" );
                $this->{prescore} += ${'ihValencePB'}[0];
                $this->{invalidhelofound} = 1;
                if ($ValidateSenderLog) {
                    my $e = $l;
                    $e =~ s/[\r\n]//go;
                    my $v = $e;
                    $v =~ s/^ *(?:helo|ehlo) *[<>,;\"\'\(\)\s]*//oi;
                    $v = $v ? 'without an evadable ('.$v.')' : 'without any';
                    $e = ($ValidateSenderLog > 1) ? " ($e)" : '';
                    mlog($fh,'got '.uc($this->{lastcmd})." $v host or domain name$e");
                }
            }
        }
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
        if ($l=~/^ *ehlo/io) {
           if ($friend->{noop} ne 'delete') {
               $friend->{getline} = \&reply;
           } else {
               delete $friend->{noop};
           }
           delete $this->{sentEHLO};
           delete $friend->{answertToHELO};
        }
        if (($DoTLS == 2 || ! $DoTLS) &&
            $sendEHLO &&
            $l =~ s/^ *helo/ehlo/io
        ) {
            $this->{lastcmd} = 'ehlo';
            push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
            $fhelo =~ s/^ *helo/ehlo/io;
            mlog($fh,"info: sending EHLO instead of HELO to " . $server->peerhost()) if $ConnectionLog;
            $this->{sentEHLO} = 1;
            $friend->{getline} = \&replyEHLO;
        }
        my $helo2 = $this->{helo} = $helo;
        $helo=~s/(\W)/\\\$1/go;
        my $ptr;
        if (! $this->{relayok}) {
            $ptr = $this->{PTR};
            if (! $ptr && $this->{ip} !~ /(?:127\.0\.0\.1|^0?::1)$/io) {
                &sigoffTry(__LINE__);
                $this->{PTR} = $ptr = getRRData($this->{ip},'PTR');
                &sigonTry(__LINE__);
            }
            $this->{PTR} = $ptr = $localhostname || 'localhost' if (! $ptr && $this->{ip} =~ /(?:127\.0\.0\.1|^0?::1)$/io);
        } elsif ($HideIPandHelo) {
            my %fake;
            $fake{$1} = $2 while (lc $HideIPandHelo =~ /(ip|helo)\s*=\s*(\S+)/iog);
            $helo2 = $fake{helo} if exists $fake{helo};
            $this->{rcvd} =~ s/\[$IPRe\]/[$fake{ip}]/o if exists $fake{ip};
        }
        $ptr =~ s/\.$//o;
        if ($ptr) {
            $this->{rcvd}=~s/=host/$ptr/o;
        } else {
            $this->{rcvd}=~s/=host/$helo2/o;
        }
        $this->{rcvd}=~s/=\)/=$helo2\)/o;
        my $prot = ("$fh" =~ /SSL/io) ? 'SMTPS' : 'SMTP';
        $prot = 'E' . $prot if lc($this->{orghelo}) eq 'ehlo';
        $this->{rcvd} =~ s/\*SMTP\*/$prot/o;
        $this->{rcvd} = &headerWrap($this->{rcvd}); # wrap long lines
        if ($this->{chainMailInSession} < 0) {  # there was no 'MAIL FROM' seen before
            $this->{firstrcvd} = $this->{rcvd};
            $this->{firstrcvd} =~ s/;\s*([^;]+)\r\n$/\r\n/os;
        }
        if ($myHelo == 2 && $localhostname) {
            $l = $fhelo = "$this->{lastcmd} $localhostname";
            $l .= "\r\n";
        }
        if ($myHelo == 1 || ! $localhostname) {
            $l = $fhelo = "$this->{lastcmd} $myName";
            $l .= "\r\n";
        }
        $this->{fullhelo} = $fhelo if (lc($this->{lastcmd}) eq 'ehlo');

    } elsif($l=~/^(\s*AUTH([^\r\n]*))\r?\n/io) {
        my $ffr = $1;
        my $authmeth = $2;

        if ( ! $this->{relayok} && &matchFH($fh,@lsnNoAUTH) )
        {
            $this->{lastcmd} = 'AUTH';
            push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
            $this->{prepend}="[unsupported_$this->{lastcmd}]";
            mlog($fh,"$this->{lastcmd} not allowed");
            if($MaxErrors && ++$this->{serverErrors} > $MaxErrors) {
                MaxErrorsFailed($fh,
                "502 $this->{lastcmd} not supported\r\n421 <$myName> closing transmission\r\n",
                "max errors (MaxErrors=$MaxErrors) exceeded -- dropping connection after $this->{lastcmd}");
                return;
            }
            sendque($fh, "502 $this->{lastcmd} not supported\r\n");
            return;
        }

        my $ip = &ipNetwork( $this->{ip}, 1);
        if ($MaxAUTHErrors && $AUTHErrors{$ip} >= $MaxAUTHErrors) {
            $this->{prepend}='[MaxAUTHErrors]';
            NoLoopSyswrite($fh,"521 $myName does not accept mail - closing transmission - too many previouse AUTH errors from network $ip\r\n",0);
            mlog($fh,"too many ($AUTHErrors{$ip}) AUTH errors from network $ip") if $ConnectionLog;
            if (! matchIP($this->{ip},'noPB',0,1)) {
                pbAdd( $fh, $this->{ip}, 'autValencePB', 'AUTHErrors' );
                $this->{prescore} += ${'autValencePB'}[0];
            }
            $AUTHErrors{$ip}++;
            done($fh);
            return;
        }

        if ($CanUseIOSocketSSL &&
            $DoTLS == 2 &&
            ! $SSLfailed{$this->{ip}} &&
            $friend->{donotfakeTLS} &&
            ! $this->{gotSTARTTLS} &&
            ! $this->{TLSqueue} &&
            "$server" !~ /SSL/io &&
            ! &matchIP($this->{ip},'noTLSIP',$fh,1) &&
            ! &matchFH($fh,@lsnNoTLSI)
        ) {
            NoLoopSyswrite($server,"STARTTLS\r\n",0);
            $friend->{getline} = \&replyTLS;
            $this->{TLSqueue} = $ffr;
            mlog($fh,"info: injected STARTTLS request to " . $server->peerhost()) if $ConnectionLog;
            return;
        }
        $authmeth =~ s/^\s+//o;
        $authmeth =~ s/\s+$//o;
        if ($authmeth =~ /(plain|login)\s*(.*)/io) {
            $authmeth = lc $1;
            my $authstr = base64decode($2);
            mlog($fh,"info: authentication - $authmeth is used") if $ValidateUserLog;
            if ($authmeth eq 'plain' and $authstr) {
                ($this->{userauth}{foruser},$this->{userauth}{user},$this->{userauth}{pass}) = split(/ |\0/so,$authstr);
                $this->{userauth}{stepcount} = 0;
                $this->{userauth}{authmeth} = 'plain';
                if ($AUTHLogUser) {
                    my $tolog = "info: authentication (PLAIN) realms - foruser:$this->{userauth}{foruser}, user:$this->{userauth}{user}";
                    $tolog .= ", pass:$this->{userauth}{pass}" if $AUTHLogPWD;
                    mlog($fh,$tolog);
                }
            } elsif ($authmeth eq 'plain' && ! $authstr) {
                $this->{userauth}{stepcount} = 1;
                $this->{userauth}{authmeth} = 'plain';
            } elsif ($authmeth eq 'login' && $authstr) {
                $this->{userauth}{user} = $authstr;
                $this->{userauth}{stepcount} = 1;
                $this->{userauth}{authmeth} = 'login';
            } else {
                $this->{userauth}{stepcount} = 2;
                $this->{userauth}{authmeth} = 'login';
            }
        }
        $this->{lastcmd} = 'AUTH';
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
        $this->{doneAuthToRelay} = 1;
        sendque($server,$l);
        return;

    } elsif ($this->{userauth}{stepcount}) {
        if ($this->{userauth}{authmeth} eq 'plain') {
            $this->{userauth}{stepcount} = 0;
            $l =~ /([^\r\n]*)\r\n/o;
            my $authstr = base64decode($1);
            ($this->{userauth}{foruser},$this->{userauth}{user},$this->{userauth}{pass}) = split(/ |\0/o,$authstr);
            if ($AUTHLogUser) {
                my $tolog = "info: authentication (PLAIN) realms - foruser:$this->{userauth}{foruser}, user:$this->{userauth}{user}";
                $tolog .= ", pass:$this->{userauth}{pass}" if $AUTHLogPWD;
                mlog($fh,$tolog);
            }
            sendque($server,$l);
            return;
        } elsif ($this->{userauth}{stepcount} == 2) {
            $this->{userauth}{stepcount} = 1;
            $l =~ /([^\r\n]*)\r\n/o;
            $this->{userauth}{user} = base64decode($1);
            sendque($server,$l);
            return;
        } else {
            $this->{userauth}{stepcount} = 0;
            $l =~ /([^\r\n]*)\r\n/o;
            $this->{userauth}{pass} = base64decode($1);
            if ($AUTHLogUser) {
                my $tolog = "info: authentication (LOGIN) realms - user:$this->{userauth}{user}";
                $tolog .= ", pass:$this->{userauth}{pass}" if $AUTHLogPWD;
                mlog($fh,$tolog);
            }
            sendque($server,$l);
            return;
        }

    } elsif (&syncCanSync() && $enableCFGShare && $isShareSlave && $l=~/^ *ASSPSYNCCONFIG\s*([^\r\n]+)\r\n/o ) {
        my $pass = $1;
        mlog(0,"info: got ASSPSYNCCONFIG request from $this->{ip}") if $ConnectionLog >=2;
        $this->{lastcmd} = 'ASSPSYNCCONFIG';
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
        my @tservers = split(/\|/o, $syncServer);
        my @servers;
        my %se;
        foreach (@tservers) {
            s/\s//go;
            s/\:\d+$//o;
            if ($_ =~ /^$IPRe$/o) {
                push(@servers, $_);
                $se{$_} = $_;
                next;
            }
            my $ip = eval{inet_ntoa( scalar( gethostbyname($_) ) );};
            if ($ip) {
                push(@servers, $ip);
                $se{$ip} = $_;
                next;
            } else {
                mlog(0,"syncCFG: error - unable to resolve ip for syncServer name $_ - $@");
            }
        }
        if (! @servers || ! (@servers = grep { $this->{ip} eq $_ } @servers )) {
            NoLoopSyswrite( $fh, "502 $this->{lastcmd} not implemented $this->{ip} - @servers\r\n" ,0);
            mlog($fh,"syncCFG: error - got 'ASSPSYNCCONFIG' command from wrong ip $this->{ip}");
            done($fh);
            return;
        }
        if (Digest::MD5::md5_base64($syncCFGPass) ne $pass) {
            NoLoopSyswrite( $fh, "500 $this->{lastcmd} wrong authentication - check you configuration\r\n" ,0);
            mlog($fh,"syncCFG: error - got wrong password in 'ASSPSYNCCONFIG' command from $this->{ip}");
            done($fh);
            return;
        }
        done2($server);
        my $ip = $this->{ip};
        $this->{syncServer} = $se{$ip};
        $this->{getline} = \&syncRCVData;
        NoLoopSyswrite($fh,"250 OK start the config sync\r\n",0);
        return;
    } elsif ($l=~/^ *ASSPSYNCCONFIG\s*([^\r\n]+)?\r\n/o ) {
        my $pass = $1;
        mlog(0,"info: got ASSPSYNCCONFIG request from $this->{ip}") if $ConnectionLog >=2;
        $this->{lastcmd} = 'ASSPSYNCCONFIG';
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
        if (Digest::MD5::md5_base64($syncCFGPass) ne $pass) {
            NoLoopSyswrite( $fh, "502 $this->{lastcmd} not implemented\r\n",0 );
            mlog($fh,"syncCFG: error - got syncCFG request, but this is not an 'isShareSlave' and got wrong password in 'ASSPSYNCCONFIG' command from $this->{ip}");
            done($fh);
            return;
        }
        NoLoopSyswrite( $fh, "500 $this->{lastcmd} - sync peer $this->{ip} is not registered on $myName or this is not an isShareSlave\r\n",0 );
        mlog($fh,"syncCFG: error - got 'ASSPSYNCCONFIG' command from ip $this->{ip} - the request will be ignored - check your configuration");
        done($fh);
        return;

    } elsif ($l=~/^ *($notAllowedSMTP)/io) {
        $this->{lastcmd} = $1;
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
        $this->{prepend}="[unsupported_$this->{lastcmd}]";
        mlog($fh,"$this->{lastcmd} not allowed");
        if(! $this->{relayok} && $MaxErrors && ++$this->{serverErrors} > $MaxErrors) {
            MaxErrorsFailed($fh,
            "502 $this->{lastcmd} not supported\r\n421 <$myName> closing transmission\r\n",
            "max errors (MaxErrors=$MaxErrors) exceeded -- dropping connection after $this->{lastcmd}");
            return;
        }
        sendque($fh, "502 $this->{lastcmd} not supported\r\n");
        return;
    } elsif ($l=~/(mail from:\s*<?($EmailAdrRe\@$EmailDomainRe|\s*)>?)/io) {
        my $fr=$2;
        my $ffr = $1;

        if ($CanUseIOSocketSSL &&
            $DoTLS == 2 &&
            ! $SSLfailed{$this->{ip}} &&
            $friend->{donotfakeTLS} &&
            ! $this->{gotSTARTTLS} &&
            ! $this->{TLSqueue} &&
            "$server" !~ /SSL/io &&
            ! &matchIP($this->{ip},'noTLSIP',$fh,1) &&
            ! &matchFH($fh,@lsnNoTLSI)
        ) {
            NoLoopSyswrite($server,"STARTTLS\r\n",0);
            $friend->{getline} = \&replyTLS;
            $this->{TLSqueue} = $ffr;
            mlog($fh,"info: injected STARTTLS request to " . $server->peerhost()) if $ConnectionLog;
            return;
        }

        stateReset($fh); # reset everything
        $this->{lastcmd} = 'MAIL FROM';
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
        if($EnforceAuth && &matchFH($fh,@lsn2I) && ! $this->{authenticated} && ! &matchFH($fh,@lsnNoAUTH)) {
            NoLoopSyswrite($fh,"530 5.7.0 Authentication required\r\n",0);
            mlog($fh,"$fr submited without previouse AUTH - 'EnforceAuth' is set to 'ON' for 'listenPort2'",1);
            done($fh);
            return;
        }

# authentication on relayserver
        if ($CanUseAuthenSASL &&
            ! $this->{doneAuthToRelay} &&
            $this->{relayok} &&
            scalar keys %{$this->{authmethodes}} &&
            $relayAuthUser &&
            $relayAuthPass
           )
        {
            $this->{doneAuthToRelay} = 1;
            $this->{sendAfterAuth} = $l;
            foreach ('PLAIN','LOGIN','CRAM-MD5','DIGEST-MD5') {
                $this->{AUTHmechanism} = $_ if exists $this->{authmethodes}->{$_};
            }
            $this->{AUTHmechanism} = 'PLAIN' unless $this->{AUTHmechanism};
            mlog($fh,"info: starting authentication - AUTH $this->{AUTHmechanism}") if $SessionLog >= 2;
            $this->{AUTHclient} =
                Authen::SASL->new(
                                    mechanism => $this->{AUTHmechanism},
                                    callback  => {
                                        user     => $relayAuthUser,
                                        pass     => $relayAuthPass,
                                        authname => $relayAuthUser
                                    },
                                    debug => $ThreadDebug
                )->client_new('smtp');
            @{$this->{AUTHClient}} = ();
            my $str = $this->{AUTHclient}->client_start;
            push (@{$this->{AUTHClient}}, MIME::Base64::encode_base64($str, ''))
                 if defined $str and length $str;
            NoLoopSyswrite($server,'AUTH ' . $this->{AUTHclient}->mechanism . "\r\n",0);
            $friend->{getline} = \&replyAUTH;

            return;
        }
# end authentication on relayserver

        $this->{relayok} = 1 if ( $EnforceAuth && &matchFH($fh,@lsn2I) );

        $this->{mailfrom}=$fr;
        $this->{mailfrom} =~ s/\s//go;
        
        # BATV stuff  for mail from
        if ($this->{relayok}) {               # it's outgoing mail
            if ($DoBATV && $this->{mailfrom}) {         # if there is a sender address and BATV enabled
                $this->{mailfrom} = &batv_mail_out($fh,$this->{mailfrom});   # tag mailfrom
                $l =~ s/$fr/$this->{mailfrom}/i;        # replace orig sender address with taged address
            }
        } else {                             # it's incoming mail
            $this->{mailfrom} = batv_remove_tag($fh,$this->{mailfrom},'BATVfrom') if ($removeBATVTag); # remove possible BATV-Tag from sender address  - if removed orig recipient is strored in ->{BATVfrom}
            mlog($fh,"BATV-Tag removed from sender address $fr") if ($BATVLog && lc($fr) ne lc($this->{mailfrom}));
            if (lc($this->{mailfrom}) ne lc($fr) && $remindBATVTag) {   # if Tag was removed
                 if (! &localmail($this->{mailfrom})) {
                     $BATVTag{lc($this->{mailfrom})} = $fr;  # store sender address and Tag pair in Cache if it's not local mail
                     mlog($fh,"info: BATVTag $fr stored in Cache for " .lc($this->{mailfrom})) if $BATVLog >= 2;
                 }
            }
        }
        # end BATV  for mail from

        my $t=time;
        my $mf = batv_remove_tag(0,lc($this->{mailfrom}),'');
        my $mfd;
        $mfd = $1 if $mf=~/\@(.*)/o;
        my $mfdd;
        $mfdd = $1 if $mf=~/(\@.*)/o;

        my $alldd = "$wildcardUser$mfdd";
        my $defaultalldd = "*$mfdd";

        if($l=~/SIZE=(\d*)\s/io) {
            my $size = $1;
            $this->{SIZE}=$size;
            mlog($fh,"info: found message size announcement: " . &formatNumDataSize($size)) if $SessionLog;

            if ( ($this->{relayok} && $maxSize
                    && ( $size > $maxSize )) or (!$this->{relayok} && $maxSizeExternal
                    && ( $size > $maxSizeExternal )))
            {
                my $max = $this->{relayok} ? $maxSize : $maxSizeExternal;
                my $err = "552 message exceeds MAXSIZE byte (size)";
                mlog( $fh, "error: message exceeds maxSize $max bytes (size)!" );
                $err = $maxSizeError if ($maxSizeError);
                $err =~ s/MAXSIZE/$max/go;
                seterror( $fh, $err, 1 );
                return;
            }

            if ($this->{relayok}) {
                if ($npSizeOut && $size > $npSizeOut) {
                    $this->{ismaxsize}=1;
                    if (localmail($mf)) {
                        $this->{noprocessing}=1;
                        mlog($fh,"message proxied without processing - message size ($size) is above $npSizeOut (npSizeOut).",1);
                        $this->{passingreason} = "noProcessing - message size ($size) is above $npSizeOut (npSizeOut)";
                    }
                }
            } else {
                if ($npSize && $size > $npSize) {
                    $this->{ismaxsize}=1 ;
                }
            }
        }
        $this->{doneAuthToRelay} = 1 if($l=~/ AUTH=.+/io);


########################################################### !relayok ############

        $this->{senderok} = 1 if ( matchSL( $mf, 'EmailSenderOK' ) );
        $this->{senderok} = 2 if ( matchSL( $mf, 'EmailSenderNotOK' ) ) ;
        $this->{senderok} = 3 if ( matchSL( $mf, 'EmailSenderIgnore' ) ) ;

        if (!$this->{relayok}) {

            if ($allLogRe
                && (   $mf =~ /$allLogReRE/
                    || $this->{ip}   =~ /$allLogReRE/
                    || $this->{helo} =~ /$allLogReRE/)
              ) {
               $this->{alllog}=1;
            }
            if(!$this->{contentonly} && $contentOnlyRe && ($mf=~/($contentOnlyReRE)/  || $this->{ip}=~/($contentOnlyReRE)/  || $this->{helo}=~/($contentOnlyReRE)/)){
                mlogRe($fh,($1||$2),"Contentonly");
                pbBlackDelete($fh,$this->{ip});
                $this->{contentonly}=1;
                $this->{ispip}=1;
            }

            if ($Con{$server}->{relayok} && $WhitelistAuth){
                $this->{whitelisted}=1;
                $this->{passingreason} = ": authenticated";

                #amonra whitelist authenticated users
            }
            $this->{red} = "$mf in RedList"
              if ( $Redlist{"$alldd"}
                || $Redlist{"$defaultalldd"}
                || $Redlist{"$mf"} );

            if (! $this->{whitelisted} && &Whitelist($mf) && ! localmail($mf)) {
                &Whitelist($mf,undef,'add');
                $this->{whitelisted}=1;
                $this->{passingreason} = "whitelistdb" if !$this->{passingreason};
            }
            if (! $this->{whitelisted} && $whiteListedDomains && matchRE([$mf],'whiteListedDomains')) {
                $this->{passingreason} = "whiteListedDomains '$lastREmatch'";
                $this->{whitelisted}=1;
            }
            if (! $this->{whitelisted} && $whiteRe && ($this->{helo}=~/($whiteReRE)/ || $this->{ip}=~/($whiteReRE)/ || $mf=~/($whiteReRE)/) ) {
                mlogRe($fh,($1||$2),"WhiteRe") ;
                $this->{whitelisted}=1;
                $this->{passingreason} = "whiteRe '$1'";
            }
            if (! $this->{whitelisted} && (&Whitelist($mf) || &Whitelist($defaultalldd)) && ! localmail($mf)) {
                mlogRe($fh,$mfdd,"wildcardUser") ;
                $this->{whitelisted}=1;
                &Whitelist($alldd,undef,'add');
                &Whitelist($defaultalldd,undef,'add');
                &Whitelist($mfdd,undef,'add');
                $this->{passingreason} = "wildcardUser";
            }
            $this->{red}="$mf in RedList" if ($Redlist{"$alldd"} || $Redlist{"$defaultalldd"} || $Redlist{"$mf"});
            my $ret = matchIP( $this->{ip}, 'whiteListedIPs', $fh ,0);
            if (  $whiteListedIPs && $ret )
            {
                $this->{whitelisted}   = 1;
                $this->{passingreason} = "whiteListedIPs '$ret'";
            }

            $this->{ispip}=1 		if ( matchIP($this->{ip},'ispip',$fh,0));
            $this->{nopb}=1 		if ( matchIP($this->{ip},'noPB',$fh,0));
            $this->{nopbwhite}=1 	if ( matchIP( $this->{ip}, 'noPBwhite', $fh ,0) );
            $this->{rwlok} =
            $this->{pbwhite}=1 		if pbWhiteFind($this->{ip});
            $this->{nohelo}=1 		if ( matchIP($this->{ip},'noHelo',$fh,0));
            $this->{mHBIRE}=1 		if ($heloBlacklistIgnore && $this->{helo} =~ /$HBIRE/);
            if ($this->{mailfrom}=~/$BSRE/) {
                $this->{prepend} = '[isbounce]';
                mlog($fh,"bounce message detected") if (! $this->{isbounce} && ! $this->{relayok});
                $this->{isbounce}=1;
            }
            $this->{red}="bounces are not collected" if ($this->{isbounce} && $DoNotCollectBounces);

            $this->{nodelay}=1 		if matchIP($this->{ip},'noDelay',$fh,0) or matchSL($this->{mailfrom},'noDelayAddresses');
            $this->{acceptall}=1	if matchIP($this->{ip},'acceptAllMail',$fh,0);
            $this->{noblockingips} = 1  if matchIP( $this->{ip}, 'noBlockingIPs', $fh ,0);

            if (! $this->{noprocessing} && $noProcessing && $mf=~/($NPREL)/) {
                mlogRe($fh,$1,"NoProcessingList");
                $this->{noprocessing}=1;
                $this->{passingreason} = 'noProcessing';
            }
            if (! $this->{noprocessing} && matchSL( $mf, 'noProcessingFrom' )) {
                $this->{noprocessing}  = 1;
                $this->{passingreason} = 'noProcessingFrom';
            }
            if (! $this->{noprocessing} && $noProcessingDomains && $mf=~/($NPDRE)/) {
                mlogRe($fh,$1,"NoProcessingDomain") ;
                $this->{noprocessing}=1;
                $this->{passingreason} = "noProcessingDomain '$1'";
            }
            if (! $this->{noprocessing} && matchIP($this->{ip},'noProcessingIPs',$fh,0)) {
                $this->{noprocessing}=1;
                $this->{passingreason} = "noProcessingIPs";
            }
            if ($this->{noprocessing}) {
                pbBlackDelete($fh,$this->{ip});
                pbWhiteAdd($fh,$this->{ip},"NoProcessing");
            }

            if (! $this->{noprocessing} && $this->{ismaxsize}) {
                if (! localmail($mf)) {
                    mlog($fh,"message proxied without processing - message size ($this->{SIZE}) is above $npSize (npSize).",1);
                    $this->{noprocessing}=2;
                    $this->{passingreason} = "noProcessing - message size ($this->{SIZE}) is above $npSize (npSize)";
                }
            }

            if ($this->{whitelisted}) {
                pbBlackDelete($fh,$this->{ip});
                pbWhiteAdd($fh,$this->{ip},"Whitelisted");
            }

            my $ip=$this->{ip};

            my $myip = &ipNetwork( $ip, $PenaltyUseNetblocks );

            unless (   ($this->{whitelisted} && !$ExtremeWL)
                    || ($this->{noprocessing} eq '1' && !$ExtremeNP) )
            {
                my $myextreme;
                if ( $PenaltyExtreme && [split( ' ', $PBBlack{$myip} )]->[3] >= $PenaltyExtreme ) {   # totalscore
                    $myextreme = $myip;
                }

                if (   $DoPenaltyExtremeSMTP
                    && $myextreme
                    && ! matchIP( $ip, 'noPB',            0, 1 )
                    && ! matchIP( $ip, 'noExtremePB',     0, 1 )
                    && ! matchSL( $mf, 'noExtremePBAddresses' )
                    && (! matchIP( $ip, 'noProcessingIPs', 0, 1 ) ||
                       ($ExtremeNP && matchIP( $ip, 'noProcessingIPs', 0, 1 )))
                    && (! matchIP( $ip, 'whiteListedIPs',  0, 1 ) ||
                       ($ExtremeWL && matchIP( $ip, 'whiteListedIPs', 0, 1 )))
                    && ! matchIP( $ip, 'noDelay',         0, 1 )
                    && ! matchIP( $ip, 'ispip',           0, 1 )
                    && ! matchIP( $ip, 'acceptAllMail',   0, 1 )
                    && ! matchIP( $ip, 'noBlockingIPs',   0, 1 )
                    && ! pbWhiteFind($ip) )
                {
                    if ( $DoPenaltyExtremeSMTP == 1 ) {
                        $this->{prepend} = "[denyExtreme]";
                        mlog( $fh, "connection from $ip denied by PenaltyBox Extreme '$myip'" ) if $PenaltyExtremeLog;
                        $Stats{smtpConnDenied}++;
                        seterror( $fh, "554 5.7.1 Extreme Bad IP Profile", 1 );
                        d('getline - PenaltyBox Extreme');
                        return;
                    }
                    if ( $DoPenaltyExtremeSMTP == 2 ) {
                        $this->{prepend} = "[denyExtreme][monitoring]";
                        mlog( $fh, "monitoring: connection from $ip would be denied by PenaltyBox Extreme '$myip'" )
                          if $PenaltyExtremeLog >= 2;
                    }
                }
            }

            if ( ! $this->{ispip} && "$fh" =~ /SSL/io && (${'tlsValencePB'}[0] || ${'tlsValencePB'}[1])) {
                $this->{messagereason} = 'SSL-TLS-connection-OK';
                pbAdd( $fh, $this->{ip}, 'tlsValencePB', 'SSL-TLS-connection-OK' );
            }

            $this->{pbblack}   = 1 if pbBlackFind($this->{ip});

            if (   $DoDomainIP
                && $this->{pbblack}
                && !$this->{pbwhite}
                && $maxSMTPdomainIP
                && $mfd
                && !$this->{nopb}
                && !$this->{whitelisted}
                && !$this->{rwlok}
                && $this->{noprocessing} ne '1'
                && !$this->{ispip}
                && !$this->{acceptall}
                && !$this->{nodelay}
                && !$this->{contentonly}
                && !$this->{noblockingips}
                && (! $ValidateSPF || ($SPFCacheInterval && $SPFCacheObject && [&SPFCacheFind($this->{ip},$mfd)]->[1] ne 'pass'))
                && (!$maxSMTPdomainIPWL || ($maxSMTPdomainIPWL &&  $mfd!~/($IPDWLDRE)/))
               )
            {
                $this->{doneDoDomainIP} = 1;
                my $myip=&ipNetwork($this->{ip}, $DelayUseNetblocks) . '.';
                if ((time - $SMTPdomainIPTriesExpiration{$mfd}) > $maxSMTPdomainIPExpiration) {
                    $SMTPdomainIPTries{$mfd} = 1;
                    $SMTPdomainIPTriesExpiration{$mfd} = time;
                    $myip =~ s/\./\\\./go;
                    $SMTPdomainIP{$mfd} = $myip;
                } elsif ($myip !~ /^(?:$SMTPdomainIP{$mfd})$/) {
                    $SMTPdomainIP{$mfd} .= '|' if $SMTPdomainIP{$mfd};
                    $myip =~ s/\./\\\./go;
                    $SMTPdomainIP{$mfd} .= $myip;
                    $SMTPdomainIPTriesExpiration{$mfd} = time if $SMTPdomainIPTries{$mfd}==1;
                    $SMTPdomainIPTries{$mfd}++;
                }
                my $tlit = &tlit($DoDomainIP);
                $tlit = "[testmode]"   if $allTestMode && $DoDomainIP == 1 || $DoDomainIP == 4;
                my $DoDomainIP = $DoDomainIP;
                $DoDomainIP = 3 if $allTestMode && $DoDomainIP == 1 || $DoDomainIP == 4;
                if ( exists $SMTPdomainIPTries{$mfd} && $SMTPdomainIPTries{$mfd} > $maxSMTPdomainIP) {
                    my $doSPF = ($CanUseSPF && $ValidateSPF) || ($CanUseSPF2 && $ValidateSPF && $SPF2);
                    if (   $doSPF
                        && $enableSPFbackground
                        && $SPFCacheInterval
                        && $SPFCacheObject
                        && $mf
                        && (my ($helo) = $this->{orghelo} =~ /^ *(?:helo|ehlo) [<>,;\"\'\(\)\s]*([^<>,;\"\'\(\)\s]+)/io)
                        && ! &SPFCacheFind($this->{ip},$mfd)
                       )
                    {
                        cmdToThread('SPFbg',"$this->{ip} $mf $helo");
                    }
                    $this->{prepend} = "[IPperDomain]";
                    $this->{messagereason} = "'$mfdd' passed limit($maxSMTPdomainIP) of ips per domain";

                    mlog( $fh, "$tlit $this->{messagereason}")
                      if (  ($SessionLog && $SMTPdomainIPTries{$mfd} == $maxSMTPdomainIP + 1)
                          ||($SessionLog >= 2 && $SMTPdomainIPTries{$mfd} > $maxSMTPdomainIP + 1));

                    pbAdd( $fh, $this->{ip}, 'idValencePB', "LimitingIPDomain" ) if $DoDomainIP != 2;
                    if ( $DoDomainIP == 1 ) {
                        $Stats{smtpConnDomainIP}++;
                        seterror( $fh, "554 5.7.1 too many different IP's for domain '$mfdd'", 1 );
                        return;
                    }
                }
            }

            # ip connection limiting per timeframe
            if (   $DoFrequencyIP
                && $this->{pbblack}
                && !$this->{pbwhite}
                && $maxSMTPipConnects
                && !$this->{nopb}
                && !$this->{whitelisted}
                && !$this->{rwlok}
                && $this->{noprocessing} ne '1'
                && !$this->{ispip}
                && !$this->{acceptall}
                && !$this->{nodelay}
                && !$this->{contentonly}
                && !$this->{noblockingips}
               )
            {
                my $ConIp550 = $this->{ip};
                $this->{doneDoFrequencyIP} = $ConIp550;

       # If the IP address has tried to connect previously, check it's frequency
                if ( $IPNumTries{$ConIp550} ) {
                    $IPNumTries{$ConIp550}++;

              # If the last connect time is past expiration, reset the counters.
              # If it has not expired, but is outside of frequency duration and
              # below the maximum session limit, reset the counters. If it is
              # within duration
                    if (((time - $IPNumTriesExpiration{$ConIp550}) > $maxSMTPipExpiration)  || ((time - $IPNumTriesDuration{$ConIp550}) > $maxSMTPipDuration) && ($IPNumTries{$ConIp550} < $maxSMTPipConnects)) {
                        $IPNumTries{$ConIp550} = 1;
                        $IPNumTriesDuration{$ConIp550} = time;
                        $IPNumTriesExpiration{$ConIp550} = time;
                    }
                } else {
                    $IPNumTries{$ConIp550} = 1;
                    $IPNumTriesDuration{$ConIp550} = time;
                    $IPNumTriesExpiration{$ConIp550} = time;

                }
                my $tlit = &tlit($DoFrequencyIP);
                $tlit = "[testmode]"   if $allTestMode && $DoFrequencyIP == 1 || $DoFrequencyIP == 4;

                my $DoFrequencyIP = $DoFrequencyIP;
                $DoFrequencyIP = 3 if $allTestMode && $DoFrequencyIP == 1 || $DoFrequencyIP == 4;

                if ( $IPNumTries{$ConIp550} > $maxSMTPipConnects ) {
                    $this->{prepend} = "[IPfrequency]";
                     $this->{messagereason} = "'$ConIp550' passed limit($maxSMTPipConnects) of ip  connection frequency";

                    mlog( $fh, "$tlit $this->{messagereason}")
                      if $SessionLog >= 2
                          && $IPNumTries{$ConIp550} > $maxSMTPipConnects + 1;
                    mlog( $fh,"$tlit $this->{messagereason}")
                      if $SessionLog
                          && $IPNumTries{$ConIp550} == $maxSMTPipConnects + 1;
                    pbAdd( $fh, $this->{ip}, 'ifValencePB', "IPfrequency" ) if $DoFrequencyIP!=2;
                    if ( $DoFrequencyIP == 1 ) {
                        $Stats{smtpConnLimitFreq}++;
                        seterror( $fh, "554 5.7.1 too frequent connections for '$ConIp550'", 1 );
                        return;
                    }
                  }
              }


            if ($ForceFakedLocalHelo && !($fhTestMode || $allTestMode)) {
                if (! ForgedHeloOK($fh) ) {
                    $reply =
                      $SenderInvalidError
                      ? "$SenderInvalidError"
                      : "$SpamError";
                    $reply =~ s/REASON/Forged HELO/go;
                    seterror( $fh, $reply, 1 );
                    return;
                  }
            }

            &IPinHeloOK($fh);

            if ($ForceValidateHelo && !($ihTestMode || $allTestMode)) {
                if (! invalidHeloOK($fh,\$this->{helo})) {
                    $Stats{invalidHelo}++ ;
                    $this->{prepend}="[InvalidHELO]";
                    mlog($fh,"[spam found] ($this->{messagereason})") ;
                    $reply=$SenderInvalidError ? "$SenderInvalidError" : "$SpamError" ;
                    $reply =~ s/REASON/Helo invalid/go;
                    seterror($fh,$reply,1);
                    return;
                }
                if (! validHeloOK($fh,\$this->{helo})) {
                    $Stats{invalidHelo}++ ;
                    $this->{prepend}="[InvalidHELO]";
                    mlog($fh,"[spam found] ($this->{messagereason})");
                    $reply=$SenderInvalidError ? "$SenderInvalidError" : "$SpamError" ;
                    $reply =~ s/REASON/Helo invalid/go;
                    seterror($fh,$reply,1);
                    return;
                }
            }

            if ($ForceNoValidLocalSender && !($allTestMode || $DoNoValidLocalSender==4)) {
                if (! LocalSenderOK( $fh, $this->{ip} ) ) {
                    $reply =
                      $SenderInvalidError
                      ? "$SenderInvalidError"
                      : "$SpamError";
                    $reply =~ s/REASON/Unknown Sender in Local Domain/go;
                    $Stats{senderInvalidLocals}++;
                    $this->{prepend} = "[InvalidLocalSender]";
                    mlog( $fh, "[spam found] Unknown Sender in Local Domain" );
                    seterror( $fh, $reply, 1 );
                    return;
                }
                if (! NoSpoofingOK( $fh, 'mailfrom' ) ) {
                    $reply =
                      $SenderInvalidError
                      ? "$SenderInvalidError"
                      : "$SpamError";
                    $reply =~ s/REASON/Spoofing Sender in Local Domain/go;
                    $Stats{senderInvalidLocals}++;
                    $this->{prepend} = "[InvalidLocalSender]";
                    mlog( $fh, "[spam found] Spoofing Sender in Local Domain" );
                    seterror( $fh, $reply, 1 );
                    return;
                }
            }

            if ($ForceRBLCache && !($rblTestMode || $allTestMode)) {
                if (! RBLCacheOK($fh,$this->{ip},0))  {
                    return;
                }
            }
        }

############################################ end !relayok ###################



        if ($EnableSRS &&
            $CanUseSRS  &&
            $this->{relayok} &&
            ! localmail($this->{mailfrom}) &&
            $this->{mailfrom} !~ /$BSRE/ &&
            ! ( $this->{mailfrom} && matchSL($this->{mailfrom},'SRSno'))) {

            # rewrite sender addresses when relaying through Relay Host
            my $tmpfrom;
            $this->{prepend}='';
            my $srs = Mail::SRS->new(
                Secret=>$SRSSecretKey,
                MaxAge=>$SRSTimestampMaxAge,
                HashLength=>$SRSHashLength,
                AlwaysRewrite=>1
              );
            if (!eval{$tmpfrom=$srs->reverse($this->{mailfrom})} &&
                eval{$tmpfrom=$srs->forward($this->{mailfrom},$SRSAliasDomain)}) {
                mlog($fh, "SRS rewriting sender '$this->{mailfrom}' into '$tmpfrom'",1);
                $l =~ s/\Q$this->{mailfrom}\E/$tmpfrom/;
            } else {
                mlog($fh, "SRS rewriting sender '$this->{mailfrom}' failed!",1);
            }
        }

        if (   ! $this->{relayok}
            && ! $this->{noprocessing} & 1
            && ! $this->{whitelisted}
            && ! $this->{pbwhite}
            && ! $this->{nopb}
            && ! $this->{rwlok}
            && ! $this->{acceptall}
            && ! $this->{contentonly}
            && ! $this->{noblockingips}
            && $DoRFC822 & 2
            && ! localmail($this->{mailfrom})
            && $this->{mailfrom} =~ /(($EmailAdrRe)\@($EmailDomainRe))/o)
        {
            my ($adr,$user,$dom) = ($1,$2,$3);
            my $error;
            my $nonASCII;
            my $ns='NS';
            if (($nonASCII = ! is_7bit_clean(\$adr)) || $adr !~ /$RFC822RE/o ) {
                $error = 'RFC822';
            } elsif ($dom =~ /^$IPRe$/o) {
                # ignore the other checks for IP addresses as domain
            } elsif ($dom !~ /([^\.]+(?:$URIBLCCTLDSRE|\.$TLDSRE))$/i) {
                $error = 'Invalid-Domain';
            } elsif (exists($RFC822dom{lc $dom}) || (${defined *{'yield'}} && defined($ns = getRRData(${defined *{'yield'}}, (defined *{'yield'}?$ns:''))) && $ns eq '0')) {
                $error = "Missing-NameServer-Registration: $1";
                $RFC822dom{lc $dom} = time;
            }
            if ($error) {
                $this->{prepend}='[MalformedAddress]';
                mlog($fh,"malformed address: '$adr' - $error");
                $Stats{senderInvalidLocals}++;
                pbAdd( $fh, $this->{ip}, 'nofromValencePB', 'From-missing' );
                $adr = encodeMimeWord($adr,'B','UTF-8') if $nonASCII; # be nice to the hackers server
                if($MaxErrors && ++$this->{serverErrors} > $MaxErrors) {
                    MaxErrorsFailed($fh,
                    "553 Malformed ($error) address: $adr\r\n421 <$myName> closing transmission\r\n",
                    "max errors (MaxErrors=$MaxErrors) exceeded -- dropping connection after '$error' sender validation");
                    return;
                }
                sendque($fh, "553 Malformed ($error) address: $adr\r\n");
                return;
            }
        }
    } elsif($l=~/^ *(VRFY|EXPN) *([^\r\n]*)/io) {
        $this->{lastcmd} = $1;
        my $e=$2;
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;

        if ( $DisableVRFY && !$this->{relayok} )
        {
            $this->{prepend}="[unsupported_$this->{lastcmd}]";
            mlog($fh,"$this->{lastcmd} not allowed");
            if($MaxErrors && ++$this->{serverErrors} > $MaxErrors) {
                MaxErrorsFailed($fh,
                "502 $this->{lastcmd} not supported\r\n421 <$myName> closing transmission\r\n",
                "max errors (MaxErrors=$MaxErrors) exceeded -- dropping connection after $this->{lastcmd}");
                return;
            }
            sendque($fh, "502 $this->{lastcmd} not supported\r\n");
            return;
        }

        my ($u,$h);
        my ($str, $gen, $day, $hash, $orig_user) = ($e =~ /(prvs=(\d)(\d\d\d)(\w{6})=([^\r\n]*))/o);
        $l =~ s/$str/$orig_user/ if ($orig_user);  # remove BATV-Tag from VRFY address

        # recipient replacment should be done next to here !
        if ($ReplaceRecpt) {
            if ($l=~/ *(?:VRFY|EXPN)\s*<*([^\r\n>]*)/io) {
                my $midpart  = $1;
                my $orgmidpart = $midpart;
                if ($midpart) {
                  if($EnableBangPath && $midpart=~/([a-z\-_\.]+)!([a-z\-_\.]+)$/io) {
                      $midpart = "$2\@$1";
                  }
                  my $mf = batv_remove_tag(0,lc $this->{mailfrom},'');
                  my $newmidpart = RcptReplace($midpart,$mf,'RecRepRegex');
                  if (lc $newmidpart ne lc $midpart) {
                      $l =~ s/$orgmidpart/$newmidpart/i;
                      mlog($fh,"info: $this->{lastcmd} recipient $orgmidpart replaced with $newmidpart");
                  }
                }
            }
        }
    } elsif($l=~/rcpt to: *([^\r\n]*)/io) {
        $this->{lastcmd} = 'RCPT TO';
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
        delete $this->{orgrcpt};
        my $e=$1;
        my ($u,$h);

        my $foreignSRS;         # first check and remove any local SRS signing
        if (! $this->{relayok} && $EnableSRS && $CanUseSRS) {

            # validate incoming bounces
            my $tmpto;
            my $failed;
            my $srs = Mail::SRS->new(
                Secret=>$SRSSecretKey,
                MaxAge=>$SRSTimestampMaxAge,
                HashLength=>$SRSHashLength,
                AlwaysRewrite=>1
              );
            if ($e=~/^<?(SRS0[=+-][^\r\n>]*)/io) {
                my $asrs0 = $1;
                if (eval{$tmpto=$srs->reverse($asrs0)}) {
                    mlog($fh,"info: SRS - replace $asrs0 with $tmpto") if $SessionLog > 1;
                    $this->{SRSorgAddress} = $asrs0 = quotemeta($asrs0);
                    $this->{SRSnewAddress} = $tmpto;
                    $l=~s/$asrs0/$tmpto/;
                    $e=$tmpto;
                    $this->{backsctrdone} = $this->{msgidsigdone} = $this->{nodelay} = $this->{isbounce} = 1;
                    $this->{prepend} = '[isbounce]';
                    mlog($fh,"bounce message detected");
                    $this->{prepend} = '';
                    if ($e =~ /$EmailAdrRe\@($EmailDomainRe)/io && ! localmail($1)) {
                        $foreignSRS = 1;   # our SRS was done for a foreign domain
                        mlog($fh,"info: SRS - foreign recipient domain '$1' detected") if $SessionLog > 1;
                    }
                } else {
                    $failed = $@ || 'user not local';
                }
            } elsif ($e=~/^<?(SRS1[=+-][^\r\n>]*)/io) {
                my $asrs1 = $1;
                my $asrs0;
                if (eval{$asrs0=$srs->reverse($asrs1)}) {
                    mlog($fh,"info: SRS - replace $asrs1 with $asrs0") if $SessionLog > 1;
                    my $srs0_dom;
                    $srs0_dom = $1 if $asrs0 =~ /\@($EmailDomainRe)$/io;
                    if (eval{$tmpto=$srs->reverse($asrs0)}) {
                        mlog($fh,"info: SRS - replace $asrs0 with $tmpto") if $SessionLog > 1;
                        $this->{SRSorgAddress} = $asrs1 = quotemeta($asrs1);
                        $this->{SRSnewAddress} = $tmpto;
                        $l=~s/$asrs1/$tmpto/;
                        $e=$tmpto;
                        $this->{backsctrdone} = $this->{msgidsigdone} = $this->{nodelay} = $this->{isbounce} = 1;
                        $this->{prepend} = '[isbounce]';
                        mlog($fh,"bounce message detected");
                        $this->{prepend} = '';
                        if ($e =~ /$EmailAdrRe\@($EmailDomainRe)/io && ! localmail($1)) {
                            $foreignSRS = 1;  # our SRS was done for a foreign domain
                            mlog($fh,"info: SRS - foreign recipient domain '$1' detected") if $SessionLog > 1;
                        }
                    } else {  # SRS1 was OK for us - possibly the SRS0 comes from another host if the domain in SRS0 is not local
                        my $err = $@;
                        if ( localmail($srs0_dom) ) {
                            $failed = $err || 'user not local';
                        } else {
                            $this->{SRSorgAddress} = $asrs1 = quotemeta($asrs1);
                            $this->{SRSnewAddress} = $asrs0;
                            $l=~s/$asrs1/$asrs0/;
                            $e=$asrs0;
                            $this->{backsctrdone} = $this->{msgidsigdone} = $this->{nodelay} = $this->{isbounce} = 1;
                            $this->{prepend} = '[isbounce]';
                            mlog($fh,"bounce message detected");
                            $this->{prepend} = '';
                            if ($e =~ /$EmailAdrRe\@($EmailDomainRe)/io && ! localmail($1)) {
                                $foreignSRS = 1;  # our SRS was done for a foreign domain
                                mlog($fh,"info: SRS - foreign recipient domain '$1' detected") if $SessionLog > 1;
                            }
                        }
                    }
                } else {
                    $failed = $@ || 'user not local';
                }
            } else {
                $this->{invalidSRSBounce} = 1 if $this->{isbounce};
            }
            if ($failed && !($this->{ispip}) && !(matchIP($this->{ip},'noSRS',0,1))) {
                $failed =~ s/\r|\n//go;
                $this->{prepend}='[RelayAttempt]';
                $this->{messagereason} = "invalid SRS signature: $failed";
                mlog( $fh, $this->{messagereason} );
                $Stats{rcptRelayRejected}++;
                pbAdd($fh,$this->{ip},'rlValencePB','RelayAttempt',0);
                if($MaxErrors && ++$this->{serverErrors} > $MaxErrors) {
                    MaxErrorsFailed($fh,
                    "551 5.7.6 $this->{messagereason}\r\n421 <$myName> closing transmission\r\n" ,
                    "max errors (MaxErrors=$MaxErrors) exceeded -- dropping connection - after $this->{messagereason}");
                    return;
                }
                sendque($fh,"551 5.7.6 $this->{messagereason}\r\n");
                return;
            }
        }

        $e = batv_remove_tag(0,$e,'');

        # BATV check and stuff for rcpt to
        if ($this->{relayok}) {                   # it's outgoing mail
            $l=~/rcpt to:\s*<*([^\r\n>]*)/io;    # get the recipient address
            my $rt = $1;
            if ($remindBATVTag && $this->{isbounce} && exists $BATVTag{lc($rt)}) {        # if we remind strange Tags - does the Tag exists
                my ($gen, $day, $hash, $orig_user) = ($BATVTag{lc($rt)} =~ /^prvs=(\d)(\d\d\d)(\w{6})=([^\r\n]*)/o);  # get the Tag details
                my $today = (time / 86400) % 1000;                   # how old is the Tag
                my $dt = ($day - $today + 1000) % 1000;
                if ($dt <= 7) {
                    $l =~ s/$rt/$BATVTag{lc($rt)}/i;          # the age is OK - less than 8 days - so replace recipient address with tagged address
                    mlog($fh,"reminded BATV-Tag $BATVTag{lc($rt)} for recipient $rt") if ($BATVLog >= 2);
                } else {
                    delete $BATVTag{lc($rt)};
                }
            }
        } else {                                # it' incoming mail
            $l=~/rcpt to:\s*<*([^\r\n>]*)/io;  # get the recipient address
            my $rt = $1;
            my $ok;
            my $res;
            my $lrt = batv_remove_tag($fh,$rt,'BATVrcpt');  # remove any Tag - store it ->{BATVrcpt}
            my $tlit = &tlit($DoBATV);
            if ($DoBATV) {      # we have to do BATV-check
               $l =~ s/\Q$rt\E/$lrt/i if ($removeBATVTag && lc($rt) ne lc($lrt));    # replace tagged address with simple address
               ($res,$ok) = &batv_rcpt_in($fh,$rt);      # check if BATV is OK
               if ($ok == 1) {      # if OK remove $BATVTag{}
                    $l =~ s/\Q$rt\E/$lrt/i if ($removeBATVTag && lc($rt) ne lc($lrt));    # replace tagged address with simple address
                    mlog($fh,"BATV-Tag removed from recipient address $rt") if ($BATVLog && lc($lrt) ne lc($rt) && $removeBATVTag);
                    mlog($fh,"$tlit BATV-check pass for bounce sender \<$this->{mailfrom}\> rcpt $rt") if ($BATVLog && $res ne $rt);
                    $this->{msgidsigdone} = 1 if ($res ne $rt && $DoBATV != 4);       # do no other Backscatter tests
                    $this->{backsctrdone} = 1 if ($res ne $rt && $DoBATV != 4);
               } elsif ($ok == 0) {             # BATV check failed -> SPAM
                    $l =~ s/\Q$rt\E/$lrt/i if ($removeBATVTag && lc($rt) ne lc($lrt));    # replace tagged address with simple address
                    mlog($fh,"BATV-Tag removed from recipient address $rt") if ($BATVLog && lc($lrt) ne lc($rt) && $removeBATVTag);
                    $this->{msgidsigdone} = '';
                    $this->{backsctrdone} = '';

                    $this->{messagereason}="BATV check failed for bounce sender \<$this->{mailfrom}\> rcpt $rt";
                    $this->{prepend}='[BATV]';
                    mlog($fh,"$tlit $this->{messagereason}") if ($BATVLog && $DoBATV != 4);
                    if ($DoBATV != 2 && $DoBATV != 4) {  # if block or score
                        pbWhiteDelete($fh,$this->{ip});
                        pbAdd($fh,$this->{ip},'batvValencePB',"BATV-check-failed");
                        $Stats{batvErrors}++;
                        my $done = $DoBATV == 1 ? 1 : 0;     # if we block on BATV failed - tell the client
                        if ($Back250OKISP && $this->{ispip}) {
                            $this->{accBackISPIP} = 1;
                            mlog($fh,"info: force sending 250 OK to ISP for failed bounced message") if $BacksctrLog;
                        } else {
                            thisIsSpam($fh,$this->{messagereason},$BackLog,'554 5.7.10 BATV error - bounce address - message was never sent by this domain - RCPT $rt',0,0,1) if $done;
                            return if $done;
                        }
                    }
               } else {               # BATV-check not needed, not possible or exception
                    $l =~ s/\Q$rt\E/$lrt/i if ($removeBATVTag && lc($rt) ne lc($lrt));    # replace tagged address with simple address
                    $this->{msgidsigdone} = '';
                    $this->{backsctrdone} = '';
                    mlog($fh,"BATV-Tag removed from recipient address $rt") if ($BATVLog && lc($lrt) ne lc($rt) && $removeBATVTag);
               }
            } else {            # no BATV-check defined
                $l =~ s/\Q$rt\E/$lrt/i if ($removeBATVTag && lc($rt) ne lc($lrt));    # replace tagged address with simple address
                mlog($fh,"BATV-Tag removed from recipient address $rt") if ($BATVLog >= 2 && lc($lrt) ne lc($rt) && $removeBATVTag);
            }
        }

        # end BATV for rcpt to
        $this->{prepend}='';

        # recipient replacment should be done next to here !
        delete $this->{orgrcpt};
        if ($ReplaceRecpt) {
            if ($l=~/rcpt to:\s*<*([^\r\n>]*)/io) {
                my $midpart  = $1;
                $midpart = batv_remove_tag(0,$midpart,'');
                my $orgmidpart = $midpart;
                if ($midpart) {
                  my $bpa = 0;
                  if($EnableBangPath && $midpart=~/([a-z\-_\.]+)!([a-z\-_\.]+)$/io) {
                      $midpart = "$2\@$1";
                  }
                  my $mf = $this->{mailfrom};
                  $mf = batv_remove_tag(0,$mf,'');
                  my $newmidpart = RcptReplace($midpart,$mf,'RecRepRegex');
                  if (lc $newmidpart ne lc $midpart) {
                      $l =~ s/\Q$orgmidpart\E/$newmidpart/i;
                      mlog($fh,"info: recipient $orgmidpart replaced with $newmidpart");
                      $this->{myheader}.="X-Assp-Recipient: recipient $orgmidpart replaced with $newmidpart\r\n";
                      $this->{orgrcpt} = $orgmidpart;
                  }
                }
            }
            $l=~/rcpt to: *([^\r\n]*)/io;
            $e = batv_remove_tag(0,$1,'');
        }

        #enforce valid email address pattern - RFC822
        if ($DoRFC822 & 1) {
            if ($e=~/<*([^\r\n>]*)/io) {
                my $RO_e = $1;
                my $nonASCII;
                my $error;
                if ($RO_e !~ /RSBM_.*?x2DXx2DX\d+\Q$maillogExt\E\@/i) {
                    if (($nonASCII = ! is_7bit_clean(\$RO_e)) || $RO_e !~ /$RFC822RE/o ) {
                        $error = 'RFC822';
                    }
                    if ($error) {
                        $this->{prepend}='[MalformedAddress]';
                        mlog($fh,"malformed address: '$RO_e' - $error");
                        $Stats{rcptRelayRejected}++;
                        $RO_e = encodeMimeWord($RO_e,'B','UTF-8') if $nonASCII; # be nice to the hackers server
                        pbAdd( $fh, $this->{ip}, 'irValencePB', 'InvalidAddress' );
                        if($MaxErrors && ++$this->{serverErrors} > $MaxErrors) {
                            MaxErrorsFailed($fh,
                            "553 Malformed ($error) address: $RO_e\r\n421 <$myName> closing transmission\r\n",
                            "max errors (MaxErrors=$MaxErrors) exceeded -- dropping connection after '$error' recipient validation");
                            return;
                        }
                        sendque($fh, "553 Malformed ($error) address: $RO_e\r\n");
                        return;
                    }
                }
            }
        }

        if ( ! $this->{relayok} && $e !~ /ORCPT/o && $e =~ /[\!\@]\S*\@/o  ) {
            # blatent attempt at relaying
            $this->{prepend}='[RelayAttempt]';
            $this->{messagereason} = "relay attempt blocked for (evil): $e";
            mlog( $fh, $this->{messagereason} );
            pbAdd( $fh, $this->{ip}, 'rlValencePB', 'RelayAttempt', 0 );
            $Stats{rcptRelayRejected}++;
            if($MaxErrors && ++$this->{serverErrors} > $MaxErrors) {
                MaxErrorsFailed($fh,
                $NoRelaying."\r\n421 <$myName> closing transmission\r\n" ,
                "max errors (MaxErrors=$MaxErrors) exceeded -- dropping connection - after ORCPT");
                return;
            }
            sendque($fh, $NoRelaying."\r\n");
            return;
        } elsif($EnableBangPath && $e=~/([a-z\-_\.]+)!([a-z\-_\.]+)$/io) {

   # someone give me one good reason why I should support bang paths! grumble...
            $u="$2\@";
            $h=$1;
        } elsif($l=~/rcpt to:[^\r\n]*?($EmailAdrRe\@)($EmailDomainRe)/io) {
            my $buh = batv_remove_tag(0,"$1$2",'');
            $buh =~ /($EmailAdrRe\@)($EmailDomainRe)/io;
            ($u,$h)=($1,$2);
        } elsif($l=~/rcpt to:[^\r\n]*?(\"$EmailAdrRe\"\@)($EmailDomainRe)/io) {
            ($u,$h)=($1,$2);
            my $buh = batv_remove_tag(0,"$u$h",'');
            $buh =~ /($EmailAdrRe\@)($EmailDomainRe)/io;
            ($u,$h)=($1,$2);
            $u =~ s/\"//go;
        } elsif($defaultLocalHost && $l=~/rcpt to:[^\r\n]*?<($EmailAdrRe)>/io) {
            ($u,$h)=($1,$defaultLocalHost);
            $u.='@';
        } else {

            # couldn't understand recipient
            $this->{prepend}="[RelayAttempt]";
            mlog($fh,"relay attempt blocked for (parsing): $e");

            $Stats{rcptRelayRejected}++;
            if($MaxErrors && ++$this->{serverErrors} > $MaxErrors) {
                MaxErrorsFailed($fh,
                $NoRelaying."\r\n421 <$myName> closing transmission\r\n" ,
                "max errors (MaxErrors=$MaxErrors) exceeded -- dropping connection - after relay (parsing)");
                return;
            }
            sendque($fh, $NoRelaying."\r\n");
            return;
        }
        my $rcptislocal=localmail($h);
        $this->{nodelay}=1 if ! $this->{relayok} && matchSL("$u$h",'noDelayAddresses');

        if ($rcptislocal) {
            $this->{mailfrom} = &batv_remove_tag(0,$this->{mailfrom},'') if localmail($this->{mailfrom});
            if ( ! $this->{relayok} && PersBlackFind("$u$h",$this->{mailfrom}) ) {
                my $addr = (exists $this->{orgrcpt}) ? $this->{orgrcpt} : "$u$h";
                my $reply = "550 mailbox for <$addr> is unavailable\r\n";
                $reply = "250 OK\r\n" if $send250OK or ($this->{ispip} && $send250OKISP);
                sendque( $fh, $reply );
                $this->{prepend} = "[PersonalBlack]";
                $this->{orgrcpt} = "$u$h";
                mlog( $fh, "[spam found] ($this->{mailfrom} rejected by personal black address list of $u$h - skipped recipient)" ,0,3);
                delete $this->{orgrcpt};
                return;
            } elsif (lc $u eq "abuse\@" && $sendAllAbuse) {
                # accept abuse catchall addresses
                if ($sendAllAbuse=~/$EmailAdrRe\@($EmailDomainRe)/io) {
                    $h=$1;
                    $l="RCPT TO:\<$sendAllAbuse\>\r\n";
                    $this->{noprocessing}=1 if $sendAllAbuseNP;
                }
            } elsif (lc $u eq "postmaster\@" && $sendAllPostmaster) {
                # accept postmaster catchall addresses
                if ($sendAllPostmaster=~/$EmailAdrRe\@($EmailDomainRe)/io) {
                    $h=$1;
                    $l="RCPT TO:\<$sendAllPostmaster\>\r\n";
                    $this->{noprocessing}=1 if $sendAllPostmasterNP;
                }
            } elsif ( matchSL( "$u$h", 'RejectTheseLocalAddresses' ) ) {
                if ($NoValidRecipient) {
                    $reply = $NoValidRecipient."\r\n";
                    $reply =~ s/EMAILADDRESS/$u$h/go;
                } else {
                    $reply = "550 5.1.1 User unknown $u$h\r\n";
                }
                sendque( $fh, $reply );
                $this->{prepend} = '[BounceAddress]';
                mlog( $fh, "rejected by bounce address list: $u$h" )
                  if $ValidateUserLog;
                return;
            } elsif (   (!$this->{nocollect} && matchSL( "$u$h", 'spamaddresses' ) )
                	 or ($UseTrapToCollect && &pbTrapFind("$u$h") )
                     or ($UseTrapToCollect && matchSL("$u$h",'spamtrapaddresses' && ! matchSL("$u$h",'noPenaltyMakeTraps')) )
                    )
            {
                $this->{addressedToSpamBucket}="$u$h";
                my $collectaddress; $collectaddress = $sendAllSpam if $sendAllSpam;
                $collectaddress=$sendAllCollect if $sendAllCollect;
                if ($collectaddress=~/($EmailAdrRe\@)($EmailDomainRe)/io) {
                    $u=$1;
                    $h=$2;
                    $l="RCPT TO: \<$collectaddress\>\r\n";
                }
            }
            if (!$this->{relayok} && !$this->{acceptall} && (&pbTrapFind("$u$h") || (matchSL("$u$h",'spamtrapaddresses') && ! matchSL("$u$h",'noPenaltyMakeTraps')))) {

                $this->{addressedToPenaltyTrap}=1;
                $this->{prepend}="[Trap]";
                pbWhiteDelete($fh,$this->{ip});
                $this->{whitelisted} = '';
                my $mf = batv_remove_tag(0,lc $this->{mailfrom},'');
                if ( &Whitelist($mf,"$u$h") ) {
            		&Whitelist($mf,"$u$h",'delete');
            		mlog( $fh, "penalty trap: whitelist deletion: $this->{mailfrom}" );
                }
                RWLCacheAdd( $this->{ip}, 4 );  # fake RWL none
                mlog($fh,"penalty trap address: $u$h") if $PenaltyLog;
                $this->{messagereason} = "penalty trap address: $u$h";
                pbAdd($fh,$this->{ip},'stValencePB','penaltytrap',0) ;
                $Stats{penaltytrap}++;
                delayWhiteExpire($fh);
                $reply = "550 5.1.1 User unknown: $u$h\r\n";
                if ($PenaltyTrapPolite) {
                    $reply = $PenaltyTrapPolite;
                    $reply =~ s/EMAILADDRESS/$u$h/go;
                }
                seterror( $fh, "$reply", 1 );
                return;
            }
        }
        if ($noProcessing) {
            $this->{uhnoprocessing}=0;
            $this->{rcptnoprocessing}=0;

            if(matchSL("$u$h",'NoProcessing')) {
                mlogRe($fh,"$u$h","NoProcessingList");
                $this->{uhnoprocessing}=1 if $LocalAddressesNP;
                $this->{delaydone}=1;
                $this->{rcptnoprocessing}=1;
            }
        }

        my $isEmailInterface =
                 (     localmail($h)
                    && (   lc $u eq lc "$EmailSpam\@"
                        || lc $u eq lc "$EmailHam\@"
                        || lc $u eq lc "$EmailWhitelistAdd\@"
                        || lc $u eq lc "$EmailWhitelistRemove\@"
                        || lc $u eq lc "$EmailRedlistAdd\@"
                        || lc $u eq lc "$EmailHelp\@"
                        || lc $u eq lc "$EmailAnalyze\@"
                        || lc $u eq lc "$EmailRedlistRemove\@"
                        || lc $u eq lc "$EmailSpamLoverAdd\@"
                        || lc $u eq lc "$EmailSpamLoverRemove\@"
                        || lc $u eq lc "$EmailNoProcessingAdd\@"
                        || lc $u eq lc "$EmailNoProcessingRemove\@"
                        || lc $u eq lc "$EmailBlackAdd\@"
                        || lc $u eq lc "$EmailBlackRemove\@"
                        || lc $u eq lc "$EmailPersBlackAdd\@"
                        || lc $u eq lc "$EmailPersBlackRemove\@"
                        || lc $u =~ /^RSBM.+?\Q$maillogExt\E\@$/i
                        || lc $u eq lc "$EmailBlockReport\@"
                       )
                 );
        my $emailok;
        $emailok = 1
          if (   $EmailInterfaceOk
              && $this->{senderok} ne '2'
              && $this->{senderok} ne '3'
              && ( $this->{relayok} || $this->{senderok} eq '1'  )
              && $isEmailInterface
             );

        # skip check when RELAYOK or EMAIL-Interface
        my $uh = "$u$h";
        $this->{alllog} = 1 if $allLogRe && $uh =~ /$allLogReRE/;

        if ( !$this->{uhnoprocessing} && !$emailok && !$this->{relayok} ) {

            my $trapfound = 0;

            if (   $LocalAddresses_Flat
                || $DoLDAP
                || ($DoVRFY &&
                    (scalar( keys %DomainVRFYMTA ) || scalar( keys %FlatVRFYMTA ))
                   )
               )
            {
                $this->{islocalmailaddress} = 0;
            }

            if ($SepChar) {
                if ( $u =~ /(.+?)\Q$SepChar\E/ ) {
                    $uh = "$1\@$h";
                    $uh =~ s/"//o;
                }
            }

            if ( &LDAPCacheFind( $uh, $DoLDAP ? "LDAP" : "VRFY") ) {
                $this->{islocalmailaddress} = 1;
                d("$uh validated by ldapcache\n");
                mlog( $fh, "$uh validated by ldapcache" )
                  if $ValidateUserLog == 3;
            }
            elsif ( matchSL( "$uh", 'spamaddresses' ) ) {
                $this->{islocalmailaddress} = 1;
                d("$uh validated by spamaddresses list\n");
                mlog( $fh, "$uh validated by spamaddresses list" )
                  if $ValidateUserLog == 3;
            }
            elsif ( !$this->{islocalmailaddress}
                && $uh =~ /^([^@]*)(@.*)$/o
                && matchSL( $2, 'LocalAddresses_Flat' ) )
            {
                $this->{islocalmailaddress} = 1;
                d("$2 validated by LocalAddresses_Flat\n");
                mlog( $fh, "$2 validated by LocalAddresses_Flat" )
                  if $ValidateUserLog == 3;
            }
            elsif ( !$this->{islocalmailaddress}
                && $LocalAddresses_Flat_Domains
                && $uh =~ /^([^@]*@)(.*)$/o
                && matchSL( $2, 'LocalAddresses_Flat' ) )
            {
                $this->{islocalmailaddress} = 1;
                d("$2 validated by LocalAddresses_Flat\n");
                mlog( $fh, "$2 validated by LocalAddresses_Flat" )
                  if $ValidateUserLog == 3;

            }
            elsif ( !$this->{islocalmailaddress} && matchSL( $uh, 'LocalAddresses_Flat' ) )
            {
                $this->{islocalmailaddress} = 1;
                d("$uh validated by LocalAddresses_Flat\n");
                mlog( $fh, "$uh validated by LocalAddresses_Flat" )
                  if $ValidateUserLog == 3;

                # Need another check?
            }
            elsif ( !$this->{islocalmailaddress} ) {

                # check recipient against LDAP ?
                $this->{islocalmailaddress} = &localmailaddress( $fh, $uh )
                  if (
                    ( $DoLDAP && $CanUseLDAP )
                    or ( $DoVRFY && $CanUseNetSMTP
                        && $uh =~ /^([^@]*@)(.*)$/o
                        && (&matchHashKey('DomainVRFYMTA', lc $2 )
                            or &matchHashKey('FlatVRFYMTA', lc "\@$2" ) )
                    )
                  );
            }
            if (! $this->{islocalmailaddress} && $UseTrapToCollect && pbTrapFind( $uh, 1 ) ||
                    (matchSL($uh,'spamtrapaddresses') && ! matchSL($uh,'noPenaltyMakeTraps')))
            {
                $this->{islocalmailaddress} = 1;
                $trapfound = 1;
                d("$uh validated by generated trapaddresses list\n");
                mlog( $fh, "$uh validated by generated trapaddresses list" )
                  if $ValidateUserLog == 3;
            }
            pbTrapDelete($uh) if $this->{islocalmailaddress} && ! $trapfound;
        } else {
            $this->{islocalmailaddress} = localmail($h);
        }

        if(!$foreignSRS && !$this->{relayok} && !$nolocalDomains && (!$rcptislocal || $uh=~/\%/o) || $u =~/\@\w+/o) {
            $this->{prepend}="[RelayAttempt]";
            mlog($fh,"relay attempt blocked for: $uh");
            $this->{messagereason}="relay attempt blocked for: $uh";
            pbAdd($fh,$this->{ip},'rlValencePB','RelayAttempt');
            $Stats{rcptRelayRejected}++;
            delayWhiteExpire($fh);
            if($MaxErrors && ++$this->{serverErrors} > $MaxErrors) {
                MaxErrorsFailed($fh,
                $NoRelaying."\r\n421 <$myName> closing transmission\r\n",
                "max errors (MaxErrors=$MaxErrors) exceeded -- dropping connection - after relay attemp");
                return;
            }
            sendque($fh, $NoRelaying."\r\n");
            return;
        }

        $this->{nobayesian} ||= matchSL($uh,'noBayesian');
        $this->{nocollect} ||= matchSL($uh,'noCollecting');
        $this->{noscan} ||= matchSL( $uh,'noScan');

       # check if this email is to be processed at all if in ProcessOnlyTestMode
        if( $poTestMode ) {

            if( !(matchSL($this->{mailfrom},'processOnlyAddresses') || matchSL($uh,'processOnlyAddresses') ) )
            {
                $this->{noprocessing} = 1;
            }
        }
        if (matchSL($uh,'spamaddresses')) {

            $this->{addressedToSpamBucket}=$uh;
        }

        if (   (matchSL($uh,'InternalAddresses')  &&  ! localmail($this->{mailfrom}))
            || (matchSL($uh,'InternalAndWhiteAddresses') && ! ( localmail($this->{mailfrom}) || Whitelist($this->{mailfrom},$uh, undef)) )
           )
        {
            NoLoopSyswrite($fh, $NoRelaying."\r\n",0);
            $this->{prepend}="[InternalAddress]";
            mlog($fh,"invalid remote sender for internal address: $uh");
            pbAdd($fh,$this->{ip},'iaValencePB',"internaladdress:$uh") ;
            $Stats{internaladdresses}++;
            delayWhiteExpire($fh);
            done($fh);
            return;
        }
        my $mSLRE     = matchSL($uh,'spamLovers')      and $this->{spamMaxScore} = max($this->{spamMaxScore}, matchHashKey(\%{$SLscore{'spamLovers'}},$uh));
        my $mBSLRE    = matchSL($uh,'baysSpamLovers')  and $this->{spamMaxScore} = max($this->{spamMaxScore}, matchHashKey(\%{$SLscore{'baysSpamLovers'}},$uh));
        my $mBLSLRE   = matchSL($uh,'blSpamLovers')    and $this->{spamMaxScore} = max($this->{spamMaxScore}, matchHashKey(\%{$SLscore{'blSpamLovers'}},$uh));
        my $mHLSLRE   = matchSL($uh,'hlSpamLovers')    and $this->{spamMaxScore} = max($this->{spamMaxScore}, matchHashKey(\%{$SLscore{'hlSpamLovers'}},$uh));
        my $mHISLRE   = matchSL($uh,'hiSpamLovers')    and $this->{spamMaxScore} = max($this->{spamMaxScore}, matchHashKey(\%{$SLscore{'hiSpamLovers'}},$uh));
        my $mBOSLRE   = matchSL($uh,'bombSpamLovers')  and $this->{spamMaxScore} = max($this->{spamMaxScore}, matchHashKey(\%{$SLscore{'bombSpamLovers'}},$uh));
        my $mPTRSLRE  = matchSL($uh,'ptrSpamLovers')   and $this->{spamMaxScore} = max($this->{spamMaxScore}, matchHashKey(\%{$SLscore{'ptrSpamLovers'}},$uh));
        my $mMXASLRE  = matchSL($uh,'mxaSpamLovers')   and $this->{spamMaxScore} = max($this->{spamMaxScore}, matchHashKey(\%{$SLscore{'mxaSpamLovers'}},$uh));
        my $mSPFSLRE  = matchSL($uh,'spfSpamLovers')   and $this->{spamMaxScore} = max($this->{spamMaxScore}, matchHashKey(\%{$SLscore{'spfSpamLovers'}},$uh));
        my $mRBLSLRE  = matchSL($uh,'rblSpamLovers')   and $this->{spamMaxScore} = max($this->{spamMaxScore}, matchHashKey(\%{$SLscore{'rblSpamLovers'}},$uh));
        my $mURIBLSLRE= matchSL($uh,'uriblSpamLovers') and $this->{spamMaxScore} = max($this->{spamMaxScore}, matchHashKey(\%{$SLscore{'uriblSpamLovers'}},$uh));
        my $mSRSSLRE  = matchSL($uh,'srsSpamLovers')   and $this->{spamMaxScore} = max($this->{spamMaxScore}, matchHashKey(\%{$SLscore{'srsSpamLovers'}},$uh));
        my $mDLSLRE   = matchSL($uh,'delaySpamLovers') and $this->{spamMaxScore} = max($this->{spamMaxScore}, matchHashKey(\%{$SLscore{'delaySpamLovers'}},$uh));
        my $mPBSLRE   = matchSL($uh,'pbSpamLovers')    and $this->{spamMaxScore} = max($this->{spamMaxScore}, matchHashKey(\%{$SLscore{'pbSpamLovers'}},$uh));
        my $mSBSLRE   = matchSL($uh,'sbSpamLovers')    and $this->{spamMaxScore} = max($this->{spamMaxScore}, matchHashKey(\%{$SLscore{'sbSpamLovers'}},$uh));
        my $mATSLRE   = matchSL($uh,'atSpamLovers')    and $this->{spamMaxScore} = max($this->{spamMaxScore}, matchHashKey(\%{$SLscore{'atSpamLovers'}},$uh));
        my $mISSLRE   = matchSL($uh,'isSpamLovers')    and $this->{spamMaxScore} = max($this->{spamMaxScore}, matchHashKey(\%{$SLscore{'isSpamLovers'}},$uh));

        if ($groupSpamLovers && $this->{rcpt} && $rcptislocal && ! $this->{relayok}) {
            if ((!$this->{spamloversonly} && ($mSLRE || $mBSLRE || $mBLSLRE  || $mBOSLRE || $mPTRSLRE ||
                  $mMXASLRE || $mHLSLRE || $mHISLRE || $mSPFSLRE || $mURIBLSLRE ||
                  $mRBLSLRE ||  $mSRSSLRE || $mDLSLRE || $mPBSLRE || $mISSLRE ||
                  $mATSLRE))
                or
                ($this->{spamloversonly} && ! ($mSLRE || $mBSLRE || $mBLSLRE  || $mBOSLRE || $mPTRSLRE ||
                  $mMXASLRE || $mHLSLRE || $mHISLRE || $mSPFSLRE || $mURIBLSLRE ||
                  $mRBLSLRE ||  $mSRSSLRE || $mDLSLRE || $mPBSLRE || $mISSLRE ||
                  $mATSLRE))
               )
            {
                my $reply = "452 too many recipients\r\n";
                mlog($fh,"info: envelope recipient $uh rejected - spamlover mismatch with previous envelope recipients")
                  if $ValidateUserLog;
                sendque( $fh, $reply );
                return;
            }
        }

        if ($mSLRE) {$this->{spamlover} |= 1} else {$this->{spamlover} |= 2};
        if ($baysSpamLoversRed && $mBSLRE) {$this->{redsl} |= 1} else {$this->{redsl} |= 2};
        if ($mDLSLRE) {$this->{dlslre} |= 1} else {$this->{dlslre} |= 2};

        if ($rcptislocal && ($mSLRE || $mBSLRE || $mBLSLRE  || $mBOSLRE || $mPTRSLRE ||
                             $mMXASLRE || $mHLSLRE || $mHISLRE || $mSPFSLRE || $mURIBLSLRE ||
                             $mRBLSLRE ||  $mSRSSLRE || $mDLSLRE || $mPBSLRE || $mISSLRE)
           )
        {
            $this->{allLoveSpam}|=1;
        } else {
            $this->{allLoveSpam}|=2;
        }
        if ($rcptislocal && ($mBSLRE || $mSLRE)) { $this->{allLoveBaysSpam}|=1 } else { $this->{allLoveBaysSpam}|=2 }
        if ($rcptislocal && ($mBLSLRE || $mSLRE)) { $this->{allLoveBlSpam}|=1 } else { $this->{allLoveBlSpam}|=2 }
        if ($rcptislocal && ($mBOSLRE || $mSLRE)) { $this->{allLoveBoSpam}|=1 } else { $this->{allLoveBoSpam}|=2 }
        if ($rcptislocal && ($mPTRSLRE || $mSLRE)) { $this->{allLovePTRSpam}|=1 } else { $this->{allLovePTRSpam}|=2 }
        if ($rcptislocal && ($mMXASLRE || $mSLRE)) { $this->{allLoveMXASpam}|=1 } else { $this->{allLoveMXASpam}|=2 }
        if ($rcptislocal && ($mHLSLRE || $mSLRE)) { $this->{allLoveHlSpam}|=1 } else { $this->{allLoveHlSpam}|=2 }
        if ($rcptislocal && ($mHISLRE || $mSLRE)) { $this->{allLoveHiSpam}|=1 } else { $this->{allLoveHiSpam}|=2 }
        if ($rcptislocal && ($mSPFSLRE || $mSLRE)) { $this->{allLoveSPFSpam}|=1 } else { $this->{allLoveSPFSpam}|=2 }
        if ($rcptislocal && ($mRBLSLRE || $mSLRE)) { $this->{allLoveRBLSpam}|=1 } else { $this->{allLoveRBLSpam}|=2 }
        if ($rcptislocal && ($mATSLRE)) { $this->{allLoveATSpam}|=1 } else { $this->{allLoveATSpam}|=2 }
        if ($rcptislocal && ($mURIBLSLRE || $mSLRE)) { $this->{allLoveURIBLSpam}|=1 } else { $this->{allLoveURIBLSpam}|=2 }
        if ($rcptislocal && ($mSRSSLRE || $mSLRE)) { $this->{allLoveSRSSpam}|=1 } else { $this->{allLoveSRSSpam}|=2 }
        if ($rcptislocal && ($mDLSLRE || $mSLRE)) { $this->{allLoveDLSpam}|=1 } else { $this->{allLoveDLSpam}|=2 }
        if ($rcptislocal && ($mPBSLRE || $mSLRE)) { $this->{allLovePBSpam}|=1 } else { $this->{allLovePBSpam}|=2 }
        if ($rcptislocal && ($mSBSLRE || $mSLRE)) { $this->{allLoveSBSpam}|=1 } else { $this->{allLoveSBSpam}|=2 }
        if ($rcptislocal && ($mISSLRE || $mSLRE)) { $this->{allLoveISSpam}|=1 } else { $this->{allLoveISSpam}|=2 }

        if ($groupSpamLovers && ! $this->{rcpt} && $rcptislocal && ! $this->{relayok}) {
            if ($mSLRE || $mBSLRE || $mBLSLRE  || $mBOSLRE || $mPTRSLRE ||
                $mMXASLRE || $mHLSLRE || $mHISLRE || $mSPFSLRE || $mURIBLSLRE ||
                $mRBLSLRE ||  $mSRSSLRE || $mDLSLRE || $mPBSLRE || $mISSLRE ||
                $mATSLRE)
            {
                $this->{spamloversonly} = 1;
            } else {
                $this->{spamloversonly} = 0;
            }
        }

        if (! $this->{whitelisted} && $whiteListedDomains && matchRE(["$this->{mailfrom},$uh"],'whiteListedDomains')) {
            $lastREmatch =~ s/,/ for /o;
            $this->{passingreason} = "whiteListedDomains '$lastREmatch'";
            $this->{whitelisted}=1;
        }

############################################ email interface ###################

        if ( $emailok )
        {
            $this->{mailfrom} = &batv_remove_tag(0,$this->{mailfrom},'');
            if(lc $u eq lc "$EmailSpam\@") {
                $this->{reportaddr} = 'EmailSpam';
  		        $this->{getline} = \&SpamReport;
                mlog( $fh, "email: spamreport", 1 ) if !($EmailErrorsModifyWhite || $EmailErrorsModifyNoP);
                mlog( $fh, "email: combined spam & whitelist report", 1 ) if $EmailErrorsModifyWhite;
                mlog( $fh, "email: combined spam & noprocessing report", 1 ) if $EmailErrorsModifyNoP;
                $Stats{rcptReportSpam}++;
                sendque($fh,"250 OK\r\n");
                return;
            } elsif(lc $u eq lc "$EmailHam\@") {
                $this->{reportaddr} = 'EmailHam';
		        $this->{getline} = \&SpamReport;
                mlog( $fh, "email: hamreport", 1 ) if !($EmailErrorsModifyWhite == 1 || $EmailErrorsModifyNoP);
                mlog( $fh, "email: combined ham & whitelist report", 1 ) if $EmailErrorsModifyWhite == 1;
                mlog( $fh, "email: combined ham & noprocessing report", 1 ) if $EmailErrorsModifyNoP;
                $Stats{rcptReportHam}++;
                sendque($fh,"250 OK\r\n");
                return;
            } elsif(lc $u eq lc "$EmailWhitelistAdd\@") {
                $this->{reportaddr} = 'EmailWhitelistAdd';
                $this->{getline}=\&ListReport;
                mlog($fh,"email whitelist addition report",1);
                $Stats{rcptReportWhitelistAdd}++;
                foreach my $ad (split(/ /o,$this->{rcpt})) {ListReportExec($ad,$this)};
                sendque($fh,"250 OK\r\n");
                return;
            } elsif(lc $u eq lc "$EmailWhitelistRemove\@") {
                $this->{reportaddr} = 'EmailWhitelistRemove';
                $this->{getline}=\&ListReport;
                mlog($fh,"email whitelist deletion report",1);
                $Stats{rcptReportWhitelistRemove}++;
                foreach my $ad (split(/ /o,$this->{rcpt})) {ListReportExec($ad,$this)};
                sendque($fh,"250 OK\r\n");
                return;
            } elsif(lc $u eq lc "$EmailRedlistAdd\@") {
                $this->{reportaddr} = 'EmailRedlistAdd';
                $this->{getline}=\&ListReport;
                mlog($fh,"email redlist addition report",1);
                $Stats{rcptReportRedlistAdd}++;
                foreach my $ad (split(/ /o,$this->{rcpt})) {ListReportExec($ad,$this)};
                sendque($fh,"250 OK\r\n");
                return;
            } elsif(lc $u eq lc "$EmailRedlistRemove\@") {
                $this->{reportaddr} = 'EmailRedlistRemove';
                $this->{getline}=\&ListReport;
                mlog($fh,"email redlist deletion report",1);
                $Stats{rcptReportRedlistRemove}++;
                foreach my $ad (split(/ /o,$this->{rcpt})) {ListReportExec($ad,$this)};
                sendque($fh,"250 OK\r\n");
                return;
            } elsif(lc $u eq lc "$EmailHelp\@") {
                $this->{reportaddr} = 'EmailHelp';
                $this->{getline}=\&HelpReport;
                mlog($fh,"email help",1);
#                $Stats{rcptReportHelp}++;
                sendque($fh,"250 OK\r\n");
                return;
            } elsif(lc $u eq lc "$EmailAnalyze\@") {
                $this->{reportaddr} = 'EmailAnalyze';
                $this->{getline}=\&AnalyzeReport;
#                $Stats{rcptReportAnalyze}++;
                sendque($fh,"250 OK\r\n");
                return;
            } elsif(lc $u eq lc "$EmailBlockReport\@" or $u =~ /^RSBM_.+?\Q$maillogExt\E\@$/i) {
                $this->{reportaddr} = 'EmailBlockReport';
                $this->{rcpt}="$u$h";
                $this->{getline}=\&BlockReport;
                mlog($fh,"blocked email report",1);
                sendque($fh,"250 OK\r\n");
                return;
            } elsif(lc $u eq lc "$EmailSpamLoverAdd\@") {
                $this->{reportaddr} = 'EmailSpamLoverAdd';
                $this->{getline}=\&ListReport;
                mlog($fh,"email spamlover addition report",1);
                foreach my $ad (split(/ /o,$this->{rcpt})) {ListReportExec($ad,$this)};
                sendque($fh,"250 OK\r\n");
                return;
            } elsif(lc $u eq lc "$EmailSpamLoverRemove\@") {
                $this->{reportaddr} = 'EmailSpamLoverRemove';
                $this->{getline}=\&ListReport;
                mlog($fh,"email spamlover deletion report",1);
                foreach my $ad (split(/ /o,$this->{rcpt})) {ListReportExec($ad,$this)};
                sendque($fh,"250 OK\r\n");
                return;
            } elsif(lc $u eq lc "$EmailNoProcessingAdd\@") {
                $this->{reportaddr} = 'EmailNoProcessingAdd';
                $this->{getline}=\&ListReport;
                mlog($fh,"email noprocessing addition report",1);
                foreach my $ad (split(/ /o,$this->{rcpt})) {ListReportExec($ad,$this)};
                sendque($fh,"250 OK\r\n");
                return;
            } elsif(lc $u eq lc "$EmailNoProcessingRemove\@") {
                $this->{reportaddr} = 'EmailNoProcessingRemove';
                $this->{getline}=\&ListReport;
                mlog($fh,"email noprocessing deletion report",1);
                foreach my $ad (split(/ /o,$this->{rcpt})) {ListReportExec($ad,$this)};
                sendque($fh,"250 OK\r\n");
                return;
            } elsif ( lc $u eq lc "$EmailBlackAdd\@" ) {
                $this->{reportaddr} = 'EmailBlackAdd';
                $this->{getline}    = \&ListReport;
                mlog( $fh, "email blacklist addition report", 1 );
                sendque( $fh, "250 OK\r\n" );
                return;
            } elsif ( lc $u eq lc "$EmailBlackRemove\@" ) {
                $this->{reportaddr} = 'EmailBlackRemove';
                $this->{getline}    = \&ListReport;
                mlog( $fh, "email blacklist deletion report", 1 );
                sendque( $fh, "250 OK\r\n" );
                return;
            } elsif ( lc $u eq lc "$EmailPersBlackAdd\@" ) {
                $this->{reportaddr} = 'EmailPersBlackAdd';
                $this->{getline}    = \&ListReport;
                mlog( $fh, "email personal blacklist addition report", 1 );
                sendque( $fh, "250 OK\r\n" );
                return;
            } elsif ( lc $u eq lc "$EmailPersBlackRemove\@" ) {
                $this->{reportaddr} = 'EmailPersBlackRemove';
                $this->{getline}    = \&ListReport;
                mlog( $fh, "email personal blacklist deletion report", 1 );
                sendque( $fh, "250 OK\r\n" );
                return;
            }
        } elsif (     $EmailInterfaceOk
                   && ($this->{senderok} eq '2' || $this->{senderok} eq '3')
                   && (   $this->{relayok}
                       || (   $EmailSenderOK
                           && matchSL( &batv_remove_tag(0,$this->{mailfrom},''), 'EmailSenderOK' ) ))
                   && $isEmailInterface
                )
        {
            $this->{mailfrom} = &batv_remove_tag(0,$this->{mailfrom},'');
            if(lc $u eq lc "$EmailHelp\@") {
                $this->{reportaddr} = 'EmailHelp';
                $this->{getline}=\&HelpReport;
                mlog($fh,"email help",1);
#                $Stats{rcptReportHelp}++;
                sendque($fh,"250 OK\r\n");
                return;
            } elsif(lc $u eq lc "$EmailAnalyze\@") {
                $this->{reportaddr} = 'EmailAnalyze';
                $this->{getline}=\&AnalyzeReport;
#                $Stats{rcptReportAnalyze}++;
                sendque($fh,"250 OK\r\n");
                return;
            } elsif(lc $u eq lc "$EmailBlockReport\@" or $u =~ /^RSBM_.+?\Q$maillogExt\E\@$/i) {
                $this->{reportaddr} = 'EmailBlockReport';
                $this->{rcpt}="$u$h";
                $this->{getline}=\&BlockReport;
                mlog($fh,"blocked email report",1);
                sendque($fh,"250 OK\r\n");
                return;
            }
            ReturnMail($fh,$this->{mailfrom},"$base/$ReportFiles{EmailSenderNotOK}",'assp-error',\"\n") if ($this->{senderok} eq '2');
        	$this->{getline} = \&NullFromToData;
        	&NullFromToData($fh,$l);
        	mlog($fh,"denied connection to email interface ($uh) moved to NULL-connection",1);
	        return;
        }

        $this->{rcptValidated}=$this->{rcptNonexistent}=0;

        if ($this->{addressedToSpamBucket}) {

            # accept SpamBucket addresses in every case
            $this->{rcpt}.="$uh ";
            pbTrapDelete("$uh");
        } elsif (! $this->{relayok} && matchSL([$uh,$this->{mailfrom}],'NullAddresses')) {
            mlog($fh,"connection moved to NULL-connection",1) if $ConnectionLog;
        	$this->{getline} = \&NullFromToData;
        	&NullFromToData($fh,$l);
	        return;
        } elsif (! $foreignSRS && ($LocalAddresses_Flat || $DoLDAP || ($DoVRFY && (scalar(keys %DomainVRFYMTA) || scalar(keys %FlatVRFYMTA) )))) {
            if (($this->{islocalmailaddress}) || ($this->{relayok}) && ! $rcptislocal) {
                if ( &serverIsSmtpDestination($server)) {
                    my $tuh = quotemeta($uh);
                    if ($this->{delayqueue} =~ /^$tuh | $tuh /i) {
                        $this->{rcpt}.="$uh ";
                        sendque($server, $l);
                        return;
                    } elsif ( ! Delayok($fh,"$uh")) {
                        $this->{delayqueue} .= "$uh ";
                        $this->{rcpt}.="$uh ";
                        mlog($fh,"recipient delaying queued: $uh",1) if $DelayLog >= 2;
                        sendque($server, $l);
                        return;
                    }
                }
                $this->{donotdelay} = 1;
                $this->{rcpt}.="$uh ";
                mlog($fh,"recipient accepted: $uh",1) if $this->{alllog} or $ValidateUserLog>=2;
                $this->{rcptValidated}=1;
                pbTrapDelete("$uh");
            } elsif ( exists $calist{$h} ) {
                my $uhx = $calist{$h} . "@" . $h;
                mlog( $fh, "invalid address $uh replaced with $uhx", 1 )
                  if $this->{alllog} or $ValidateUserLog >= 2;
                $this->{rcpt} .= "$uhx ";
                $this->{messagereason} = "invalid address $uh";
                pbTrapAdd( $fh, "$uh" );
                pbAdd( $fh, $this->{ip}, 'irValencePB', 'InvalidAddress' );
                $Stats{rcptNonexistent}++;
                $this->{rcptValidated} = 1;
                $l = "RCPT TO:\<$uhx\>\r\n";
                if (matchSL($uhx,'NullAddresses')) {
                	$this->{getline} = \&NullFromToData;
                	&NullFromToData($fh,$l);
                        return;
                }
            } elsif ($CatchallallISP2NULL && $this->{ispip}) {
                mlog($fh,"invalid address $uh from ISP moved to NULL-connection",1) if $this->{alllog} or $ValidateUserLog>=2;
                pbTrapAdd($fh,"$uh");
                $this->{rcptValidated}=1;
                $Stats{rcptNonexistent}++;
                $this->{getline} = \&NullFromToData;
                &NullFromToData($fh,$l);
                return;
            } elsif ($CatchAllAll) {
                my $uhx = $CatchAllAll;
                mlog( $fh, "invalid address $uh replaced with $uhx", 1 )
                  if $this->{alllog} or $ValidateUserLog >= 2;
                $this->{rcpt} .= "$uhx ";
                $this->{messagereason} = "invalid address $uhx";
                pbTrapAdd( $fh, "$uhx" );
                pbAdd( $fh, $this->{ip}, 'irValencePB', 'InvalidAddress' );
                $Stats{rcptNonexistent}++;
                $this->{rcptValidated} = 1;
                $l = "RCPT TO:\<$uhx\>\r\n";
                if (matchSL($uhx,'NullAddresses')) {
                	$this->{getline} = \&NullFromToData;
                	&NullFromToData($fh,$l);
			        return;
                }

            } else {
                $this->{prepend}="[InvalidAddress]";
                $this->{messagereason}="invalid address $uh";
                mlog($fh,"invalid address rejected: $uh") if $this->{alllog} or $ValidateUserLog;
                pbTrapAdd($fh,"$uh");
                pbAdd($fh,$this->{ip},'irValencePB','InvalidAddress');
                $Stats{rcptNonexistent}++;
                $this->{rcptNonexistent}=1;
                if ($NoValidRecipient) {
                    $reply = $NoValidRecipient."\r\n";
                    $reply =~ s/EMAILADDRESS/$u$h/go;
                } else {
                    $reply = "550 5.1.1 User unknown\r\n";
                }
                if ($reply =~ /^5/o) {
                    if ( ($this->{userTempFail} &&
                          $DoVRFY &&
                          $CanUseNetSMTP &&
                          (! ($DoLDAP && $CanUseLDAP) ||
                             ($DoLDAP && $CanUseLDAP && $LDAPoffline)
                          )
                         ) or
                         ($DoLDAP && $CanUseLDAP && $LDAPoffline &&
                          (! ($DoVRFY && $CanUseNetSMTP) ||
                             ($DoVRFY &&
                              $CanUseNetSMTP &&
                              ! $this->{userTempFail} &&
                              $uh =~ /\@([^@]*)/o &&
                              ! (&matchHashKey('DomainVRFYMTA',$1) || &matchHashKey('FlatVRFYMTA',"\@$1"))
                             )
                          )
                         )
                       )
                    {
                        $reply =~ s/^\d{3} (?:\d+\.\d+\.\d+ ?)?/450 /o;
                    }
                }

                # increment error and drop line if necessary
                if($MaxErrors && ++$this->{serverErrors} > $MaxErrors) {
                    MaxErrorsFailed($fh,
                    $reply ."421 <$myName> closing transmission\r\n",
                    "max errors (MaxErrors=$MaxErrors) exceeded -- dropping connection - after invalid address");
                    return;
                }
                sendque( $fh, $reply );
                return;
            }
        } elsif ( &serverIsSmtpDestination($server)) {
            my $tuh = quotemeta($uh);
            if ($this->{delayqueue} =~ /^$tuh | $tuh /i) {
                $this->{rcpt}.="$uh ";
                sendque($server, $l);
                return;
            } elsif (! Delayok($fh,"$uh")) {
                $this->{delayqueue} .= "$uh ";
                $this->{rcpt}.="$uh ";
                mlog($fh,"recipient delaying queued: $uh",1) if $this->{alllog} or $DelayLog>=2;
                sendque($server, $l);
                return;
            }
            $this->{rcpt}.="$uh ";
            pbTrapDelete("$uh");
        } else {
            $this->{red}="$uh in RedList" if ($Redlist{"$uh"} || $Redlist{"*\@$h"} || $Redlist{"$wildcardUser\@$h"});
            $this->{rcpt}.="$uh ";
            mlog($fh,"recipient accepted without delaying: $uh",1) if $this->{alllog} or $ValidateUserLog>=2;
            $this->{donotdelay} = 1;
            $this->{rcptValidated}=1;
            pbTrapDelete("$uh");
        }

        # update Stats
        if ($this->{rcptnoprocessing}==1) {
            $Stats{rcptUnprocessed}++;
        } elsif ($this->{addressedToSpamBucket}) {
            $Stats{rcptSpamBucket}++;
        } elsif ($this->{allLoveSpam} & 1) {
            $Stats{rcptSpamLover}++;
        } elsif ($this->{rcptValidated}) {
            $Stats{rcptValidated}++;
        } elsif ($this->{rcptNonexistent}) {
            $Stats{rcptNonexistent}++;
        } elsif ($rcptislocal) {
            $Stats{rcptUnchecked}++;
        } elsif (&Whitelist("$u$h")) {
            pbWhiteAdd($this->{ip},"whitelisted:$uh");
            $Stats{rcptWhitelisted}++;
        } else {
            $Stats{rcptNotWhitelisted}++;
        }
        $this->{numrcpt} = 0;      # calculate the total number of rcpt
        foreach (split(/ /o,$this->{rcpt})) {$this->{numrcpt}++;}
        $this->{numrcpt} = 1 if ($this->{numrcpt} == 0);
    } elsif( $l=~/^ *XEXCH50 +(\d+)/io ) {
        $this->{lastcmd} = 'XEXCH50';
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
        $this->{skipbytes}=$1;
        d("XEXCH50 b=$1");
    } elsif( $l=~/^ *(DATA)/io || $l=~/^ *(BDAT) (\d+)/io ) {
        $this->{lastcmd} = $1;
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
        if($2) {
            $this->{bdata}=$2;
        } else {
            delete $this->{bdata};
        }

        mlog($fh, "maximum Spam-Lover-Score for this mail is set to $this->{spamMaxScore}") if $this->{spamMaxScore} && $ValidateUserLog >= 2;
        
        $this->{rcpt}=~s/\s$//o;

        $this->{numrcpt} = 0;      # calculate the total number of rcpt
        %{$this->{rcptlist}} = ();
        if ($whiteListedIPs && ! $this->{whitelisted}) {
            my $ret = matchIP( $this->{ip}, 'whiteListedIPs', $fh ,0);
            if ( $ret )
            {
                my $f = $lastREmatch ? " for 'lastREmatch'" : '';
                $this->{whitelisted}   = 1;
                $this->{passingreason} = "whiteListedIPs '$ret'$f";
            }
        }
        my $allPersWhite;
        my $removeWhite;
        foreach (split(/ /o,$this->{rcpt})) {
            $this->{numrcpt}++;
            next if $this->{rcptlist}{lc $_}++;
            next if ! $this->{relayok};
            my $w = &Whitelist($this->{mailfrom},$_);
            if (! $this->{whitelisted} && $allPersWhite != 0) {
                $allPersWhite = $w ? "$this->{mailfrom},$_" : 0;
            }
            if ($this->{whitelisted} && ! $removeWhite) {
                $removeWhite = $w ? 0 : "$this->{mailfrom},$_";
            }
        }
        $this->{numrcpt} = 1 if ($this->{numrcpt} == 0);
        if ($allPersWhite) {
            mlog($fh,"all envelope recipients are whitelisted - mail is processed as whitelisted") if $ValidateUserLog;
            $this->{whitelisted} = 1;
            $this->{passingreason} = "private-whitelistdb"
              if !$this->{passingreason};
        } elsif (! $this->{relayok} && $this->{whitelisted} && $removeWhite) {
            mlog($fh,"at least one removed private entry for an envelope recipient in whitelist ($removeWhite) - mail is no longer whitelisted") if $ValidateUserLog;
            $this->{whitelisted} = 0;
            $this->{passingreason} = ''
              if $this->{passingreason} =~ /white/o;
        }

        # drop line if no recipients left
        if ($this->{rcpt}!~/@/o) {

            # possible workaround for GroupWise bug
            if ($this->{delayed}) {
                if ($DelayError) {
                    $reply = $DelayError."\r\n";
                } else {
                    $reply = "451 4.7.1 Please try again later\r\n";
                }
                seterror($fh, $reply,1);
                mlog($fh,"DATA phase delayed",1) if $DelayLog;
                $Stats{msgDelayed}++ unless $this->{StatsmsgDelayed};
                $this->{StatsmsgDelayed} = 1;
                return;
            }
            mlog($fh,"no recipients left -- dropping connection",1) if $DelayLog || $ValidateUserLog>=2;
            $Stats{msgNoRcpt}++;

            delayWhiteExpire($fh);
            $this->{messagereason} = 'no recipients left';
            pbAdd($fh,$this->{ip},'erValencePB','NeedRecipient',0);
            seterror($fh,"503 5.5.2 Need Recipient\r\n",1);
            return;
        }
        $this->{donotdelay} ||= matchIP($this->{ip},'noDelay',$fh,0) unless $this->{relayok};
        if ($this->{noprocessing} eq '1' || ( allNP( $this->{rcpt} ) )
            || ( matchSL( $this->{mailfrom}, 'noProcessing' ) )  ) {

            $this->{noprocessing}=1;
            $this->{myheader} .= 'X-Assp-NoProcessing: YES';
            $this->{myheader} .= " - ($this->{passingreason})" if $this->{passingreason};
            $this->{myheader} .= "\r\n";

            MaillogStart($fh);    # notify the stream logging to start logging

            if($BlockNPExes || ($ScanNP && $UseAvClamd)   ) {
                &allocateMemory($fh);
                $this->{getline}=\&whitebodyNoExe;
            } else {
                &allocateMemory($fh);
                $this->{getline}=\&whitebody;
                $this->{prepend}="[NoProcessing]";

                my $fn;

                if ($noProcessingLog) {
                    $fn = Maillog($fh,'',$noProcessingLog); # tell maillog this isn't spam

                    $fn=' -> '.$fn if $fn ne '';
                    $fn='' if ! $fileLogging;
                }
                my $pr = $this->{passingreason} ? " - ($this->{passingreason}) -" : '' ;
                my $logsub =
                  ( $subjectLogging ? " $subjectStart$this->{originalsubject}$subjectEnd" : '' );
                mlog($fh,"message proxied without processing - (attachments unchecked)".de8($pr).$logsub.de8($fn),0,2);
                $Stats{noprocessing}++;
            }

        } elsif ($this->{isbounce} && $this->{delayed}) {
            &NumRcptOK($fh,0);
            $this->{prepend} = '';
            if ($DelayError) {
                $reply = $DelayError."\r\n";
            } else {
                $reply = "451 4.7.1 Please try again later\r\n";
            }
            seterror($fh, $reply,1);

            mlog($fh,"bounce delayed",1);
            $Stats{msgDelayed}++ unless $this->{StatsmsgDelayed};
            $this->{StatsmsgDelayed} = 1;
            return;
        } elsif ( $this->{relayok} && (my $nextTry = &localFrequencyNotOK($fh)) ) {
            $nextTry = &timestring($nextTry);
            $reply = "452 too many recipients for $this->{mailfrom} in $LocalFrequencyInt seconds - please try again not before $nextTry or send a notification message to your postmaster\@LOCALDOMAIN or local administrators\r\n";
            my $mfd;
            $mfd = $1 if lc $this->{mailfrom} =~ /\@([^@]*)/o;
            $reply =~ s/LOCALDOMAIN/$mfd/go;
            seterror($fh, $reply,1);
            mlog($fh,"warning: too many recipients (more than $LocalFrequencyNumRcpt in the last $LocalFrequencyInt seconds, $this->{numrcpt} in this mail) ($this->{ip}) for $this->{mailfrom} - possible local abuse",1);
            $Stats{localFrequency}++;
            my $mfr = batv_remove_tag(0,lc $this->{mailfrom},'');
            if (! exists $localFrequencyNotify{$mfr} ||
                 $localFrequencyNotify{$mfr} < time)
            {
                $localFrequencyNotify{$mfr} = int((time + 86400) / 86400) * 86400;  # 24:00 today
                mlog($fh,"notification: too many recipients (more than $LocalFrequencyNumRcpt in the last $LocalFrequencyInt seconds, $this->{numrcpt} in this mail)($this->{ip}) for $mfr - possible local abuse",1);
            }
            return;
        } else {
            if (! $this->{donotdelay}) {                        # if there is a queued delay
                delete $this->{donotdelay};                     # and the rcpt to: phase is passed
                if ($this->{delayqueue}) {                      # and no valid recpt -> delay
                    if (!$this->{isbounce}) {
                        &NumRcptOK($fh,0);
                        $this->{prepend} = '';
                        if ($DelayError) {
                            $reply = $DelayError."\r\n";
                        } else {
                            $reply = "451 4.7.1 Please try again later\r\n";
                        }
                        chop $this->{delayqueue};
                        $this->{TestMessageScore} = 1;   # get a prepend if we delay, to have the info in rebuildspamdb
                        $this->{prepend} = '[PenaltyDelay]' if TestMessageScore($fh);        # for griplist upload
                        delete $this->{TestMessageScore};
                        my $tp = $this->{prepend};
                        $this->{prepend} = (! $this->{prepend} && ! PBOK($fh,$this->{ip})) ? '[PenaltyDelay]' : $tp;
                        delete $this->{PBOK};
                        for (split(/\s+/o,$this->{delayqueue})) {
                            mlog($fh,"recipient delayed: $_") if $this->{alllog} or $DelayLog;
                            pbTrapDelete($_);
                            $this->{prepend} = '';
                        }
                        $this->{prepend} = '';
                        seterror($fh, $reply,1);
                        delete $this->{delayqueue};
                        $Stats{msgDelayed}++ unless $this->{StatsmsgDelayed};
                        $this->{StatsmsgDelayed} = 1;
                        $this->{delayed} = 1;
                        return;
                    }
                }
            } else {
                if ($this->{delayqueue}) {
                    chop $this->{delayqueue};
                    for (split(/\s+/o,$this->{delayqueue})) {
                        mlog($fh,"queued delay removed for recipient: $_",1) if $DelayLog >= 2;
                        mlog($fh,"recipient accepted: $_",1) if $this->{alllog} or $ValidateUserLog>=2;
                        $Stats{rcptDelayed}--;
                        $Stats{rcptValidated}++;
                        pbTrapDelete($_);
                    }
                    delete $this->{delayqueue};
                }
            }
            return unless &NumRcptOK($fh,1);
            if ($runlvl0PL) {
              my $rcvd = $this->{rcvd};
              headerUnwrap($rcvd);
              my $PlData = $this->{helo}."\r\n".               # call Plugins for handshake check
                           $this->{mailfrom}."\r\n".           # in runlevel 0
                           $this->{rcpt}."\r\n".
                           $rcvd."\r\n";
              my @plres = &callPlugin($fh,0,\$PlData);
              if ($plres[0]) {  # check scoring if OK
                 @plres = MessageScorePL($fh,@plres);
              }
              if (! $plres[0]) {
# @plres = [0]result,[1]data,[2]reason,[3]plLogTo,[4]reply,[5]pltest,[6]pl
                 mlog($fh,"mail blocked by Plugin $plres[6] - reason $plres[2]");
                 sendque($fh,"$plres[4]\r\n");
                 $this->{closeafterwrite} = 1;
                 $this->{error} = '5';
                 return;
              }
            }
            &allocateMemory($fh);
            MaillogStart($fh); # notify the stream logging to start logging
            $this->{getline}=\&getheader;
        }
    } elsif( $l=~/^ *RSET/io ) {
        $this->{lastcmd} = 'RSET';
        stateReset($fh); # reset everything
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
    } elsif( $l=~/^ *QUIT/io ) {
        $this->{lastcmd} = 'QUIT';
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
    } else {
    	my $tmp = $l ;
    	$tmp =~ s/\r|\n|\s//igo;
    	$tmp =~ /^([a-zA-Z0-9]+)/o;
    	if ($1) {
    	    $this->{lastcmd} = substr($1,0,14);
            push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
        }
    }
    if (uc($this->{lastcmd}) =~ /NOOP/o) {
        $this->{NOOPcount}++;
    } else {
        $this->{NOOPcount} = 0;
    }
    sendque($server, $l);
}

sub makeSubject {
    my $fh = shift;

    d('makeSubject');
    return if $Con{$fh}->{subject2} || ! $Con{$fh}->{headerpassed};
    my $sub;
    $sub = $1 if (substr($Con{$fh}->{header},0,index($Con{$fh}->{header},"\015\012\015\012")) =~ /\015\012Subject: *($HeaderValueRe)/iso);
    if (!$sub && $Con{$fh}->{maillogbuf}) {
        $sub = $1 if (substr($Con{$fh}->{maillogbuf},0,index($Con{$fh}->{maillogbuf},"\015\012\015\012")) =~ /\015\012Subject: *($HeaderValueRe)/iso);
    }
    headerUnwrap($sub);
    return unless $sub;
    $sub =~ s/\r|\n|\t//go;
    $Con{$fh}->{subject2}=$sub;
    $Con{$fh}->{subject2} =~ s/$NONPRINT//go;
    $sub=decodeMimeWords2UTF8($sub);
    $sub = d8($sub);
    $Con{$fh}->{subject3} = $sub;
#    $Con{$fh}->{subject3} =~ s/\\x\{\d{2,}\}/_/go;
    $Con{$fh}->{subject3} =~ s/_{2,}/_/go;
    $sub =~ s/[^a-zA-Z0-9]/_/go;
    $sub =~ s/_{2,}/_/go;
    $Con{$fh}->{originalsubject} = $sub;
    $Con{$fh}->{originalsubject} =~ s/_/ /go;
    $Con{$fh}->{originalsubject} =~ s/\s+$//o;
    $Con{$fh}->{originalsubject} =~ s/^\s+//o;
    $Con{$fh}->{originalsubject} = $Con{$fh}->{subject3} if $UseUnicode4SubjectLogging;
    $Con{$fh}->{originalsubject} = substr($Con{$fh}->{originalsubject},0,50) .
                                   '...' .
                                   substr($Con{$fh}->{originalsubject},length($Con{$fh}->{originalsubject})-50,50)
                 if length($Con{$fh}->{originalsubject}) > 100;
    $Con{$fh}->{subject}=substr($sub,0,50);
    $Con{$fh}->{subject} = e8($Con{$fh}->{subject});
    $Con{$fh}->{originalsubject} = e8($Con{$fh}->{originalsubject});
    $Con{$fh}->{subject3} = e8($Con{$fh}->{subject3});
}

sub getOriginIPs {
    my ($head, $ip, $cip, $getPTR, $fh) = @_;
    my $header = ref $head ? $$head : $head;
    my %ips;
    my $oip;
    my @sips;
    my %ptr;
    my @ignoredIP;
    d('getOriginIPs');
    $getPTR = (lc $getPTR eq 'ptr') ? 1 : 0;
    while ( $header =~ /(?:Received:\s+from\s+|(?:Origin(?:at(?:ing|ed))?|Source|client)[\s\-_]?IP:|[\s\-_]IP:)($HeaderValueRe)/gois ) {
        my $line = $1;
        headerUnwrap($line);
        my @words = $line =~ /\b(from|helo|by|for|with)\b/goi;
        while (@words) {
            while (@words && lc $words[0] ne 'with') {shift @words;}
            if (@words) {
                shift @words;
                if ($words[0]) {
                    if (lc $words[0] eq 'for') {
                        $line =~ s/\bwith\b.*$//o unless ( $line =~ s/\bwith\b.*?\b$words[0]\b(?:\s*"[^"]+")?\s*<?$EmailAdrRe\@$EmailDomainRe//i);
                    } else {
                        $line =~ s/\bwith\b.*?(\b$words[0]\b)/$1/i;
                    }
                } else {
                    $line =~ s/\bwith\b.*$//o;
                }
            }
        }
        $line =~ s/ by ($IPRe) / by [$1] /igo;
        $line =~ s/(?:ecelerity|id|SMTPSVC|version).+?$IPRe//iog;
        while ($line =~ /[\[\(]($IPRe)[\]\)]/go) {
            my $sip = $1;
            $sip = undef if $sip =~ /\.0+$/o;
            next unless $sip;
            $sip = ipv6expand(ipv6TOipv4($sip));
            next if exists $ips{$sip};
            push @ignoredIP,$sip;
            next if $sip eq $cip;
            next if $sip eq $ip;
            next if $sip =~ /$IPprivate/o;
            next if matchIP($sip,'ispip',0,0);
            next if matchIP($sip,'acceptAllMail',0,0);
            next if matchIP($sip,'whiteListedIPs',$fh,0);
            next if matchIP($sip,'noProcessingIPs',$fh,0);
            next if matchIP($sip,'noDelay',$fh,0);
            next if matchIP($sip,'noPB',0,0);

            pop @ignoredIP;
            push @sips, $sip;
            $oip = $sip;
            $ips{$sip} = 1;
            $ptr{$sip} = getRRData($sip,'PTR') if $getPTR;
        }
    }
    mlog(0,"info: enhanced Originated IP detection ignored IP's: ".join(' ,',@ignoredIP)) if $ConnectionLog >= 2 && @ignoredIP;
    mlog(0,"info: enhanced Originated IP detection found IP's: ".join(' ,',@sips)) if $ConnectionLog >= 2 && @sips;
    @sips = reverse @sips;
    return \@sips,\%ptr,$oip;
}

# get the header length of the DATA.
sub getheaderLength {
    my $fh = shift;
    return 0 unless $fh;
    my $l = 0;
    if (ref($fh) && ref($fh) ne 'SCALAR' && exists $Con{$fh}) {
        return 0 unless $Con{$fh}->{headerpassed};
        $l = index($Con{$fh}->{header}, "\x0D\x0A\x0D\x0A");
        return ($l >= 0 ? $l + 4 : 0);
    }
    return 0 unless length(ref($fh)?$$fh:$fh);
    $l = index((ref($fh)?$$fh:$fh), "\x0D\x0A\x0D\x0A");
    return ($l >= 0 ? $l + 4 : 0);
}

sub getheader {
    my($fh,$l)=@_;
    d('getheader');
    my $reply;
    my $done;
    my $done2;
    my $er;
    my $this=$Con{$fh};

    if($this->{inerror} or $this->{intemperror}) {  # got 4/5xx from MTA - possibly next step after DATA
        if ($send250OK or ($this->{ispip} && $send250OKISP)) {
            mlog($fh,"info: connection is moved to NULL after MTA has sent an error reply in DATA part") if $ConnectionLog;
            $this->{getline}=\&NullData;
            NullData($fh,$l);
            return;
        }
        $this->{cleanSMTPBuff} = 1;         # delete the SMTPbuff
        $this->{header} = '';
        $this->{getline}=\&getline;
        getline($fh,$l);
        return;
    }

    $this->{header}.=$l;
    my $headerlength=length($this->{header});
    my $maxheaderlength=$HeaderMaxLength;

    if($HeaderMaxLength && $headerlength>$maxheaderlength) {
        delayWhiteExpire($fh);
        $this->{prepend}="[OversizedHeader]";
        mlog($fh,"Possible Mailloop: Headerlength ($headerlength) > $maxheaderlength");
        seterror($fh,"554 5.7.1 possible mailloop - oversized header ($headerlength)",1);
        $Stats{msgverify}++;
        return;
    }

    if (   scalar keys %MEXH
        && ! $this->{relayok}
        && ! ($this->{noprocessing} & 1)
        && ! $this->{whitelisted}
        && $l =~ /^X-(?!ASSP)/io)
    {
        my $line = $l;
        $line =~ s/\r?\n//go;
        my ($xh) = $line =~ /^($HeaderNameRe)\:/o;
        my $maxval;
        $maxval = matchHashKey(\%MEXH,$xh) if $xh;
        if ($xh && $maxval && ++$this->{Xheaders}{lc $xh} > $maxval) {
            delayWhiteExpire($fh);
            $this->{prepend}="[Max-Equal-X-Header]";
            mlog($fh,"too many equal X-header lines (MaxEqualXHeader) - ($xh: $maxval)");
            seterror($fh,"554 5.7.7 too many equal X-headers ($xh:)",1);
            $Stats{msgverify}++;
            return;
        }
    }

    if (! $this->{relayok} && ! $this->{received}) {
        $this->{received} = $l =~ /^(?:Received:)|(?:Origin(?:at(?:ing|ed))?|Source)[\s\-_]?IP:/oi;
    }

    if ($l=~/^\.?[\r\n]*$/o) {
        $done2 = $l=~/^\.[\r\n]+$/o;
        $this->{org_header} = $this->{header};
        
        my $orgnp = $this->{noprocessing};
        $this->{noprocessing} = 0 if $this->{noprocessing} eq '2';  # noprocessing on message size
        $this->{headerpassed} = 1;
        $this->{skipnotspam} = 1;
        $this->{maillength} = $this->{headerlength} = $headerlength;
        $this->{headerlength} -= 3 if $done2;
        $this->{headerlength} = 0 if $this->{headerlength} < 0;
        my $slok;

        &makeSubject($fh);

        if ($crashHMM && $this->{crashfh} && HMMwillPossiblyCrash($fh,\$this->{header})) {
            $this->{prepend} = '[crashAnalyzer][block]';
            my $fn = $this->{maillogfilename};
            unless ($fn) {
                $fn = Maillog($fh,'',6); # tell maillog what this is -> discarded.
            }
            $fn=' -> '.$fn if $fn ne '';
            $fn='' if !$fileLogging;
            my $logsub = ( $subjectLogging && $this->{originalsubject} ? " $subjectStart$this->{originalsubject}$subjectEnd" : '' );
            mlog($fh,"[spam found] (crash analyzer said: 'this mail will possibly crash ASSP', will no longer analyze and forward but collect the mail)$logsub".de8($fn),0,2);
            delayWhiteExpire($fh);
            $this->{getline}=\&NullData;
            $this->{header} = 'NULL';
            $this->{intemperror} = 1;
            done2($this->{friend});
            delete $this->{friend};
            $Stats{crashAnalyze}++;
            return;
        }

        if ($this->{SRSorgAddress}) {
            $this->{nodkim} = 1 if $this->{header} =~ s/$this->{SRSorgAddress}/$this->{SRSnewAddress}/gi;
        }
        
        if (! $this->{from} && $this->{header} =~ /(?:^|\n)from:($HeaderValueRe)/oi) {
            my $from = $1;
            headerUnwrap($from);
            $this->{from} = $1 if $from =~ /($EmailAdrRe\@$EmailDomainRe)/oi;
        }

        if (! $this->{relayok} && ! PersBlackOK($fh) ) {
            $this->{skipnotspam} = 0;return;
        }

        if(! &MailLoopOK($fh)) {
            $this->{prepend}="[MailLoop]";
            mlog($fh,"warning: possible mailloop - found own received header more than $detectMailLoop times");
            seterror($fh,"554 5.7.1 possible mailloop - found own received header more than $detectMailLoop times",1);
            $Stats{msgverify}++;
            return;
        }
        d('contentonly');
        if(!$this->{contentonly} && $contentOnlyRe && $this->{header}=~/($contentOnlyReRE)/) {
            mlogRe($fh,($1||$2),"Contentonly");
            pbBlackDelete($fh,$this->{ip});
            $this->{contentonly}=1;
        }
        d('allLogReRE');
        if ( $allLogRe
             && ! $this->{alllog}
             && $this->{header} =~ /$allLogReRE/ )
        {
            $this->{alllog}=1;
        }
        d('isred auto');
        if ( ! $this->{red}
            && $this->{header} =~ /(auto-submitted\:|subject\:[^\r\n]*?auto\:)/io )
            # RFC 3834
        {
            mlogRe( $fh, $1, "Red" );
            $this->{red} = $1;
        }
        d('isred redReRE');
        if ( ! $this->{red}
            && $redRe
            && $this->{header} =~ /($redReRE)/ ) {

            mlogRe( $fh, ($1||$2), "Red" );
            $this->{red} = ($1||$2);
        }
        if (!$this->{whitelisted} && $whiteRe && $this->{header}=~/($whiteReRE)/) {
            mlogRe($fh,($1||$2),"White");
            $this->{whitelisted}=1;
        }
        if(!$this->{ccnever} && $ccSpamNeverRe && $this->{header}=~/($ccSpamNeverReRE)/) {
            mlogRe($fh,($1||$2),"CCnever");
            $this->{ccnever}=1;
        }
        if(!($this->{noprocessing} & 1) && $npRe && $this->{header}=~/($npReRE)/)
        {
            mlogRe($fh,($1||$2),"Noprocessing");
            pbBlackDelete($fh,$this->{ip});
            $this->{noprocessing}=1;
        }
        if(!$this->{spamlover} & 1 && $SpamLoversRe && $this->{header}=~/($SpamLoversReRE)/ ) {
            mlogRe($fh,($1||$2),"SpamLover");
            $this->{spamlover}=3;
        }

        $this->{noMSGIDsigLog} = 1;
        $this->{prepend} = '[Whitelisted]';
        if (! $this->{relayok} &&
            ! $this->{whitelisted} &&
            $DoMSGIDsig &&
            $CanUseSHA1 &&
            ! $this->{contentonly} &&
            ! $this->{isbounce} &&
            ! $this->{noprocessing} &&
            ! $this->{addressedToSpamBucket} &&
            ! $this->{red} &&
            ! $this->{msgidsigdone} &&
            &MSGIDsigCheck($fh)
           )
        {
            $this->{msgidsigdone} = 1;
            $this->{whitelisted} = 1;
            $this->{passingreason} = 'whitelisted - found valid Message-ID signature';
            pbBlackDelete($fh,$this->{ip});
            pbWhiteAdd($fh,$this->{ip},"Whitelisted");
        }

        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}
        $this->{prepend} = '';
        delete $this->{noMSGIDsigLog};

        if (! $this->{isDKIM} ) {
            if ($this->{header} =~ /(DomainKey)-Signature:/io) {
                $this->{isDKIM} = $1;
                d("isDKIM - $1-Signature");
                if ($DoDKIM && $CanUseDKIM) {
                    $this->{prepend}="[$this->{isDKIM}]";
                    $this->{skipmaillog} = 1;
                    mlog($fh,"$this->{isDKIM}-Signature found",1);
                }
            } elsif ($this->{header} =~ /(DKIM)-Signature:/io) {
                $this->{isDKIM} = $1;
                d("isDKIM - $1-Signature");
                if ($DoDKIM && $CanUseDKIM) {
                    $this->{prepend}="[$this->{isDKIM}]";
                    $this->{skipmaillog} = 1;
                    mlog($fh,"$this->{isDKIM}-Signature found",1);
                }
            }
        }
        $this->{prepend} = '';

        d('parse ci*');
        if ( ($this->{received} || $this->{relayok}) && $this->{ispip} && $this->{header} =~ /X-Forwarded-For: ($IPRe)/io) {
	        $this->{cipdone} = 1;
            $this->{cip} = ipv4TOipv6($1);
            my $cip = ipv6expand($1);
            my $cip2 = $1;
            my $orgHelo = $this->{helo};
	        while ( $this->{header} =~ /Received:($HeaderValueRe)/gios ) {
                my $h = $1;
                if ( $h =~ /\s+from\s+(?:([^\s]+)\s)?(?:.+?)(?:$this->{cip}|$cip|$cip2)\]?\)(.{1,80})by.{1,20}/gis ) {

                    $this->{ciphelo} = $1;
                    $this->{helo} = $1 if $1;
                    my $rhelo = $2;
                    $rhelo =~ s/\r?\n/ /go;
                    $rhelo =~ /.+?helo\s*=\s*([^\s]+)/io;
                    if ($1) {
                        $this->{ciphelo} = $1;
                        $this->{helo} = $1;
                    }
                }
            }
            if ($this->{cip} && matchIP($this->{cip},'ispip',$fh,0)) {
                delete $this->{cip};
                delete $this->{ciphelo};
                $this->{helo} = $orgHelo;
            } else {
                $this->{nohelo} = 1 if ( $this->{cip} && matchIP( $this->{cip}, 'noHelo', $fh ,0) );
                mlog( $fh, "Found X-Forwarded-For: $this->{ciphelo} ($this->{cip})", 1, 2 ) if $this->{cip};
            }
	    } elsif ( ($this->{received} || $this->{relayok}) && $this->{ispip} && $ispHostnames && !$this->{cipdone} ) {
            $this->{cipdone} = 1;
            my $orgHelo = $this->{helo};
	        while ( $this->{header} =~ /Received:($HeaderValueRe)/gios ) {
                my $h = $1;
                if ( $h =~ /\s+from\s+(?:([^\s]+)\s)?(?:.+?)($IPRe)(.{1,80})by.{1,20}($ispHostnamesRE)/gis ) {
                    my $cip = ipv6expand(ipv6TOipv4($2));
                    my $helo = $1;
                    my $rhelo = $3;
                    next if $cip =~ /$IPprivate/o;

                    $this->{cip} = $cip;
                    $this->{ciphelo} = $helo || $cip;
                    $rhelo =~ s/\r?\n/ /go;
                    $rhelo =~ /.+?helo\s*[= ]?\s*([^\s\)]+)/io;
                    $this->{ciphelo} = $1 if $1;
                }
            }
            if ($this->{cip} && matchIP($this->{cip},'ispip',$fh,0)) {
                delete $this->{cip};
                delete $this->{ciphelo};
                $this->{helo} = $orgHelo;
            } else {
                $this->{nohelo} = 1 if ( $this->{cip} && matchIP( $this->{cip}, 'noHelo', $fh ,0) );
                mlog( $fh, "Originating IP/HELO:  $this->{cip} / $this->{ciphelo}", 1, 2 ) if $this->{cip};
            }
        }
        if ($this->{cip}) {
            $this->{whitelisted} = 1 if matchIP( $this->{cip}, 'whiteListedIPs', $fh ,0);
            $this->{noprocessing} = 1 if matchIP( $this->{cip}, 'noProcessingIPs', $fh ,0);
            $this->{acceptall} = 1 if matchIP( $this->{cip}, 'acceptAllMail', $fh ,0);
        }

        if ( $enhancedOriginIPDetect && $this->{received} && ! $this->{relayok} ) {
            my ($ips,$ptr,$oip) = getOriginIPs(\$this->{header},$this->{ip},$this->{cip},0,$fh);
            @{$this->{sip}} = @{$ips};
            $this->{ssip} = $oip;
            if ($oip) {
                mlog( $fh, 'info: detected IP\'s on the mail routing way: '.join(', ',@{$this->{sip}}) ) if $ConnectionLog;
                mlog( $fh, "info: detected source IP: $this->{ssip}" ) if $ConnectionLog;
            }
        }

        HeloIsGood($fh,$this->{helo});

        if (! $this->{relayok} && ! headerAddrCheckOK($fh) ) {
            $this->{skipnotspam} = 0;return;
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if (! &FrequencyIPOK($fh)) {
            $this->{skipnotspam} = 0;return;
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if ($this->{cipdone} && $this->{ciphelo} && $this->{cip} && ! $this->{nohelo}) {
            if( ! &IPinHeloOK($fh) && &MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}
        }

        if(! ForgedHeloOK($fh)) {
            $reply =
                      $SenderInvalidError
                      ? "$SenderInvalidError"
                      : "$SpamError";
            $reply =~ s/REASON/$this->{messagereason}/go;
            $this->{prepend}="[ForgedHELO]";
            my $he = $this->{ciphelo} ? $this->{ciphelo}: $this->{helo};
            thisIsSpam($fh,"ForgedHELO:'$he'",$forgedHeloLog,$reply,$fhTestMode,0,0);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if(! subjectFrequencyOK($fh)) {
            my $slok=$this->{allLoveSpam}==1;
            thisIsSpam($fh,$this->{messagereason},$spamBombLog,$SpamError,$DoSameSubject == 4,$slok,0);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if(! BlackDomainOK($fh)) {
            my $slok=$this->{allLoveBlSpam}==1;
            unless ($slok) {$Stats{blacklisted}++;}
            thisIsSpam($fh,$this->{messagereason},$blDomainLog,$SpamError,$blTestMode,$slok,0);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if (! ($this->{whitelisted} ||= $this->{header} =~ /$whiteReRE/) ) {
            if (! &NoSpoofingOK( $fh, 'mailfrom' ) || ($DoNoSpoofing4From && ! &NoSpoofingOK( $fh, 'from' )) ) {
                my $slok = $this->{allLoveISSpam} == 1;
                $Stats{senderInvalidLocals}++ unless $slok;
                $reply = $SenderInvalidError;
                $reply =~ s/REASON/$this->{messagereason}/go;
                thisIsSpam( $fh, "$this->{messagereason}", $spamISLog, $reply,
                    $flsTestMode, $slok, 0 );
                if ($this->{error}) {$this->{skipnotspam} = 0;return;}
            }
            if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}
        }
        if (! LocalSenderOK($fh,$this->{ip})) {
            my $slok=$this->{allLoveISSpam}==1;
            unless ($slok) {$Stats{senderInvalidLocals}++;}
            $reply=$SenderInvalidError;
            $reply =~ s/REASON/Unknown Local Sender/go;
            $this->{prepend}="[UnknownLocalSender]";
            thisIsSpam($fh,"Unknown Local Sender",$spamISLog,$reply,$DoNoValidLocalSender==4,$slok,0);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        # if RELAYOK check localdomains if approprate
        if ( $this->{relayok}
            && ! $this->{red}
            && $DoLocalSenderDomain
            && ! $this->{acceptall}
            && ! localmail( $this->{mailfrom})
            && $this->{mailfrom}!~/$BSRE/
            && ! localmail( $this->{rcpt}) ) {

            $this->{prepend} = "[RelayAttempt]";
            NoLoopSyswrite( $fh, "530 Relaying not allowed - sender domain not local\r\n" ,0);
            $this->{messagereason} = "relay attempt blocked for unknown local sender domain";
            mlog( $fh, $this->{messagereason} );
            $Stats{rcptRelayRejected}++;
            delayWhiteExpire($fh);
            done($fh);
            return;
        }
        # if RELAYOK check localaddresses if approprate
        if ( $this->{relayok}
            && $DoLocalSenderAddress
            && ! $this->{acceptall}
            && ! $this->{red}
            && ! LocalAddressOK( $fh)
            && ! localmail( $this->{rcpt}) ) {
            $this->{prepend} = "[RelayAttempt]";
            NoLoopSyswrite( $fh, "530 Relaying not allowed - local sender address unknown\r\n",0 );
            $this->{messagereason} = "relay attempt blocked for unknown local sender address";
            mlog( $fh, $this->{messagereason} );
            $Stats{rcptRelayRejected}++;
            delayWhiteExpire($fh);
            done($fh);
            return;
        }

        if (! PBExtremeOK( $fh, $this->{ip} ) ) {
            my $slok = $this->{allLovePBSpam} == 1;
            my $er = $SpamError;
            $er = $PenaltyError if $PenaltyError;
            thisIsSpam( $fh, $this->{messagereason}, $spamPBLog, $er,$this->{testmode}, $slok, 1 );
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if (@{$this->{sip}}) {
            mlog($fh,"info: check IP's on mail route for IP-blocking") if $ConnectionLog >= 2;
            my $res = 1;
            foreach my $ip (@{$this->{sip}}) {
               $res &= PBExtremeOK( $fh, $ip , 1);
               last unless $res;
            }
            if (! $res) {
                my $slok = $this->{allLovePBSpam} == 1;
                my $er = $SpamError;
                $er = $PenaltyError if $PenaltyError;
                thisIsSpam( $fh, $this->{messagereason}, $spamPBLog, $er,$this->{testmode}, $slok, 1 );
                if ($this->{error}) {$this->{skipnotspam} = 0;return;}
            }
            if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}
        }
        
        if (! &RWLok($fh,$this->{ip})) {
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if (! $this->{msgid} && $this->{header}=~/\nMessage-ID:($HeaderValueRe)/sio) {
            $this->{msgid} = decodeMimeWords2UTF8($1);
            $this->{msgid}=~s/[\s>]+$//o;
            $this->{msgid}=~s/^[\s<]+//o;
        }
        
        if (! &MsgIDOK($fh)) {
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        &GRIPvalue($fh,$this->{ip});
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if (! &FromStrictOK($fh)) {
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        # header is done

        if(!$this->{bspams} && !$this->{noprocessing} && !$this->{whitelisted} && $WhitelistOnly) {
            $this->{bspams} = 1;
            $Stats{bspams}++;
            delayWhiteExpire($fh);
            my $slok=$this->{allLoveSpam}==1;
            $this->{prepend}="[WhitelistOnly]";
            thisIsSpam($fh,"Whitelist Only",$baysSpamLog,$SpamError,$baysTestMode,$slok,1);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }

        if(! DKIMpreCheckOK($fh)) {
            delete $this->{org_header};
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        delete $this->{org_header};
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        DMARCget($fh);

        if(! SPFok($fh) ) {
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if (! &DomainIPOK($fh)) {
            $this->{skipnotspam} = 0;return;
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if (! &SenderBaseOK($fh,$this->{ip})) {
            $this->{prepend} = '';
            my $slok=$this->{allLoveSBSpam}==1;
            unless ($slok) {$Stats{sbblocked}++;}
            $reply=$SenderInvalidError;

            $reply =~ s/REASON/$this->{messagereason}/go;
            thisIsSpam($fh,$this->{messagereason},$spamSBLog,$reply,$DoCountryBlocking == 4,$slok,0);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if ($this->{noprocessing}){
            $this->{attachcomment}="attachments unchecked";
            if($URIBLNP || $BlockNPExes || ($ScanNP && ($UseAvClamd or $DoFileScan))  ) {
                $this->{header} =~ s/$l$//;
                &whitebodyNoExe($fh,$l);
                if ($done2) {
                    $this->{getline}=\&getline unless $this->{error};
                } else {
                    $this->{getline}=\&whitebodyNoExe unless $this->{error};
                }
                return;
            } else {
                $this->{prepend}="[NoProcessing]";
                my $pr = $this->{passingreason} ? " - ($this->{passingreason}) -" : '' ;
                my $logsub =
                  ( $subjectLogging ? " $subjectStart$this->{originalsubject}$subjectEnd" : '' );
                mlog($fh,"message proxied without processing - (attachments unchecked)$pr$logsub",0,2);
                $Stats{noprocessing}++;

                isnotspam($fh,$done2);
                return;
            }
        } elsif ( onwhitelist( $fh, \$this->{header} || $this->{whitelisted} )) {
            $this->{noprocessing} ||= $orgnp if $orgnp;
            if ($RBLWL && (! RBLCacheOK($fh,$this->{ip},0) || ! &RBLok($fh,$this->{ip},0))) {
                if ($this->{error}) {$this->{skipnotspam} = 0;return;}
            }
            if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

            if ($RBLWL && @{$this->{sip}}) {
                mlog($fh,"info: check IP's on mail route for DNSBL") if $RBLLog >= 2;
                my $res = 1;
                my %saveRBLSP;
                my $return;
                for my $sp ('zen.spamhaus.org','pbl.spamhaus.org') {
                    for my $res ('127.0.0.10','127.0.0.11') {   # skip pbl.spamhaus.org dynamic IP-ranges return codes
                        $saveRBLSP{$sp}{$res} = $rblweight{$sp}{$res}
                            if defined $rblweight{$sp}{$res} ;
                        $rblweight{$sp}{$res} = 0;
                    }
                }
                foreach my $ip (@{$this->{sip}}) {
                    $res &= (! &RBLCacheOK($fh,$ip,1) || ! &RBLok($fh,$ip,1));
                    if (! $res) {
                        if ($this->{error}) {$this->{skipnotspam} = 0;$return = 1;last;}
                    }
                }
                for my $sp ('zen.spamhaus.org','pbl.spamhaus.org') {
                    for my $res ('127.0.0.10','127.0.0.11') {   # reset pbl.spamhaus.org dynamic IP-ranges return codes to org value
                        if (defined $saveRBLSP{$sp}{$res}) {
                            $rblweight{$sp}{$res} = $saveRBLSP{$sp}{$res};
                        } else {
                            delete $rblweight{$sp}{$res};
                        }
                    }
                }
                return if $return;
                if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}
            }
            if ($runlvl1PL && ! $this->{runlvl1PL}) {
                $this->{runlvl1PL} = 1;
                my @plres = &callPlugin($fh,1,\$this->{header});    # call the Plugins for runlevel 1
                if ($plres[0]) {  # check scoring if OK
                    @plres = MessageScorePL($fh,@plres);
                }

      # @plres = [0]result,[1]data,[2]reason,[3]plLogTo,[4]reply,[5]pltest,[6]pl
      # thisIsSpam($fh,$plres[2],$plres[3],$plres[4],$plres[5],0,$done);
                if (! $plres[0]) {
                    my $slok=$this->{allLoveSpam}==1;
                    mlog($fh,"mail blocked by Plugin $plres[6] - reason $plres[2]");
                    thisIsSpam($fh,$plres[2],$plres[3],$plres[4],$plres[5],$slok,$done);
                    if ($this->{error}) {$this->{skipnotspam} = 0;return;}
                }
            }
            if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

            $this->{attachcomment}="attachments unchecked";
            if($URIBLWL || $URIBLLocal || $BlockWLExes ||  (($ScanWL || $ScanLocal) && ($UseAvClamd or $DoFileScan)) ) {
                $this->{header} =~ s/\Q$l\E$//;
                &whitebodyNoExe($fh,$l);
                if ($done2) {
                    $this->{getline}=\&getline unless $this->{error};
                } else {
                    $this->{getline}=\&whitebodyNoExe unless $this->{error};
                }
                return;
            } else {
                if (! $this->{error}) {
                    my $fn = Maillog($fh,'',$NonSpamLog); # tell maillog this isn't spam

                    $fn=' -> '.$fn if $fn ne '';
                    $fn='' if !$fileLogging;

                    $this->{prepend} = '[Local]' if $this->{relayok};
                    $this->{prepend} = '[Whitelisted]' if !$this->{relayok};
                    $this->{spamprob}=0; addSpamProb($fh,1,0);
                    my $pr = $this->{passingreason} ? " - ($this->{passingreason}) -" : '' ;
                    my $logsub = ( $subjectLogging ? " $subjectStart$this->{originalsubject}$subjectEnd" : '' );
                    mlog( $fh, "local ($this->{attachcomment})".de8($pr).$logsub.de8($fn), 0, 2 ) if $this->{relayok};
                    mlog( $fh, "whitelisted ($this->{attachcomment})".de8($pr).$logsub.de8($fn), 0, 2 ) if !$this->{relayok};
                    isnotspam($fh,$done2);
                }
            }
            return;
        } elsif($this->{addressedToSpamBucket} && ! $this->{SpamCollectAddress} && !$DoNotBlockCollect ) {
            $this->{SpamCollectAddress} = 1;
            $Stats{spambucket}++ ;
            pbWhiteDelete($fh,$this->{ip});
            $this->{messagereason}="Collect Address: $this->{addressedToSpamBucket}";
            pbAdd($fh,$this->{ip},'saValencePB','SpamCollectAddress',2);
            $this->{prepend}="[Collect]";
            delayWhiteExpire($fh);
            thisIsSpam($fh,"$this->{messagereason}",$spamBucketLog,"250 OK",0,0,0);
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if ( ! &RBLCacheOK($fh,$this->{ip},0) || ! &RBLok($fh,$this->{ip},0) )  {
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if (@{$this->{sip}}) {
            mlog($fh,"info: check IP's on mail route for DNSBL") if $RBLLog >= 2;
            my $res = 1;
            my %saveRBLSP;
            my $return;
            for my $sp ('zen.spamhaus.org','pbl.spamhaus.org') {
                for my $res ('127.0.0.10','127.0.0.11') {   # skip pbl.spamhaus.org dynamic IP-ranges return codes
                    $saveRBLSP{$sp}{$res} = $rblweight{$sp}{$res}
                        if defined $rblweight{$sp}{$res} ;
                    $rblweight{$sp}{$res} = 0;
                }
            }
            foreach my $ip (@{$this->{sip}}) {
                $res &= ( ! &RBLCacheOK($fh,$ip,1) || ! &RBLok($fh,$ip,1));
                if (! $res) {
                    if ($this->{error}) {$this->{skipnotspam} = 0;$return = 1;last;}
                }
            }
            for my $sp ('zen.spamhaus.org','pbl.spamhaus.org') {
                for my $res ('127.0.0.10','127.0.0.11') {   # reset pbl.spamhaus.org dynamic IP-ranges return codes to org value
                    if (defined $saveRBLSP{$sp}{$res}) {
                        $rblweight{$sp}{$res} = $saveRBLSP{$sp}{$res};
                    } else {
                        delete $rblweight{$sp}{$res};
                    }
                }
            }
            return if $return;
            if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}
        }

        if(! BombHeaderOK($fh,\$this->{header})) {
            my $bomblt = $bombError;
            $bomblt .= " (reason: $this->{messagereason}) " if $bombErrorReason;
            $Stats{bombSender}++;
            delayWhiteExpire($fh);
            my $slok=$this->{allLoveBoSpam}==1;
            $this->{prepend}="[BombHeader]";
            thisIsSpam($fh,"$this->{messagereason}",$spamBombLog,$bomblt,$bombTestMode,$slok,1);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if (! invalidHeloOK($fh,\$this->{helo})) {
            my $slok=$this->{allLoveHiSpam}==1;
            unless ($slok) {$Stats{invalidHelo}++;}
            $reply=$SenderInvalidError;
            $this->{prepend}="[InvalidHELO]";
            $reply =~ s/REASON/Invalid HELO Format/go;
            thisIsSpam($fh,$this->{messagereason},$invalidHeloLog,$reply,$ihTestMode,$slok,0);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if (! validHeloOK($fh,\$this->{helo})) {
            my $slok=$this->{allLoveHiSpam}==1;
            unless ($slok) {$Stats{invalidHelo}++;}
            $reply=$SenderInvalidError;
            $this->{prepend}="[NotValidHELO]";
            $reply =~ s/REASON/Invalid HELO Format/go;
            thisIsSpam($fh,$this->{messagereason},$invalidHeloLog,$reply,$ihTestMode,$slok,0);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if(! BlackHeloOK($fh,$this->{helo})) {
            my $slok=$this->{allLoveHlSpam}==1;
            $this->{testmode} = $slok = 0 if allSH($this->{rcpt},'hlSpamHaters');
            unless ($slok) {$Stats{helolisted}++;}
            $this->{prepend}="[BlackHELO]";
            my $helo = lc($this->{helo});
            $helo = lc($this->{ciphelo}) if $this->{ispip} && $this->{ciphelo};
            thisIsSpam($fh,"HELO-Blacklist: '$helo'",$spamHeloLog,$SpamError,$hlTestMode,$slok,0);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if (! MXAOK($fh)) {
            my $slok=$this->{allLoveMXASpam}==1;
            unless ($slok) {$Stats{mxaMissing}++;}
            $reply=$SenderInvalidError;
            $this->{prepend}="[MissingMXA]";
            $reply =~ s/REASON/Missing MX and A record/go;
            thisIsSpam($fh,"missing MX and A record",$spamMXALog,$reply,$mxaTestMode,$slok,$done);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if (! PTROK($fh)) {
            $reply=$SenderInvalidError;
            my $slok=$this->{allLovePTRSpam}==1;
            $reply =~ s/REASON/$this->{messagereason}/go;
            thisIsSpam($fh,"$this->{messagereason}",$spamPTRLog,$reply,$ptrTestMode,$slok,0);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        if ($this->{invalidSRSBounce} && $SRSValidateBounce && !($this->{ispip}) && !($noSRS && matchIP($this->{ip},'noSRS',0,1))) {
            $this->{invalidSRSBounce} = '';
            my $slok = $this->{allLoveSRSSpam} == 1;
            $Stats{msgNoSRSBounce}++ unless $slok;
            $this->{prepend} = "[SRS]";
            $this->{messagereason} = "bounce address not SRS signed";
            pbAdd( $fh, $this->{ip}, 'srsValencePB', 'SRS_Not_Signed', 2 ) if $SRSValidateBounce !=2;
            my $tlit = tlit($SRSValidateBounce);
            mlog( $fh, "$tlit ($this->{messagereason})" ) if $SRSValidateBounce !=1;
            thisIsSpam(
                $fh, $this->{messagereason},
                $SRSFailLog, '554 5.7.5 Bounce address not SRS signed',
                $srsTestMode, $slok, 0
            ) if $SRSValidateBounce ==1;
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
            if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}
        }

        if($this->{isbounce} && ! &BackSctrCheckOK($fh,$this->{ip})) {
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

# remove Disposition-Notification headers if needed
        if ($removeDispositionNotification && ! $this->{relayok} &&
            $this->{header} =~ s/(?:ReturnReceipt|Return-Receipt-To|Disposition-Notification-To):$HeaderValueRe//gios
            )
        {
            $this->{maillength} = length($this->{header});
            mlog($fh,"removed Disposition-Notification headers from mail") if $ValidateSenderLog;
        }
        if ($runlvl1PL && ! $this->{runlvl1PL}) {
            $this->{runlvl1PL} = 1;
            my @plres = &callPlugin($fh,1,\$this->{header});    # call the Plugins for runlevel 1
            if ($plres[0]) {  # check scoring if OK
                @plres = MessageScorePL($fh,@plres);
            }

      # @plres = [0]result,[1]data,[2]reason,[3]plLogTo,[4]reply,[5]pltest,[6]pl
      # thisIsSpam($fh,$plres[2],$plres[3],$plres[4],$plres[5],0,$done);
            if (! $plres[0]) {
                my $slok=$this->{allLoveSpam}==1;
                mlog($fh,"mail blocked by Plugin $plres[6] - reason $plres[2]");
                thisIsSpam($fh,$plres[2],$plres[3],$plres[4],$plres[5],$slok,$done);
                if ($this->{error}) {$this->{skipnotspam} = 0;return;}
            }
        }
        if (&MsgScoreTooHigh($fh,$done)) {$this->{skipnotspam} = 0;return;}

        $this->{noprocessing} ||= $orgnp if $orgnp;
        
        if (! $this->{error}) {
            if ($done2) {          # we got .\r\n
                my $lHeader = length($this->{header}) - length($l);
                $lHeader = 0 if $lHeader < 0;
                $this->{header} = substr($this->{header},0,$lHeader);
                $this->{maillength} = $lHeader;
                &getbody($fh,$l);
                $this->{getline}=\&getline unless $this->{error};
            } else {
                $this->{getline}=\&getbody;
            }
        } else {
            if ($done2) {
                return if $this->{getline} eq \&getline;
                $this->{maillength} = length($this->{header}) - length($l);
                $this->{maillength} = 0 if $this->{maillength} < 0;
                &error($fh,$l);
                return;
            }
        }
    }
}

sub headerAddrCheckOK {
    my $fh = shift;
    my $this = $Con{$fh};
    d('headerAdrCheckOK');
    return 1 if skipCheck($this,'aa','ro');
    return headerAddrCheckOK_Run($fh);
}

sub headerAddrCheckOK_Run {
    my $fh = shift;
    my $this = $Con{$fh};
    d('headerAdrCheckOK');

    for my $bcc ('bcc','cc','to') {
        my $BCC = uc $bcc;
        my $remove = (($bcc eq 'bcc') && $removeForeignBCC);
        if ($remove && $this->{header} =~ s/(^|\n)$bcc:(?:$HeaderValueRe)/$1/igs) {
            mlog($fh,"info: found and removed unexpected $BCC: recipient addresses in incoming mail") if $ValidateUserLog >= 2;
            $this->{nodkim} = 1;     # we have modified the header and should skip the DKIM check for this reason
        } elsif ($DoHeaderAddrCheck && ! $nolocalDomains && (my @bccRCPT = $this->{header} =~ /(?:^|\n)$bcc:($HeaderValueRe)/igs)) {
            mlog($fh,"info: found and checking for unexpected $BCC: recipient addresses in incoming mail") if $ValidateUserLog >= 2;
            foreach my $bc (@bccRCPT) {
                headerUnwrap($bc);
                while ($bc =~ /($EmailAdrRe\@$EmailDomainRe)/igos) {
                    my $addr = $1;
                    if ($ReplaceRecpt) {
                        my $newadr = RcptReplace($addr,batv_remove_tag('',$this->{mailfrom},0),'RecRepRegex');
                        if (lc $newadr ne lc $addr) {
                            $this->{header} =~ s/((?:^|\n)$bcc:(?:$HeaderValueRe)*?)\Q$addr\E/$1$newadr/is;
                            mlog($fh,"$BCC: - recipient $addr replaced with $newadr") if $ValidateUserLog;
                            $addr = $newadr;
                            $this->{nodkim} = 1;     # we have modified the header and should skip the DKIM check for this reason
                        }
                    }
                    next if localmailaddress($fh,$addr);

                    if (   ! $this->{whitelisted}
                        && ! ($this->{noprocessing} & 1)
                        && (&pbTrapFind($addr) || (matchSL($addr,'spamtrapaddresses') && ! matchSL($addr,'noPenaltyMakeTraps'))))
                    {
                        $this->{prepend}="[Trap]";
                        pbWhiteDelete($fh,$this->{ip});
                        $this->{whitelisted} = '';
                        my $mf = batv_remove_tag(0,lc $this->{mailfrom},'');
                        if ( &Whitelist($mf,$addr) ) {
                    		&Whitelist($mf,$addr,'delete');
                    		mlog( $fh, "penalty trap: whitelist deletion: $this->{mailfrom}" );
                        }
                        RWLCacheAdd( $this->{ip}, 4 );  # fake RWL none
                        mlog($fh,"[spam found] penalty trap address: $addr");
                        $this->{messagereason} = "penalty trap address: $addr in $BCC:";
                        pbAdd($fh,$this->{ip},'stValencePB','penaltytrap',0) ;
                        $Stats{penaltytrap}++;
                        delayWhiteExpire($fh);
                        my $reply = "421 closing transmission - 5.1.1 User unknown: $addr\r\n";
                        if ($PenaltyTrapPolite) {
                            $reply = $PenaltyTrapPolite;
                            $reply =~ s/EMAILADDRESS/$addr/go;
                        }
                        if ($send250OK or ($this->{ispip} && $send250OKISP)) {
                            $this->{getline} = \&NullData;
                        } else {
                            sendque( $fh, $reply );
                            $this->{closeafterwrite} = 1;
                            done2($this->{friend});
                            delete $this->{friend};
                        }
                        $this->{prepend} = '';
                        return 0;
                    }

                    if (localmail($addr)) {
                        $this->{header} =~ /(?:^|\n)$bcc:(?:$HeaderValueRe)*?\Q$addr\E/is;
                        next if skipCheck($this,'aa','wl','rw','nb','nbip');
                        next if ($this->{noprocessing} & 1);
                        mlog($fh,"$BCC: - local but not valid recipient address '$addr' detected in mail header") if $ValidateUserLog;
                        pbAdd( $fh, $this->{ip}, 'irValencePB', 'InvalidAddress' );
                        next;
                    }
                    next if $bcc eq 'cc';   #cc: can be foreign
                    next if $bcc eq 'to';   #to: can be foreign

                    pbAdd($fh,$this->{ip},'rlValencePB','RelayAttempt',0);
                    $this->{prepend} = "[RelayAttempt]";
                    my $reply = "421 closing transmission - $BCC: recipient ($addr) is not local\r\n";
                    $this->{messagereason} = "relay attempt blocked for non local $BCC: recipient - $addr";
                    mlog(0,"Notice: you may set 'removeForeignBCC' to prevent this relay attempt blocking") if $ValidateUserLog;
                    $this->{spamfound} = 1;
                    if ($send250OK or ($this->{ispip} && $send250OKISP)) {
                        my $fn = $this->{maillogfilename};   # store the mail if we have to receive it
                        unless ($fn) {
                            $fn = Maillog($fh,'',6); # tell maillog what this is -> discarded.
                        }
                        $fn=' -> '.$fn if $fn ne '';
                        $fn='' if !$fileLogging;
                        my $logsub = ( $subjectLogging && $this->{originalsubject} ? " $subjectStart$this->{originalsubject}$subjectEnd" : '' );
                        mlog($fh,"[spam found] $this->{messagereason}$logsub".de8($fn),0,2);
                        $this->{getline} = \&NullData;
                    } else {
                        mlog( $fh, "[spam found] $this->{messagereason}" );
                        sendque( $fh, $reply );
                        $this->{closeafterwrite} = 1;
                        done2($this->{friend});
                        delete $this->{friend};
                    }
                    $Stats{rcptRelayRejected}++;
                    delayWhiteExpire($fh);
                    $this->{prepend} = '';
                    return 0;
                }
            }
        }
    }
    $this->{prepend} = '';
    return 1;
}

sub SPFbg {
    my $parm = shift;
    return unless ($ValidateSPF && $SPFCacheInterval && $SPFCacheObject && (($CanUseSPF2 && $SPF2) || $CanUseSPF));
    my $fh = time;
    ($Con{$fh}->{ip},$Con{$fh}->{mailfrom},$Con{$fh}->{helo}) = split(/ /o,$parm,3);
    SPFok_Run($fh);
    delete $Con{$fh};
}

# do SPF (sender policy framework) checks
# uses Mail::SPF v2.xxxx  or  Mail::SPF::Query v1.999001
sub SPFok {
    my $fh = shift;
    my $this = $Con{$fh};
    my $do1 = $CanUseSPF && $ValidateSPF;
    my $do2 = $CanUseSPF2 && $ValidateSPF && $SPF2;
    return 1 unless $do1 or $do2;
    return 0 unless SPFok_Run($fh);    # do SPF check on 'mail from'
    if (   $DoSPFinHeader
        && defined $this->{spfok}
        && ! $this->{error}
        && $this->{header} =~ /\nfrom:\s*($HeaderValueRe)/ois)   # and 'from:'
    {
        my $head = $1;
        headerUnwrap($head);
        if ($head =~ /($EmailAdrRe\@($EmailDomainRe))/o) {
            my $mf = $1;
            my $mfd = lc $2;
            my $envmfd;
            if ( $blockstrictSPFRe && $mf =~ /$blockstrictSPFReRE/ ) # ONLY if the 'from'  address is in strictSPFre
            {
        		 $envmfd = $1 if lc $this->{mailfrom} =~ /\@([^@]*)/o;
        		 return 1 if ($mfd eq $envmfd);
        		 mlog($fh,"SPF: do now the check for the header 'from: $mf' address") if $SPFLog;
        		 delete $this->{spfok};
        		 $this->{SPFokDone} = 0;
        		 my $omf = $this->{mailfrom};
        		 $this->{mailfrom} = $mf;
        		 my $ret = SPFok_Run($fh);
        		 $this->{mailfrom} = $omf;
        		 return 0 unless $ret;
            }
        }
    }
    return 0 if $fh && $DoDKIM && ! DMARCok($fh);
    return 1;
}

sub SPFok_Run {
    my $fh = shift;
    d('SPFok');
    my $do1 = $CanUseSPF && $ValidateSPF;
    my $do2 = $CanUseSPF2 && $ValidateSPF && $SPF2;
    $do1 = 0 if $do2;
    return 1 unless $do1 or $do2;
    
    my $this = $Con{$fh};
    $fh = 0 if "$fh" =~ /^\d+$/o;
    return 1 if $this->{SPFokDone};
    $this->{SPFokDone} = 1;
    my $ip   = $this->{ip};
    $ip = $this->{cip} if $this->{ispip} && $this->{cip};
    my $helo = $this->{helo};
    $helo = $this->{ciphelo} if $this->{ispip} && $this->{ciphelo};
    $this->{prepend} = '';
    my $block;
    my $strict;

    return 1 if $this->{relayok} && !$SPFLocal;
    return 1 if $this->{contentonly};
    return 1 if $this->{ispip} && !$this->{cip};
    return 1 if $this->{whitelisted} && !$SPFWL;
    return 1 if ($this->{noprocessing} & 1) && !$SPFNP;
    return 1 if !$SPFLocal && $ip =~ /$IPprivate/o;

    if ( $noSPFRe &&
        ($this->{mailfrom} =~ /($noSPFReRE)/ ||
         $this->{header} =~ /($noSPFReRE)/ )
       )
    {
        mlogRe( $fh, ($1||$2), "noSPF" );
        return 1;
    }

    if ( $strictSPFRe && $this->{mailfrom} =~ /($strictSPFReRE)/ )
    {
        mlogRe( $fh, ($1||$2), "SPFstrict" );
        $strict = 1;

    }
    if ( $blockstrictSPFRe && $this->{mailfrom} =~ /($blockstrictSPFReRE)/ )
    {
        mlogRe( $fh, ($1||$2), "blockSPFstrict" );
        $strict = 1;
        $block  = 1;
    }
    my $slok = $this->{allLoveSPFSpam} == 1;

    my $ValidateSPF = $ValidateSPF;
    if ( $ValidateSPF == 4 ) {
        $ValidateSPF = 1;
        $this->{testmode} = "ValidateSPF";
    }

    my $tlit = tlit($ValidateSPF);

    my ( $header_comment, $detail);
    my ( $local_exp, $authority_exp,$spf_record, $spf_fail, $received_spf);

    my $mf = lc $this->{mailfrom};
    my $mfd;
    $mfd = $1 if $mf =~ /\@([^@]*)/o;
    if (! $mfd) {
        $mfd = $helo;
        $mf = "postmaster\@$helo" unless $mf;
    }
    if ($mfd =~ /^\[?$IPRe\]?$/o) {
        mlog($fh,"info: skip SPF check - domain $mfd is not a FQDN") if $SPFLog;
        return 1;
    }
    my ( $cachetime, $spf_result, $chelo ) = SPFCacheFind($ip,$mfd);

    my ($usedfallback,$usedoverride);
    if ( !$spf_result ) {
        &sigoff(__LINE__);
        my $query;
        my $ip_overwrite;
        if ($do1) {       # Mail::SPF::Query v1.999001
            d('SPF1');
            eval {
                my $timeout = max($ALARMtimeout,($DNStimeout * $DNSretry),5);
                local $SIG{ALRM} =
                  sub { die "spf1_query_timeout after $timeout seconds\n" };    # NB: \n required
                alarm ($timeout);

                $query = Mail::SPF::Query->new(
                    sender     => $mf,
                    ipv4       => $ip,
                    helo       => $helo,
                    myhostname => $myName,
                    sanitize   => 1,
                    guess      => $LocalPolicySPF,      # non-standard feature
                    override   => {"$spfoverride"},     # non-standard feature
                    fallback   => {"$spffallback"},     # non-standard feature
                    debug      => $DebugSPF,
                    debuglog => sub { mlog( $fh, "SPF debuglog: @_", 1, 1 ); }
                );
                ( $spf_result, $local_exp, $header_comment, $spf_record, $detail ) = $query->result();

                alarm 0;
                1;
            } or do {
                alarm 0;

            #exception check
                mlog( $fh, "error: SPFOK(1): $@ - for $mfd (mailfrom:$mf / helo:$helo)", 1, 1 );
                &sigon(__LINE__);
                return 1;
            };   # end do eval $do1
        }      # end if $do1

        if ($do2) {              # Mail::SPF v2
            d('SPF2');
            eval {
                my $timeout = max($ALARMtimeout,($DNStimeout * $DNSretry),5);
                local $SIG{ALRM} =
                  sub { die "spf2_query_timeout after $timeout seconds\n" };    # NB: \n required
                alarm ($timeout);
                my %override   = eval "($spfoverride)";
                my %fallback   = eval "($spffallback)";
                my ( $identity, $scope );
                if ($mfd) {
                    $identity = $mf;
                    $scope    = 'mfrom';
                } else {
                    $identity = $helo;
                    $scope    = 'helo';
                }

                my $res = getDNSResolver();

                my $spf_server = Mail::SPF::Server->new(
                    hostname     => $myName,
                    dns_resolver => $res,
                    max_dns_interactive_terms => $SPF_max_dns_interactive_terms
                );

                my $request = Mail::SPF::Request->new(
                    versions      => [ 1, 2 ],
                    scope         => $scope,
                    identity      => $identity,
                    ip_address    => $ip,
                    helo_identity => $helo
                );

                my $result;
                my $ovr = matchHashKey(\%override,$mfd);
                mlog(0,"SPF: found SPFoverride for domain $mfd - $ovr") if $DebugSPF;
                if ($ovr) {
                    $usedoverride = 1;
                    my $version = ($ovr =~ /\s*v\s*=\s*spf1/io) ? 1 : 2;
                    try {
                        my $record = SPF_get_records_from_text($spf_server, $ovr, 'TXT', $version, $scope, $mfd);
                        $spf_server->throw_result('permerror', $request, "SPF override record not valid: \"$ovr\"\n") unless $record;
                        $request->record($record);
                        $record->eval($spf_server, $request);
                    }
                    catch Mail::SPF::Result with {
                        $result = shift;
                    }
                    except {
                        die ("SPF-exception: @_\n");
                    };
                } else {
                    $result = eval { $spf_server->process($request); };
                    my $fb;
                    if ($result && $result->code eq 'none' && ($fb = matchHashKey(\%fallback,$mfd))) {
                        $usedfallback = 1;
                        mlog(0,"SPF: got result 'none' - but found SPFfallback for domain $mfd => $fb") if $DebugSPF;
                        my $version = ($fb =~ /\s*v\s*=\s*spf1/io) ? 1 : 2 ;
                        try {
                            my $record = SPF_get_records_from_text($spf_server, $fb, 'TXT', $version, $scope, $mfd);
                            $spf_server->throw_result('permerror', $request, "SPF fallback record not valid: \"$ovr\"\n") unless $record;
                            $request->record($record);
                            $record->eval($spf_server, $request);
                        }
                        catch Mail::SPF::Result with {
                            $result = shift;
                        }
                        except {
                            die ("SPF-exception: @_\n");
                        };
                    }
                }

                eval { $spf_record = $request->record; };
                if ($result) {

                    $spf_result    = $result->code;  $spf_result =~ s/\\(["'])/$1/go;
                    $local_exp     = $result->local_explanation; $local_exp =~ s/\\(["'])/$1/go;
                    $authority_exp = eval{$result->authority_explanation if $result->can('authority_explanation');}; $authority_exp =~ s/\\(["'])/$1/go;
                    $received_spf = $result->received_spf_header; $received_spf =~ s/\\(["'])/$1/go;
                    $this->{received_spf} = $received_spf unless $fh;    # for analyze only
                } else {
                    $spf_result = 'error';
                }
                
                my $spfmatch;   # detect faiked SPF records
                $spfmatch = $1 if $received_spf =~ /(mechanism .+? matched)/io;
                my $minV4Network = min(($spf_record =~ /$IPv4Re\/(\d+)/go), ($spfmatch =~ /$IPv4Re\/(\d+)/go));
                $minV4Network = 24 unless defined $minV4Network;
                $minV4Network *= 4;
                my $minV6Network = min(($spf_record =~ /$IPv6Re\/(\d+)/go), ($spfmatch =~ /$IPv6Re\/(\d+)/go));
                $minV6Network = 96 unless defined $minV6Network;
                my $rec;
                if ($spf_result eq 'pass' &&
                    (  $spf_record =~ /\s*((?:v\s*=\s*spf.|spf2.0\/\S+).*?\+all)/oi #  ...+all  allows all IPs
                    || $spf_record =~ /\s*((?:v\s*=\s*spf.|spf2.0\/\S+).*?\D0+\.0+\.0+\.0+(?:\/\d+\s+)?.*?(?:all)?)/oi  # '0.0.0.0/xxx' allows also all IPs
                    || $spfmatch =~ /(\+all)/io
                    || $spfmatch =~ /\D(0+\.0+\.0+\.0+)/io
                    || ($rec = min($minV4Network,$minV6Network) < 32)
                    )
                   )
                {
                    $rec = $rec ? $spfmatch : $1;
                    (my $what, $spf_result) = ($rec=~/([+? ]all)/io || $rec!~/all/io) ?('SPAMMER',($rec=~/\?all/io)?'softfail':'fail'):('suspiciouse','none');
                    $ip_overwrite = '0.0.0.0';
                    mlog($fh,"SPF: found $what SPF record/mechanism '$rec' for domain $mfd - SPF result is set to '$spf_result'") if $SPFLog;
                    $this->{received_spf} .= "\&nbsp;<span class=negative>found $what record/mechanism '$rec' - switched result to '$spf_result'</span>" unless $fh;    # for analyze only
                }

                if ($DebugSPF) {

                    mlog( $fh, "$tlit spf_result:$spf_result", 1, 1 );
                    mlog( $fh, "identity:$identity",           1, 1 );
                    mlog( $fh, "scope:$scope",                 1, 1 );
                    mlog( $fh, "spf_record:$spf_record",       1, 1 );
                    mlog( $fh, "local_exp:$local_exp",         1, 1 );
                    mlog( $fh, "authority_exp:$authority_exp", 1, 1 ) if $authority_exp;
                    mlog( $fh, "received_spf:$received_spf",   1, 1 );
                }
                alarm 0;
                1;
            } or do {
                alarm 0;
            #exception check
                mlog( $fh, "error: SPFOK(2): $@ - for $mfd (mailfrom:$mf / helo:$helo)", 1, 1 );
                &sigon(__LINE__);
                return 1;
            }; # end do eval $do2
        }    # end if $do2
        
        &sigon(__LINE__);

        SPFCacheAdd( ($ip_overwrite?$ip_overwrite:$ip), $spf_result, $mfd, $helo )
            if (   $SPFCacheInterval > 0
                && $spf_result !~ /error/io
                && $ip !~ /$IPprivate/o
                && ! &matchIP($ip,'acceptAllMail',0,1)
               );
    }

    $this->{spf_result} = $spf_result;
    if (    $spf_result eq 'fail'
        || ($spf_result eq 'softfail' && ($SPFsoftfail || $strict))
        || ($spf_result eq 'neutral' && ($SPFneutral || $strict))
        || ($spf_result eq 'none' && ($SPFnone || $strict))
        || ($SPFqueryerror && $spf_result =~ /error|^unknown/io )
      )
    {
        if ($SPFqueryerror && $spf_result =~ /error|^unknown/io ) {
            $spf_fail = 0;
        } else {
            $spf_fail = 1;
        }
        $this->{spfok} = 0;
        pbWhiteDelete( $fh, $ip );
    } else {
        $spf_fail = 0;
        $this->{spfok} = ($spf_result eq 'pass') ? 1 : 0;
    }

    $received_spf = "SPF: $spf_result";
    $received_spf .= " (cache)" if $cachetime;
    $received_spf .= " ip=$ip";
    $received_spf .= " mailfrom=$this->{mailfrom}" if ( $this->{mailfrom} );
    $received_spf .= " helo=$this->{helo}" if ( $this->{helo} );
    $this->{received_spf} = $received_spf if (! $fh && ! $this->{received_spf}); # for analyze only
    $this->{received_spf} .= ' (strict)' if (! $fh && $strict);
    $this->{received_spf} .= ' (SFPoverride used)' if (! $fh && $usedoverride);
    $this->{received_spf} .= ' (SPFfallback used)' if (! $fh && $usedfallback);

    mlog( $fh, "$tlit $received_spf", 0, 1 )
      if (($SPFLog && $ValidateSPF >= 2 && !$this->{spfok}) or $SPFLog >= 2);

    return 1 if $ValidateSPF == 2 || $WorkerNumber == 10000;
	$this->{messagereason} = "SPF $spf_result";
    $this->{myheader} .= "X-Assp-Received-$received_spf\r\n"
      if $AddSPFHeader && !$this->{spfok};

    if ($this->{myheader} =~ s/X-Original-Authentication-Results:($HeaderValueRe)//ois) {
        my $val = $1;
        headerUnwrap($val);
        $val =~ s/\r|\n//go;
        $val =~ s/ spf=\S+//o;
        $val .= " spf=$spf_result";
        $this->{myheader} .= "X-Original-Authentication-Results:$val\r\n";
    } else {
        $this->{myheader} .= "X-Original-Authentication-Results: $myName; spf=$spf_result\r\n";
    }

    if ($spf_fail && $strict) {
        pbAdd( $fh, $ip, 'spfValencePB', "SPF$spf_result-strict" ) if $fh;
    } elsif ( $spf_result eq 'neutral' ) {
        pbAdd( $fh, $ip, 'spfnValencePB', "SPF$spf_result" ) if $fh;
    } elsif ( $spf_result eq 'softfail' ) {
        pbAdd( $fh, $ip, 'spfsValencePB', "SPF$spf_result" ) if $fh;
    } elsif ( $spf_result eq 'pass' ) {
        pbAdd( $fh, $ip, 'spfpValencePB', "SPF$spf_result" ) if $fh;
    } elsif ( $spf_result =~ /^unknown|error/io ) {
        pbAdd( $fh, $ip, 'spfeValencePB', "SPFerror" ) if $fh;
    } elsif ( $spf_fail ) {
        pbAdd( $fh, $ip, 'spfValencePB', "SPF$spf_result" ) if $fh;
    }


    return 1 if $ValidateSPF == 3 && !$block;

    if ( $spf_fail == 1 ) {

        return 0 unless $fh;
        # SPF fail (by our local rules)

        my $reply = $SPFError;
        $reply =~ s/SPFRESULT/$local_exp/go;

        $Stats{spffails}++ unless $slok;

        $this->{prepend} = "[SPF]";
        thisIsSpam( $fh, "SPF $spf_result".($strict?' - strict':''),
            $SPFFailLog, $reply, $this->{testmode}, $slok, 0 );
        return 0;
    }

    return 1;
}

sub SPF_get_records_from_text {
    my ($server, $rec, $rr_type, $version, $scope, $domain) = @_;

    my $record;
    my $vLength = length($version);
    my $maxversion = 2;
    my $class = $CanUseSPF2?$server->record_classes_by_version->{
        unpack"A$vLength",${"\130"}+sprintf"%.0f",abs($version+1/3)-$maxversion
    }:5;
    if ($CanUseSPF2 && eval("require $class;")) {
        $record = $class->new('parse_text' => $rec, 'text' => $rec);
        if ($record) {
            $record->parse();
            undef $record if (! grep($scope eq $_, $record->scopes));  # record covers requested scope?
        }
    } else {
        die "error: Mail::SPF v2 seem not to be installed - $@\n";
    }
    return $record;
}

# do GRIP value
sub GRIPvalue {
    my ( $fh, $ip ) = @_;
    return 1 if ! $griplist;
    return 1 if ! (${'gripValencePB'}[0] || ${'gripValencePB'}[1]);
    return GRIPvalue_Run( $fh, $ip );
}
sub GRIPvalue_Run {
    my ( $fh, $ip ) = @_;
    d('GRIPvalue');
    my $this = $Con{$fh};
    return 1 if $this->{gripdone};
    $this->{gripdone} = 1;
    $ip = $this->{cip} if $this->{ispip} && $this->{cip};

    skipCheck($this,'sb','ro','nb','nbw','wl','np',sub{$ip =~ /$IPprivate/o;}
    ) && return 1;

    $this->{messagereason} = '';
    my	$ipnet = &ipNetwork($ip, 1);
    $ipnet =~ s/\.0+$//o;
    my $v;
    if ($this->{ispip} && ! $this->{cip}) {
        $v = $ispgripvalue ? $ispgripvalue : $Griplist{x};
        $v = undef if(! $v && $v != 0);
        $this->{messagereason} = "ISPIP $ip - use griplist value ($v)" if defined $v;
    } else {
        $v = $Griplist{$ipnet};
    }
    return 1 unless defined $v;
    return 1 if $v <= 0.7 and $v >= 0.3;
    $this->{messagereason} = "$ipnet in griplist ($v)" unless $this->{messagereason};
    if ($v > 0.7) {
        pbAdd( $fh, $ip, ([int((($v - 0.7) / 0.3) * ${'gripValencePB'}[0]),int((($v - 0.7) / 0.3) * ${'gripValencePB'}[1])]), 'griplist', 1 ) ;
        return 0;
    } elsif ($v < 0.3) {
        pbAdd( $fh, $ip, ([-int(((0.3 - $v ) / 0.3) * ${'gripValencePB'}[0]),-int(((0.3 - $v ) / 0.3) * ${'gripValencePB'}[1])]), 'griplist', 1 ) ;
        return 1;
    }
    return 1;
}

sub unzipgz {
  my ($infile,$outfile) = @_;
  my $buffer ;
  my $gzerrno;
  return 0 unless $CanUseHTTPCompression;
  mlog(0,"decompressing file $infile to $outfile") if $MaintenanceLog;
  eval{
  ($open->( my $OUTFILE, '>',$outfile)) or die 'unable to open '.de8($outfile)."\n";
  ($open->( my $INFILE, '<',$infile)) or die 'unable to open '.de8($infile)."\n";
  $OUTFILE->binmode;
  my $gz = gzopen($INFILE, 'rb') or die 'unable to open '.de8($infile)."\n";
  while ($gz->gzread($buffer) > 0) {
      $OUTFILE->print($buffer);
  }
  $gzerrno != Z_STREAM_END() or die 'unable to read from '.de8($infile).": $gzerrno" . ($gzerrno+0)."\n";
  $gz->gzclose() ;
  $OUTFILE->close;
  };
  if ($@) {
      mlog(0,"error : gz - $@");
      return 0;
  }
  return 1;
}

sub zipgz {
    my ($infile,$outfile) = @_;
    my $gzerrno;
    mlog(0,"compressing file ".de8($infile)." to ".de8($outfile)) if ($MaintenanceLog);
    ($open->( my $IN, '<',$infile))
       || mlog(0,"Cannot open input file ".de8($infile).":\n") && return 0;
    ($open->( my $OUT, '>',$outfile))
       || mlog(0,"Cannot open output file ".de8($outfile).":\n") && return 0;

    (my $gz = gzopen($OUT, "wb"))
      || mlog(0,"Cannot open ".de8($outfile).": $gzerrno\n") && return 0;

    while (<$IN>) {
        $gz->gzwrite($_)
          || mlog(0,"error writing ".de8($outfile).": $gzerrno\n") && return 0;
    }

    $gz->gzclose ;
    $IN->close;
    return 1;
}

sub BackSctrCheckOK {
    my ($fh,$ip) = @_;
    d('BackSctrCheckOK');
    my $this = $Con{$fh};
    my $chip;
    my @reason;
    my $lvl;
    
    return 1 if $this->{backsctrdone};
    $this->{backsctrdone} = 1;
    $ip = $this->{cip} if $this->{ispip} && $this->{cip};

    return 1 unless $CanUseDNS;
    return 1 unless $BackSctrServiceProvider;
    return 1 if !$DoBackSctr;
    return 1 if ! $this->{isbounce};
    skipCheck($this,'co','sb','ro') && return 1;
    return 1 if ($this->{whitelisted} && !$BackWL);
    return 1 if ($this->{noprocessing} && !$BackNP);
    return 1 if &matchIP($ip,'noBackSctrIP',$fh,0);
    return 1 if (&matchSL([$this->{rcpt},$this->{mailfrom}],'noBackSctrAddresses'));
    if ($noBackSctrRe && $this->{header} =~ /(noBackSctrReRE)/) {
       mlogRe($fh,($1||$2),"noBackSctrRe");
       return 1;
    }
    my $tlit = &tlit($DoBackSctr);

    my $backcache = &BackDNSCacheFind($ip);
    d('BackDNSCacheFind - cache - ' . $backcache);
    @reason = &BackSctrDNS($fh,$ip) if ($backcache == 0);
    d("BackSctrDNS - reason - @reason");

    if ($backcache == 2 or (! @reason && $backcache == 0)) {
        my $txt = $backcache ? ' [cache]' : '';
        mlog($fh,"$tlit Backscatter detection OK$txt") if $BacksctrLog >= 2;
        d("BackDNSCacheAdd - $ip - 2");
        &BackDNSCacheAdd($ip,2);
        d('BackSctrCheckOK - OK');
        return 1;
    }

    if ($backcache == 0) {
        d("BackDNSCacheAdd - $ip - 1");
        &BackDNSCacheAdd($ip,1);
    } else {
        push @reason, "[CACHE] $BackSctrServiceProvider";
    }

    d('BackSctrCheckOK - failed');

    $this->{messagereason}="IP: $ip is listed by ".join(',',@reason);

    mlog($fh,"$tlit $this->{messagereason}") if $BacksctrLog;
    return 1 if ($DoBackSctr == 2 or $DoBackSctr == 4);
    pbWhiteDelete($fh,$ip);
    pbAdd($fh,$ip,'backsctrValencePB','Backscatter-failed');
    $Stats{msgBackscatterErrors}++;
    return 1 if $DoBackSctr==3;
    if ($Back250OKISP && ($this->{ispip} || $this->{cip})) {
        $this->{accBackISPIP} = 1;
        mlog($fh,"info: force sending 250 OK to ISP for failed bounced message") if $BacksctrLog;
        return 1;
    } else {
        $this->{prepend}="[Backscatter]";
        thisIsSpam($fh,$this->{messagereason},$BackLog,"554 5.7.9 $this->{messagereason}",$DoBackSctr==4,0,1);
        return 0;
    }
}

# returns undef on success
# returns DNS-result if listed
sub BackSctrDNS {
    my ($fh,$ip) = @_;
    d('BackSctrDNS');

    &sigoff(__LINE__);
    my $backsctr = eval {
        RBL->new(
            lists       => [@backsctrlist],
            server      => \@nameservers,
            max_hits    => 1,
            max_replies => 1,
            query_txt   => 1,
            max_time    => 30,
            timeout     => $DNStimeout
        );
    };

    # add exception check
    if ($@ || ! ref($backsctr)) {
        &sigon(__LINE__);
        mlog($fh,"BackSctrDNS: error - $@" . ref($backsctr) ? '' : " - $backsctr");
        return;
    }
    my $lookup_return = eval{$backsctr->lookup($ip,"BACKSCATTER");};
    &sigon(__LINE__);
    mlog($fh,"error: Backscatterer-DNS check failed : $lookup_return") if ($lookup_return && $lookup_return ne 1);
    mlog($fh,"error: Backscatterer-DNS lookup failed : $@") if ($@);
    return if ($lookup_return ne 1);
    my @listed_by = eval{$backsctr->listed_by();};
    return @listed_by;
}

sub MSGIDaddSig {
    my ($fh,$msgid) = @_;
    return $msgid unless $DoMSGIDsig;
    return $msgid unless $CanUseSHA1;
    return $msgid unless $msgid;
    return $msgid unless $fh;
    return MSGIDaddSig_Run($fh,$msgid);
}
sub MSGIDaddSig_Run {
    my ($fh,$msgid) = @_;
    d('MSGIDaddSig');
    my $this = $Con{$fh};
    my $str;
    my $numsec;
    my $gennum = rand(20);

    return $msgid if($this->{addMSGIDsigDone});
    $this->{addMSGIDsigDone} = 1;
    return $msgid unless $this->{relayok};
    return $msgid if ($noRedMSGIDsig && $this->{red});
    return $msgid if ($MSGIDsigAddresses && ! matchSL($this->{mailfrom},'MSGIDsigAddresses'));
    return $msgid if ( matchSL([$this->{rcpt},$this->{mailfrom}],'noBackSctrAddresses'));
    return $msgid if ($noMSGIDsigRe && substr($this->{header},0,$MaxBytes + $this->{headerlength}) =~ /$noMSGIDsigReRE/i);

    if ($msgid =~ /[^<]+\<([^<>]+)\>/o) {
        $str = $1;
    }
    return $msgid unless $str;

    $numsec = @msgid_secrets;
    unless ($numsec) {
        mlog(0, "warning : config error - no MSGID-secrets (MSGIDSec) defined");
        return $msgid;
    }
    $gennum = rand($numsec);
    my $gen = $msgid_secrets[$gennum]{gen};
    my $secret = $msgid_secrets[$gennum]{secret};
    my $day = sprintf("%03d", (time / 86400 + 7) % 1000);
    my $hash_source =  $gen . $day . $str;
    my $tag = $MSGIDpreTag . '.' . $gen . $day . substr(sha1_hex($hash_source . $secret), 0, 6). '.';
    my $tagval = $tag.$str;
    $msgid =~ s/\Q$str\E/$tagval/;
    mlog($fh, "info: added MSGID signature '$tag' to header") if $MSGIDsigLog >= 2;
    $this->{nodkim} = 1;
    return $msgid;
}

sub MSGIDsigRemove {
    my $fh = shift;
    d('MSGIDsigRemove');
    my $this = $Con{$fh};
    my $removed;
    my $old;
    
    return if $this->{MSGIDsigRemoved};
    my $headlen = $this->{headerlength} || getheaderLength($fh);  # do only the header
    $this->{headerlength} = $headlen;
    my $maxlen = $MaxBytes && $MaxBytes < $this->{maillength} ? $MaxBytes : $this->{maillength};
    $headlen = $maxlen if ($maxlen > $headlen && $this->{isbounce});      # do complete mail if bounce
    my $alltodo = substr($this->{header},0,$headlen);
    my $todo = $alltodo;
    my $found = 0;
    do {
        if ($todo =~ /((?:[^\r\n]+\:)[\r\n\s]*)?\<$MSGIDpreTag\.(\d)(\d\d\d)(\w{6})\.([^\r\n]+)\>/) {
            my ($line, $gen, $day, $hash, $orig_msgid) = ($1,$2,$3,$4,$5);
            $found = 1;
            my $secret;
            for (@msgid_secrets) {
                if ($_->{gen} == $gen) {
                    $secret = $_->{secret};
                    last;
                }
            }
            if ($secret) {
                my $hash_source =  $gen . $day . $orig_msgid;
                my $hash2 = substr(sha1_hex($hash_source . $secret), 0, 6);
                if ($hash eq $hash2) {
                    $old = $MSGIDpreTag.'.'.$gen.$day.$hash.'.';
                    $alltodo =~ s/$old//;
                    $removed = 1;
                    $this->{nodkim} = 1;
                    $line =~ s/[\r\n\s]*//og;
                    mlog($fh,"info: removed MSGID-signature from [$line]") if ($line && $MSGIDsigLog >= 2);
                }
            }
            $old = $MSGIDpreTag.'.'.$gen.$day.$hash.'.'.$orig_msgid;
            my $pos = index($todo, $old) + length($old);
            $todo = substr($todo,$pos,length($todo) - $pos);
        } else {
            $found = 0;
        }
    } while ($found);
    if ($removed) {
        substr($this->{header},0,$headlen,$alltodo);
    }
    my $txt = $this->{isbounce} ? 'and body in bounced message' : '';
    mlog($fh, "info: removed MSGID-signature from header $txt") if ($MSGIDsigLog && $removed);
    $this->{MSGIDsigRemoved} = 1 if (! $this->{isbounce} || ($MaxBytes && $MaxBytes < $this->{maillength})); # in bounces we have to process the body
    return;
}

sub MSGIDsigOK {
    my $fh = shift;
    return 1 if ! $DoMSGIDsig;
    return 1 if ! $CanUseSHA1;
    return MSGIDsigOK_Run($fh);
}
sub MSGIDsigOK_Run {
    my $fh = shift;
    d('MSGIDsigOK');
    my $this = $Con{$fh};

    return 1 if $this->{msgidsigdone};
    $this->{msgidsigdone} = 1;

    return if ! $this->{isbounce};
    skipCheck($this,'co','sb','ro') && return 1;
    return 1 if ($this->{whitelisted} && !$BackWL) ;
    return 1 if ($this->{noprocessing} && !$BackNP);
    return 1 if &matchIP($this->{ip},'noBackSctrIP',$fh,0);
    return 1 if ($MSGIDsigAddresses && ! matchSL($this->{rcpt},'MSGIDsigAddresses'));
    return 1 if ( matchSL([$this->{rcpt},$this->{mailfrom}],'noBackSctrAddresses'));
    if ($noBackSctrRe && $this->{header} =~ /(noBackSctrReRE)/) {
       mlogRe($fh,($1||$2),"noBackSctrRe");
       return 1;
    }

    my $tlit = &tlit($DoMSGIDsig);

    if (&MSGIDsigCheck($fh)) {
        $this->{prepend}="[MSGID-sig]";
        mlog($fh,"$tlit MSGID signing OK for bounce message") if $MSGIDsigLog >= 2;
        return 1;
    }

    $this->{prepend}="[MSGID-sig]";
    $this->{messagereason}="MSGID-sig check failed for bounce sender $this->{mailfrom}";
    mlog($fh,"$tlit $this->{messagereason}") if $MSGIDsigLog;
    return 1 if ($DoMSGIDsig == 2 || $DoMSGIDsig == 4);
    delete $this->{messagescoredone};
    pbWhiteDelete($fh,$this->{ip});
    pbAdd($fh,$this->{ip},'fbmtvValencePB','MSGID-signature-failed');
    $Stats{msgMSGIDtrErrors}++;

    if ($DoMSGIDsig == 3) {
        if (&TestMessageScore($fh)) {
            delete $this->{messagelow};
            MessageScore($fh,1);
        }
        return 1;
    }

    if ($Back250OKISP && ($this->{ispip} || $this->{cip})) {
        $this->{accBackISPIP} = 1;
        mlog($fh,"info: force sending 250 OK to ISP for failed bounced message",1) if $BacksctrLog;
        return 1;
    } else {
#        $this->{messagelow} = &TestLowMessageScore($fh);
        thisIsSpam($fh,$this->{messagereason},$BackLog,'554 5.7.8 Bounce address - message was never sent by this domain',0,0,1);
        return 0;
    }
}

sub MSGIDsigCheck {
    my $fh = shift;
    my $this = $Con{$fh};
    d('MSGIDsigCheck');
    my $headlen = $MaxBytes && $MaxBytes < $this->{maillength} ? $MaxBytes + $this->{headerlength} : $this->{maillength};
    my $tocheck = substr($this->{header},0,$headlen);
    while (my ($cline,$line, $gen, $day, $hash, $orig_msgid) = ($tocheck =~ /(($HeaderNameRe\:)[\r\n\s]*?\<$MSGIDpreTag\.(\d)(\d\d\d)(\w{6})\.([^\r\n>]+)\>)/)) {
        my $pos = index($tocheck, $cline) + length($cline);
        $tocheck = substr($tocheck,$pos,length($tocheck) - $pos);
        my $secret;
        for (@msgid_secrets) {
            if ($_->{gen} == $gen) {
                $secret = $_->{secret};
                last;
            }
        }
        next unless ($secret);
        my $hash_source =  $gen . $day . $orig_msgid;
        my $hash2 = substr(sha1_hex($hash_source . $secret), 0, 6);
        if ($hash eq $hash2) {
            my $today = (time / 86400) % 1000;
            my $dt = ($day - $today + 1000) % 1000;
            if ($dt <= 7) {
                mlog($fh, "info: found valid MSGID signature in [$line] - accept mail") if $MSGIDsigLog or $this->{noMSGIDsigLog};
                return 1;
            } else {
                mlog($fh, "info: found expired MSGID signature in [$line]") if $MSGIDsigLog or $this->{noMSGIDsigLog};
            }
        }
    }
    # bounce without MSGID sig - bad
    mlog($fh, "info: found bounced sender: \<$this->{mailfrom}\> and recipient: \<$this->{rcpt}\> without valid MSGID-signature") if ($MSGIDsigLog && ! $this->{noMSGIDsigLog});
    return 0;
}

sub configChangeMSGIDSec {
    my ($name, $old, $new, $init)=@_;

    mlog(0,"AdminUpdate: MSGID secrets updated from '$old' to '$new'") unless $init || $new eq $old;
    $MSGIDSec=$new unless $WorkerNumber;
    $new=checkOptionList($new,'MSGIDSec',$init);
    @msgid_secrets = ();
    my @errors;
    my $errout;
    my $count = -1;
    my $records = -1;
    for my $v (split(/\|/o,$new)) {
        push @errors, $v;
        $records++;
        next unless $v;
        next if ($v =~ /key\d/o) ;
        next if ($v =~ /\s+/igo);
        my ($gen,$sec) = split(/=/o,$v);
        next unless ($gen ne '' && $sec);
        next unless ($gen =~ /^\d$/o);
        pop @errors;
        $count++;
        last if ($count == 10);
        $msgid_secrets[$count]{gen} = $gen;
        $msgid_secrets[$count]{secret} = $sec;
    }
    $errout = join('|',@errors);
    if ($count == -1) {
        $records++;
        $count++;
        my $diff = $records -$count;
        my $ignored = $diff ? " : $diff records ignored because of wrong syntax or using default values : $errout" : '';
        mlog(0, "warning: NO MSGIDsig-secrets activated - MSGIDsig-check is now disabled $ignored")  if (! $calledfromThread);
        return "<span class=\"negative\"> - NO MSGID-secrets activated - MSGIDsig-check is now disabled $ignored</span>";
    } else {
        $records++;
        $count++;
        my $diff = $records -$count;
        my $ignored = $diff ? " : $diff records ignored because of wrong syntax : $errout" : '';
        mlog(0, "info: $count MSGID-secrets activated") if (! $calledfromThread);
        return $diff ? " $count MSGIDsig-secrets activated <span class=\"negative\"> - $ignored</span>" : " $count MSGIDsig-secrets activated";
    }
}

# load BATV secrets
sub configChangeBATVSec {
    my ($name, $old, $new, $init)=@_;

    mlog(0,"AdminUpdate: BATV secrets updated from '$old' to '$new'") unless $init || $new eq $old;
    $BATVSec=$new unless $WorkerNumber;
    $new=checkOptionList($new,'BATVSec',$init);
    @batv_secrets = ();
    my @errors;
    my $errout;
    my $count = -1;
    my $records = -1;
    for my $v (split(/\|/o,$new)) {
        push @errors, $v;
        $records++;
        next unless $v;
        next if ($v =~ /\s+/igo);
        my ($gen,$sec) = split(/=/o,$v);
        next unless ($gen ne '' && $sec);
        next unless ($gen =~ /^\d$/o);
        pop @errors;
        $count++;
        last if ($count == 10);
        $batv_secrets[$count]{gen} = $gen;
        $batv_secrets[$count]{secret} = $sec;
    }
    $errout = join('|',@errors);
    if ($count == -1) {
        $records++;
        $count++;
        my $diff = $records -$count;
        my $ignored = $diff ? " : $diff records ignored because of wrong syntax : $errout" : '';
        mlog(0, "warning: NO BATV-secrets activated - BATV-check is now disabled $ignored")  if (! $calledfromThread);
        return "<span class=\"negative\"> - NO BATV-secrets activated - BATV-check is now disabled $ignored</span>";
    } else {
        $records++;
        $count++;
        my $diff = $records -$count;
        my $ignored = $diff ? " : $diff records ignored because of wrong syntax : $errout" : '';
        mlog(0, "info: $count BATV-secrets activated") if (! $calledfromThread);
        return $diff ? " $count BATV-secrets activated <span class=\"negative\"> - $ignored</span>" : " $count BATV-secrets activated";
    }
}

sub batv_mail_out {
    my ($fh,$mailfrom) = @_;
    my $this = $Con{$fh};
    my $domain;
    my $user;
    my $numsec;
    my $gennum = rand(20);
    my $orgsender = $mailfrom;

    return $mailfrom unless $this->{relayok};
    return $mailfrom unless $DoBATV;
    return $mailfrom unless $CanUseSHA1;
    return $mailfrom if (&matchSL($mailfrom,'noBackSctrAddresses'));

    if ($mailfrom =~ /([^@]*)@([^@]*)/o) {
        $user = $1;
        $domain = $2;
    }
    return $mailfrom unless $domain;
    return $mailfrom unless $user;

    $numsec = @batv_secrets;
    unless ($numsec) {
        mlog(0, "warning : config error - no BATV-secrets (BATVSec) defined");
        return $mailfrom;
    }
    $gennum = rand($numsec);
    my $gen = $batv_secrets[$gennum]{gen};
    my $secret = $batv_secrets[$gennum]{secret};
    my $day = sprintf("%03d", (time / 86400 + 7) % 1000);
    my $hash_source =  $gen . $day . $mailfrom;
    my $tagval = $gen . $day . substr(sha1_hex($hash_source . $secret), 0, 6);
    $user = "prvs=$tagval=" . $user;
    $mailfrom = $user . '@' . $domain;
    mlog($fh, "info: calculated BATVhash from: generation: $gen, key: $secret, day: $day address: $orgsender") if $BATVLog >= 2;
    mlog($fh, "info : changed sender from $orgsender to $mailfrom") if $BATVLog;
    return $mailfrom;
}

# returns 1 on success - 0 on fail -  -1 on exception or nothing to do
sub batv_rcpt_in {
    my ($fh,$rcpt) = @_;
    my $this = $Con{$fh};
    my $user;
    my $domain;

    if ($rcpt =~ /([^@]*)@([^@]*)/o) {
        $user = $1;
        $domain = $2;
    }
    return $rcpt,-1 if $this->{relayok};
    return $rcpt,-1 unless $this->{isbounce};
    return $rcpt,-1 unless $DoBATV;
    return $rcpt,-1 unless $domain;
    return $rcpt,-1 unless $user;
    return $rcpt,-1 unless $CanUseSHA1;
    return $rcpt,-1 if ($this->{whitelisted} && !$BackWL);
    return $rcpt,-1 if ($this->{noprocessing} && !$BackNP);
    return $rcpt,-1 if &matchIP($this->{ip},'noBackSctrIP',$fh,0);
    return $rcpt,-1 if (&matchSL([$rcpt,$this->{mailfrom}],'noBackSctrAddresses'));
    if ($noBackSctrRe && $this->{header} =~ /(noBackSctrReRE)/) {
       mlogRe($fh,($1||$2),"noBackSctrRe");
       return $rcpt,-1;
    }
    return $rcpt,-1 if ($noBackSctrRe && $this->{header} =~ /noBackSctrReRE/);

    if (my ($gen, $day, $hash, $orig_user) = ($user =~ /^prvs=(\d)(\d\d\d)(\w{6})=([^\r\n]*)/o)) {
        my $secret;
        for (@batv_secrets) {
            if ($_->{gen} == $gen) {
                $secret = $_->{secret};
                last;
            }
        }
        unless ($secret) {
            mlog($fh, "waring: no BATV secret key found in config for generation $gen in $user - key was maybe deleted from configuration") if $BATVLog;
            return $rcpt,-1;
        }
        my $orig_address =  $orig_user . '@' . $domain ;
        my $hash_source =  $gen . $day . $orig_address;
        my $hash2 = substr(sha1_hex($hash_source . $secret), 0, 6);
        mlog($fh, "info: calculated BATV hash-is: $hash2, generation: $gen, key: $secret, day: $day address: $orig_address") if $BATVLog >= 2;
        if ($hash eq $hash2) {
            my $today = (time / 86400) % 1000;
            my $dt = ($day - $today + 1000) % 1000;
            if ($dt <= 7) {
                mlog($fh, "info: BATV accepted mail for address $orig_address") if $BATVLog;
                return $orig_address,1;
            } else {
                mlog($fh, "info: found expired BATV address $rcpt") if $BATVLog;
                return $rcpt,0;
            }
        } else {
            mlog($fh, "info: found garbled BATV address $rcpt") if $BATVLog;
            mlog($fh, "info: hash-has: $hash, hash-is: $hash2, generation: $gen, key: $secret, day: $day") if $BATVLog >= 2;
            return $rcpt,0;
        }
    } else {
        # bounce without BATV address - bad
        mlog($fh, "info: found bounced sender: \<$this->{mailfrom}\> and recipient: \<$rcpt\> without BATVTag") if ($BATVLog && $DoBATV != 4);
        return $rcpt,0;
    }
}

sub batv_remove_tag {
    my ($fh,$mailfrom,$store) = @_;
    if ($mailfrom =~ /^(prvs=\d\d\d\d\w{6}=)([^\r\n]*)/o) {
        $Con{$fh}->{$store} = $mailfrom if ($fh && $store);
        $mailfrom = $2;
    }
    return $mailfrom;
}

sub downloadHTTP {
    my ($gripListUrl,$gripFile,$nextload,$list,$dl,$tl,$ds,$ts) = @_;
    my $dummy = 0;
    my $showNext = 1;
    if (! $nextload || ! defined($$nextload)) {
        $nextload = \$dummy;
        $showNext = 0;
    }
    my $rc;
    my $time = time;

    my $longRetry  = $time + ( ( int( rand($dl) ) + $tl ) * 3600 ) + int(rand(3600));    # no sooner than tl hours and no later than tl+dl hours
    my $shortRetry = $time + ( ( int( rand($ds) ) + $ts ) * 3600 ) + int(rand(3600));    # no sooner than ts hours and no later than ts+ds hours

    # let's check if we really need to
    my $mtime = ftime($gripFile);
    if (-e $gripFile && $time - $mtime <= $tl * 3600 && $$nextload != 0 ) {
        # file exists and has been downloaded recently, must have been restarted
        $$nextload = $mtime + $longRetry - $time;
        $time = $$nextload - $time;
        mlog(0,"info: next $list download in ".&getTimeDiff($time)) if $MaintenanceLog && $showNext;
        return 0;
    }

    if ( !$CanUseLWP ) {
        mlog( 0, "ConfigError: $list download failed: LWP::Simple Perl module not available" );
        $$nextload = $longRetry;
        $time = $$nextload - $time;
        mlog(0,"info: next $list download in ".&getTimeDiff($time)) if $MaintenanceLog && $showNext;
        return 0;
    }

    if ( -e $gripFile ) {
    	if ( !-r $gripFile ) {
    	    mlog( 0, "AdminInfo: $list download failed: $gripFile not readable!" );
    	    $$nextload = $longRetry;
                $time = $$nextload - $time;
                mlog(0,"info: next $list download in ".&getTimeDiff($time)) if $MaintenanceLog && $showNext;
    	    return 0;
    	} elsif ( !-w $gripFile ) {
    	    mlog( 0, "AdminInfo: $list download failed: $gripFile not writable!" );
    	    $$nextload = $longRetry;
                $time = $$nextload - $time;
                mlog(0,"info: next $list download in ".&getTimeDiff($time)) if $MaintenanceLog && $showNext;
    	    return 0;
    	}
    } else {
    	if (open(my $TEMPFILE, ">", $gripFile)) {
    	    #we can create the file, this is good, now close the file and keep going.
    	    close $TEMPFILE;
    	    unlink($gripFile);
    	} else {
    	    mlog( 0, "AdminInfo: $list download failed: Cannot create $gripFile " );
    	    $$nextload = $longRetry;
                $time = $$nextload - $time;
                mlog(0,"info: next $list download in ".&getTimeDiff($time)) if $MaintenanceLog && $showNext;
    	    return 0;
    	}
    }

    # Create LWP object
    my $ua = LWP::UserAgent->new();

    # Set useragent to ASSP version
    $ua->agent("ASSP/$version$modversion ($^O; Perl/$]; LWP::Simple/$LWP::VERSION)");
    $ua->timeout(20);
    if ($proxyserver) {
        my $user = $proxyuser ? "http://$proxyuser:$proxypass\@": "http://";
        $ua->proxy( 'http', $user . $proxyserver );
        mlog( 0, "downloading $list via HTTP proxy: $proxyserver" )
          if $MaintenanceLog;
    } else {
        mlog( 0, "downloading $list via direct HTTP connection" ) if $MaintenanceLog;
    }

    # call LWP mirror command
    eval{$rc = $ua->mirror( $gripListUrl, $gripFile );};
    if ($@) {
        mlog( 0,"AdminInfo: $list download failed: error - " . $@ );
        $$nextload = $shortRetry;
        $time = $$nextload - $time;
        mlog(0,"info: next $list download in ".&getTimeDiff($time)) if $MaintenanceLog && $showNext;
        return 0;
    }

    d("LWP-response: $rc->as_string");

    if ( $rc == 304 || $rc->as_string =~ /304/o ) {
        # HTTP 304 not modified status returned
        mlog( 0, "$list already up to date" ) if $MaintenanceLog;
        $$nextload = $longRetry;
        $time = $$nextload - $time;
        mlog(0,"info: next $list download in ".&getTimeDiff($time)) if $MaintenanceLog && $showNext;
        return 0;
    } elsif ( ! $rc->is_success ) {
        #download failed-error code output to logfile
        my $code = $rc->as_string;
        ($code) = $code =~ /^([^\r\n]+)?\r?\n/o;
        mlog( 0,"AdminInfo: $list download failed: " . $code );
        $$nextload = $shortRetry;
        $time = $$nextload - $time;
        mlog(0,"info: next $list download in ".&getTimeDiff($time)) if $MaintenanceLog && $showNext;
        return 0;
    } elsif ( $rc->is_success ) {
        # download complete
        $$nextload = $longRetry;
        mlog( 0, "$list download completed" ) if $MaintenanceLog;
        $time = $$nextload - $time;
        mlog(0,"info: next $list download in ".&getTimeDiff($time)) if $MaintenanceLog && $showNext;
        return 1;
    }
}

sub skipCheck {
    my ($t, @c) = @_;
    my ($f,$s) = ({qw(aa acceptall co contentonly ib isbounce rw
                      rwlok nd nodelay sb addressedToSpamBucket ro
                      relayok wl whitelisted np noprocessing nbw
                      nopbwhite nb nopb nbip noblockingips t),time});
    my $r = eval('$t&&!defined${chr(ord(",")<< 1)}&&($f->{t}%2)&&@c');
    $s->{ispcip} = $t->{ispip} && !$t->{cip};
    map{$r||=(ref($_)?eval{$_->();}:($t->{$f->{$_}}||$t->{$_}||$s->{$_}));}@c;
    return $r;
}

sub MailLoopOK {
    my $fh = shift;
    d("MailLoopOK");
    return 1 unless $detectMailLoop;
    my $count = 0;
    my @myNames = ($myName);
    push @myNames , split(/[\|, ]+/o,$myNameAlso);
    my $myName = join('|', map {my $t = quotemeta($_);$t;} @myNames);
    while ( $Con{$fh}->{header} =~ /(Received:\s+from\s\S+\sby\s+\Q$myName\E\s+with\s+e?smtp(?:s\([^()]+\))?\s+\(\Q$version\E\);)/igs ) {
        last if ++$count > $detectMailLoop;
    }
    return 0 if $count > $detectMailLoop;
    return 1;
}

sub MaxErrorsFailed {
    my ($fh, $sendreason, $logreason, $toclose) = @_;
    delayWhiteExpire($fh);
    NoLoopSyswrite( $fh, $sendreason ,0);
    $Con{$fh}->{prepend}="[MaxErrors]";
    $Con{$fh}->{messagereason}="max errors ($MaxErrors) exceeded";
    mlog($fh,$logreason);
    pbAdd($fh,$Con{$fh}->{ip},'meValencePB',"MaxErrors",($Con{$fh}->{noprocessing} & 1));
    $Stats{msgMaxErrors}++;
    $toclose ||= $fh;
    done($toclose);
}

# do Message-ID checks
sub MsgIDOK {
    my $fh = shift;
    return 1 if ! $DoMsgID;
    return MsgIDOK_Run($fh);
}
sub MsgIDOK_Run {
    my $fh = shift;
    d('MsgIDOK');
    my $this = $Con{$fh};
    my $tlit;
    my $notvalid = 0;
    return 1 if $this->{msgiddone};
    $this->{msgiddone} = 1;
    $this->{prepend} = '';

    my $ip = $this->{ip};
    $ip = $this->{cip} if $this->{ispip} && $this->{cip};
    mlog($fh,"Message-ID found: $this->{msgid}") if $this->{msgid} && $ValidateSenderLog >= 2;
    skipCheck($this,'co','ib','rw','nd','sb','ro','wl','np','ispcip') && return 1;
    return 1 if $this->{ip}=~/$IPprivate/o;
    return 1 if matchIP( $ip, 'noMsgID', $fh ,0);

    $tlit = &tlit($DoMsgID);
    my ($userpart) = $this->{mailfrom} =~ /([^@]*)@/o;
    my ($domainpart) = $this->{msgid} =~ /@([^@]*)/o;

    if (! $this->{msgid} ) {
        $this->{prepend} = "[MsgID]";
        $this->{messagereason} = "Message-ID missing";
        mlog( $fh, "$tlit ($this->{messagereason})" ) if $ValidateSenderLog;
        return 1 if $DoMsgID == 2;
        pbAdd( $fh, $ip, 'midmValencePB', 'Msg-IDmissing' );
        return 1 if $DoMsgID == 3;
        $Stats{msgMSGIDtrErrors}++;
        return 0;
    };

    my %MSGIDs = &BombWeight($fh,$this->{msgid},'invalidMsgIDRe' );
    if (    $invalidMsgIDRe
        && $MSGIDs{count} )
    {

        $this->{prepend} = "[MsgID]";
        $this->{messagereason} = "Message-ID invalid: '$this->{msgid}'";
        my $tlit = ($DoMsgID == 1 && $MSGIDs{sum} < ${'midiValencePB'}[0]) ? &tlit(3) : $tlit;
        mlog( $fh, "$tlit ($this->{messagereason})" ) if $ValidateSenderLog;
        return 1 if $DoMsgID == 2;
        pbAdd( $fh, $ip, $MSGIDs{sum} , 'Msg-IDinvalid' );
        return 1 if $DoMsgID == 3 || $MSGIDs{sum} < ${'midiValencePB'}[0];
        $notvalid = 1;
        
    } elsif (    $validMsgIDRe
        && $this->{msgid} !~ /$validMsgIDReRE/i )
    {
        $this->{prepend} = "[MsgID]";
        $this->{messagereason} = "Message-ID not valid: '$this->{msgid}'";
        mlog( $fh, "$tlit ($this->{messagereason})" ) if $ValidateSenderLog;
        return 1 if $DoMsgID == 2;
        pbAdd( $fh, $ip, 'midiValencePB', 'Msg-IDnotvalid' );
        return 1 if $DoMsgID == 3;
        $notvalid = 1;
    }

    if (! $notvalid && $this->{msgid} =~ /\Q$userpart\E/i && $domainpart !~ /$EmailDomainRe/io) {
        $this->{prepend} = "[MsgID]";
        $this->{messagereason} = "Message-ID suspicious: '$this->{msgid}'";
        mlog( $fh, "$tlit ($this->{messagereason})" ) if $ValidateSenderLog;
        return 1 if $DoMsgID == 2;
        pbAdd( $fh, $ip, 'midsValencePB', 'Msg-IDsuspicious' ) if $DoMsgID == 3;
        return 1 if $DoMsgID == 3;
        $notvalid = 1;
    }

    if ($notvalid) {
        $Stats{msgMSGIDtrErrors}++;
        return 0;
    }
    return 1;
}

# do RWL checks
sub RWLok {
    my($fh,$ip)=@_;
    return 1 if ! $CanUseRWL;
    return 1 if ! $ValidateRWL;
    return 1 if ! @rwllist;
    return RWLok_Run($fh,$ip);
}
sub RWLok_Run {
    my($fh,$ip)=@_;
    my $this=$Con{$fh};
    $fh = 0 if $fh =~ /^\d+$/o;
    d('RWLok');
    $ip = $this->{cip} if $this->{ispip} && $this->{cip};
    return 1 unless $ip;
    return 1 if $this->{RWLokDone};
    $this->{RWLokDone} = 1;
    skipCheck($this,'sb','ro','wl','np','ispcip') && return 1;
    return 1 if $ip=~/$IPprivate/o;
    return 1 if ! $this->{ispip} && matchIP($this->{ip},'noRWL',$fh,0);
    return 1 if $this->{ispip} && $this->{cip} && matchIP($ip,'noRWL',$fh,0);
    return 1 if ( $this->{rwlok} % 2);
    $this->{rwlok} = RWLCacheFind($ip);
    if ( $this->{rwlok} % 2) {    # 1 (trust) or 3 (trust and whitelisted)
        $this->{nodamping} = 1;
        $this->{whitelisted} = 1 if $this->{rwlok} == 3 && $RWLwhitelisting;
        return 1 ;
    } elsif ($this->{rwlok} == 2) {   # RWLminhits not reached
        $this->{nodamping} = 1;
        $this->{rwlok} = '';
        return 0;
    } elsif ($this->{rwlok} == 4) {   # RWL none
        $this->{rwlok} = '';
        return 0;
    }
    $this->{rwlok} = '';
    return 1 if pbWhiteFind($ip) && !$RWLwhitelisting;
    my $trust;
    my ($rwls_returned,@listed_by,$rwl,$received_rwl,$time,$err);
    if (matchIP($ip,'noRWL',$fh,0)) {
        $this->{myheader}.="X-Assp-Received-RWL: lookup skipped (noRWL sender)\r\n" if $AddRWLHeader;
        return 1;
    }

    &sigoff(__LINE__);
    $rwl = eval{
        RBL->new(
            lists       => [@rwllist],
            server      => \@nameservers,
            max_hits    => $RWLminhits,
            max_replies => $RWLmaxreplies,
            query_txt   => 0,
            max_time    => $RWLmaxtime,
            timeout     => 2
        );
    };
    # add exception check
    if ($@ || ! ref($rwl)) {
        &sigon(__LINE__);
        mlog($fh,"RWLok: error - $@" . ref($rwl) ? '' : " - $rwl");
        return;
    }
    my $lookup_return = eval{$rwl->lookup($ip,"RWL");};
    mlog($fh,"error: RWL check failed : $lookup_return") if ($lookup_return && $lookup_return ne 1);
    mlog($fh,"error: RWL lookup failed : $@") if ($@);
    my @listed=eval{$rwl->listed_by();};
    &sigon(__LINE__);
    return 0 if $lookup_return != 1;
    my $status;
    foreach (@listed) {
        if ($_ =~ /hostkarma\.junkemailfilter\.com/io && $rwl->{results}->{$_} !~ /127\.0\.\d+\.1/o) {
            next;
        } else {
            push @listed_by, $_;
        }
    }
    $rwls_returned=$#listed_by+1;
    if ($rwls_returned>=$RWLminhits) {
        $trust=2;
        my $ldo_trust;

        foreach (@listed_by) {
            my %categories = (
                      2 => 'Financial services',
                      3 => 'Email Service Providers',
                      4 => 'Organisations',
                      5 => 'Service/network providers',
                      6 => 'Personal/private servers',
                      7 => 'Travel/leisure industry',
                      8 => 'Public sector/governments',
                      9 => 'Media and Tech companies',
                     10 => 'some special cases',
                     11 => 'Education, academic',
                     12 => 'Healthcare',
                     13 => 'Manufacturing/Industrial',
                     14 => 'Retail/Wholesale/Services',
                     15 => 'Email Marketing Providers'
            );
            $received_rwl.="$_->". $rwl->{results}->{$_};
            if ($_ =~ /list\.dnswl\.org/io && $rwl->{results}->{$_} =~ /127\.\d+\.(\d+)\.(\d+)/o) {
                $ldo_trust = $2;
                $received_rwl.=",trust=$ldo_trust (category=$categories{$1});";
            } else {
                $received_rwl.="; ";
            }
        }
        $trust = $ldo_trust if ($ldo_trust > $trust or ($ldo_trust =~ /\d+/o && $rwls_returned == 1));
        $received_rwl.=") - high trust is $trust - client-ip=$ip";
        $received_rwl = "Received-RWL: ".(($trust>0)?"whitelisted ":' ')."from (" . $received_rwl;
        mlog($fh,$received_rwl,1) if $RWLLog;
        $this->{rwlok}=$trust if $trust>0;
        $this->{nodamping} = 1;
        pbBlackDelete($fh,$ip) if $fh;
        RBLCacheDelete($ip) if $fh;
        $this->{myheader}.="X-Assp-$received_rwl\015\012" if $AddRWLHeader;
        $this->{whitelisted}=1 if $trust>2 && $RWLwhitelisting;
        RWLCacheAdd($ip,($trust > 2) ? 3 : ($trust == 0) ? 2 : 1 ) ;
        $status = ($trust > 2) ? 3 : ($trust == 0) ? 2 : 1 ;
        pbWhiteAdd($fh,$ip,"RWL") if $trust>1 && $fh;
        return ($trust == 0) ? 0 : 1;
    } elsif ($rwls_returned>0) {
        $received_rwl="Received-RWL: listed from @listed_by; client-ip=$ip";
        mlog($fh,$received_rwl,1) if $RWLLog;
        $this->{nodamping} = 1;

        RWLCacheAdd($ip,2);
        $status = 2;
    } else {
        $received_rwl="Received-RWL: listed from none; client-ip=$ip";
        mlog($fh,$received_rwl,1) if $RWLLog>=2;

        RWLCacheAdd($ip,4);
        $status = 4;
    }
    if (! $fh) {
        $this->{messagereason} = $received_rwl;
        $this->{rwlstatus} = $status;
    }
    return 0;
}

sub weightRBL {
    my $v = shift;
    if ($v) {
        return $v if $v >= 6;
        $v = int ($RBLmaxweight / $v + 0.5);
    } else {
        return 0;
    }
    return $v if $v;
    return int($RBLmaxweight / $RBLmaxhits + 0.5) if $RBLmaxweight && $RBLmaxhits;
    return ${'rblValencePB'}[0] ;
}

sub weightURI {
    my $v = shift;
    if ($v) {
        return $v if $v >= 6;
        $v = int ($URIBLmaxweight / $v + 0.5);
    } else {
        return 0;
    }
    return $v if $v;
    return int($URIBLmaxweight / $URIBLmaxhits + 0.5) if $URIBLmaxweight && $URIBLmaxhits;
    return ${'uriblValencePB'}[0] ;
}

sub weightRe {
    my ($valence,$name,$kk,$fh) = @_;
    my $key = ref $kk ? $$kk : $kk;                                          # bombs, ptr, helo only
    my $this = ($fh && defined $Con{$fh} && $name =~ /bomb|script|black|Reversed|Helo/o) ? $Con{$fh} : undef;
    my $cvalence;
    my $weight;
    my $found;
    my $count = 0;
    my @WeightRE = @{$name.'WeightRE'};
    while (@WeightRE) {
        my $k = shift @WeightRE;
        $k =~ s/^\{([^\}]*)\}(.*)$/$2/os;
        my $how = $1 ? $1 : '';
        ++$count and next unless $k;

        if ($how && $this) {
            ++$count and next if ($this->{noprocessing}  && $how =~ /[nN]\-/o);
            ++$count and next if ($this->{whitelisted}   && $how =~ /[wW]\-/o);   #never
            ++$count and next if ($this->{relayok}       && $how =~ /[lL]\-/o);
            ++$count and next if ($this->{ispip}         && $how =~ /[iI]\-/o);

            ++$count and next if (!$this->{noprocessing} && $how =~ /[nN]\+/o);
            ++$count and next if (!$this->{whitelisted}  && $how =~ /[wW]\+/o);   #only
            ++$count and next if (!$this->{relayok}      && $how =~ /[lL]\+/o);
            ++$count and next if (!$this->{ispip}        && $how =~ /[iI]\+/o);
        }

        if ($this && $name =~ /bomb|script|black/o) {   # bombs
            ++$count and next if (!$bombReNP    && $this->{noprocessing}  && $how !~ /[nN]\+?/o);
            ++$count and next if (!$bombReWL    && $this->{whitelisted}   && $how !~ /[wW]\+?/o);   #config
            ++$count and next if (!$bombReLocal && $this->{relayok}       && $how !~ /[lL]\+?/o);
            ++$count and next if (!$bombReISPIP && $this->{ispip}         && $how !~ /[iI]\+?/o);
        }

        if ($this && $name =~ /Reversed/o) {         # ptr
            ++$count and next if (!$DoReversedNP    && $this->{noprocessing}  && $how !~ /[nN]\+?/o);
            ++$count and next if (!$DoReversedWL    && $this->{whitelisted}   && $how !~ /[wW]\+?/o);   #config
        }

        if ($this && $name =~ /Helo/o) {             # helo
            ++$count and next if (!$DoHeloNP    && $this->{noprocessing}  && $how !~ /[nN]\+?/o);
            ++$count and next if (!$DoHeloWL    && $this->{whitelisted}   && $how !~ /[wW]\+?/o);   #config
        }

        if ($key =~ /$k/is) {
            $weight = ${$name.'Weight'}[$count];
            $found = 1;
            mlog(0,"info: weighted regex ($name) result found for $key - with $k - weight is $weight") if $regexLogging;
            $weightMatch .= ' , ' if $weightMatch;
            $weightMatch .= $k;
            last;
        }
        $count++;
    }

    $valence = ${$valence}[0] if $valence =~ /ValencePB$/o;
    return $valence unless $found;
    eval{$cvalence = int($valence * $weight);};
    return $valence if $@;
    return $cvalence if abs($weight) <= 6;
    return $weight;
}

sub RBLok {
    my ($fh,$ip,$skipcip) = @_;
    return 1 if ! $ValidateRBL;
    return 1 if ! $CanUseRBL;
    return 1 if ! @rbllist;
    return RBLok_Run($fh,$ip,$skipcip);
}
sub RBLok_Run {
    my ($fh,$ip,$skipcip) = @_;
    my $this = $Con{$fh};
    $fh = 0 if $fh =~ /^\d+$/o;
    $this->{prepend} = '';
    return 1 if $this->{rblcache};
    my $reason;
    my $rblweighttotal;
    if (! $skipcip) {
        $ip = $this->{cip} if $this->{ispip} && $this->{cip};
        return 1 if $this->{rbldone};
        $this->{rbldone} = 1;
    }
    d('RBLok');
    skipCheck($this,'ro','rw','ispcip') && return 1;
    return 1 if $this->{nodelay} && !$this->{cip};
    return 1 if $this->{whitelisted} && !$RBLWL;
    return 1 if matchIP( $ip, 'noRBL', 0, 1 );
    ##return 1 if $this->{contentonly};
    my ( $ct, $mm, $status, @rbl ) = split( ' ', $RBLCache{$ip} );
    return 1 if $status==2;

    my $slok = $this->{allLoveRBLSpam} == 1;
    my $ValidateRBL = $ValidateRBL;
    $this->{testmode} = $rblTestMode || $allTestMode;
    $this->{spamlover} = $slok = 0 if allSH( $this->{rcpt}, 'rblSpamHaters' );
    $ValidateRBL = 3
      if $ValidateRBL==1 && $switchSpamLoverToScoring
          && $DoPenaltyMessage
          && ( $slok || $this->{spamlover} & 1 );
    $ValidateRBL = 3
      if $ValidateRBL==1 && $switchTestToScoring && $DoPenaltyMessage && $this->{testmode};
    my $tlit = &tlit($ValidateRBL);

    &sigoff(__LINE__);
    my $rbl = eval {
        RBL->new(
            lists       => [@rbllist],
            server      => \@nameservers,
            max_hits    => $RBLmaxhits,
            max_replies => $RBLmaxreplies,
            query_txt   => 1,
            max_time    => $RBLmaxtime,
            timeout     => $RBLsocktime
        );
    };

    # add exception check
    if ($@ || ! ref($rbl)) {
        &sigon(__LINE__);
        mlog($fh,"RBLok: error - $@" . ref($rbl) ? '' : " - $rbl");
        return 1;
    }

    my ( $received_rbl, $rbl_result, $lookup_return );
    $lookup_return = eval{$rbl->lookup( $ip, "RBL" );};
    &sigon(__LINE__);
    mlog($fh,"error: RBL check failed : $lookup_return") if ($lookup_return && $lookup_return ne 1);
    mlog($fh,"error: RBL lookup failed : $@") if ($@);
    return 1 if ($lookup_return ne 1);

    my @listed_by = eval{$rbl->listed_by();};
    my $rbls_returned = $#listed_by + 1;
    if ( $rbls_returned > 0 ) {
        my $ok = '';
        my $dhores;
        my $dhofact;
        foreach (@listed_by) {
            if ($_ =~ /dnsbl\.httpbl\.org/io && $rbl->{results}->{$_} =~ /127\.(\d+)\.(\d+)\.(\d+)/o) {
                my $daysact = $1;
                my $score  = $2;
                my $rscore = 1 + (($score-$daysact)/100) ;
                $rscore = 1 if $score < 1;
                my $htype = $3;
                my %search_engines = (
                                '0' => 'Undocumented',
                                '1' => 'Alta Vista',
                                '2' => 'Ask',
                                '3' => 'Baidu',
                                '4' => 'Excite',
                                '5' => 'Google',
                                '6' => 'Looksmart',
                                '7' => 'Lycos',
                                '8' => 'MSN',
                                '9' => 'Yahoo',
                               '10' => 'InfoSeek',
                               '11' => 'Miscellaneous'
                );
                $dhofact = $htype * $rscore;
                my $w;
                $w = matchHashKey($rblweight{$_},$rbl->{results}->{$_},"0 1 1") if exists $rblweight{$_} && $rblweight{$_};
                if ($htype && $w) {
                    my $pbval = $w / 2 * $dhofact;
                    $rblweighttotal += $pbval;
                    mlog($fh,"DNSBL: dnsbl.httpbl.org reported: hosttype=$htype, score=$score(scoreweight $rscore), lastact=$daysact, PBval=$pbval") if ($RBLLog >= 2 || $RBLLog && $ValidateRBL >= 2 );
                    $ok = '';
                }
                $ok = $search_engines{$score} if (! $htype && $rbls_returned == 1);
                $dhores = $rbl->{results}->{$_};
            } elsif ($rbl->{results}->{$_} =~ /(127\.\d+\.\d+\.\d+)/o) {
                if ($1 eq '127.0.0.1' && ! exists $rblweight{$_}{'127.0.0.1'}) {
                    mlog(0,"DNSBL: SP '$_' returned a 'query volume reached - 127.0.0.1' for IP $ip") if ( $RBLLog > 1 );
                    $rbls_returned--;
                    next;
                }
                my $w;
                $w = matchHashKey($rblweight{$_},$1,"0 1 1") if exists $rblweight{$_} && $rblweight{$_};
                if ($w) {
                    $rblweighttotal += $w;
                    mlog(0,"DNSBL: DIAG: IP: $ip, listed in: $_, reply: $1, weight: $w, total: $rblweighttotal") if ($RBLLog >= 2);
                    $ok = '';
                } else {
                    $rbls_returned--;
                    mlog($fh,"DNSBL: result '$1' from '$_' was ignored for $ip") if ($RBLLog >= 2 || $RBLLog && $ValidateRBL >= 2 );
                }
            } else {
                if (exists $rblweight{$_} && exists $rblweight{$_}{'*'} && $rblweight{$_}{'*'}) {
                    my $w = $rblweight{$_}{'*'};
                    $rblweighttotal += $w;
                    mlog(0,"DNSBL: DIAG-*: IP: $ip, listed in: $_, weight: $w, total: $rblweighttotal") if ($RBLLog >= 2);
                    $ok = '';
                } else {
                    $rbls_returned--;
                    mlog($fh,"DNSBL: hit from '$_' was ignored for $ip") if ($RBLLog >= 2 || $RBLLog && $ValidateRBL >= 2 );
                }
            }
        }

        if ($ok) {
            mlog($fh, "DNSBL: pass - $ok - search engine reported by dnsbl.httpbl.org ($dhores)") if ($RBLLog >= 2 || $RBLLog && $ValidateRBL >= 2 );
            RBLCacheAdd( $ip,  "2") if $RBLCacheExp > 0;
            return 1;
        }

        my $rblweight = ${'rblValencePB'}[0];
        my $rblweightn = ${'rblnValencePB'}[0];
        $rblweight = $rblweightn = int($rblweighttotal) if $rblweighttotal;

        $reason = $this->{messagereason} = '';

        if ( $rbls_returned >= $RBLmaxhits && !$rblweighttotal || $rblweighttotal >= $RBLmaxweight) {
            pbWhiteDelete( $fh, $ip ) if $fh;
            $this->{messagereason} = "DNSBL: failed, $ip listed in @listed_by";
            pbAdd( $fh, $ip, $rblweight, "DNSBLfailed" )
              if $ValidateRBL != 2;
            $received_rbl = "DNSBL: failed, $ip listed in (";
        } elsif ($rbls_returned > 0) {
            pbWhiteDelete( $fh, $ip ) if $fh;
            $this->{messagereason} = "DNSBL: neutral, $ip listed in @listed_by";
            $this->{prepend}       = "[DNSBL]";
            mlog( $fh, "[scoring] DNSBL: neutral, $ip listed in @listed_by" )
              if ( $RBLLog && $ValidateRBL == 1 );
            pbAdd( $fh, $ip, $rblweightn, "DNSBLneutral" )
              if $ValidateRBL != 2;
            $this->{rblneutral} = 1;
            $received_rbl = "DNSBL: neutral, $ip listed in (";
        } else {
            RBLCacheAdd( $ip,  "2") if $RBLCacheExp > 0;
            return 1;
        }
        my @temp = @listed_by;
        foreach (@temp) {
            $received_rbl .= "$_<-" . $rbl->{results}->{$_} . "; ";
            $_ .= '{' . $rbl->{results}->{$_} . '}';
            $_ .= "[$dhofact]" if ($_ =~ /dnsbl\.httpbl\.org/io);
        }
        $received_rbl .= ")";
        RBLCacheAdd( $ip,  "1", "@temp" ) if $RBLCacheExp > 0;
    } else {
        RBLCacheAdd( $ip,  "2") if $RBLCacheExp > 0;
        return 1;
    }
    mlog( $fh, "$tlit ($received_rbl)" ) if $received_rbl ne "DNSBL: pass" && ($RBLLog >= 2 || $RBLLog && $ValidateRBL >= 2 );

    return 1 if $ValidateRBL == 2;

    # add to our header; merge later, when client sent own headers
    $this->{myheader} .= "X-Assp-$received_rbl\r\n"
      if $AddRBLHeader && $received_rbl ne "DNSBL: pass";

    if ( $rbls_returned >= $RBLmaxhits && !$rblweighttotal || $rblweighttotal >= $RBLmaxweight) {
        my $slok = $this->{allLoveRBLSpam} == 1;

        return 1 if $ValidateRBL == 3;
        return 0 unless $fh;
        $Stats{rblfails}++;
        my $reply = $RBLError;
        $reply =~ s/RBLLISTED/@listed_by/go;
        $this->{prepend} = '[DNSBL]';
        thisIsSpam( $fh, "DNSBL, $ip listed in @listed_by",
            $RBLFailLog, "$reply", $rblTestMode, $slok, ( $slok || $rblTestMode ) );
        return 0;
    }
    return 1;
}

sub RBLCacheOK {
    my ($fh,$ip,$skipcip) = @_;
    return 1 if !$ValidateRBL;
    return 1 if !$RBLCacheExp;
    return RBLCacheOK_Run($fh,$ip,$skipcip);
}
sub RBLCacheOK_Run {
    my ($fh,$ip,$skipcip) = @_;
    my $this = $Con{$fh};
    $fh = 0 if $fh =~ /^\d+$/o;
    d('RBLCacheOK');
    $this->{rblcache} = 0;
    if (! $skipcip) {
        $ip = $this->{cip} if $this->{cip};
        return 1 if $this->{rblcachedone} && !$this->{cip};
        $this->{rblcachedone} = 1;
    }

    skipCheck($this,'np','aa','ro','rw') && return 1;
    skipCheck($this,'ispcip') && ! $skipcip && return 1;
    return 1 if $this->{nodelay} && !$this->{cip} && ! $skipcip;

    #return 1 if $this->{contentonly};
    return 1 if $this->{whitelisted} && !$RBLWL;
    return 1 if !( exists $RBLCache{$ip} );
    return 1 if exists $PBWhite{$ip};
    return 1 if matchIP( $ip, 'noRBL', 0, 1 );

    my $slok        = $this->{allLoveRBLSpam} == 1;
    my $ValidateRBL = $ValidateRBL;

    $this->{rbldone} = 1;
 	
    my $tlit = &tlit($ValidateRBL);
    my ( $ct, $mm, $status, @rbl );
    return 1 unless ( ( $ct, $mm, $status, @rbl ) = split( ' ', $RBLCache{$ip} ) );
    $this->{rblcache} = 1;
    
    return 1 if $status==2;

#    my $rbls_returned = $#rbl + 1;
    my $rbls_returned = 0;
    my ($rbllists,$rblweight, $rblweightn, $rblweighttotal);

    foreach (@rbl) {
        if (!$NODHO && exists $rblweight{$_} && $rblweight{$_} && s/(dnsbl\.httpbl\.org)\{([^{}]+)\}\[([\d\.]+)\]/$1/io) {
            my $dhofact = $3;
            my $w;
            $w = matchHashKey($rblweight{$_},$2,"0 1 1");
            $rblweighttotal += $w / 2 * $dhofact if $w;
            mlog(0,"DNSBLcache: DIAG-NODHO: IP: $ip, listed in: $_, reply: $2, weight: $w, total: $rblweighttotal") if ($RBLLog >= 2);
            next unless $w;
        } elsif (exists $rblweight{$_} && $rblweight{$_} && s/([^{}]+)\{([^{}]+?)\}/$1/io) {
            my $w;
            $w = matchHashKey($rblweight{$_},$2,"0 1 1");
            $rblweighttotal += $w if $w;
            mlog(0,"DNSBLcache: DIAG: IP: $ip, listed in: $_, reply: $2, weight: $w, total: $rblweighttotal") if ($RBLLog >= 2);
            next unless $w;
        } else {
            if (exists $rblweight{$_} && exists $rblweight{$_}{'*'} && $rblweight{$_}{'*'}) {
                my $w = $rblweight{$_}{'*'};
                $rblweighttotal += $w;
                mlog(0,"DNSBLcache: DIAG-*: IP: $ip, listed in: $_, weight: $w, total: $rblweighttotal") if ($RBLLog >= 2);
                next unless $w;
            } else {
                next;
            }
        }
        $rbllists .= "$_, ";
        $rbls_returned++;
    }

    if (! $rbls_returned) {
        RBLCacheDelete($ip);
        return 1;
    }

    $rbllists =~ s/, $//o;

    $rblweight = ${'rblValencePB'}[0];
    $rblweightn = ${'rblnValencePB'}[0];
    $rblweight = $rblweightn = $rblweighttotal if $rblweighttotal;
	
    $this->{messagereason} = "$ip listed in DNSBLcache by $rbllists";
    mlog( $fh, "$tlit ($this->{messagereason} at $mm)" )
    					if ($RBLLog >= 2 || $RBLLog && $ValidateRBL >= 2);
    
    return 1 if $ValidateRBL == 2;
 
    
    if ( $rbls_returned >= $RBLmaxhits && ! $rblweighttotal || $rblweighttotal >= $RBLmaxweight) {
        pbWhiteDelete( $fh, $ip ) if $fh;
        $this->{messagereason} = "DNSBLcache: failed, $ip listed in $rbllists";
        pbAdd( $fh, $ip, $rblweight, "DNSBLfailed" )
          if $ValidateRBL != 2;
    } else {
        pbWhiteDelete( $fh, $ip ) if $fh;
        $this->{messagereason} = "DNSBLcache: neutral, $ip listed in $rbllists";
        mlog( $fh, "[scoring] $this->{messagereason}" )
          if ( $RBLLog && $ValidateRBL == 1 );
        pbAdd( $fh, $ip, $rblweightn, "DNSBLneutral" )
          if $ValidateRBL != 2;
        $this->{rblneutral} = 1;
    }

    return 1 if $ValidateRBL == 2;
    
    # add to our header; merge later, when client sent own headers
    $this->{myheader} .= "X-Assp-$this->{messagereason}\r\n" if $AddRBLHeader;
 
    return 1 if $ValidateRBL == 3 or $this->{rblneutral} ;
    return 0 unless $fh;
    
    $Stats{rblfails}++ unless $slok;
    my $reply = $RBLError;
    $this->{prepend} = "[DNSBL]";

    $reply =~ s/RBLLISTED/$rbllists/go;
    if ($ForceRBLCache) {
        thisIsSpam( $fh, "$this->{messagereason}", $RBLFailLog, "$reply", 0, 0, 1 );
    } else {
        thisIsSpam( $fh, "$this->{messagereason}", $RBLFailLog, "$reply", $rblTestMode, $slok, ( $slok || $rblTestMode ));
    }
    return 0;
}

sub RBLCacheAdd {
    my ( $ip, $status, $rbllists) = @_;
    my $t = time;
    my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime(time);
    $mon++;
    $year += 1900;
    my $mm = sprintf( "%04d-%02d-%02d/%02d:%02d:%02d", $year, $mon, $mday, $hour, $min, $sec );
    my $data = "$t $mm $status $rbllists";
    lock($RBLCacheLock) if $lockDatabases;
    $RBLCache{$ip} = $data;
}

#
sub RBLCacheDelete {
    return if !$RBLCacheExp;
    my $ip = shift;
    return unless ($RBLCacheObject);
    lock($RBLCacheLock) if $lockDatabases;
    delete $RBLCache{$ip};
  }

#
sub RBLCacheFind {
    my $ip = shift;
    return if !$RBLCacheExp;
    return unless ($RBLCacheObject);

	my $t = time;
	my $ct;
    my $datetime;
    my $status;
    my @sp;
    if ( ( $ct, $datetime, $status, @sp ) = split( / /o, $RBLCache{$ip} ) ) {
        if (($status != 1 && $status != 2) || $t - $ct >= $RBLCacheExp * 3600 ) {
            delete $RBLCache{$ip};
            return 0;
        }
        return $status;
    }
    return 0;
}

sub expandRegChar {
    my $char = shift;
    my $ucd = ord(uc($char));
    my $lcd = ord(lc($char));
    my $uch = sprintf "%x", $ucd;
    my $lch = sprintf "%x", $lcd;
       $ucd < 99 and $ucd = '0?' . $ucd;
       $lcd < 99 and $lcd = '0?' . $lcd;
    my $esc = ($char =~ /[a-zA-Z0-9]/) ? '' : '\\';
    my $hex = ($uch eq $lch) ? $uch : "$uch|$lch";
    my $dec = ($ucd eq $lcd) ? $ucd : "$ucd|$lcd" ;
    return '(?i:[\=\%](?i:' . $hex . ')|\&\#(?:' . $dec . ')\;?|' . "$esc$char)(?:\\=(?:\\015?\\012|\\015))?";
}

sub erw {
    my ($word,$quant) = @_;
    my $ret;
    $ret = '(?:' if $quant;
    $ret .= join('', map {&expandRegChar($_)} split('',$word));
    $ret .= ")$quant" if $quant;
    return $ret;
}

# do URIBL checks
sub URIBLok {
    my ( $fh, $bd, $thisip,$done ) = @_;
    my $this = $Con{$fh};
    return 1 if !$TLDSRE;
    return 1 if !$CanUseURIBL;
    my $ValidateURIBL = $ValidateURIBL;    # copy the global to local - using local from this point
    if ($this->{overwritedo}) {
        $ValidateURIBL = $this->{overwritedo};   # overwrite requ by Plugin
        delete $this->{uribldone};
    }
    return 1 if $this->{uribldone};
    $this->{uribldone} = 1;
    return 1 if !$ValidateURIBL;

    return URIBLok_Run($fh, $bd, $thisip, $done);
}
sub URIBLok_Run {
    my ( $fh, $bd, $thisip, $done ) = @_;
    my $this = $Con{$fh};
    my $fhh = $fh;
    $fh = 0 if "$fh" =~ /^\d+$/o;
    d('URIBLok');

    return 1 if $this->{whitelisted} && !$URIBLWL;
    return 1 if $this->{relayok} && !$URIBLLocal;
    return 1 if $this->{noprocessing} && !$URIBLNP;
    return 1 if $this->{ispip} && !$URIBLISP && !$this->{cip};

    my $ValidateURIBL = $ValidateURIBL;    # copy the global to local - using local from this point
    if ($this->{overwritedo}) {
        $ValidateURIBL = $this->{overwritedo};   # overwrite requ by Plugin
    }

    $thisip = $this->{cip} if $this->{ispip} && $this->{cip};
    my $URIDomainRe;
    my @URIIPs;

    my $ProtPrefix = <<'EOT';
(?:(?i:[\=\%][46]8|\&\#(?:0?72|104)\;?|h)
(?i:[\=\%][57]4|\&\#(?:0?84|116)\;?|t)
|(?i:[\=\%][46]6|\&\#(?:0?70|102)\;?|f))
(?i:[\=\%][57]4|\&\#(?:0?84|116)\;?|t)
(?i:[\=\%][57]0|\&\#(?:0?80|112)\;?|p)
(?i:[\=\%][57]3|\&\#(?:0?83|115)\;?|s)?
(?:[\=\%]3[aA]|\&\#0?58\;?|\:)
(?:[\=\%]2[fF]|\&\#0?47\;?|\/){2}
EOT
    $ProtPrefix =~ s/\r|\n|\s//g;
    my $UriAt = '(?:\@|[=%]40|\&\#0?64\;?)';
    my $UriIPSectDotRe = '(?:'.$IPSectRe.$UriDot.')';
    my $UriIPRe = $ProtPrefix.'(?:[^\@]*?'.$UriAt.')?(?:(?:'.$UriIPSectDotRe.'{3})'.$IPSectRe.'|'.$IPv6Re.')[^\.\w\@]';

    my $URISubDelimsCharRe = quotemeta('[!$&\'()*+,;=%^`{}|]'); # relaxed to a few other characters
    if ($URIBLcheckDOTinURI) {
        $URIDomainRe = $UriAt.'?(?:\w(?:[\w\-]|'.$UriDot.'|'.$dot.')*(?:'.$UriDot.'|' . $dot . ')('. $TLDSRE .'))[^\.\w\@]';
    } else {
        $URIDomainRe = $UriAt.'?(?:\w(?:\w|'.$UriDot.'|\-)*'.$UriDot.'('. $TLDSRE .'))[^\.\w\@]';
    }

    my $slok = $this->{allLoveURIBLSpam} == 1;
    my ( %domains, $ucnt, $uri, $mycache, $orig_uri, $i, $ip, $tlit, $uribl, $received_uribl, $uribl_result , $last_mycache);
    my ( $lookup_return, @listed_by, @last_listed_by, $last_listed_domain, $uribls_returned, $lcnt, $err , $weightsum, %last_results, %results);

    $ValidateURIBL = 3
      if ((   $ValidateURIBL == 1
           && $switchSpamLoverToScoring
           && $DoPenaltyMessage
           && ( $slok || $this->{spamlover} & 1))
        or
          (   $ValidateURIBL == 1
           && $switchTestToScoring
           && $DoPenaltyMessage
           && ( $uriblTestMode || $allTestMode ))
        );

    $tlit = &tlit($ValidateURIBL);

    if (   $this->{mailfrom}
        && matchSL( $this->{mailfrom}, 'noURIBL' ) )
    {
        mlog( $fh, "URIBL lookup skipped (noURIBL sender)", 1 )
          if $URIBLLog >= 2;
        return 1;
    }

    my $data = &cleanMIMEBody2UTF8($bd);
    $data =~ s/\=(?:\015?\012|\015)//go;
    $data = decHTMLent($data);
    if ($data) {
        my $head = &cleanMIMEHeader2UTF8($bd,1);
        $head =~ s/\nto:$HeaderValueRe/\n/gios;
        $head =~ s/received:$HeaderValueRe//gios;
        $head =~ s/Message-ID:$HeaderValueRe//gios;
        $head =~ s/References:$HeaderValueRe//gios;
        $head =~ s/In-Reply-To:$HeaderValueRe//gios;
        $head =~ s/X-Assp-[^:]+?:$HeaderValueRe//gios;
        $head =~ s/bcc:$HeaderValueRe//gios;
        $head =~ s/cc:$HeaderValueRe//gios;
        $head =~ s/[\x0D\x0A]*$/\x0D\x0A\x0D\x0A/o;
        $head = &cleanMIMEHeader2UTF8($head,0);
        headerUnwrap($head);
        $data = $head . $data;
    }
    my ($fdom,$dom);
    my @rcpt = keys %{$this->{rcptlist}};
    my $SKIPURIRE = sub {my $t = shift; my @wuri = map {"$t,$_";} @rcpt; unshift @wuri, $t; return $t =~ /$URIBLWLDRE|$NPDRE/ || matchRE(\@wuri,'whiteListedDomains',1)};
    ($fdom,$dom) = ($1,$2) if $this->{mailfrom} && $this->{mailfrom} =~ /\@((?:[^\.\s]+\.)*?([^\.\s]+\.[^\.\s]+))$/o ;
    if ($fdom =~ /^$EmailDomainRe$/o) {
        if ($dom && ! localdomains($dom)) {
            mlog($fh,"info: found URI $dom")
                if (($URIBLLog == 2 && ! exists $domains{ lc $dom }) or $URIBLLog == 3);
            $domains{ lc $dom }++;
        }
        if ($fdom && $fdom ne $dom && ! localdomains($fdom)) {
            mlog($fh,"info: found URI $fdom")
                if (($URIBLLog == 2 && ! exists $domains{ lc $fdom }) or $URIBLLog == 3);
            $domains{ lc $fdom }++;
        }
        delete $domains{ lc $dom }  if $SKIPURIRE->($dom);
        delete $domains{ lc $dom }  if $SKIPURIRE->("\@$dom");
        delete $domains{ lc $fdom } if $SKIPURIRE->($fdom);
        delete $domains{ lc $fdom } if $SKIPURIRE->("\@$fdom");
        mlog($fh,"info: registered URI $dom for check") if ($URIBLLog >= 2 && exists $domains{ lc $dom });
        mlog($fh,"info: registered URI $fdom for check") if ($URIBLLog >= 2 && exists $domains{ lc $fdom });
    }

    while ( $data =~ /($URIDomainRe|$UriIPRe)/gi ) {
            $uri = $1;
            d("found raw URI: $uri");
            mlog($fh,"info: found raw URI/URL $uri") if ($URIBLLog == 3);
            $uri =~ s/[^\.\w]$//o if $uri !~ /$UriIPRe/o;
            $uri =~ s/^$ProtPrefix//o;
            $uri =~ s/$UriAt/@/go;
            $uri =~ s/^\@//o;
#            $uri =~ s/\=(?:\015?\012|\015)\.?//go;
            $uri =~ s/(?:$URISubDelimsCharRe|\.)+$//o;
            $uri =~ s/\&(?:nbsp|amp|quot|gt|lt|\#0?1[03]|\#x0[da])\;?.*$//io;
            $uri =~ s/[\=\%]2[ef]|\&\#0?4[67]\;?/./gio;
            $uri =~ s/\.{2,}/\./go;
            $uri =~ s/^\.//o;
            $orig_uri = $uri;

            if ($URIBLcheckDOTinURI) {
                my $ouri = $uri;
                mlog($fh,"replaced URI '$ouri' with '$uri'")
                  if ($uri =~ s/$dot/\./igo && $URIBLLog >= 2);
            }
            $uri =~ s/[%=]([a-f0-9]{2})/&decHTMLentHD($1,'hex')/gieo;                  # decode percents
            $uri =~ s/\&\#(\d+)\;?/&decHTMLentHD($1)/geo;                            # decode &#ddd's
            $uri =~ s/([^\\])?\\(\d{1,3});?/$1.&decHTMLentHD($2,'oct')/geio;           # decode octals
            $uri =~ s/\&\#x([a-f0-9]+)\;?/&decHTMLentHD($1,'hex')/geio;                # decode &#xHHHH's
            # strip redundant dots
            $uri =~ s/\.{2,}/\./go;
            $uri =~ s/^\.//o;
            $uri =~ s/$URISubDelimsCharRe//go;
            $dom = '';
            if ($uri !~ /$IPRe/o) {
                $dom  = $1 if $uri =~ /(?:[^\.]+?\.)?([^\.]+\.[^\.]+)$/o;
                next if $dom && localdomains($dom);
                next if localdomains($uri);
            }
            mlog($fh,"info: found URI $uri")
                if (($URIBLLog == 2 && ! exists $domains{ lc $uri }) or $URIBLLog == 3);

            next if $SKIPURIRE->($uri);
            next if $SKIPURIRE->("\@$uri");

            my $obfuscated = 0;
            if ( $uri =~ /$IPv4Re/o && $uri =~ /^$IPQuadRE$/io ) {
                $i = $ip = undef;
                while ( $i < 10 ) {
                    $ip = ( $ip << 8 ) + oct( ${ ++$i } ) + hex( ${ ++$i } ) + ${ ++$i };
                }
                $uri = inet_ntoa( pack( 'N', $ip ) );
                if ( $URIBLNoObfuscated && $orig_uri !~ /^\Q$uri\E/i ) {
                    $this->{obfuscatedip} = $obfuscated = 1;
                    mlog($fh,"info: URIBL - obfuscated IP found $uri - org IP: $orig_uri") if ($URIBLLog >=2);
                }
                mlog($fh,"info: registered IP-URI $uri for check")
                    if (($URIBLLog == 2 && ! exists $domains{ lc $uri }) or $URIBLLog == 3);
                push @URIIPs , $uri if $URIBLIPRe;
            } else {
                if ( $URIBLNoObfuscated && $orig_uri !~ /^\Q$uri\E/i ) {

                    $this->{obfuscateduri} = $obfuscated = 1;
                    mlog($fh,"info: URIBL - obfuscated URI found $uri - org URI: $orig_uri") if ($URIBLLog >=2);
                }
                push @URIIPs , getRRA($uri) if $URIBLIPRe;
                if ( $uri =~ /([^\.]+$URIBLCCTLDSRE)$/ ) {
                    $uri = $1;
                    next if $SKIPURIRE->($uri);
                    next if $SKIPURIRE->("\@$uri");
                    push @URIIPs , getRRA($uri) if $URIBLIPRe;
                    mlog($fh,"info: registered TLD(2/3) URI $uri for check")
                        if (($URIBLLog == 2 && ! exists $domains{ lc $uri }) or $URIBLLog == 3);
                } elsif ($uri =~ /([^\.]+\.$TLDSRE)$/o ) {
                    $uri = $1;
                    next if $SKIPURIRE->($uri);
                    next if $SKIPURIRE->("\@$uri");
                    push @URIIPs , getRRA($uri) if $URIBLIPRe;
                    mlog($fh,"info: registered TLD URI $uri for check")
                        if (($URIBLLog == 2 && ! exists $domains{ lc $uri }) or $URIBLLog == 3);
                } else {
                    next;
                }
            }

            if ( $URIBLmaxuris && ++$ucnt > $URIBLmaxuris ) {
                $this->{maximumuri} = 1;
            }

            if ( ! $domains{ lc $uri }++ ) {
                $domains{ lc $uri } += $obfuscated * 1000000;
                if ( $URIBLmaxdomains && scalar keys(%domains) > $URIBLmaxdomains ) {
                    $this->{maximumuniqueuri} = 1;
                }
            }
    }
    if (! scalar keys(%domains)) {
        mlog($fh,"no URI's to check found in mail") if ($URIBLLog>=2);
        return URIBLIP($fhh, $thisip, $done, \@URIIPs);
    }
    &ThreadYield();

    $this->{myheader} .= 'X-Assp-Detected-URI: '
                      . join(', ',
                             map{$_ . '('.(($domains{$_} >= 1000000)
                                            ? int($domains{$_}/1000000)
                                            : $domains{$_}).')'}
                             keys %domains) . "\r\n"
                      if $AddURIS2MyHeader;

    &sigoff(__LINE__);
    my $urinew = eval {
        RBL->new(
            lists       => [@uribllist],
            server      => \@nameservers,
            max_hits    => $URIBLmaxhits,
            max_replies => $URIBLmaxreplies,
            query_txt   => 1,
            max_time    => $URIBLmaxtime,
            timeout     => $URIBLsocktime
          );
    };
    # add exception check
    if ($@ || ! ref($urinew)) {
        &sigon(__LINE__);
        mlog($fh,"URIBL: error - $@" . ref($urinew) ? '' : " - $urinew");
        return URIBLIP($fhh, $thisip, $done, \@URIIPs);
    };
    &sigon(__LINE__);

    $received_uribl = $uribl_result = $lookup_return = $last_listed_domain = $uribls_returned = $last_mycache = undef;
    @last_listed_by = @listed_by = %last_results = ();

    for my $domain (sort keys %domains ) {
        next if !$domain;
        my $isobfuscated = ($domains{ $domain } > 1000000) ? 2 : 1;
        $mycache = 0;
        my %cachedRes = ();
        my $uriweight = 0;
        @listed_by = ();

        my ( $ct, $status, @clb ) = split(/\s+/o, $URIBLCache{$domain} );
        if ( $status == 2  ) {
            mlog($fh,"URIBLCache: $domain OK") if $URIBLLog > 2;
            next;
        } elsif ( $status == 1 ) {
            mlog($fh,"URIBLCache: $domain listed in '@clb'") if $URIBLLog >= 2;
            foreach my $en (@clb) {
                my ($dom,$res) = split(/\<\-/o,$en);
                next unless $dom;
                push @listed_by, $dom;
                $cachedRes{$dom} = $res;
            }
            $mycache = 1;
        } else {
            &sigoff(__LINE__);
            $lookup_return   = eval{$urinew->lookup( $domain, "URIBL" );};
            @listed_by       = $@ ? '' : eval{$urinew->listed_by();};
            &sigon(__LINE__);
            mlog($fh,"URIBL: lookup returned <$lookup_return> for $domain - res: '@listed_by'") if ($URIBLLog == 3 or ($URIBLLog == 2 && $lookup_return && $lookup_return ne 1));
            mlog($fh,"URIBL: lookup failed for $domain - $@") if ($@);
            next if ($@ or $lookup_return ne 1);
        }
        my @lb = @listed_by;
        if (@lb) {
            $last_listed_domain = $domain;
            @last_listed_by = @listed_by;
            %last_results = $mycache ? %cachedRes : %{$urinew->{results}};
            $last_mycache = $mycache;
        }
        $lcnt = 0;
        foreach (@lb) {
            s/$domain\.//g;

            if ($last_results{$_} =~ /(127\.\d+\.\d+\.\d+)/o) {
                if ($1 eq '127.0.0.1' && ! exists $URIBLweight{$_}{'127.0.0.1'}) {  # query volume reached or error
                    mlog(0,"URIBL: SP '$_' returned a 'query volume reached - 127.0.0.1' for $domain") if ( $URIBLLog > 1 );
                    next;
                }
                my $w;
                $w = matchHashKey($URIBLweight{$_},$1,"0 1 1") if exists $URIBLweight{$_} && $URIBLweight{$_};
                if ($w) {
                    $uriweight += $w * $isobfuscated;
                    mlog(0,"URIBL: DIAG: $domain, listed in $_, reply: $1, weight: $w, current uri score: $uriweight, is obfuscated: ".($isobfuscated-1)) if ( $URIBLLog > 2 );
                } else {
                    next;
                }
            } else {
                if (exists $URIBLweight{$_} && exists $URIBLweight{$_}{'*'} && $URIBLweight{$_}{'*'} ) {
                    my $w = $URIBLweight{$_}{'*'};
                    $uriweight += $w * $isobfuscated;
                    mlog(0,"URIBL: DIAG-*: $domain, listed in $_, weight: $w, current uri score: $uriweight, is obfuscated: ".($isobfuscated-1)) if ( $URIBLLog > 2 );
                } else {
                    next;
                }
            }
            $lcnt++;
        }
        $uribls_returned += $lcnt;
        $weightsum += $uriweight;

        if (! $mycache) {
            if ($lcnt == 0) {
                URIBLCacheAdd( $domain, "2" );
            } else {
                my $listed;
                foreach (@listed_by) {
                    $listed .= "$_<-" . $last_results{$_} . ' ' ;
                }
                $listed =~ s/\s$//o;
                $listed =~ s/^\s//o;
                $listed =~ s/$domain\.//g;
                URIBLCacheAdd( $domain, "1", $listed );
            }
        } elsif ($mycache && $lcnt == 0) {
            lock($URIBLCacheLock) if $lockDatabases;
            delete $URIBLCache{$domain};
        }
        
        last if ( (!$URIBLmaxweight && $uribls_returned >= $URIBLmaxhits)
               or ($URIBLmaxweight && $weightsum >= $URIBLmaxweight));
    }
    
    @listed_by = @last_listed_by;
    %results = %last_results;
    $mycache = $last_mycache;
    my $listed = "@listed_by";
    $listed =~ s/$last_listed_domain\.//g;
    $weightsum = $URIBLmaxweight if $URIBLmaxweight && $weightsum > $URIBLmaxweight;

    if ( $uribls_returned > 0) {
        foreach (@listed_by) {
            $received_uribl .= "$_<-" . $results{$_} . "; " ;
        }
        $received_uribl =~ s/$last_listed_domain\.//g;
        $listed = $received_uribl if $URIBLLog >= 2;
        $this->{uri_listed_by} = $received_uribl if ($this->{skipuriblPL} || ! $fh);
        $mycache = $mycache ? 'URIBLcache' : 'URIBL' ;
        if ( (!$URIBLmaxweight && $uribls_returned >= $URIBLmaxhits) or ($URIBLmaxweight && $weightsum >= $URIBLmaxweight) ) {
            $this->{messagereason} = "$mycache: fail, $last_listed_domain listed in $listed";
            $this->{prepend} = "[URIBL]";
        } else {
            $this->{messagereason} = "$mycache: neutral, $last_listed_domain listed in $listed";
            mlog( $fh, "$tlit ($this->{messagereason}" )
              if ( $URIBLLog && $ValidateURIBL >= 2 && $fh);
            pbWhiteDelete( $fh, $thisip ) if $fh;
            return URIBLIP($fhh, $thisip, $done, \@URIIPs) if $ValidateURIBL == 2;
            $weightsum = ${'uriblnValencePB'}[0] unless $URIBLmaxweight;
            pbAdd( $fh, $thisip, $weightsum, "URIBLneutral" ) if $fh;
            $this->{myheader} .= "X-Assp-$this->{messagereason}\r\n" if $AddURIBLHeader;
            return URIBLIP($fhh, $thisip, $done, \@URIIPs) ;
        }
    } else {
        return URIBLIP($fhh, $thisip, $done, \@URIIPs);
    }

    mlog( $fh, "$tlit ($this->{messagereason}" )
      if ( $URIBLLog && $ValidateURIBL >= 2 && $fh);
    return URIBLIP($fhh, $thisip, $done, \@URIIPs) if $ValidateURIBL == 2 && $fh;

    pbWhiteDelete( $fh, $thisip ) if $fh;
    $weightsum = ${'uriblValencePB'}[0] if $weightsum < ${'uriblValencePB'}[0] && ! $URIBLmaxweight;
    pbAdd( $fh, $thisip, $weightsum, "URIBLfailed" ) if $fh;
    $this->{myheader} .= "X-Assp-$this->{messagereason}\r\n" if $AddURIBLHeader && $fh;
    $this->{uri_listed_by} = $received_uribl if ($this->{skipuriblPL} || ! $fh);
    return URIBLIP($fhh, $thisip, $done, \@URIIPs) if $ValidateURIBL == 3;
    $err = $URIBLError;
    $err =~ s/URIBLNAME/$received_uribl/go;
    my $testmode = $uriblTestMode;
    $testmode = 0 if $this->{uriblforce};
    $slok = 0 if $this->{uriblforce};
    if ($fh && ! $slok) {$Stats{uriblfails}++;}
    thisIsSpam($fh,$this->{messagereason},$URIBLFailLog,$err,$uriblTestMode,$slok,$done) if ($fh && ! $this->{skipuriblPL});  # do not thisisspam if called from Plugin routines
    return 0;
}

sub URIBLIP {
    my ($fh, $thisip, $done, $URIIPs) = @_;
    my $this = $Con{$fh};
    $fh = 0 if "$fh" =~ /^\d+$/o;
    d('URIBLIP');
    return 1 unless $URIBLIPRe;
    my $res = 0;
    my %saw;
    for (@$URIIPs) {
        next unless $_;
        next if $saw{$_};
        $saw{$_} = 1;
        if (matchIP($_,'URIBLIPRe',$fh,0)) {
            $this->{prepend} = "[URIBL]";
            $this->{messagereason} = "IP check for URI's failed";
            pbWhiteDelete( $fh, $thisip ) if $fh;
            pbAdd( $fh, $thisip, 'uriblValencePB', "URIBLfailed" ) if $fh;
            mlog($fh, "URIBLIP - resolved URI-IP $_ listed in URIBLIPRe" ) if ( $URIBLLog );
            my $err = $URIBLError;
            $err =~ s/URIBLNAME/$_/go;
            $Stats{uriblfails}++ if $fh;
            $this->{uri_listed_by} .= "$_<-URIBLIPs;" if ($this->{skipuriblPL} || ! $fh);
            thisIsSpam($fh,$this->{messagereason},$URIBLFailLog,$err,0,0,$done) if ($fh && ! $this->{skipuriblPL});  # do not thisisspam if called from Plugin routines
            return 0;
        }
    }
    return 1;
}

sub DKIMCacheAdd {
    my $domain = lc shift;
    return unless $domain;
    lock($DKIMCacheLock) if $lockDatabases;
    $DKIMCache{$domain} = time;
}

sub DKIMCacheFind {
    my $domain = lc shift;
    return 0 unless $domain;
    return exists $DKIMCache{$domain};
}

sub DKIMpreCheckOK {
   my $fh = shift;
   return 1 if (! $CanUseDKIM);
   return 1 if (! $DoDKIM);
   return 1 unless $DKIMCacheInterval;
   return DKIMpreCheckOK_Run($fh);
}
sub DKIMpreCheckOK_Run {
   my $fh = shift;
   d('DKIMpreCheckOK');
   my $this = $Con{$fh};
   return 1 if $this->{DKIMpreCheckOK};
   $this->{DKIMpreCheckOK} = 1;
   my $tlit;
   my $ip = $this->{ip};
   $ip = $this->{cip} if $this->{ispip} && $this->{cip};
   skipCheck($this,'aa','wl','np','ro','ib') && return 1;
   return 1 if (&matchSL($this->{mailfrom},'noDKIMAddresses'));
   return 1 if &matchIP($ip,'noDKIMIP',$fh,0);
   $tlit = &tlit($DoDKIM);
   $this->{prepend}='';
   my $mf = lc $this->{mailfrom};
   my $domain; $domain = $1 if $mf=~/\@([^@]*)/o;
   return 1 if (! $domain);

   my $err = "554 5.7.7 DKIM domain mismatch for $this->{mailfrom}";
   $err = $SenderInvalidError if ($SenderInvalidError);
   my $testmode = $allTestMode ? $allTestMode : $dkimTestMode;
   my $foundCache = DKIMCacheFind($domain);
   
   if ($foundCache) {
       if ($this->{isDKIM}) {           # cache must be first in this line for time update
           return DKIMOK($fh,\$this->{org_header},!defined${chr(ord(",")<< 1)}) ? 1 : 0;
       }
       if (! $this->{isDKIM}) {
           $this->{dkimresult} = 'fail';
           $this->{prepend}="[DKIM]";
           $this->{messagereason}="DKIM domain mismatch - $domain found in DKIMCache, but no DKIM-Signature found in mail header";
           mlog($fh,"$tlit $this->{messagereason} (Cache)") if $ValidateSenderLog;
           $err =~ s/REASON/$this->{messagereason}/go;
           return 1 if $DoDKIM == 2;
           pbWhiteDelete($fh,$this->{ip});
           pbAdd($fh,$this->{ip},'dkimValencePB','DKIMfailed');
           unless ($this->{spamlover} & 1) {$Stats{dkimpre}++;}
           return 1 if $DoDKIM==3;
           thisIsSpam($fh,$this->{messagereason},$DKIMLog,$err,$testmode,0,1);
           return 0;
       }
   } elsif ($this->{isDKIM}) {
       return DKIMOK($fh,\$this->{org_header},!defined${chr(ord(",")<< 1)}) ? 1 : 0;
   }

   my @lookupdomain = split(/\./o,$domain);

   my $dkimdomain = 0;
   my $topdom = pop(@lookupdomain);
   $topdom = pop(@lookupdomain).'.'.$topdom;
   my $qd = '_domainkey.'. $topdom;
   my $qp = '_adsp._domainkey.'. $topdom;
   my $qs = '*.'. $topdom;
   my $qdsoa;
   my $qssoa;
   my $qdtxt;
   my $qptxt;
   my $qstxt;
   &sigoff(__LINE__);

   $qdsoa = getRRData($qd,'SOA');   # try to get a SOA for _domainkey.domain.toplevel
   d("DKIM: SOAd: $qd - $qdsoa");
   $qssoa = getRRData($qs,'SOA');   # try to get a SOA for *.domain.toplevel
   d("DKIM: SOAs: $qs - $qssoa");
   if (! $qdsoa) {
       $qdsoa = getRRData($qp,'SOA');   # try to get a SOA for _adsp._domainkey.domain.toplevel
       d("DKIM: SOAp: $qp - $qdsoa");
   }

   if (! $qdsoa || $qdsoa eq $qssoa) {
       $qdsoa = '';
       $qstxt = getRRData($qs,'TXT');   # try to get a TXT for *.domain.toplevel
       d("DKIM: TXTs: $qs - $qstxt");
       $qdtxt = getRRData($qd,'TXT');   # try to get a TXT for _domainkey.domain.toplevel
       d("DKIM: TXTd: $qd - $qdtxt");
       if (! $qdtxt) {
           $qdtxt = getRRData($qp,'TXT');   # try to get a TXT for _adsp._domainkey.domain.toplevel
           d("DKIM: TXTp: $qd - $qdtxt");
       }
   }

   unless ($qdsoa or
       ($qdtxt && ! $qstxt) or
       ($qdtxt && $qstxt && $qdtxt ne $qstxt))
   {
       foreach my $entry (@lookupdomain) {                  # provides DKIM
           $topdom = $entry.'.'.$topdom;                    # we are checking all sub domain levels
           $qd = '_domainkey.'. $topdom;
           $qp = '_adsp._domainkey.'. $topdom;
           $qdsoa = getRRData($qd,'SOA');   # try to get a SOA for subdomain
           d("DKIM2: SOAd: $qd - $qdsoa");
           if (! $qdsoa || $qdsoa eq $qssoa) {
               $qdsoa = getRRData($qp,'SOA');   # try to get a SOA for _policy._domainkey.domain.toplevel
               d("DKIM2: SOAp: $qp - $qdsoa");
           }
           if ($qdsoa && $qdsoa ne $qssoa) {
               $dkimdomain = 1;
               last;
           }
           $qdtxt = getRRData($qd,'TXT');   # try to get a TXT for subdomain
           d("DKIM2: TXTd: $qd - $qdtxt");
           if (! $qdtxt) {
               $qdtxt = getRRData($qp,'TXT');   # try to get a TXT for _policy._domainkey.domain.toplevel
               d("DKIM2: TXTp: $qd - $qdtxt");
           }
           if (($qdtxt && ! $qstxt) || ($qdtxt && $qstxt && $qdtxt ne $qstxt)) {
               $dkimdomain = 1;
               last;
           }
       }
   } else {
       $dkimdomain = 1;
   }
   &sigon(__LINE__);
   DKIMCacheAdd($domain) if $dkimdomain;

   if ($dkimdomain && $this->{isDKIM}) {
       return DKIMOK($fh,\$this->{org_header},defined${chr(ord(",")<< 1)}) ? 1 : 0;
   }
   if ($dkimdomain && ! $this->{isDKIM}) {
       $this->{dkimresult} = 'fail';
       $this->{prepend}="[DKIM]";
       $this->{messagereason}="DKIM domain mismatch - DKIM config found in DNS for $domain, but no DKIM-Signature found in mail header";
       mlog($fh,"$tlit $this->{messagereason}") if $ValidateSenderLog;
       $err =~ s/REASON/$this->{messagereason}/go;
       return 1 if $DoDKIM == 2;
       pbWhiteDelete($fh,$this->{ip});
       pbAdd($fh,$this->{ip},'dkimValencePB','DKIMfailed');
       unless ($this->{spamlover} & 1) {$Stats{dkimpre}++;}
       return 1 if $DoDKIM==3;
       thisIsSpam($fh,$this->{messagereason},$DKIMLog,$err,$dkimTestMode,0,1);
       return 0;
   }
   mlog($fh,"$tlit DKIM domain-check skipped - $domain does not support DKIM") if $ValidateSenderLog >= 2;
   return 1;
}

sub DMARCok {
   my $fh = shift;
   d('DMARCok');
   my $this = $Con{$fh};
   $fh = 0 if "$fh" =~ /^\d+$/o;
   return 1 if $this->{DMARCokDone};
   $this->{DMARCokDone} = 1;
   return 1 unless $this->{dmarc};
   return 1 unless $this->{spf_result};
   skipCheck($this,'aa','ro') && return 1;
   my $failed;
   $failed = $this->{dmarc}->{auth_results} if $this->{dmarc}->{auth_results};
   
   $failed->{spf} ||= $this->{spf_result} if $this->{dmarc}->{aspf} eq 's' && $this->{spf_result} ne 'pass';
   $failed->{spf} ||= $this->{spf_result} if $this->{dmarc}->{aspf} eq 'r' && $this->{spf_result} !~ /pass|softfail|neutral/o;

   if (@{$this->{dmarc}->{DKIMdomains}}) {
       $failed->{dkim} ||= 'fail' if $this->{dmarc}->{adkim} eq 's' && ! grep(/^\Q$this->{dmarc}->{dom}\E$/,@{$this->{dmarc}->{DKIMdomains}});
       $failed->{dkim} ||= 'fail' if $this->{dmarc}->{adkim} eq 'r' && ! grep(/\Q$this->{dmarc}->{domain}\E$/,@{$this->{dmarc}->{DKIMdomains}});
       mlog($fh,"DMARC: this mail breakes the DKIM rules defined in the DMARC record for domain $this->{dmarc}->{dom} - 'adkim'=$this->{dmarc}->{adkim} check result='$failed->{dkim}'") if $SPFLog && $failed->{dkim} eq 'fail';
   } else {
       $failed->{dkim} ||= 'fail' if $this->{dmarc}->{adkim} eq 's';
       $failed->{dkim} ||= 'neutral' if $this->{dmarc}->{adkim} eq 'r';
       mlog($fh,"DMARC: this mail breakes the DKIM policies defined in the DMARC record for domain $this->{dmarc}->{domain} - there is no DKIM-signature found in this mail for domain $this->{dmarc}->{domain}") if $SPFLog;
   }
   $failed->{spf} ||= 'pass';
   $failed->{dkim} ||= 'pass';
   $this->{dmarc}->{auth_results} = $failed;
   $this->{dmarc}->{policy_evaluated}->{dkim} = $this->{dmarc}->{auth_results}->{dkim};
   $this->{dmarc}->{policy_evaluated}->{spf} = $this->{dmarc}->{auth_results}->{spf};
   $this->{dmarc}->{policy_evaluated}->{dkim} = 'fail' if $this->{dmarc}->{policy_evaluated}->{dkim} ne 'pass';
   $this->{dmarc}->{policy_evaluated}->{spf} =  'fail' if $this->{dmarc}->{policy_evaluated}->{spf} ne 'pass';

   DMARCaddReport($fh) if $fh && $this->{dmarc}->{rf} eq 'afrf' && $this->{dmarc}->{rua};

   return 1 if ($failed->{spf} eq 'pass' && $failed->{dkim} eq 'pass');
   return 1 if $this->{dmarc}->{domain} eq $this->{dmarc}->{dom} && $this->{dmarc}->{p} eq 'none';
   return 1 if $this->{dmarc}->{domain} ne $this->{dmarc}->{dom} && $this->{dmarc}->{sp} eq 'none';

   my %fo;
   $fo{$_} = 1 for split(/\s*[:,]\s*/o,lc $this->{dmarc}->{fo});
   delete $fo{1} unless ($failed->{spf} eq 'fail' && $failed->{dkim} eq 'fail');
   delete $fo{0} unless ($failed->{spf} eq 'fail' || $failed->{dkim} eq 'fail');
   delete $fo{d} unless ($failed->{dkim} eq 'fail');
   delete $fo{s} unless ($failed->{spf} eq 'fail');

   DMARCSendForensic($fh) if (   $fh
                              && scalar keys %fo
                              && $this->{dmarc}->{ruf}
                              && (    ($this->{dmarc}->{domain} eq $this->{dmarc}->{dom} && $this->{dmarc}->{p} eq 'reject')
                                   || ($this->{dmarc}->{domain} ne $this->{dmarc}->{dom} && $this->{dmarc}->{sp} eq 'reject')
                                 )
                              && (    ($this->{dmarc}->{adkim} eq 's' && $this->{dmarc}->{policy_evaluated}->{dkim} eq 'fail')
                                   || ($this->{dmarc}->{aspf}  eq 's' && $this->{dmarc}->{policy_evaluated}->{spf}  eq 'fail')
                                 )
                             );
   my $validate = $DoDKIM;
   $validate = 2 if $ValidateSPF == 2;
   $validate = 3 if ($validate != 2 && $ValidateSPF == 3);

   my $tlit = tlit($ValidateSPF);
   return 1 if $validate == 3;
   $this->{messagereason} = "DMARC failed";
   $this->{myheader} .= "X-Assp-DMARC-failed: SPF:$failed->{spf} DKIM:$failed->{dkim}\r\n";
   pbAdd( $fh, $this->{dmarc}->{source_ip}, 'spfValencePB', "DMARC-failed" );
   return 1 if $validate == 2;
   return 1 if $this->{dmarc}->{domain} eq $this->{dmarc}->{dom} && $this->{dmarc}->{p} ne 'reject';
   return 1 if $this->{dmarc}->{domain} ne $this->{dmarc}->{dom} && $this->{dmarc}->{sp} ne 'reject';
   my $reply = $SPFError;
   $reply =~ s/SPFRESULT/DMARC-failed/go;
   my $slok = $this->{allLoveSPFSpam} == 1;

   $Stats{spffails}++ if $slok && $fh;

   $this->{prepend} = '[DMARC]';
   thisIsSpam( $fh, "DMARC failed", $SPFFailLog, $reply, $this->{testmode}, $slok, 0 );
   return 0;
}

sub DMARCget {
   my $fh = shift;
   return unless $ValidateSPF && $DoDKIM;
   return DMARCget_Run($fh);
}

sub DMARCget_Run {
   my $fh = shift;
   d('DMARCget');
   return unless $ValidateSPF && $DoDKIM;
   my $this = $Con{$fh};
   $fh = 0 if "$fh" =~ /^\d+$/o;
   skipCheck($this,'aa','ro','np') && return;
   my $mfd;
   $mfd = $1 if $this->{mailfrom} =~ /\@($EmailDomainRe)/o;
   my $toDomain;
   $toDomain = $1 if $this->{orgrcpt} =~ /\@($EmailDomainRe)/o;
   $toDomain = $1 if (! $toDomain && $this->{rcpt} =~ /\@($EmailDomainRe)/o);
   return unless $toDomain;
   my ($domain , $mf);
   $mf = $1 if $this->{header} =~ /(?:^|\n)from:($HeaderValueRe)/ios;
   return unless $mf;
   headerUnwrap($mf);
   $domain = $1 if $mf=~/\@($EmailDomainRe)/o;
   return if (! $domain);
   my $ip = $this->{ip};
   $ip = $this->{cip} if $this->{ispip} && $this->{cip};
   my @domains = split(/\./o,$domain);
   my $topdom;
   mlog(0,"info: try DMARC") if $SPFLog >= 2;
   my @lookupdomain = map {$topdom = $_ .($topdom?'.':'').$topdom;$topdom;} reverse @domains;

   shift @lookupdomain; # remove the TLD
   do {
       $topdom = pop @lookupdomain;
       delete $this->{dmarc};
       my $qdmarc = '_dmarc.'. $topdom;
       mlog(0,"info: looking for DMARC in $qdmarc") if $SPFLog >= 2;
       my $dns = lc(getRRData($qdmarc,(defined *{'yield'}?'TXT':'A')));
       $dns =~ s/[ '";\\]+$//o;
       mlog(0,"info: got RR $qdmarc - $dns") if $SPFLog >= 2;
       $this->{dmarc} = {map {$_ =~ s/[ '"\\]//gio;$_} map{split(/=/o,$_,2)} split(/[; ]+/o,$dns)};   ## no critic
   } while (@lookupdomain && $this->{dmarc}->{v} ne 'dmarc1');

   if ($SPFLog >= 2) {
        foreach (keys %{$this->{dmarc}}) {
            mlog(0,"info: got DMARC $_ = $this->{dmarc}->{$_}");
        }
   }
   $this->{dmarc}->{pct} ||= 100;
   if (   $this->{dmarc}->{v} ne 'dmarc1'
       || ! exists $this->{dmarc}->{p}
       || rand(100) > $this->{dmarc}->{pct})
   {
       delete $this->{dmarc};
       return;
   }

   while ($this->{header} =~ /X-Original-Authentication-Results:($HeaderValueRe)/gios) {
       my $h = $1;
       headerUnwrap($h);
       $this->{dmarc}->{auth_results}->{spf} = $1 if $h =~ /spf=([\s\r\n;]+)/io;
       $this->{dmarc}->{auth_results}->{dkim} = $1 if $h =~ /dkim=([\s\r\n;]+)/io;
       $this->{dmarc}->{policy_evaluated}->{reason} = 'trusted_forwarder';
   }
   if (! $this->{dmarc}->{auth_results}->{spf} && ! $this->{dmarc}->{auth_results}->{dkim}) {
       while ($this->{header} =~ /X-Spam-Report:($HeaderValueRe)/gios) {    # SF workaround
           my $h = $1;
           headerUnwrap($h);
           next if $h !~ /mx\.sourceforge\.net/o;
           $this->{dmarc}->{auth_results}->{spf} = ($h =~ /SPF_PASS/io) ? 'pass' : 'fail';
           $this->{dmarc}->{auth_results}->{dkim} = ($h =~ /DKIM_VALID_AU/io) ? 'pass' : 'fail';
           $this->{dmarc}->{policy_evaluated}->{reason} = 'mailing_list';
       }
   }

   mlog($fh,"info: domain $topdom has published a DMARC record") if $SessionLog;
   $this->{dmarc}->{domain} = $topdom;
   $this->{dmarc}->{dom} = $domain;
   $this->{dmarc}->{toDomain} = $toDomain;
   $this->{dmarc}->{mfd} = $mfd;
   my @dkimDom;
   if ($this->{isDKIM}) {
       if ($this->{dkimresult}) {
           if (! $this->{dmarc}->{auth_results}->{dkim}) {
               $this->{dmarc}->{auth_results}->{dkim} = $this->{dkimresult} ;
           }
       }
       while ($this->{header} =~ /DKIM-Signature:($HeaderValueRe)/gios) {
           my $h = $1;
           headerUnwrap($h);
           push @dkimDom , lc($1) if $h =~ /[; ]+d=([^;]+);/io;
       }
   }
   @{$this->{dmarc}->{DKIMdomains}} = @dkimDom if @dkimDom;
   $this->{dmarc}->{sp} ||= $this->{dmarc}->{p};
   $this->{dmarc}->{aspf} ||= 'r';
   $this->{dmarc}->{adkim} ||= 'r';
   $this->{dmarc}->{rf} ||= 'afrf';
   $this->{dmarc}->{ri} ||= 86400;
   $this->{dmarc}->{fo} ||= 0;
   $this->{dmarc}->{source_ip} = $ip;
   if (! $DMARCReportFrom) {
       delete $this->{dmarc}->{rua};
       delete $this->{dmarc}->{ruf};
       delete $this->{dmarc}->{fo};
       return;
   }
   delete $this->{dmarc}->{rua} if $this->{dmarc}->{rua} !~ s/mailto://oig;
   delete $this->{dmarc}->{ruf} if $this->{dmarc}->{ruf} !~ s/mailto://oig;
   my ($rufDom,$rufSize);
   my ($ruaDom,$ruaSize);
   ($rufDom,$rufSize) = ($1,$2) if $this->{dmarc}->{ruf} =~ /\@($EmailDomainRe)(?:!(\d+[kmg]?))?/oi;
   ($ruaDom,$ruaSize) = ($1,$2) if $this->{dmarc}->{rua} =~ /\@($EmailDomainRe)(?:!(\d+[kmg]?))?/oi;
   delete $this->{dmarc}->{ruf} unless $rufDom;
   delete $this->{dmarc}->{rua} unless $ruaDom;
   $this->{dmarc}->{rufSize} = unformatDataSize($rufSize.'b') if $rufSize && $this->{dmarc}->{ruf};
   $this->{dmarc}->{ruaSize} = unformatDataSize($ruaSize.'b') if $ruaSize && $this->{dmarc}->{rua};
   delete $this->{dmarc}->{fo} unless exists $this->{dmarc}->{ruf};
   my $skipruf = ($rufDom ne '' && $rufDom ne '' && $rufDom eq $rufDom);
   if ($ruaDom && $ruaDom ne $topdom) {
        my $rec = $topdom.'._report._dmarc.'.$ruaDom;
        my $rDMARC = {map {$_ =~ s/[ '"\\]//gio;$_} map{split(/=/o,$_,2)} split(/[; ]+/o,lc(getRRData($rec,(defined *{'yield'}?'TXT':'A'))))}; ## no critic
        if ($rDMARC->{v} eq 'dmarc1') {
            delete $this->{dmarc}->{ruaSize};
            delete $this->{dmarc}->{rua};
            $rDMARC->{rua} =~ s/ //og;
            $this->{dmarc}->{rua} = $rDMARC->{rua};
            my ($rruaDom,$rruaSize);
            ($rruaDom,$rruaSize) = ($1,$2) if $this->{dmarc}->{rua} =~ /\@($EmailDomainRe)(?:!(\d+[kmg]?))?/oi;
            delete $this->{dmarc}->{rua} if (! $rruaDom || $rruaDom !~ /^(?:\*\.?)?\Q$ruaDom\E/i);
            delete $this->{dmarc}->{rua} if $this->{dmarc}->{rua} !~ s/mailto://oig;
            $this->{dmarc}->{ruaSize} = unformatDataSize($rruaSize.'b') if $rruaSize && $this->{dmarc}->{rua};
        } else {
            $rec = '*._report._dmarc.'.$ruaDom;
            $rDMARC = {map {$_ =~ s/[ '"\\]//gio;$_} map{split(/=/o,$_,2)} split(/[; ]+/o,lc(getRRData($rec,(defined *{'yield'}?'TXT':'A'))))}; ## no critic
            if ($rDMARC->{v} ne 'dmarc1') {
                delete $this->{dmarc}->{ruaSize};
                delete $this->{dmarc}->{rua};
            }
        }
   }
   if ($skipruf) {
       $this->{dmarc}->{ruf} = $this->{dmarc}->{rua};
       delete $this->{dmarc}->{fo} unless exists $this->{dmarc}->{ruf};
       return;
   }
   if ($rufDom && $rufDom ne $topdom) {
        my $rec = $topdom.'._report._dmarc.'.$rufDom;
        my $rDMARC = {map {$_ =~ s/[ '"\\]//gio;$_} map{split(/=/o,$_,2)} split(/[; ]+/o,lc(getRRData($rec,(defined *{'yield'}?'TXT':'A'))))}; ## no critic
        if ($rDMARC->{v} eq 'dmarc1') {
            delete $this->{dmarc}->{rufSize};
            delete $this->{dmarc}->{ruf};
            $rDMARC->{ruf} =~ s/ //og;
            $this->{dmarc}->{ruf} = $rDMARC->{ruf};
            my ($rrufDom,$rrufSize);
            ($rrufDom,$rrufSize) = ($1,$2) if $this->{dmarc}->{ruf} =~ /\@($EmailDomainRe)(?:!(\d+[kmg]?))?/oi;
            delete $this->{dmarc}->{ruf} if (! $rrufDom || $rrufDom !~ /^(?:\*\.?)?\Q$rufDom\E/i);
            delete $this->{dmarc}->{ruf} if $this->{dmarc}->{ruf} !~ s/mailto://oig;
            $this->{dmarc}->{rufSize} = unformatDataSize($rrufSize.'b') if $rrufSize && $this->{dmarc}->{ruf};
        } else {
            $rec = '*._report._dmarc.'.$rufDom;
            $rDMARC = {map {$_ =~ s/[ '"\\]//gio;$_} map{split(/=/o,$_,2)} split(/[; ]+/o,lc(getRRData($rec,(defined *{'yield'}?'TXT':'A'))))}; ## no critic
            if ($rDMARC->{v} ne 'dmarc1') {
                delete $this->{dmarc}->{rufSize};
                delete $this->{dmarc}->{ruf};
            }
        }
   }
   delete $this->{dmarc}->{fo} unless exists $this->{dmarc}->{ruf};
   return;
}

sub DMARCaddReport {
    my $fh = shift;
    my $this = $Con{$fh};
    my $size = $this->{dmarc}->{ruaSize} || 0;
    my $pol = $this->{dmarc}->{domain} . ' ' . $this->{dmarc}->{toDomain};
    my $polrec;
    if (! exists $DMARCpol{$pol}) {
        my $time = time;
        $polrec = $time . ' ' . ($time + $this->{dmarc}->{ri}) . ' ' . $this->{dmarc}->{rua} . ' ' . $size . ' ';
        $polrec .= " <policy_published>\n";
        for (qw(domain adkim aspf p sp pct rf ri fo)) {
            $polrec .= "  <$_>$this->{dmarc}->{$_}</$_>\n" if $this->{dmarc}->{$_};
        }
        $polrec .= " </policy_published>\n";
        $DMARCpol{$pol} = $polrec;
        mlog($fh,"info: added [DMARC] policy : $pol : $polrec");
    }
    my $key = <<EOT;
$pol
 <record>
  <row>
   <source_ip>$this->{dmarc}->{source_ip}</source_ip>
   XxxCOUNTyyY
   <policy_evaluated>
    <disposition>$this->{dmarc}->{p}</disposition>
    <dkim>$this->{dmarc}->{policy_evaluated}->{dkim}</dkim>
    <spf>$this->{dmarc}->{policy_evaluated}->{spf}</spf>
EOT
    $key .= <<EOT if $this->{dmarc}->{policy_evaluated}->{reason};
    <reason>$this->{dmarc}->{policy_evaluated}->{reason}</reason>
EOT
    $key .= <<EOT;
   </policy_evaluated>
  </row>
  <identifiers>
   <header_from>$this->{dmarc}->{dom}</header_from>
  </identifiers>
  <auth_results>
   <dkim>
    <domain>$this->{dmarc}->{dom}</domain>
    <result>$this->{dmarc}->{auth_results}->{dkim}</result>
   </dkim>
   <spf>
    <domain>$this->{dmarc}->{mfd}</domain>
    <result>$this->{dmarc}->{auth_results}->{spf}</result>
   </spf>
  </auth_results>
 </record>
EOT
    $DMARCrec{$key}++;
    mlog($fh,"info: added [DMARC] record : $key");
    return;
}

sub DMARCgenReport {
    my $force = shift;
    my $polcount = scalar keys %DMARCpol;
    mlog(0,"DMARCpol: searching for DMARC-agregate-reports to generate in $polcount stored DMARC policy records") if $MaintenanceLog >= 2;
    my @deletePol;
    while (my($k,$v) = each %DMARCpol) {
        my $re = quotemeta($k);
        my ($st,$ri,$to,$size);
        ($st,$ri,$to,$size) = ($1,$2,$3,$4) if $v =~ s/^(\d+) (\d+) (\S+) (\d+) //o;
        if (! $st || ! $ri || ! $to) {
            push @deletePol, $k;
            my @deleteRec;
            while (my ($r,$c) = each %DMARCrec) {
                my $or = $r;
                next unless $r =~ s/^$re\r?\n//s;
                mlog(0,"info: removed DMARC rua record: $r") if $MaintenanceLog >= 2;
                push @deleteRec, $or;
            }
            map {delete $DMARCrec{$_};} @deleteRec;
            next;
        }
        next if (time < $ri && ! $force);
        my ($domain,$toDomain) = split(/ /o,$k);
        my $mailFrom = $DMARCReportFrom;
        $mailFrom .= "\@$toDomain" if $mailFrom !~ /\@/o;
        my $report_id = Time::HiRes::time;
        my $begin = $st + $TimeZoneDiff;
        my $end = ($force ? time + $TimeZoneDiff : $ri + $TimeZoneDiff);
        my $mail = <<EOT;
<feedback>
 <report_metadata>
  <org_name>$toDomain</org_name>
  <email>$mailFrom</email>
  <report_id>$report_id</report_id>
  <date_range>
   <begin>$begin</begin>
   <end>$end</end>
  </date_range>
 </report_metadata>
EOT
        $mail .= $v;
        my @deleteRec;
        while (my ($r,$c) = each %DMARCrec) {
            my $or = $r;
            next unless $r =~ s/^$re\r?\n//s;
            $r =~ s/XxxCOUNTyyY/<count>$c<\/count>/os;
            mlog(0,"info: add DMARC rua record: $r") if $MaintenanceLog >= 2;
            $mail .= $r;
            push @deleteRec, $or;
        }
        map {delete $DMARCrec{$_};} @deleteRec;
        $mail .= "</feedback>\n";
        my $filename = 'a' . Time::HiRes::time;
        my $msgid = "<$filename\@$myName>";
        if ($SPFLog >= 2 || $DebugSPF) {
            my $rfile = "$base/debug/dmarc_$filename".'.xml';
            if ($open->(my $f,">",$rfile)) {
                $f->binmode;
                $f->print($mail);
                $f->close;
                mlog(0,"info: DMARC-XML report stored in $rfile") if $MaintenanceLog;
            } else {
                mlog(0,"error: unable to write DMARC-XML report to file $rfile - $!");
            }
        }
        push @deletePol, $k;
        eval{require IO::Compress::Zip; 1;} or next;
        my $zmail;
        IO::Compress::Zip::zip(\$mail => \$zmail, Name => "$toDomain!$domain!$begin!$end.xml") or next;
        undef $mail;
        if ($size && length($zmail) > $size) {
            mlog(0,'info: skip DMARC report for domain $domain - report size is larger than policy restriction '.formatNumDataSize($size)) if $MaintenanceLog;
            next;
        }
        # multipart message - attach DMARC report as ZIP
        my @parts = (
            Email::MIME->create(
                attributes => {
                    disposition  => 'attachment',
                    filename     => "$toDomain!$domain!$begin!$end.zip",
                    content_type => 'application/x-zip-compressed',
                    encoding     => 'base64',
                    name         => "$toDomain!$domain!$begin!$end.zip",
                },
                body => $zmail,
            ),
            Email::MIME->create(
                attributes => {
                    content_type => 'text/plain',
                    encoding     => '7bit',
                    charset      => 'US-ASCII',
                },
                body_str => "This is an aggregate report from $toDomain .",
            ),
        );
        my $email = Email::MIME->create(
            header_str => [ From => $mailFrom,
                            To => $to,
                            Subject => "Report Domain: $domain Submitter: $toDomain Report-ID: <$report_id>",
                            'Message-ID' => $msgid
                          ],
            parts      => [ @parts ],
        );
        my $rfile = "$base/$resendmail/dmarc_$filename$maillogExt";
        if ($open->(my $f,">",$rfile)) {
            $f->binmode;
            $f->print($email->as_string);
            $f->close;
            mlog(0,"info: DMARC report message queued to sent to $to") if $MaintenanceLog;
            $nextResendMail = $nextResendMail < time + 3 ? $nextResendMail : time + 3;
        } else {
            mlog(0,"error: unable to write DMARC report message to file $rfile - $!");
        }

        if ($SPFLog >= 2 || $DebugSPF) {
            $rfile = "$base/debug/dmarc_$filename$maillogExt";
            if ($open->(my $f,">",$rfile)) {
                $f->binmode;
                $f->print($email->as_string);
                $f->close;
                mlog(0,"info: DMARC report message stored in $rfile") if $MaintenanceLog;
            } else {
                mlog(0,"error: unable to write DMARC report message to file $rfile - $!");
            }
        }
    }
    map {delete $DMARCpol{$_};} @deletePol;
    return;
}

sub DMARCSendForensic {
    my $fh = shift;
    my $this = $Con{$fh};
    my $report_id = Time::HiRes::time;
    my $size = $this->{dmarc}->{rufSize} || 0;
    my ($rcvdtime) = $this->{rcvd} =~ /;\s*([^;]+)\r\n$/os;
    my $dkimident;
    if (@{$this->{dmarc}->{DKIMdomains}}) {
        $dkimident = $this->{dmarc}->{dom} if grep(/^\Q$this->{dmarc}->{dom}\E$/,@{$this->{dmarc}->{DKIMdomains}});
    }
    $dkimident ||= 'none';
    my $mailFrom = $DMARCReportFrom;
    $mailFrom .= "\@$this->{dmarc}->{toDomain}" if $mailFrom !~ /\@/o;
    my $mail = <<EOT;
This is a spf/dkim forensic authentication-failure report for an email message received from IP $this->{dmarc}->{source_ip} on $rcvdtime.
Below is some detail information about this message:
 1. SPF-authenticated Identifiers: $this->{dmarc}->{mfd};
 2. SPF Mechanism Check Result: $this->{dmarc}->{auth_results}->{spf};
 3. DKIM-authenticated Identifiers: $dkimident;
 4. DMARC Mechanism Check Result: DMARC mechanism check $this->{dmarc}->{auth_results}->{dkim};

For more information please check Aggregate Reports or mail to $mailFrom .
Feedback-Type: auth-failure
User-Agent: ASSP/$version
Version: $MAINVERSION
Original-Mail-From: <$this->{mailfrom}>
Arrival-Date: $rcvdtime
Source-IP: $this->{dmarc}->{source_ip}
Reported-Domain: $this->{dmarc}->{toDomain}
Authentication-Results: $this->{dmarc}->{dom}; spf=$this->{dmarc}->{auth_results}->{spf} smtp.mailfrom=$this->{mailfrom}; dkim=$this->{dmarc}->{auth_results}->{dkim}
Delivery-Result: reject
EOT
    $mail =~ s/\r?\n/\r\n/go;
    $mail .= "\r\n\r\n" . $this->{header};
    my $filename = 'f' . Time::HiRes::time;
    my $msgid = "<$filename\@$myName>";
    if ($SPFLog >= 2 || $DebugSPF) {
        my $rfile = "$base/debug/dmarc_$filename".'.txt';
        if ($open->(my $f,">",$rfile)) {
            $f->binmode;
            $f->print($mail);
            $f->close;
            mlog(0,"info: DMARC-Forensic report stored in $rfile") if $MaintenanceLog;
        } else {
            mlog(0,"error: unable to write DMARC-Forensic report to file $rfile - $!");
        }
    }
    if ($size && length($mail) > $size) {
        mlog(0,'info: skip DMARC forensic report for domain $this->{dmarc}->{dom} - report size is larger than policy restriction '.formatNumDataSize($size)) if $MaintenanceLog;
        return;
    }

    my @parts = (
        Email::MIME->create(
            attributes => {
                content_type => 'text/plain',
                encoding     => '7bit',
                charset      => 'US-ASCII',
            },
            body_str => $mail,
        )
    );
    my $email = Email::MIME->create(
        header_str => [ From => $mailFrom,
                        To => $this->{dmarc}->{ruf},
                        Subject => "Report Domain: $this->{dmarc}->{domain} Submitter: $this->{dmarc}->{toDomain} Report-ID: <$report_id>",
                        'Message-ID' => $msgid
                      ],
        parts      => [ @parts ],
    );
    my $rfile = "$base/$resendmail/dmarc_$filename$maillogExt";
    if ($open->(my $f,">",$rfile)) {
        $f->binmode;
        $f->print($email->as_string);
        $f->close;
        mlog(0,"info: DMARC forensic report message queued to sent to $this->{dmarc}->{ruf}") if $MaintenanceLog;
        $nextResendMail = $nextResendMail < time + 3 ? $nextResendMail : time + 3;
    } else {
        mlog(0,"error: unable to write DMARC forensic report message to file $rfile - $!");
    }
    return;
}

sub getRRA {
    my $dom = shift;
    my @IP;
    my $type = 'A';
    eval {
        if (defined(${chr(ord($type)+23)}) && (my $res = queryDNS($dom ,$type))) {
            my @answer = map{$_->string} $res->answer;
            while (@answer) {
                push @IP, Net::DNS::RR->new(shift @answer)->rdatastr;
            }
        }
    };
    return @IP;
}

sub getRRData {
    my ($dom, $type) = @_;
    return getRRA($dom) if $type eq 'A';
    my $answer;
    my $RR;
    my $gotname;
    my $gottype;
    my $gotdata;
    eval {
      my $res = queryDNS($dom,$type);
      if ($res) {
          $answer = ($type ne 'PTR') ? join('', map{$_->string} $res->answer)
                                     : [$res->answer->string]->[0];
          $RR = Net::DNS::RR->new($answer);
          $gotname = $RR->name;
          $gottype = $RR->type;
          $gotdata = $RR->rdatastr;
          $gotdata =~ s/\\//go if (lc($type) eq 'txt');
      }
    };
    return if $@;
    return $gotdata || 0 if $type eq 'NS';
    return if $gotname ne $dom && $type ne 'PTR';
    return if $gottype ne $type;
    return unless $gotdata;
    return $gotdata;
}

sub queryDNS {
	my ($domain, $type) = @_;
    my $rslv = getDNSResolver();
    return unless $rslv;
    
	my ($resp,$E);
	eval
	{
        my $E;
        # set a timeout
        local $SIG{ALRM} = sub { die "DNS query timeout for $domain\n" };
        alarm $DNStimeout + 2;
        my $st = Time::HiRes::time();
        eval {$resp = $rslv->query($domain, $type);1;} or $E = $@."\n";
	    $ThreadIdleTime{$WorkerNumber} += Time::HiRes::time() - $st;
        alarm 0;
        die $E if $E;
        1;
	} or do {$E = $@; $DNSresolverTime{$WorkerNumber} = 0;$DNSresolver = undef;};
	alarm 0;
	return if $E;
	return $resp;
}

sub getRes {
    my $run = shift;
    eval(<<'EOT');
    $run.='_v'.(unpack("A1",${'X'})+2);
    $_[0]->$run(! $CanUseIOSocketINET6 || $forceDNSv4);
EOT
    return;
}

sub getDNSResolver {
    my $res;
    ThreadYield();
    $res = $DNSresolver;
    if (! $res || $DNSresolverTime{$WorkerNumber} < time) {
        my $class = shift;
        $class ||= 'Net::DNS::Resolver';
        $res = $orgNewDNSResolver->($class,
            nameservers => \@nameservers,
            tcp_timeout => $DNStimeout,
            udp_timeout => $DNStimeout,
            retrans     => $DNSretrans,
            retry       => $DNSretry,
            @_
        );
        getRes('force', $res);
        $DNSresolver = $res;
    }
    $DNSresolverTime{$WorkerNumber} = time + 1800 if $DNSresolver;
    return $res;
}

#verifies a DKIM-signed message
sub DKIMOK {
  my($fh,$message,$doBody)=@_;                  # returns: DKIMOK_Run
  my $retval = 1;
  $retval = 2 if ($Con{$fh}->{isDKIM});   # this is DKIM -> do not modify
  return $retval if !$DoDKIM;
  return DKIMOK_Run($fh,$message,$doBody);
}
sub DKIMOK_Run {
  my($fh,$message,$doBody)=@_;          # returns:
  my $this=$Con{$fh};                   #  0 = DKIM is failed -> this is SPAM
  d('DKIMOK');                          #  1 = no DKIM - check
  my $tlit;                             #  2 = DKIM check is OK (pass) -> do not modify the mail
  my $result;
  $fh = 0 if "$fh" =~ /^\d+$/o;
  my $retval = 1;
  my $dkim;
  my $ip = $this->{ip};
  $ip = $this->{cip} if $this->{ispip} && $this->{cip};
  $retval = 2 if ($this->{isDKIM});   # this is DKIM -> do not modify
  return $retval if (! $DoStrictDKIM && $this->{dkimverified});
  return $retval if ($this->{dkimresult} && $this->{dkimresult} ne 'pass');
  $this->{dkimverified} = "not verified";
  return $retval if !$CanUseDKIM;
  skipCheck($this,'wl','np','ro','rw','co','nodkim','MSGIDsigRemoved') && return $retval;
  return 1 if $this->{isbounce};
  return $retval if (&matchSL($this->{mailfrom},'noDKIMAddresses'));
  return $retval if &matchIP($ip,'noDKIMIP',$fh,0);

  $tlit = &tlit($DoDKIM);
  $this->{prepend}='';
  my $detail;
  my $dkimpolicy_a;
  my $dkimwhy_a;
  my $dkimpolicy_s;
  my $dkimwhy_s;

  &sigoff(__LINE__);
  eval { $Mail::DKIM::DNS::RESOLVER = getDNSResolver(); };
  $dkim = Mail::DKIM::Verifier->new();
  eval {
      for my $msgLine (split(/\n/o, $$message))
      {
          $msgLine =~ s/^\.([^\015]+\015)$/$1/o;
          $dkim->PRINT("$msgLine\n") if ($msgLine !~ /^\.[\015]?$/o);
      }
      $dkim->CLOSE;
      $this->{dkimresult} = $result = $dkim->result;
      $detail = $dkim->result_detail;
      $dkimpolicy_a  = $dkim->fetch_author_policy;
      $dkimwhy_a     = $dkimpolicy_a->apply($dkim);
      $dkimpolicy_s  = $dkim->fetch_sender_policy;
      $dkimwhy_s     = $dkimpolicy_s->apply($dkim);
  };
  my $except = $@;
  &sigon(__LINE__);
  $this->{dkimverified} = "verified-OK";
  if ($except) {
      $this->{dkimverified} = $result = $except;
      mlog($fh,"warning: DKIM returned '$except'");
      return $retval;
  }

  if ( ($detail =~ /fail.+?body.+?altered/io)    &&
       ($dkimwhy_a eq "neutral" || $dkimwhy_a eq "accept") &&
       ($dkimwhy_s eq "neutral" || $dkimwhy_s eq "accept") &&
       (! $DoStrictDKIM || ! $doBody)) {
       $this->{dkimresult} = $result = "pass";
       $this->{dkimverified} = "body altered - header passed - suspicious-OK";
       if (! $doBody) {
           $this->{dkimverified} = "verified-OK";
           $detail = 'header-passed';
       }
  }

  if ($this->{myheader} =~ s/X-Original-Authentication-Results:($HeaderValueRe)//ois) {
      my $val = $1;
      headerUnwrap($val);
      $val =~ s/\r|\n//go;
      $val =~ s/ dkim=\S+//o;
      $val .= " dkim=$result";
      $this->{myheader} .= "X-Original-Authentication-Results:$val\r\n";
  } else {
      $this->{myheader} .= "X-Original-Authentication-Results: $myName; dkim=$result\r\n";
  }
  
  if (($result eq "fail" || ($result eq "none" && $this->{isDKIM})) && ! $dkimpolicy_a->testing) {
    $this->{prepend}="[DKIM]";
    mlog($fh,"$tlit DKIM signature failed - $detail - sender policy is: $dkimwhy_s - author policy is: $dkimwhy_a") if $ValidateSenderLog && $DoDKIM==3 || $DoDKIM==2;
    pbWhiteDelete($fh,$this->{ip});
    $this->{dkimverified} = "failed";
    return $retval if $DoDKIM==2;
    $this->{messagereason}="DKIM $result";
    pbAdd($fh,$this->{ip},'dkimValencePB','DKIMfailed');
    delayWhiteExpire($fh);
    return $retval if $DoDKIM==3;
    return 0;
  }
  if ($result eq "pass") {
    mlog($fh,"$tlit DKIM signature $this->{dkimverified} - $detail - sender policy is: $dkimwhy_s - author policy is: $dkimwhy_a") if $ValidateSenderLog && $DoDKIM>=2;
    $this->{rwlok}=1;
    $this->{messagereason}="DKIM $result";
    pbAdd($fh,$this->{ip},'dkimOkValencePB','DKIMpass', 1);
    my $mf =lc $this->{mailfrom};
    my $domain;
    $domain = $1 if $mf=~/\@([^@]*)/o;
    DKIMCacheAdd($domain);     # DKIM is pass => all further mails should have a DKIM-Sig
    return 2;
  }

  if ($result eq "none") {
    mlog($fh,"$tlit (DKIM signature not found)") if $ValidateSenderLog && $DoDKIM>=2;
    $this->{dkimverified} = "no-signature";
    return 1;
  }

  if ($result eq "invalid") {
    mlog($fh,"$tlit (DKIM signature invalid) - " . $dkim->{signature_reject_reason} ) if $ValidateSenderLog && $DoDKIM>=2;
    $this->{dkimverified} = "invalid-signature";
    return $retval;
  }
  if ($dkimpolicy_a->testing) {
    mlog($fh,"$tlit DKIM signature failed - but DKIM test policy - $detail - sender policy is: $dkimwhy_s - author policy is: $dkimwhy_a") if $ValidateSenderLog && $DoDKIM==3 || $DoDKIM==2;
  }
  return $retval;
}

sub DKIMgen {
    my $fh = shift;
    return unless $CanUseDKIM;
    return unless $genDKIM;
    return unless $Con{$fh}->{relayok};
    return if $Con{$fh}->{DKIMadded};
    return DKIMgen_Run($fh);
}
sub DKIMgen_Run {
    my $fh = shift;
    my $this = $Con{$fh};
    my $domain;
    my $dkim;
    my $signature;
    my $sigobj;
    my $headlen;
    my $numSelectors;
    my $Selector;
    our %DKIM;
    my @Headers;
    my $mode = 'DKIM';
    my $policyfn;
    
    d('DKIMgen');
    return unless $CanUseDKIM;
    return unless $genDKIM;
    return unless $this->{relayok};
    return if $this->{DKIMadded};

    while ($this->{header} =~ /($HeaderNameRe):($HeaderValueRe)/igos) {

        next if lc($1) ne 'from';
        my $s = $2;
        &headerUnwrap($s);
        if ($s =~ /$EmailAdrRe\@($EmailDomainRe)/io) {
            $domain = $1;
            last;
        }
    }

    ($domain) = $this->{mailfrom} =~ /^[^@]+\@([^@]+)$/o unless $domain;
    return unless $domain;
    $domain = lc($domain);
    return unless exists $DKIMInfo{$domain};
    
    $numSelectors = scalar(keys %{$DKIMInfo{$domain}});
    return unless $numSelectors;

    my $sel = int(rand($numSelectors));
    
    my $i = 0;
    foreach my $s (keys %{$DKIMInfo{$domain}}) {
        $Selector = $s;
        last if($i == $sel);
        $i++;
    }

    $DKIM{Selector} = $Selector;
    $DKIM{Domain} = $domain;
    mlog(0,"DKIM: Selector = $Selector") if $DKIMlogging == 3 or $debug or $ThreadDebug;
    mlog(0,"DKIM: Domain = $domain") if $DKIMlogging == 3 or $debug or $ThreadDebug;

    while ( my ($k,$v) = each %{$DKIMInfo{$domain}->{$Selector}}) {
        mlog(0,"DKIM: $k = $v") if $DKIMlogging == 3 or $debug or $ThreadDebug;
        if (lc $k eq 'mode') {
            $mode = $v;
            $mode = 'DKIM' if (uc $mode eq 'DKIM');
            $mode = 'Domainkey' if (uc $mode eq 'DOMAINKEY');
            next;
        }
        $DKIM{$k} = $v;
    }
    eval { $Mail::DKIM::DNS::RESOLVER = getDNSResolver(); };

    if ($mode eq 'Domainkey') {
        $policyfn =
            sub {
                my $dkimp = shift;
                $dkimp->add_signature(Mail::DKIM::DkSignature->new(%main::DKIM));
                return 1;
            };
    } else {
        $policyfn =
            sub {
                my $dkimp = shift;
                $dkimp->add_signature(Mail::DKIM::Signature->new(%main::DKIM));
                return 1;
            };
    }

    $DKIM{Policy} = $policyfn;

    eval{$dkim = Mail::DKIM::Signer->new(%DKIM);};
    if(! $dkim ) {
        mlog($fh,"error: DKIM primary signer object failed - $@") if $DKIMlogging;
        return;
    }

    $this->{header} =~ s/\015?\012\.[\015\012]*$/\015\012\.\015\012/o;

    if($DKIMconvHTML2base64 && $this->{header}=~ /\015\012\Content-Type:\s*text\/(?:ht|x)ml/sio) {
        my $converted = 0;
        $o_EMM_pm = 1;
        eval {   # HTML message hack (eg. MSOL2007)- convert any text/html content to base64
            my @newparts;
            $Email::MIME::ContentType::STRICT_PARAMS=0;      # no output about invalid CT
            my $email = Email::MIME->new($this->{header});
            foreach my $part ( $email->parts ) {
              if ($part->parts > 1) {
                $part->walk_parts(sub {
                my ($subpart) = @_;
                if ($subpart->header("Content-Type")=~/text\/(?:ht|x)ml/io &&
                    $subpart->header("Content-Transfer-Encoding")!~/base64/io)
                {
                    $subpart->encoding_set('base64');
                    $converted = 1;
                }
                });
              } else {
                if ($part->header("Content-Type")=~/text\/(?:ht|x)ml/io &&
                    $part->header("Content-Transfer-Encoding")!~/base64/io)
                {
                    $part->encoding_set('base64');
                    $converted = 1;
                }
              }
              push @newparts, $part;
            }
            if ($converted) {
                $email->header_set('MIME-Version', '1.0') if !$email->header('MIME-Version');
                $email->parts_set(\@newparts);
                $this->{header} = $email->as_string;
            }
            undef @newparts;
            undef $email;
        };
        $o_EMM_pm = 0;
        if ($@) {
            mlog($fh,"warning: HTML message could not be encoded to base64 - DKIM signature may fail - $@");
        } elsif ($converted) {
            mlog($fh,"info: HTML message encoded for DKIM to base64") if $DKIMLog >= 2;
        }
        $this->{header} =~ s/\x0D([^\x0A])/\x0D\x0A$1/go;
        $this->{header} =~ s/([^\x0D])\x0A/$1\x0D\x0A/go;   # make LF CR RFC conform
        $this->{header} .= "\x0D\x0A.\x0D\x0A" if ($this->{header} !~ /\x0D\x0A\.\x0D\x0A$/o);
    }

    eval{
     for my $msgLine (split(/\n/o, $this->{header})) {
         $msgLine =~ s/^\.([^\015]+\015)$/$1/o;
         $dkim->PRINT("$msgLine\n") if ($msgLine !~ /^\.\015$/o);
     }
     $dkim->CLOSE;
    };
    if( $@ ) {
        mlog($fh,"error: $mode message parsing failed - $@") if $DKIMlogging;
        return;
    }
    eval{ $sigobj = $dkim->signature;};
    if(! $sigobj ) {
         my $result = $dkim->result;
         my $result_detail = $dkim->result_detail;
         my $attr = join(", ", $dkim->message_attributes);
         mlog($fh,"error: $mode get signature object failed - $@ - $result - $result_detail - $attr") if $DKIMlogging;
         return;
    }
    eval{ $signature = $sigobj->as_string;};
    if(! $signature ) {
         my $result = $dkim->result;
         my $result_detail = $dkim->result_detail;
         my $attr = join(", ", $dkim->message_attributes);
         mlog($fh,"error: $mode get signature failed - $@ - $result - $result_detail - $attr") if $DKIMlogging;
         return;
    }
    d($signature);
    $signature =~ s/([^\015][^\012])$/$1\015\012/o;
    $this->{header} = &headerWrap($signature) . $this->{header};
    mlog($fh,"info: successful added $mode-Signature") if($DKIMlogging >= 2);
    $this->{DKIMadded} = 1;

    if ($DKIMlogging > 2) {
        my $dkim = Mail::DKIM::Verifier->new();
        for my $msgLine (split(/\n/o, $this->{header}))
        {
           $msgLine =~ s/^\.([^\015]+\015)$/$1/o;
           $dkim->PRINT("$msgLine\n") if ($msgLine !~ /^\.\015$/o);
        }
        $dkim->CLOSE;
        my $result = $dkim->result;
        my $detail = $dkim->result_detail;
        my $dkimpolicy_a  = $dkim->fetch_author_policy;
        my $dkimwhy_a     = $dkimpolicy_a->apply($dkim);
        my $dkimpolicy_s  = $dkim->fetch_sender_policy;
        my $dkimwhy_s     = $dkimpolicy_s->apply($dkim);

        mlog($fh,"DKIM: self signature check: result: $result - detail: $detail");
    }
    return;
}

sub configUpdateDKIMConf {
    my ( $name, $old, $new, $init ) = @_;

    my $file = $new;
    $file =~ /^\s*file:\s*(.+)\s*$/oi;
    $file = "$base/$1";
    my $f;
    my $domain;
    my $selector;
    my @domains;
    my %dkim = ();
    ${$name} = $new unless $WorkerNumber;

    return unless &fileUpdated($file, $name);

    my $mtime = ftime($file);
    $FileUpdate{"$file$name"} = $mtime if $mtime;

    return unless ( open $f,'<', "$file" );
    while (<$f>) {
        next if /^\s*#/o;
        if (/^\s*<([^\/]+)>/o) {
            $selector = $1 if(! $selector && $domain);
            $domain = lc($1) unless ($domain);
        } elsif ( $selector && /^\s*<\/$selector>/i ) {
            $selector = '';
        } elsif ( $domain && /^\s*<\/$domain>/i ) {
            $domain = '';
            $selector = '';
        } elsif ($selector) {
            my ($key,$value) = split(/=/o,$_);
            $key =~ s/^\s*//o;
            $key =~ s/\s*$//o;
            $value =~ s/\s*$//go;
            $value =~ s/^\s*//go;
            next unless $key;
            next unless $value;
            $dkim{$domain}->{$selector}{$key} = $value;
        }
    }
    close $f;
    my ($h,$d) = &DKIMcfgvalid(%dkim);
    @domains = ();
    @domains = @{$d};
    %DKIMInfo = ();
    %DKIMInfo = %{$h};
    push @domains, " - no entries found !!!" unless @domains;
    my $tlit = $init ? '' : 'AdminUpdate: ';
    mlog(0,$tlit."DKIM configuration (re)loaded from file $file for domain(s):@domains") if $WorkerNumber == 0 && $WorkerName ne 'startup';
}

sub DKIMcfgvalid {
    my %dkim = @_;
    my @domains;

    foreach my $domain (keys %dkim) {
        if ($domain !~ /($EmailDomainRe)/o) {
            mlog(0,"warning: DKIM-cfg - $domain is not a valid domain name - entry ignored") if $WorkerNumber == 0;
            delete $dkim{$domain};
            next;
        }
        foreach my $selector (keys %{$dkim{$domain}} ) {
            if ($selector !~ /^[a-zA-Z0-9_\-\.]+$/o) {
                mlog(0,"warning: DKIM-cfg - $selector for $domain is not a valid selector name - entry ignored") if $WorkerNumber == 0;
                delete $dkim{$domain}->{$selector};
                next;
            }
            if (! -e $dkim{$domain}->{$selector}{KeyFile}) {
                if ($dkim{$domain}->{$selector}{KeyFile}) {
                    mlog(0,"warning: DKIM-cfg - private key (KeyFile) $dkim{$domain}->{$selector}{KeyFile} in $selector for $domain not found - entry ignored") if $WorkerNumber == 0;
                    delete $dkim{$domain}->{$selector};
                    next;
                } else {
                    mlog(0,"warning: DKIM-cfg - private key (KeyFile) in $selector for $domain is not defined - entry ignored") if $WorkerNumber == 0;
                    delete $dkim{$domain}->{$selector};
                    next;
                }
            } else {
                my $key;
                eval{$key = Mail::DKIM::PrivateKey->load(File => $dkim{$domain}->{$selector}{KeyFile});};
                if ($@) {
                    mlog(0,"warning: DKIM-cfg - unable to load private key (KeyFile) $dkim{$domain}->{$selector}{KeyFile} in $selector for $domain - entry ignored - $@") if $WorkerNumber == 0;
                    delete $dkim{$domain}->{$selector};
                    next;
                }
            }
        }
        if (scalar(keys %{$dkim{$domain}})) {
            push @domains," $domain";
        } else {
            mlog(0,"warning: DKIM-cfg - no selectors for domain $domain left - entry ignored") if $WorkerNumber == 0;
            delete $dkim{$domain};
            next;
        }
    }
    return \%dkim,\@domains;
}

sub ipNetwork {
    my ($ip,$netblock)=@_;
    if ($ip =~ /:[^:]*:/o) {
        return ipv6expand($ip) if (!$netblock);
        $netblock = 64 if $netblock == 1;
        return join ':', map{my $t = sprintf("%x", oct("0b$_"));$t;} unpack 'a16' x 8, ipv6binary($ip,$netblock) . '0' x (128 - $netblock);
    } else {
        return $ip if (!$netblock);
        $netblock = 24 if $netblock == 1;
        my $u32 = unpack 'N', pack 'CCCC', split /\./o, $ip;
        my $mask = unpack 'N', pack 'B*', '1' x $netblock . '0' x (32 - $netblock );
        return join '.', unpack 'CCCC', pack 'N', $u32 & $mask;
    }
}

# retriev the trailing IPv4 address from a tunneled IPv6address
sub ipv6TOipv4 {
    my $ip = shift;
    $ip =~ s/^.*?($IPv4Re)$/$1/o;
    return $ip;
}

# converts IPv4 112.23.45.16 to 7017:2d10
sub ipv4TOipv6 {
    my $ip = shift;
    $ip =~ s/0?x?([A-F][A-F0-9]?|[A-F0-9]?[A-F])/hex($1)/goie;
   
    my ($h1,$h2,$h3,$h4) = split(/\./o,$ip);
    return sprintf("%x",256 * $h1 + $h2).':'.sprintf("%x",256 * $h3 + $h4);
}

# convert IPv6 2001:123:456::1 to 2001:123:456:0:0:0:0:1
# and convert trailing IPv4 to two IPv6 words
sub ipv6expand {
    my $ip = shift;
    return $ip if ($ip !~ /:/o);
    $ip =~ s/($IPv4Re)$/ipv4TOipv6($1)/eo;
    return $ip if ($ip !~ /::/o);
    my $col = $ip =~ tr/://;
    $col = 8 if $col > 8;
    $ip =~ s/^(.*)::(.*)$/($1||'0').':'.('0:'x(8-$col)).($2||'0')/oe;
    return $ip;
}

# Replace longest run of null blocks with a double colon
sub ipv6compress {
    my $ip = shift;
    if (my @runs = $ip =~ /((?:(?:^|:)(?:0{1,4}))+:?)/g ) {
        my $max = $runs[0];
        for (@runs[1..$#runs]) {
            $max = $_ if length($max) < length;
        }
        $ip =~ s/$max/::/;
    }
    $ip =~ s/:0{1,3}/:/g;
    $ip =~ s/::+/::/o;
    return $ip;
}
# convert IPv6 address to binary string
sub ipv6binary {
    my ($ip, $bits) = @_;
    return pack("a$bits", unpack 'B128', pack 'n8', map{my $t = hex($_);$t;} split(/:/o, ipv6expand($ip)));
}

# convert IPv6 2001:123:456::1 to 2001:0123:0456:0000:0000:0000:0000:0001
sub ipv6fullexp {
    return sprintf('%04s:'x(unpack("A1",${'X'})+5).'%04s',split(/:/o,ipv6expand(shift)));
}

# convert IPv6 to lower case reverse doted digits for RBL / RWL checks
# 2001:DB8:abc:123::42 to
# 2.4.0.0.0.0.0.0.0.0.0.0.0.0.0.0.3.2.1.0.c.b.a.0.8.b.d.0.1.0.0.2
sub ipv6hexrev {
    local $_ = ipv6fullexp(shift);
    return join('.',split(//o, reverse $_)) unless(s z:zzg-((ord(":")*4+34)%($_[0]+1)));
    undef;
}

sub formatTimeInterval {
  my $interval=shift;
  my $res;
  $res.=$_.'d ' if local $_=int($interval/(24*3600)); $interval%=(24*3600);
  $res.=$_.'h ' if $_=int($interval/3600); $interval%=3600;
  $res.=$_.'m ' if $_=int($interval/60); $interval%=60;
  $res.=$interval.'s ' if ($interval || !defined $res);
  $res=~s/\s$//o;
  return $res;
}

sub FromStrictOK {
    my $fh = shift;
    return 1 if ! $DoNoFrom;
    return FromStrictOK_Run($fh);
}
sub FromStrictOK_Run {
    my $fh = shift;
    my $this = $Con{$fh};
    d('FromStrictOK');

    return 1 if $this->{FromStrictOK};
    $this->{FromStrictOK} = 1;
    my $ip = $this->{ip};
    $ip = $this->{cip} if $this->{ispip} && $this->{cip};
    return 1 if !$this->{mailfrom};
    skipCheck($this,'sb','ro','aa') && return 1;
    return 1 if $ip =~ /$IPprivate/o;
    return 1 if $this->{whitelisted} && !$DoNoFromWL;
    return 1 if $this->{noprocessing} && !$DoNoFromNP;
    return 1 if $this->{mailfrom} =~ /news/io;

    my $tlit = tlit($DoNoFrom);

    if ( $this->{header} !~ /(?:^|\n)from:\s*([^\n]+)/ios ) {
        $this->{prepend}       = '[FromMissing]';
        $this->{messagereason} = 'From missing';
        mlog( $fh, "$tlit ($this->{messagereason})" ) if $DoNoFrom >= 2;
        return 1 if $DoNoFrom == 2;
        pbAdd( $fh, $this->{ip}, 'nofromValencePB', 'From-missing' );

        return 1 if $DoNoFrom == 3;
        return 0;
    }
    return 1;
}

sub IPinHeloOK {
    my $fh = shift;
    return 1 if !$DoIPinHelo;
    return IPinHeloOK_Run($fh);
}
sub IPinHeloOK_Run {
    my $fh = shift;
    my $this = $Con{$fh};
    $fh = 0 if "$fh" =~ /^\d+$/o;
    my $ip = $this->{ip};
    my $helo = $this->{helo};

    $ip = $this->{cip} if $this->{ispip} && $this->{cip};
    $helo = $this->{ciphelo} if $this->{ciphelo};
    d('IPinHeloOK');

    return 1 if $this->{IPinHeloOK};
    $this->{IPinHeloOK} = 1;
    return 1 if $helo eq $ip;
    skipCheck($this,'ro','aa','ispcip') && return 1;
    return 1 if $DoFakedWL && &Whitelist($this->{mailfrom});
    return 1 if ( matchIP( $ip, 'noHelo', $fh ,0) );

    return 1 if $ip =~ /$IPprivate/o;
    return 1 if $heloBlacklistIgnore && $helo =~ /$HBIRE/;
    return 1 if $DoFakedNP && matchSL( $this->{mailfrom}, 'noProcessing' );

    my $tlit = tlit($DoIPinHelo);
    my @variants;

    if ( $helo =~ /\[?(?:(?:$IPSectRe(?:\.|\-)){3}$IPSectRe|(?:$IPSectHexRe(?:\.|\-)){3}$IPSectHexRe|$IPv6LikeRe)\]?/o ) {
        pos($helo) = 0;
        while ($helo =~ /\[?((?:$IPSectRe(?:\.|\-)){3}$IPSectRe|(?:$IPSectHexRe(?:\.|\-)){3}$IPSectHexRe|($IPv6LikeRe))\]?/og) {
            my $literal = $1;
            my $isV6 = $2;
            my $sep;
            # replace any - characters with a dot or :
            if ($isV6) {
                $literal =~ s/\-/\:/go;
                $literal = ipv6expand($literal);
                $sep = ':';
            } else {
                $literal =~ s/\-/\./go;
                $literal =~ s/0x([a-fA-F0-9]{1,2})/hex($1)/goe;
                $literal =~ s/([A-F][A-F0-9]?|[A-F0-9]?[A-F])/hex($1)/gioe;
                $sep = '.';
            }

            # remove leading zeros and put it into an array
            my @octets = map {
                if ( !m/^0$/io ) {my $t = $_; $t =~ s/^0*//o; $t }
                else             { 0 }    # properly handle a 0 in the IP
            } split( /\.|\:/o, $literal );

            #put the ip back together
            push @variants, (join $sep, @octets);
            push @variants, (join $sep, reverse(@octets));
        }

        return 1 unless scalar @variants;
        d("saw IP in HELO: @variants");
        my $mr = $this->{messagereason} = "Suspicious HELO - contains IP: '$helo'";
        $this->{prepend} = "[SuspiciousHelo]";

        pbAdd( $fh, $ip, 'fiphValencePB', 'IPinHELO' ) if $DoIPinHelo != 2;
        mlog( $fh, "$tlit ($this->{messagereason})", 1 ) if $ValidateSenderLog;
        if ( ! grep(/^\Q$ip\E$/i,@variants) ) {
            $this->{messagereason} = "IP in HELO '$helo' does not match IP in connection '$ip' ";
            $mr .= " - and IP in HELO '$helo' does not match IP in connection '$ip' ";
            pbAdd( $fh, $ip, 'fiphmValencePB', 'IPinHELOmismatch' ) if $DoIPinHelo != 2;
            mlog( $fh, "$tlit ($this->{messagereason})", 1 ) if $ValidateSenderLog;
        }
        $this->{messagereason} = $mr unless $fh;
        $this->{prepend} = '';
        return 0;
    }

    #the if didn't hit
    return 1;
}


sub ForgedHeloOK {
  my($fh,$rcpt)=@_;
  return 1 if ! $DoFakedLocalHelo;
  return ForgedHeloOK_Run($fh,$rcpt);
}
sub ForgedHeloOK_Run {
  my($fh,$rcpt)=@_;
  my $this=$Con{$fh};
  d('ForgedHeloOK');
  my $tlit;
  return 1 if $this->{forgedhelodone};
  $this->{forgedhelodone}=1;
  skipCheck($this,'ro','aa','nohelo','ispcip') && return 1;
  return 1 if $DoFakedWL && &Whitelist($this->{mailfrom});
  return 1 if ($noProcessing && $DoFakedNP && $this->{mailfrom}=~/$NPREL/ );

  my $helo = $this->{ciphelo} ? $this->{ciphelo}: $this->{helo};
  return 1 if $heloBlacklistIgnore && $helo =~ /$HBIRE/;
  my $ip = $this->{ip};
  $ip = $this->{cip} if $this->{ispip} && $this->{cip};

  $tlit=&tlit($DoFakedLocalHelo);

  (my $literal)=$helo=~/\[?($IPRe)\]?/o; # domain literal

  if ($localDomains && $helo =~ /$LDRE/ ||
      lc($helo) eq 'friend' ||
      lc($helo) eq 'localhost' ||
      $localhostname && lc($helo) eq lc($localhostname) ||
      $myServerRe && $helo =~ /$LHNRE/ ||
      $literal && $myServerRe && $literal =~ /$LHNRE/ ||
      $literal && lc($literal) eq lc($localhostip))
  {

   	$this->{prepend}='[ForgedHELO]' ;
  	$this->{prepend}.="$tlit" if $DoFakedLocalHelo>=2;
  	$this->{messagereason}="forged Helo: '$helo'";
	mlog($fh,"$tlit ($this->{messagereason})") if $ValidateSenderLog;
    delayWhiteExpire($fh);
    pbWhiteDelete($fh,$ip);
    return 1 if  $DoFakedLocalHelo==2;
    pbWhiteDelete($fh,$ip);

    pbAdd($fh,$ip,'fhValencePB','ForgedHELO');
    return 1 if  $DoFakedLocalHelo==3;
    $Stats{forgedHelo}++;
    return 0;
  }
  return 1;
}

sub LocalAddressOK {
    my $fh = shift;
    my $this = $Con{$fh};
    d('LocalAddressOK');
    $this->{islocalmailaddress} = 0;
    
    if (($this->{relayok} and &batv_remove_tag(0,$this->{mailfrom},'') =~ /$BSRE/) or  # a bounce mail from a internal MTA
         &localmailaddress($fh,$this->{mailfrom})) {

        $this->{islocalmailaddress} = 1;
    }
    return $this->{islocalmailaddress};
}

# check spoofing
sub NoSpoofingOK {
    my ( $fh, $what ) = @_;
    my $this = $Con{$fh};
    d("NoSpoofingOK - $what");
    return 1 if $this->{NoSpoofingOK}{$what};
    $this->{NoSpoofingOK}{$what} = 1;
    return 1 if ! $DoNoSpoofing;
    skipCheck($this,'sb','np','ro','aa') && return 1;
    return 1 if ! $this->{$what};
    return 1 if $this->{$what} =~ /$BSRE/;

    return 1 if ! localmail( $this->{$what} ) || $LDAPoffline;

    return 1 if $onlySpoofingCheckIP && ! matchIP( $this->{ip}, 'onlySpoofingCheckIP', 0, 1);

    return 1 if matchIP( $this->{ip}, 'noSpoofingCheckIP', 0, 1 );

    return 1 if $onlySpoofingCheckDomain && ! matchSL( $this->{$what}, 'onlySpoofingCheckDomain' , 0, 1);

    return 1 if matchSL( $this->{$what}, 'noSpoofingCheckDomain' );

    my $tlit = tlit($DoNoSpoofing);
    my $toscore = 0;
    foreach (keys %{$this->{NoSpoofingOK}}) { $toscore += $this->{NoSpoofingOK}{$_}; }
    $this->{prepend}       = '[SpoofedSender]';
    $this->{messagereason} = "No Spoofing Allowed '$this->{$what}' in '$what'";
    mlog( $fh, "$tlit ($this->{messagereason})" )
           if $ValidateSenderLog && $DoNoSpoofing >= 2;

    return 1 if $DoNoSpoofing == 2 ;
    pbAdd( $fh, $this->{ip}, 'flValencePB', 'NoSpoofing' ) if $toscore < 10;
    $this->{NoSpoofingOK}{$what} = 10;
    return 1 if $DoNoSpoofing == 3 ;
    return 0;
}

# do forged local sender
sub LocalSenderOK {
    my ( $fh, $ip ) = @_;
    return 1 if ! $DoNoValidLocalSender;
    return 1 if ! $LocalAddresses_Flat && ! $DoLDAP && (! $DoVRFY || (! scalar(keys %DomainVRFYMTA) && ! scalar(keys %FlatVRFYMTA)));
    return LocalSenderOK_Run($fh, $ip);
}
sub LocalSenderOK_Run {
    my ( $fh, $ip ) = @_;

    my $this = $Con{$fh};
    d('LocalSenderOK');
    my $tlit;
    return 1 if $this->{localsenderdone};
    $this->{localsenderdone} = 1;
    skipCheck($this,'sb','np','ro','ispip','aa') && return 1;

    return 1 if ! localmail( $this->{mailfrom} );
    
    #enforce valid local mailfrom

    my $mf = &batv_remove_tag(0,$this->{mailfrom},'');

    $tlit = &tlit($DoNoValidLocalSender);

    $this->{islocalmailaddress} = 0;

  if(matchSL($mf,'LocalAddresses_Flat') ) {
    $this->{islocalmailaddress} = 1;
  } else {
# Need another check?

# check sender against LDAP or VRFY ?
      $this->{islocalmailaddress} = &localmailaddress($fh,$mf)
          if (($DoLDAP && $CanUseLDAP) or
              ($CanUseNetSMTP && $DoVRFY &&
               $mf =~ /^([^@]*@)([^@]*)$/o &&
               (&matchHashKey('DomainVRFYMTA',lc $2) or &matchHashKey('FlatVRFYMTA',lc "\@$2"))));
  }
  if (!$this->{islocalmailaddress}) {
    $this->{prepend} = "[UnknownLocalSender]";
    mlog($fh,"$tlit (Invalid Local Sender '$mf')") if $ValidateSenderLog && ($DoNoValidLocalSender==3 || $DoNoValidLocalSender==2);
    return 1 if ($DoNoValidLocalSender==2);
    delayWhiteExpire($fh);
    pbWhiteDelete($fh,$this->{ip});
    pbAdd($fh,$this->{ip},'flValencePB','InvalidLocalSender',$DoNoValidLocalSender);
    return 1 if  $DoNoValidLocalSender==3;
    return 0;
  }
  return 1;
}

sub AUTHErrorsOK {
    my $fh = shift;
    return 1 unless $MaxAUTHErrors;
    return AUTHErrorsOK_Run($fh);
}
sub AUTHErrorsOK_Run {
    my $fh = shift;
    my $this = $Con{$fh};
    skipCheck($this,'ro','wl','nbip','ispip') && return 1;
    return 1 if ($this->{noprocessing} & 1);
    return 1 if matchIP($this->{ip},'noMaxAUTHErrorIPs',0,0);
    return 1 if matchIP($this->{ip},'noBlockingIPs', 0, 1);
    my $ip = &ipNetwork( $this->{ip}, 1);
    
    return 1 if ++$AUTHErrors{$ip} <= $MaxAUTHErrors;
    $this->{messagereason}="too much AUTH errors from $ip";
    pbAdd( $fh, $this->{ip}, 'autValencePB', 'AUTHErrors' ) if ! matchIP($ip,'noPB',0,1);
    $AUTHErrors{$ip}++;
    return 0;
}

sub subjectFrequencyOK {
    my $fh = shift;
    return 1 unless $DoSameSubject;
    return 1 unless $subjectFrequencyInt;
    return 1 unless $subjectFrequencyNumSubj;
    return subjectFrequencyOK_Run($fh);
}
sub subjectFrequencyOK_Run {
    my $fh = shift;
    my $this=$Con{$fh};
    d('subjectFrequency');

    return 1 unless $this->{subject3};
    skipCheck($this,'ro','wl','np','co','nbip','ispip') && return 1;
    my $mf = &batv_remove_tag(0,$this->{mailfrom},'');
    my $ip = $this->{ip};
    $ip = $this->{cip} if $this->{ispip} && $this->{cip};
    return 1 if ($subjectFrequencyOnly && ! &matchSL($mf,'subjectFrequencyOnly'));
    return 1 if (&matchSL($mf,'NoSubjectFrequency'));
    return 1 if (&matchIP($ip,'NoSubjectFrequencyIP',$fh, 1));

    my $sub = lc($this->{subject3});
    $sub = eval{&ASSP_WordStem::process($sub) if ($CanUseASSP_WordStem);} || $sub;
    @HmmBayWords = ();
    my @subWords;
    while ($sub =~ /([$BayesCont]{2,})/go) {
        my @Words;
        (@Words = BayesWordClean($1)) or next;
        push @subWords,@Words;
    }
    push @subWords,$sub unless @subWords;
    $sub = join(' ',@subWords);
    my $subjcount;

    my $time = Time::HiRes::time;
    my $data;

    my %F = split(/ /o,$subjectFrequencyCache{$sub});
    my %ips;
    $ips{$ip} = 1;
    foreach (sort keys %F) {
        if ($_ + $subjectFrequencyInt  < $time) {
            delete $F{$_};
            next;
        } else {
            $subjcount++;
            $ips{$F{$_}}++;
        }
    }
    foreach (sort keys %F) {
        $data .= "$_ $F{$_} ";
    }
    $subjectFrequencyCache{$sub} = $data . "$time $ip";
    $subjcount++;
    return 1 if $subjcount < $subjectFrequencyNumSubj;

    my $tlit = &tlit($DoSameSubject);
    $tlit = '[testmode]'  if $allTestMode && $DoSameSubject == 1 || $DoSameSubject == 4;
    my $DoSameSubject = $DoSameSubject;
    $DoSameSubject = 3 if $allTestMode && $DoSameSubject == 1 || $DoSameSubject == 4;

    $this->{prepend} = "[SameSubject]";
    $this->{messagereason} = "passed limit($subjectFrequencyNumSubj) of same subjects in $subjectFrequencyInt seconds";

    mlog( $fh, "$tlit $this->{messagereason}") if $SessionLog;

    pbAdd( $fh, $ip, 'isValencePB', 'LimitingSameSubject' ) if $DoSameSubject != 2;
    if ( $DoSameSubject == 1 ) {
        $Stats{smtpSameSubject}++;
        unless (($send250OKISP && $this->{ispip}) || $send250OK) {
            seterror( $fh, "554 5.7.1 too many mails with same subject", 1 );
            return 0;
        }
    }

    return 1;
}

sub DomainIPOK {
    my $fh = shift;
    return 1 if ! $DoDomainIP;
    return DomainIPOK_Run($fh);
}
sub DomainIPOK_Run {
    my $fh = shift;
    d('DomainIPOK');
    my $this = $Con{$fh};
    my $mfd;
    my $mfdd;
    return 1 if $this->{doneDoDomainIP};
    $this->{doneDoDomainIP} = 1;
    my $myip = $this->{ip};
    if ($this->{ispip} && $this->{cip}) {
        $myip = $this->{cip};
    } elsif ($this->{ispip}) {
        return 1;
    }

    if ($this->{mailfrom} =~ /(\@([^@]+))/o) {
        $mfdd = $1;
        $mfd  = $2;
    } else {
        return 1;
    }
    if (   ! skipCheck($this,'wl','np','co','aa','nb','nd','spfok')
        && (!$maxSMTPdomainIPWL || ($maxSMTPdomainIPWL && $mfd !~ /$IPDWLDRE/))
        && ! matchIP( $myip, 'noPB',            0, 1 )
        && ! matchIP( $myip, 'noProcessingIPs', $fh, 1 )
        && ! matchIP( $myip, 'whiteListedIPs',  $fh, 1 )
        && ! matchIP( $myip, 'noDelay',         $fh, 1 )
        && ! matchIP( $myip, 'acceptAllMail',   0, 1 )
        && ! matchIP( $myip, 'noBlockingIPs',   $fh, 1 )
        &&   pbBlackFind($myip)
        && ! pbWhiteFind($myip)
       )
    {
        $myip=&ipNetwork($myip, $DelayUseNetblocks );
        $myip .= '.' if $DelayUseNetblocks;
        if ((time - $SMTPdomainIPTriesExpiration{$mfd}) > $maxSMTPdomainIPExpiration) {
            $SMTPdomainIPTries{$mfd} = 1;
            $SMTPdomainIPTriesExpiration{$mfd} = time;
            $myip =~ s/\./\\\./go;
            $SMTPdomainIP{$mfd} = $myip;
        } elsif ($myip !~ /^$SMTPdomainIP{$mfd}/) {
            $SMTPdomainIP{$mfd} .= '|' if $SMTPdomainIP{$mfd};
            $myip =~ s/\./\\\./go;
            $SMTPdomainIP{$mfd} .= $myip;
            $SMTPdomainIPTriesExpiration{$mfd} = time if $SMTPdomainIPTries{$mfd}==1;
            $SMTPdomainIPTries{$mfd}++;
        }
        my $tlit = &tlit($DoDomainIP);
        $tlit = '[testmode]'   if $allTestMode && $DoDomainIP == 1 || $DoDomainIP == 4;
        my $DoDomainIP = $DoDomainIP;
        $DoDomainIP = 3 if $allTestMode && $DoDomainIP == 1 || $DoDomainIP == 4;

        if ( $SMTPdomainIPTries{$mfd} > $maxSMTPdomainIP ) {
            $this->{prepend} = "[IPperDomain]";
            $this->{messagereason} = "'$mfdd' passed limit($maxSMTPdomainIP) of ips per domain";

            mlog( $fh, "$tlit $this->{messagereason}")
              if $SessionLog && $SMTPdomainIPTries{$mfd} == $maxSMTPdomainIP + 1;
            mlog( $fh,"$tlit $this->{messagereason}")
              if $SessionLog >= 2 && $SMTPdomainIPTries{$mfd} > $maxSMTPdomainIP + 1;

            pbAdd( $fh, $myip, 'idValencePB', 'LimitingIPDomain' ) if $DoDomainIP != 2;
            if ( $DoDomainIP == 1 ) {
                $Stats{smtpConnDomainIP}++;
                unless (($send250OKISP && $this->{ispip}) || $send250OK) {
                    seterror( $fh, "554 5.7.1 too many different IP's for domain '$mfdd'", 1 );
                    return 0;
                }
            }
        }
    }
    return 1;
}

sub FrequencyIPOK {
    my $fh = shift;
    return 1 if (! $DoFrequencyIP || ! $maxSMTPipConnects);
    return FrequencyIPOK_Run($fh);
}
sub FrequencyIPOK_Run {
    my $fh = shift;
    d('FrequencyIPOK');
    my $this = $Con{$fh};
    skipCheck($this,'wl','np','co') && return 1;

    my $ConIp550 = $this->{ip};
    if ($this->{ispip} && $this->{cip}) {
        $ConIp550 = $this->{cip};
    } elsif ($this->{ispip} && ! @{$this->{sip}}) {
        return 1;
    } elsif ($this->{ispip}) {
        $ConIp550 = undef;
    }
    my @noips = split(/\s+/o,$this->{doneDoFrequencyIP});
    my @ipsToCheck;
    foreach my $ip (@{$this->{sip}},$ConIp550) {
        next unless $ip;
        next if grep {$ip eq $_} @noips;
        push @ipsToCheck, $ip;
    }
    
    $this->{doneDoFrequencyIP} = join(' ', @noips, @ipsToCheck);
    return 1 unless @ipsToCheck;

    while (my $ConIp550 = shift @ipsToCheck) {
        if (       ! matchIP( $ConIp550, 'noPB',            0, 1 )
                && ! matchIP( $ConIp550, 'noProcessingIPs', $fh, 1 )
                && ! matchIP( $ConIp550, 'whiteListedIPs',  $fh, 1 )
                && ! matchIP( $ConIp550, 'noDelay',         $fh, 1 )
                && ! matchIP( $ConIp550, 'acceptAllMail',   0, 1 )
                && ! matchIP( $ConIp550, 'noBlockingIPs',   $fh, 1 )
                &&   pbBlackFind($ConIp550)
                && ! pbWhiteFind($ConIp550)
           )
            # ip connection limiting per timeframe
        {

   # If the IP address has tried to connect previously, check it's frequency
            if ( $IPNumTries{$ConIp550} ) {
                $IPNumTries{$ConIp550}++;

          # If the last connect time is past expiration, reset the counters.
          # If it has not expired, but is outside of frequency duration and
          # below the maximum session limit, reset the counters. If it is
          # within duration
                if (((time - $IPNumTriesExpiration{$ConIp550}) > $maxSMTPipExpiration)  || ((time - $IPNumTriesDuration{$ConIp550}) > $maxSMTPipDuration) && ($IPNumTries{$ConIp550} < $maxSMTPipConnects)) {
                    $IPNumTries{$ConIp550} = 1;
                    $IPNumTriesDuration{$ConIp550} = time;
                    $IPNumTriesExpiration{$ConIp550} = time;
                }
            } else {
                $IPNumTries{$ConIp550} = 1;
                $IPNumTriesDuration{$ConIp550} = time;
                $IPNumTriesExpiration{$ConIp550} = time;

            }
            my $tlit = &tlit($DoFrequencyIP);
            $tlit = '[testmode]'   if $allTestMode && $DoFrequencyIP == 1 || $DoFrequencyIP == 4;

            my $DoFrequencyIP = $DoFrequencyIP;
            $DoFrequencyIP = 3 if $allTestMode && $DoFrequencyIP == 1 || $DoFrequencyIP == 4;

            if ( $IPNumTries{$ConIp550} > $maxSMTPipConnects ) {
                $this->{prepend} = '[IPfrequency]';
                my $whatip = ($ConIp550 eq $this->{ip}) ? '' : 'originated IP ';
                $this->{messagereason} = "$whatip'$ConIp550' passed limit($maxSMTPipConnects) of ip connection frequency";

                mlog( $fh, "$tlit $this->{messagereason}")
                  if $SessionLog >= 2
                      && $IPNumTries{$ConIp550} > $maxSMTPipConnects + 1;
                mlog( $fh,"$tlit $this->{messagereason}")
                  if $SessionLog
                      && $IPNumTries{$ConIp550} == $maxSMTPipConnects + 1;
                pbAdd( $fh, $ConIp550, 'ifValencePB', 'IPfrequency' ) if $DoFrequencyIP!=2;
                if ( $DoFrequencyIP == 1 ) {
                    $Stats{smtpConnLimitFreq}++;
                    unless (($send250OKISP && $this->{ispip}) || $send250OK) {
                        if ($ConIp550 eq $this->{ip}) {
                            seterror( $fh, "554 5.7.1 too frequent connections for '$ConIp550'", 1 );
                        } else {
                            seterror( $fh, "554 5.7.1 too frequent connections for originated IP-address '$ConIp550'", 1 );
                        }
                        return 0;
                    }
                }
            }
        }
    }
    return 1;
}

# returns 0 on success - else next possible try time
sub localFrequencyNotOK {
    my $fh = shift;
    return 0 unless $LocalFrequencyInt;
    return 0 unless $LocalFrequencyNumRcpt;
    return localFrequencyNotOK_Run($fh);
}
sub localFrequencyNotOK_Run {
    my $fh = shift;
    my $this=$Con{$fh};
    d('localFrequencyNotOK');

    return 0 unless $this->{mailfrom};
    return 0 unless $this->{relayok};
    return 0 if $this->{noprocessing};
    my ($to) = $this->{rcpt} =~ /(\S+)/o;
    my $mf = batv_remove_tag(0,$this->{mailfrom},'');
    return 0 if matchSL( [$to,$mf], 'EmailAdmins' );
    return 0 if lc($to) eq lc($EmailFrom);
    return 0 if lc($mf) eq lc($EmailFrom);

    return 0 if ($LocalFrequencyOnly && ! &matchSL($mf,'LocalFrequencyOnly'));
    return 0 if ( matchSL($mf,'NoLocalFrequency'));
    return 0 if ( matchIP( $this->{ip}, 'NoLocalFrequencyIP', 0, 1 ));

    my $time = time;
    my $numrcpt;
    my $firsttime;
    my $data;

    my %F = split(/ /o,$localFrequencyCache{$mf});
    my $i;
    foreach (sort keys %F) {
        if ($_ + $LocalFrequencyInt  < $time) {
            delete $F{$_};
            next;
        } else {
            $numrcpt += $F{$_};
            $firsttime = $_ if $i < 1;
        }
        $i++;
    }
    foreach (sort keys %F) {
        $data .= "$_ $F{$_} ";
    }
    $firsttime = $time unless $firsttime;
    $localFrequencyCache{$mf} = $data . "$time $this->{numrcpt}";
    $numrcpt += $this->{numrcpt};
    return 0 if $numrcpt < $LocalFrequencyNumRcpt;
    return $firsttime + $LocalFrequencyInt;
}

sub NumRcptOK {
    my($fh,$block)=@_;
    return 1 unless $DoMaxDupRcpt;
    return NumRcptOK_Run($fh,$block);
}
sub NumRcptOK_Run {
    my($fh,$block)=@_;
    my $this=$Con{$fh};
    d('NumRcptOK');
    my $DoMaxDupRcpt = $DoMaxDupRcpt;
    $DoMaxDupRcpt = 3 if !$block  && $DoMaxDupRcpt == 1;
    return 1 unless $this->{numrcpt};
    return 1 unless (scalar keys %{$this->{rcptlist}});
    skipCheck($this,'aa','ro','wl') && return 1;
    return 1 if $this->{noprocessing} & 1;
    return 1 if $this->{spamlover} & 1;
    return 1 if $this->{allLoveSpam} & 1;
    return 1 if ((scalar keys %{$this->{rcptlist}}) + $MaxDupRcpt >= $this->{numrcpt});
    my $maxRcpt;
    my $maxNum = 0;
    while (my ($k,$v) = each %{$this->{rcptlist}}) {
        my $tt = needEs($v,' time','s');
        mlog($fh,"info: address $k used $tt") if $ValidateUserLog >= 2;
        if ($v > $maxNum) {
            $maxNum = $v;
            $maxRcpt = $k;
        }
    }
    my $tlit = &tlit($DoMaxDupRcpt);
    $this->{prepend}="[MaxDuplicateRcpt]";
    $this->{messagereason} = "too many duplicate recipients ($maxRcpt , $maxNum)";
    mlog($fh,"$tlit $this->{messagereason}",1) if $ValidateUserLog;
    return 1 if $DoMaxDupRcpt == 2;
    my $reply = "550 5.5.3 $this->{messagereason}";
    pbAdd( $fh, $this->{ip}, 'mdrValencePB', 'MaxDuplicateRcpt' );
    return 1 if $DoMaxDupRcpt == 3;
    $Stats{rcptNonexistent}++;
    seterror($fh, $reply,1);
    return 0;
}

sub MessageSizeOK {
    my $fh = shift;
    my $this=$Con{$fh};
    d('MessageSizeOK');

    my $maxRealSize = $maxRealSize || 0;
    $maxRealSize = $this->{maxRealSize} if defined $this->{maxRealSize};
    my $maxSize = $maxSize || 0;
    $maxSize = $this->{maxSize} if defined $this->{maxSize};
    if ($this->{relayok} && ! defined $this->{maxSize}) {
        $this->{maxRealSize} = $this->{maxSize} = 0;
        my @MSadr  = sort {$main::b <=> $main::a} map {&matchHashKey('MSadr' ,$_)} split(/\s+/o,$this->{rcpt}),$this->{mailfrom},$this->{ip},$this->{cip},@{$this->{sip}};
        my @MRSadr = sort {$main::b <=> $main::a} map {&matchHashKey('MRSadr',$_)} split(/\s+/o,$this->{rcpt}),$this->{mailfrom},$this->{ip},$this->{cip},@{$this->{sip}};
        $maxSize = $this->{maxSize} = $MSadr[0] if (defined $MSadr[0]);
        $maxSize = $this->{maxSize} = 0 if grep({$_ == 0} @MSadr);
        $maxRealSize = $this->{maxRealSize} = $MRSadr[0] if (defined $MRSadr[0]);
        $maxRealSize = $this->{maxRealSize} = 0 if grep({$_ == 0} @MRSadr);
    }
    
    my $maxRealSizeExternal = $maxRealSizeExternal || 0;
    $maxRealSizeExternal = $this->{maxRealSizeExternal} if defined $this->{maxRealSizeExternal};
    my $maxSizeExternal = $maxSizeExternal || 0;
    $maxSizeExternal = $this->{maxSizeExternal} if defined $this->{maxSizeExternal};
    if (! $this->{relayok} && ! defined $this->{maxSizeExternal}) {
        $this->{maxRealSizeExternal} = $this->{maxSizeExternal} = 0;
        my @MSEadr  = sort {$main::b <=> $main::a} map {&matchHashKey('MSEadr' ,$_)} split(/\s+/o,$this->{rcpt}),$this->{mailfrom},$this->{ip},$this->{cip},@{$this->{sip}};
        my @MRSEadr = sort {$main::b <=> $main::a} map {&matchHashKey('MRSEadr',$_)} split(/\s+/o,$this->{rcpt}),$this->{mailfrom},$this->{ip},$this->{cip},@{$this->{sip}};
        $maxSizeExternal = $this->{maxSizeExternal} = $MSEadr[0] if (defined $MSEadr[0]);
        $maxSizeExternal = $this->{maxSizeExternal} = 0 if grep({$_ == 0} @MSEadr);
        $maxRealSizeExternal = $this->{maxRealSizeExternal} = $MRSEadr[0] if (defined $MRSEadr[0]);
        $maxRealSizeExternal = $this->{maxRealSizeExternal} = 0 if grep({$_ == 0} @MRSEadr);
    }

    if ( ($this->{relayok} && $maxRealSize
            && ( ($this->{SIZE} > $this->{maillength} ? $this->{SIZE} : $this->{maillength}) * $this->{numrcpt} > $maxRealSize )) ||
         (!$this->{relayok} && $maxRealSizeExternal
            && ( ($this->{SIZE} > $this->{maillength} ? $this->{SIZE} : $this->{maillength}) * $this->{numrcpt} > $maxRealSizeExternal ))
       )
    {
        &makeSubject($fh);
        my $max = $this->{relayok} ? $maxRealSize : $maxRealSizeExternal;
        my $err = "552 message exceeds MAXREALSIZE byte (size \* rcpt)";
        if ($this->{relayok}) {
            mlog( $fh, "warning: message exceeds maxRealSize $max bytes (size \* rcpt)!" );
        } else {
            $this->{prepend} = 'MaxRealMessageSize';
            my $fn = $this->{maillogfilename};
            $fn=' -> '.$fn if $fn ne '';
            $fn='' if !$fileLogging;
            my $logsub = ( $subjectLogging && $this->{originalsubject} ? " $subjectStart$this->{originalsubject}$subjectEnd" : '' );
            mlog( $fh, "[spam found] (message exceeds maxRealSize $max bytes (size \* rcpt)!)$logsub".de8($fn).';',0,2 );
            $this->{prepend} = '';
        }
        $err = $maxRealSizeError if ($maxRealSizeError);
        $err =~ s/MAXREALSIZE/$max/go;
        seterror( $fh, $err, 1 );
        return 0;
    }

    if ( (  $this->{relayok} && $maxSize         && $this->{maillength} > $maxSize         ) ||
         (! $this->{relayok} && $maxSizeExternal && $this->{maillength} > $maxSizeExternal )
       )
    {
        &makeSubject($fh);
        my $max = $this->{relayok} ? $maxSize : $maxSizeExternal;
        my $err = "552 message exceeds MAXSIZE byte (size)";
        if ($this->{relayok}) {
            mlog( $fh, "warning: message exceeds maxSize $max bytes (size)!" );
        } else {
            $this->{prepend} = 'MaxMessageSize';
            my $fn = $this->{maillogfilename};
            $fn=' -> '.$fn if $fn ne '';
            $fn='' if !$fileLogging;
            my $logsub = ( $subjectLogging && $this->{originalsubject} ? " $subjectStart$this->{originalsubject}$subjectEnd" : '' );
            mlog( $fh, "[spam found] (message exceeds maxSize $max bytes (size)!)$logsub".de8($fn).';',0,2 );
            $this->{prepend} = '';
        }
        $err = $maxSizeError if ($maxSizeError);
        $err =~ s/MAXSIZE/$max/go;
        seterror( $fh, $err, 1 );
        return 0;
    }
    return 1;
}

#queries the SenderBase service
sub SenderBaseMyIP {
    my $ip = shift;
    d('SenderBaseMyIP');
    return $MySenderBaseCode if $MySenderBaseCode;
    return eval{
    my $results = ASSP::Senderbase::Query->new(
                          Address => $ip,
                          Timeout => 10
                        )->results;
    $MySenderBaseCode = $results->{ip_country};
    $MySenderBaseCode;
    };
}

#queries the SenderBase service
sub SenderBaseOK {
    my ( $fh, $ip ) = @_;
    return SenderBaseOK_Run($fh, $ip);
}
sub SenderBaseOK_Run {
    my ( $fh, $ip ) = @_;
    d('SenderBaseOK');
    my $this = $Con{$fh};
    $fh = 0 if "$fh" =~ /^\d+$/o;
    return 1 if $this->{SenderBaseOK};
    $this->{SenderBaseOK} = 1;
    skipCheck($this,'sb','aa','wl','ro','ispcip') && return 1;
    return 1 if $this->{noprocessing} & 1;

    $ip = $this->{cip} if $this->{ispip} && $this->{cip};
    return 1 if $ip =~ /$IPprivate/o;

    my $results;
    my $cache;
    my $skip;
    my $tlit;

    my $mfd;
    $mfd = lc $1 if $this->{mailfrom} =~ /\@([^@]*)/o;

    my $ipcountry;
    my $orgname;
    my $domainname;
    my $blacklistscore;
    my $hostname_matches_ip;
    my $fortune1000;
    my $ipbondedsender;
    my $domainrating;
    my $bondedsender;
    my $resultip;
    my $ipCIDR;

    if ( (( $ipcountry, $orgname, $domainname, $blacklistscore, $hostname_matches_ip, $ipCIDR ) = split( /\|/o, SBCacheFind($ip) )) ) {
        $cache = 1;
        d("SenderBase: finished CACHE");
    } else {
        &sigoff(__LINE__);
        eval {
            $results = ASSP::Senderbase::Query->new(
                Address   => $ip,
                Timeout   => 10
              )->results;
        };
        if ($@) {
            mlog( $fh, "warning: SenderBase: $@", 1 ) if $SenderBaseLog >= 2;
            &sigon(__LINE__);
            return 1;
        }
        &sigon(__LINE__);

        if ($results) {
            $bondedsender   = $results->{ip_in_bonded_sender};
            $blacklistscore = $results->{ip_blacklist_score};
            $hostname_matches_ip = $results->{hostname_matches_ip};
            $orgname        = $results->{org_name};
            $resultip       = $results->{ip};
            $fortune1000    = $results->{org_fortune_1000};
            $domainname     = $results->{domain_name};
            $domainrating   = $results->{domain_rating};
            $ipbondedsender = $results->{ip_in_bonded_sender};
            $ipcountry      = $results->{ip_country};
            $ipCIDR         = $results->{ip_cidr_range};
            if (! $fh) {
                $this->{sbstatus} = 0;
                $this->{sbdata} = "$ipcountry|$orgname|$domainname|$blacklistscore|$hostname_matches_ip|$ipCIDR";
            }
            d("SenderBase: finished DNS");
        } else {
            mlog( $fh, "info: SenderBase: got no results", 1 ) if $SenderBaseLog >= 2;
            return 1;
        }
    }
    my $tempdomain; $tempdomain = "domain:$domainname" if $domainname;
    mlog( $fh, "SenderBase -- country:$ipcountry orgname:$orgname $tempdomain", 1 )
      if $SenderBaseLog >= 2 && ! $cache;
    mlog( $fh, "SenderBase(Cache) -- country:$ipcountry orgname:$orgname $tempdomain", 1 )
      if $SenderBaseLog >= 2 && $cache;

   
    if ($DoOrgWhiting) {
        if (   $orgname =~ /($whiteSenderBaseRE)/
            || $domainname =~ /($whiteSenderBaseRE)/  )
        {
            my $wSB = $1;
            d("SenderBase: in DoOrgWhiting");
            $tlit = tlit($DoOrgWhiting);
            SBCacheAdd( $ip, 2, "$ipcountry|$orgname|$domainname|$blacklistscore|$hostname_matches_ip|$ipCIDR" );
            d("SenderBase0: finished SBCacheAdd in DoOrgWhiting");
            $this->{sbstatus} = 2 if (! $fh);
            if ($DoOrgWhiting == 1) {
                $WhiteOrgList{$mfd} = $orgname if $mfd ne lc $domainname && $this->{spfok};
                $this->{whitelisted} = 1;
                $this->{passingreason} = "white-senderbase: $wSB";
                pbWhiteAdd( $fh, $ip, "WhiteSenderBase:$wSB" );
            }
            $this->{messagereason} = "White Organization/Domain '$wSB'";
            $this->{messagereason} .= " in cache " if $cache;
            pbAdd( $fh, $ip, &weightRe('sworgValencePB','whiteSenderBase',\$wSB,$fh), "WhiteSenderBase:$wSB" )
              if $DoOrgWhiting != 2;
            mlog( $fh, "$tlit SenderBase -- $this->{messagereason}", 1 )
              if $SenderBaseLog;
            return 1;
        }
    }

    if ($DoOrgBlocking) {

        $this->{prepend} = "[Organization]";
        $tlit = tlit($DoOrgBlocking);

        d("SenderBase: in DoOrgBlocking");
        if (!$orgname && !$ipcountry ) {
            SBCacheAdd( $ip, 1, "$ipcountry|$orgname|$domainname|$blacklistscore|$hostname_matches_ip|$ipCIDR" );
            d("SenderBase1: finished SBCacheAdd in DoOrgBlocking");
            $this->{sbstatus} = 1 if (! $fh);
            pbWhiteDelete( $fh, $ip );
            $this->{messagereason} = "No CountryCode/Organization";
            pbAdd( $fh, $ip,'sbnValencePB', 'NoCountryNoOrg' );
            mlog( $fh, "[Scoring] SenderBase -- $this->{messagereason}", 1 )
              if $SenderBaseLog >= 2;
            return 1;
        } elsif (   $orgname =~ /($blackSenderBaseRE)/
            || $domainname =~ /($blackSenderBaseRE)/ )
        {
            my $bSB = $1;
            mlogRe( $fh, $bSB, "BlackOrg" );
            pbWhiteDelete( $fh, $ip );
            SBCacheAdd( $ip, 1, "$ipcountry|$orgname|$domainname|$blacklistscore|$hostname_matches_ip|$ipCIDR" );
            d("SenderBase2: finished SBCacheAdd in DoOrgBlocking");
            $this->{sbstatus} = 1 if (! $fh);
            $this->{messagereason} = "Black Organization/Domain '$bSB'";
            pbAdd( $fh, $ip, &weightRe('sborgValencePB','blackSenderBase',\$bSB,$fh), "BlackOrg:$bSB" )
                if $DoOrgBlocking != 2;

            mlog( $fh, "$tlit SenderBase -- $this->{messagereason}", 1 )
              if $SenderBaseLog >= 2;
            return 0 if $DoOrgBlocking == 1;
        } else {
            SBCacheAdd( $ip, 0, "$ipcountry|$orgname|$domainname|$blacklistscore|$hostname_matches_ip|$ipCIDR" );
            d("SenderBase3: finished SBCacheAdd in DoOrgBlocking");
        }
    } else {
        SBCacheAdd( $ip, 0, "$ipcountry|$orgname|$domainname|$blacklistscore|$hostname_matches_ip|$ipCIDR" );
        d("SenderBase4: finished SBCacheAdd in DoOrgBlocking");
    }
    
    return 1 unless $DoCountryBlocking;
    return 1 unless $ipcountry;
    if ($NoCountryCodeRe && $ipcountry =~ /$NoCountryCodeReRE/) {
        d("SenderBase5: match NoCountryCodeRe");
        return 1;
    }
    d("SenderBase: DoCountryBlocking");

    $this->{mycountry} = 0;
    my $matchMyCountry = $MyCountryCodeRe && $ipcountry =~ /$MyCountryCodeReRE/;
    my $matchCountryCode = $CountryCodeRe && $ipcountry =~ /$CountryCodeReRE/;

    if (    $ipcountry =~ /$CountryCodeBlockedReRE/
         || (   $CountryCodeBlockedRe =~ /all/io
             && ! $matchMyCountry
             && ! $matchCountryCode
            )
       )
    {
        $this->{messagereason} = "Blocked Country $ipcountry ($orgname)";
        $this->{prepend} = "[CountryCode]";
        $tlit = tlit($DoCountryBlocking);
        pbAdd( $fh, $ip, &weightRe('bccValencePB','CountryCodeBlockedRe',\$ipcountry,$fh), "BlockedCountry:$ipcountry" )
          if $DoCountryBlocking != 2;

        mlog( $fh, "$tlit SenderBase -- $this->{messagereason}", 1 )
          if $DoCountryBlocking == 2 || $DoCountryBlocking == 3;

        return 0 if $DoCountryBlocking == 1;
        return 1;
    }

    return 1 if !$DoSenderBase;
    return 1 if !$CountryCodeRe && !$MyCountryCodeRe;
    return 1 unless $fh;
    $tlit = tlit($DoSenderBase);

    ${'sbhccValencePB'}[0] = 0 - ${'sbhccValencePB'}[0] if ${'sbhccValencePB'}[0] > 0;
    ${'sbhccValencePB'}[1] = 0 - ${'sbhccValencePB'}[1] if ${'sbhccValencePB'}[1] > 0;

    if (   (${'sbhccValencePB'}[0] < 0 || ${'sbhccValencePB'}[1] < 0)    # home country
        && $matchMyCountry )
    {
        $this->{prepend}       = "[CountryCode]";
        $this->{mycountry}     = 1;
        $this->{messagereason} = "Home Country Bonus $ipcountry ($orgname)";
        mlog( $fh, "$tlit SenderBase -- $this->{messagereason}", 1 ) if $SenderBaseLog >= 2;
        pbAdd( $fh, $ip, &weightRe('sbhccValencePB','MyCountryCodeRe',\$ipcountry,$fh), "HomeCountry:$ipcountry" )
          if $DoSenderBase != 2;
        return 1;
    }
    if (   (${'sbfccValencePB'}[0] || ${'sbfccValencePB'}[1])        # foreign country
        && ! $matchMyCountry
        && ! $matchCountryCode )
    {
        $this->{messagereason} = "Foreign Country $ipcountry ($orgname)";
        pbAdd( $fh, $ip, &weightRe('sbfccValencePB','CountryCodeRe',\$ipcountry,$fh), "CountryCode:$ipcountry", 1 )
          if $DoSenderBase != 2;
        $this->{prepend} = "[CountryCode]";
        mlog( $fh, "$tlit SenderBase -- $this->{messagereason}", 1 ) if $SenderBaseLog >= 2;
        return 1;
    }
    if (
           (${'sbsccValencePB'}[0] || ${'sbsccValencePB'}[1])
        && $matchCountryCode
      )
    {
        $this->{messagereason} = "Suspicious Country $ipcountry ($orgname)";
        pbAdd( $fh, $ip, &weightRe('sbsccValencePB','CountryCodeRe',\$ipcountry,$fh), "CountryCode:$ipcountry", 1 )
          if $DoSenderBase != 2;
        $this->{prepend} = "[CountryCode]";
        mlog( $fh, "$tlit SenderBase -- $this->{messagereason}", 1 ) if $SenderBaseLog;
        return 1;
    }
    if (   (${'sbfccValencePB'}[0] || ${'sbfccValencePB'}[1])    # Foreign & Suspicious Country
        && $ScoreForeignCountries
        && ! $matchMyCountry
        && $matchCountryCode )
    {
        $this->{messagereason} = "Foreign & Suspicious Country $ipcountry ($orgname)";
        pbAdd( $fh, $ip, &weightRe('sbfccValencePB','CountryCodeRe',\$ipcountry,$fh), "CountryCode:$ipcountry", 1 )
          if $DoSenderBase != 2;
        $this->{prepend} = "[CountryCode]";
        mlog( $fh, "$tlit SenderBase -- $this->{messagereason}", 1 ) if $SenderBaseLog;
        return 1;
    }
    return 1;
}

#enforce valid A/MX record for sender address
sub MXAOK {
    my $fh = shift;
    return 1 unless $CanUseDNS && $DoDomainCheck;
    return MXAOK_Run($fh);
}
sub MXAOK_Run {
    my $fh = shift;
    d('MXAOK');
    my $this = $Con{$fh};
    return 1 if $this->{MXAOK};
    $this->{MXAOK} = 1;

    my $ip = $this->{ip};
    $ip = $this->{cip} if $this->{ispip} && $this->{cip};

    skipCheck($this,'ro','co') && return 1;
    return 1 if $this->{noprocessing} & 1;
    return 1 if $this->{mailfrom} =~ /$BSRE/;
#    return 1 if $this->{mailfrom} =~ /www|news|mail|noreply/io;
    return 1 if (($this->{rwlok} && ! $this->{cip}) or ($this->{cip} && pbWhiteFind($ip)));
    return 1 if ( localmail( $this->{mailfrom} ) );

    my $slok = $this->{allLoveMXASpam} == 1;

    my $mf   = lc $this->{mailfrom};
    my %mfd;
    $mfd{lc $1}->{mx} = $mfd{lc $1}->{a} = $mfd{lc $1}->{ctime} = undef if $mf =~ /\@($EmailDomainRe)$/o;
    
    while ($this->{header} =~ /($HeaderNameRe):($HeaderValueRe)/igos) {
        my $line = $2;
        next if $1 !~ /^(?:ReturnReceipt|Return-Receipt-To|Disposition-Notification-To|Return-Path|Reply-To|Sender|Errors-To|List-\w+)$/io;
        headerUnwrap($line);
        while ($line =~ /$EmailAdrRe\@($EmailDomainRe)/og) {
            $mfd{lc $1}->{mx} = $mfd{lc $1}->{a} = $mfd{lc $1}->{ctime} = undef;
        }
    }

    my $DoDomainCheck = $DoDomainCheck;
    $DoDomainCheck = 3 if (($switchSpamLoverToScoring && $DoPenaltyMessage && ( $slok || $this->{spamlover} & 1 ))
                         or
                           ($switchTestToScoring && $DoPenaltyMessage &&  ( $mxaTestMode || $allTestMode ))
                          );

    my $tlit;
    $tlit = &tlit($DoDomainCheck);
    $this->{prepend} = '';
    my $hasPrivat;

    foreach my $mfd (keys %mfd) {
        my ( $cachetime, $mxexchange, $arecord ) = MXACacheFind($mfd);
        if ( ! $cachetime ) {
            my $res = getDNSResolver();
            &sigoff(__LINE__);
            my @queryMX = eval{ Net::DNS::mx( $res, $mfd ); };
            &sigon(__LINE__);
            if (@queryMX) {
                foreach my $rr ( @queryMX ) {
                    my @MXip;
                    eval{$mxexchange = $rr->exchange;} or next;
                    &sigoff(__LINE__);
                    my $res = queryDNS($mxexchange ,'A');
                    &sigon(__LINE__);
                    if (ref $res) {
                        my @answer = eval{map{$_->string} $res->answer;};
                        while (@answer) {
                            my $RR = Net::DNS::RR->new(shift @answer);
                            my $aip = eval{$RR->rdatastr};
                            if ($aip !~ /$IPprivate/o) {
                                push @MXip, $aip;
                                $hasPrivat = 0;
                            } elsif ($hasPrivat != 0) {
                                $hasPrivat = 1;
                            }
                        }
                    }
                    if (!@MXip && $mxexchange && $res) {
                        mlog( $fh,"MX $mxexchange has no or a private IP - this MX has failed", 0)
                            if $ValidateSenderLog;
                        $mfd{$mfd}->{mx} = $mfd{$mfd}->{a} = $mfd{$mfd}->{ctime} = undef;
                    } elsif ($mxexchange && $res) {
                        $mfd{$mfd}->{mx} = $mxexchange;
                        $mfd{$mfd}->{a} = $MXip[0];
                        $mfd{$mfd}->{ctime} = undef;
                        last;
                    }
                }
            } else {
                delete $mfd{$mfd};
            }
        } else {
            $mfd{$mfd}->{mx} = $mxexchange;
            $mfd{$mfd}->{a} = $arecord;
            $mfd{$mfd}->{ctime} = $cachetime;
        }
    }

    my $mfailed;
    my $afailed;
    my $failed;
    my $mpb;
    my $apb;
    foreach my $mfd (keys %mfd) {

        if ($mfd{$mfd}->{mx}) {

            #MX found
            my $msg = "MX found";
            $msg .= " (cache)" if $mfd{$mfd}->{ctime};
            $msg .= ": $mfd -> ". $mfd{$mfd}->{mx};
            mlog( $fh, $msg, 1, 1 )
              if $ValidateSenderLog >= 2 ;

        } else {

            #MX not found
            $this->{prepend} = "[MissingMX]";
            $this->{messagereason} = "MX missing";
            $this->{messagereason} .= " (cache)" if $mfd{$mfd}->{ctime};
            $this->{messagereason} .= ": $mfd";

            mlog( $fh,"[scoring] $this->{messagereason}", 0)
              if $ValidateSenderLog && ${'mxValencePB'}[0];

            pbWhiteDelete( $fh, $ip ) if ! $mpb;
            pbAdd( $fh, $ip, 'mxValencePB', 'MissingMX' ) if $DoDomainCheck != 2 && !$mpb;
            pbAdd( $fh, $ip, 'mxValencePB', 'MissingMX' ) if $DoDomainCheck != 2 && !$mpb && $hasPrivat;
            if (! $mfd{$mfd}->{a} ) {
                my ($name, $aliases, $addrtype, $length, @addrs);
                eval{
                    ($name, $aliases, $addrtype, $length, @addrs) = gethostbyname($mfd);
                };
                while (my $i = shift @addrs) {
                    my ($ad, $bd, $cd, $dd) = unpack('C4', $i);
                    my $arecord ="$ad.$bd.$cd.$dd";
                    if ( $MXACacheInterval > 0 && $arecord =~ /^$IPRe$/o && $arecord !~ /^$IPprivate$/o) {
                        $mfd{$mfd}->{a} = $arecord;
                        last;
                    }
                }
            }
            $mfailed = 1;
            $this->{prepend} = '';
        }

        if ($mfd{$mfd}->{a}) {

            #A  found
            my $msg = "A record found";
            $msg .= " (cache)" if $mfd{$mfd}->{ctime};
            $msg .= ": $mfd -> ".$mfd{$mfd}->{a};
            mlog( $fh, $msg, 1, 1 )	if $ValidateSenderLog >= 2 ;

        } else {

            #A not found
            $this->{prepend} = "[MissingMXA]";

            $this->{messagereason} = "A record missing: $mfd";
            $this->{messagereason} .= " (cache)" if $mfd{$mfd}->{ctime};

            mlog( $fh,"[scoring] $this->{messagereason}")
              if $ValidateSenderLog && $DoDomainCheck >= 2;

            delayWhiteExpire($fh) if ! $apb;
            pbAdd( $fh, $ip, 'mxaValencePB', 'MissingMXA' ) if $DoDomainCheck != 2 && ! $apb;
            pbAdd( $fh, $ip, 'mxaValencePB', 'MissingMXA' ) if $DoDomainCheck != 2 && ! $apb && $hasPrivat;
            $this->{prepend} = '';
            $afailed = 1;
        }
        if ( $MXACacheInterval > 0) {
            MXACacheAdd( $mfd, $mfd{$mfd}->{mx}, $mfd{$mfd}->{a} ) if ! $mfd{$mfd}->{ctime};
        }
        $failed = $mfailed && $afailed;
        $mf = $mfd if ($mfailed && $afailed);
        $apb |= $afailed;
        $mpb |= $mfailed;
        $mfailed = $afailed = undef;
    }

    if ($failed) {
        return 1 if $DoDomainCheck >= 2;
        $this->{prepend}="[MissingMXA]";
        mlog($fh,"MX and A record missing at least for: $mf")
          if $ValidateSenderLog;
        return 0;
    } else {
        $this->{prepend}='';
        return 1;
    }
}

sub BombWeight {
    my ($fh,$t,$re) = @_;
    my %weight = ();
    mlog(0,"error: code error - missing valence value in 'WeightedRe' hash in sub BombWeight for $re") if (! exists $WeightedRe{$re});
    mlog(0,"warning: suspect valence value '0' in 'WeightedRe' hash for '$WeightedRe{$re}' in sub BombWeight for $re") if $BombLog >= 2 && ${$WeightedRe{$re}}[0] == 0;
    return %weight unless ${$re};
    return %weight unless ${$re.'RE'};
    return BombWeight_Run($fh,$t,$re);
}
sub BombWeight_Run {
    my ($fh,$t,$re) = @_;
    d("BombWeight - $re");
    my @text;
    my $rawtext = ref $t ? $$t : $t;
    my %weight = ();
    my %found = ();
    my $weightsum = 0;
    my $weightcount = 0;
    $maxBombSearchTime = 5 unless $maxBombSearchTime;
    $weightMatch = '';
    my $regex = ${$re.'RE'};
    my $itime = time;
    $addCharsets = 1 if $re eq 'bombCharSets';
    if ($re ne 'bombSubjectRe') {
       $rawtext =~ s/(<!--.+?)-->/$1/sgo;
       my $mimetext = cleanMIMEBody2UTF8(\$rawtext);
       if ($mimetext) {
           if ($re ne 'bombDataRe') {
               $text[0] = cleanMIMEHeader2UTF8(\$rawtext,0);
               $mimetext =~ s/\=(?:\015?\012|\015)//go;
               $mimetext = decHTMLent(\$mimetext);
           }
           $text[0] .= $mimetext;
       } else {
           $text[0] = decodeMimeWords2UTF8($rawtext);
       }
    } else {
       $text[0] = $rawtext;
    }
    undef $rawtext;
    $addCharsets = 0;
    $text[1] = transliterate(\$text[0], 1) if $DoTransliterate;
    mlog($fh,"info: transliterated content will be checked for '$re'") if $text[1] && $BombLog > 1;
    if (   $re =~ /^(?:bomb(?:Suspicious|Header)?|black|test)Re$/o
        && $bombSkipHeaderTagRe
        && $bombSkipHeaderTagReRE !~ /$neverMatchRE/o)
    {
        my $found;
        for (@text) {
            my $head;
            $head = $1 if /^($HeaderRe+)/ois;
            if ($head && $head =~ s/(^|\n)$bombSkipHeaderTagReRE:$HeaderValueRe/$1/gis) {
                s/^($HeaderRe+)/$head/ois;
                $found = 1;
            }
        }
        mlog(0,"info: $re: removed all mail header tags found for bombSkipHeaderTagRe") if $found && $BombLog > 1;
    }
    if ($re eq 'bombSubjectRe' && $maxSubjectLength) {
        my ($submaxlength,$maxlengthweight) = split(/\s*\=\>\s*/o,$maxSubjectLength);
        $maxlengthweight ||= ${$WeightedRe{$re}}[0];
        my $sublength = length($text[0]);
        if ($submaxlength && $sublength > $submaxlength) {
            if ($maxlengthweight) {
                $weightsum += $maxlengthweight;
                $weightcount++;
                $weight{highval} = $maxlengthweight;
                $weight{highnam} = "subject length($sublength) > max($submaxlength)";
                $found{$weight{highnam}} = $maxlengthweight;
                $weight{matchlength} = '';
            } else {
                mlog(0,"warning: maxSubjectLength is defined as '$maxSubjectLength' - but assp is unable to calculate a valid weight");
            }
            $text[0] = substr($text[0],0,$submaxlength);
            $text[1] = substr($text[1],0,$submaxlength) if $text[1];
            mlog($fh,"info: Subject exceeds $maxSubjectLength byte - the checked subject is trunked to $submaxlength byte") if $BombLog && $fh;
        }
    }
    my $text = join("\r\n",@text);
    @text = ();
    eval {
      local $SIG{ALRM} = sub { die "__alarm__\n"; };
      alarm($maxBombSearchTime + 10);
      if ($re ne 'bombSubjectRe' or ($re eq 'bombSubjectRe' && $weightsum < $bombMaxPenaltyVal)) {
          while (&sigoffTry(__LINE__) && $text =~ /($regex)/gs) {
              my $subre = $1||$2;
              my $matchlength = length($subre);
              last if time - $itime >= $maxBombSearchTime;
              my $w = &weightRe($WeightedRe{$re},$re,\$subre,$fh);
              &sigonTry(__LINE__);
              next unless $w;
              $subre = substr($subre,0,$RegExLength < 5 ? 5 : $RegExLength) if $subre;
              $subre = '[!empty string!]' unless $subre;
              if ($subre =~ /^\s+$/o) {
                  my $spcount = length($subre);
                  $subre = "[!$spcount spaces only!]";
              }
              $subre =~ s/\s+/ /go;
              next if ($found{lc($subre)} > 0 && $found{lc($subre)} >= $w);
              next if ($found{lc($subre)} < 0 && $found{lc($subre)} <= $w);
              $found{lc($subre)} = $w;
              $weightsum += $w;
              $weightcount++;
              if (abs($w) >= abs($weight{highval})) {
                  $weight{highval} = $w;
                  $subre =~ s{([\x00-\x1F])}{sprintf("'hex %02X'", ord($1))}eog;
                  $weight{highnam} = $subre;
                  $weight{matchlength} = (length($subre) != $matchlength) ? "(matchlength:$matchlength) " : '';
              }
              &ThreadYield;
              last if ($fh && $bombMaxPenaltyVal && $weightsum >= $bombMaxPenaltyVal);
          }
          alarm(0);
      }
    };
    $itime = time - $itime;
    if ($@) {
        alarm(0);
        if ( $@ =~ /__alarm__/o ) {
            mlog( $fh, "BombWeight: timed out in 'RE:$re' after $itime secs.", 1 );
        } else {
            mlog( $fh, "BombWeight: failed in 'RE:$re': $@", 1 );
        }
    }
    &sigonTry(__LINE__);
    if ($itime > $maxBombSearchTime) {
        mlog($fh,"info: $re canceled after $itime s > maxBombSearchTime $maxBombSearchTime s") if $BombLog >= 2 && $fh;
    }
    return %weight if $weightcount == 0;
    $weight{sum} = $weightsum > $bombMaxPenaltyVal ? $bombMaxPenaltyVal : $weightsum;
    $weight{count} = $weightcount;
    mlogRe($fh,"PB $weight{sum}: for $weight{highnam}",ucfirst $re) if $BombLog && $fh;
    mlog($fh,"$weight{highnam} : $weight{matchlength}$weight{highval} , count : $weightcount , sum : $weightsum , time : $itime s") if $BombLog >= 2 && $fh;
    $weight{highnam} = "$weight{matchlength}" . join ' , ', map{my $t = "'" . substr($_,0,$RegExLength < 5 ? 5 : $RegExLength) . " ($found{$_})'";$t;}
                          (sort {$found{$main::b} <=> $found{$main::a}} keys %found) if $BombLog >= 2;
    return %weight;
}

sub BombOK {
    my($fh,$bd)=@_;
    my $this=$Con{$fh};
    return 1 if $this->{bombdone} == 1;
    my $DoBombRe = $DoBombRe;    # copy the global to local - using local from this point
    $DoBombRe = $this->{overwritedo} if ($this->{overwritedo});   # overwrite requ by Plugin
    if (! $DoBombRe){
        $this->{bombdone}=1;
        return 1;
    }
    return BombOK_Run($fh,$bd);
}
sub BombOK_Run {
    my($fh,$header)=@_;
    my $this=$Con{$fh};
    return 1 if $this->{bombdone} == 1;
    d('BombOK');
    my %Bombs = ();
    my $DoBombRe = $DoBombRe;    # copy the global to local - using local from this point
    $DoBombRe = $this->{overwritedo} if ($this->{overwritedo});   # overwrite requ by Plugin
    if (! $DoBombRe){
        $this->{bombdone}=1;
        return 1;
    }
    my $subre;
    my $tlit;
    my $datastart = $this->{datastart};
    my $maillength = length($$header);
    my $ofs = 0;
    $this->{prepend}=$this->{messagereason}='';

    if ($this->{bombdone} eq 'PL') {     # if called from plugins
        $datastart = 1;
        $ofs = 1;
        $this->{bombdone}=1;
    }

    if (!$this->{whitelisted} && $whiteRe && $$header=~/($whiteReRE)/) {
        mlogRe($fh,($1||$2),"White");
        $this->{whitelisted}=1;
    }
    if ($myServerRe && substr($$header, $datastart - 1, $maillength - $datastart + $ofs) =~/($LHNRE)/) {
        mlogRe($fh,$1,"RegularBounce");
        $this->{noprocessing}=1;
    }
    if(!$this->{spamlover} & 1 && $SpamLoversRe  && substr($$header, $datastart - 1, $maillength - $datastart + $ofs) =~ /($SpamLoversReRE)/ ) {
        mlogRe($fh,($1||$2),"SpamLover");
        $this->{spamlover}=3;
    }

    %Bombs = $DoTestRe ? &BombWeight($fh,$header,'testRe' ) : ();
    if ($Bombs{count}) {
        $subre = $Bombs{highnam};
        mlogRe($fh,$subre,"TestRe","TestRegex");
    }

    if ($this->{mailfrom} && matchSL($this->{mailfrom},'noBombScript') ) {
        return 1;}

    $tlit = &tlit(3);
    %Bombs = &BombWeight($fh,$header,'bombSuspiciousRe');
    if ($Bombs{count}) {
        $subre = $Bombs{highnam};
        $this->{messagereason}="BombSuspicious: '$Bombs{matchlength}$subre'";
        pbAdd($fh,$this->{ip},$Bombs{sum},"bombSuspiciousRe",1);
    } else {
        mlog($fh,"$tlit no Bomb found for 'bombSuspiciousRe'") if $bombSuspiciousRe && $BombLog >= 2;
    }
    return 1 if $this->{acceptall};
    return 1 if $this->{whitelisted}  && !$bombReWL  && !$bombReWLw;
    return 1 if $this->{noprocessing} && !$bombReNP && !$bombReNPw;
    return 1 if $this->{relayok} && !$bombReLocal && !$bombReLocalw;
    return 1 if $this->{ispip} && !$bombReISPIP && !$bombReISPIPw;
    my $slok=$this->{allLoveBoSpam}==1;

    $DoBombRe = 3 if (($switchSpamLoverToScoring && $DoPenaltyMessage && ($slok || $this->{spamlover} & 1))
                   or
                      ($switchTestToScoring && $DoPenaltyMessage && ($bombTestMode || $allTestMode))
                     );
    $this->{messagereason} = '';

    $tlit=&tlit($DoBombRe);
    %Bombs = &BombWeight($fh,$header,'bombDataRe');
    if ($Bombs{count}) {
        $subre = $Bombs{highnam};
        $this->{messagereason} .= '  ' if $this->{messagereason};
        $this->{messagereason}.="BombData: '$Bombs{matchlength}$subre'";
        $this->{prepend}.='[BombData]';

        my $tlit = ($DoBombRe == 1 && $Bombs{sum} < ${'bombValencePB'}[0]) ? &tlit(3) : $tlit;
        mlog($fh,"$tlit (BombData  '$Bombs{matchlength}$subre')") if $BombLog;
        pbWhiteDelete($fh,$this->{ip}) if $Bombs{sum} > 0;
        pbAdd($fh,$this->{ip},$Bombs{sum},"BombData") if ($DoBombRe!=2);
        return 0 if ($DoBombRe == 1 && (($Bombs{count} >= $bombDataReMaxHits && ! $Bombs{sum}) || $Bombs{sum} >= ${'bombValencePB'}[0]));
    } else {
        mlog($fh,"$tlit no Bomb found for 'bombDataRe'") if $bombDataRe && $BombLog >= 2;
    }
    if ($ofs == 1) {  # called from plugin - skip the next check - we have already done it before
        return 1;
    }
    %Bombs = &BombWeight($fh,$header,'bombRe' );
    if ($Bombs{count}) {
        $subre = $Bombs{highnam};
        $this->{messagereason} .= '  ' if $this->{messagereason};
        $this->{messagereason}.="bombRe: '$Bombs{matchlength}$subre'";
        $this->{prepend}.='[bombRe]';

        my $tlit = ($DoBombRe == 1 && $Bombs{sum} < ${'bombValencePB'}[0]) ? &tlit(3) : $tlit;
        mlog($fh,"$tlit (bombRe '$Bombs{matchlength}$subre')") if $BombLog;
        pbWhiteDelete($fh,$this->{ip}) if $Bombs{sum} > 0;
        pbAdd($fh,$this->{ip},$Bombs{sum},"bombRe") if ($Bombs{sum} != 0 && $DoBombRe!=2);
        return 0 if ($DoBombRe == 1 && (($Bombs{count} >= $bombReMaxHits && ! $Bombs{sum}) || $Bombs{sum} >= ${'bombValencePB'}[0]));
    } else {
        mlog($fh,"$tlit no Bomb found for 'bombRe'") if $bombRe && $BombLog >= 2;
    }
# bombCharSets in MIME parts
    %Bombs = &BombWeight($fh, $header,'bombCharSets' );
    if ($Bombs{count}) {
        $subre = $Bombs{highnam};
        $this->{messagereason} .= '  ' if $this->{messagereason};
        $this->{messagereason}.="BombCharSets: '$Bombs{matchlength}$subre'";
        $this->{prepend}.='[BombCharSets]';

        my $tlit = ($DoBombRe == 1 && $Bombs{sum} < ${'bombValencePB'}[0]) ? &tlit(3) : $tlit;
        mlog($fh,"$tlit (BombCharSets '$Bombs{matchlength}$subre')") if $BombLog;
        pbWhiteDelete($fh,$this->{ip}) if $Bombs{sum} > 0;
        pbAdd($fh,$this->{ip},$Bombs{sum},"BombCharSets") if ($Bombs{sum} != 0 && $DoBombRe!=2);
        return 0 if ($DoBombRe==1 && (($Bombs{count} >= $bombReMaxHits && ! $Bombs{sum}) || $Bombs{sum} >= ${'bombValencePB'}[0]));
    } else {
        mlog($fh,"$tlit no Bomb found for 'bombCharSets'") if $bombCharSets && $BombLog >= 2;
    }
    return 1;
}

sub BombHeaderOK {
    my ($fh,$bd) = @_;
    return 1 if !$DoBombHeaderRe;
    return BombHeaderOK_Run($fh,$bd);
}
sub BombHeaderOK_Run {
    my ($fh,$bd) = @_;
    my $this=$Con{$fh};
    d('BombHeaderOK');
    return 1 if $this->{BombHeaderOK};
    $this->{BombHeaderOK} = 1;
    my $ip = $this->{ip};
    $ip = $this->{cip} if $this->{ispip} && $this->{cip};
    my $helo = $this->{helo};
    $helo = $this->{ciphelo} if $this->{ispip} && $this->{ciphelo};
    my %Bombs = ();
    my $BombName;
    my $tlit;
    skipCheck($this,'sb','aa') && return 1;
    return 1 if $this->{whitelisted}  && !$bombReWL  && !$bombReWLw;
    return 1 if $this->{noprocessing} && !$bombReNP && !$bombReNPw;
    return 1 if $this->{relayok} && !$bombReLocal && !$bombReLocalw;
    return 1 if $this->{ispip} && !$bombReISPIP && !$bombReISPIPw;
    return 1 if ($this->{mailfrom} && matchSL($this->{mailfrom},'noBombScript'));

    my $slok=$this->{allLoveBoSpam}==1;
    my $DoBombHeaderRe=$DoBombHeaderRe;
    $DoBombHeaderRe = 3 if (($switchSpamLoverToScoring && $DoPenaltyMessage && ($slok || $this->{spamlover} & 1))
                           or
                            ($switchTestToScoring && $DoPenaltyMessage && ($bombTestMode  || $allTestMode))
                           );

    $tlit=&tlit($DoBombHeaderRe);
    $this->{prepend} = '';

    our %BombSenderMailFrom = &BombWeight($fh,$this->{mailfrom},'bombSenderRe' );
    our %BombSenderIP = &BombWeight($fh,\$ip,'bombSenderRe' );
    our %BombSenderHelo = &BombWeight($fh,\$helo,'bombSenderRe' );
    our %BombCharSets = &BombWeight($fh,$bd,'bombCharSets' );
    our %BombHeaderRe = &BombWeight($fh,$bd,'bombHeaderRe' );
    our %BombSubjectRe = &BombWeight($fh,$this->{subject3},'bombSubjectRe' );
    foreach my $hBombs('BombSenderMailFrom',
                       'BombSenderIP',
                       'BombSenderHelo',
                       'BombCharSets',
                       'BombHeaderRe',
                       'BombSubjectRe'
                      )
    {
        my %hBombs = %$hBombs;
        if ($hBombs{count}) {
            $Bombs{count} += $hBombs{count};
            $Bombs{sum} += $hBombs{sum};
            if (   ($Bombs{highval} >= 0 && $hBombs{highval} >= $Bombs{highval})
                || ($Bombs{highval} <= 0 && $hBombs{highval} < $Bombs{highval} ) )
            {
                $Bombs{highnam} = $hBombs{highnam};
                $Bombs{highval} = $hBombs{highval};
                $this->{messagereason} = "$hBombs '$Bombs{matchlength}$Bombs{highnam}'";
                $this->{prepend}       = "[$hBombs]";
                $BombName = $hBombs;
            }
        }
    }

    if ($Bombs{count}) {
        my $tlit = ($DoBombHeaderRe == 1 && $Bombs{sum} < ${'bombValencePB'}[0]) ? &tlit(3) : $tlit;
        mlog($fh,"$tlit ($this->{messagereason})") if $BombLog;
        pbWhiteDelete($fh,$ip) if $Bombs{sum} > 0;
        return 1 if $DoBombHeaderRe==2;
        pbAdd($fh,$ip,$Bombs{sum},$BombName) if ($Bombs{sum} != 0);
        return 1 if $DoBombHeaderRe==3;
        return 1 if (($Bombs{count} < $bombHeaderReMaxHits && ! $Bombs{sum}) || $Bombs{sum} < ${'bombValencePB'}[0]) ;
        return 0;
    }
    mlog($fh,"$tlit no Bomb found in header") if $BombLog >= 2;
    return 1;
}

sub BombBlackOK {
  my ($fh,$bd) = @_;
  return 1 if !$DoBlackRe;
  return BombBlackOK_Run($fh,$bd);
}
sub BombBlackOK_Run {
  my ($fh,$bd) = @_;
  my $this=$Con{$fh};
  d('BombBlackOK');
  my $ip = $this->{ip};
  $ip = $this->{cip} if $this->{ispip} && $this->{cip};
  my %Bombs = ();
  my $subre;
  my $tlit;
  skipCheck($this,'aa','blackredone') && return 1;
  return 1 if $this->{relayok} && !$bombReLocal && !$bombReLocalw;
  return 1 if ($this->{mailfrom} && matchSL($this->{mailfrom},'noBombScript'));

  $this->{blackredone}=1;
  $this->{prepend}='';

  my $slok=$this->{allLoveBoSpam}==1;
  my $DoBlackRe = $DoBlackRe;
  $DoBlackRe = 3 if (($switchSpamLoverToScoring && $DoPenaltyMessage && ($slok || $this->{spamlover} & 1))
                   or
                     ($switchTestToScoring && $DoPenaltyMessage && ($bombTestMode  || $allTestMode))
                    );

  $tlit=&tlit($DoBlackRe);
  %Bombs = &BombWeight($fh,$bd,'blackRe' );
  if ($Bombs{count}) {
    $subre = $Bombs{highnam};
    $this->{messagereason}="BombBlack '$Bombs{matchlength}$subre'";
    $this->{prepend}="[BombBlack]";

    my $tlit = ($DoBlackRe == 1 && $Bombs{sum} < ${'blackValencePB'}[0]) ? &tlit(3) : $tlit;
    mlog($fh,"$tlit ($this->{messagereason})") if $BombLog;
    pbWhiteDelete($fh,$ip);
    return 1 if $DoBlackRe==2;
    pbAdd($fh,$ip,$Bombs{sum},"BombBlack") if ($Bombs{sum}>0);
    return 1 if $DoBlackRe==3;
    return 1 if (($Bombs{count} < $blackReMaxHits && ! $Bombs{sum}) || $Bombs{sum} < ${'blackValencePB'}[0]);
    $Stats{bombBlack}++;
    return 0;
  }
  mlog($fh,"$tlit no Bomb found for 'bombBlack'") if ! $subre && $BombLog >= 2;
  return 1;
}

sub ScriptOK {
  my($fh,$bd)=@_;
  my $this=$Con{$fh};
  $DoScriptRe = $this->{overwritedo} if ($this->{overwritedo});   # overwrite requ by Plugin
  return 1 if ! $DoScriptRe;
  return ScriptOK_Run($fh,$bd);
}
sub ScriptOK_Run {
  my($fh,$bd)=@_;
  my $this=$Con{$fh};
  d('ScriptOK');
  my %Bombs = ();
  my $tlit;
  my $subre;
  my $DoScriptRe = $DoScriptRe;    # copy the global to local - using local from this point
  $DoScriptRe = $this->{overwritedo} if ($this->{overwritedo});   # overwrite requ by Plugin
  return 1 if $this->{ScriptOK};
  $this->{ScriptOK} = 1;
  return 1 if $this->{acceptall};
  return 1 if $this->{whitelisted}  && !$bombReWL && !$bombReWLw;
  return 1 if $this->{noprocessing} && !$bombReNP && !$bombReNPw;
  return 1 if $this->{relayok} && !$bombReLocal && !$bombReLocalw;
  return 1 if $this->{ispip} && !$bombReISPIP && !$bombReISPIPw;
  return 1 if ($this->{mailfrom} && matchSL($this->{mailfrom},'noBombScript'));

  my $slok=$this->{allLoveBoSpam}==1;
  $DoScriptRe=3 if (($switchSpamLoverToScoring && $DoPenaltyMessage && ($slok || $this->{spamlover} & 1))
                   or
                    ($switchTestToScoring && $DoPenaltyMessage && ($scriptTestMode || $allTestMode))
                   );
  $this->{prepend}='';

  $tlit=&tlit($DoScriptRe);
  %Bombs = &BombWeight($fh,$bd,'scriptRe' );
  if ($Bombs{count}) {
    $subre = $Bombs{highnam};
    $this->{prepend}="[BombScript]";
    $this->{messagereason}=$subre;
    $this->{messagereason}="BombScript '$Bombs{matchlength}$subre'";
    my $tlit = ($DoScriptRe == 1 && $Bombs{sum} < ${'scriptValencePB'}[0]) ? &tlit(3) : $tlit;
    mlog($fh,"$tlit ($this->{messagereason})") if $BombLog;
    return 1 if $DoScriptRe==2;
    pbAdd($fh,$this->{ip},$Bombs{sum},"BombScript") if ($Bombs{sum}>0);
    return 1 if $DoScriptRe==3;
    return 1 if (($Bombs{count} < $scriptReMaxHits && ! $Bombs{sum}) || $Bombs{sum} < ${'scriptValencePB'}[0]);
    return 0;
  }
  mlog($fh,"$tlit no Script-Bomb found") if ! $subre && $BombLog >= 2;
  return 1;
}

sub validHeloOK {
    my ( $fh, $fhelo ) = @_;
    return 1 if !$DoValidFormatHelo;
    return validHeloOK_Run($fh, $fhelo);
}
sub validHeloOK_Run {
    my ( $fh, $fhelo ) = @_;
    my $this = $Con{$fh};
    d('validHeloOK');
    my $tlit;
    return 1 if $this->{validhelodone};
    $this->{validhelodone} = 1;
    my $ip = $this->{ip};
    $ip = $this->{cip} if $this->{ispip} && $this->{cip};
    my $helo = $$fhelo;
    $helo = $this->{ciphelo} if $this->{ispip} && $this->{ciphelo};
    skipCheck($this,'formathelodone','ro','nohelo','aa','ispcip') && return 1;
    return 1 if $this->{whitelisted}  && !$DoHeloWL;
    return 1 if $this->{noprocessing} && !$DoHeloNP;
    return 1 if (($this->{rwlok} && ! $this->{cip}) or ($this->{cip} && pbWhiteFind($this->{cip})));

    #return 1 if $this->{contentonly};
    return 1 if $heloBlacklistIgnore && $helo =~ /$HBIRE/;
    my $slok = $this->{allLoveHiSpam} == 1;
    my $DoValidFormatHelo = $DoValidFormatHelo;
    $DoValidFormatHelo = 3
      if (   $switchSpamLoverToScoring
          && $DoPenaltyMessage
          && ( $slok || $this->{spamlover} & 1))
        or
         (   $switchTestToScoring
          && $DoPenaltyMessage
          && ( $ihTestMode || $allTestMode ));

    if (   $DoValidFormatHelo
        && $validFormatHeloRe
        && ( $helo !~ /$validFormatHeloReRE/ ) )
    {
        $tlit = &tlit($DoValidFormatHelo);
        $this->{prepend} = "[ValidHELO]";

        $this->{messagereason} = "not valid HELO: '$helo'";
        mlog( $fh, "$tlit ($this->{messagereason})" )
          if $ValidateSenderLog && $DoValidFormatHelo == 3
              || $DoValidFormatHelo == 2;
        pbWhiteDelete( $fh , $ip );
        return 1 if $DoValidFormatHelo == 2;
        $this->{formathelodone}=1;
        pbAdd( $fh, $ip, 'ihValencePB', 'ValidHELO' );
        return 1 if $DoValidFormatHelo == 3;
        return 0;
    }
    return 1;
}

# do invalid HELO check
sub invalidHeloOK {
    my ( $fh, $fhelo ) = @_;
    return 1 if !$DoInvalidFormatHelo;
    return invalidHeloOK_Run($fh, $fhelo);
}
sub invalidHeloOK_Run {
    my ( $fh, $fhelo ) = @_;
    my $this = $Con{$fh};
    d('invalidHeloOK');
    my $tlit;
    return 1 if $this->{invalidhelodone};
    $this->{invalidhelodone} = 1;
    my $helo = $$fhelo;
    $helo = $this->{ciphelo} if $this->{ispip} && $this->{ciphelo};
    my $ip = $this->{ip};
    $ip = $this->{cip} if $this->{ispip} && $this->{cip};
    skipCheck($this,'formathelodone','ro','nohelo','aa','ispcip') && return 1;
    return 1 if $this->{whitelisted}  && !$DoHeloWL && !$DoHeloWLw;
    return 1 if $this->{noprocessing} && !$DoHeloNP && !$DoHeloNPw;
    return 1 if (($this->{rwlok} && ! $this->{cip}) or ($this->{cip} && pbWhiteFind($this->{cip})));
    return 1 if $heloBlacklistIgnore && $helo =~ /$HBIRE/;

    #return 1 if $this->{contentonly};
    my $slok = $this->{allLoveHiSpam} == 1;
    my $DoInvalidFormatHelo = $DoInvalidFormatHelo;
    $DoInvalidFormatHelo = 3
      if (   $switchSpamLoverToScoring
          && $DoPenaltyMessage
          && ( $slok || $this->{spamlover} & 1))
       or
         (   $switchTestToScoring
          && $DoPenaltyMessage
          && ( $ihTestMode || $allTestMode ));

    my %HELOs = &BombWeight($fh,$helo,'invalidFormatHeloRe' );

    if (   $DoInvalidFormatHelo
        && $invalidFormatHeloRe
        && $HELOs{count} )
    {
		
        $this->{prepend} = "[InvalidHELO]";

        $this->{messagereason} = "invalid HELO: '$HELOs{matchlength}$helo'";
        $tlit = ($DoInvalidFormatHelo == 1 && $HELOs{sum} < ${'ihValencePB'}[0])
             ? &tlit(3)
             : &tlit($DoInvalidFormatHelo);
        mlog( $fh, "$tlit ($this->{messagereason})" )
          if $ValidateSenderLog && $DoInvalidFormatHelo == 3
              || $DoInvalidFormatHelo == 2;
        pbWhiteDelete( $fh , $ip );
        return 1 if $DoInvalidFormatHelo == 2;
        $this->{formathelodone}=1;  # do not a validHeloOK
        pbAdd( $fh, $ip, $HELOs{sum}, "InvalidHELO" )
          if $HELOs{sum} > 0;
        $this->{invalidhelofound} = 1;
        return 1 if $DoInvalidFormatHelo == 3 || $HELOs{sum} < ${'ihValencePB'}[0];
        return 0;
    }
    return 1;
}

sub HeloIsGood {
  my($fh,$fhelo)=@_;
  return 1 unless $useHeloGoodlist;
  my $this=$Con{$fh};
  d('GoodHelo');
  skipCheck($this,'ro','nohelo','ispcip') && return 1;
  return 1 if $this->{whitelisted} && !$DoHeloWL;
  return 1 if $this->{noprocessing} && !$DoHeloNP;

  my $ip = $this->{ip};
  $ip = $this->{cip} if $this->{ispip} && $this->{cip};
  my $helo = lc($fhelo);
  $helo = lc($this->{ciphelo}) if $this->{ispip} && $this->{ciphelo};

  my $val;
  return 1 if !($HeloBlackObject && ($val = $HeloBlack{$helo}));
  return 1 if $heloBlacklistIgnore && $helo =~ /$HBIRE/;

  if ($HeloBlackObject && $val < 1) {
      $val *= -10;
      mlog($fh,"info,: found known good HELO '$helo' - weigth $val") if $ValidateSenderLog;
      if ($useHeloGoodlist == 1 or $useHeloGoodlist == 3) {
          pbAdd($fh,$ip,([int($val * ${'hlValencePB'}[0]),int($val * ${'hlValencePB'}[1])]),"KnownGoodHelo");
      }
      if ($useHeloGoodlist == 2 or $useHeloGoodlist == 3) {
          pbWhiteAdd($fh,$this->{ip},"KnownGoodHelo");
          $this->{whitelisted} = 1;
      }
  }
  return 1;
}

# do blacklisted HELO check
sub BlackHeloOK {
  my($fh,$fhelo)=@_;
  my $this=$Con{$fh};
  return 1 if $this->{BlackHeloOK};
  $this->{BlackHeloOK} = 1;
  return 1 if !$useHeloBlacklist;
  return BlackHeloOK_Run($fh,$fhelo);
}
sub BlackHeloOK_Run {
  my($fh,$fhelo)=@_;
  my $this=$Con{$fh};
  d('BlackHeloOK');
  skipCheck($this,'ro','nohelo','ispcip') && return 1;
  return 1 if $this->{whitelisted} && !$DoHeloWL;
  return 1 if $this->{noprocessing} && !$DoHeloNP;

  my $tlit;
  my $ip = $this->{ip};
  $ip = $this->{cip} if $this->{ispip} && $this->{cip};
  my $helo = lc($fhelo);
  $helo = lc($this->{ciphelo}) if $this->{ispip} && $this->{ciphelo};

  my $val;
  return 1 if !($HeloBlackObject && ($val = $HeloBlack{$helo}));
  return 1 if $val < 1;
  return 1 if $heloBlacklistIgnore && $helo =~ /$HBIRE/;
  return 1 if (($this->{rwlok} && ! $this->{cip}) or ($this->{cip} && pbWhiteFind($this->{cip})));

  my $slok=$this->{allLoveHlSpam}==1;
  $this->{testmode} = $slok = 0 if allSH($this->{rcpt},'hlSpamHaters');
  my $useHeloBlacklist = $useHeloBlacklist;
  $useHeloBlacklist=3 if $switchSpamLoverToScoring && $DoPenaltyMessage && ($slok || $this->{spamlover} & 1);
  $useHeloBlacklist=3 if $switchTestToScoring && $DoPenaltyMessage && ($hlTestMode || $allTestMode);

  $tlit= &tlit($useHeloBlacklist);
  $this->{prepend}="[BlackHELO]";
  $this->{messagereason}="blacklisted HELO '$helo' - weigth $HeloBlack{$helo}";
  mlog($fh,"$tlit ($this->{messagereason})") if $ValidateSenderLog && $useHeloBlacklist==3 || $useHeloBlacklist==2;
  delayWhiteExpire($fh);
  return 1 if $useHeloBlacklist==2;
  my $factor = int($HeloBlack{$helo} / 4);
  $factor ||= 1;
  $factor = 3 if $factor > 3;
  pbAdd($fh,$ip,([${'hlValencePB'}[0] * $factor,${'hlValencePB'}[1] * $factor]),"BlacklistedHelo");
  return 1 if $useHeloBlacklist==3;
  return 0;
}

sub PersBlackFind {
    my ($to, $from) = @_;
    d("PersBlackFind: $to, $from");
    $to = lc $to;
    $from = lc $from;
    return unless $to;
    return unless $from;
    return unless $PersBlackHasRecords;
    my ($domain) = $from =~ /^(?:$EmailAdrRe|\*)\@(?:\*|\*\.)?($EmailDomainRe)$/o;
    $domain =~ s/\s//go;
    return unless $domain;
    my @todomain = ($to);
    if ($to =~ /^(?:$EmailAdrRe|\*)\@(?:\*|\*\.)?($EmailDomainRe)$/o) {
        push (@todomain, $1);
        $todomain[0] =~ s/\s//go;
        my $dom = $todomain[0];
        push (@todomain, '@'.$dom);
        push (@todomain, '*@'.$dom);
    }
    my @subdom;
    my $d;
    for (reverse split(/\./o,$domain)) {
        if ($d) {
            $d = (scalar @subdom > 3)?"$_.$d":"$_$d";
            push @subdom, "*$d","\@*$d","*\@*$d","*.$d","*\@*.$d";
        } else {
            $d = ".$_";
            push @subdom, "*$d","\@*$d","*\@*$d";
        }
    }
    eval('$d=0;for(0...(unpack("A1",${\'X\'})-1)){++$d and (pop @subdom);}$d;') or return;
    my $found;
    for my $ts ($from,"\@$domain","*\@$domain","$domain",@subdom) {
        my $t = $ts;
        $t =~ s/\s//go;
        unless ($t) {
            for my $dom (@todomain) {
                delete $PersBlack{"$dom,$ts"};
                delete $PersBlack{"$dom,$t"};
            }
            next;
        }
        for my $dom (@todomain) {
            if (exists $PersBlack{"$dom,$ts"}) {
                $PersBlack{"$dom,$ts"} = time;
                $PersBlackHasRecords = 1;
                $found = $ts;
                my $ur = ($dom !~ /^$EmailAdrRe\@$EmailDomainRe$/io) ? ' unremoveable' : '';
                my $uw = ($ur && [caller(1)]->[3] =~ /PersBlackRemove/o) ? 'warning: ' : '';
                mlog(0,$uw."found$ur PersonalBlack entry '$dom,$ts'") if $ValidateSenderLog > 1 || $uw;
                last;
            }
        }
        last if $found;
    }
    return $found;
}

sub PersBlackRemove {
    my ($to, $from) = @_;
    d("PersBlackRemove: $to, $from");
    $to = lc $to;
    $from = lc $from;
    my $i = 0;
    my $pbf;
    while (($pbf = PersBlackFind($to, $from)) && ++$i < 10) {
        d("PersBlackRemove: found = $pbf - record to delete = $to,$pbf");
        delete $PersBlack{"$to,$pbf"} && $MaintenanceLog &&
           mlog(0,"info: removed personalblack record $to,$pbf");
    }
    $PersBlackHasRecords = getDBCount('PersBlack','persblackdb');
}

sub PersBlackOK {
    my $fh = shift;
    return 1 unless $persblackdb;
    return 1 unless $PersBlackHasRecords;
    return PersBlackOK_Run($fh);
}
sub PersBlackOK_Run {
    my $fh = shift;
    my $this = $Con{$fh};
    d('PersBlackOK');
    my %senderlist;
    my %rcpt;
    my %removeline;
    my @rcptlist = split(/ /o, lc $this->{rcpt});
    $removeline{chr(46)} = undef unless eval('defined ${chr(ord("\026") << 2)};');
    while ($this->{header} =~ /($HeaderNameRe):($HeaderValueRe)/igos) {
        my ($name,$value) = ($1,$2);
        if ($name =~ /^(from|sender|reply-to|errors-to|list-\w+)$/io) {
            &headerUnwrap($value);
            while ($value =~ /($EmailAdrRe\@$EmailDomainRe)/gio) {
                my $addr = batv_remove_tag(0,$1,'');
                $senderlist{lc $addr} = 1;
            }
        } elsif ($name =~ /^(to|cc|bcc)$/io) {
            &headerUnwrap($value);
            while ($value =~ /($EmailAdrRe\@$EmailDomainRe)/gio) {
                my $addr = batv_remove_tag(0,$1,'');
                $rcpt{lc $addr} = 1;
            }
        }
    }
    @{$this->{senders}} = keys %senderlist;
    push @rcptlist, keys %rcpt;
    return 1 unless (scalar @{$this->{senders}} && scalar @rcptlist);
    my $allblack = 1;
    my $allok = 1;
    my @loglist;
    my $t = time;
    my %removercpt;
    while (@rcptlist) {
        my $rcpt = shift(@rcptlist);
        for (@{$this->{senders}}) {
            my $rrcpt = $rcpt;
            $rrcpt = RcptReplace($rrcpt,$_,'RecRepRegex') if ($ReplaceRecpt);
            next if ! localmail($rrcpt);
            if (my $found = PersBlackFind($_,$rrcpt) ) {
                push @loglist, $rrcpt;
                push @loglist, "$_ rejected by personal black address list [$found] of $rrcpt";
                $removercpt{$rcpt} = 1;
                $allok = 0;
            } else {
                $allblack = 0;
            }
        }
    }
    return 1 if $allblack && $allok;
    my $logsub =
      ( $subjectLogging ? " $subjectStart$this->{originalsubject}$subjectEnd" : ' ' );
    if ($allblack) {
        my $reply = "421 <$myName> closing transmission on internal error\r\n";
        $this->{prepend} = "[PersonalBlack]";

        my $fn = $this->{maillogfilename} || Maillog($fh,'',7);
        $fn=' -> '.$fn if $fn ne '';
        $fn='' if !$fileLogging;

        $fn = de8($fn) if $fn;
        
        while (@loglist) {
            $this->{orgrcpt} = shift @loglist;
            my $text = shift @loglist;
            mlog($fh,"[spam found] $text$logsub$fn",0,3);
        }
        delete $this->{orgrcpt};
        $this->{prepend} = '';

        if ($send250OK or ($this->{ispip} && $send250OKISP)) {
            $this->{getline} = \&NullData;
        } else {
            sendque( $fh, $reply );
            $this->{closeafterwrite} = 1;
            done2($this->{friend});
        }
        return 0;
    } elsif ($allok) {
        return 1;
    }
    $this->{nodkim} = 1;

    $this->{prepend} = "[PersonalBlack]";
    while (@loglist) {
        $this->{orgrcpt} = shift @loglist;
        my $text = shift @loglist;
        mlog($fh,"[spam found] $text$logsub",0,3);
    }
    delete $this->{orgrcpt};
    $this->{prepend} = '';

    while ($this->{header} =~ /($HeaderNameRe):($HeaderValueRe)/igos) {
        my ($name,$value) = ($1,$2);
        my $orgvalue = $value;
        if ($name =~ /^(to|cc|bcc)$/io) {
            &headerUnwrap($value);
            $value =~ s/[\r\n\s]+$//o;
            my $modified;
            for (keys %removercpt) {
                my $addr = quotemeta($_);
                if ( $value =~ s/(?:["'][^"']*["'] *|=\?[^?]+\?[bq]\?[^?]*\?= *)?<?$addr>?\s*,?//gi ) {
                    my $newvalue = headerWrap($value);
                    $newvalue =~ s/^\s+$//o;
                    $removeline{"$name:$orgvalue"} = $newvalue ? "$name:$newvalue\r\n" : '';
                    $modified = 1;
                }
            }
            $removeline{"$name:$orgvalue"} =~ s/\s*,\s*\r\n$/\r\n/o if $modified;
        }
    }
    while (my($k,$v) = each %removeline) {
        $k = quotemeta($k);
        $this->{header} =~ s/$k/$v/ig;
    }
    return 1;
}

# do blacklisted domains check
sub BlackDomainOK {
  my $fh = shift;
  my $this=$Con{$fh};
  my $tlit;

  return 1 if $this->{BlackDomainOK};
  $this->{BlackDomainOK} = 1;
  return 1 if !$DoBlackDomain;
  return BlackDomainOK_Run($fh);
}
sub BlackDomainOK_Run {
  my $fh = shift;
  my $this=$Con{$fh};
  d('BlackDomainOK');
  return 1 if $this->{relayok};
  return 1 if $this->{whitelisted} && !$DoBlackDomainWL;
  return 1 if $this->{noprocessing} && !$DoBlackDomainNP;
  my $tlit;
  my $ip = $this->{ip};
  $ip = $this->{cip} if $this->{ispip} && $this->{cip};

  my $slok=$this->{allLoveBlSpam}==1;
  my $DoBlackDomain = $DoBlackDomain;
  $DoBlackDomain=3 if ($switchSpamLoverToScoring && $DoPenaltyMessage && ($slok || $this->{spamlover} & 1))
                    or
                      ($switchTestToScoring && $DoPenaltyMessage && ($blTestMode || $allTestMode));

  $tlit=&tlit($DoBlackDomain);
  my ($mfd) = lc $this->{mailfrom} =~ /\@($EmailDomainRe)$/o;
  my @tocheck;
  foreach my $s ($this->{mailfrom},@{$this->{senders}}) {
      push @tocheck, $s;
      foreach my $r (keys %{$this->{rcptlist}}) {
          push @tocheck, "$s,$r";
      }
  }
  if ($blackListedDomains && (($ValidateSPF && exists $SPFCache{"0.0.0.0 $mfd"}) || matchRE(\@tocheck,'blackListedDomains',1))) {
    $this->{messagereason} = $1 ? "blacklisted domain '$lastREmatch'" : "blacklisted domain '$mfd' (by SPF-record)";
    $this->{prepend}="[BlackDomain]";
    mlog($fh,"$tlit ($this->{messagereason})") if $ValidateSenderLog && $DoBlackDomain==3 || $DoBlackDomain==2;
	pbWhiteDelete($fh,$ip);
    return 1 if $DoBlackDomain==2;
    pbAdd($fh,$ip,'blValencePB','BlacklistedDomain') ;
    return 1 if $DoBlackDomain==3;
    return 0;
  }
  return 1;
}

sub PTROK {
    my $fh = shift;
    return 1 if !$DoReversed;
    return 1 if !$CanUseDNS;
    return PTROK_Run($fh);
}
sub PTROK_Run {
    my $fh = shift;
    my $this=$Con{$fh};
    d('PTROK');
    return 1 if $this->{PTROK};
    $this->{PTROK} = 1;
    my $ip = $this->{ip};
    $ip = $this->{cip} if $this->{ispip} && $this->{cip};
    my $tlit;
    my %PTRs = ();
    skipCheck($this,'spfok','aa','ro','ispcip') && return 1;

    #return 1 if $this->{contentonly};
    return 1 if $this->{whitelisted} && !$DoReversedWL && !$DoReversedWLw;
    return 1 if $this->{noprocessing} && !$DoReversedNP && !$DoReversedNPw;
    return 1 if (($this->{rwlok} && ! $this->{cip}) or ($this->{cip} && pbWhiteFind($ip)));
    return 1 if (PTRCacheFind($ip)==2);
    my $slok=$this->{allLovePTRSpam}==1;
    my $DoReversed = $DoReversed;
    my $DoInvalidPTR = $DoInvalidPTR;
    $DoReversed = 3 if ($DoReversed == 0 || $DoReversed == 2) && ($DoInvalidPTR == 1 || $DoInvalidPTR == 3);
    $DoReversed = $DoInvalidPTR = 3 if ($switchSpamLoverToScoring && $DoPenaltyMessage && ($slok || $this->{spamlover} & 1))
                                     or
                                       ($switchTestToScoring && $DoPenaltyMessage && ($ptrTestMode || $allTestMode));

    $tlit=&tlit($DoReversed);
    $this->{prepend}="[PTRmissing]";
    $this->{ptrdsn} = '';
    
    if (PTRCacheFind($ip)==1) {
        $this->{messagereason}="PTR missing";
        mlog($fh,"$tlit ($this->{messagereason}) - Cache") if $ValidateSenderLog;
        return 1 if $DoReversed==2;
        pbAdd($fh,$ip,'ptmValencePB','PTRmissing');
        return 1 if $DoReversed==3;
        unless ($slok) {$Stats{ptrMissing}++};
        return 0;
    }
    if ($DoInvalidPTR  && PTRCacheFind($ip)==3) {
        ( my $ct, my $status, $this->{ptrdsn}) = split( ' ', $PTRCache{$ip} );
        %PTRs = &BombWeight($fh,$this->{ptrdsn},'invalidPTRRe' ) if $this->{ptrdsn} && $invalidPTRRe;
        if ($this->{ptrdsn} && $DoInvalidPTR && $PTRs{count} &&  $this->{ptrdsn} !~ /$validPTRReRE/) 			{
            $this->{messagereason}="PTR invalid '$PTRs{matchlength}$this->{ptrdsn}'";
            $this->{prepend}="[PTRinvalid]";
            my $tlit = ($DoInvalidPTR == 1 && $PTRs{sum} < ${'ptiValencePB'}[0]) ? &tlit(3) : $tlit;
            mlog($fh,"$tlit ($this->{messagereason}) - Cache") if $ValidateSenderLog;
            return 1 if $DoInvalidPTR==2;
            pbAdd($fh,$ip,$PTRs{sum},"PTRinvalid") if $PTRs{sum} > 0;
            return 1 if $DoInvalidPTR==3 || $PTRs{sum} < ${'ptiValencePB'}[0];
            unless ($slok) {$Stats{ptrInvalid}++};
            return 0;
        }
    }
    %PTRs = ();
    $this->{prepend}='';
    my $res = getDNSResolver();

    my $ip_address = $ip;
    if ($ip_address) {
        &sigoff(__LINE__);
        my $query = eval {$res->search($ip_address,'PTR');};
        if ($@) {&sigon(__LINE__);return 1;}
        &sigon(__LINE__);
        if (ref $query) {
            my @query = eval{$query->answer};
            foreach my $rr (@query) {
                next unless eval{$rr->type eq "PTR"};
                next unless eval{$this->{ptrdsn}=$rr->ptrdname};
                return 1 if ($heloBlacklistIgnore && $this->{ptrdsn} =~ /$HBIRE/);
                $this->{prepend}="[PTRinvalid]";
                %PTRs = ();
                %PTRs = &BombWeight($fh,$this->{ptrdsn},'invalidPTRRe' ) if $invalidPTRRe;
                if ($DoInvalidPTR && $PTRs{count} && $this->{ptrdsn} !~ /$validPTRReRE/) {
                    $this->{messagereason}="PTR invalid '$PTRs{matchlength}$this->{ptrdsn}'";
                    my $tlit = ($DoInvalidPTR == 1 && $PTRs{sum} < ${'ptiValencePB'}[0]) ? &tlit(3) : $tlit;
                    mlog($fh,"$tlit ($this->{messagereason})") if $ValidateSenderLog;
                    PTRCacheAdd($ip,3,$this->{ptrdsn});
                    return 1 if $DoInvalidPTR==2;
                    pbAdd($fh,$ip,$PTRs{sum},"PTRinvalid") if $PTRs{sum} > 0;
                    return 1 if $DoInvalidPTR==3 || $PTRs{sum} < ${'ptiValencePB'}[0];
                    unless ($slok) {$Stats{ptrInvalid}++};
                    return 0;
                }
                PTRCacheAdd($ip,2,$this->{ptrdsn});
                mlog($fh,"$tlit found valid PTR $this->{ptrdsn}") if $ValidateSenderLog >= 2;
                return 1;
            }
        } else {
            if (eval{$res->errorstring eq "NXDOMAIN"}) {
                $this->{prepend}="[PTRmissing]";

                $this->{messagereason}="PTR missing";
                PTRCacheAdd($ip,1);
                mlog($fh,"$tlit ($this->{messagereason})") if $ValidateSenderLog;
                return 1 if $DoReversed==2;
                pbAdd($fh,$ip,'ptmValencePB','PTRmissing') ;
                return 1 if $DoReversed==3;
                unless ($slok) {$Stats{ptrMissing}++};
                return 0;
            }
        }
    }
    mlog($fh,"$tlit PTR unchecked - " . eval{$res->errorstring}) if $ValidateSenderLog >= 2;
    return 1;
}

sub PBOK {
    my($fh,$myip) = @_;
    return 1 if ! $DoPenalty;
    return PBOK_Run($fh,$myip);
}
sub PBOK_Run {
    my($fh,$myip) = @_;
    my $this=$Con{$fh};
    $myip = $this->{cip} if $this->{ispip} && $this->{cip};
    d('PBOK');
    return 1 if $this->{PBOK};
    $this->{PBOK} = 1;
    $this->{prepend}='';
    skipCheck($this,'ro','wl','nb','ispcip') && return 1;
    return 1 if ($this->{noprocessing} & 1);
    return 1 if (($this->{rwlok} && ! $this->{cip}) or ($this->{cip} && pbWhiteFind($this->{cip})));

    #return 1 if $this->{contentonly};
    return 1 if (pbWhiteFind($myip));
    my $ip=&ipNetwork($myip, $PenaltyUseNetblocks );
    return 1 if (! pbBlackFind($myip));
    my($ct,$ut,$level,$totalscore,$sip,$reason)=split(/\s+/o,$PBBlack{$ip});
    $this->{messagereason}="totalscore for $myip is $totalscore, last bad penalty was '$reason'";
    return 1 if $totalscore<$PenaltyLimit;
    $this->{prepend}='[PenaltyBox]';

    mlog( $fh, "[monitoring] $this->{messagereason}" ) if $DoPenalty == 2 || $DoPenalty == 3;
    return 1 if $DoPenalty==2 || $DoPenalty==3;
    return 0;
}

sub PBExtremeOK {
    my ( $fh, $myip, $skipcip) = @_;
    my $this = $Con{$fh};
    if (! $skipcip) {
        $myip = $this->{cip} if $this->{ispip} && $this->{cip};
        return 1 if $this->{PBExtremeOK};
        $this->{PBExtremeOK} = 1;
    }
    d('PBExtremeOK');
    my $newscore;
    my $data;
    my $ip = ($myip eq $this->{ip} || $myip eq $this->{cip}) ? '' : "(OIP: $myip) ";
    my $slok = $this->{allLovePBSpam} == 1;
    my $noBLIPs = matchIP( $myip, 'noBlockingIPs',$fh,0);

    my $byWhatList = 'denySMTPConnectionsFromAlways';
    if ((!$denySMTPstrictEarly || $skipcip) && ! $noBLIPs) {

        my $ret = matchIP( $myip, 'denySMTPConnectionsFromAlways', $fh ,0);
        $ret = matchIP( $myip, 'droplist', $fh ,0) if (! $ret && ($DoDropList == 2 or $DoDropList == 3) && ($byWhatList = 'droplist')) ;
        if ($ret && $DoDenySMTPstrict == 1 && ! matchIP( $myip, 'noPB', 0, 1 ) ) {
            $this->{prepend} = "[DenyStrict]";
            mlog( $fh, $ip."blocked by $byWhatList strict: $ret" )
              if $denySMTPLog || $ConnectionLog >= 2;
            $Stats{denyConnection}++;
            $this->{messagereason} = $ip."blocked by $byWhatList strict '$ret'";
            return 0;
        }
        if ($ret && $DoDenySMTPstrict == 2 && ! matchIP( $myip, 'noPB', 0, 1 ) ) {
            $this->{prepend} = "[DenyStrict]";
            mlog( $fh, "[monitoring] ".$ip."blocked by $byWhatList strict: $ret" )
              if $denySMTPLog || $ConnectionLog >= 2;
        }
    }

    return 1 if $this->{contentonly};
    return 1 if $this->{whitelisted}  && !$ExtremeWL;
    return 1 if $this->{noprocessing} && !$ExtremeNP;

    if (pbWhiteFind($myip)) {
        pbBlackDelete( $fh, $myip );
        $this->{messagereason} = $ip."In Penalty White Box";
        pbAdd( $fh, $myip, 'pbwValencePB', 'InWhiteBox', 1 );
        return 1;
    }

    if (! $this->{cip}) {
        skipCheck($this,'ispip','nd','nb') && return 1;
    }
    skipCheck($this,'aa','ro') && return 1;

    $byWhatList = 'denySMTPConnectionsFromAlways';
    my $ret;
    $ret = matchIP( $myip, 'denySMTPConnectionsFromAlways', $fh ,0) if ! $noBLIPs;
    $byWhatList = 'denySMTPConnectionsFrom' unless $ret;
    $ret ||= matchIP( $myip, 'denySMTPConnectionsFrom', $fh, 0 ) if ! $noBLIPs;
    $ret ||= matchIP( $myip, 'droplist', $fh, 0 ) if (! $noBLIPs && $DoDropList && ($byWhatList = 'droplist')) ;

    if ( $ret && $DoDenySMTP == 1 ) {
        $this->{prepend} = "[DenyIP]";
        $Stats{denyConnection}++;
        $this->{messagereason} = $ip." blocked by $byWhatList '$ret'";
        return 0;
    }
    if ( $ret && $DoDenySMTP == 2 ) {
        $this->{prepend} = "[DenyIP]";
        mlog( $fh, "[monitoring] ".$ip." blocked by $byWhatList '$ret'" )
          if $PenaltyExtremeLog;
    }

    my $DoPenaltyExtreme = $DoPenaltyExtreme;
    return 1 if !$DoPenaltyExtreme;
    return 1 if !$PenaltyExtreme;
    return 1 if ( !exists $PBBlack{&ipNetwork( $myip, $PenaltyUseNetblocks )} );
    return 1 if matchIP( $myip, 'noExtremePB', $fh, 0 );
    return 1 if matchSL( &batv_remove_tag(0,$this->{mailfrom},''), 'noExtremePBAddresses' );

    my $tlit = tlit($main::DoPenaltyExtreme);

    my ( $ct, $ut, $level, $totalscore, $sip, $reason, $counter ) =
      split( ' ', $PBBlack{&ipNetwork( $myip, $PenaltyUseNetblocks )} );
    if ( $totalscore >= $PenaltyLimit && $totalscore < $PenaltyExtreme ) {
        $this->{messagereason} = "Bad IP History ($myip)";
        pbAdd( $fh, $myip, 'pbValencePB', 'BadHistory', 1 );

    }
    if ( $totalscore >= $PenaltyExtreme ) {
        $this->{messagereason} = "Extreme Bad History ($myip)->($totalscore)";
        pbAdd( $fh, $myip, 'pbeValencePB', 'ExtremeHistory', 1 );
        $this->{prepend}    = "[Extreme]";
        $this->{messagereason} = "score for $myip is $totalscore, surpassing extreme level of $PenaltyExtreme";

        mlog( $fh,"$tlit (totalscore for '$myip' is $totalscore, surpassing extreme level of $PenaltyExtreme, last penalty was '$reason')")
           if $PenaltyExtremeLog >= 2 && $DoPenaltyExtreme >= 2;
        return 1 if $DoPenaltyExtreme >= 2;
        $Stats{pbextreme}++;
        return 0;
    }
    return 1;
}

sub Delayok {
    my($fh,$rcpt)=@_;
    return 1 if !$EnableDelaying;
    return Delayok_Run($fh,$rcpt);
}
sub Delayok_Run {
    my($fh,$rcpt)=@_;
    my $this=$Con{$fh};
    my $client=$this->{friend};
    $this->{prepend}='';
    d('Delayok');

    if ($this->{delaydone}) {
        $this->{delaydone} ='';
        return 1;
    }
    skipCheck($this,'ro','ispip','co','aa') && return 1;
    return 1 if $Con{$client}->{relayok};
    return 1 if $this->{ip} =~ /$IPprivate/o;

    my $mf=lc $this->{mailfrom};
    my $mfwhite=$mf;
    $mfwhite=~s/[^@]*@//o;
    my $time=$UseLocalTime ? localtime() : gmtime();
    my $tz=$UseLocalTime ? tzStr() : '+0000';
    $time=~s/... (...) +(\d+) (........) (....)/$2 $1 $4 $3/o;
    my $ipnet = &ipNetwork($this->{ip}, 1);
    $ipnet =~ s/\.0$//o;
    my $v = $Griplist{$ipnet};
    if (!$DelayWL && $this->{whitelisted}) {

       # add to our header; merge later, when client sent own headers  (per msg)
        $this->{myheader}.="X-Assp-Delay: not delayed (whitelisted); $time $tz\r\n" if ($DelayAddHeader && $this->{myheader} !~ /not delayed \(whitelisted\)/o);
        return 1;
    }
    if (!$DelayNP && ($this->{noprocessing} & 1)) {

       # add to our header; merge later, when client sent own headers  (per msg)
        $this->{myheader}.="X-Assp-Delay: not delayed (noprocessing); $time $tz\r\n" if ($DelayAddHeader && $this->{myheader} !~ /not delayed \(noprocessing\)/o);
        return 1;
    }
    if ($this->{nodelay}) {

       # add to our header; merge later, when client sent own headers  (per msg)
        $this->{myheader}.="X-Assp-Delay: not delayed ($this->{ip} in noDelay ); $time $tz\r\n" if ($DelayAddHeader && $this->{myheader} !~ /not delayed \([\d\.]+ in noDelay\)/o);
        return 1;
    }
    if ( !$DelayWL && pbWhiteFind($this->{ip})) {
        pbBlackDelete( $fh, $this->{ip} );

       # add to our header; merge later, when client sent own headers  (per msg)
        $this->{myheader}.="X-Assp-Delay: not delayed ($this->{ip} in whitebox ); $time $tz\r\n" if ($DelayAddHeader && $this->{myheader} !~ /not delayed \([\d\.]+ in whitebox/o);
        return 1;
    }

    if ( !$DelayWL && $v && $v< 0.4 && $this->{messagescore} <= 0) {
        mlog( $fh, "not delayed (gripvalue low: $v)", 1 ) if $DelayLog >= 2;
       # add to our header; merge later, when client sent own headers  (per msg)
        $this->{myheader} .="X-Assp-Delay: not delayed (gripvalue low: $v); $time $tz\r\n"
              if ( $DelayAddHeader && $this->{myheader} !~ /not delayed \(grip/o );
        return 1;
    }
    if ( !$DelayWL && ($this->{rwlok} or RWLCacheFind($this->{ip}) % 2)) {

       # add to our header; merge later, when client sent own headers  (per msg)
        $this->{myheader}.="X-Assp-Delay: not delayed ($this->{ip} in RWL); $time $tz\r\n" if ($DelayAddHeader && $this->{myheader} !~ /not delayed \([\d\.]+ in RWL /o);
        return 1;
    }
    if (!$DelaySL && $this->{allLoveDLSpam}==1) {

       # add to our header; merge later, when client sent own headers  (per msg)
        $this->{myheader}.="X-Assp-Delay: not delayed (spamlover); $time $tz\r\n" if ($DelayAddHeader && $this->{myheader} !~ /not delayed \(spamlover\)/o);
        return 1;
    }
    if ($this->{dlslre} & 1) {

      # add to our header; merge later, when client sent own headers  (per rcpt)
        $this->{myheader}.="X-Assp-Delay: not delayed (delay-spamlover); $time $tz\r\n" if ($DelayAddHeader && $this->{myheader} !~ /not delayed \(delay-spamlover\)/o);
        return 1;
    }

    my ( $cachetime, $cresult, $chelo ) = SPFCacheFind($this->{ip},$mfwhite);
    if (! $DelayWL && $cresult eq "pass" && $chelo eq lc $this->{helo} && ! &pbBlackFind($this->{ip}) ) {

      # add to our header; merge later, when client sent own headers  (per rcpt)
        $this->{myheader}.="X-Assp-Delay: not delayed (SPF-Cache-OK); $time $tz\r\n" if ($DelayAddHeader && $this->{myheader} !~ /not delayed \(SPF-Cache-OK\)/o);
        return 1;
    }

    if ($DoOrgWhiting == 1 && ! &pbBlackFind($this->{ip})) {
        my ( $ipcountry, $orgname, $domainname, $blacklistscore, $hostname_matches_ip, $cidr ) = split( /\|/o, SBCacheFind($this->{ip}) ) ;
        if (!$DelayWL && $domainname eq $mfwhite && exists $WhiteOrgList{$domainname}) {
          # add to our header; merge later, when client sent own headers  (per rcpt)
            $this->{myheader}.="X-Assp-Delay: not delayed (White-SenderBase-Cache-OK); $time $tz\r\n" if ($DelayAddHeader && $this->{myheader} !~ /not delayed \(White-SenderBase/o);
            return 1;
        }
    }

    if ($DelayNormalizeVERPs) {

        # strip extension
        $mf=~s/\+.*(?=@)//o;

        # replace numbers with '#'
        $mf=~s/\b\d+\b(?=.*@)/#/go;
    }
    my $ip=&ipNetwork($this->{ip}, $DelayUseNetblocks );
    my $hash="$ip $mf ". lc $rcpt;
    my $hosthash = $hash;
    my $onhost;
    if ($DelayWithMyName) {
        $hosthash .= " $myName";       # add $myName to triplet to sign entry as host unique
        $onhost = " on host $myName ";
    }

    # get sender domain
    my $hashwhite="$ip $mfwhite";
    if ($CanUseMD5Keys && $DelayMD5) {
        $hash      = Digest::MD5::md5_hex($hash);
        $hosthash  = Digest::MD5::md5_hex($hosthash);
        $hashwhite = Digest::MD5::md5_hex($hashwhite);
    }
    my $t=time;
    my $delay_result;
    my $DelayWhite_hashwhite = $DelayWhite{$hashwhite};
    my $Delay_hash = $Delay{$hash};
    my $Delay_hosthash = $Delay{$hosthash};
    if (! $DelayWhite_hashwhite) {
        if (! $Delay_hash && ! $Delay_hosthash) {
            mlog($fh,"adding new triplet: ($ip,$mf,". lc $rcpt .")$onhost",1) if $DelayLog>=2;
            $Stats{rcptDelayed}++;
            $Delay{$hosthash}=$t;
            $delay_result=0;
        } else {
            my $interval=$t-$Delay_hosthash;
            my $intervalFormatted=formatTimeInterval($interval);
            if ($interval<$DelayEmbargoTime*60) {
                mlog($fh,"embargoing triplet: ($ip,$mf,". lc $rcpt .")$onhost waited: $intervalFormatted",1) if $DelayLog>=2;
                $Stats{rcptEmbargoed}++;
                $delay_result=0;
            } elsif ($interval<$DelayEmbargoTime*60+$DelayWaitTime*3600) {
                mlog($fh,"accepting triplet: ($ip,$mf,". lc $rcpt .")$onhost waited: $intervalFormatted",1) if $DelayLog>=2;
                delete $Delay{$hash};
                delete $Delay{$hosthash};
                $DelayWhite{$hashwhite}=$t;
                $delay_result=1;

                # add to our header; merge later, when client sent own headers
                $this->{myheader}.="X-Assp-Delay: delayed for $intervalFormatted; $time $tz\r\n" if $DelayAddHeader;
            } else {
                mlog($fh,"late triplet encountered, deleting: ($ip,$mf,". lc $rcpt .")$onhost waited: $intervalFormatted",1) if $DelayLog>=2;
                $Stats{rcptDelayedLate}++;
                $Delay{$hosthash}=$t;
                $delay_result=0;
            }
        }
    } else {
        my $interval=$t-$DelayWhite_hashwhite;
        my $intervalFormatted=formatTimeInterval($interval);
        if ($interval<$DelayExpiryTime*24*3600) {
            mlog($fh,"renewing tuplet: ($ip,$mfwhite) age: ". $intervalFormatted,1) if $DelayLog>=2;
            $DelayWhite{$hashwhite}=$t;

            # multiple rcpt's
            delete $Delay{$hash};
            delete $Delay{$hosthash};
            $delay_result=1;

            # add to our header; merge later, when client sent own headers
            $this->{myheader}.="X-Assp-Delay: not delayed (auto accepted); $time $tz\r\n" if $DelayAddHeader;
        } else {
            mlog($fh,"deleting expired tuplet: ($ip,$mfwhite) age: ". $intervalFormatted,1) if $DelayLog>=2;
            $Stats{rcptDelayedExpired}++;

            delete $DelayWhite{$hashwhite};
            $Delay{$hosthash}=$t;
            $delay_result=0;
        }
    }
    return $delay_result;
}

sub allRot {
    my $ad = shift;
    $ad =~ tr/A-Za-z/N-ZA-Mn-za-m/;
    return ($ad);
}

# returns true if all of the addresses in the space separated list are Noprocessing addresses
sub allNP {
    my $rcpt = shift;
    my $c = 0;
    for ( split( /\s+/o, $rcpt ) ) {
        return 0 unless matchSL( $_, 'noProcessing' );
        $c++;
    }
    return $c;
  }

sub allSL {
   my($rcpt,$from,$re)=@_;
   return 0 unless $rcpt;
   return 0 unless $re;
   return 0 unless $$re;
   return 1 if matchSL($from,$re,1);
   my $ret = 1;
   for (split(/\s+/o,$rcpt)) {
      if (! matchSL($_,$re,1)) {
         $ret = 0 ;
         last;
      }
   }
   return $ret;
}

sub allSH {
   my($rcpt,$re)=@_;
   return 0 unless $rcpt;
   return 0 unless $re;
   return 0 unless $$re;
   my $ret = 1;
   for (split(/\s+/o,$rcpt)) {
      if (! matchSL($_,$re,1)) {
         $ret = 0 ;
         last;
      }
   }
   return $ret;
}

# the message is not spam -- route it to the server
sub isnotspam {
  my ($fh,$done)=@_;
  d('isnotspam');
  my $this=$Con{$fh};
  my $server=$this->{friend};

# it's time to merge our header with client's one
  $this->{myheader}="X-Assp-Version: $version$modversion on $myName\r\n" . $this->{myheader}
      if ! $this->{relayok} && $this->{myheader} !~ /X-Assp-Version:.+? on \Q$myName\E/;

  makeMyheader($fh,0,0,'');
  addMyheader($fh) if ($done && $this->{myheader});  # &whitebody will do it later

  sendquedata($server, $fh ,\$this->{header}, $done);
  $this->{headerpassed} = 1;
  
  if($done) {
    $this->{getline}=\&getline;
  } else {
    $this->{getline}=\&whitebody;
  }
}

# the message is non spam -- just relay it to the server
sub whitebody { my($fh,$l)=@_;
    my $this=$Con{$fh};
    d('whitebody');
    my $server=$this->{friend};
    $this->{maillength}+=length($l);
    $this->{header} .= $l;
    my $mbytes;
    my $clamavbytes;

    return if ! MessageSizeOK($fh);
    
    my $done=$l=~/^\.[\r\n]*$/o || defined($this->{bdata}) && $this->{bdata}<=0;

    $this->{headerlength} ||= getheaderLength($fh);
    $mbytes = $MaxBytes ? $MaxBytes + $this->{headerlength} : 10000 + $this->{headerlength};
    $clamavbytes = $ClamAVBytes ? $ClamAVBytes + $this->{headerlength} : 50000 + $this->{headerlength};
    $clamavbytes = 100000 if $ClamAVBytes > 100000;
    $mbytes = $clamavbytes
      if $clamavbytes > $mbytes && ($BlockExes || $CanUseAvClamd && $AvailAvClamd) ;
    $mbytes = 100000 if $mbytes >100000;

    $this->{headerpassed} = 1 if ($done || $this->{maillength} >= $mbytes );

    my $doneToError = $done || ($send250OK || ($send250OKISP && ($this->{ispip} or $this->{cip})));
    if (($done || $this->{maillength} >= $mbytes ) && haveToScan($fh) &&
         ! ClamScanOK($fh, bodyWrap(\$this->{header},$clamavbytes)))
    {
            thisIsSpam($fh,$this->{messagereason},$SpamVirusLog,$this->{averror},0,0,$doneToError);
            return;
    }
    if (($done || $this->{maillength} >= $mbytes ) && haveToFileScan($fh) &&
         ! FileScanOK($fh, bodyWrap(\$this->{header},$clamavbytes)))
    {
            thisIsSpam($fh,$this->{messagereason},$SpamVirusLog,$this->{averror},0,0,$doneToError);
            return;
    }

    if($done) {
        $this->{getline}=\&getline;
        &addMyheader($fh) if $this->{myheader};
    }
    sendquedata($server, $fh , \$l , $done);
}

# the message is non spam -- check if it is executable
sub whitebodyNoExe {
    my($fh,$l)=@_;
    my $this=$Con{$fh};
    my $dataref;
    my $virusdataref;
    my $maxbytes;
    my $clamavbytes;
    my $mbytes;
    d('whitebodyNoExe');
    $this->{datastart} = $this->{maillength} if (! $this->{datastart});

    $this->{header}.=$l;
    $this->{maillength}+=length($l);
    my $logsub;
    my $tlit=&tlit($DoBlockExes);
    $this->{attachcomment}="no bad attachments";

    return if ! MessageSizeOK($fh);

    my $done=$l=~/^\.[\r\n]*$/o || defined($this->{bdata}) && $this->{bdata}<=0;

    $this->{headerlength} ||= getheaderLength($fh);
    $maxbytes = $MaxBytes ? $MaxBytes + $this->{headerlength} : 10000 + $this->{headerlength};
    $clamavbytes = $ClamAVBytes ? $ClamAVBytes + $this->{headerlength} : 50000 + $this->{headerlength};
    $clamavbytes = 100000 if $ClamAVBytes > 100000;
    $mbytes = $maxbytes;
    $mbytes = $clamavbytes if $clamavbytes > $mbytes && ($BlockExes || $CanUseAvClamd && $AvailAvClamd) ;

    if ( $done || $this->{maillength} >= $mbytes ) {
        $this->{headerpassed} = 1;
        &makeSubject($fh);
        my $doneToError = $done || ($send250OK || ($send250OKISP && ($this->{ispip} or $this->{cip})));

        $dataref = bodyWrap(\$this->{header},$maxbytes);
        $virusdataref = bodyWrap(\$this->{header},$clamavbytes);

        if (!$this->{red} && $redRe && $$dataref =~/($redReRE)/) {
            $this->{red}=($1||$2);
            mlogRe($fh,$this->{red},"Red");
        }
        if($BlockUuencoded && $this->{header}=~ /$UUENCODEDRe/o) {
            $Stats{msgverify}++;
            delayWhiteExpire($fh);
            mlog($fh,"MsgVerify: uuencoded");
            seterror($fh,"$UuencodedError",$doneToError);
            return;
        }
        if ( !$this->{whitelisted} && $whiteRe && $$dataref =~ /($whiteReRE)/ ) {
            $this->{whitelisted} = 1;
            mlogRe( $fh, ($1||$2), "White" );
        }

        if ( !($this->{noprocessing} & 1) && $npRe && $$dataref=~/($npReRE)/) {
            mlogRe($fh,($1||$2),"Noprocessing");
            pbBlackDelete($fh,$this->{ip});
            $this->{noprocessing}=1;
        }

        if ( !$this->{spamlover} & 1 && $SpamLoversRe && $$dataref=~/($SpamLoversReRE)/ ) {
            mlogRe($fh,($1||$2),"SpamLover");
            $this->{spamlover}=3;
        }

        if ( $this->{noprocessing} ) {

            # noprocessing
            if(! SPFok($fh) ) {
                return if ($this->{error});
            }
            return if (&MsgScoreTooHigh($fh,$doneToError));

            if ( ! CheckAttachments( $fh, $BlockNPExes, $dataref, $npAttachLog, $doneToError ) ) {
                return if $this->{error};
            }
            return if (&MsgScoreTooHigh($fh,$doneToError));

            if ( haveToScan($fh) && ! ClamScanOK( $fh, $virusdataref ) ) {
                thisIsSpam( $fh, $this->{messagereason}, $SpamVirusLog, $this->{averror}, 0, 0, $doneToError );
                return if $this->{error};
            }
            return if (&MsgScoreTooHigh($fh,$doneToError));

            if ( haveToFileScan($fh) && ! FileScanOK( $fh, $virusdataref ) ) {
                thisIsSpam( $fh, $this->{messagereason}, $SpamVirusLog, $this->{averror}, 0, 0, $doneToError );
                return if $this->{error};
            }
            return if (&MsgScoreTooHigh($fh,$doneToError));

            $this->{uriblforce} = 1;
            if (!$this->{uribldone} && ! URIBLok( $fh, $dataref, $this->{ip} ,$doneToError) ) {
                delete $this->{uriblforce};
             	return if $this->{error};
            }
            delete $this->{uriblforce};
            return if (&MsgScoreTooHigh($fh,$doneToError));

            $this->{prepend} = "[NoProcessing]";
            my $fn;

            if ($noProcessingLog) {
                $fn = Maillog($fh,'',$noProcessingLog); # tell maillog this isn't spam

                $fn=' -> '.$fn if $fn ne '';
                $fn='' if ! $fileLogging;
            }
            my $pr = $this->{passingreason} ? " - ($this->{passingreason}) -" : '' ;
            $logsub =
                  ( $subjectLogging ? " $subjectStart$this->{originalsubject}$subjectEnd" : '' );
            mlog( $fh, "message proxied without processing ($this->{attachcomment})".de8($pr).$logsub.de8($fn), 0, 2 ) if $AttachmentLog >= 2 && $attachLogNoPL;
            $Stats{noprocessing}++;

            isnotspam( $fh, $done );

        } else  {

            # whitelisted
            if(! SPFok($fh) ) {
                return if ($this->{error});
            }
            return if (&MsgScoreTooHigh($fh,$doneToError));

            if ( ! CheckAttachments( $fh, $BlockWLExes, $dataref, $wlAttachLog, $doneToError ) ) {
                return if $this->{error};
            }
            return if (&MsgScoreTooHigh($fh,$doneToError));

            if ( haveToScan($fh) && ! ClamScanOK( $fh, $virusdataref ) ) {
                thisIsSpam( $fh, $this->{messagereason}, $SpamVirusLog, $this->{averror}, 0, 0, $doneToError );
                return if $this->{error};
            }
            return if (&MsgScoreTooHigh($fh,$doneToError));

            if ( haveToFileScan($fh) && ! FileScanOK( $fh, $virusdataref ) ) {
                thisIsSpam( $fh, $this->{messagereason}, $SpamVirusLog, $this->{averror}, 0, 0, $doneToError );
                return if $this->{error};
            }
            return if (&MsgScoreTooHigh($fh,$doneToError));

            $this->{uriblforce} = 1;
            if (! $this->{uribldone} && ! URIBLok( $fh, $dataref, $this->{ip} ,$doneToError) ) {
                delete $this->{uriblforce};
            	delayWhiteExpire($fh);
             	return if $this->{error};
            }
            delete $this->{uriblforce};
            return if (&MsgScoreTooHigh($fh,$doneToError));

            $this->{prepend} = '[Local]' if $this->{relayok};
            $this->{prepend} = '[Whitelisted]' if !$this->{relayok};

            addSpamProb( $fh, 1, 0 );
            if ( !$this->{red} && $redRe && $$dataref =~ /($redReRE)/ )
            {
                $this->{red} = ($1||$2);
                mlogRe($fh, $this->{red}, "Red" );
            }
            # tell maillog this isn't spam
            my $fn = Maillog($fh,'',$NonSpamLog); # tell maillog this isn't spam

            $fn=' -> '.$fn if $fn ne '';
            $fn='' if !$fileLogging;
            my $pr = $this->{passingreason} ? " - ($this->{passingreason}) -" : '' ;
            $logsub = ( $subjectLogging ? " $subjectStart$this->{originalsubject}$subjectEnd" : '' );

            mlog( $fh, "local ($this->{attachcomment})".de8($pr).$logsub.de8($fn), 0, 2 ) if $this->{relayok} && $AttachmentLog >= 2 && $attachLogNoPL;
            mlog( $fh, "whitelisted ($this->{attachcomment})".de8($pr).$logsub.de8($fn), 0, 2 ) if !$this->{relayok} && $AttachmentLog >= 2 && $attachLogNoPL;

            isnotspam( $fh, $done );
        }
    }
}


# the message may or may not be spam -- get the body and test it.
sub getbody {
    my ( $fh, $l ) = @_;
    my $this = $Con{$fh};
    my $dataref;
    my $virusdataref;

    $this->{datastart} = $this->{maillength} if (! $this->{datastart});
    $this->{maillength}+=length($l);
    $this->{header} .= $l;

    $this->{headerlength} ||= getheaderLength($fh);
    my $maxbytes = $MaxBytes ? $MaxBytes + $this->{headerlength} : 10000 + $this->{headerlength};
    my $clamavbytes = $ClamAVBytes ? $ClamAVBytes + $this->{headerlength} : 50000 + $this->{headerlength};
    $clamavbytes = 100000 if $ClamAVBytes > 100000;
    my $mbytes = $maxbytes;
    $mbytes = $clamavbytes
      if $clamavbytes > $mbytes && ($BlockExes || $CanUseAvClamd && $AvailAvClamd) ;

    my $done = $l =~ /^\.[\r\n]*$/o || defined( $this->{bdata} ) && $this->{bdata} <= 0;

    if ( $done || $this->{maillength} >= $mbytes) {
        my $doneToError = $done || ($send250OK || ($send250OKISP && ($this->{ispip} or $this->{cip})));

        $this->{skipnotspam} = 1;
        
        $dataref = bodyWrap(\$this->{header},$maxbytes);
        $virusdataref = bodyWrap(\$this->{header},$clamavbytes);

        $this->{attachcomment} = "no bad attachments";

        d( "getbody - done:$done maillength:$this->{maillength}" );

        if ( !$this->{red} && $redRe && $$dataref =~ /($redReRE)/ )	{
            $this->{red} = ($1||$2);
            mlogRe( $fh, $this->{red}, "Red" );
        }

        if ( !$this->{whitelisted} && $whiteRe && $$dataref =~ /($whiteReRE)/ ) {
            $this->{whitelisted} = 1;
            mlogRe( $fh, ($1||$2), "White" );
        }

        if ( !($this->{noprocessing} & 1) && $npRe && $$dataref=~/($npReRE)/) {
            mlogRe($fh,($1||$2),"Noprocessing");
            pbBlackDelete($fh,$this->{ip});
            $this->{noprocessing}=1;
        }

        if ( !$this->{spamlover} & 1 && $SpamLoversRe && $$dataref=~/($SpamLoversReRE)/ ) {
            mlogRe($fh,($1||$2),"SpamLover");
            $this->{spamlover}=3;
        }

        if (&MsgScoreTooHigh($fh,$doneToError)) {$this->{skipnotspam} = 0;return;}

        if ( ! CheckAttachments( $fh, $BlockExes, $dataref, $extAttachLog, $doneToError ) ) {
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$doneToError)) {$this->{skipnotspam} = 0;return;}

        if ( ! BombOK( $fh, $dataref ) ) {
            my $bomblt = $bombError;

            $bomblt .= " (reason: $this->{messagereason}) " if $bombErrorReason;
            $Stats{bombs}++;
            delayWhiteExpire($fh);
            my $slok = $this->{allLoveBoSpam} == 1;

            thisIsSpam( $fh, $this->{messagereason}, $spamBombLog, $bomblt, $bombTestMode, $slok, $doneToError );
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$doneToError)) {$this->{skipnotspam} = 0;return;}

        if(! ScriptOK($fh,$dataref)) {
            my $slok=$this->{allLoveBoSpam}==1;
            $Stats{scripts}++;
            delayWhiteExpire($fh);
            my $bomblt = $scriptError;

            $bomblt .= " (reason: $this->{messagereason}) " if $bombErrorReason;
            $this->{prepend}="[BombScript]";
            thisIsSpam($fh,$this->{messagereason},$scriptLog,$bomblt,$bombTestMode,$slok,$doneToError);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$doneToError)) {$this->{skipnotspam} = 0;return;}

        if(! BombBlackOK($fh, $dataref)) {
            my $bomblt = $bombError;
            $bomblt .= " (reason: $this->{messagereason}) " if $bombErrorReason;
            delayWhiteExpire($fh);
            my $slok=$this->{allLoveBoSpam}==1;
            $Stats{bombs}++;
            thisIsSpam($fh,$this->{messagereason},$spamBombLog,$bomblt,$bombTestMode,$slok,$doneToError);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$doneToError)) {$this->{skipnotspam} = 0;return;}

        if ( haveToScan($fh) && ! ClamScanOK($fh,$virusdataref)){
            $this->{prepend}="[VIRUS]";
            thisIsSpam($fh,$this->{messagereason},$SpamVirusLog,$this->{averror},0,0,$doneToError);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$doneToError)) {$this->{skipnotspam} = 0;return;}

        if ( haveToFileScan($fh) && ! FileScanOK($fh,$virusdataref)){
            $this->{prepend}="[VIRUS]";
            thisIsSpam($fh,$this->{messagereason},$SpamVirusLog,$this->{averror},0,0,$doneToError);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$doneToError)) {$this->{skipnotspam} = 0;return;}

        if(! $this->{uribldone} && ! URIBLok($fh,$dataref,$this->{ip},$doneToError)) {
            delayWhiteExpire($fh);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$doneToError)) {$this->{skipnotspam} = 0;return;}

        if($this->{addressedToSpamBucket} && ! $this->{SpamCollectAddress}) {
            $this->{SpamCollectAddress} = 1;
            $Stats{spambucket}++ ;
            $this->{messagereason}="Collect Address: $this->{addressedToSpamBucket}";
            pbAdd($fh,$this->{ip},'saValencePB','SpamCollectAddress',2);
            $this->{prepend}="[Collect]";
            thisIsSpam($fh,"Collect Address: $this->{addressedToSpamBucket}",$spamBucketLog,"250 OK",0,0,0);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$doneToError)) {$this->{skipnotspam} = 0;return;}

        @HmmBayWords = ();
        if( ! HMMOK($fh,$dataref)) {
            my $slok=$this->{allLoveBaysSpam}==1;
            my $mybaystestmode;
            $mybaystestmode = "1" if $this->{bayeslowconf} || $baysTestMode;
            $mybaystestmode = $slok = 0 if allSH($this->{rcpt},'baysSpamHaters');
            if (!$slok) { $Stats{bspams}++;}
            $this->{myheader}.=sprintf("X-Assp-HMM-Confidence: %.5f\r\n",$this->{hmmconf}) if $AddSpamProbHeader && $AddConfidenceHeader && $this->{hmmconf}>0;
            $this->{prepend}="[HMM]";
            thisIsSpam($fh,'HMM',$baysSpamLog,$SpamError,$mybaystestmode,$slok,$doneToError);
            $this->{bayeslowconf} = '';
            if ($this->{error}) {$this->{skipnotspam} = 0; delete $this->{clean}; return;}
        }
        if (&MsgScoreTooHigh($fh,$doneToError)) {$this->{skipnotspam} = 0; delete $this->{clean}; return;}

        if( ! BayesOK($fh,$dataref,$this->{ip})) {
            my $slok=$this->{allLoveBaysSpam}==1;
            my $mybaystestmode; 
            $mybaystestmode = "1" if $this->{bayeslowconf} || $baysTestMode;
            $mybaystestmode = $slok = 0 if allSH($this->{rcpt},'baysSpamHaters');
            if (!$slok) { $Stats{bspams}++;}
            $this->{myheader}.=sprintf("X-Assp-Bayes-Confidence: %.5f\r\n",$this->{spamconf}) if $AddSpamProbHeader && $AddConfidenceHeader && $this->{spamconf}>0;
            $this->{prepend}="[Bayesian]";
            thisIsSpam($fh,'Bayesian',$baysSpamLog,$SpamError,$mybaystestmode,$slok,$doneToError);
            if ($this->{error}) {$this->{skipnotspam} = 0; delete $this->{clean}; return;}
        }
        delete $this->{clean};
        if (&MsgScoreTooHigh($fh,$doneToError)) {$this->{skipnotspam} = 0;return;}

        if (&TestLowMessageScore($fh)) {
            $this->{messagelow}=1;
            $this->{messagereason}="MessageScore passed low limit";
            my $slok=$this->{allLovePBSpam}==1;
            my $er = $SpamError;
            $er = $PenaltyError if $PenaltyError;
            $this->{prepend}="[MessageLimit]";
            delayWhiteExpire($fh);
            $Stats{msgscoring}++;
            thisIsSpam($fh,$this->{messagereason},$spamMSLog,$er,$msTestMode,$slok,$doneToError);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        if (&MsgScoreTooHigh($fh,$doneToError)) {$this->{skipnotspam} = 0;return;}

        if (! PBOK($fh,$this->{ip})){
            my $slok=$this->{allLovePBSpam}==1;
            unless ($slok) {$Stats{pbdenied}++;}
            my $er=$SpamError;
            $er=$PenaltyError if $PenaltyError;
            $this->{myheader}.="X-Assp-Penalty: $this->{messagereason}\r\n";
            $this->{prepend}="[Penalty]";
            thisIsSpam($fh,$this->{messagereason},$spamPBLog,$er,$pbTestMode || $DoPenalty == 4,$slok,$doneToError);
            if ($this->{error}) {$this->{skipnotspam} = 0;return;}
        }
        $this->{TestMessageScore} = 1;
        if (&MsgScoreTooHigh($fh,$doneToError)) {delete $this->{TestMessageScore};$this->{skipnotspam} = 0;return;}

        delete $this->{TestMessageScore};
        $this->{skipnotspam} = 0;
        if($this->{spamfound}) {

            # Spam is found to be safe, lets pass it on.
            my $fn;
            if (! $this->{maillogfh}) {
                $fn = Maillog($fh,'',$baysSpamLog);
            } else {
                $fn = $this->{maillogfilename};
            }
            $fn=' -> '.$fn if $fn ne '';
            $fn='' if !$fileLogging;
            my $logsub =
                  ( $subjectLogging ? " $subjectStart$this->{originalsubject}$subjectEnd" : '' );
            mlog($fh,"spam found and passing ($this->{messagereason})$logsub".de8($fn),1);
            delayWhiteExpire($fh);
            isnotspam($fh,$done);
            return;
        }
        my $fn;
        my $logto = ($this->{relayok} || $this->{whitelisted}) ? $NonSpamLog : $baysNonSpamLog;
        if (! $this->{maillogfh}) {
            $fn = Maillog($fh,'',$logto) if $logto>=2 ;
        } else {
            $fn = $this->{maillogfilename} if $logto>=2 ;
        }
        $fn=' -> '.$fn if $fn ne '';
        $fn='' if !$fileLogging;
        my $pr = $this->{passingreason} ? " - ($this->{passingreason}) -" : '' ;
        my $logsub = ( $subjectLogging ? " $subjectStart$this->{originalsubject}$subjectEnd" : '' );
        addSpamProb($fh,0,0);
        $this->{sayMessageOK} = "message ok".de8($pr).$logsub.de8($fn);
        isnotspam($fh,$done);
    }
}

# checks for blocked attachments
sub CheckAttachments {
    my ( $fh, $block, $bd, $attachlog, $done ) = @_;
    return 1 unless $fh;
    d('CheckAttachments');
    my $this = $Con{$fh};
    my @name;

    return 1 unless $CanUseEMM;
    return 1 unless $DoBlockExes;
    return 1 if $this->{attachdone};
    my $msg = $$bd;
    $this->{prepend} = '';

    eval {
        $Email::MIME::ContentType::STRICT_PARAMS=0;      # no output about invalid CT
        my $email = Email::MIME->new($msg);
        if ($email->{ct}{composite} =~ /signed/io) {
            mlog($fh,"info: digital signed email found - some check may skipped") if $AttachmentLog >= 2;
            $this->{signed} = 1;
        }
        foreach my $part ( $email->parts ) {
            my $dis = $part->header("Content-Type") || '';
            my $attrs = $dis =~ s/^[^;]*;//o ? Email::MIME::ContentType::_parse_attributes($dis) : {};
            my $name = $attrs->{name} || $part->{ct}{attributes}{name};
            my $filename = $attrs->{filename} || $part->{ct}{attributes}{filename};
            eval{$filename ||= $part->filename;};
            if (! $name || ! $filename) {
              eval{
                $dis = $part->header("Content-Disposition") || '';
                $attrs = $dis =~ s/^[^;]*;//o ? Email::MIME::ContentType::_parse_attributes($dis) : {};
                $name ||= $attrs->{name} || $part->{ct}{attributes}{name};
                $filename ||= $attrs->{filename} || $part->{ct}{attributes}{filename};
              };
            }
            if (($name||$filename) && $part->header("Content-Disposition")=~ /attachment|inline/io ) {
                my $attname = $filename || $name;
                mlog($fh,"info: attachment $attname found for Level-$block") if ($AttachmentLog >= 2);
                push(@name,$attname);
            }
        }
    };
    if ($@) {
        mlog($fh,"warning: unable to parse message for attachments - $@") unless $IgnoreMIMEErrors;
        d("warning: unable to parse message for attachments - $@") ;
    }
    my $numatt = @name;
    my $s; $s = 's' if ($numatt > 1);
    mlog($fh,"info: $numatt attachment$s found for Level-$block") if ($AttachmentLog && $numatt);

    my $ext;
    my @attre;
    my $userbased = 0;
    my $bRE = $badattachRE[$block];

    my $attRun = sub { return
        ($block >= 1 && $block <= 3 && $ext =~ /$bRE/ ) ||
        ($GoodAttach && $block == 4 && $ext !~ /$goodattachRE/);
    };

    if (defined ${chr(ord(",") << 1)} and scalar keys %AttachRules) {
        my $rcpt = [split(/ /o,$this->{rcpt})]->[0];
        my $dir = ($this->{relayok}) ? 'out' : 'in';
        my $addr;
        $addr = matchHashKey('AttachRules', batv_remove_tag('',$this->{mailfrom},''), 1);
        $attre[0] = $AttachRules{$addr}->{'good'} . '|' . $AttachRules{$addr}->{'good-'.$dir} . '|' if $addr;
        $attre[1] = $AttachRules{$addr}->{'block'} . '|' . $AttachRules{$addr}->{'block-'.$dir} . '|' if $addr;
        $addr = matchHashKey('AttachRules', batv_remove_tag('',$rcpt,''), 1);
        $attre[0] .= $AttachRules{$addr}->{'good'} . '|' . $AttachRules{$addr}->{'good-'.$dir} . '|' if $addr;
        $attre[1] .= $AttachRules{$addr}->{'block'} . '|' . $AttachRules{$addr}->{'block-'.$dir} . '|' if $addr;

        $attre[0] =~ s/\|\|+/\|/go;
        $attre[1] =~ s/\|\|+/\|/go;

        $attre[0] =~ s/^\|//o;
        $attre[1] =~ s/^\|//o;

        $attre[0] =~ s/\|$//o;
        $attre[1] =~ s/\|$//o;

        if ($attre[0] || $attre[1]) {
            $attre[0] = qq[\\.(?:$attre[0])\$] if $attre[0];
            $attre[1] = qq[\\.(?:$attre[1])\$] if $attre[1];
            $attRun = sub { return
                ($attre[1] && $ext =~ /$attre[1]/ ) ||
                ($attre[0] && $ext !~ /$attre[0]/ );
            };
            mlog($fh,"info: using user based attachment check") if $AttachmentLog;
            $userbased = 1;
        }
    }

    while (my $name = shift @name) {
        $ext = undef;
        eval{
        $ext = $1 if $name =~ /(\.[^\.]+)$/o;};
        if ( $attRun->() ) {
            $this->{attachdone} = 1;

            $this->{prepend} = "[Attachment]";

            my $tlit="[spam found]";
            $tlit = "[monitoring]" if $DoBlockExes == 2;
            $tlit = "[scoring]"    if $DoBlockExes == 3;

            if ($DoBlockExes == 1) {
                $Stats{viri}++;
                delayWhiteExpire($fh) if ! $userbased;
            }
            eval{$this->{messagereason} = "bad attachment '$name'";};
            $this->{attachcomment} = $this->{messagereason};
            mlog( $fh, "$tlit $this->{messagereason}" ) if ($DoBlockExes > 1 && $AttachmentLog);
            return 1 if $DoBlockExes == 2;

            pbAdd( $fh, $this->{ip} ,'baValencePB', 'BadAttachment' , $userbased) if $DoBlockExes != 2;
            return 1 if $DoBlockExes == 3;

            my $reply = $AttachmentError;
            eval{$name = encodeMimeWord($name,'B','UTF-8') unless is_7bit_clean(\$name);
                 $reply =~ s/FILENAME/$name/go;
            };
            my $slok = $this->{allLoveATSpam} == 1;
            thisIsSpam( $fh, $this->{messagereason}, $attachlog, $reply, $attachTestMode, $slok, $done );

            return 0;
        }
    }
    return 1;
}

sub makeMyheader {
    my ($fh,$slok,$testmode,$reason) = @_;
    my $this = $Con{$fh};
    d('makeMyheader');
    # add to our header; merge later, when client sent own headers
    my $header = $this->{myheader};
    $this->{myheader} = '';
    $this->{myheader}.="X-Assp-Version: $version$modversion on $myName\r\n"
        if $header !~ /X-Assp-Version:.+? on \Q$myName\E/;
    $this->{myheader}.= "X-Assp-ID: $myName $this->{msgtime}\r\n"
        if $header !~ /X-Assp-ID: \Q$myName $this->{msgtime}\E/;
    my $sID = $this->{SessionID};
    my $nbr = $this->{chainMailInSession} + (($this->{chainMailInSession} < 0)?2:1);
    $sID .= " (mail $nbr)";
    $this->{myheader}.= "X-Assp-Session: $sID\r\n"
        if $header !~ /X-Assp-Session:/o;
    if (! $this->{relayok}) {
        $this->{myheader}.= "X-Assp-OIP: $this->{cip}\r\n"
            if $this->{cip} && $this->{ispip} && $header !~ /X-Assp-OIP: \Q$this->{cip}\E/;
        $this->{myheader}.= "X-Assp-Detected-RIP: ".join(', ',@{$this->{sip}})."\r\n"
            if @{$this->{sip}} && $header !~ /X-Assp-Detected-RIP:/o;
        $this->{myheader}.= "X-Assp-Source-IP: $this->{ssip}\r\n"
            if $this->{ssip} && $header !~ /X-Assp-Source-IP: \Q$this->{ssip}\E/;
    }
    $this->{myheader}.= "X-Assp-Envelope-From: $this->{mailfrom}\r\n"
        if $AddIntendedForHeader && $this->{mailfrom} && $header !~ /X-Assp-Envelope-From: \Q$this->{mailfrom}\E/;
    for (split(/ /o,$this->{rcpt})) {
        $this->{myheader}.= "X-Assp-Intended-For: $_\r\n"
            if $AddIntendedForHeader && $_ && $header !~ /X-Assp-Intended-For: \Q$_\E/i;
    }
    $this->{myheader}.="X-Assp-Original-Subject: $this->{subject2}\r\n"
        if $AddSubjectHeader && $this->{subject2} && $header !~ /X-Assp-Original-Subject:/;
    $this->{myheader}.=$header;

    my $red = $this->{red};
    $red =~ s/\r|\n//gos;
    $red =~ s/\s+/ /gos;
    my $red2 = substr($red,0,$RegExLength);
    $red2 .= '...' if $red ne $red2;
    $red2 = $red if $red =~ /^$EmailAdrRe\@$EmailDomainRe$/o;
    $this->{myheader}.="X-Assp-Redlisted: Yes ($red2)\r\n"
        if $this->{red} && $this->{myheader} !~ /X-Assp-Redlisted/o;
    if ($this->{spamfound} && $AddSpamHeader) {
        foreach my $k (sort keys(%{$this})) {
            next if $k !~ /love/oi;
            next unless $this->{$k};
            next if ref($this->{$k});
            $this->{myheader}.= "X-Assp-$k: $this->{$k}\r\n" if $this->{myheader} !~ /X-Assp-$k/o;
        }
    }
    $this->{myheader}.= "X-Assp-Spam: YES\r\n"
        if $this->{spamfound} && $AddSpamHeader && !$this->{bayeslowconf} && $this->{myheader} !~ /X-Assp-Spam: YES/o;
    $this->{myheader}.= "X-Assp-Spam: YES (Probably)\r\n"
        if $this->{spamfound} && $AddSpamHeader && $this->{bayeslowconf} && $this->{myheader} !~ /X-Assp-Spam: YES \(Probably\)/o;
    $this->{myheader}.="X-Assp-Block: NO (Spamlover)\r\n"
        if $this->{spamfound} && $slok && $this->{myheader} !~ /X-Assp-Block: NO \(Spamlover\)/o;
    $this->{myheader}.="X-Assp-Block: NO ($testmode)\r\n"
        if $this->{spamfound} && $testmode && !$this->{messagelow} && $this->{myheader} !~ /X-Assp-Block: NO \(\Q$testmode\E\)/;
    $this->{myheader}.="$AddCustomHeader\r\n"
        if $this->{spamfound} && $AddCustomHeader && $this->{myheader} !~ /\Q$AddCustomHeader\E/;
    $this->{myheader}.="X-Assp-Spam-Reason: ".$reason."\r\n"
        if $this->{spamfound} && $reason && $AddSpamReasonHeader &&
           $this->{myheader} !~ /X-Assp-Spam-Reason: \Q$reason\E/;

    if ($this->{spamfound} && $AddScoringHeader) {
        $this->{myheader} =~ s/X-Assp-Message-Totalscore:$HeaderValueRe//iogs;
        $this->{myheader} .= "X-Assp-Message-Totalscore: $this->{messagescore}\r\n";
    }
    if (   (! $this->{relayok} || ($this->{relayok} && ! $NoExternalSpamProb ) )
        && $this->{messagescore} > 0
        && $AddLevelHeader
#        && $this->{spamfound}
       )
    {
        my $mscore = $this->{messagescore};
        $mscore = 99 if $mscore > 99;
        $mscore = int($mscore/5) + 1;
        my $stars = '*' x $mscore;
        $this->{myheader} =~ s/X-Assp-Spam-Level:$HeaderValueRe//gios; # clear out existing X-Assp-Spam-Level headers
        $this->{myheader} .= "X-Assp-Spam-Level: $stars\r\n";
    }
}

sub addMyheader {
    my $fh = shift;
    my $this = $Con{$fh};
    d('addMyheader');
    my $var = $this->{addMyheaderTo} || 'header';
    return unless $this->{myheader};

    my $foundEnd = my $headlen = index($this->{$var}, "\x0D\x0A\x0D\x0A");  # merge header
    $headlen = 0 if ($headlen < 0);
    my $preheader = my $header = substr($this->{$var},0,$headlen);
    if ($this->{preheaderlength}) {    # we have added our headers before - now find the end of the orig header
        $this->{preheaderlength} -= 2; # step back two bytes  ("\x0D\x0A")
        $this->{preheaderlength} = 0 if $this->{preheaderlength} < 0;   # min offset is 0
        $this->{preheaderlength} = index($this->{$var}, "\x0D\x0A",$this->{preheaderlength});
        $this->{preheaderlength} = ( $this->{preheaderlength} < 0 ) ? 0 : $this->{preheaderlength} + 2;
        $preheader = substr($header,0,$this->{preheaderlength});
    }
    my $myheader = headerFormat($this->{myheader});
    $myheader =~ s/(?:\r|\n)+$//o;
    $myheader .= "\r\n" if $myheader;
    $preheader =~ s/(?:\r|\n)+$//o;
    $preheader .= "\r\n" if $preheader;
    $this->{preheaderlength} = length $preheader;
    my $newheader = $preheader . $myheader;
    if ($foundEnd >= 0) {
       $newheader =~ s/(?:\r|\n)+$//o;
    } elsif ($newheader) {
       $newheader .= "\r\n\r\n";
    }

    substr($this->{$var},0,$headlen,$newheader);
    $this->{maillength} = length($this->{$var});
}

# This is spam, lets see if its test mode or spamlover.
sub thisIsSpam {
    my ($fh,$reason,$log,$error,$testmode,$slok,$done)=@_;
    return 0 unless $fh;
    my $this=$Con{$fh};
    d("thisIsSpam - $reason , $testmode, $slok, $done");
    return 0 if ($this->{detectonly} && $this->{error});   # we are in ERROR mode
                                                           # we do not have to do
                                                           # anything for Plugins
    &makeSubject($fh);
    my $logsub;
    $this->{messagereason}=$reason;
    my ($to) = $this->{rcpt} =~ /(\S+)/o;
    $to = lc($to);
    my $mfd; $mfd = $1 if $to =~ /\@([^@]*)/o;
    $error = $SpamError if !$error;
    $error =~ s/LOCALDOMAIN/$mfd/go;

    if ( $reason =~ /bayes/io ) {
        if (allSH( $this->{rcpt}, 'baysTestModeUserAddresses' )) {
            $testmode = "bayesian test mode user";
            $slok=0; # make sure it's not flagged as a spam lover
        }
    }

    addSpamProb( $fh, 0, 1 );
    $this->{spamfound} = 1;   # Set spamfound flag.

    $testmode = "testmode" if $testmode eq '1';
    $testmode  = "all in testmode" if $allTestMode;
    $testmode = $slok = 0 if allSH( $this->{rcpt}, 'spamHaters' );
    if ($slok && defined $this->{spamMaxScore} && $this->{messagescore} > $this->{spamMaxScore}) {
        $slok = 0;
        mlog($fh, "The message score ($this->{messagescore}) exceeds the SpamLover-Max-Score ($this->{spamMaxScore})");
    }
    
    makeMyheader($fh,$slok,$testmode,$reason);

    return 1 if ($this->{error});  # we are already in error-mode - writing our headers is enough
    
    my $passtext;

    if(    $slok
        || $testmode
        || $this->{tagmode}
        || (($this->{spamlover} & 1) && $this->{messagescore} <= $this->{spamMaxScore})
        || (! $this->{detectonly} && ($this->{messagelow} || ($this->{bayeslowconf} && $reason =~ /bayes/io)))
      )
    {
        if($slok) {
            $this->{prepend}.="[sl]";
            $this->{saveprepend2}.="[sl]";
            $passtext="passing because spamlover for this check, otherwise blocked ($reason)";
            $Stats{spamlover}++;
            $done = 1;
        }elsif ( $testmode ) {
            $this->{prepend}.="[testmode]";
            $this->{saveprepend2}.="[testmode]";
            $passtext = "passing because $testmode, otherwise blocked ($reason)";
            $done = 1;
        }elsif($this->{tagmode}) {
            $this->{prepend}.="[tagmode]";
            $passtext="passing because tagmode: $this->{rcpt}, otherwise blocked ($reason)";
            $done = 1;
        }elsif($this->{spamlover} & 1) {
            $this->{prepend}.="[all-sl]";
            $this->{saveprepend2}.="[all-sl]";
            $passtext="passing because ";
            $passtext .= ($this->{spamlover} == 1) ? 'all spamlover [address match in \'spamLovers\']' : 'content matches in \'SpamLoversRe\'';
            $passtext .= ", otherwise blocked ($reason)";
            $Stats{spamlover}++;
            $done = 1;
        }elsif ($this->{messagelow})  {
            $this->{prepend}.="[lowlimit]";
            $this->{saveprepend2}.="[lowlimit]";
            $passtext="passing because messagescore($this->{messagescore}) low";
            $done = 1;
        }elsif($this->{bayeslowconf}) {
            $this->{prepend}.="[lowconfidence]";
            $this->{saveprepend2}.="[lowconfidence]";
            $passtext="passing because of low confidence, otherwise blocked ($reason)";
        }

        # pretend it's not spam
        $this->{header}=~s/^($HeaderRe*)/$1From: sender not supplied\r\n/o unless $this->{header}=~/^$HeaderRe*From:/io; # add From: if missing
        $this->{header}=~s/^($HeaderRe*)/$1Subject:\r\n/o unless $this->{header}=~/^$HeaderRe*Subject:/io; # add Subject: if missing
        unless ($slok && $spamTagSL ) {
            $this->{header} =~ s/^Subject:/Subject: $this->{prepend}/imo
              if ( $spamTag && $this->{prepend} ne '' && $this->{header} !~ /Subject: $this->{prepend}/i);
        }

        unless ( $slok && $spamSubjectSL ) {
            $this->{header} =~ s/^Subject:/Subject: $spamSubjectEnc/imo
              if $spamSubjectEnc && $this->{header} !~ /Subject: \Q$spamSubjectEnc\E/i;
        }

        #Lets check if its safe to pass if not already done so.

        if ($done) {
            if (! $this->{maillogfh}) {
                my $fn = Maillog($fh,'',$log); # tell maillog what this is.
                $fn=' -> '.$fn if $fn ne '';
                $fn='' if !$fileLogging;
                $logsub =
                  ( $subjectLogging ? " $subjectStart$this->{originalsubject}$subjectEnd" : '' );

                mlog($fh,"[spam found] and possibly $passtext$logsub".de8($fn),0,2);
            }
            delayWhiteExpire($fh);
            if ($this->{detectonly}) {
                return 0;
            } else {
                isnotspam($fh,$done) unless $this->{skipnotspam};
            }
        } else {
            $this->{getline}=\&getbody unless $this->{getline} eq \&getheader;
        }

    } else {
        my $wasremoved;
        $wasremoved = &MaillogRemove($this) if ($this->{maillogfh});
        my $fn = $this->{maillogfilename};
        unless ($fn) {
            $fn = Maillog($fh,'',$log); # tell maillog what this is.
            Maillog($fh,"\r\n.\r\n") if $wasremoved;
        }
        $fn=' -> '.$fn if $fn ne '';
        $fn='' if !$fileLogging;
        $logsub = ( $subjectLogging && $this->{originalsubject} ? " $subjectStart$this->{originalsubject}$subjectEnd" : '' );
        $this->{prepend} .= '[isbounce]' if $this->{isbounce} && $this->{prepend} !~ /\[isbounce\]/o  ;
        mlog($fh,"[spam found] (". $reason . ")$logsub".de8($fn).';',0,2);
        delayWhiteExpire($fh);
        $error=$SpamError if $error eq '';
        $error=~s/500/554/io;

        seterror($fh,$error,$done);
        return 1;
    }
}

# delete safelisted tuplet
sub delayWhiteExpire {
	my $fh   = shift;
    return unless $fh;
    my $this = $Con{$fh};
    d('delayWhiteExpire');
	my $ip = $this->{ip};
	$ip = $this->{cip} if $this->{ispip} && $this->{cip};

	pbWhiteDelete( $fh, $ip );
    SBCacheChange( $ip, 3);
	return unless ( $EnableDelaying && $DelayExpireOnSpam );
	my $mf = lc $this->{mailfrom};

	# get sender domain
	$mf =~ s/[^@]*@//o;
	my $ipn = &ipNetwork( $ip, $DelayUseNetblocks );
	my $hash = "$ipn $mf";
	$hash = Digest::MD5::md5_hex($hash) if $CanUseMD5Keys && $DelayMD5;
    my $DelayWhite_hash = $DelayWhite{$hash};
    if ( $DelayWhite_hash ) {
		# delete whitelisted (IP+sender domain) tuplet
		mlog(	$fh, "deleting spamming safelisted tuplet: ($ipn,$mf) age: "
				. formatTimeInterval( time - $DelayWhite_hash ), 1 ) if $DelayLog;
		delete $DelayWhite{$hash};
    }
}

# add to penalty box
sub pbAdd {

    # status:
    # 0-message score and pbblackadd
    # 1-message score but don't pbblackadd
    # 2-pbblackadd but don't message score
    # noheader:
    # 0-write X-Assp header info
    # 1-skip X-Assp header info
    my($fh,$myip,$score,$reason,$status,$noheader)=@_;
    return unless $fh;
    my $this = $Con{$fh};
    return if $this->{relayok};
    my @score;
    if ($score =~ /ValencePB$/o) {
       defined ${chr(ord(",") << 1)} and (@score = @{$score});
    } elsif (ref($score) eq 'ARRAY') {
       defined ${chr(ord(",") << 1)} and (@score = @{$score});
    } elsif ($score = 0+$score) {
       push @score, $score, $score;
    } else {
       return;
    }
    return if $status && ! $score[$status - 1];
    return if ! $status && ! max(@score);
    $myip = $this->{cip} if $this->{ispip} && $this->{cip} && $myip eq $this->{ip};
    my $reason2=$reason;
    $reason2=$this->{messagereason} if $this->{messagereason};
    if ( ! $noheader ) {
        $this->{myheader}.="X-Assp-Message-Score: $score[0] ($reason2)\r\n" if $AddScoringHeader && $status < 2 && $score[0];
        $this->{myheader}.="X-Assp-IP-Score: $score[1] ($reason2)\r\n" if $AddScoringHeader && $status != 1 && $score[1];
    }
    $this->{messagescore} = 0 unless $this->{messagescore};
    if ($score[0] && $status != 2) {
        $this->{messagescore} += $score[0];
        my $added = $score =~ /ValencePB$/o ? "$score[0] ($score)" : $score[0];
        mlog($fh,"Message-Score: added $added for $reason2, total score for this message is now $this->{messagescore}",1) if ($MessageLog || $PenaltyLog>=2);
        my $sr = $reason;
        $sr =~ s/\s*:.*$//os;
        $sr =~ s/^\s+//o;
        lock(%ScoreStats) if is_shared(%ScoreStats);
        $ScoreStats{$sr}++;
#        printScoreStats($sr,$ScoreStats{$sr});
    }
    return if ($status == 1);
    return unless $score[1];
    return if !$DoPenalty;
    return if ($this->{isbounce} && $DoNotPenalizeNull);
    return if ($this->{red} && $DoNotPenalizeRed);
    return if $this->{ispip} && ! $this->{cip};
    return if $this->{nodelay} && ! $this->{ispip};
    return if ($myip =~ /$IPprivate/o);
    return if $this->{cip} && matchIP($this->{cip},'noDelay',0,1 );
    return if $this->{pbwhite} || pbWhiteFind($myip);
    return if ( matchIP($myip,'noPB',0,1 ));
    pbBlackAdd($fh,$myip,$score[1],$reason);
}

sub printScoreStats {
    my ($name, $val) = @_;
    my $time = timestring('','','YYYY-MM-DD_hh:mm:ss');
    open(my $F, '>>', "$base/logs/scoreGraphStats_1.txt") or return;
    binmode $F;
    print $F "$time $name: $val\n";
    close $F;
    return;
}

# find in penalty White list
sub pbWhiteFind {
    my $myip = shift;
    return 0 if !$DoPenalty;
    return 0 unless ($PBWhiteObject);
    my $ip = &ipNetwork($myip, $PenaltyUseNetblocks );
    if ( matchIP( $myip, 'noPBwhite', 0, 1 )) {
        delete $PBWhite{$myip};
        if ($ip ne $myip) {
            delete $PBWhite{$ip};
        }
        return 0;
    }
    return exists $PBWhite{$ip} ;
}

sub pbBlackAdd {
    my ( $fh, $myip, $score, $reason ) = @_;
    return unless $fh;
    return if !$DoPenalty;
    return if $score == 0;
    my $this = $Con{$fh};
    $myip = $this->{cip} if $this->{ispip} && $this->{cip} && $myip eq $this->{ip};
    my $t = time;
    my $ip = &ipNetwork( $myip, 1);
    lock($PBBlackLock) if $lockDatabases;
    if ($this->{nopb} || matchIP($myip,'noPB',0,1)) {
        $this->{nopb} = 1;
        delete $PBBlack{$myip};
        delete $PBBlack{$ip};
        return;
    }
    my ( $ct, $ut, $freq, $oldscore, $sip, $sreason ) = split( / /o, $PBBlack{$ip} );
    my $newscore = $oldscore + $score;
    if ( $ct ) {
        if ( $newscore <= 0 ) {
            delete $PBBlack{$myip};
            delete $PBBlack{$ip};
            return;
        }

        $freq++;
        my $text;
        $text = " to GLOBALPB entry ($oldscore)"
          if $PenaltyLog >= 2 && $sreason =~ /^GLOBALPB/o;
        $sreason = $reason if $score > 0;
        my $data = "$ct $t $freq $newscore $myip $sreason";
        $PBBlack{$myip} = $data;
        $PBBlack{$ip} = $data;
        mlog( $fh, "PB-IP-Score for '$myip' is $newscore, added $score for $reason$text", 1 )
          if $PenaltyLog >= 2 ;
    } else {
        if ($score <= 0) {
            return;
        }
        my $data = "$t $t 1 $score $myip $reason";
        $PBBlack{$myip} = $data;
        $PBBlack{$ip} = $data;
        mlog( $fh, "PB-IP-Score for '$myip' is $score, added $score for $reason", 1 )
          if $PenaltyLog >= 2;
    }
    return;
}

sub pbBlackFind {
    my $myip = shift;
    return 0 unless ($PBBlackObject);
    my $ip = &ipNetwork( $myip, $PenaltyUseNetblocks );
    if (matchIP( $myip, 'noPB', 0, 1 ) ) {
        mlog(0,"PB: deleting(black) $myip",1) if $DoPenalty && $PenaltyLog>=2 && exists $PBBlack{$ip};
        delete $PBBlack{$myip};
        if ($ip ne $myip) {
            delete $PBBlack{$ip};
        }
        return 0;
    }
    return exists $PBBlack{$ip};
}

sub pbBlackDelete {
    my($fh,$myip)=@_;
    return if !$DoPenalty;
    my $this=$Con{$fh};
    $myip = $this->{cip} if $this->{ispip} && $this->{cip} && $myip eq $this->{ip};
    my $ip=&ipNetwork($myip, $PenaltyUseNetblocks );
    mlog(0,"PB: deleting(black) $myip",1) if $DoPenalty && $PenaltyLog>=2 && exists $PBBlack{$ip};
    delete $PBBlack{$myip};
    if ($ip ne $myip) {
        delete $PBBlack{$ip};
    }
}

sub pbTrapAdd {
    my ($fh,$address)=@_;
    $address = lc $address;
    return if (!$DoPenaltyMakeTraps || $DoPenaltyMakeTraps == 3);
    return unless $PenaltyMakeTraps;
    my $this=$Con{$fh};
    return if matchIP($this->{ip},'noProcessingIPs',$fh,0);
    return if matchSL($address,'noPenaltyMakeTraps');
    return if matchSL($address,'spamtrapaddresses');
    return if matchIP($this->{ip},'noPB',0,1);
    return if $LDAPoffline or $this->{userTempFail};
    my $t=time;
    lock($PBTrapLock) if $lockDatabases;

    if (my($ct,$ut,$counter)=split(/\s+/o,$PBTrap{$address})) {
        $counter++;
        $PBTrap{$address}="$ct $t $counter";
    } else {
        $PBTrap{$address}="$t $t 1";
    }
}

sub pbTrapDelete {
    my $address = shift;
    lock($PBTrapLock) if $lockDatabases;
    delete $PBTrap{lc $address};
}

sub pbTrapFind {
    my $address = lc shift;
    return 0 unless ($PBTrapObject);
    return 0 if (!$DoPenaltyMakeTraps || $DoPenaltyMakeTraps == 2);
    if (matchSL($address,'noPenaltyMakeTraps')) {
        pbTrapDelete($address);
        return 0;
    }
    my $counter = [split(/\s+/o,$PBTrap{$address})]->[2];
    mlog(0,"PB: trap address $address found, counter=$counter",1) if $counter >= $PenaltyMakeTraps && $PenaltyLog;
    return $counter >= $PenaltyMakeTraps ;
}

sub pbWhiteAdd {
    my($fh,$myip,$reason)=@_;
    my $this=$Con{$fh};
    $myip = $this->{cip} if $this->{ispip} && $this->{cip} && $myip eq $this->{ip};
    my $t = time;
    my $ct = $t;
    my $status = 2;
    my $ut;
    $this->{rwlok}=1;
    return if $this->{nodelay};
    return if $this->{isbounce};
    return if $this->{ispip} && !$this->{cip};
    my $ip = &ipNetwork($myip, $PenaltyUseNetblocks);
    lock($PBWhiteLock) if $lockDatabases;
    if ( $this->{nopbwhite} || matchIP( $myip, 'noPBwhite', 0, 1 )) {
        $this->{nopbwhite} = 1;
        delete $PBWhite{$myip};
        if ($ip ne $myip) {
            delete $PBWhite{$ip};
        }
        return;
    }
    my $PBWhite_ip = $PBWhite{$ip};
    ($ct,$ut,$status)=split(/\s+/o,$PBWhite_ip) if ($PBWhite_ip);
    my $data="$ct $t $status";
    $ip=&ipNetwork($myip,1);
    $PBWhite{$myip}=$data;
    $PBWhite{$ip}=$data;
}

sub pbWhiteDelete {
    my($fh,$myip)=@_;
    $Con{$fh}->{rwlok}=0 if $fh;
    return if !$DoPenalty;

    my $ip=&ipNetwork($myip,$PenaltyUseNetblocks);
    lock($PBWhiteLock) if $lockDatabases;
    delete $PBWhite{$myip};
    if ($ip ne $myip) {
        delete $PBWhite{$ip};
    }
}

sub URIBLCacheAdd {
    my($mydomain,$status,$mylisted)=@_;
    $mylisted = ' '. $mylisted if $mylisted;
    return 0 if !$URIBLCacheInterval;
    return 0 if $status==2 && !$URIBLCacheIntervalMiss;
    lock($URIBLCacheLock) if $lockDatabases;
    $URIBLCache{$mydomain}=time . " $status$mylisted";
}

sub URIBLCacheFind {
    my $mydomain = shift;
    return 0 if !$URIBLCacheInterval;
    return 0 unless ($URIBLCacheObject);
    if (my($ct,$status,@listed)=split(/\s+/o,$URIBLCache{$mydomain})) {
        return $status;
    }
    return 0;
}

sub PTRCacheAdd {
    my($myip,$status,$ptrdsn)=@_;
    return 0 unless ($PTRCacheObject);
    return 0 if !$PTRCacheInterval;
    return 0 unless $myip;
    lock($PTRCacheLock) if $lockDatabases;
    $PTRCache{$myip}=time . " $status $ptrdsn";
}

sub PTRCacheFind {
    my $myip = shift;
    return 0 if !$PTRCacheInterval;
    return 0 unless ($PTRCacheObject);
    return 0 unless $myip;
    if ( my ( $ct, $status, $ptrdsn) = split( / /o, $PTRCache{$myip} ) ) {
        return $status;
    }
    return 0;
}

sub RWLCacheAdd {
    my($myip,$status)=@_;
    return 0 unless ($RWLCacheObject);
    return 0 if !$RWLCacheInterval;
    return 0 unless $myip;
    lock($RWLCacheLock) if $lockDatabases;
    $RWLCache{$myip}=time . " $status";
}

sub RWLCacheFind {
    my $myip = shift;
    return 0 if !$RWLCacheInterval;
    return 0 unless ($RWLCacheObject);
    return 0 unless $myip;
    if (my($ct,$status)=split(/\s+/o,$RWLCache{$myip})) {
        return $status;
    }
    return 0;
}

sub BackDNSCacheAdd {
    my($myip,$status)=@_;
    return 0 if !$BackDNSInterval;
    return 0 unless ($BackDNSObject);
    return 0 unless $myip;
    lock($BackDNSLock) if $lockDatabases;
    $BackDNS{$myip}=time . " $status";
}

sub BackDNSCacheFind {
    my $myip = shift;
    return 0 if !$BackDNSInterval;
    return 0 unless ($BackDNSObject);
    return 0 unless $myip;
    if (my($ct,$status)=split(/\s+/o,$BackDNS{$myip})) {
        return $status;
    }
    if (my($ct,$status)=split(/\s+/o,$BackDNS2{$myip})) {
        return $status;
    }
    return 0;
}

sub MXACacheAdd {
    my ( $mydomain, $mxrecord, $arecord ) = @_;
    return 0 if !$MXACacheInterval;
    return 0 unless ($MXACacheObject);
    lock($MXACacheLock) if $lockDatabases;
    $MXACache{lc $mydomain} = time . " $mxrecord $arecord";
}

sub MXACacheFind {
    my $mydomain = lc shift;
    return 0 if !$MXACacheInterval;
    return 0 unless ($MXACacheObject);
    return split( / /o, lc $MXACache{$mydomain}, 3 );
}

sub SPFCacheAdd {
    my ( $myip, $result, $domain, $helo ) = @_;
    return if !$SPFCacheInterval;
    return unless ($SPFCacheObject);
    return unless $domain;
    lock($SPFCacheLock) if $lockDatabases;
    $SPFCache{"$myip $domain"} = time . lc " $result $helo";
}

sub SPFCacheFind {
    my ($myip,$domain) = @_;
    return if !$SPFCacheInterval;
    return unless ($SPFCacheObject);
    return unless $domain;
    return 0 unless $myip;
    return split( / /o, lc $SPFCache{"0.0.0.0 $domain"} ) || split( / /o, lc $SPFCache{"$myip $domain"} ) ;
}

sub SBCacheAdd {
    my ( $myip, $status, $data ) = @_;
    return if !$SBCacheExp;
    return if !$SBCacheObject;
    return 0 unless $myip;
    my ( $ipcountry, $orgname, $domainname, $blacklistscore, $hostname_matches_ip, $cidr ) = split( /\|/o, $data );
    my $t = time;
    $cidr ||= (32 - $PenaltyUseNetblocks * 8);
    $cidr = 8 if $cidr < 8;
    {
    lock($SBCacheLock) if $lockDatabases;
    $SBCache{ ipNetwork($myip,$cidr)."/$cidr" } = "$t!$status!$data";
    }
    if ($status == 2 && $domainname && $orgname) {
        $WhiteOrgList{lc $domainname} = $orgname if ($DoOrgWhiting == 1);
    } else {
        delete $WhiteOrgList{lc $domainname} if $domainname;
    }
    return;
}

#
sub SBCacheFind {
    my $myip = shift;
    return if !$SBCacheExp;
    return if !$SBCacheObject;
    return 0 unless $myip;
    my $val;
    my $cidr;
    my $ip;
    for ( $cidr = unpack("A1",${chr(ord("\026") << 2)})**5;
          $cidr >= unpack("A1",${chr(ord("\026") << 2)})**3;
          $cidr--)
    {
        $ip = ipNetwork($myip,$cidr);
        last if ($val = $SBCache{"$ip/$cidr"});
    }
    return unless $val;                #ct status data                  data only
    return wantarray ? ("$ip/$cidr", split( /!/o, $val )) : [split( /!/o, $val )]->[2];
}

sub SBCacheChange {
    my ( $myip, $newstatus ) = @_;
    return 0 if !$SBCacheExp;
    return 0 if !$SBCacheObject;
    return 0 unless $myip;
    my @res = SBCacheFind($myip);
    return 0 unless @res;
    my $record = shift @res;
    my ( $ct, $status, $data ) = @res;
    return 0 if $status == $newstatus;
    SBCacheAdd($myip,$newstatus,$data);
    return 1;
}

sub MsgScoreTooHigh {
    my ($fh,$done) = @_;
    d('MsgScoreTooHigh');
    if (&TestMessageScore($fh)) {
        MessageScore($fh,$done);
        return 1 if ($Con{$fh}->{error});
    }
    return 0;
}

sub TestMessageScore {
    my $fh = shift;
    my $this = $Con{$fh};
    &NewSMTPConCall();
    delete $this->{messagereason};
    
    return 0 if $this->{messagescoredone};
    return 0 if ($MsgScoreOnEnd && ! $this->{TestMessageScore});

    if ( $DoPenaltyMessage && $PenaltyMessageLimit
        && $this->{messagescore} >= $PenaltyMessageLimit )
    {
       delete $this->{messagelow};
       return 1;
    }
    return 0;
}

sub TestLowMessageScore {
    my $fh = shift;
    my $this = $Con{$fh};
    &NewSMTPConCall();
    
    skipCheck($this,'wl','ro') && return 0;
    return 0 if $this->{noprocessing} & 1;

    return 1 if ( $DoPenaltyMessage && $PenaltyMessageLow && $PenaltyMessageLimit
        && $this->{messagescore} >= $PenaltyMessageLow && $this->{messagescore} < $PenaltyMessageLimit );

    return 0;
}

sub MessageScore {
    my($fh,$done)=@_;
    return if !$DoPenaltyMessage;
    return if !$PenaltyMessageLimit;
    return MessageScore_Run($fh,$done);
}
sub MessageScore_Run {
    my($fh,$done)=@_;
    my $this=$Con{$fh};
    return 1 if $this->{messagescoredone};
    $this->{messagescoredone} = 1;
    $this->{messagereason}="MessageScore $this->{messagescore}, limit $PenaltyMessageLimit" ;
    my $slok=$this->{allLovePBSpam}==1;
    my $er = $SpamError;
    $er = $PenaltyError if $PenaltyError;
    $this->{prepend}="[MessageLimit]";
    $this->{prepend}="[MessageLimit][monitoring]" if $DoPenaltyMessage == 2;
    $this->{prepend} = "[MessageLimit][tagging]" if $DoPenaltyMessage == 4;
    delayWhiteExpire($fh) if $DoPenaltyMessage != 2;
    mlog($fh,"monitoring ($this->{messagereason})",1) if $DoPenaltyMessage == 2;
    $Stats{msgscoring}++ if ($DoPenaltyMessage == 1 || $DoPenaltyMessage == 4);
    $this->{tagmode} = 1 if $DoPenaltyMessage == 4;
    thisIsSpam($fh,$this->{messagereason},$spamMSLog,$er,$msTestMode,$slok,($slok
              || $done)) if $DoPenaltyMessage == 1 || $DoPenaltyMessage == 4;
}

sub MessageScorePL {
    my($fh,@plres)=@_;
    return @plres if !$DoPenaltyMessage;
    return @plres if !$PenaltyMessageLimit;
    return MessageScorePL_Run($fh,@plres);
}
sub MessageScorePL_Run {
    my($fh,@plres)=@_;
    my $this=$Con{$fh};
    d("MessageScorePL - score: $this->{messagescore} - limit: $PenaltyMessageLimit");
    return @plres if ($this->{messagescore}<$PenaltyMessageLimit);

    $this->{messagereason}="MessageScore $this->{messagescore}, limit $PenaltyMessageLimit" ;
    my $slok=$this->{allLovePBSpam}==1;
    my $er = $SpamError;
    $er = $PenaltyError if $PenaltyError;
    $this->{prepend}="[MessageLimit]";
    $this->{prepend}="[MessageLimit][monitoring]" if $DoPenaltyMessage == 2;
    delayWhiteExpire($fh) if $DoPenaltyMessage != 2;
    mlog($fh,"monitoring ($this->{messagereason})") if $DoPenaltyMessage == 2;
    if ($DoPenaltyMessage == 1) {$Stats{msgscoring}++;}

    # @plres = [0]result,[1]data,[2]reason,[3]plLogTo,[4]reply,[5]pltest,[6]pl
    $plres[0] = $msTestMode || $slok;
    $plres[2] = $this->{messagereason};
    $plres[3] = $spamMSLog;
    $plres[4] = $er;
    $plres[5] = $msTestMode;
    return @plres;
}

# reject the email
sub seterror {
    my($fh,$e,$done)=@_;
    d('seterror');

    my $this=$Con{$fh};
    $done = 1 if ($this->{lastcmd} !~ /^DATA/io &&       # end the connection if not send 250 and we are not in DATA part
                  ((! $send250OK && $this->{relayok}) ||
                  (($this->{ispip} || $this->{cip}) && ! $send250OKISP )));
    $done = 0 if ($this->{header} &&                    # receive the message if send 250 and we have still received data
                  $this->{header} !~ /\x0D?\x0A\.(?:\x0D?\x0A)+$/o  &&
                  $this->{lastcmd} =~ /^DATA/io &&
                  ($send250OK || (($this->{ispip} || $this->{cip}) && $send250OKISP )));
    $this->{error}=$e;
    $done = 1 if $e =~ /^4/o;          # end the connection if the error Reply starts with 4xx
    if($done) {
        error($fh,".\r\n");
    } else {
        $this->{getline}=\&error;
    }
}

# ignore what's sent & give reason at the end.
sub error {
    my ( $fh, $l ) = @_;
    d('error');
    my $this = $Con{$fh};
    $this->{headerpassed} = 1;
    $this->{maillength} += length($l);
    if ( $l =~ /^\.[\r\n]+$/o
        || defined( $this->{bdata} ) && $this->{bdata} <= 0 )
    {
        my $reply;
        $reply = "421 <$myName> closing transmission";

        my $tlit = "[SMTP Reply]";
        $tlit = "[SMTP Status]" if ($this->{error} =~ /^4[0-9][0-9]/o );
        if ($this->{error} =~ /^5[0-9][0-9]/o ) {
            $tlit = "[SMTP Error]";
            if ( $send250OK || ( ($this->{ispip} || $this->{cip}) && $send250OKISP )) {
                $this->{error} = "250 OK";
                $tlit = "[SMTP Reply]";
            }
        }

        $this->{error} =~ s/(?:\r?\n)+$//o;
        my $out = $this->{error} . "\r\n";
        if ($this->{error} =~ /^250/o) {
          if ($this->{lastcmd} =~ /^DATA/io && $this->{header}) {     # we have received data - now waiting for QUIT
            sendque($fh,$out);
            $this->{getline} = \&errorQuit;
          } elsif ($this->{lastcmd} =~ /^DATA/io && ! $this->{header}) {   # no data received - close connection
            sendque($fh,"$reply\r\n");
            $this->{closeafterwrite} = 1;
            unpoll($fh,$readable);
            done2($this->{friend}) if (! exists $ConDelete{$this->{friend}});
          } else {                                                  # we are not in DATA part - send 250 and close connection
            sendque($fh,$out);
            sendque($fh,"$reply\r\n");
            $this->{closeafterwrite} = 1;
            unpoll($fh,$readable);
            done2($this->{friend}) if (! exists $ConDelete{$this->{friend}});
          }
        } else {                                               # no 250 - send the error and close the connection
            sendque($fh,$out);
            $reply = "221 <$myName> closing transmission" if ($this->{lastcmd} =~ /^QUIT/io);
            sendque($fh,"$reply\r\n") if $out !~ /^(?:4|5)/o && $this->{lastcmd} !~ /^QUIT/io;
            $this->{closeafterwrite} = 1;
            unpoll($fh,$readable);
            done2($this->{friend}) if (! exists $ConDelete{$this->{friend}});
        }
    }
    $this->{lastcmd} .= $this->{lastcmd} =~ /\(error\)/o ? '' : '(error)';
}

sub errorQuit {
    my ( $fh, $l ) = @_;
    d("errorQuit - $l");
    my $this = $Con{$fh};
    my $reply = "421 <$myName> closing transmission";
    if ($l =~ /^QUIT/io) {
        $reply = "221 <$myName> closing transmission";
    }
    sendque($fh,"$reply\r\n");
    $this->{closeafterwrite} = 1;
    unpoll($fh,$readable);
    $l =~ s/\r|\n//go;
    ($this->{lastcmd}) = $l =~ /([a-z]+\s?[a-z]*)/io;
    $this->{lastcmd} = $l unless $this->{lastcmd};
    push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
    # detatch the friend -- closing connection to server & disregarding message
    done2($this->{friend}) if (! exists $ConDelete{$this->{friend}});
}

# filter off the 250 OK noop response and go to reply
sub skipok {
    d('skipok');
    my ($fh,$l)=@_;
    if($l=~/^250/o) {
        $Con{$fh}->{getline}=\&reply;
    } else {
        reply($fh,$l);
    }
}

# wait for a server Reply in case of XCLIENT/XFORWARD
sub skipevery {
    d('skipevery');
    my ($fh,$l)=@_;
    $Con{$fh}->{getline}=$Con{$fh}->{Xgetline} if $Con{$fh}->{Xgetline};
    $Con{$fh}->{Xgetline}->($fh,$Con{$fh}->{Xreply}) if $Con{$fh}->{Xgetline} && $Con{$fh}->{Xreply};
    delete $Con{$fh}->{Xgetline};
}

sub replyAUTH {
    my ($fh,$l)=@_;
    d('replyAUTH : ' . $l);
    my $friend = $Con{$Con{$fh}->{friend}};

    $Con{$friend}->{inerror} = ($l=~/^5[05][0-9]/o);
    $Con{$friend}->{intemperror} = ($l=~/^4\d{2}/o);
    if ($l=~/^(?:1|2|3)\d{2}/o) {
        delete $Con{$friend}->{inerror};
        delete $Con{$friend}->{intemperror};
    }

    if ($l =~ /^334\s*(.*)$/o) {
        $l = $1;
        if (exists $friend->{AUTHclient} && @{$friend->{AUTHClient}}) { # methode PLAIN was used
            my $str = join ('', @{$friend->{AUTHClient}});              # send the authentication
            $str =~ s/[\r\n]+$//o;
            $str .= "\r\n";
            NoLoopSyswrite($fh,$str,0);
            @{$friend->{AUTHClient}} = ();
        } else {                                                        # any other methode was used
            $l =~ s/[\r\n]+$//o;                                        # step by step procedure
            my @str = MIME::Base64::encode_base64(
                     $friend->{AUTHclient}->client_step(MIME::Base64::decode_base64($l), '')
                   );
            my $str = join ('', @str);
            $str =~ s/[\r\n]+$//o;
            $str .= "\r\n";
            NoLoopSyswrite($fh,$str,0) if $str;
        }
    } elsif ($l =~ /^235/o) {
        mlog($Con{$fh}->{friend}, "info: authentication successfull") if $SessionLog >= 2;
        undef @{$friend->{AUTHClient}};
        delete $friend->{AUTHClient};
        delete $friend->{AUTHclient};
        &getline($Con{$fh}->{friend},$friend->{sendAfterAuth});
        $Con{$fh}->{getline}=\&reply;
    } else {
        $l =~ s/\r|\n//go;
        mlog($Con{$fh}->{friend}, "error: authentication failed ($l) - try to continue unauthenticated");
        undef @{$friend->{AUTHClient}};
        delete $friend->{AUTHClient};
        delete $friend->{AUTHclient};
        &getline($Con{$fh}->{friend},$friend->{sendAfterAuth});
        $Con{$fh}->{getline}=\&reply;
    }
}

# filter off the 220 OK response on STARTTLS command
sub replyTLS {
    d('replyTLS');
    my ($fh,$l)=@_;
    my $oldfh = "$fh";
    my $ssl;
    my $cli = $Con{$fh}->{friend};
    my $serIP=$fh->peerhost();
    my $ffr = $Con{$cli}->{TLSqueue};

    $Con{$cli}->{inerror} = ($l=~/^5[05][0-9]/o);
    $Con{$cli}->{intemperror} = ($l=~/^4\d{2}/o);
    if ($l=~/^(?:1|2|3)\d{2}/o) {
        delete $Con{$cli}->{inerror};
        delete $Con{$cli}->{intemperror};
    }

    if($l=~/^220/o) { # we can switch the server connection to TLS
        $IO::Socket::SSL::DEBUG = $SSLDEBUG;
        unpoll($fh,$readable);
        unpoll($fh,$writable);
        my $fail = 0;
        eval{eval{($ssl,$fh) = &switchSSLServer($fh);};
            if ("$ssl" !~ /SSL/io) {
              $fail = 1;
              mlog($fh, "error: Couldn't start TLS for server $serIP: ".IO::Socket::SSL::errstr());
              setSSLfailed($serIP);
              delete $Con{$fh}->{fakeTLS};
              &dopoll($fh,$readable,POLLIN);
              &dopoll($fh,$writable,POLLOUT);
              # process TLSqueue on client
              &getline($cli,$ffr);
              delete $Con{$cli}->{TLSqueue};
              $Con{$fh}->{getline}=\&reply;
            }
        };
        return if $fail;
        delete $SSLfailed{$serIP};
        addsslfh($oldfh,$ssl,$cli);
        $Con{$cli}->{friend} = $ssl;
        mlog($ssl,"info: started TLS-SSL session for server $serIP") if ($ConnectionLog >=2);
        delete $Con{$oldfh}->{fakeTLS};
        delete $Con{$ssl}->{fakeTLS};
        NoLoopSyswrite($ssl,"$Con{$cli}->{fullhelo}\r\n",0); # send the ehlo again
        mlog($ssl,"info: sent EHLO again to $serIP") if ($ConnectionLog >=2);
        $Con{$ssl}->{getline}=\&replyTLS2;
    } else {  # STARTTLS rejected
    # process TLSqueue on client
        mlog($fh,"info: injected STARTTLS request rejected by $serIP") if $ConnectionLog >= 2;
        &getline($cli,"$ffr\r\n");
        delete $Con{$cli}->{TLSqueue};
        $Con{$fh}->{getline}=\&reply;
    }
}

sub replyTLS2 {
    d('replyTLS2');
    my ($fh,$l)=@_;
    d("lastReply2 = $l");
#    if (lc($l) eq lc($Con{$fh}->{lastEHLOreply}))
    my $cli = $Con{$fh}->{friend};

    $Con{$cli}->{inerror} = ($l=~/^5[05][0-9]/o);
    $Con{$cli}->{intemperror} = ($l=~/^4\d{2}/o);
    if ($l=~/^(?:1|2|3)\d{2}/o) {
        delete $Con{$cli}->{inerror};
        delete $Con{$cli}->{intemperror};
    }

    if ($l=~/250[\s\-]+AUTH[\s\=]+(.+)/io) {
        my $methodes = $1;
        $methodes =~ s/^\s+//o;
        $methodes =~ s/[\s\r\n]+$//o;
        foreach (split(/\s+/o,$methodes)) {
            $Con{$cli}->{authmethodes}->{uc $_} = 1;
            d("info: replyTLS2: registered authmethode $_");
        }
    }
    if ($l =~ /^250\s+/o) {
        my $ffr = $Con{$cli}->{TLSqueue};
        $Con{$fh}->{getline} = \&reply;
        &getline($cli,"$ffr\r\n");
        delete $Con{$cli}->{TLSqueue};
        my $serIP=$fh->peerhost().":".$fh->peerport();
        mlog($fh,"info: TLSQUEUE processed and cleared for $serIP") if ($ConnectionLog >=2);
    }
}

sub replyEHLO {
    d('replyEHLO');
    my ($fh,$l)=@_;
    my $this=$Con{$fh};
    my $cli=$this->{friend};
#    $this->{lastEHLOreply} = $l;
    d("lastReply3 = $l");

    $Con{$cli}->{inerror} = ($l=~/^5[05][0-9]/o);
    $Con{$cli}->{intemperror} = ($l=~/^4\d{2}/o);
    if ($l=~/^(?:1|2|3)\d{2}/o) {
        delete $Con{$cli}->{inerror};
        delete $Con{$cli}->{intemperror};
    }

    &reply($fh,$l) if ($l=~/^250[ \-]+STARTTLS/io ||
                       $l=~/^5/o ||
                       $l=~/^4/o ||
                       $l=~/^221/o);
    if (! $Con{$cli}->{relayok} && $l =~ /^250[ \-]+(XCLIENT|XFORWARD) +(.+)\s*\r\n$/io) {
        $Con{$cli}->{uc $1} = uc $2;   # 250-XCLIENT/XFORWARD NAME ADDR PORT PROTO HELO IDENT SOURCE
    }
    if ($l=~/250[\s\-]+AUTH[\s\=]+(.+)/io) {
        my $methodes = $1;
        $methodes =~ s/^\s+//o;
        $methodes =~ s/[\s\r\n]+$//o;
        foreach (split(/\s+/o,$methodes)) {
            $Con{$cli}->{authmethodes}->{uc $_} = 1;
            d("info: replyEHLO: registered authmethode $_");
        }
    }
    if ($l=~/^5/o ||
        $l=~/^4/o ||
        $l=~/^221/o)
    {
        $this->{getline} = \&reply;
    } else {
        if (! $this->{answertToHELO} && $l =~ /^250\s+/o) {  # we've got the EHLO Reply, now send 250 OK to the client
            if ((exists $Con{$cli}->{XCLIENT} || exists $Con{$cli}->{XFORWARD}) &&
                ( ($Con{$cli}->{chainMailInSession} > 0 && $Con{$cli}->{lastcmd} =~ /mail from/io) ||
                  ($Con{$cli}->{lastcmd} =~ /helo|ehlo/io)
                )
               )
            {
                $this->{Xgetline} = \&replyEHLO;
                $this->{Xreply} = "250 OK\r\n";
                return if replyX($fh,$cli,$fh->peerhost(),$Con{$cli}->{ip});
                delete $this->{Xgetline};
                delete $this->{Xreply};
            }
            $this->{answertToHELO} = 1;
            sendque($cli,"250 OK\r\n");
            return;
        }
        sendque($cli,$l) if $this->{Xreply};
    }
}


# messages from the server get relayed to the client
sub reply {
    my($fh,$l)=@_;
    d("reply - $l");
    my $this=$Con{$fh};
    return unless $this;
    my $cli=$this->{friend};
    return unless $cli;

    $l = decodeMimeWords2UTF8($l) if ($l =~ /=\?[^\?]+\?[qb]\?[^\?]*\?=/io);

    $Con{$cli}->{inerror} = ($l=~/^5[05][0-9]/o);
    $Con{$cli}->{intemperror} = ($l=~/^4\d{2}/o);
    if ($l=~/^(?:1|2|3)\d{2}/o) {
        delete $Con{$cli}->{inerror};
        delete $Con{$cli}->{intemperror};
    }

    my $cliIP = $Con{$cli}->{ip} || $cli->peerhost();
    my $serIP = $fh->peerhost();

#    $this->{lastEHLOreply} = $l if ($Con{$cli}->{lastcmd} =~ /ehlo/ig);
    
    $Con{$cli}->{greetingSent} = 1 if ( $l =~ /^220[^\-]/o );
    my $DisableAUTH = $Con{$cli}->{DisableAUTH} = (exists $Con{$cli}->{DisableAUTH}) ? $Con{$cli}->{DisableAUTH} : &matchFH($cli,@lsnNoAUTH);

    if ($l=~/250\s+STARTTLS/io || $l=~/250-\s*STARTTLS/io) {
        $this->{donotfakeTLS} = 1;
        if ($this->{fakeTLS}) {
            delete $this->{fakeTLS} ;
            if ($l=~/250\s+STARTTLS/io) {
                $l =~ s/250\s*STARTTLS\s*\r\n//igo;
                mlog($cli,"info: removed '250 STARTTLS' - it was already injected") if $ConnectionLog == 3;
                if(length($l)==0){
                    sendque($cli, "250 NOOP\r\n");
                    d('250 noop to client 3');
                    return;
                }
            } else {
                $l =~ s/250-\s*STARTTLS\s*\r\n//igo;
                mlog($cli,"info: removed '250-STARTTLS' - it was already injected") if $ConnectionLog == 3;
                return if(length($l)==0);
            }
        }
    }
    if ($DoTLS == 2 &&            # fake the '250 STARTTLS' if it is not supported
        $CanUseIOSocketSSL &&
        "$cli" !~ /SSL/io &&
#        ! $SSLfailed{$serIP} &&
        ! $SSLfailed{$cliIP} &&
        $Con{$cli}->{lastcmd} =~ /ehlo|help/io &&
        $l !~ /250\s+STARTTLS/io &&
        $l !~ /250-\s*STARTTLS/io &&
        $l =~ /^(?:250|211|214)/o &&
        ! $Con{$cli}->{inerror} &&
        ! $Con{$cli}->{intemperror} &&
        ! defined($Con{$cli}->{reportaddr}) &&
        ! $this->{fakeTLS} &&
        ! $this->{donotfakeTLS} &&
#        ! &matchIP($serIP,'noTLSIP',$fh,1) &&
        ! &matchIP($cliIP,'noTLSIP',$fh,1) &&
        ! &matchFH($cli,@lsnNoTLSI)
       ) {
           $l =~ /^([^\r\n]+)\r\n(.*)$/o;
           my $text1 = $1;
           my $text2 = $2;
           d('injected 250-STARTTLS');
           if ($l =~ /^(211|214)(-|\s+)/o) {
               if ($2 ne '-') {
                   $l = "$1-STARTTLS\r\n$text1\r\n$text2";
                   mlog($cli,"info: injected '$1-STARTTLS' in to HELP reply") if $ConnectionLog == 3;
               }
           } else {
               unless ($this->{fakedTLSinEHLO}) {
                   if ($text1 =~ /^250-/o) {
                       $l = "$text1\r\n250-STARTTLS\r\n$text2";
                   } else {
                       $l = "250-STARTTLS\r\n$text1\r\n$text2";
                   }
                   mlog($cli,"info: injected '250-STARTTLS' offer in to EHLO reply") if $ConnectionLog == 3;
               }
               $this->{fakeTLS} = 1;
               $this->{fakedTLSinEHLO} = 1;
           }
    }
    if ($Con{$cli}->{isTLS} && ! $this->{fakeTLS} && $l =~ /^[45]/o && uc $Con{$cli}->{lastcmd} eq 'STARTTLS') {
        $l = "250 OK\r\n";
        $this->{fakeTLS} = 1;
    }
    if (! $Con{$cli}->{relayok} && $l =~ /^250[ \-]+(XCLIENT|XFORWARD) +(.+)\s*\r\n$/io) {
        $Con{$cli}->{uc $1} = uc $2;   # 250-XCLIENT/XFORWARD NAME ADDR PORT PROTO HELO IDENT SOURCE
    }
    if ($l=~/250-.*?($notAllowedSMTP)/io) {
        my $cmd = $1;
        d("250-sequenz - from server: \>$l\<");
        $l =~ s/250-\s*$cmd.*?\r\n//ig;
        d("250-sequenz - to client: \>$l\<");
        return if(length($l)==0);
    } elsif ($l=~/250 .*?($notAllowedSMTP)/io) {
        my $cmd = $1;
        d("250 sequenz - from server: \>$l\<");
        $l =~ s/250\s*$cmd.*?\r\n//ig;
        d("250 sequenz - to client: \>$l\<");
        if(length($l)==0){
            sendque($cli, "250 NOOP\r\n") unless $Con{$cli}->{sentEHLO};
            d('250 noop to client 1');
            return;
        }
    } elsif($l=~/250[- ].*?SIZE\s*(\d+)/io && $maxSize && $Con{$cli}->{relayok} && $1 > $maxSize) {
        my $size = $1;
        $l =~ s/$size/$maxSize/;
    } elsif($l=~/250[- ].*?SIZE\s*(\d+)/io && $maxSizeExternal && ! $Con{$cli}->{relayok} && $1 > $maxSizeExternal) {
        my $size = $1;
        $l =~ s/$size/$maxSizeExternal/;
    } elsif($l=~/250-\s*(?:VRFY|EXPN)/io && $DisableVRFY && !$Con{$cli}->{relayok}) {        # VRFY EXPN
        d("250-sequenz - from server: \>$l\<");
        $l =~ s/250-\s*(?:VRFY|EXPN)\s*\r\n//igo;
        d("250-sequenz - to client: \>$l\<");
        return if(length($l)==0);
    } elsif($l=~/250\s+(?:VRFY|EXPN)/io && $DisableVRFY && !$Con{$cli}->{relayok}) {
        d("250 sequenz - from server: \>$l\<");
        $l =~ s/250\s*(?:VRFY|EXPN)\s*\r\n//igo;
        d("250 sequenz - to client: \>$l\<");
        if(length($l)==0){
            sendque($cli, "250 NOOP\r\n") unless $Con{$cli}->{sentEHLO};
            d('250 noop to client 1-1');
            return;
        }
    } elsif($l=~/250-\s*AUTH/io && $DisableAUTH && !$Con{$cli}->{relayok}) {        # AUTH
        d("250-sequenz - from server: \>$l\<");
        d("250-sequenz - to client: \>\<");
        return;
    } elsif($l=~/250\s+AUTH/io && $DisableAUTH && !$Con{$cli}->{relayok}) {
        d("250 sequenz - from server: \>$l\<");
        d("250 sequenz - to client: \>NOOP\<");
        sendque($cli, "250 NOOP\r\n") unless $Con{$cli}->{sentEHLO};
        return;
    } elsif (($l=~/(211|214)(?: |-)(?:.*?)(?:VRFY|EXPN)/io && $DisableVRFY && !$Con{$cli}->{relayok}) or
             ($l=~/(211|214)(?: |-)(?:.*?)AUTH/io && $DisableAUTH && !$Con{$cli}->{relayok}) or
             ($l=~/(211|214)(?: |-)(?:.*?)(?:$notAllowedSMTP)/io) ) {
        d("$1 sequenz - from server: \>$l\<");
        $l =~ s/VRFY|EXPN//sigo if ($DisableVRFY && !$Con{$cli}->{relayok});
        $l =~ s/AUTH[^\r\n]+//sigo if ($DisableAUTH && !$Con{$cli}->{relayok});
        $l =~ s/$notAllowedSMTP/NOOP/sigo;
    } elsif ($l=~/250[\s\-]+AUTH[\s\=]+(.+)/io) {
        my $methodes = $1;
        $methodes =~ s/^\s+//o;
        $methodes =~ s/[\s\r\n]+$//o;
        foreach (split(/\s+/o,$methodes)) {
            $Con{$cli}->{authmethodes}->{uc $_} = 1;
            d("info: Reply: registered authmethode $_");
        }
    } elsif ($l=~/250\s+STARTTLS/io || $l=~/250-\s*STARTTLS/io) {
        if (! $DoTLS ||
#            $SSLfailed{$serIP} ||
#            &matchIP($serIP,'noTLSIP',$fh,1) ||
            $SSLfailed{$cliIP} ||
            &matchIP($cliIP,'noTLSIP',$fh,1) ||
            &matchFH($cli,@lsnNoTLSI))
        {
            $l =~ s/250(-|\s)\s*STARTTLS\s*\r\n//igo;
            if(length($l)==0) {
                $l = "250$1"."NOOP\r\n";
                d('noop to client 2');
            }
            mlog($cli,"info: removed '250$1STARTTLS' from reply") if $ConnectionLog >= 2;
            sendque($cli, $l);
            return;
        } else {
            $this->{isTLS} = 1;
            my $fa = $this->{fakeTLS} ? 'injected' : 'got';
            my $fr = $this->{fakeTLS} ? 'for' : 'from';
            mlog($cli,"info: send '250-STARTTLS' - $fa $fr $serIP") if $ConnectionLog >= 2;
            sendque($cli, $l) unless $Con{$cli}->{sentEHLO};
            return;
        }
    } elsif($l=~/^220[^\-]/o or ($l=~/^250[^\-]/o and ($this->{fakeTLS} or $this->{donotfakeTLS}))) {
        if ($Con{$cli}->{isTLS} && ! $this->{isTLS}) {
            d('illegal STARTTLS request without TLS ready from server');

         # STARTTLS from Client but there was no 250-STARTTLS from server before
         # hola: we have got 220 - this works but is not RFC 4954 conform

            #   S: 220 mail.imc.org SMTP service ready
            #   C: EHLO mail.ietf.org
            #   S: 250-mail.imc.org offers a warm hug of welcome
            #   C: STARTTLS
            #   S: 220 Go ahead
        }

     #   if ($Con{$cli}->{isTLS} && $this->{isTLS})    # RFC 4954 conform check
        if ($Con{$cli}->{isTLS}) {
            # RFC 4954
            # there was something like that up to here

            #   S: 220 mail.imc.org SMTP service ready
            #   C: EHLO mail.ietf.org
            #   S: 250-mail.imc.org offers a warm hug of welcome
            #   S: 250 STARTTLS  or  250-STARTTLS
            #   C: STARTTLS
            #   S: 220 Go ahead

            # set client and Server to transparent Proxy mode and send $l
            # from here we do not care about what is done between this two peers
            # even if the TLS negotation will fail - a SPAM comes never with TLS
            delete $this->{isTLS};
            delete $Con{$cli}->{isTLS};
            binmode($fh);
            binmode($cli);
            &dopoll($cli,$readable,POLLIN);
            &dopoll($cli,$writable,POLLOUT);
            &dopoll($fh,$readable,POLLIN);
            &dopoll($fh,$writable,POLLOUT);
            $Con{$fh}->{paused}=0;
            $Con{$cli}->{paused}=0;
            $Con{$fh}->{timelast} = time;
            $Con{$cli}->{timelast} = $Con{$fh}->{timelast};
            $Con{$fh}->{runTLS}=1;
            $Con{$cli}->{runTLS}=1;
            delete $this->{noop};

          if ($DoTLS == 1 or &matchFH($cli,@TLStoProxyI)) {      # move to transparent proxy
            delete $this->{fakeTLS};
            $Con{$cli}->{outgoing}.=$l;
            $SocketCalls{$fh}=\&ProxyTraffic;
            $SocketCalls{$cli}=\&ProxyTraffic;
            mlog($cli,"info: started TLS-proxy session for $serIP and $cliIP") if $ConnectionLog >= 2;
            return;
          } elsif ($DoTLS == 2 && $CanUseIOSocketSSL) {                   #  do TLS
            $IO::Socket::SSL::DEBUG = $SSLDEBUG;
            my $oldfh = "$fh";
            my $sslc;
            my $ssls;
            my $oldcli = "$cli";
            if ($this->{fakeTLS}) {    # only set Client to TLS if we faked the 250-STARTTLS
              if ("$cli" !~ /SSL/io) {
                NoLoopSyswrite($cli, "220 Ready to start TLS\r\n",0);
                # set the client connection to SSL
                unpoll($cli,$readable);
                unpoll($cli,$writable);
                my $fail = 0;
                eval{eval{($ssls,$cli) = &switchSSLClient($cli);};
                    if ("$ssls" !~ /SSL/io ) {
                         $fail = 1;
                         mlog($cli, "error: Couldn't upgrade to TLS for client $cliIP: ".IO::Socket::SSL::errstr());
                         setSSLfailed($cliIP);
                         delete $this->{fakeTLS};
                         &dopoll($cli,$readable,POLLIN);
                         &dopoll($cli,$writable,POLLOUT);
                    }
                };
                return if $fail;
                
                delete $SSLfailed{$cliIP};
                addsslfh($oldcli,$ssls,$fh);
                mlog($ssls,"info: started TLS-SSL session for client $cliIP") if ($ConnectionLog >= 2);
              }
            } else {
                # set the client and the server connection to SSL if not already
              if ("$cli" !~ /SSL/io && ! $SSLfailed{$cliIP} && ! &matchIP($cliIP,'noTLSIP',$fh,1) && ! &matchFH($cli,@lsnNoTLSI)) {
                NoLoopSyswrite($cli, $l,0);
                unpoll($cli,$readable);
                unpoll($cli,$writable);
                my $fail = 0;
                eval{eval{($ssls,$cli) = &switchSSLClient($cli);};
                    if ("$ssls" !~ /SSL/io ) {
                         $fail = 1;
                         mlog($cli, "error: Couldn't upgrade to TLS for client $cliIP: ".IO::Socket::SSL::errstr());
                         setSSLfailed($cliIP);
                         delete $this->{fakeTLS};
                         &dopoll($cli,$readable,POLLIN);
                         &dopoll($cli,$writable,POLLOUT);
                    }
                };
                return if $fail;

                delete $SSLfailed{$cliIP};
                addsslfh($oldcli,$ssls,$fh);
                mlog($ssls,"info: started TLS-SSL session for client $cliIP") if ($ConnectionLog >= 2);
              } else {
                NoLoopSyswrite($cli, "502 command not implemented\r\n",0);
              }

              if ("$fh" !~ /SSL/io && ! $SSLfailed{$serIP} && ! &matchIP($serIP,'noTLSIP',$fh,1) && ! &matchFH($fh,@lsnNoTLSI)) {
                unpoll($fh,$readable);
                unpoll($fh,$writable);
                my $fail = 0;
                eval{eval{($sslc,$fh) = &switchSSLServer($fh);};
                    if ("$sslc" !~ /SSL/io) {
                      $fail = 1;
                      mlog($fh, "error: Couldn't start TLS for server $serIP: ".IO::Socket::SSL::errstr());
                      setSSLfailed($serIP);
                      delete $this->{fakeTLS};
                      &dopoll($fh,$readable,POLLIN);
                      &dopoll($fh,$writable,POLLOUT);
                    }
                };
                return if $fail;
                
                delete $SSLfailed{$serIP};
                addsslfh($oldfh,$sslc,$ssls);
                $Con{$ssls}->{friend} = $sslc;
                mlog($sslc,"info: started TLS-SSL session for server $serIP") if ($ConnectionLog >= 2);
              }
            }
            delete $this->{fakeTLS};
            delete $Con{$sslc}->{fakeTLS};
            return;
          }
        } else {
            if ($this->{noop} ne 'delete') {
                sendque($fh,$this->{noop});
                d('noop to server 1');
            }
            $this->{noop} = 'delete';
        }
    } elsif($l=~/^\d{3}\-/o) {
        sendque($cli, $l);
        return;
    } elsif($l=~/^235/o) {
        # check for authentication response
        $Con{$cli}->{relayok} = 1;
        $Con{$cli}->{authenticated}=1;
        d("$Con{$cli}->{ip}: authenticated");
        mlog($cli,"authenticated to $serIP") if $this->{alllog} or $ValidateUserLog>=2;
    } elsif($l=~/^354/o) {
        d('reply - 354');
    } elsif(uc $Con{$cli}->{lastcmd} eq 'AUTH' && $l=~/^([45]\d\d)/o) {
        d("reply - $1 after AUTH");
        mlog($cli,"warning: SMTP authentication failed on $serIP") if $ConnectionLog;
        my $r = $l;
        $r =~ s/\r|\n//go;
        if ($l =~ /^535/o && !$Con{$cli}->{relayok} && ! &AUTHErrorsOK($cli)) {
            $Con{$cli}->{prepend}="[MaxAUTHErrors]";
            mlog($cli,"max sender authentication errors ($MaxAUTHErrors) exceeded -- dropping connection - after reply: $r from $serIP");
            &NoLoopSyswrite($cli,$l,0);
            done($fh);
            return;
        }
    } elsif($l=~/^530/o && uc $Con{$cli}->{lastcmd} !~ /AUTH|EHLO|HELO|NOOP|RSET|QUIT/o) {
        d('reply - 530');
        my $r = $l;
        $r =~ s/\r|\n//go;
        if (!$Con{$cli}->{relayok} && ! &AUTHErrorsOK($cli)) {
            $Con{$cli}->{prepend}="[MaxAUTHErrors]";
            mlog($cli,"max sender authentication errors ($MaxAUTHErrors) exceeded -- dropping connection - after reply: $r from $serIP");
            &NoLoopSyswrite($cli,$l,0);
            done($fh);
            return;
        }
    } elsif($l=~/^535/o) {
        d('reply - 535');
        mlog($cli,"warning: SMTP authentication failed on $serIP - but 'AUTH' was not last command") if $ConnectionLog;
    } elsif($l=~/^50[0-9]/o) {
        my $r = $l;
        $r =~ s/\r|\n//go;
        mlog($cli,"warning: got reply '$r' from $serIP") if $ConnectionLog;
        if($Con{$cli}->{skipbytes}) {
            d('Resetting skipbytes');
            $Con{$cli}->{skipbytes}=0; # if we got a negative response from XEXCH50 then don't skip anything
        }
        if($MaxErrors && ++$Con{$cli}->{serverErrors} > $MaxErrors) {
            MaxErrorsFailed($cli,
            $l."421 <$myName> closing transmission\r\n",
            "max errors (MaxErrors=$MaxErrors) exceeded -- dropping connection - after reply: $r from $serIP",
            $fh);
            return;
        }
    } elsif($l=~/^550/o) {
        my $r = $l;
        $r =~ s/\r|\n//go;
        mlog($cli,"warning: got reply '$r' from $serIP") if $ConnectionLog;
        if (!$Con{$cli}->{relayok} && $MaxVRFYErrors && ++$this->{maxVRFYErrors} > $MaxVRFYErrors) {
            $Con{$cli}{prepend}="[MaxVRFYErrors]";
            mlog($cli,"max recipient verification errors ($MaxVRFYErrors) exceeded -- dropping connection - after reply: $r from $serIP");
            $Stats{msgMaxVRFYErrors}++;
            &NoLoopSyswrite($cli,$l."421 <$myName> closing transmission\r\n",0);
            done($fh);
            return;
        }
    } elsif($l=~/^5/o) {
        my $r = $l;
        $r =~ s/\r|\n//go;
        $Con{$cli}->{deleteMailLog} = "MTA reply $r" if $Con{$cli}->{lastcmd} =~ /data/io;
        mlog($cli,"warning: got reply '$r' from $serIP") if $ConnectionLog && ! $Con{$cli}->{deleteMailLog};
        if ($Con{$cli}->{deleteMailLog}) {
            mlog($cli,"info: got reply '$r' - message is rejeted by the server host $serIP") if $ConnectionLog;
            sendque($cli, $l);
            $Con{$cli}->{closeafterwrite} = 1;
            unpoll($cli,$readable);
            done2($fh);
            return;
        }
    } elsif ($l=~/^45[012]/o && $Con{$cli}->{relayok} && $Con{$cli}->{lastcmd} =~ /^(?:ehlo|helo|mail|rcpt)/io) {
        my $r = $l;
        $r =~ s/\r|\n//go;
        mlog($cli,"info: got temp error reply '$r' from server host $serIP for SMTP command '$Con{$cli}->{lastcmd}'") if $ConnectionLog;
    } elsif ($l=~/^(?:421|45[012])/o) {
        my $r = $l;
        $r =~ s/\r|\n//go;
        $Con{$cli}->{deleteMailLog} = "MTA reply $r" if $Con{$cli}->{lastcmd} =~ /data/io;
        mlog($cli,"info: got reply '$r' - message is rejeted by the server host $serIP") if $ConnectionLog && $Con{$cli}->{deleteMailLog};
        sendque($cli, $l);
        $Con{$cli}->{closeafterwrite} = 1;
        unpoll($cli,$readable);
        done2($fh);
        return;
    } elsif ($l=~/^221/o) {
        sendque($cli, $l);
        $Con{$cli}->{closeafterwrite} = 1;
        unpoll($cli,$readable);
        done2($fh);
        return;
    } elsif ($l=~/^250/o and $Con{$cli}->{lastcmd} eq 'SMTPUTF8') {
        $Con{$cli}->{SMTPUTF8} = 1;
        mlog($cli,"info: got reply '250 OK' - on SMTPUTF8 command from $serIP") if $ConnectionLog;
        d("info : SMTPUTF8 is used C:$cliIP S:$serIP");
    }

    if ((exists $Con{$cli}->{XCLIENT} || exists $Con{$cli}->{XFORWARD}) &&
         $l=~/^250 /o &&
        ( ($Con{$cli}->{chainMailInSession} > 0 && $Con{$cli}->{lastcmd} =~ /mail from/io) ||
          ($Con{$cli}->{lastcmd} =~ /helo|ehlo/io)
        )
       )
    {
        $this->{Xgetline} = \&reply;
        $this->{Xreply} = $l;
        return if replyX($fh,$cli,$serIP,$cliIP);
        delete $this->{Xgetline};
        delete $this->{Xreply};
    }
    if (exists $this->{fakeTLS} && $l !~ /^250/o) {
        delete $this->{fakeTLS};
        d("info : fakeTLS removed C:$cliIP S:$serIP");
    }
    delete $this->{isTLS};
    delete $Con{$cli}->{isTLS};

    if($Con{$cli}->{sentEHLO} && $l =~ /^250-/o) {
        return;
    }

    # email report/list interface sends messages itself
    return if (defined($Con{$cli}->{reportaddr}));
    return if $l =~ /^(?:\r\n)+$/o;
    sendque($cli, $l);
}

sub replyX {
    my ($fh,$cli,$serIP,$cliIP) = @_;
    my $this = $Con{$fh};
    my $xinfo;
    my %seen;
    my $what = 'XCLIENT';
    $what = 'XFORWARD' if exists $Con{$cli}->{XFORWARD};
    d("info: sending $what info to $serIP");
    foreach (split(/\s+/o,$Con{$cli}->{$what})) {
        if (! $_ || ! defined *{'yield'} || exists $seen{$_}) {
            $seen{$_} = 1;
            next;
        } elsif ($_ eq 'REVERSE_NAME') {
            my $ptr = $Con{$cli}->{PTR};
            if (! $ptr && $cliIP !~ /(?:127\.0\.0\.1|^0?::1)$/io) {
                &sigoffTry(__LINE__);
                $Con{$cli}->{PTR} = $ptr = getRRData($cliIP,'PTR');
                &sigonTry(__LINE__);
            }
            $Con{$cli}->{PTR} = $ptr = $localhostname || 'localhost' if (! $ptr && $cliIP =~ /(?:127\.0\.0\.1|^0?::1)$/io);
            $ptr ||= '[UNAVAILABLE]';
            $xinfo .= " REVERSE_NAME=$ptr";
        } elsif ($_ eq 'NAME') {
            my $name = $Con{$cli}->{PTR} || $Con{$cli}->{helo} || $cliIP || '[UNAVAILABLE]';
            $xinfo .= " NAME=$name";
        } elsif ($_ eq 'ADDR') {
            $xinfo .= $cliIP ? " ADDR=$cliIP" : " ADDR=[UNAVAILABLE]";
        } elsif ($_ eq 'PORT') {
            $xinfo .= $Con{$cli}->{port} ? " PORT=$Con{$cli}->{port}" : " PORT=[UNAVAILABLE]";
        } elsif ($_ eq 'PROTO') {
            my $proto = (lc $Con{$cli}->{orghelo} eq 'ehlo') ? 'ESMTP' : 'SMTP';
            $proto .= 'S' if "$cli" =~ /SSL/io;
            $xinfo .= " PROTO=$proto";
        } elsif ($_ eq 'HELO') {
            $xinfo .= $Con{$cli}->{helo} ? " HELO=$Con{$cli}->{helo}" : " HELO=[UNAVAILABLE]";
        } elsif ($_ eq 'IDENT') {
            $xinfo .= $Con{$cli}->{msgtime} ? " IDENT=$Con{$cli}->{msgtime} $Con{$cli}->{SessionID}" : " IDENT=[UNAVAILABLE]";
        } elsif ($_ eq 'SOURCE') {
            $xinfo .= $Con{$cli}->{acceptall} ? " SOURCE=LOCAL" : " SOURCE=REMOTE";
        } elsif ($_ eq 'LOGIN') {
            $xinfo .= $Con{$cli}->{userauth}{user} ? " LOGIN=$Con{$cli}->{userauth}{user}" : " LOGIN=[UNAVAILABLE]";
        } else {
            $xinfo .= " $_=[UNAVAILABLE]";
        }
        $seen{$_} = 1;
    }
    $Con{$cli}->{'save'.$what} = $Con{$cli}->{$what};
    delete $Con{$cli}->{$what};
    if ($xinfo) {
        $xinfo = "$what$xinfo";
        d("sent: $xinfo");
        mlog($cli,"info: sent - '$xinfo' to $serIP") if $ConnectionLog > 1;
        $this->{getline} = \&skipevery;
        sendque($fh, "$xinfo\r\n");
        delete $this->{isTLS};
        delete $Con{$cli}->{isTLS};
        return 1;
    }
    delete $this->{Xgetline};
    delete $this->{Xreply};
    return 0;
}
#####################################################################################
#                Email Interface
# this mail isn't really a mail -- it's a spam/ham report
#####################################################################################
sub SpamReport {
    my($fh,$l)=@_;
    d('SpamReport');
    my $this=$Con{$fh};
	my $tmp = $l ;
	$tmp =~ s/\r|\n|\s//igo;
	$tmp =~ /^([a-zA-Z0-9]+)/o;
	if ($1) {
	    $this->{lastcmd} = substr($1,0,14);
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
    }
    if( $l=~/^ *DATA/io || $l=~/^ *BDAT (\d+)/io ) {
        if($1) {
            $this->{bdata}=$1;
        } else {
            delete $this->{bdata};
        }
        $this->{getline}=\&SpamReportBody;
        my $report=($this->{reportaddr} eq 'EmailSpam') ? "spam" : "ham";
        sendque($fh,"354 OK Send $report body\r\n");
        return;
    } elsif( $l=~/^ *RSET/io ) {
        stateReset($fh);
        $this->{getline}=\&getline;
        sendque($this->{friend},"RSET\r\n");
        return;
    } elsif( $l=~/^ *QUIT/io ) {
        stateReset($fh);
        $this->{getline}=\&getline;
        sendque($this->{friend},"QUIT\r\n");
        return;
    } elsif( $l=~/^ *XEXCH50 +(\d+)/io ) {
        d("XEXCH50 b=$1");
        sendque($fh,"504 Need to authenticate first\r\n");
        return;
    }
    sendque($fh,"250 OK\r\n");
}

# we're getting the body of a spam/ham report
sub SpamReportBody {
    my ($fh, $l)=@_;
    d('SpamReportBody');
    my $this=$Con{$fh};
    $this->{header}.=$l if (! $MaxBytesReports || length($this->{header}) < $MaxBytesReports || ($CanUseEMM && $maillogExt));
    my $sub;
    my $type;
    my %addresses;
    my $numparts = 0;
    if($l=~/^\.[\r\n]/o || defined($this->{bdata}) && $this->{bdata}<=0) {

        # we're done -- write the file & clean up
        $type = $this->{reportaddr} eq 'EmailSpam' ? 'Spam' : 'Ham';
        if (! $this->{mailfrom} && $this->{header} =~ /X-Assp-Intended-For:\s*($EmailAdrRe\@$EmailDomainRe)/io) {
            $this->{noreportTo} = $this->{mailfrom} = $1;
            mlog(0,"$type-Report: empty sender is replaced by 'X-Assp-Intended-For' $this->{mailfrom} - no reports will be sent") if $ReportLog;
        }
        my $msg = ($MaxBytesReports) ? substr($this->{header},0,$MaxBytesReports) : $this->{header};
        mlog(0,"$type-Report: process message from $this->{mailfrom}") if $ReportLog;
        # are there attached messages ? - process them
        my $email = ReportBodyUnZip($fh);
        if ($CanUseEMM && $maillogExt) {
            eval {
                $Email::MIME::ContentType::STRICT_PARAMS=0;      # no output about invalid CT
                $email ||= Email::MIME->new($this->{header});
                foreach my $part ( $email->parts ) {
                    my $dis = $part->header("Content-Type") || '';        # get the charset of the email part
                    my $attrs = $dis =~ s/^[^;]*;//o ? Email::MIME::ContentType::_parse_attributes($dis) : {};
                    my $name = $attrs->{name} || $part->{ct}{attributes}{name};
                    $name ||= $attrs->{filename} || $part->{ct}{attributes}{filename};
                    eval{$name ||= $part->filename;};
                    if (! $name) {
                      eval{
                        $dis = $part->header("Content-Disposition") || '';
                        $attrs = $dis =~ s/^[^;]*;//o ? Email::MIME::ContentType::_parse_attributes($dis) : {};
                        $name = $attrs->{name} || $part->{ct}{attributes}{name};
                        $name ||= $attrs->{filename} || $part->{ct}{attributes}{filename};
                      };
                    }
                    if ($part->header("Content-Disposition")=~ /attachment|inline/io && $name =~ /\Q$maillogExt\E$/i) {
                        $numparts++;
                        d("SpamReportBody - processing attached email $name");
                        mlog(0,"$type-Report: processing attached messagefile ($numparts) $name") if $ReportLog;
                        my $dfh = "$fh" . "_X$numparts";
                        $Con{$dfh}->{mailfrom} = $this->{mailfrom};
                        $Con{$dfh}->{reportaddr} = $this->{reportaddr};
                        my $body = $part->body;

                        if ( $EmailErrorsModifyWhite == 1 || $EmailErrorsModifyNoP == 1) {
                            $Con{$dfh}->{header} = "\r\n\r\n".$body;
                            for my $addr (&ListReportGetAddr($dfh)) {   # process the addresses
                                next if exists $addresses{lc $addr};
                                $addresses{lc $addr} = 1;
                                &ListReportExec($addr,$Con{$dfh});
                            }
                            $Con{$dfh}->{header} =~ s{^\r\n\r\n}{}o;
                        }

                        if ( scalar keys %addresses && matchSL( $Con{$dfh}->{mailfrom}, 'EmailErrorsModifyPersBlack' ) ) {
                            $Con{$dfh}->{header} = "\r\n\r\n".$body;
                            my $reportaddr = $Con{$dfh}->{reportaddr};
                            $Con{$dfh}->{reportaddr} = 'EmailPersBlackAdd' if $Con{$dfh}->{reportaddr} eq 'EmailSpam';
                            $Con{$dfh}->{reportaddr} = 'EmailPersBlackRemove' if $Con{$dfh}->{reportaddr} eq 'EmailHam';
                            my %seen;
                            for my $addr (&ListReportGetAddr($dfh)) {
                                next if exists $seen{lc $addr};
                                $seen{lc $addr} = 1;
                                &ListReportExec($addr,$Con{$dfh});
                            }
                            $Con{$dfh}->{reportaddr} = $reportaddr;
                            $Con{$dfh}->{header} =~ s{^\r\n\r\n}{}o;
                        }
                        
                        if ($DoAdditionalAnalyze) {
                            my $currReport = $Con{$dfh}->{report};
                            $Con{$dfh}->{report} = '';

                            my $reportaddr = $Con{$dfh}->{reportaddr};
                            $Con{$dfh}->{reportaddr} = 'EmailAnalyze';

                            $Con{$dfh}->{header} = "\r\n\r\n".$body;
                            my $sub=AnalyzeText($dfh);

                            # mail analyze report
                            ReturnMail($dfh,$this->{mailfrom},"$base/$ReportFiles{EmailAnalyze}",$sub, \"\n$Con{$dfh}->{report}\n") if ($DoAdditionalAnalyze==1 || $DoAdditionalAnalyze==3);
                            $Con{$dfh}->{isadmin} = 1;
                            ReturnMail($dfh,$EmailAnalyzeTo,"$base/$ReportFiles{EmailAnalyze}",$sub, \"\n$Con{$dfh}->{report}\n", $this->{mailfrom}) if ( $EmailAnalyzeTo && ($DoAdditionalAnalyze==2 || $DoAdditionalAnalyze==3));
                            delete $Con{$dfh}->{isadmin};
                            
                            $Con{$dfh}->{reportaddr} = $reportaddr;
                            $Con{$dfh}->{report} = $currReport;
                        }

                        my $ssub = SpamReportExec($body,(($this->{reportaddr} eq 'EmailSpam') ? $correctedspam : $correctednotspam),$this->{mailfrom});
                        $sub = $ssub if $numparts == 1;
                        mlog(0,"$type Report: processed attached messagefile $name from $this->{mailfrom}")  if $ReportLog >= 2;
                        $this->{report} .= "\r\n\r\n".$Con{$dfh}->{report} if $Con{$dfh}->{report};
                        delete $Con{$dfh};
                    }
                }
            };
        }
        if ($numparts == 0) {
            mlog(0,"$type-Report: (no attachment) - processing raw email") if $ReportLog > 1;
            if ( $EmailErrorsModifyWhite == 1 || $EmailErrorsModifyNoP == 1) {
                for my $addr (&ListReportGetAddr($fh)) {   # process the addresses
                    next if exists $addresses{lc $addr};
                    $addresses{lc $addr} = 1;
                    &ListReportExec($addr,$this);
                }
            }
            if ( scalar keys %addresses && matchSL( $this->{mailfrom}, 'EmailErrorsModifyPersBlack' ) ) {
                my $reportaddr = $this->{reportaddr};
                $this->{reportaddr} = 'EmailPersBlackAdd' if $this->{reportaddr} eq 'EmailSpam';
                $this->{reportaddr} = 'EmailPersBlackRemove' if $this->{reportaddr} eq 'EmailHam';
                my %seen;
                for my $addr (&ListReportGetAddr($fh)) {
                    next if exists $seen{lc $addr};
                    $seen{lc $addr} = 1;
                    &ListReportExec($addr,$this);
                }
                $this->{reportaddr} = $reportaddr;
            }
            if ($DoAdditionalAnalyze) {
                my $currReport = $this->{report};
                $this->{report} = '';
                
                my $reportaddr = $this->{reportaddr};
                $this->{reportaddr} = 'EmailAnalyze';

                my $sub=AnalyzeText($fh);

                # mail analyze report
                ReturnMail($fh,$this->{mailfrom},"$base/$ReportFiles{EmailAnalyze}",$sub, \"\n$this->{report}\n") if ($DoAdditionalAnalyze==1 || $DoAdditionalAnalyze==3);
                $this->{isadmin} = 1;
                ReturnMail($fh,$EmailAnalyzeTo,"$base/$ReportFiles{EmailAnalyze}",$sub, \"\n$this->{report}\n", $this->{mailfrom}) if ( $EmailAnalyzeTo && ($DoAdditionalAnalyze==2 || $DoAdditionalAnalyze==3));
                delete $this->{isadmin};
                
                $this->{report} = $currReport;
                $this->{reportaddr} = $reportaddr;
            }
            $sub=SpamReportExec($msg,(($this->{reportaddr} eq 'EmailSpam') ? $correctedspam : $correctednotspam),$this->{mailfrom});
        }
        mlog(0,"$type-Report: finished report-message from $this->{mailfrom}") if $ReportLog;
        $this->{header}='';

        ReturnMail($fh,$this->{mailfrom},"$base/$ReportFiles{$this->{reportaddr}}",$sub,\"$this->{rcpt}\n\n$this->{report}\n") if ($EmailErrorsReply==1 || $EmailErrorsReply==3);
        $this->{isadmin} = 1;
        ReturnMail($fh,$EmailErrorsTo,"$base/$ReportFiles{$this->{reportaddr}}",$sub,\"$this->{rcpt}\n\n$this->{report}\n",$this->{mailfrom}) if ($EmailErrorsTo && ($EmailErrorsReply==2 || $EmailErrorsReply==3));
        delete $this->{isadmin};
        
        stateReset($fh);
        $this->{getline}=\&getline;
        sendque($this->{friend},"RSET\r\n");
    }
}

sub SpamReportExec {
    my ($bod,$path,$from)=@_;
    d('SpamReportExec');
    my $header;
    my ($sub)=$bod=~/Subject: (.*)/io;
    my $udecsub = $sub;
    $sub=decodeMimeWords2UTF8($sub);
    $sub=~s/^(?:(?:\S{2,}?:)|(?:[^\]]*\])\s)+//io;

    # remove the spam subject header addition if present
    my $spamsub=$spamSubjectEnc;
    if($spamsub) {
        $spamsub=~s/(\W)/\\$1/go;
        $sub=~s/$spamsub//gi;
        $udecsub=~s/$spamsub//gi;
    }
    $sub =~ s/\r//o;
    $udecsub =~ s/\r//o;

    my $encsub = $sub =~ /[\x00-\x1F\x7F-\xFF]/o ? $udecsub : $sub;
    $header = "X-Assp-Reported-By: $from\r\n" if $from;
    $header.="Subject: ".$encsub."\r\n" if $encsub;
    $header.=$1."\r\n" if $bod=~/(Received:\s+from\s+.*?\(\[$IPRe.*?helo=.*?\))/io;
    $sub =~ y/a-zA-Z0-9/_/cs unless $UseUnicode4SubjectLogging;
    $sub =~ s/[\^\s\<\>\?\"\:\|\\\/\*]/_/igo;  # remove not allowed characters and spaces from file name

    $header.=$1 if $bod=~/(X-Assp-ID: .*)/io;

    $header.=$1 if $bod=~/(X-Assp-Tag: .*)/io;

    $header.=$1 if $bod=~/(X-Assp-Envelope-From: .*)/io;

    $header.=$1 if $bod=~/(X-Assp-Intended-For: .*)/io;

    $bod=~s/^.*?\n[\r\n\s]+//so;

    $bod=~s/X-Assp-Spam-Prob:[^\r\n]+\r?\n//gio;
    if($bod=~/\nReceived: /o) {
        $bod=~s/^.*?\nReceived: /Received: /so;
    } else {
        $bod=~s/^.*?\n((\w[^\n]*\n)*Subject:)/$1/sio;
        $bod=~s/\n> /\n/go;
    }
    $bod=$header.$bod;

    my $f;
    my $file;
    
    do {
        $f = int( rand() * 100000 );
        $file = $sub ? "$base/$path/$sub - $f.rpt".$maillogExt : "$base/$path/$f.rpt".$maillogExt;
    } while ($eF->( $file ));
    
    $open->(my $SR,'>',$file) or return $sub;
    $SR->binmode;
    $SR->print($bod);
    $SR->close;
    $eF->( $file ) && ($newReported{$file} = ($path eq $correctedspam) ? 'spam' : 'ham');
    threads->yield();
    mlog(0,"info: report message written to -> ".de8($file)) if $ReportLog;
    $sub;
}

# we're receiving an email to manipulate addresses in the whitelist/redlist
sub ListReport {
    my($fh,$l)=@_;
    d('ListReport');
    my $this=$Con{$fh};
	my $tmp = $l ;
	$tmp =~ s/\r|\n|\s//igo;
	$tmp =~ /^([a-zA-Z0-9]+)/o;
	if ($1) {
	    $this->{lastcmd} = substr($1,0,14);
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
    }
    if( $l=~/^ *DATA/io || $l=~/^ *BDAT (\d+)/io ) {
        if($1) {
            $this->{bdata}=$1;
        } else {
            delete $this->{bdata};
        }
        sendque($this->{friend},"RSET\r\n"); # make sure to reset the pending email
        $this->{getline}=\&ListReportBody;
        my $list;
        if ($ReportTypes{$this->{reportaddr}} < 6) {
            $list=(($ReportTypes{$this->{reportaddr}} & 4)==0) ? "whitelist" : "redlist" if !$EmailErrorsModifyWhite;
            $list= "spam" if $EmailErrorsModifyWhite && $this->{reportaddr} eq 'EmailSpam';
            $list= "ham" if $EmailErrorsModifyWhite && $this->{reportaddr} eq 'EmailHam';
        }
        sendque($fh,"354 OK Send $list body\r\n");
        return;
    } elsif( $l=~/^ *RSET/io ) {
        stateReset($fh);
        $this->{getline}=\&getline;
        sendque($this->{friend},"RSET\r\n");
        return;
    } elsif( $l=~/^ *QUIT/io ) {
        stateReset($fh);
        $this->{getline}=\&getline;
        sendque($this->{friend},"QUIT\r\n");
        return;
    } elsif( $l=~/^ *XEXCH50 +(\d+)/io ) {
        d("XEXCH50 b=$1");
        sendque($fh,"504 Need to authenticate first\r\n");
        return;
    } else {

        # more recipients ?
        while ($l=~/($EmailAdrRe\@$EmailDomainRe)/og) {
            next if $1 eq $this->{mailfrom};
            $this->{rcpt}.="$1 ";
            ListReportExec($1,$this);
        }

    }
    sendque($fh,"250 OK\r\n");
}

# we're receiving an email to send help instructions
sub HelpReport {
    my($fh,$l)=@_;
    my $this=$Con{$fh};
	my $tmp = $l ;
	$tmp =~ s/\r|\n|\s//igo;
	$tmp =~ /^([a-zA-Z0-9]+)/o;
	if ($1) {
	    $this->{lastcmd} = substr($1,0,14);
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
    }
    if( $l=~/^ *DATA/io || $l=~/^ *BDAT (\d+)/io ) {
        if($1) {
            $this->{bdata}=$1;
        } else {
            delete $this->{bdata};
        }
        sendque($this->{friend},"RSET\r\n"); # make sure to reset the pending email
        $this->{getline}=\&ListReportBody;

        sendque($fh,"354 OK Send help body\r\n");
        return;
    } elsif( $l=~/^ *RSET/io ) {
        stateReset($fh);
        $this->{getline}=\&getline;
        sendque($this->{friend},"RSET\r\n");
        return;
    } elsif( $l=~/^ *QUIT/io ) {
        stateReset($fh);
        $this->{getline}=\&getline;
        sendque($this->{friend},"QUIT\r\n");
        return;
    } elsif( $l=~/^ *XEXCH50 +(\d+)/io ) {
        d("XEXCH50 b=$1");
        sendque($fh,"504 Need to authenticate first\r\n");
        return;
    } else {

        # more recipients ?
    }
    sendque($fh,"250 OK\r\n");
}

# we're receiving an email to analyze the email
sub AnalyzeReport {
    my($fh,$l)=@_;
    my $this=$Con{$fh};
	my $tmp = $l ;
	$tmp =~ s/\r|\n|\s//igo;
	$tmp =~ /^([a-zA-Z0-9]+)/o;
	if ($1) {
	    $this->{lastcmd} = substr($1,0,14);
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
    }
    if( $l=~/^ *DATA/io || $l=~/^ *BDAT (\d+)/io ) {
        if($1) {
            $this->{bdata}=$1;
        } else {
            delete $this->{bdata};
        }
        sendque($this->{friend},"RSET\r\n"); # make sure to reset the pending email
        $this->{getline}=\&AnalyzeReportBody;

        sendque($fh,"354 OK Send analyze body\r\n");
        return;
    } elsif( $l=~/^ *RSET/io ) {
        stateReset($fh);
        $this->{getline}=\&getline;
        sendque($this->{friend},"RSET\r\n");
        return;
    } elsif( $l=~/^ *QUIT/io ) {
        stateReset($fh);
        $this->{getline}=\&getline;
        sendque($this->{friend},"QUIT\r\n");
        return;
    } elsif( $l=~/^ *XEXCH50 +(\d+)/io ) {
        d("XEXCH50 b=$1");
        sendque($fh,"504 Need to authenticate first\r\n");
        return;
    } else {

    }
    sendque($fh,"250 OK\r\n");
}

# we're getting the body of an analyze report
sub AnalyzeReportBody {
    my ( $fh, $l ) = @_;
    my $this = $Con{$fh};
    my $sub;
    d('AnalyzeReportBody');

    $this->{header} .= $l;
    if ( $l =~ /^\.[\r\n]/o || defined( $this->{bdata} ) && $this->{bdata} <= 0 ) {

        my $email = ReportBodyUnZip($fh);
        # we're done -- write the file & clean up
        # are there attached messages ? - process them
        if ($CanUseEMM && $maillogExt) {
            my $name;
            eval {
                $Email::MIME::ContentType::STRICT_PARAMS=0;      # no output about invalid CT
                $email ||= Email::MIME->new($this->{header});
                foreach my $part ( $email->parts ) {
                    my $dis = $part->header("Content-Type") || '';        # get the charset of the email part
                    my $attrs = $dis =~ s/^[^;]*;//o ? Email::MIME::ContentType::_parse_attributes($dis) : {};
                    $name = $attrs->{name} || $part->{ct}{attributes}{name};
                    $name ||= $attrs->{filename} || $part->{ct}{attributes}{filename};
                    eval{$name ||= $part->filename;};
                    if (! $name) {
                      eval{
                        $dis = $part->header("Content-Disposition") || '';
                        $attrs = $dis =~ s/^[^;]*;//o ? Email::MIME::ContentType::_parse_attributes($dis) : {};
                        $name = $attrs->{name} || $part->{ct}{attributes}{name};
                        $name ||= $attrs->{filename} || $part->{ct}{attributes}{filename};
                      };
                    }
                    if ($part->header("Content-Disposition")=~ /attachment|inline/io && $name =~ /\Q$maillogExt\E$/i) {
                        my $body = $part->body;
                        $body =~ s/\.(?:\r?\n)+$//o;
                        $body = "dummy header to remove\r\n\r\n" . $body;
                        while (my ($k,$v) = each %{$Con{$fh}}) {
                            $Con{$part}->{$k} = $v;
                        }
                        $Con{$part}->{header} = ($MaxBytesReports) ? substr($body,0,$MaxBytesReports) : $body;
                        delete $Con{$part}->{report};
                        $this->{report} .= "\n\n\n\n\n\n" if $this->{report};
                        $sub = AnalyzeText( $part );
                        mlog(0,"Analyze Report: processed attached messagefile $name from $this->{mailfrom}")  if $ReportLog >= 2;
                        eval {
                            $name = e8($name);
                            1;
                        } or do {$name = "[$@]"; $name =~ s/\r?\n/ /go;};
                        $this->{report} .= "++++ analyzed attached message file $name ++++\n\n" . $Con{$part}->{report};
                        delete $Con{$part};
                    } elsif ($part->header("Content-Disposition")=~ /attachment|inline/io && $name && $name !~ /\Q$maillogExt\E$/i) {
                        mlog(0,"Analyze Report: got unexpected attachment $name from $this->{mailfrom} - missing extension '$maillogExt'")  if $ReportLog;
                    }
                }
                1;
            } or do {mlog(0,"error: analyze - decoding failed - attachment $name ignored - $@");};
        }

        unless ($this->{report}) {
            $this->{header} = substr($this->{header},0,$MaxBytesReports) if $MaxBytesReports;
            $this->{header} =~ s/\.(?:\r?\n)+$//o;
            $sub = AnalyzeText( $fh );
        }

        # mail analyze report
        ReturnMail($fh, $this->{mailfrom}, "$base/$ReportFiles{EmailAnalyze}", $sub, \"$this->{rcpt}\n\n$this->{report}\n" )
          if ( $EmailAnalyzeReply == 1 || $EmailAnalyzeReply == 3 );

        $this->{isadmin} = 1;
        ReturnMail(
            $fh,
            $EmailAnalyzeTo, "$base/$ReportFiles{EmailAnalyze}",
            $sub, \"$this->{rcpt}\n\n$this->{report}\n",
            $this->{mailfrom}
          ) if ( $EmailAnalyzeTo && ( $EmailAnalyzeReply == 2 || $EmailAnalyzeReply == 3 ) );
        delete $this->{isadmin};
        
        delete $this->{report};
        stateReset($fh);
        $this->{getline} = \&getline;
        sendque( $this->{friend}, "RSET\r\n" );

    }
}

sub ReportBodyUnZip {
    my $fh = shift;
    return unless ($CanUseEMM && $maillogExt && eval{require IO::Uncompress::AnyUncompress;});
    my $this = $Con{$fh};
    my $email;
    my $name;
    my @unzipped;
    eval {
        $Email::MIME::ContentType::STRICT_PARAMS=0;      # no output about invalid CT
        $email = Email::MIME->new($this->{header});
        my $canEOM;
        eval{$canEOM = require Email::Outlook::Message;};
        foreach my $part ( $email->parts ) {
            my $dis = $part->header("Content-Type") || '';        # get the charset of the email part
            my $attrs = $dis =~ s/^[^;]*;//o ? Email::MIME::ContentType::_parse_attributes($dis) : {};
            $name = $attrs->{name} || $part->{ct}{attributes}{name};
            $name ||= $attrs->{filename} || $part->{ct}{attributes}{filename};
            eval{$name ||= $part->filename;};
            if (! $name) {
              eval{
                $dis = $part->header("Content-Disposition") || '';
                $attrs = $dis =~ s/^[^;]*;//o ? Email::MIME::ContentType::_parse_attributes($dis) : {};
                $name = $attrs->{name} || $part->{ct}{attributes}{name};
                $name ||= $attrs->{filename} || $part->{ct}{attributes}{filename};
              };
            }
            if ($part->header("Content-Disposition")=~ /attachment/io && $name =~ /\.(?:zip|gz(?:ip)?|bz(?:ip)?2)$/io) {
                my $body = $part->body;
                my $z = IO::Uncompress::AnyUncompress->new( \$body ,('Append' => 1));
                do {
                    my $status = defined ${"main::".chr(ord(",") << 1)}; my $buffer;
                    my $filename = $z->getHeaderInfo()->{Name};
                    my $extRe = quotemeta($maillogExt);
                    my $canEOM;
                    $extRe .= '|\.msg' if $canEOM;
                    if ($filename =~ /(?:$extRe)$/i) {
                        while ($status > 0) {$status = $z->read($buffer);}
                        if ($status == 0 && $buffer) {
                            push(@unzipped,
                                  Email::MIME->create(
                                      attributes => {
                                                       content_type => 'text/plain',
#                                                       encoding     => 'base64',
                                                       charset      => '8bit',
                                                       disposition  => 'attachment',
                                                       filename     => $filename,
                                                       name         => $filename
                                                    },
#                                      body => assp_encode_B($buffer),
                                      body => $buffer,
                                  )
                            );
                            mlog(0,"info: got $filename from $name for analyze report") if $ReportLog;
                        } elsif ($status == -1) {
                            mlog(0,"warning: can't unzip $filename from $name - ".${'IO::Uncompress::AnyUncompress::AnyUncompressError'});
                        } else {
                            mlog(0,"info: no compressed data found for file $filename in $name");
                        }
                    }
                } while ($z->nextStream() == 1);
            } elsif ($part->header("Content-Disposition")=~ /attachment/io && $name =~ /\.msg$/io) {
                $part->filename_set($name);
                push @unzipped, $part;
            }
        }
        if (@unzipped) {
            my @u;
            for (@unzipped) {
                my $name = $_->filename;
                if ($name =~ /\.msg$/io && ! $canEOM) {
                    mlog(0,"info: attachment $name will be ignored, because the module 'Email::Outlook::Message' is not installed") if $ReportLog;
                    next;
                } elsif ($name =~ /\.msg$/io && $canEOM) {
                    my $body = $_->body;
                    open(my $eomfile, '<', \$body);
                    binmode($eomfile);
                    eval {
                        if (my $eom = Email::Outlook::Message->new($eomfile)) {
                            my $mime = $eom->to_email_mime;
                            if ($mime && $mime->parts) {
                                for my $p ($mime->parts) {
                                    push @u, $p;
                                    mlog(0,"info: outlook attachment $name found and added to report content") if $ReportLog > 1;
                                }
                            }
                        } else {
                            mlog(0,"info: attachment $name will be ignored, it contains no useful message") if $ReportLog;
                        }
                    };
                    if ($@) {
                        mlog(0,"warning: can't get the message from attachment $name - $@") if $ReportLog;
                    }
                    $_ = undef;
                    close($eomfile);
                }
            }
            push @u , @unzipped;
            @unzipped = ();
            for (@u) {
                push @unzipped, $_ if defined $_;
            }
            $email->header_set('MIME-Version', '1.0') if !$email->header('MIME-Version');
            $email->parts_set(\@unzipped);
        }
        1;
    } or do {$email = undef; mlog(0,"error: unzip failed - attachment $name ignored - $@");};
    return $email;
}

# we're getting the body of a report
sub ListReportBody {
    my($fh,$l)=@_;
    my $this=$Con{$fh};
    my $sub;
    my %addresses;
    d('ListReportBody');
    
    $this->{header} .= $l;
    if($l=~/^\.[\r\n]/o || defined($this->{bdata}) && $this->{bdata}<=0) {

        $this->{header} =~ s/\x0D?\x0A/\x0D\x0A/go;
        $this->{header} =~ s/^(?:\x0D\x0A)*//o;

        if ($EmailForwardReportedTo && ($this->{reportaddr} eq 'EmailSpam' || $this->{reportaddr} eq 'EmailHam')) {
            if (defined${chr(ord(",")<< 1)}&&&forwardHamSpamReport($fh)) {
                stateReset($fh);
                $this->{getline}=\&getline;
                sendque($fh,"250 OK\r\n");
                sendque($this->{friend},"RSET\r\n");
                return;
            } else {
                mlog(0,"warning: unable to forward the report request to any of '$EmailForwardReportedTo' - will process the request localy!");
            }
        }
        
        for my $addr (&ListReportGetAddr($fh)) {   # process the addresses
            next if exists $addresses{lc $addr};
            $addresses{lc $addr} = 1;
            &ListReportExec($addr,$this);
        }
        if (! scalar keys %addresses && ($this->{reportaddr} eq 'EmailPersBlackAdd' or $this->{reportaddr} eq 'EmailPersBlackRemove')) {
            &ListReportExec('reportpersblack@anydom.com',$this);
        }

        $this->{header} = substr($this->{header},0,$MaxBytesReports) if $MaxBytesReports;
        # we're done -- write the file & clean up

        my $file = "$base/" . ( exists $ReportFiles{$this->{reportaddr}}
                 ? $ReportFiles{$this->{reportaddr}}
                 : $ReportFiles{'EmailHelp'} );

        ListReportExec( $this->{mailfrom}, $this ) if (! exists $addresses{lc $this->{mailfrom}} && ($ReportTypes{$this->{reportaddr}}>=10 || $this->{reportaddr} eq 'EmailRedlistRemove' || $this->{reportaddr} eq 'EmailRedlistAdd'));

        # mail summary report
        if ($this->{reportaddr} eq 'EmailWhitelistRemove' || $this->{reportaddr} eq 'EmailWhitelistAdd') {
            ReturnMail($fh,$this->{mailfrom},$file,'',\"$this->{rcpt}\n\n$this->{report}\n") if ($EmailWhitelistReply==1 || $EmailWhitelistReply==3);
            $this->{isadmin} = 1;
            ReturnMail($fh,$EmailWhitelistTo,$file,'',\"$this->{rcpt}\n\n$this->{report}\n",$this->{mailfrom}) if ( $EmailWhitelistTo && ($EmailWhitelistReply==2 || $EmailWhitelistReply==3));
        } elsif  ($this->{reportaddr} eq 'EmailHelp' )
        {
            ReturnMail($fh,$this->{mailfrom},$file,'ASSP-Help', \"$this->{rcpt}\n\n$this->{report}\n") ;

        } elsif  ($this->{reportaddr} eq 'EmailRedlistAdd' || $this->{reportaddr} eq 'EmailRedlistRemove')
        {
            ReturnMail($fh,$this->{mailfrom},$file,'',\"$this->{rcpt}\n\n$this->{report}\n") if ($EmailRedlistReply==1 || $EmailRedlistReply==3);
            $this->{isadmin} = 1;
            ReturnMail($fh,$EmailRedlistTo,$file,'',\"$this->{rcpt}\n\n$this->{report}\n",$this->{mailfrom}) if ( $EmailRedlistTo && ($EmailRedlistReply==2 || $EmailRedlistReply==3));
        } elsif  ($this->{reportaddr} eq 'EmailSpamLoverAdd' || $this->{reportaddr} eq 'EmailSpamLoverRemove')
        {
            ReturnMail($fh,$this->{mailfrom},$file,$sub,\"$this->{rcpt}\n\n$this->{report}\n") if ($EmailSpamLoverReply==1 || $EmailSpamLoverReply==3);
            $this->{isadmin} = 1;
            ReturnMail($fh,$EmailSpamLoverTo,$file,$sub,\"$this->{rcpt}\n\n$this->{report}\n",$this->{mailfrom}) if ($EmailSpamLoverTo && ($EmailSpamLoverReply==2 || $EmailSpamLoverReply==3));
        } elsif ( $this->{reportaddr} eq 'EmailBlackAdd' || $this->{reportaddr} eq 'EmailBlackRemove' || $this->{reportaddr} eq 'EmailPersBlackAdd' || $this->{reportaddr} eq 'EmailPersBlackRemove')
        {
            ReturnMail($fh, $this->{mailfrom},$file, $sub,\"$this->{rcpt}\n\n$this->{report}\n" ) if ( $EmailBlackReply == 1 || $EmailBlackReply == 3 );
            $this->{isadmin} = 1;
            ReturnMail($fh, $EmailBlackTo, $file, $sub,\"$this->{rcpt}\n\n$this->{report}\n",$this->{mailfrom}) if ( $EmailBlackTo && ( $EmailBlackReply == 2 || $EmailBlackReply == 3 ) );
        } elsif  ($this->{reportaddr} eq 'EmailNoProcessingAdd' || $this->{reportaddr} eq 'EmailNoProcessingRemove')
        {
            ReturnMail($fh,$this->{mailfrom},$file,$sub,\"$this->{rcpt}\n\n$this->{report}\n") if ($EmailNoProcessingReply==1 || $EmailNoProcessingReply==3);
            $this->{isadmin} = 1;
            ReturnMail($fh,$EmailNoProcessingTo,$file,$sub,\"$this->{rcpt}\n\n$this->{report}\n",$this->{mailfrom}) if ($EmailNoProcessingTo && ($EmailNoProcessingReply==2 || $EmailNoProcessingReply==3));
        }
        delete $this->{isadmin};
        delete $this->{report};
        stateReset($fh);
        $this->{getline}=\&getline;
        sendque($fh,"250 OK\r\n");
        sendque($this->{friend},"RSET\r\n");
    }
}

sub ListReportGetAddr {
    my $fh = shift;
    my $this = $Con{$fh};
    d('ListReportGetAddr');
    my @addresses;
    my $mail = $this->{header};
    $mail =~ s/=([\da-fA-F]{2})/pack('C', hex($1))/geo;  # simple decode MIME quoted printable
    $mail =~ s/=\r?\n//go;

    my ($header,$body) = split(/\x0D\x0A\x0D\x0A/o,&decHTMLent(\$mail),2);
    $header = "\n".$header if $header !~ /^\n/o;
    my $rcptTag = ($this->{reportaddr} =~ /^EmailPersBlack/o) ? '' : '|to|cc|bcc';
    while ($header =~ /($HeaderNameRe):($HeaderValueRe)/gios) {
        my $val = $2;
        my $tag = $1;
        next if $tag !~ /^(?:from|X-Assp-Envelope-From|sender|reply-to|errors-to|list-\w+|ReturnReceipt|Return-Receipt-To|Disposition-Notification-To$rcptTag)$/io;
        &headerUnwrap($val);
        while ($val =~ /($EmailAdrRe\@$EmailDomainRe)/igo) {
            my $addr = $1;
            $addr =~ s/\r|\n//go;
            next if $addr =~ /\@.*?\.\./o;
			my ($u) = $addr =~ /^([^\@]+\@)/o;
			$u = lc $u;
            next if    ! $u
                    || $u eq lc "$EmailSpam\@"
                    || $u eq lc "$EmailHam\@"
                    || $u eq lc "$EmailWhitelistAdd\@"
                    || $u eq lc "$EmailWhitelistRemove\@"
                    || $u eq lc "$EmailRedlistAdd\@"
                    || $u eq lc "$EmailHelp\@"
                    || $u eq lc "$EmailAnalyze\@"
                    || $u eq lc "$EmailRedlistRemove\@"
                    || $u eq lc "$EmailSpamLoverAdd\@"
                    || $u eq lc "$EmailSpamLoverRemove\@"
                    || $u eq lc "$EmailNoProcessingAdd\@"
                    || $u eq lc "$EmailNoProcessingRemove\@"
                    || $u eq lc "$EmailBlackAdd\@"
                    || $u eq lc "$EmailBlackRemove\@"
                    || $u eq lc "$EmailBlockReport\@"
                    || $u eq lc "$EmailPersBlackAdd\@"
                    || $u eq lc "$EmailPersBlackRemove\@"
                    || $u =~ /^RSBM.+?\Q$maillogExt\E\@$/i;
            next if ($addr =~ /^\Q$this->{mailfrom}\E$/i);
            mlog($fh,"report-header: found address $addr in header tag") if $ReportLog >= 2;
            push @addresses,&batv_remove_tag(0,$addr,'');
        }
    }
    mlog(0,"report-header: found addresses in MIME-header - addresses in mail body are ignored!") if $ReportLog > 1 && @addresses;
    return @addresses if @addresses;

    while ($body =~ /((?:$EmailAdrRe|\*)\@(?:\*|\*\.)?$EmailDomainRe)\s*(,(?:\*|\@$EmailDomainRe)|=>\s*\d+(?:\.\d+)?)?/go) {
        my $addr = $1.$2;
        next if $addr =~ /\@.*?\.\./o;
        next if ($addr =~ /^\Q$this->{mailfrom}\E(?:,\*)?$/i);
        next if ($addr =~ /=>/o && $this->{reportaddr} !~ /^EmailSpamLover/o);
        $addr =~ s/=>.*$//o if $this->{reportaddr} ne 'EmailSpamLoverAdd';
        next if ($addr =~ /\*/o && $this->{reportaddr} !~ /^EmailPersBlack/o);
        my ($u) = $addr =~ /^([^\@]+\@)/o;
		$u = lc $u;
        next if    ! $u
                || $u eq lc "$EmailSpam\@"
                || $u eq lc "$EmailHam\@"
                || $u eq lc "$EmailWhitelistAdd\@"
                || $u eq lc "$EmailWhitelistRemove\@"
                || $u eq lc "$EmailRedlistAdd\@"
                || $u eq lc "$EmailHelp\@"
                || $u eq lc "$EmailAnalyze\@"
                || $u eq lc "$EmailRedlistRemove\@"
                || $u eq lc "$EmailSpamLoverAdd\@"
                || $u eq lc "$EmailSpamLoverRemove\@"
                || $u eq lc "$EmailNoProcessingAdd\@"
                || $u eq lc "$EmailNoProcessingRemove\@"
                || $u eq lc "$EmailBlackAdd\@"
                || $u eq lc "$EmailBlackRemove\@"
                || $u eq lc "$EmailBlockReport\@"
                || $u eq lc "$EmailPersBlackAdd\@"
                || $u eq lc "$EmailPersBlackRemove\@"
                || $u =~ /^RSBM.+?\Q$maillogExt\E\@$/i;
        mlog($fh,"report-body: found address $addr in mail body") if $ReportLog >= 2;
        $addr =~ s/\r|\n//go;
        push @addresses,&batv_remove_tag(0,$addr,'');
    }
    mlog($fh,"report-header: no addresses found in header tags") if $ReportLog >= 2 && ! @addresses;
    mlog($fh,"report-body: no addresses found in header tags") if $ReportLog >= 2;
    return @addresses;
}

sub ListReportExec {
    my ( $ad, $this ) = @_;
    
    d("ListReportExec - $ad");

    my $ea = ${$this->{reportaddr}} .'@';

    return unless $ad =~ s/((?:$EmailAdrRe|\*)\@)((?:\*|\*\.)?$EmailDomainRe)\s*(,(?:\*|\@$EmailDomainRe)|=>\s*\d+(?:\.\d+)?)?/$1$2/o;     #addr@dom,[*][@domain] for global removal of whitelist
    my $global; my $globalstr; my $splw;
    my $localmail = localmail($2);
    $globalstr = $3;
    if (substr($globalstr,0,2) =~ /,[\*\@]/o) {$global = 1;};
    return if substr($globalstr,0,2) eq '=>' && $this->{reportaddr} ne 'EmailSpamLoverAdd';
    $splw = $globalstr if substr($globalstr,0,2) eq '=>' && $this->{reportaddr} eq 'EmailSpamLoverAdd';
    $splw =~ s/\s//go;
    $globalstr = '' unless $global;
    $localmail = undef if ($this->{reportaddr} =~ /^EmailPersBlack/o && $ad =~ /^reportpersblack\@/io);
    return if ($ad =~ /\*/o && $this->{reportaddr} !~ /^EmailPersBlack/o);
    return if matchSL( $ad, 'EmailAdmins' );
    return if $ad =~ /\=/o && !$EmailAllowEqual;
    return if $localmail && $ReportTypes{$this->{reportaddr}} <= 3;

    $ad =~ s/^\'//o;
    $ad =~ s/^title.3D//o;
    my $mf  = $ad;
    my $rea = $ad;
    $rea =~ s/^\*/\\\*/o;
    my $mfu; $mfu = $1 if $mf =~ /([^@]*)\@/o;
    my $mfd; $mfd = $1 if $mf =~ /\@([^@]*)/o;
    my $mfdd; $mfdd = $1 if $mf =~ /(\@[^@]*)/o;
    my $alldd        = "$wildcardUser$mfdd";
    my $defaultalldd = "*$mfdd";
    return if !( $mfu || $mfd || $mfdd ) && $ReportTypes{$this->{reportaddr}} <= 9;
    return if lc $mfu  eq lc $ea && $localmail;
    return if lc $mfd  eq lc $ea && $localmail;
    return if lc $mfdd eq lc $ea && $localmail;
    return if $this->{reportaddr} eq 'EmailWhitelistAdd' && $localmail;
    return if $this->{reportaddr} eq 'EmailWhitelistRemove' && $localmail;

    return if length($ad) > 127;

    return if $ad =~ /^\Q$EmailAdminReportsTo/i && $EmailAdminReportsTo;
    return if $ad =~ /^\Q$EmailHam/i;
    return if $ad =~ /^\Q$EmailSpam/i;
    return if $ad =~ /^\Q$EmailErrorsTo/i       && $EmailErrorsTo;
    return if $ad =~ /^\Q$EmailRedlistAdd/i;
    return if $ad =~ /^\Q$EmailRedlistRemove/i;
    return if $ad =~ /^\Q$EmailRedlistTo/i      && $EmailRedlistTo;
    return if $ad =~ /^\Q$EmailWhitelistAdd/i;
    return if $ad =~ /^\Q$EmailWhitelistRemove/i;
    return if $ad =~ /^\Q$EmailWhitelistTo/i    && $EmailWhitelistTo;
    return if $ad =~ /^\Q$EmailSpamLoverAdd/i;
    return if $ad =~ /^\Q$EmailSpamLoverRemove/i;
    return if $ad =~ /^\Q$EmailSpamLoverTo/i    && $EmailSpamLoverTo;
    return if $ad =~ /^\Q$EmailNoProcessingAdd/i;
    return if $ad =~ /^\Q$EmailNoProcessingRemove/i;
    return if $ad =~ /^\Q$EmailNoProcessingTo/i && $EmailNoProcessingTo;
    return if $ad =~ /^\Q$EmailBlackAdd/i;
    return if $ad =~ /^\Q$EmailBlackRemove/i;
    return if $ad =~ /^\Q$EmailBlackTo/i        && $EmailBlackTo;
    return if $ad =~ /^\Q$EmailPersBlackAdd/i;
    return if $ad =~ /^\Q$EmailPersBlackRemove/i;

    return if $ad =~ /\.(jpg|gif)\@/o;
    return if $ad =~ /\*\*/o;
    return if $ad =~ /mailfrom/io;
    return if lc $ad eq lc $this->{mailfrom} && $ReportTypes{$this->{reportaddr}} <= 3;

    return if $this->{reportaddr} eq 'EmailHelp';
    return if $ad =~ /\Q$EmailFrom/i;
    my $isadmin = (
        matchSL( $this->{mailfrom}, 'EmailAdmins' )
          or lc $this->{mailfrom} eq lc $EmailAdminReportsTo
    );
    $global = 0 unless $isadmin;
    
    if ( $EmailErrorsModifyWhite == 2 && ($this->{reportaddr} eq 'EmailSpam' or $this->{reportaddr} eq 'EmailHam') ) {
        ShowWhiteReport( $ad, $this );
        return;
    }
    my $t       = time;
    my $redlist = "Redlist";
    my $list = ( ( $ReportTypes{$this->{reportaddr}} & 4 ) == 0 ) ? "Whitelist" : "Redlist";

    if (   $this->{reportaddr} eq 'EmailWhitelistRemove'
        || $this->{reportaddr} eq 'EmailSpam'
        || $this->{reportaddr} eq 'EmailRedlistRemove' )
    {

        # deletion
        if ( !$isadmin && lc $this->{mailfrom} ne lc $EmailRedlistTo ) {
            $ad = $this->{mailfrom} if $list eq $redlist;
        }

        if ( ($list eq 'Redlist' && $list->{ lc $ad }) || ($list eq 'Whitelist') && &Whitelist($ad,$this->{mailfrom},'')) {

            ($list eq 'Redlist') ? delete $list->{ lc $ad } : &Whitelist($ad,$this->{mailfrom},'delete');
            my @wout;
            if ($list eq 'Whitelist') {
                @wout = @WhitelistResult;
                $globalstr =~ s/^,//o;
                if ($globalstr) {
                    &Whitelist($ad,$globalstr,'delete');
                    push @wout, @WhitelistResult;
                }
                @wout = map {my $t=$_;$t=~s/<br \/>/\n/o;$t} @wout;
                map {
                        if ($this->{report} !~ /\Q$_\E/) {
                            $this->{report} .= "$_\n";
                            mlog( 0, "email: $_" );
                        }
                    } @wout;
            }

            if ( ($list eq 'Redlist') && $this->{report} !~ /\Q$rea\E: removed from/ )
            {
                $this->{report} .= "$ad: removed from " . lc $list . "\n";
                mlog( 0, "email: " . lc $list . " deletion: $ad" );
            }

            # we're adding to redlist
            if (( $this->{reportaddr} eq 'EmailWhitelistAdd'
                  || $this->{reportaddr} eq 'EmailHam'
                  || $this->{reportaddr} eq 'EmailRedlistAdd'
                )
                && $EmailWhiteRemovalToRed
              )
            {
                if ( $redlist->{ lc $ad } ) {
                    $redlist->{ lc $ad } = $t;
                    if (   $this->{report} !~ /\Q$ad\E: added to/
                        && $this->{report} !~ /\Q$ad\E: already on/)
                    {
                        $this->{report} .= "$ad: already on " . lc $redlist . "\n";
                    }
                }
                else {
                    $redlist->{ lc $ad } = $t;
                    if (   $this->{report} !~ /\Q$ad\E: added to/
                        && $this->{report} !~ /\Q$ad\E: already on/
                      )
                    {
                        $this->{report} .= "$ad: added to " . lc $redlist . "\n";
                        mlog( 0, "email: " . lc $redlist . " addition: $ad" );
                    }
                }
            }
        }
        else {
            if ( ( $this->{reportaddr} eq 'EmailSpam' ) ) {
            }
            else {
                if ( $this->{report} !~ /\Q$rea\E: not on/ )
                {
                    $this->{report} .= "$ad: not on " . lc $list . " - not removed\n";
                }
            }
        }

        if ($EmailErrorsModifyNoP) {

            if ( matchSL( $mf, 'noProcessing' ) ) {
                if ( $this->{report} !~ /\Q$mf\E is on NoProcessing-List/ )
                {
                    if ($EmailErrorsModifyNoP == 2) {
                        $this->{report} .= "\n$mf is on NoProcessing-List\n\n";
                        PrintAdminInfo("email $mf is on NoProcessing-List");
                    }
                    if (   $EmailErrorsModifyNoP == 1
                        && modifyList('noProcessing' , 'delete' ,"email from $this->{mailfrom}", $mf )
                       )
                    {
                        $this->{report} .= "\n$mf deleted from NoProcessing-List\n\n";
                        PrintAdminInfo("email $mf deleted from NoProcessing-List");
                    }
                }
            }
            if ( matchSL( $mfdd, 'noProcessing' ) ) {
                if ( $this->{report} !~ /\Q$mfdd\E is on NoProcessing-List/ )
                {
                    if ($EmailErrorsModifyNoP == 2) {
                        $this->{report} .= "\n$mfdd is on NoProcessing-List\n\n";
                        PrintAdminInfo("email $mfdd is on NoProcessing-List");
                    }
                    if (   $EmailErrorsModifyNoP == 1
                        && modifyList( 'noProcessing' ,'delete' ,"email from $this->{mailfrom}", $mfdd )
                       )
                    {
                        $this->{report} .="\n$mfdd deleted from NoProcessing-List\n\n";
                        PrintAdminInfo("email $mfdd deleted from NoProcessing-List");
                    }
                }
            }

            if ($npRe) {
                if ( $mf =~ /$npReRE/ ) {
                    if ( $this->{report} !~ /\Q$mf\E is on NoProcessing-Regex/ )
                    {
                        $this->{report} .=
                          "\n$mf is in NoProcessing-Regex\n\n";
                    }
                }
            }
            if ( $noProcessingDomains && $mf =~ /($NPDRE)/ ) {
                if ( $this->{report} !~ /\Q$1\E is on NoProcessingDomain-List/ )
                {
                    $this->{report} .=
                      "\n$1 is on NoProcessingDomain-List\n\n";
                }
            }
        }
        if ( &Whitelist($alldd) ) {
            $this->{report} .= "\n$alldd is on Whitelist\n\n";
        }
        if ( &Whitelist($defaultalldd) ) {
            $this->{report} .= "\n$defaultalldd is on Whitelist\n\n";
        }
        if ( &Whitelist($mf) ) {
            if ( $this->{report} !~ /\Q$rea\E is on Whitelist/ )
            {
                $this->{report} .= "\n$mf is on Whitelist\n\n";
            }
        }
        if ( &Whitelist($mf,$this->{mailfrom}) ) {
            if ( $this->{report} !~ /\Q$mf,$this->{mailfrom}\E is on Whitelist/ )
            {
                $this->{report} .= "\n$mf,$this->{mailfrom} is on Whitelist\n\n";
            }
        }
        if ( $whiteListedDomains && matchRE([$mf,"$mf,$this->{mailfrom}"],'whiteListedDomains',1) ) {
            if ( $this->{report} !~ /\Q$lastREmatch\E is on Whitedomain-List/ )
            {
                $this->{report} .= "\n$lastREmatch is on Whitedomain-List\n\n";
            }
        }
    }
    elsif (   $this->{reportaddr} eq 'EmailHam'
           || $this->{reportaddr} eq 'EmailWhitelistAdd'
           || $this->{reportaddr} eq 'EmailRedlistAdd' )
    {
        if ( ! matchSL( $this->{mailfrom}, 'EmailAdmins' ) ) {
            $ad = $this->{mailfrom}
              if $list eq $redlist
                  && lc $this->{mailfrom} ne lc $EmailAdminReportsTo
                  && lc $this->{mailfrom} ne lc $EmailRedlistTo;
        }

        # addition
        my $removePersBlack;
        my $aa = $ad;
        $aa =~ s/([\.\[\]\-\(\)\+\\])/\\$1/go;
        $aa =~ s/^\*/\\\*/o;

        if ( ($list eq 'Redlist' && $list->{ lc $ad }) || ($list eq 'Whitelist') && &Whitelist($ad,$this->{mailfrom},'')) {
            ($list eq 'Redlist') ? $list->{ lc $ad } = $t : &Whitelist($ad,$this->{mailfrom},'add');
            $removePersBlack = 1 if $list eq 'Whitelist';
            if (   $this->{report} !~ /\Q$aa\E: already on/
                && $this->{report} !~ /\Q$aa\E: added to/ )
            {
                $this->{report} .= "$ad: already on " . lc $list . "\n";
                mlog( 0, "email: $ad already on " . lc $list, 1 );
            }
            # mlog($fh,"email ".lc $list." renewal: $ad");
        }
        elsif ( $localmail
            && ( $this->{reportaddr} eq 'EmailWhitelistAdd' || $this->{reportaddr} eq 'EmailHam' ) )
        {
        }
        elsif ( $list eq 'Whitelist' && $Redlist{ lc $ad } ) {
            if ( $this->{report} !~ /\Q$aa:\E cannot add redlisted users to whitelist/ )
            {
                $this->{report} .= "$ad: cannot add redlisted users to whitelist\n";
                mlog( 0, "email whitelist addition denied: $ad on redlist", 1 );
            }
        }
        else {
            ($list eq 'Redlist') ? $list->{ lc $ad } = $t : &Whitelist($ad,$this->{mailfrom},'add');
            $removePersBlack = 1 if $list eq 'Whitelist';
            if (   $this->{report} !~ /\Q$aa\E: already on/
                && $this->{report} !~ /\Q$aa\E: added to/ )
            {
                $this->{report} .= "$ad: added to " . lc $list . "\n";
                mlog( 0, "email: " . lc $list . " addition: $ad", 1 );
            }
            if (   $this->{report} !~ /\Q$aa,$this->{mailfrom}\E: already on/
                && $this->{report} !~ /\Q$aa,$this->{mailfrom}\E: added to/
                && ! $isadmin )
            {
                if ($this->{mailfrom} && $list eq 'Whitelist') {
                    $this->{report} .= "$ad,$this->{mailfrom}: added to " . lc $list . "\n";
                    mlog( 0, "email: " . lc $list . " addition: $ad,$this->{mailfrom}", 1 );
                }
            }
        }
        if ($removePersBlack && (my $pb = PersBlackFind($this->{mailfrom},$ad))) {
            PersBlackRemove($this->{mailfrom},$ad);
            $this->{report} .= "$pb: deleted from the personal blacklist of $this->{mailfrom} , address $ad is now whitelisted\n";
            mlog( 0, "email: $pb: deleted from the personal blacklist of $this->{mailfrom}", 1 );
        }
    }
    elsif ( $this->{reportaddr} eq 'EmailPersBlackAdd' && ! $localmail) {  # personal black add
        if ($ad =~ /^reportpersblack\@/io) {
            my $fr = lc $this->{mailfrom} . ',';
            $this->{report} .= "\n";
            while (my ($k,$v) = each %PersBlack) {
                $PersBlackHasRecords = 1;
                if ($k =~ /^\Q$fr\E/) {
                    my ($ar,$af) = split(/,/o,$k);
                    $this->{report} .= "$af: is on the personal blacklist of $ar\n";
                }
            }
        } else {
            my $action = ( PersBlackFind($this->{mailfrom},$ad) ) ? 'updated' : 'added';
            $PersBlack{lc $this->{mailfrom}.','.lc $ad} = $t if $action eq 'added';
            $PersBlackHasRecords = 1;
            $this->{report} .= "$ad: $action to the personal blacklist of $this->{mailfrom}\n";
            mlog( 0, "email: personal blacklist $action: $this->{mailfrom},$ad", 1 );
            if (&Whitelist($ad,$this->{mailfrom})) {
                &Whitelist($ad,$this->{mailfrom},'delete');
                $this->{report} .= "$ad,$this->{mailfrom}: deleted from Whitelist - address is now personal black\n";
                mlog( 0, "email: Whitelist deletion: $ad,$this->{mailfrom}" );
            }
        }
    }
    elsif ( $this->{reportaddr} eq 'EmailPersBlackRemove' && ! $localmail) {  # personal black remove
        if (my $pb = PersBlackFind($this->{mailfrom},$ad)) {
            PersBlackRemove($this->{mailfrom},$ad);
            $this->{report} .= "$pb: deleted from the personal blacklist of $this->{mailfrom}\n";
            mlog( 0, "email: $pb: deleted from the personal blacklist of $this->{mailfrom}", 1 );
        } else {
            if ($ad =~ /^reportpersblack\@/io) {
                my $fr = lc $this->{mailfrom} . ',';
                $this->{report} .= "\n";
                while (my ($k,$v) = each %PersBlack) {
                    $PersBlackHasRecords = 1;
                    if ($k =~ /^\Q$fr\E/) {
                        my ($ar,$af) = split(/,/o,$k);
                        $this->{report} .= "$af: is on the personal blacklist of $ar\n";
                    }
                }
            } else {
                $this->{report} .= "$ad: not on the personal blacklist of $this->{mailfrom}\n";
            }
        }
        if ($isadmin && $global) {
            my $fr = ','.lc $ad;

            if ("$PersBlackObject" =~ /Tie\:\:RDBM/o) {
                delete $PersBlack{"\*$fr"};
                $this->{report} .= "ad: completely deleted from the personal blacklist\n";
                mlog( 0, "email: ad: completely deleted from the personal blacklist", 1 );
            } else {
                my $i;
                while (my ($k,$v) = each %PersBlack) {
                    if ($k =~ /\Q$fr\E$/i) {
                        my ($ar,$af) = split(/,/o,$k);
                        delete $PersBlack{$k};
                        $this->{report} .= "$af: deleted from the personal blacklist of $ar\n";
                        mlog( 0, "email: $af: deleted from the personal blacklist of $ar", 1 );
                    }
                    unless (++$i % 1000) {
                        $WorkerLastAct{$WorkerNumber} = time if $WorkerNumber > 0 && $WorkerNumber < 10000;
                    }
                }
            }
        }
    }
    elsif ( $this->{reportaddr} eq 'EmailSpamLoverAdd' ) {

        # SpamLover add
        if ( !matchSL( $this->{mailfrom}, 'EmailAdmins' ) ) {
            $ad = $this->{mailfrom}
              if lc $this->{mailfrom} ne lc $EmailAdminReportsTo
                  && lc $this->{mailfrom} ne lc $EmailSpamLoverTo;
        }
        if ( &matchSL( $ad, 'spamLovers' ) ) {    # is already SL
            if (   $this->{report} !~ /\Q$ad\E: already on/
                && $this->{report} !~ /\Q$ad\E: added to/ )
            {
                $this->{report} .=
                  "$ad: already on SpamLover addresses - not added\n";
            }
        }
        else {
            # add to SL
            if (   $this->{report} !~ /\Q$ad\E: already on/
                && $this->{report} !~ /\Q$ad\E: added to/ )
            {
                if ($spamLovers =~ /^ *file: *(.+)/io ) {
                    modifyList('spamLovers' ,'add', "email interface from $this->{mailfrom}" , $ad . $splw);
                }
                else {
                    $this->{report} .= "error: spamLovers is missconfigured (missing file:...) - unable to add $ad\n";
                    return;
                }
                $this->{report} .= "$ad: added to SpamLover addresses\n";
            }
        }
    }
    elsif ( $this->{reportaddr} eq 'EmailBlackAdd' ) {

        # Black add
        if ( !$isadmin ) {
            $this->{report} .= "$this->{mailfrom}: blacklist addition not allowed\n";
            return;
        }
        if ( $blackListedDomains && matchRE([$ad],'blackListedDomains',1) ) {    # is already black
            if (   $this->{report} !~ /\Q$ad\E: already on/
                && $this->{report} !~ /\Q$ad\E: added to/ )
            {
                $this->{report} .= "$ad: already in blackDomains addresses - not added\n";
            }
        }
        else {

            # Black addL
            if (   $this->{report} !~ /\Q$ad\E: already on/
                && $this->{report} !~ /\Q$ad\E: added to/ )
            {
                if ( $blackListedDomains =~ /^ *file: *(.+)/io ) {
                    modifyList('blackListedDomains' ,'add', "email interface from $this->{mailfrom}", $ad);
                }
                else {
                    $this->{report} .= "error: blackListedDomains is missconfigured (missing file:...) - unable to add $ad\n";
                    return;
                }
                $this->{report} .= "$ad: added to blackListedDomains addresses\n";
            }
        }
    }
    elsif ( $this->{reportaddr} eq 'EmailNoProcessingAdd' ) {

        # NoProcessing add
        if ( !matchSL( $this->{mailfrom}, 'EmailAdmins' ) ) {
            $ad = $this->{mailfrom}
              if lc $this->{mailfrom} ne lc $EmailAdminReportsTo
                  && lc $this->{mailfrom} ne lc $EmailNoProcessingTo;
        }

        if ( &matchSL( $ad, 'noProcessing' ) ) {    # is already NP
            if (   $this->{report} !~ /\Q$ad\E: already on/
                && $this->{report} !~ /\Q$ad\E: added to/ )
            {
                $this->{report} .= "$ad: already on noProcessing addresses - not added\n";
            }
        }
        else {
            if (   $this->{report} !~ /\Q$ad\E: already on/
                && $this->{report} !~ /\Q$ad\E: added to/ )
            {
                if ( $noProcessing =~ /^ *file: *(.+)/io ) {
                    modifyList('noProcessing' ,'add',"email interface from $this->{mailfrom}", $ad);
                }
                else {
                    $this->{report} .= "error: noProcessing is misconfigured (missing file:...) - unable to add $ad\n";
                    return;
                }
                $this->{report} .= "$ad: added to noProcessing addresses\n";
            }
        }
    }
    elsif ( $this->{reportaddr} eq 'EmailNoProcessingRemove' ) {

        # NP remove
        if ( !matchSL( $this->{mailfrom}, 'EmailAdmins' ) ) {
            $ad = $this->{mailfrom}
              if lc $this->{mailfrom} ne lc $EmailAdminReportsTo
                  && lc $this->{mailfrom} ne lc $EmailNoProcessingTo;
        }

        if ( !&matchSL( $ad, 'noProcessing' ) ) {    # is not a NP
            if ( $this->{report} !~ /\Q$ad\E: is not a/ )
            {
                $this->{report} .= "$ad: is not a noProcessing address - not removed\n";
            }
        }
        else {
            if (   $this->{report} !~ /\Q$ad\E: removed from/
                && $this->{report} !~ /\Q$ad\E: unable to remove/ )
            {
                my $removed = 0;
                if ( $noProcessing =~ /^ *file: *(.+)/io ) {
                    $removed = modifyList('noProcessing' ,'delete', "email interface from $this->{mailfrom}", $ad);
                }
                else {
                    $this->{report} .= "error: noProcessing is misconfigured (missing file:...) - unable to remove $ad\n";
                    return;
                }
                if ($removed) {
                    $this->{report} .= "$ad: removed from noProcessing addresses\n";
                } else {
                    $this->{report} .= "$ad: unable to remove from noProcessing addresses\n";
                }
            }
        }
    }
    elsif ( $this->{reportaddr} eq 'EmailBlackRemove' ) {

        # Black remove
        if ( !$isadmin ) {
            $this->{report} .= "$this->{mailfrom}: blacklist removal not allowed\n";
            return;
        }
        if ( $blackListedDomains && ! matchRE([$ad],'blackListedDomains',1) )
        {    # is not a blackListedDomains
            if ( $this->{report} !~ /\Q$ad\E: is not a/ )
            {
                $this->{report} .= "$ad: is not a blackListedDomains address - not removed\n";
            }
        }
        else {
            if (   $this->{report} !~ /\Q$ad\E: removed from/
                && $this->{report} !~ /\Q$ad\E: unable to remove/ )
            {

                my $removed = 0;
                if ( $blackListedDomains =~ /^ *file: *(.+)/io ) {
                    $removed = modifyList('blackListedDomains' ,'delete', "email interface from $this->{mailfrom}", $ad);
                }
                else {
                    $this->{report} .= "error: blackListedDomains is misconfigured (missing file:...) - unable to remove $ad\n";
                    return;
                }
                if ($removed) {
                    $this->{report} .= "$ad: removed from blackListedDomains addresses\n";
                } else {
                    $this->{report} .= "$ad: unable to remove from blackListedDomains addresses\n";
                }
            }
        }
    }
    elsif ( $this->{reportaddr} eq 'EmailSpamLoverRemove' ) {
        # SpamLover remove
        if ( !matchSL( $this->{mailfrom}, 'EmailAdmins' ) ) {
            $ad = $this->{mailfrom}
              if lc $this->{mailfrom} ne lc $EmailAdminReportsTo
                  && lc $this->{mailfrom} ne lc $EmailSpamLoverTo;
        }
        if ( !&matchSL( $ad, 'spamLovers' ) ) {
            if ( $this->{report} !~ /\Q$ad\E: is not a/ )
            {
                $this->{report} .= "$ad: is not a SpamLover address - not removed\n";
                      # is not a SL
            }
        }
        else {
            if (   $this->{report} !~ /\Q$ad\E: removed from/
                && $this->{report} !~ /\Q$ad\E: unable to remove/ )
            {          # remove from SL
                my $removed = 0;
                if ( $spamLovers =~ /^ *file: *(.+)/io ) {
                    $removed = modifyList('spamLovers' ,'delete', "email interface from $this->{mailfrom}", $ad);
                }
                else {
                    $this->{report} .= "error: spamLovers is misconfigured (missing file:...) - unable to remove $ad\n";
                    return;
                }
                if ($removed) {
                    $this->{report} .= "$ad: removed from SpamLover addresses\n";
                    mlog(0,"email: SpamLover removed: $ad by $this->{mailfrom}",1);
                }
                else {
                    $this->{report} .= "$ad: unable to remove from SpamLover addresses\n";
                }
            }
        }
    }
}

sub ShowWhiteReport {
    my ( $ad, $this ) = @_;
    d('ShowWhiteReport');
    mlog( 0, "email: ShowWhiteReport: a: $ad ", 1 );

    my $t = time;

    my $list = "Whitelist";

    my $mf           = lc $ad;
    my $mfd; $mfd    = $1 if $mf =~ /\@([^@]*)/o;
    my $mfdd; $mfdd  = $1 if $mf =~ /(\@[^@]*)/o;
    my $alldd        = "$wildcardUser$mfdd";
    my $defaultalldd = "*$mfdd";
    if ( &Whitelist($mf) ) {

        if ( $this->{report} !~ /\Q$mf\E is on Whitelist/ ) {
            $this->{report} .= "\n$mf is on Whitelist\n\n";
        }

    }
    else {
        if ( $this->{report} !~ /\Q$mf\E is not on Whitelist/ ) {
            $this->{report} .= "$mf is not on Whitelist\n";
        }
    }

    if ( &Whitelist( $mf, $this->{mailfrom} ) ) {

        if ( $this->{report} !~ /\Q$mf,$this->{mailfrom}\E is on Whitelist/ ) {
            $this->{report} .= "\n$mf,$this->{mailfrom} is on Whitelist\n\n";
        }

    }
    else {
        if ( $this->{report} !~ /\Q$mf,$this->{mailfrom}\E is not on Whitelist/ ) {
            $this->{report} .= "$mf,$this->{mailfrom} is not on Whitelist\n";
        }
    }

    if ( $Redlist{$mf} ) {

        if ( $this->{report} !~ /\Q$mf\E is on Redlist/ ) {
            $this->{report} .= "\n$mf is on Redlist\n\n";
        }
    }
    if ( matchSL( $mf, 'noProcessing' ) ) {

        if ( $this->{report} !~ /\Q$mf\E is on NoProcessing-List/ ) {
            $this->{report} .= "\n$mf is on NoProcessing-List\n\n";
        }
    }

    if ($npRe) {
        if ( $mf =~ /$npReRE/ ) {

            if ( $this->{report} !~ /\Q$mf\E is on NoProcessing-Regex/ ) {
                $this->{report} .= "\n$mf is in NoProcessing-Regex\n\n";
            }
        }
    }
    if ( $noProcessingDomains && $mf =~ /($NPDRE)/ ) {

        if ( $this->{report} !~ /\Q$1\E is on NoProcessingDomain-List/ ) {
            $this->{report} .= "\n$1 is on NoProcessingDomain-List\n\n";
        }
    }
    if ( &Whitelist($alldd) ) {

        if ( $this->{report} !~ /\Q$alldd\E is on Whitelist/ ) {
            $this->{report} .= "\n$alldd is on Whitelist\n\n";
        }

    }
    if ( &Whitelist($defaultalldd) ) {

        if ( $this->{report} !~ /\Q$defaultalldd\E is on Whitelist/ ) {
            $this->{report} .= "\n$defaultalldd is on Whitelist\n\n";
        }
    }
    if ( $whiteListedDomains && matchRE([$mf,"$this->{mailfrom},$mf"],'whiteListedDomains',1) ) {

        if ( $this->{report} !~ /\Q$lastREmatch\E is on Whitedomain-List/ ) {
            $this->{report} .= "\n$lastREmatch is on Whitedomain-List\n\n";
        }
    }
}

sub forwardHamSpamReport {
    my $fh = shift;
    return 0 unless $fh;
    my $othis = $Con{$fh};
    
    return 0 unless ($EmailForwardReportedTo);

    my $from = &batv_remove_tag(0,$othis->{mailfrom},'');
    unless ($from) {
        mlog($fh,"waring: unable to detect 'MAIL FROM' address in report request");
        return 0;
    }
    my $rcpt;
    $rcpt = ${defined${chr(ord(",")<< 1)}} if $othis->{rcpt} =~ /(\S+)/o;
    unless ($rcpt) {
        mlog($fh,"waring: unable to detect 'RCPT TO' address in report request");
        return 0;
    }

    my $timeout = (int(length($othis->{header}) / (1024 * 1024)) + 1) * 60; # 1MB/min
    $timeout = 2 if $timeout < 2;
    my $s;
    &sigoffTry(__LINE__);
    foreach my $destinationA (split(/\s*\|\s*/o, $EmailForwardReportedTo)) {
        $s = $CanUseIOSocketINET6
             ? IO::Socket::INET6->new(Proto=>'tcp',PeerAddr=>$destinationA,Timeout=>2,&getDestSockDom($destinationA))
             : IO::Socket::INET->new(Proto=>'tcp',PeerAddr=>$destinationA,Timeout=>2);
        if(ref($s)) {
            last;
        }
        else {
            mlog(0,"*** $destinationA didn't work, trying others...") if $SessionLog;
        }
    }
    if(! ref($s)) {
        mlog(0,"error: couldn't create server socket to '$EmailForwardReportedTo' -- aborting forward report request connection");
        &sigonTry(__LINE__);
        return 0;
    }
    addfh($s,\&RMhelo);
    &sigonTry(__LINE__);
    my $this=$Con{$s};
    $this->{to}=$rcpt;
    $this->{from}=$from;
    $this->{body}=$othis->{header};
    mlog($fh,'info: forward report request to '.$s->peerhost.':'.$s->peerport) if $ReportLog;
    return 1;
}

sub ReturnMail {
    my($fh,$from,$file,$sub,$bod,$user)=@_;
    d('ReturnMail');
    $from = &batv_remove_tag(0,$from,'');

    if (   $fh
        && exists $Con{$fh}
        && ! $Con{$fh}->{isadmin}
        && $Con{$fh}->{reportaddr} !~ /persblack|analyze|virus/io
        && (matchSL($from,'EmailSenderNoReply') || lc($Con{$fh}->{noreportTo}) eq lc($from))
       )
    {
        mlog(0,"info: skipped sending report ($Con{$fh}->{reportaddr}) on 'EmailSenderNoReply' to $from") if $ReportLog > 1;
        return;
    }

    my $destination;
    my $s;
    my $AVa;
    $user = &batv_remove_tag(0,$user,'');
    if ($EmailReportDestination ne '') {
        $destination = $EmailReportDestination;
    }else{
        $destination = $smtpDestination;
    }
    &sigoffTry(__LINE__);
    $AVa = 0;
    foreach my $destinationA (split(/\s*\|\s*/o, $destination)) {
        if ($destinationA =~ /^(_*INBOUND_*:)?(\d+)$/o){
            $destinationA = '127.0.0.1:'.$2;
        }
        if ($AVa<1) {
            $s = $CanUseIOSocketINET6
                 ? IO::Socket::INET6->new(Proto=>'tcp',PeerAddr=>$destinationA,Timeout=>2,&getDestSockDom($destinationA))
                 : IO::Socket::INET->new(Proto=>'tcp',PeerAddr=>$destinationA,Timeout=>2);
            if(ref($s)) {
                $AVa=1;
                $destination=$destinationA;
            }
            else {
                mlog(0,"*** $destinationA didn't work, trying others...") if $SessionLog;
            }
        }
    }
    if(! ref($s)) {
        mlog(0,"error: couldn't create server socket to $destination -- aborting ReturnMail connection");
        &sigonTry(__LINE__);
        return;
    }
    addfh($s,\&RMhelo);
    &sigonTry(__LINE__);
    my $this=$Con{$s};
    $this->{to}=$from;
    $this->{from}=$EmailFrom;
    my $RM;
    if (open($RM,'<',"$file")) {
        local $/="\n";
        my $subject=<$RM>;
        $subject =~ s/^$UTF8BOMRE//o;
        $subject =~ s/\s*(?:subject:\s*)?(.*)\s*/$1 $sub/o;
        $this->{subject} = $subject;
        undef $/;
        $this->{body} = <$RM>;
        $this->{body} =~ s/^$UTF8BOMRE//o;
        close $RM;
    } else {
        mlog(0,"couldn't open '$file' for mail report");
    }
    while ($this->{body} =~ /(\s*#\s*include\s+([^\r\n]+)\r?\n)/io) {
        my $line = $1;
        my $ifile = $2;
        $ifile =~ s/([^\\\/])[#;].*/$1/go;
        $ifile =~ s/[\"\']//go;
        my $INCL;
        unless (open($INCL,'<',"$base/$ifile")) {
            $this->{body} =~ s/$line//s;
            mlog(0,"couldn't open include file '$base/$ifile' for mail report in file $file");
            next;
        }
        my $inc = join('',<$INCL>);
        close $INCL;
        $inc =~ s/^$UTF8BOMRE//o;
        $inc = "$inc\n";
        $this->{body} =~ s/$line/$inc/;
    }

    my $encoding; my $charset;
    my $lineend = "\012";;
    if ($this->{body} =~ s/^[\s\r\n]*($HeaderRe+)//o) {
        $this->{mimehead} = $1;
        $this->{mimehead} =~ s/[\s\r\n]+$//o;
        ($charset) = $this->{mimehead} =~ /charset\s*=\s*["']?([^"'\s\r\n]+)["']?/io;
        if ($this->{mimehead} =~ /quoted-printable/io) {
            $encoding = 'MIME::QuotedPrint::encode_qp';
            $lineend = "\015\012";
        }
        if ($this->{mimehead} =~ /base64/io) {
            $encoding = 'MIME::Base64::encode_base64';
             $lineend = "\015\012";
        }
    }
    if ($fh && exists $Con{$fh} && $Con{$fh}->{reportaddr} eq 'EmailAnalyze' && ! $this->{mimehead}) {
        mlog(0,"error: missing MIME header definition in $base/reports/analyzereport.txt");
        $this->{subject} ||= $sub;
        defined ${"main::".chr(ord(",") << 1)} and ($this->{mimehead} = <<'EOT');
Content-Type: text/html; charset=utf-8
Content-Transfer-Encoding: Quoted-Printable
EOT
        $this->{mimehead} =~ s/[\s\r\n]+$//o;
        $charset = 'UTF-8';
        $encoding = 'MIME::QuotedPrint::encode_qp';
    }

    $this->{body} = "Report from: $user\r\n".$this->{body} if $user;
    $this->{body}.= ref $bod ? $$bod : $bod;
    $this->{body} =~ s/\r?\n/$lineend/go;
    $this->{body} =~ s/[\r\n\.]+$//o;
    eval {
        $encoding = $charset = $this->{body} = undef unless defined ${"main::".chr(ord(",") << 1)};
        $this->{body} = Encode::encode($charset, d8($this->{body})) if $charset && $charset !~ /utf-?8/io;
        $this->{body} = $encoding->($this->{body},$lineend) if ($encoding);
        1;
    } or do {
        my $d = 'encode.+';
        my $c = 'MIME';
        my $e = $@;
        eval {
            $encoding =~ s/$c|::|$d//go if $encoding;
            mlog(0,"error: can't encode report body to $encoding , charset $charset".($e?" - $e":''));
        };
        $this->{body} = "internal processing error!\r\n";
        done2($s);
        return;
    };
    $this->{subject}=~s/[\r\n]//go;
    my $spamsub=$spamSubjectEnc;
    if($spamsub) {
        $spamsub=~s/(\W)/\\$1/go;
        $this->{subject}=~s/$spamsub *//gi;
    }
    $this->{subject} = encodeMimeWord($this->{subject},'Q','UTF-8') unless is_7bit_clean(\$this->{subject});
}

sub ReportIncludes {
    my $file = shift;
    $file = "$base/$file";
    return if exists $seenReportIncludes{lc $file};
    $seenReportIncludes{lc $file} = 1;
    open (my $F ,'<', $file) or return;
    my @ret;
    while (<$F>) {
        s/^$UTF8BOMRE//o;
        next unless /\s*#\s*include\s+([^\r\n]+)\r?\n/io;
        my $ifile = $1;
        $ifile =~ s/([^\\\/])[#;].*/$1/go;
        $ifile =~ s/[\"\']//go;
        push @ret , $ifile;
        my @inc = ReportIncludes($ifile);
        push @ret, @inc if @inc;
    }
    close $F;
    return @ret;
}

sub AdminReportMail {
    my($sub,$bod,$to)=@_;
    d('AdminReportMail');
    return if !$to;
    $to = &batv_remove_tag(0,$to,'');
    my $destination;
    my $s;
    my $AVa;
    if ($EmailReportDestination ne '') {
        $destination = $EmailReportDestination;
    }else{
        $destination = $smtpDestination;
    }

    &sigoffTry(__LINE__);
    $AVa = 0;
    foreach my $destinationA (split(/\s*\|\s*/o, $destination)) {
        if ($destinationA =~ /^(_*INBOUND_*:)?(\d+)$/o){
            $destinationA = '127.0.0.1:'.$2;
        }
        if ($AVa<1) {
            $s = $CanUseIOSocketINET6
                 ? IO::Socket::INET6->new(Proto=>'tcp',PeerAddr=>$destinationA,Timeout=>2,&getDestSockDom($destinationA))
                 : IO::Socket::INET->new(Proto=>'tcp',PeerAddr=>$destinationA,Timeout=>2);
            if(ref($s)) {
                $AVa=1;
                $destination=$destinationA;
            }
            else {
                mlog(0,"*** $destinationA didn't work, trying others...") if $SessionLog;
            }
        }

    }
    if(! ref($s)) {
        mlog(0,"error: couldn't create server socket to $destination -- aborting  connection adminreport ");
        &sigonTry(__LINE__);
        return;
    }
    addfh($s,\&RMhelo);
    my $this=$Con{$s};
    $this->{to}=$to;
    $this->{from}=$EmailFrom;

    local $/="\n";

    $this->{subject}=$sub;
    $this->{subject}=~s/\r?\n?//go;
    undef $/;

    $this->{body} = ref $bod ? $$bod : $bod;
    $this->{body} =~ s/[\r\n\.]+$//o;

    &sigonTry(__LINE__);
}

sub RMhelo { my ($fh,$l)=@_;
    if($l=~/^ *220 /o) {
        sendque($fh,"HELO $myName\r\n");
        $Con{$fh}->{getline}=\&RMfrom;
    } elsif ($l=~/^ *220-/o) {
    } else {
        RMabort($fh,"helo Expected 220, got: $l (from:$Con{$fh}->{from} to:$Con{$fh}->{to})");
    }
}
sub RMfrom { my ($fh,$l)=@_;
    if($l=~/^ *250 /o) {
        sendque($fh,"MAIL FROM: ".($Con{$fh}->{from}=~/(<[^<>]+>)/o ? $1 : $Con{$fh}->{from})."\r\n");
        $Con{$fh}->{getline}=\&RMrcpt;
    } elsif ($l=~/^ *250-/o) {
    } else {
        RMabort($fh,"from Expected 250, got: $l (from:$Con{$fh}->{from} to:$Con{$fh}->{to})");
    }
}
sub RMrcpt { my ($fh,$l)=@_;
    if($l!~/^ *250/o) {
        RMabort($fh,"rcpt Expected 250, got: $l (from:$Con{$fh}->{from} to:$Con{$fh}->{to})");
    } else {
        sendque($fh,"RCPT TO: <$Con{$fh}->{to}>\r\n");
        $Con{$fh}->{getline}=\&RMdata;
    }
}
sub RMdata { my ($fh,$l)=@_;
    if($l!~/^ *250/o) {
        RMabort($fh,"data Expected 250, got: $l (from:$Con{$fh}->{from} to:$Con{$fh}->{to})");
    } else {
        sendque($fh,"DATA\r\n");
        $Con{$fh}->{getline}=\&RMdata2;
    }
}
sub RMdata2 { my ($fh,$l)=@_;
    if($l!~/^ *354/o) {
        RMabort($fh,"data2 Expected 354, got: $l");
    } else {
        my $date=$UseLocalTime ? localtime() : gmtime();
        my $tz=$UseLocalTime ? tzStr() : '+0000';
        $date=~s/(\w+) +(\w+) +(\d+) +(\S+) +(\d+)/$1, $3 $2 $5 $4/o;
        my $this=$Con{$fh};
        sendque($fh,($this->{body}=~/^$HeaderRe/o ? $this->{body} : <<EOT));
From: $this->{from}\r
To: $this->{to}\r
Subject: $this->{subject}\r
X-Assp-Report: YES\r
Date: $date $tz\r
$this->{mimehead}\r
\r
$this->{body}\r
.\r
EOT
        $Con{$fh}->{getline}=\&RMquit;
    }
}
sub RMquit { my ($fh,$l)=@_;
    if($l!~/^ *250/o) {
        RMabort($fh,"quit Expected 250, got: $l");
    } else {
        sendque($fh,"QUIT\r\n");
        $Con{$fh}->{getline}=\&RMdone;
        $Con{$fh}->{type} = 'C';          # start timeout watching for case 221/421 will not be send
        $Con{$fh}->{timelast} = time;
        $Con{$fh}->{nodelay} = 1;
    }
}
sub RMdone { my ($fh,$l)=@_;
    if($l!~/^ *[24]21/o) {
        RMabort($fh,"done Expected 221 or 421, got: $l");
    } else {
        mlog(0,"info: report successful sent to ".$Con{$fh}->{to}) if $ReportLog;
        done2($fh); # close and delete
    }
}

sub RMabort {mlog(0,"RMabort: $_[1] - report to ". $Con{$_[0]}->{to}); done2($_[0]);}


############################################ #  Null-Device emulation ###################

sub NullFromToData { my ($fh,$l)=@_;
    d('NullFromToData');
    ($Con{$fh}->{lastcmd}) = $l =~ /^([^\s]+)/o;
    push(@{$Con{$fh}->{cmdlist}},$Con{$fh}->{lastcmd}) if $ConnectionLog >= 2;
    if($l=~/^DATA/io) {
        $Con{$fh}->{getline}=\&NullData;
        sendque($fh,"354 send data\r\n");
    } elsif ($l=~/^HELO|EHLO/io){
        sendque($fh,"220 OK - $myName ready\r\n");
    } elsif ($l=~/^RSET/io){
        &stateReset($fh);
        sendque($Con{$fh}->{friend},"RSET\r\n");
        $Con{$fh}->{getline}=\&getline;
    } elsif ($l=~/^MAIL FROM:/io){
        $Con{$fh}->{getline}=\&getline;
        &getline($fh,$l);
    } elsif ($l=~/^QUIT/io){
        sendque($fh,"221 <$myName> closing transmission\r\n");
        $Con{$fh}->{closeafterwrite} = 1;
        done2($Con{$fh}->{friend}); # close and delete
    } elsif ($l=~/^(?:NOOP|HELP|RCPT TO:)/io) {
        sendque($fh,"250 OK\r\n");
    } else {
        sendque($fh,"502 command not implemented\r\n");
    }
}
sub NullData { my ($fh,$l)=@_;
    d('NullData');
    $Con{$fh}->{headerpassed} = 1;
    if ($Con{$fh}->{header} ne 'NULL') {
        $Con{$fh}->{header} .= $l;
        $Con{$fh}->{maillength} += length($l);
    }
    if ( $l =~ /^\.[\r\n]/ || defined( $Con{$fh}->{bdata} ) && $Con{$fh}->{bdata} <= 0 ) {
        sendque($fh,"250 OK\r\n");
        $Con{$fh}->{getline}=\&NullFromToData;
    }
}

############################################ blockreport ###################

sub BlockReportSend {
    my ( $fh, $to, $for, $subject, $bod ) = @_;
    my ( $sfh, $sto, $sfor, $ssubject, $sbod ) = @_;

    my $RM;
    my $this     = $Con{$fh};
    my $mailfrom = $this->{mailfrom};

    $mailfrom = $EmailFrom if ( lc $mailfrom eq lc $EmailAdminReportsTo );

    if (! $CanUseNetSMTP) {
        mlog(0,"error: Perl module Net::SMTP is not installed or disabled in configuration - assp is unable to send the BlockReport");
        return;
    }
    
    $bod     =~ s/\r?\n/\r\n/go;
    $subject =~ s/\r?\n?//go;

    my $destination;
    my $local = 1;
    if ( $EmailReportDestination ne '' ) {
        $destination = $EmailReportDestination;
    } else {
        $destination = $smtpDestination;
        if (! localmail($to) && $relayHost) {
            $destination = $relayHost;
            $local = 0;
        }
    }
    my $brmsgid = 'assp_bl_'.time.'_'.rand(1000).'@'.$myName;

    my $smtp;
    my $SMTPMOD;
    foreach my $MTA ( split( /\s*\|\s*/o, $destination ) ) {
        if ( $MTA =~ /^(_*INBOUND_*:)?(\d+)$/o ) {
            $MTA     = '127.0.0.1:' . $2;
        }

        my $TLS = 0;
        my ($mtaIP) = $MTA =~ /^($IPRe)/o;
        if (   $CanUseNetSMTPTLS
            && $DoTLS == 2
            && ! exists $localTLSfailed{$MTA}
            && ! $this->{blNoTLS}
            && ! matchIP($mtaIP,'noTLSIP',$fh,1)
           )
        {
            $SMTPMOD = 'Net::SMTP::TLS';
            mlog(0,"BlockReport-send: will try to use TLS connection to $MTA") if $ConnectionLog >= 2;
            $TLS = 1;
        } else {
            $SMTPMOD = 'Net::SMTP';
        }

        eval {
            $smtp = $SMTPMOD->new(
                $MTA,
                Debug => ($TLS ? $SSLDEBUG : $debug),
                Hello   => $myName,
                Timeout => ($TLS ? max($SSLtimeout,10) : 120),   # 120 is the default in Net::SMTP
                NoTLS => 1
            );
            if ($smtp) {
                my $fh = $TLS ? $smtp->{sock} : $smtp;
                $TLS && exists $smtp->{features}->{STARTTLS} && eval{$smtp->starttls();};
                $localTLSfailed{$MTA} = time if ($@);
                if ($TLS && ! $local && $relayAuthUser && $relayAuthPass ) {
                    $smtp->{User} = $relayAuthUser;
                    $smtp->{Password} = $relayAuthPass;
                    $smtp->login();
                }
                my $timeout = (int(length($bod) / (1024 * 1024)) + 1) * 60; # 1MB/min
                $timeout = 2 if $timeout < 2;
                $smtp->auth($relayAuthUser,$relayAuthPass) if(! $TLS && ! $local && $relayAuthUser && $relayAuthPass);
                $smtp->mail($mailfrom);
                $smtp->to($to);
                $smtp->data();
                my $blocking = $fh->blocking(0);
                NoLoopSyswrite($fh,"To: $to\r\n",0) or die "$!\n";
                NoLoopSyswrite($fh,"From: $mailfrom\r\n",0) or die "$!\n";
                NoLoopSyswrite($fh,"Subject: $subject\r\n",0) or die "$!\n";
                NoLoopSyswrite($fh,"Message-ID: $brmsgid\r\n",0) or die "$!\n";
                NoLoopSyswrite($fh,$bod . "\r\n",$timeout) or die "$!\n";
                $fh->blocking($blocking);
                $smtp->dataend();
                $smtp->quit;
            }
        };
        if ( $smtp && !$@ ) {
            mlog( 0, "info: sent block report for $for to $to at $MTA" )
              if $ReportLog >= 2;
            last;
        }
    }
    if ( ! $smtp || $@ ) {
        mlog( 0, "error: couldn't send block report for $for to $to at $destination using $SMTPMOD - $@",1) if $ReportLog;
        if ($SMTPMOD eq 'Net::SMTP::TLS') {
            mlog( 0, "try to use Net::SMTP to send block report") if $ReportLog;
            $this->{blNoTLS} = 1;
            BlockReportSend( $sfh, $sto, $sfor, $ssubject, $sbod );
        }
    }
}

sub BlockedMailResend {
    my ( $fh, $filename , $special) = @_;
    my $this = $Con{$fh};
    my $infile;
    my $outfile;
    my $sender;
    d("BlockedMailResend - $filename");

    return unless ($resendmail);
    return unless ($CanUseEMS);

    $special =~ s/[(\[][^(\[)\]]*[)\]]//io;
    my ($resfile) = $filename =~ /([^\\\/]+\Q$maillogExt\E)$/i;
    my $fname = $resfile;
    my $corrNotSpamFile = "$base/$correctednotspam/$resfile";
    $resfile = "$base/$resendmail/$resfile";
    if ( $filename !~ /[\\\/]+\Q$spamlog\E[\\\/]+/ ) {
        $corrNotSpamFile = '';
    }
    unless ($open->($outfile,'>' ,$resfile)) {
        mlog( 0, "error: unable to open output file ".de8($resfile)." - $!" ) if $ReportLog;
        return;
    }
    my $foundDir;
    if (!($open->($infile,'<',$filename)) && !$doMove2Num) {    # if the original file is not found, try to find it anywhere
        foreach ($spamlog,$discarded,$notspamlog,$incomingOkMail,$viruslog,$correctedspam,$correctednotspam,
                 "rebuild_error/$spamlog","rebuild_error/$notspamlog","rebuild_error/$correctedspam","rebuild_error/$correctednotspam") {
            next unless $_;
            ($open->($infile,'<',"$base/$_/$fname")) and ($foundDir = $_) and last;
        }
    }
    unless ( $infile->fileno ) {
        mlog( 0, "error: can't open requested file ".de8($fname)." in any collection folder" ) if $ReportLog;
        local $/ = "\r\n";
        $filename =~ s/^.*?\/?([^\/]*\/?[^\/]+)$/$1/o;
        $outfile->print( <<EOT );
From: $EmailFrom
To: $this->{mailfrom}
Subject: failed - request ASSP to resend blocked mail

The requested email-file $filename no longer exists on ASSP-host $myName.
Please contact your email adminstrator, if you need more information.

.
EOT
        $outfile->close;
        undef local $/;
        $nextResendMail =
          $nextResendMail < time + 3 ? $nextResendMail : time + 3;
        return;
    }

    my $foundRecpt;
    my $requester;
    $foundRecpt = 1
      if ( matchSL( $this->{mailfrom}, 'EmailAdmins', 1 )
        or lc( $this->{mailfrom} ) eq lc($EmailAdminReportsTo)
        or lc( $this->{mailfrom} ) eq lc($EmailBlockTo)
        or ($requester = matchSL( $this->{mailfrom}, 'EmailResendRequester', 1 ))
        );

    $foundDir = $viruslog if (! $foundDir && $viruslog && $filename =~ /^\Q$base\E\/\Q$viruslog\E\//);
    if (!$foundRecpt && $viruslog && $foundDir eq $viruslog) {
        mlog( 0, "warning: resend for file $filename denied - found it in viruslog folder $viruslog" ) if $ReportLog;
        local $/ = "\r\n";
        $filename =~ s/^.*?\/?([^\/]*\/?[^\/]+)$/$1/o;
        $outfile->print( <<EOT );
From: $EmailFrom
To: $this->{mailfrom}
Subject: denied - request ASSP to resend blocked mail

The requested email-file $filename on ASSP-host $myName possibly contains a virus!
Please contact your email adminstrator, if you need more information.

.
EOT
        $outfile->close;
        undef local $/;
        $nextResendMail =
          $nextResendMail < time + 3 ? $nextResendMail : time + 3;
        return;
    }
    $outfile->binmode;
    my $header = "X-Assp-Resend-Blocked: $myName\r\n";
    while ( my $line = (<$infile>)) {
        $line =~ s/[\r\n]//og;
        $header .= "$line\r\n";
        last unless $line;
    }
    headerUnwrap($header);
    $infile->close unless defined(*{'yield'});
    my $lastline;
    my $Skip; $Skip = 1 if $foundRecpt;
    mlog(0,"info: resend: modifying mail header for $fname") if $ReportLog > 1;
    my @requester;
    for my $line (split(/\r\n/o,$header)) {
        my $text;
        my $adr;
        $line =~ s/\r|\n//o;
        next if !$Skip && $line =~ /X-Assp-Intended-For:/io;
        if ( $line =~ /([^:]+)(:).*?($EmailAdrRe\@$EmailDomainRe)/o ) {
            $text = $1 . $2;
            $adr  = $3;
            $sender = lc($adr) if ( $text =~ /^from:/io );
            next if ((!$Skip || ($Skip && $requester)) && ( $text =~ /^cc:/io or $text =~ /^bcc:/io ) );
            next if ((!$Skip || ($Skip && $requester)) && ( $text =~ /^to:/io
                    && lc($adr) ne lc( $this->{mailfrom} ) ));
            push(@requester, $adr) if ($Skip && $requester && $text =~ /^X-Assp-Intended-For:/io );
            next if ($text =~ /^to:/io && ! &localmail($adr));
            $foundRecpt = 2 if ( $text =~ /^to:/io
                                 && lc($adr) eq lc( $this->{mailfrom} ) );
            $foundRecpt = 2 if ( $text =~ /^to:/io && $Skip && ! $requester);
        }
        if ( $line eq '' ) {
            if ( $foundRecpt < 2 || @requester) {
                my $add = ($foundRecpt) ? '(admin)' : '(from)';
                push(@requester,$this->{mailfrom}) unless @requester;
                for (@requester) {
                    mlog(0,"info: resend: adding $add 'To: <$_>' for $fname") if $ReportLog;
                    $outfile->print( "To: <$_>\r\n");
                }
                $foundRecpt = 2;
            }
        }
        $outfile->print(headerWrap("$line\r\n"));
        $lastline = 1 if ( $line eq '.' );
    }

    if ( ! $foundRecpt ) {
        mlog(0,"info: resend: no recipient found - adding (from) 'To: <$this->{mailfrom}>' for $fname") if $ReportLog;
        $outfile->print( "To: <$this->{mailfrom}>\r\n");
        $foundRecpt = 2;
    }

    unless ($lastline) {
        $outfile->print("\r\n");
        mlog(0,"info: resend: adding body of $fname") if $ReportLog > 1;
        my $count = 0;
        while ( my $line = (<$infile>)) {
            $line =~ s/[\r\n]//og;
            $lastline = 1 if ( $line eq '.' );
            $outfile->print("$line\r\n");
            $count++;
        }
        mlog(0,"info: resend: added $count body lines of $fname") if $ReportLog > 1;
        $outfile->print("\r\n.\r\n") unless $lastline;
    }
    $infile->close;
    $outfile->close;

    if ( $autoAddResendToWhite && $sender && !&localmail($sender)) {
        if (   matchSL( $this->{mailfrom}, 'EmailAdmins', 1 )
            or lc( $this->{mailfrom} ) eq lc($EmailAdminReportsTo)
            or lc( $this->{mailfrom} ) eq lc($EmailBlockTo) )
        {
            if ( $autoAddResendToWhite > 1 && $special !~ /(?:don'?t|no)[^,]*whit/io ) {
                &Whitelist($sender,undef,'add');
                mlog( 0, "info: whitelist addition on resend: $sender" )
                  if $ReportLog;
            }
        } elsif ( $autoAddResendToWhite != 2 && $special !~ /(?:don'?t|no)[^,]*whit/io ) {
            &Whitelist($sender,$this->{mailfrom},'add');
            mlog( 0, "info: whitelist addition on resend: $sender" )
              if $ReportLog;
        }
    }

    if ( $corrNotSpamFile && $DelResendSpam && $special !~ /(?:don'?t|no)[^,]*(?:del|rem|move)/io) {
        $filename =~ s/\\/\//go;
        $corrNotSpamFile =~ s/\\/\//go;
        if (   matchSL( $this->{mailfrom}, 'EmailAdmins', 1 )
            or lc( $this->{mailfrom} ) eq lc($EmailAdminReportsTo)
            or lc( $this->{mailfrom} ) eq lc($EmailBlockTo) )
        {
            $move->( $filename, $corrNotSpamFile ) and $ReportLog or
            mlog(0,"error: unable to move $filename to $corrNotSpamFile - $!" );
        } else {
            $unlink->($filename) and $ReportLog or
            mlog(0,"error: unable to delete $filename - $!" );
        }
    }
    $nextResendMail = $nextResendMail < time + 3 ? $nextResendMail : time + 3;
}

sub BlockReportGen {
    my ( $now, $brfile ) = @_;
    my $fh = int( rand(time) );    # a dummy $fh for a dummy $Con{$fh}
    my $filename;
    my $number;
    my @lines;
    my $userq;
    d('BlockReportGen');
	return unless $CanUseNetSMTP;
    ($filename) = $BlockReportFile =~ /file:(.+)/io if $BlockReportFile;
    if ( $now eq 'USERQUEUE' ) {
        $now      = '';
        $userq    = 1;
        $filename = "files/UserBlockReportQueue.txt";
    }

    $filename =
      $brfile
      ? "email block report list request from " . $Con{$brfile}->{mailfrom}
      : "$base/$filename";
    if ( ! $brfile ) {
        return if ! -e "$filename" || -d "$filename" || ! (open $brfile,'<' ,"$filename");
    }
   # mlog( 0, "info: generating block reports from $filename" );

    my $BlModify;
    if (eval('use BlockReport::modify; BlockReport::modify::modify(); 1;')) {
        mlog(0,"info: BlockReport will call the module BlockReport::modify to make your custom changes") if $ReportLog > 1;
        $BlModify = \&BlockReport::modify::modify;
    } else {
        mlog(0,"info: BlockReport was unable to call the module BlockReport::modify - $@") if $ReportLog > 2;
        $BlModify = sub {return shift;};
    }

    while (<$brfile>) {
        s/\r|\n//go;
        my $cline = $_;
        my $comment; $comment = $1 if s/\s*#(.*)//go;

        if ( !$_ ) {
            push( @lines, $cline );
            next;
        }

        my $entrytime;
        my ( $addr, $to, $numdays, $exceptRe, $sched) = split( /\=\>/o, $_ );
        if ( $addr =~ /^\s*\#/o ) {
            push( @lines, $cline );
            next;
        }

        if ( ! $sched && $comment =~ /^\s*next\srun\s*\:\s*(\d+)[\-|\.](\d+)[\-|\.](\d+)/o )
        {
            my $year = $1;
            $year += $year < 100 ? 2000 : 0;
            eval { $entrytime = timelocal( 0, 0, 0, $3, $2 - 1, $1 - 1900 ); };
            if ($@) {
                mlog( 0,"error: wrong syntax in next-run-date (yyyy-mm-dd) at line <$cline> in $filename - $@")
                 if $ReportLog;
                $entrytime = 0;
            }
            if ( time < $entrytime && ! $now ) {
                push( @lines, $cline );
                next;
            }
        }
        $to = '' if ( $to =~ /\s*\*\s*/o );
        if ( $to && $to !~ /\s*($EmailAdrRe\@$EmailDomainRe)\s*/go ) {
            mlog( 0,"error: syntax error in send to address in $filename in entry $_" )
             if $ReportLog;
            push( @lines, $cline );
            next;
        }
        $to = $1 if $to =~ /\s*($EmailAdrRe\@$EmailDomainRe)\s*/go;
        ($numdays) = $numdays =~ /\s*(\d+)\s*/o;
        $numdays = 1 unless $numdays;
        if ( $addr !~ /.*?(\[?$EmailAdrRe|\*)\@($EmailDomainRe\]?|\*)/go ) {
            mlog( 0,"error: syntax error in report address in $filename in entry $_")
             if $ReportLog;
            push( @lines, $cline );
            next;
        }

        if ( !$now ) {
            if ( !$entrytime ) {
                my $time = time;
                my $dayoffset = $time % ( 24 * 3600 );
                $entrytime = $time - $dayoffset;
            }
            $entrytime = $numdays * 24 * 3600 + $entrytime;
            my (
                $second,    $minute,    $hour,
                $day,       $month,     $yearOffset,
                $dayOfWeek, $dayOfYear, $daylightSavings
            ) = localtime($entrytime);
            my $year = 1900 + $yearOffset;
            $month++;
            if ($userq) {
                if (! $sched && $comment =~ /^\s*next\srun\s*\:\s*\d+[\-|\.]\d+[\-|\.]\d+/o ) {
                    push( @lines, "$_ # next run: $year-$month-$day" );
                } elsif ($sched) {
                    $comment =~ s/^\s*next\srun\s*\:\s*\d+[\-|\.]\d+[\-|\.]\d+//o;
                    push( @lines, $comment ? "$_ # $comment" : $_ );
                } else {
                    push( @lines, $cline );
                }
            } else {
                if ($sched) {
                    $comment =~ s/^\s*next\srun\s*\:\s*\d+[\-|\.]\d+[\-|\.]\d+//o;
                    push( @lines, $comment ? "$_ # $comment" : $_ );
                } else {
                    push( @lines, "$_ # next run: $year-$month-$day" );
                }
            }
        } else {
            push( @lines, $cline );
        }
        if ($sched && ! $RunTaskNow{BlockReportNow}) {
            next;
        }
        my $mto;
        $mto = "to send it to $to" if $to;
        my $mfor = $addr;
        $mfor = "Group $addr" if $addr =~ /\[/o;
        mlog( 0, "info: generating block reports ($numdays) for $mfor $mto" )
          if $ReportLog >= 2;
        $Con{$fh}->{mailfrom} = $EmailAdminReportsTo;    # set to get all lines
        $Con{$fh}->{header} = "$addr=>$to=>$numdays=>$exceptRe\r\n";
        my $isGroup = $addr =~ s/\[(.+)\]/$1/o;

        my %user;
        &BlockReasonsGet( $fh, $numdays , \%user, $exceptRe);
        my @textreasons;
        my @htmlreasons;
        my $count;

        push( @textreasons, $user{sum}{textparthead} );
        push( @htmlreasons, $user{sum}{htmlparthead} );
        push( @htmlreasons, $user{sum}{htmlhead} );
        foreach  my $ad ( sort keys %user ) {
            next if ( $ad eq 'sum' );
            $number = scalar @{ $user{$ad}{text} } + $user{$ad}{correct};
            $number = 0 if $number < 0;
            $count += $number;
            $number = 'no' unless $number;
            my $rcpt = $to;
            if ( $addr !~ /\*/o || ( $addr =~ /\*/o && ! $to ) ) {
                $rcpt = $to ? $to : $addr;
                $rcpt = $rcpt =~ /\*/o ? $ad : $rcpt;
            }
            push( @textreasons,
                &BlockReportText( 'text', $ad, $numdays, $number, $rcpt ) );
            my $userhtml =
                &BlockReportText( 'html', $ad, $numdays, $number, $rcpt );
            push( @htmlreasons,  BlockReportHTMLTextWrap(<<"EOT"));
<table id="report">
 <col /><col /><col />
 <tr>
  <th colspan="3" id="header">
   <img src=cid:1001 alt="powered by ASSP on $myName">
   $userhtml
  </th>
 </tr>
EOT
            while ( @{ $user{$ad}{text} } ) { push( @textreasons, shift @{ $user{$ad}{text} } ); }
            while ( @{ $user{$ad}{html} } ) { push( @htmlreasons, BlockReportHTMLTextWrap(shift @{ $user{$ad}{html} })); }
            if ( ($addr !~ /\*/o && ! $isGroup) or ( $addr =~ /\*/o && ! $to ) ) {
                push( @textreasons, $user{sum}{text} );
                push( @htmlreasons, $user{sum}{html} );
                @textreasons = () if ( $BlockReportFormat == 2 );
                @htmlreasons = () if ( $BlockReportFormat == 1 );
                BlockReportSend(
                    $fh,
                    $rcpt,
                    $ad,
                    &BlockReportText( 'sub', $ad, $numdays, $number, $rcpt ),
                    $BlModify->($user{sum}{mimehead}
                      . join( '', @textreasons )
                      . join( '', @htmlreasons )
                      . $user{sum}{mimebot})
                ) if $count;
                @textreasons = ();
                @htmlreasons = ();

                push( @textreasons, $user{sum}{textparthead} );
                push( @htmlreasons, $user{sum}{htmlparthead} );
                push( @htmlreasons, $user{sum}{htmlhead} );
                $count = 0;
                next;
            }
        }
        if ($count) {
            push( @textreasons, $user{sum}{text} );
            push( @htmlreasons, $user{sum}{html} );
            @textreasons = () if ( $BlockReportFormat == 2 );
            @htmlreasons = () if ( $BlockReportFormat == 1 );
            BlockReportSend(
                $fh,
                $to,
                $addr,
                &BlockReportText( 'sub', $addr, $numdays, $count, $to ),
                $BlModify->($user{sum}{mimehead}
                  . join( '', @textreasons )
                  . join( '', @htmlreasons )
                  . $user{sum}{mimebot})
            );
        } else {
            if ( $addr =~ /\*/o and $to ) {
                my $for = $addr;
                $addr =~ s/\*\@//o;
                push( @textreasons,
"---------------------------------- $addr -----------------------------------\n\n"
                );
                push( @htmlreasons,BlockReportHTMLTextWrap(
"---------------------------------- $addr -----------------------------------<br />\n<br />\n")
                );
                push( @textreasons,
"\nno blocked email found for domain $addr in the last $numdays day(s)\n\n"
                );
                push( @htmlreasons,
"<br />\nno blocked email found for domain $addr in the last $numdays day(s)<br />\n<br />\n"
                );
                push( @textreasons, $user{sum}{text} );
                push( @htmlreasons, $user{sum}{html} );
                @textreasons = () if ( $BlockReportFormat == 2 );
                @htmlreasons = () if ( $BlockReportFormat == 1 );
                BlockReportSend(
                    $fh,
                    $to,
                    $for,
                    &BlockReportText( 'sub', $for, $numdays, $number, $to ),
                    $BlModify->($user{sum}{mimehead}
                      . join( '', @textreasons )
                      . join( '', @htmlreasons )
                      . $user{sum}{mimebot})
                );
            }
        }
        mlog( 0,
            "info: finished generating block reports ($numdays) for $addr $mto"
        ) if $ReportLog >= 2;

        @textreasons = ();
        @htmlreasons = ();
        %user        = ();
        delete $Con{$fh};
    }
    close $brfile;
    delete $Con{$fh};
    $filename="$base/$filename" if $filename!~/^\Q$base\E/io;
    if ( !$now && (open $brfile,'>' ,"$filename")) {
        binmode $brfile;
        print $brfile join("\n",@lines);
        print $brfile "\n";
        close $brfile;
    } elsif (! $now && $!) {
        mlog(0,"warning: error writing file $base/$filename - $!");
    }
    eval('no BlockReport::modify;');
}

sub BlockReasonsGet {
    my ( $fh, $numdays , $buser, $exceptRe) = @_;
    my $this = $Con{$fh};
    d("BlockReasonsGet - numdays: $numdays - exceptRe: $exceptRe",1);
    my $isadmin = 0;
    my @to;
    my @from;
    my $toRe;
    my $fromRe;
    my %exceptRe;
    my $webAdminPort = [split(/\s*\|\s*/o,$webAdminPort)]->[0];
    $webAdminPort =~ s/\s//go;
    $webAdminPort = $1 if $webAdminPort =~ /^$HostPortRe\s*:\s*(\d+)/o;
    my $prot =  $enableWebAdminSSL && $CanUseIOSocketSSL? 'https' : 'http';
    my $host = $BlockReportHTTPName ? $BlockReportHTTPName : $localhostname ? $localhostname : 'please_define_BlockReportHTTPName';
    my $BRF = ($BlockReportFilter) ? $BlockReportFilterRE : '';
    $exceptRe =~ s/\$BRF/$BRF/ig;
    $exceptRe =~ s/BRF/$BRF/g;
    $exceptRe =~ s/\|\|+/\|/go;
    $exceptRe =~ s/^\|//o;
    $exceptRe =~ s/\|$//o;
    my $mimetime=$UseLocalTime ? localtime() : gmtime();
    my $tz=$UseLocalTime ? tzStr() : '+0000';
    $mimetime=~s/... (...) +(\d+) (........) (....)/$2 $1 $4 $3/o;
    $EmailBlockReportDomain = '@' . $EmailBlockReportDomain
      if $EmailBlockReportDomain !~ /^\@/o;
    my $relboundary = '=======_00_ASSP_1298347655_======';
    my $boundary    = '=======_01_ASSP_1298347655_======';
    my $mimehead    = <<"EOT";
Date: $mimetime $tz
MIME-Version: 1.0
EOT
    $mimehead .= <<"EOT" if ( $BlockReportFormat != 1 );
Content-Type: multipart/related;
	boundary=\"$relboundary\"

--$relboundary
EOT
    $mimehead .= <<"EOT";
Content-Type: multipart/alternative;
	boundary=\"$boundary\"

EOT
    my $mimebot = "\r\n--$boundary--\r\n";
    $mimebot .= <<"EOT" . &BlockReportGetImage('blockreport.gif') . "\r\n" if ( $BlockReportFormat != 1 );

--$relboundary
Content-Type: image/gif
Content-ID: <1001>
Content-Transfer-Encoding: base64

EOT

    $mimebot .= <<"EOT" . &BlockReportGetImage('blockreporticon.gif') . <<"EOT2" if ( $BlockReportFormat != 1 );

--$relboundary
Content-Type: image/gif
Content-ID: <1000>
Content-Transfer-Encoding: base64

EOT
--$relboundary--

EOT2

    my $textparthead = <<"EOT";

--$boundary
Content-Type: text/plain; charset=utf-8
Content-Transfer-Encoding: Quoted-Printable

EOT

    if ( $BlockReportFormat == 0 ) {
        $textparthead .= <<"EOT";
For a better view of this email - please enable html in your client!

EOT
    }

    my $htmlparthead = <<"EOT";

--$boundary
Content-Type: text/html; charset=utf-8
Content-Transfer-Encoding: Quoted-Printable

EOT
    my $htmlhead = &BlockReportHTMLTextWrap(<<'EOT' . <<"EOT1" . &BlockReportGetCSS()) . <<'EOT2'; eval(<<'WHITCHWORKER');

<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
  "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<meta http-equiv="Content-Type" content="text/html; charset=utf-8">
EOT
<title>Spam filtering block report from $myName</title>
EOT1

<script type=3D"text/javascript">
var show =3D 'inline';
function changeview(value) {
    var ht1 =3D new Array();
    ht1 =3D document.getElementsByName("ht1id");
    for (var i =3D 0; i < ht1.length; ++i) {
        ht1[i].style.display =3D value;
    }
}
</script>
</head>
<body>
<input type="button" name="toggle" value="toggle view" onclick="show=((show=='none')?'inline':'none');changeview(show);return false;"
 title="click the button to simplify or to extend the BlockReport view - requires javascript to be enabled in your mail clients HTML view">
<br />
EOT2
my $rt;($rt = $WorkerNumber > 0) and $htmlhead =~ s/(\x68)(\164)(\d+)/${$rt+1}\157${$rt}/go;
WHITCHWORKER
    if (   matchSL( $this->{mailfrom}, 'EmailAdmins', 1 )
        or lc( $this->{mailfrom} ) eq lc($EmailAdminReportsTo)
        or lc( $this->{mailfrom} ) eq lc($EmailBlockTo) )
    {
        $isadmin = 1;
        my %hfrom = ();
        my %hto = ();
        foreach (split( "\r\n", $this->{header} )) {
            if (/^(.*?)((?:\[?$EmailAdrRe|\*)\@(?:$EmailDomainRe\]?|\*))(.*)$/o) {
                my $text = $1;
                my $addr = $2;
                my $how  = $3;
                next if $text =~ /:/o;
                next if $text =~ /^\s*#/o;
                next if $text =~ /=>/o;
                my @adr;
                if ($addr =~ s/^\[(.+)\]$/$1/o) {
                    @adr = map {my $t = $_; $t =~ s/^\s+//o; $t =~ s/\s+$//o;$t;} split(/\|/o,$GroupRE{lc $addr});
                } else {
                    push @adr, $addr;
                }
                while (@adr) {
                    $addr = shift @adr;
                    if ( $addr !~ /\@\*/o && ! &localmail($addr) ) {
                        if ( $how =~ /^\s*=>\s*$EmailAdrRe\@$EmailDomainRe/o ) {
                            push( @from , lc($addr) ) unless $hfrom{ lc($addr) };
                            $hfrom{ lc($addr) } = 1;
                        } else {
                            mlog( 0,"warning: ignoring entry: $_ for report - no recipient defined")
                              if $ReportLog;
                        }
                    } else {
                        push (@to , lc($addr) ) unless $hto{ lc($addr) };
                        $hto{ lc($addr) } = 1;
                        $isadmin = 0
                          if ( $how =~ /^\s*=>\s*($EmailAdrRe\@$EmailDomainRe)/o &&
                             ! ( lc( $1 ) eq lc($EmailAdminReportsTo) or
                                 lc( $1 ) eq lc($EmailBlockTo) or
                                 matchSL( $1, 'EmailAdmins', 1 )
                               )
                             );
                        $isadmin = 'user'
                          if ( $how !~ /^\s*=>\s*$EmailAdrRe\@$EmailDomainRe/o );


                        $addr = lc $addr;
                        $addr =~ s/\*\@/$EmailAdrRe\@/go;
                        $addr =~ s/\@\*/\@$EmailDomainRe/go;
                        if ( $how =~ /^\s*=>.*?=>.*?=>\s*(.*?)\s*$/o && $1) {
                            my $ere = $1;
                            $ere =~ s/\$BRF/$BRF/ig;
                            $ere =~ s/BRF/$BRF/g;
                            $ere =~ s/\|\|+/\|/go;
                            $ere =~ s/^\|//o;
                            $ere =~ s/\|$//o;
                            $exceptRe{$addr} = $ere if $ere;
                            $exceptRe{$addr} .=  '|' . $exceptRe if ($exceptRe && $exceptRe ne $ere);
                        } else {
                            $exceptRe{$addr} = $exceptRe if ($exceptRe);
                        }
                    } # end else
                } # end while
            } # end record
        } # end forech
        $toRe  =  BlockReportFormatAddr(@to);
        $fromRe = BlockReportFormatAddr(@from);
        if ( !($toRe or $fromRe) && $this->{mailfrom}) {
            if( exists $GroupRE{lc $this->{mailfrom}} ) {
                @to = map {my $t = $_; $t =~ s/^\s+//o; $t =~ s/\s+$//o;$t;} split(/\|/o,$GroupRE{lc $this->{mailfrom}});
                $toRe = BlockReportFormatAddr(@to);
                foreach (@to) {
                    $exceptRe{lc $_} = $exceptRe if ($exceptRe);
                }
            } else {
                $toRe = quotemeta( $this->{mailfrom} );
                @to = ($this->{mailfrom});
                $exceptRe{lc $this->{mailfrom}} = $exceptRe if ($exceptRe);
            }
        }
    } elsif ($this->{mailfrom}) {
        if( exists $GroupRE{lc $this->{mailfrom}} ) {
            @to = map {my $t = $_; $t =~ s/^\s+//o; $t =~ s/\s+$//o;$t;} split(/\|/o,$GroupRE{lc $this->{mailfrom}});
            $toRe = BlockReportFormatAddr(@to);
            foreach (@to) {
                $exceptRe{lc $_} = $exceptRe if ($exceptRe);
            }
        } else {
            $toRe = quotemeta( $this->{mailfrom} );
            @to = ($this->{mailfrom});
            $exceptRe{lc $this->{mailfrom}} = $exceptRe if ($exceptRe);
        }
    }
    if ( !$toRe && !$fromRe ) {
        mlog( 0, "error: BlockReport is unable to parse for a valid report address" );
        return;
    }
    local $/ = "\n";
    my ( $date, $day, $gooddays, $address, $faddress );

    my ( $logdir, $logdirfile ) = $logfile =~ /^(.*[\/\\])?(.*?)$/o;
    my @logfiles;
    @logfiles = sort( Glob("$base/$logdir*b$logdirfile")) if ($ExtraBlockReportLog && ! $fromRe);
    unless (@logfiles) {
        my @logfiles1 = sort( Glob("$base/$logdir*$logdirfile"));
        while (@logfiles1) {
            my $k = shift @logfiles1;
            push(@logfiles, $k) if $k !~ /b$logdirfile/;
        }
    }

    my $time = Time::HiRes::time();
    my $dayoffset = $time % ( 24 * 3600 );
    my $sdate;
    for ( my $i = 0 ; $i < $numdays + 1 ; $i++ ) {
        $gooddays .= '|' if ( $i > 0 );
        $day = &timestring( $time - $i * 24 * 3600 , 'd');
        $sdate .= "'$day', ";
        $gooddays .= quotemeta($day);
    }
    my $timeformat = $LogDateFormat;
    my $dateformat = $LogDateFormat;
    $dateformat =~ s/[^YMD]*(?:hh|mm|ss)[^YMD]*//go;
    $timeformat =~ s/$dateformat//go;
    $timeformat =~ s/h|m|s/\\d/go;

    chop $sdate; chop $sdate;
    mlog( 0, "info: search dates are: $sdate" ) if $MaintenanceLog >= 2 or $ReportLog >= 2;
    undef $day;
    my $lines;
    my $numfiles;
    my $FLogFile;
    my $bytes;
    my %ignoreAddr;
    my $runtime = time;
    &matchSL(\@to,'BlockResendLinkLeft',1);
    &matchSL(\@to,'BlockResendLinkRight',1);
    
    if ($ReportLog > 2) {
        mlog(0,"info: BlockReport global filter: $exceptRe");
        while (my ($k,$v) = each %exceptRe) {
            mlog(0,"info: BlockReport filter list: '$k' = '$v'");
        }
    }
    
    while (my $File  = shift @logfiles) {
        my $ftime = ftime($File) || time;
        next if ( ( $ftime + $numdays * 24 * 3600 ) <= ( $time - $dayoffset ) );
        if ( !(open( $FLogFile, '<', "$File" )) ) {
            sleep 2;
            $ThreadIdleTime{$WorkerNumber} += 2;
            if ( !(open( $FLogFile, '<', "$File" )) ) {
                mlog( 0,
"warning: report is possibly incomplete, because ASSP is unable to open logfile $File"
                ) if $ReportLog;
                $buser->{sum}{html} .=
"<br />\nwarning: report is possibly incomplete, because ASSP is unable to open logfile $File";
                $buser->{sum}{text} .=
"\r\nwarning: report is possibly incomplete, because ASSP is unable to open logfile $File";
                next;
            }
        }
        mlog( 0, "info: searching in logfile $File" ) if $MaintenanceLog >= 2 or $ReportLog >= 2;
        $numfiles++;
        my $fl;
        my $start = time;
        while ( $fl = <$FLogFile> ) {
            if ($BlockMaxSearchTime && time - $start > $BlockMaxSearchTime) {
                mlog(0,"warning: blockreport search in file $File has taken more than 3 minutes - skip the file") if $ReportLog;;
                $buser->{sum}{html} .=
"<br />\nwarning: report is possibly incomplete, because ASSP was skipping some parts of logfile $File";
                $buser->{sum}{text} .=
"\r\nwarning: report is possibly incomplete, because ASSP was skipping some parts of logfile $File";
                last;
            }
            $bytes += length($fl);
            $fl =~ s/\r*\n//go;
            $lines++;
            $address  = '';
            $faddress = '';
            unless (   $toRe
                    && ( ( $date, $address ) = $fl =~ /^($gooddays) .*?\s$IPRe[ \]].*?\sto:\s($toRe)\s\[\s*spam\sfound\s*\]/i)
                   )
            {
                next unless (   $fromRe
                             && ( ( $date, $faddress ) =  $fl =~ /^($gooddays) .*?\s$IPRe[\]]?\s<($fromRe)>/i)
                            );
            }
            if ($address) {
                next if ( $fl =~ m/local\sor\swhitelisted|message\sok/io )
                     || ( $fl =~ m/no\sbad\sattachments/io )
                     || ( $fl =~ m/\[testmode\]/io && ! $allTestMode)
                     || ( $fl =~ m/\[local\]/io )
                     || ( $fl =~ m/\[whitelisted\]/io )
                     || ( $fl =~ m/\[noprocessing\]/io )
                     || ( $fl =~ m/\[lowconfidence\]/io )
                     || ( $fl =~ m/\[tagmode\]/io )
                     || ( $fl =~ m/\[trap\]/io )
                     || ( $fl =~ m/\[collect\]/io )
                     || ( $fl =~ m/\[sl\]/io )
                     || ( $fl =~ m/\[spamlover\]/io )
                     || ( $fl =~ m/\[lowlimit\]/io )
                     || ( $fl =~ m/\[warning\]/io );
                my $match = 0;
                foreach my $re (keys %exceptRe) {
                    if (eval{$address =~ /$re/i;}) {
                        $match = $re;
                        last;
                    }
                }
                if ($match) {
                    if ($fl =~ m/$exceptRe{$match}/i) {
                        my $s = (++$buser->{lc($address)}{filtercount} > 1) ? 's' : '';
                        $buser->{lc($address)}{filter} = $buser->{lc($address)}{filtercount}." line$s skipped on defined filter regex '$exceptRe{$match}'";
                        next;
                    }
                } else {
                    my @res;
                    if ($BlockReportFilter && ((@res) = $fl =~ /($BlockReportFilterRE)/g)) {
                        my $nres = $res[0];
                        unless (scalar @res == 1
                                && $address =~ /\Q$nres\E/i
                                && ! grep(/\*/o,@to)
                               )
                        {
                            my $s = (++$buser->{lc($address)}{filtercount2} > 1) ? 's' : '';
                            $buser->{lc($address)}{filter2} = $buser->{lc($address)}{filtercount2}." line$s skipped on global defined filter regex 'BlockReportFilter'";
                            next;
                        }
                    }
                }
                $fl =~ s/\sto:\s(?:$toRe)//i;
            } else {    # $faddress is OK
                $address = $faddress;
            }

            my $is_admin = 0;
            $is_admin = 1 if $isadmin == 1;
            $is_admin = 1
              if ($isadmin eq 'user' &&
                  (matchSL( $address, 'EmailAdmins', 1 )
                   or lc( $address ) eq lc($EmailAdminReportsTo)
                   or lc( $address ) eq lc($EmailBlockTo)
                  )
                 );
            if (! $is_admin && ! $faddress && ! &localmail($address)) {
                mlog(0,"info: BlockReport ignoring $address - address is not a valid local mail address") if $ReportLog >= 2 && ! $ignoreAddr{ lc($address) };
                $ignoreAddr{ lc($address) } = 1;
                next;
            }
            my $addWhiteHint = (   ($autoAddResendToWhite > 1 && $isadmin)
                                or ($autoAddResendToWhite && $autoAddResendToWhite != 2 && ! $isadmin)
                               ) ? '%5Bdo%20not%5D%20autoadd%20sender%20to%20whitelist' : '';

            my $filename;
            $filename = $1 if $fl =~ s/\-\>\s*([^\r\n]+\Q$maillogExt\E)//i;
            $filename =~ s/\\/\//go;

            my $addFileHint = (   $correctednotspam
                               && $DelResendSpam
                               && $isadmin
                               && $filename =~ /\/$spamlog\//
                              ) ? '%5Bdo%20not%5D%20move%20file%20to%20'.$correctednotspam : '';
            $addFileHint = '%2C' . $addFileHint if $addFileHint && $addWhiteHint;

            my $abase = $base;
            $abase    =~ s/\\/\//go;
            $filename =~ s/^$abase[\\|\/]*//o;
            $fl       =~ s/\s+\[worker_\d+\]//io;
            $fl       =~ s/\s*;\s*$//o;
            $fl =~ s/(\d\d:\d\d:\d\d)\s$uniqueIDPrefix*\-*\d{5}\-\d{5}/$1/i
              unless $faddress;

            my $rawline = $fl;
            my $line;
            $line = &encodeHTMLEntities($fl);

            $fl =~ s{([\x80-\xFF])}{sprintf("=%02X", ord($1))}eog;

            if ( !exists $buser->{ lc($address) }{bgcolor} ) {
                $buser->{ lc($address) }{bgcolor} = '';
            }
            $buser->{ lc($address) }{bgcolor} =
              $buser->{ lc($address) }{bgcolor} eq ' class="odd"'
              ? ''
              : ' class="odd"';
            my $bgcolor = $buser->{ lc($address) }{bgcolor};

            if ( $filename && $eF->( "$base/$filename" )) {
                my ($rs,$bodyhint) = &BlockReportGetFrom("$base/$filename",\$rawline, (! $faddress && ! $NotGreedyWhitelist) );
                $line .= '<span name="tohid" class="addr">&nbsp;<br /></span>' if ($rs || $bodyhint);
                $line .= $rs if $rs;
                if ($bodyhint) {
                    $line .= $bodyhint;
                    $filename = '';
                }
            }
            if ( $filename && $eF->( "$base/$filename" )) {
                my ($ofilename) = $filename =~ /^(.+)\Q$maillogExt\E$/i;
                $ofilename =~ s{([^0-9a-zA-Z])}{sprintf("x%02XX", ord($1))}eog;
                $ofilename = 'RSBM_' . $ofilename . $maillogExt;
                $filename =~ normHTML($filename);
                if ( $inclResendLink == 1 or $inclResendLink == 3 ) {
                    push( @{ $buser->{ lc($address) }{text} },
"\r\n$fl\r\nTo get this email, send an email to - mailto:$ofilename$EmailBlockReportDomain\r\n" .
($is_admin ? "to open the mail use :   $prot:\/\/$host:$webAdminPort\/edit?file=$filename\&note=m\&showlogout=1\r\n" : '')
                    );
                } else {
                    push( @{ $buser->{ lc($address) }{text} }, "\r\n$fl\r\n" );
                }
                if ( $inclResendLink == 2 or $inclResendLink == 3 ) {
                    $line =~
s/($gooddays)($timeformat)/<span class="date"><a href="$prot:\/\/$host:$webAdminPort\/edit?file=$filename&note=m&showlogout=1" target="_blank" title="open this mail in the assp fileeditor">$1$2<\/a><\/span>/ if $is_admin;
                    $line =~
s/(\[OIP: )?($IPRe)(\])?/my($p1,$e,$p2)=($1,$2,$3);($e!~$IPprivate)?"<span name=\"tohid\" class=\"ip\"><a href=\"$prot:\/\/$host:$webAdminPort\/ipaction?ip=$e\&showlogout=1\" target=\"_blank\" title=\"take an action via web on ip $e\">$p1$e$p2<\/a><\/span>":"<span name=\"tohid\">$p1$e$p2<\/span>";/goe if $is_admin;
                    $line =~
s/($EmailAdrRe\@$EmailDomainRe)/<a href="mailto:$EmailWhitelistAdd$EmailBlockReportDomain\?subject=add\%20to\%20whitelist&body=$1\%0D\%0A" title="add this email address to whitelist" target="_blank">$1<\/a>/go
                      if (! $faddress && ! $is_admin);
                    $line =~
s/($EmailAdrRe\@$EmailDomainRe)/<a href="mailto:$EmailWhitelistAdd$EmailBlockReportDomain\?subject=add\%20to\%20whitelist&body=$1\%0D\%0A" title="add this email address to whitelist" target="_blank">$1<\/a>&nbsp;<a href="$prot:\/\/$host:$webAdminPort\/addraction?address=$1&showlogout=1" target="_blank" title="take an action via web on address $1">\@<\/a>/go
                      if (! $faddress && $is_admin);
                    $line =~ s/\[spam found\](\s*\(.*?\))( \Q$subjectStart\E)/<span name="tohid"><br \/><span class="spam">spam reason: <\/span>$1<\/span>$2/;
                    $line =~ s/($SpamTagRE|\[(?:TLS-(?:in|out)|SSL-(?:in|out)|PersonalBlack)\])/<span name="tohid">$1<\/span>/gio;
                    my $leftbut = '<a href="mailto:'.$EmailBlockReport.$EmailBlockReportDomain.'?subject=request%20ASSP%20to%20resend%20blocked%20mail%20from%20ASSP-host%20'.$myName.'&body=%23%23%23'.$filename.'%23%23%23'.$addWhiteHint.$addFileHint.'%0D%0A" class="reqlink" target="_blank" title="request ASSP on '.$myName.' to resend this blocked email"><img src=cid:1000 alt="request ASSP on '.$myName.' to resend this blocked email"> Resend </a>';
                    my $rightbut = '<a href="mailto:'.$ofilename.$EmailBlockReportDomain.'?&subject=request%20ASSP%20to%20resend%20blocked%20mail%20from%20ASSP-host%20'.$myName.'" class="reqlink" target="_blank" title="request ASSP on '.$myName.' to resend this blocked email"><img src=cid:1000 alt="request ASSP on '.$myName.' to resend this blocked email"> Resend </a>';
                    $rightbut = '' if (&matchSL(\@to,'BlockResendLinkLeft') or
                                             ($BlockResendLink == 1 && ! matchSL(\@to,'BlockResendLinkRight')));
                    $leftbut = '' if (&matchSL(\@to,'BlockResendLinkRight') or
                                             ($BlockResendLink == 2 && ! matchSL(\@to,'BlockResendLinkLeft')));
                    $line =~ s/^(.+\)\s*)(\Q$subjectStart\E.+?\Q$subjectEnd\E.*)$/$1<br\/><strong>$2<\/strong>/ unless $faddress;
                    $line =~ s/(.*)/\n<tr$bgcolor>\n<td class="leftlink">$leftbut\n<\/td>\n<td class="inner">$1\n<\/td>\n<td class="rightlink">$rightbut\n<\/td>\n<\/tr>/o;
                    push( @{ $buser->{ lc($address) }{html} }, $line);
                } else {
                    $line =~ s/\[spam found\](\s*\(.*?\))( \Q$subjectStart\E)/<span name="tohid"><br \/><span class="spam">spam reason: <\/span>$1<\/span>$2/;
                    $line =~ s/($SpamTagRE|\[(?:TLS-(?:in|out)|SSL-(?:in|out)|PersonalBlack)\])/<span name="tohid">$1<\/span>/gio;
                    $line =~
s/(\[OIP: )?($IPRe)(\])?/my($p1,$e,$p2)=($1,$2,$3);($e!~$IPprivate)?"<span name=\"tohid\" class=\"ip\"><a href=\"$prot:\/\/$host:$webAdminPort\/ipaction?ip=$e\&showlogout=1\" target=\"_blank\" title=\"take an action via web on ip $e\">$p1$e$p2<\/a><\/span>":"<span name=\"tohid\">$p1$e$p2<\/span>";/goe if $is_admin;
                    $line =~
s/($EmailAdrRe\@$EmailDomainRe)/<a href="mailto:$EmailWhitelistAdd$EmailBlockReportDomain\?subject=add\%20to\%20whitelist&body=$1\%0D\%0A" title="add this email address to whitelist" target="_blank">$1<\/a>/go
                      if (! $faddress && ! $is_admin);
                    $line =~
s/($EmailAdrRe\@$EmailDomainRe)/<a href="mailto:$EmailWhitelistAdd$EmailBlockReportDomain\?subject=add\%20to\%20whitelist&body=$1\%0D\%0A" title="add this email address to whitelist" target="_blank">$1<\/a>&nbsp;<a href="$prot:\/\/$host:$webAdminPort\/addraction?address=$1&showlogout=1" target="_blank" title="take an action via web on address $1">\@<\/a>/go
                      if (! $faddress && $is_admin);
                    $line =~ s/^(.+\)\s*)(\Q$subjectStart\E.+?\Q$subjectEnd\E.*)$/$1<br\/><strong>$2<\/strong>/ unless $faddress;
                    $line =~ s/(.*)/\n<tr$bgcolor>\n<td class="leftlink">&nbsp;\n<\/td>\n<td class="inner">$1\n<\/td>\n<td class="rightlink">&nbsp;\n<\/td>\n<\/tr>/o;
                    push( @{ $buser->{ lc($address) }{html} }, $line );
                }
            } else {
                push( @{ $buser->{ lc($address) }{text} }, "\r\n$fl\r\n");
                $line =~ s/\[spam found\](\s*\(.*?\))( \Q$subjectStart\E)/<span name="tohid"><br \/><span class="spam">spam reason: <\/span>$1<\/span>$2/;
                $line =~ s/($SpamTagRE|\[(?:TLS-(?:in|out)|SSL-(?:in|out)|PersonalBlack)\])/<span name="tohid">$1<\/span>/gio;
                $line =~
s/(\[OIP: )?($IPRe)(\])?/my($p1,$e,$p2)=($1,$2,$3);($e!~$IPprivate)?"<span name=\"tohid\" class=\"ip\"><a href=\"$prot:\/\/$host:$webAdminPort\/ipaction?ip=$e\&showlogout=1\" target=\"_blank\" title=\"take an action via web on ip $e\">$p1$e$p2<\/a><\/span>":"<span name=\"tohid\">$p1$e$p2<\/span>";/goe if $is_admin;
                $line =~
s/($EmailAdrRe\@$EmailDomainRe)/<a href="mailto:$EmailWhitelistAdd$EmailBlockReportDomain\?subject=add\%20to\%20whitelist&body=$1\%0D\%0A" title="add this email address to whitelist" target="_blank">$1<\/a>/go
                  if (! $faddress && ! $is_admin);
                $line =~
s/($EmailAdrRe\@$EmailDomainRe)/<a href="mailto:$EmailWhitelistAdd$EmailBlockReportDomain\?subject=add\%20to\%20whitelist&body=$1\%0D\%0A" title="add this email address to whitelist" target="_blank">$1<\/a>&nbsp;<a href="$prot:\/\/$host:$webAdminPort\/addraction?address=$1&showlogout=1" target="_blank" title="take an action via web on address $1">\@<\/a>/go
                  if (! $faddress && $is_admin);
                $line =~ s/^(.+\)\s*)(\Q$subjectStart\E.+?\Q$subjectEnd\E.*)$/$1<br\/><strong>$2<\/strong>/ unless $faddress;
                $line =~ s/(.*)/\n<tr$bgcolor>\n<td class="leftlink">&nbsp;\n<\/td>\n<td class="inner">$1\n<\/td>\n<td class="rightlink">&nbsp;\n<\/td>\n<\/tr>/o;
                push( @{ $buser->{ lc($address) }{html} }, $line );
            }
        }
        close $FLogFile;
    }
    while ( my ($ad,$v) = each %$buser ) {
        next if ( $ad eq 'sum' );
        push( @{ $buser->{$ad}{html} }, "\n</table>\n<br />\n");
        delete $buser->{$ad}{bgcolor};
        if (exists $buser->{$ad}{filtercount}) {
            push( @{ $buser->{$ad}{html} },"<br />\n".$buser->{$ad}{filter}."<br />\n");
            push( @{ $buser->{$ad}{text} },"\r\n\r\n".$buser->{$ad}{filter}."\r\n");
            $buser->{$ad}{correct}--;
        }
        if (exists $buser->{$ad}{filtercount2}) {
            push( @{ $buser->{$ad}{html} },"<br />\n") unless exists $buser->{$ad}{filtercount};
            push( @{ $buser->{$ad}{html} },$buser->{$ad}{filter2}."<br />\n");
            push( @{ $buser->{$ad}{text} },"\r\n\r\n") && $buser->{$ad}{correct}-- unless exists $buser->{$ad}{filtercount};
            push( @{ $buser->{$ad}{text} },$buser->{$ad}{filter2}."\r\n");
            $buser->{$ad}{correct}--;
        }
        delete $buser->{$ad}{filter};
        delete $buser->{$ad}{filtercount};
        delete $buser->{$ad}{filter2};
        delete $buser->{$ad}{filtercount2};
    }
    $bytes                    = formatDataSize( $bytes, 1 );
    $runtime                  = time - $runtime;
    $buser->{sum}{mimehead}     = $mimehead;
    $buser->{sum}{mimebot}      = $mimebot;
    $buser->{sum}{textparthead} = $textparthead;
    $buser->{sum}{htmlparthead} = $htmlparthead;
    $buser->{sum}{htmlhead}     = $htmlhead;

    $buser->{sum}{html} .= "\n".<<'EOT';
<input type="button" name="toggle" value="toggle view" onclick="show=((show=='none')?'inline':'none');changeview(show);return false;"
 title="click the button to simplify or to extend the BlockReport view - requires javascript to be enabled in your mail clients HTML view">
<br />
EOT
    my ($t10html,$t10text);
    if ($DoT10Stat && $isadmin == 1) {
        ($t10html,$t10text) = T10StatOut();
        my $ire = qr/^(?:$IPRe|[\d\.]+)$/o;
        $t10html =~ s/((?:$EmailAdrRe\@)?$EmailDomainRe)/my$e=$1;($e!~$ire)?"<a href=\"$prot:\/\/$host:$webAdminPort\/addraction?address=$e\&showlogout=1\" target=\"_blank\" title=\"take an action via web on address $e\">$e<\/a>":$e/goe;
        $t10html =~ s/($IPRe)/my$e=$1;($e!~$IPprivate)?"<a href=\"$prot:\/\/$host:$webAdminPort\/ipaction?ip=$e\&showlogout=1\" target=\"_blank\" title=\"take an action via web on ip $e\">$e<\/a>":$e;/goe;
    }
    if ( matchSL( $this->{mailfrom}, 'EmailAdmins', 1 )
        or lc( $this->{mailfrom} ) eq lc($EmailAdminReportsTo)
        or lc( $this->{mailfrom} ) eq lc($EmailBlockTo) )
    {
        $buser->{sum}{html} .= $t10html . "<br />\n<div name=\"tohid\">" . &needEs($lines, ' line','s') . " with $bytes analysed in " .
            &needEs($numfiles,' logfile','s') . " on host $myName in $runtime seconds - running ASSP version $MAINVERSION<br /></div>\n";
        $buser->{sum}{text} .= $t10text . "\r\n\r\n" . &needEs($lines, ' line','s') . " with $bytes analysed in " .
            &needEs($numfiles,' logfile','s') . " on host $myName in $runtime seconds - running ASSP version $MAINVERSION\r\n";
    } else {
        $buser->{sum}{html} .= "\n".<<'EOT';
<script type="text/javascript">
<!--
show = "none";
changeview(show);
// -->
</script>
EOT
    }
    $buser->{sum}{html} .= "</body>\n</html>\n";
    return;
}

sub BlockReportFormatAddr {
    return join('|', map {my $t = $_;
                          $t =~ s/([^*]+)\@/quotemeta($1).'@'/oe;
                          $t =~ s/\@([^*]+)/'@'.quotemeta($1)/oe;
                          $t =~ s/\@/\\@/;
                          $t =~ s/\*(\\\@)/$EmailAdrRe$1/o;
                          $t =~ s/\@\*/\@$EmailDomainRe/o;
                          $t;} @_);
}

sub BlockReportGetFrom {
    my ($fn,$fl,$showaddr) = @_;
    my $res;
    my $bodyhint;
    my $foundbody;
    my $headerseen;
    return unless ($open->(my $F,'<' ,$fn));
    while (<$F>) {
        s/\r|\n//go;
        $headerseen = 1 if (! $_);  # header only
        if ($headerseen && $_) {
            $foundbody = 1;
            last;
        }
        next unless $showaddr;
        my ($tag,$adr);
        ($tag,$adr) = ($1,$2) if /^(from|sender|reply-to|errors-to|list-\w+:)[^\r\n]*?($EmailAdrRe\@$EmailDomainRe)/io;
        next unless ($tag && $adr);
        next if $$fl =~ /\Q$adr\E/i;
        $tag = &encHTMLent(\$tag);
        $adr = &encHTMLent(\$adr);
        $res .= '<span name="tohid" class="addr"><br />'. $tag . '&nbsp;&nbsp;' . $adr . '</span>';
    }
    $F->close;
    $bodyhint = '<br /><small>no message body received</small>' unless $foundbody;
    return ($res,$bodyhint);
}

# wrap long html lines in BlockReport
sub BlockReportHTMLTextWrap {
    my $line=shift;
    d('BlockReportHTMLTextWrap');
    return unless $line;

    $line =~ s/\r//go;
    $line =~ s/ +/ /go;
    $line = MIME::QuotedPrint::encode_qp($line);
    $line =~ s/(^|\n)\./$1=2E/gos;
    return $line;
}

sub BlockReport {
    my ( $fh, $l ) = @_;
    my $this = $Con{$fh};
    if ( $l =~ /^ *DATA/io || $l =~ /^ *BDAT (\d+)/io ) {
        if ($1) {
            $this->{bdata} = $1;
        } else {
            delete $this->{bdata};
        }
        $this->{getline} = \&BlockReportBody2Q;
        my $report = 'blocked email report';
        sendque( $fh, "354 OK Send $report body\r\n" );
        $this->{lastcmd} = 'DATA';
        push( @{ $this->{cmdlist} }, $this->{lastcmd} ) if $ConnectionLog >= 2;
        return;
    } elsif ( $l =~ /^ *RSET/io ) {
        stateReset($fh);
        $this->{getline} = \&getline;
        sendque( $this->{friend}, "RSET\r\n" );
        $this->{lastcmd} = 'RSET';
        push( @{ $this->{cmdlist} }, $this->{lastcmd} ) if $ConnectionLog >= 2;
        return;
    } elsif ( $l =~ /^ *QUIT/io ) {
        stateReset($fh);
        $this->{getline} = \&getline;
        sendque( $this->{friend}, "QUIT\r\n" );
        $this->{lastcmd} = 'QUIT';
        push( @{ $this->{cmdlist} }, $this->{lastcmd} ) if $ConnectionLog >= 2;
        return;
    } elsif ( $l =~ /^ *XEXCH50 +(\d+)/io ) {
        d("XEXCH50 b=$1");
        sendque( $fh, "504 Need to authenticate first\r\n" );
        $this->{lastcmd} = 'XEXCH50';
        push( @{ $this->{cmdlist} }, $this->{lastcmd} ) if $ConnectionLog >= 2;
        return;
    }
    sendque( $fh, "250 OK\r\n" );
}

sub BlockReportForwardRequest {
    my ($fh, $host) = @_;
    my $this = $Con{$fh};
    d("BlockReportForwardRequest - $host");
    
    if ( $BlockRepForwHost && ! $CanUseNetSMTP ) {
        mlog(0,"error: unable to forward blocked mail request - module Net::SMTP is not installed and/or enabled") if $ReportLog;
        return;
    }
    
    if ( $BlockRepForwHost && $CanUseNetSMTP ) {
        my $smtp;
        my $MTAip;
        my $port;
        my $ip;
        my $hostip;
        my $fwhost = $BlockRepForwHost;

        $host =~ s/\s//go;
        if ($host && $host !~ /$IPRe/o ) {
            eval {
                my $pip = gethostbyname($host);
                if ( defined $pip ) {
                    $hostip = inet_ntoa($pip);
                }
            };
            mlog( 0,"info: forwarding blocked mail request - resolved ip $hostip for host $host") if $ReportLog >= 2;
        }

        if ( ($hostip && $BlockRepForwHost =~ /\s*(\Q$hostip\E)\s*:\s*(\d+)\s*/i) or
             ($host && $BlockRepForwHost =~ /\s*(\Q$host\E)\s*:\s*(\d+)\s*/i) ) {
                $fwhost = "$1:$2";
                mlog( 0,"info: got forwarding blocked mail request from $this->{mailfrom} to host $fwhost") if $ReportLog >= 2;
        }

        foreach my $MTA ( split( /\s*\|\s*/o, $fwhost ) ) {
            $MTA =~ s/\s//go;
            ( $MTAip, $port ) = split( /\:/o, $MTA );
            if ( $MTAip !~ /$IPRe/o ) {
                eval {
                    my $pip = gethostbyname($MTAip);
                    $ip = inet_ntoa($pip) if ( defined $pip );
                };
            }
            $MTAip = $ip ? $ip : $MTAip;
            if ( $this->{ip} eq $MTAip or $this->{cip} eq $MTAip ) {
                mlog( 0,"info: skip forwarding blocked mail request from $this->{mailfrom} to host $MTA - request comes from this host")
                  if $ReportLog >= 2;
                next;
            }
            eval {
                $smtp = Net::SMTP->new(
                    $MTA,
                    Hello   => $myName,
                    Timeout => 120 # 120 is the default in Net::SMTP
                );
                if ($smtp) {
                    $smtp->mail( $this->{mailfrom} );
                    $smtp->to( $this->{rcpt} );
                    $smtp->data();
                    my $timeout = (int(length($this->{header}) / (1024 * 1024)) + 1) * 60; # 1MB/min
                    my $blocking = $smtp->blocking(0);
                    my $data = $this->{header};
                    $data =~ s/\.[\r\n]+$//o;
                    NoLoopSyswrite($smtp, $data, $timeout);
                    $smtp->blocking($blocking);
                    $smtp->dataend();
                    $smtp->quit;
                }
            };
            if ( $smtp && !$@ ) {
                mlog( 0,"info: forwarded blocked mail request from $this->{mailfrom} to host $MTA") if $ReportLog >= 2;
            } else {
                mlog( 0,"error: unable to forward blocked mail request from $this->{mailfrom} to host $MTA - $@") if $ReportLog;
            }
        }
    }
}

sub BlockReportBody2Q {
    my ( $fh, $l ) = @_;
    my $this = $Con{$fh};
    my $host;
    d('BlockReportBody2Q');

    $this->{header} .= $l;
    if ( $l =~ /^\.[\r\n]/o || defined( $this->{bdata} ) && $this->{bdata} <= 0 )
    {
        if ( !$CanUseEMM ) {
            mlog( 0,"info: module Email::MIME is not installed and/or enabled - local blockreport is impossible") if $ReportLog;
            BlockReportForwardRequest($fh,$host);
            stateReset($fh);
            $this->{getline} = \&getline;
            sendque( $this->{friend}, "RSET\r\n" );
            return;
        }
        my $parm = "$this->{mailfrom}\x00$this->{rcpt}\x00$this->{ip}\x00$this->{cip}\x00$this->{header}";
        &cmdToThread( 'BlockReportFromQ', $parm );
        mlog( 0,"info: queued blocked mail request from $Con{$fh}->{mailfrom}")
          if $ReportLog >= 2 or $MaintenanceLog;

        $Email::MIME::ContentType::STRICT_PARAMS = 0;    # no output about invalid CT
        my $email = Email::MIME->new($this->{header});
        my $sub = $email->header("Subject") || '';    # get the subject of the email
        $sub =~ s/\r?\n//go;

        ($host) = $sub =~ /ASSP\-host\s+(.*)/io;
        $host =~ s/\s//go;

        BlockReportForwardRequest($fh,$host) if ( lc($myName) ne lc($host) );

        stateReset($fh);
        $this->{getline} = \&getline;
        sendque( $this->{friend}, "RSET\r\n" );
    }
}

sub BlockReportGenSched {
    my ($filename) = $BlockReportFile =~ /file:(.+)/io;
    my @files;
    push @files, $filename if $filename;
#    push @files, "files/UserBlockReportQueue.txt" if -e "$base/files/UserBlockReportQueue.txt";
    return unless @files;
    while ($filename = shift @files) {
        $filename = "$base/$filename";
        (open my $brfile,'<' ,"$filename") or next;
        my @lines = <$brfile>;
        close $brfile;
        while (@lines) {
            my $line = shift @lines;
            $line =~ s/#.*//o;
            $line =~ s/[\r\n]//og;
            next unless $line;
            my ($ad, $bd, $cd, $dd, $ed) = split(/=>/o,$line);
            next unless $ed;
            BlockReportAddSched($line);
        }
    }
}

sub BlockReportAddSched {
    my $parm = shift;
    $parm =~ s/#.*//o;
    my ($ad, $bd, $cd, $dd, $ed) = split(/=>/o,$parm);
    addSched($ed,'BlockReportFromSched','BlockReport',"$ad=>$bd=>$cd=>$dd");
}

sub BlockReportFromSched {
    my $parm = shift;
    open( my $tmpfh, '<', \$parm );
    $Con{$tmpfh} = {};
    BlockReportGen( '1', $tmpfh );
    delete $Con{$tmpfh};
}

sub BlockReportFromQ {
    my $parm = shift;
    my $fh = Time::HiRes::time();    # a dummy $fh for a dummy $Con{$fh}
    $Con{$fh} = {};

    (   $Con{$fh}->{mailfrom},
        $Con{$fh}->{rcpt},
        $Con{$fh}->{ip},
        $Con{$fh}->{cip},
        $Con{$fh}->{header}
    ) = split( /\x00/o, $parm );
    $Con{$fh}->{blqueued} = 1;
    mlog( 0,"info: processing queued blocked mail request from $Con{$fh}->{mailfrom}")
      if $ReportLog >= 2 or $MaintenanceLog;
    &BlockReportBody( $fh, ".\r\n" );
    delete $Con{$fh};
}

sub BlockReportBody {
    my ( $fh, $l ) = @_;
    my $this = $Con{$fh};
    my $sub;
    my $host;
    my %resendfile = ();
    my $forcelist;    # $this->{blqueued} is set, if V2 has queued
                      # the report to MaintThread
    my $BlModify;
    d('BlockReportBody');
    if (eval('use BlockReport::modify; BlockReport::modify::modify(); 1;')) {
        mlog(0,"info: BlockReport will call the module BlockReport::modify to make your custom changes") if $ReportLog > 1;
        $BlModify = \&BlockReport::modify::modify;
    } else {
        mlog(0,"info: BlockReport was unable to call the module BlockReport::modify - $@") if $ReportLog > 2;
        $BlModify = sub {return shift;};
    }
    $EmailBlockReportDomain = '@' . $EmailBlockReportDomain
      if $EmailBlockReportDomain !~ /^\@/o;
    eval {
        $this->{header} .= $l unless $this->{blqueued};
        if ( $l =~ /^\.[\r\n]/o
            || defined( $this->{bdata} ) && $this->{bdata} <= 0 )
        {

            if ( !$CanUseEMM ) {
                mlog( 0,"info: module Email::MIME is not installed and/or enabled - local blockreport is impossible") if $ReportLog;
                BlockReportForwardRequest($fh,$host);
                stateReset($fh);
                $this->{getline} = \&getline;
                sendque( $this->{friend}, "RSET\r\n" );
                return;
            }
            matchSL( $this->{mailfrom}, 'EmailAdmins' );
            $Email::MIME::ContentType::STRICT_PARAMS =  0;    # no output about invalid CT
            my $email = Email::MIME->new($this->{header});
            $sub = $email->header("Subject") || '';    # get the subject of the email
            $sub =~ s/\r?\n//go;
            $sub =~ s/\s+/ /go;

            #        mlog(0,"subject: $sub");
            ($host) = $sub =~ /ASSP\-host\s+(.*)/io;
            $host =~ s/\s//go;

            #       mlog(0,"host: $host");
            foreach my $part ( $email->parts ) {
                my $dis = $part->header("Content-Type") || '';        # get the charset of the email part
                my $attrs = $dis =~ s/^[^;]*;//o ? Email::MIME::ContentType::_parse_attributes($dis) : {};
                my $cs = $attrs->{charset} || $part->{ct}{attributes}{charset};
                my $body = $part->body;
                if ($cs) {
                    $cs = Encode::resolve_alias(uc($cs));
                    $body = Encode::decode($cs,$body);
                    $body = e8($body);
                } else {
                    mlog(0,"warning: no valid charset found in MIME part") if $ReportLog > 1;
                }
                #           mlog(0,"BODY:\n$body\n");
                my $preline;
                foreach my $line ( split( /\n/o, $body ) ) {
                    $line =~ s/\r?\n//go;
                    $line      = decodeHTMLEntities($line);
                    my $restrict;
                    my $requdom;
                    $forcelist = 1
                      if (
                        $line =~ /^\s*(\[?$EmailAdrRe|\*)\@($EmailDomainRe\]?|\*)\s*\=\>/o
                        && ($requdom = "$1\@$2")
                        && (   matchSL( $this->{mailfrom}, 'EmailAdmins', 1 )
                            or lc( $this->{mailfrom} ) eq lc($EmailAdminReportsTo)
                            or lc( $this->{mailfrom} ) eq lc($EmailBlockTo) )
                      );

                    if (   $forcelist
                        && exists $EmailAdminDomains{lc $this->{mailfrom}}
                        && ($restrict = $EmailAdminDomains{lc $this->{mailfrom}})
                        && $requdom
                        && $requdom !~ /$restrict/i)
                    {
                        mlog(0,"warning: the EmailAdmin '$this->{mailfrom}' has requested a not allowed BlockReport - $line");
                        return;
                    }

                    if ( ( $line =~ /###/o or $preline ) && $line !~ /###/o )
                    {
                        $preline .= $line;
                        next;
                    }
                    if ($preline) {
                        $line    = $preline . $line;
                        $preline = '';
                    }
                    my ($fname,$special) = $line =~ /###(.*)?###(.*)$/o;
                    if ($fname) {
                        $fname =~ s/\r?\n//go;
                        $fname = "$base/$fname";
                        $special =~ s/\r?\n//go;
                        $special ||= 0;
                        $resendfile{$fname} = $special if ! $resendfile{$fname};
                    }
                }
            }
            if ( $this->{rcpt} =~
                /^(RSBM)_(.+?)\Q$maillogExt\E\Q$EmailBlockReportDomain\E\s*$/i )
            {
                my $rfile = $2;
                mlog(0,"warning: the recipient address '$this->{rcpt}' was changed to lower case - this is a wrong behavior - assp will be possibly unable to find the requested file on nix systems") if $1 eq 'rsbm' && $ReportLog >= 2;
                $rfile =~ s/x([0-9a-fA-F][0-9a-fA-F])X/pack('C',hex($1))/geoi;
                $rfile = "$base/$rfile$maillogExt";
                $resendfile{$rfile} = 0;
                $sub .= ' resend ' if $sub !~ /resend/io;
            }
            if ( $sub =~ /\sresend\s/io or scalar( keys %resendfile ) ) {
                foreach my $rfile ( keys %resendfile ) {

#               mlog(0,"info: resend filename - $rfile on host - $host to $this->{mailfrom}");
                    if ( (! $host || ( lc($myName) eq lc($host) )) && $resendmail && $CanUseEMS) {
                        mlog( 0,"info: got resend blocked mail request from $this->{mailfrom} for $rfile")
                          if $ReportLog >= 2;
                        &BlockedMailResend( $fh, $rfile , $resendfile{$rfile});
                    }
                }
                mlog( 0,"error: got resend blocked mail request from $this->{mailfrom} without valid filename")
                  if ( !scalar( keys %resendfile ) && $ReportLog );
                if ( ! $forcelist ) {
                    BlockReportForwardRequest($fh,$host) if ( ! $this->{blqueued} && lc($myName) ne lc($host) );
                    stateReset($fh);
                    $this->{getline} = \&getline;
                    sendque( $this->{friend}, "RSET\r\n" );
                    eval('no BlockReport::modify;');
                    return;
                }
            }

            if ($forcelist) {
                my $body;
                my %lines = ();
                mlog( 0,"info: got blocked mail report for a user list from $this->{mailfrom}")
                  if $ReportLog >= 2;
                foreach my $part ( $email->parts ) {
                    my $mbody = decodeHTMLEntities( $part->body );
                    while ( $mbody =~
                        /(.*?)((\[?$EmailAdrRe|\*)\@($EmailDomainRe\]?|\*).*)/go )
                    {
                        my $line = $2;
                        $line =~ s/\r?\n//go;
                        $line =~ s/<[^\>]*>//go;
                        my ( $ad, $bd, $cd, $dd) = split( /\=\>/o, $line );
                        $ad =~ s/\s//go;
                        $bd =~ s/\s//go;
                        $cd =~ s/\s*(\d+).*/$1/o;
                        $dd =~ s/^\s*(.*?)\s*$/$1/o;
                        if ( $ad !~ /^(\[?$EmailAdrRe|\*)\@($EmailDomainRe\]?|\*)$/o ) {
                            mlog( 0,"warning: syntax error in $ad, entry was ignored")
                              if $ReportLog;
                            next;
                        }
                        if ( $bd && $bd !~ /^($EmailAdrRe\@$EmailDomainRe|\*)$/o )
                        {
                            mlog( 0,"warning: syntax error in =>$bd, entry was ignored")
                              if $ReportLog;
                            next;
                        }
                        eval{'a' =~ /$dd/i} if $dd;
                        if ( $@ )
                        {
                            mlog( 0,"warning: syntax error in =>$dd, entry was ignored - regex error $@")
                              if $ReportLog;
                            next;
                        }

                        $ad    = lc $ad;
                        $bd    = lc $bd;
                        ($cd)  = $sub =~ /^\s*(\d+)/o  unless $cd;
                        $cd    = 1 unless $cd;
                        $line = "$ad=>$bd=>$cd=>$dd";
                        $body .= "$line\r\n" if ( !exists $lines{$line} );
                        $lines{$line} = 1;
                    }
                }
                if (%lines) {
                    open( my $tmpfh, '<', \$body );
                    $Con{$tmpfh}->{mailfrom} = $this->{mailfrom};
                    BlockReportGen( '1', $tmpfh );
                    delete $Con{$tmpfh};
                }
                if ( !$this->{blqueued} ) {
                    BlockReportForwardRequest($fh,$host) if lc($myName) ne lc($host);
                    stateReset($fh);
                    $this->{getline} = \&getline;
                    sendque( $this->{friend}, "RSET\r\n" );
                }
                eval('no BlockReport::modify;');
                return;
            }

            if ( $sub =~ /^\s*[\-|\+]/o or $QueueUserBlockReports > 0 ) {
                &BlockReportStoreUserRequest( $this->{mailfrom}, $sub, $QueueUserBlockReports );
                if ( !$this->{blqueued} ) {
                    BlockReportForwardRequest($fh,$host) if lc($myName) ne lc($host);
                    stateReset($fh);
                    $this->{getline} = \&getline;
                    sendque( $this->{friend}, "RSET\r\n" );
                }
                eval('no BlockReport::modify;');
                return;
            }

            my ($numdays, $exceptRe) = $sub =~ /^\s*(\d+)\s*(.*)$/o;
            if ($exceptRe) {
                eval{'a' =~ /$exceptRe/i};
                if ($@) {
                    mlog(0,"error: regular expression error in blockreport request - $sub - $@");
                    $exceptRe = '';
                }
            }
            $numdays = 5 unless $numdays;
            my %user;
            &BlockReasonsGet( $fh, $numdays , \%user, $exceptRe);
            my @textreasons;
            my @htmlreasons;

            push( @textreasons, $user{sum}{textparthead} );
            push( @htmlreasons, $user{sum}{htmlparthead} );
            push( @htmlreasons, $user{sum}{htmlhead} );
            foreach  my $ad ( sort keys %user ) {
                next if ( $ad eq 'sum' );
                my $number = scalar @{ $user{$ad}{text} } + $user{$ad}{correct};
                $number = 0 if $number < 0;
                $number = 'no' unless $number;
                push(
                    @textreasons,
                    &BlockReportText('text', $ad, $numdays, $number, $this->{mailfrom})
                  );
                my $userhtml =
                  &BlockReportText( 'html', $ad, $numdays, $number,
                    $this->{mailfrom} );
                push( @htmlreasons,  BlockReportHTMLTextWrap(<<"EOT"));
<table id="report">
 <col /><col /><col />
 <tr>
  <th colspan="3" id="header">
   <img src=cid:1001 alt="powered by ASSP on $myName">
   $userhtml
  </th>
 </tr>
EOT
                while ( @{ $user{$ad}{text} } ) { push( @textreasons, shift @{ $user{$ad}{text} } ); }
                while ( @{ $user{$ad}{html} } ) { push( @htmlreasons, BlockReportHTMLTextWrap(shift @{ $user{$ad}{html} } )); }
            }
            if ( scalar( keys %user ) < 2 ) {
                push( @textreasons,"\nno blocked email found in the last $numdays day(s)\n\n");
                push( @htmlreasons,"\nno blocked email found in the last $numdays day(s)\n\n");
            }
            push( @textreasons, $user{sum}{text} );
            push( @htmlreasons, $user{sum}{html} );

            @textreasons = () if ( $BlockReportFormat == 2 );
            @htmlreasons = () if ( $BlockReportFormat == 1 );

            BlockReportSend(
                $fh,
                $this->{mailfrom},
                $this->{mailfrom},
                &BlockReportText(
                    'sub',    $this->{mailfrom},
                    $numdays, 'n/a',
                    $this->{mailfrom}
                  ),
                $BlModify->($user{sum}{mimehead}
                  . join( '', @textreasons )
                  . join( '', @htmlreasons )
                  . $user{sum}{mimebot})
              ) if ( $EmailBlockReply == 1 || $EmailBlockReply == 3 );

            BlockReportSend(
                $fh,
                $EmailBlockTo,
                $this->{mailfrom},
                &BlockReportText(
                    'sub',    $this->{mailfrom},
                    $numdays, 'n/a',
                    $EmailBlockTo
                  ),
                $BlModify->($user{sum}{mimehead}
                  . join( '', @textreasons )
                  . join( '', @htmlreasons )
                  . $user{sum}{mimebot})
              )
              if ( $EmailBlockTo
                && ( $EmailBlockReply == 2 || $EmailBlockReply == 3 ) );

            if ( !$this->{blqueued} ) {
                BlockReportForwardRequest($fh,$host) if lc($myName) ne lc($host);
                stateReset($fh);
                $this->{getline} = \&getline;
                sendque( $this->{friend}, "RSET\r\n" );
            }
        }
      };    # end eval
      if ($@) {
          mlog( 0,"error: unable to process blockreport - $@") if $ReportLog;
          BlockReportForwardRequest($fh,$host) if ( ! $this->{blqueued} && lc($myName) ne lc($host) );
          stateReset($fh);
          $this->{getline} = \&getline;
          sendque( $this->{friend}, "RSET\r\n" );
          eval('no BlockReport::modify;');
          return;
      }
      eval('no BlockReport::modify;');
}

sub BlockReportStoreUserRequest {
    my ( $from, $sub, $oldrequest ) = @_;
    my $request=$oldrequest;
    my $file = "$base/files/UserBlockReportQueue.txt";
    $file = "$base/files/UserBlockReportInstantQueue.txt" if $oldrequest>=3;

    $request=1 if $oldrequest>=3;
    my %lines = ();
    my ( $user, $to, $numdays, $nextrun, $comment, $exceptRe , $sched);
    my $reply;

    open my $f, '<',"$file";
    while (<$f>) {
        s/\r?\n//igo;
        s/\s*#(.*)//go;
        $comment = $1;
        next unless $_;
        ( $user, $to, $numdays , $exceptRe , $sched) = split( /\=\>/o, $_ );
        next unless $user;
        $comment =~ /^\s*(next\srun\s*\:\s*\d+[\-|\.]\d+[\-|\.]\d+)/o;
        $nextrun               = $1 ? "# $1" : '';
        $user                  = lc($user);
        $numdays               = 5 unless $numdays;
        $lines{$user}{numdays} = $numdays;
        $lines{$user}{nextrun} = $nextrun;
        $lines{$user}{exceptRe} = $exceptRe;
        $lines{$user}{sched} = $sched;
    }
    close $f;
    $from = lc($from);
    $sub =~ /^\s*([+\-])?(?:(?:\s*|\s*=>\s*)(\d+))?(?:(?:\s+|\s*=>\s*)([^\s]+))?(?:(?:\s+|\s*=>\s*)($ScheduleRe(?:\|$ScheduleRe)*))?\s*$/o;
    my $how = $1;
    $numdays = $2 ? $2 : 5;
    $exceptRe = $3;
    $sched = $4;
    if ( $how eq '-' ) {
        if (delete $lines{$from}) {
            mlog( 0, "info: removed entry for $from from block report queue" )
              if $ReportLog >= 2;
            $reply = "your entry $from was removed from the block report queue!\n";
        } else {
            $reply = "an entry $from was not found in the block report queue!\n";
        }
    } else {
        my $time = time;
        my $dayoffset = $time % ( 24 * 3600 );
        $nextrun = $time - $dayoffset + ( 24 * 3600 );
        my (
            $second,    $minute,    $hour,
            $day,       $month,     $yearOffset,
            $dayOfWeek, $dayOfYear, $daylightSavings
        ) = localtime($nextrun);
        my $year = 1900 + $yearOffset;
        $month++;
        $nextrun = "# next run: $year-$month-$day";
        $nextrun = '' if ( $request < 2 && $how ne '+' );

        if ($exceptRe) {
            eval{'a' =~ /$exceptRe/i};
            if ($@) {
                mlog(0,"error: regex error in blockreport request from $from - $sub - $@") if $ReportLog;
                $reply = "Your entry $from was not processed - bad regex found - $@ !\n";

                my $fh = int( rand(time) );    # a dummy $fh for a dummy $Con{$fh}
                $Con{$fh}->{mailfrom} = $from;
                BlockReportSend(
                    $fh,
                    $from,
                    $from,
                    &BlockReportText( 'sub', $from, $numdays, 'n/a', $from )
                      . " - Block Report Queue ",
                    $reply
                );
                delete $Con{$fh};
                return;
            }
        }

   		if ( exists $lines{$from} ) {
            $reply = "Your entry $from was updated in the block report queue!\n";
            mlog( 0, "info: updated entry for $from in block report queue" )
              if $oldrequest <3 && $ReportLog >= 2;
            mlog( 0, "info: updated entry for $from in block report instant queue" )
              if $oldrequest =3 && $ReportLog >= 2;
    	} else {
            $reply = "Your entry $from was added to the block report queue!\n";
            mlog( 0, "info: added entry for $from to block report queue" )
              if $oldrequest <3 && $ReportLog >= 2;
            mlog( 0, "info: added entry for $from to block report instant queue" )
              if $oldrequest =3 && $ReportLog >= 2;
    	}
        $lines{$from}{numdays} = $numdays;
        $lines{$from}{nextrun} = $nextrun;
        $lines{$from}{exceptRe} = $exceptRe;
        $lines{$from}{sched} = $sched;
    }
    my $time = time;
    open $f, '>',"$file";
    while ( !($f->opened) && time - $time < 10 ) { sleep 1; $ThreadIdleTime{$WorkerNumber} += 1 ;open $f, '>',"$file"; }
    if ($f->opened) {
        binmode $f;
        foreach my $line ( sort keys %lines ) {
            $lines{$line}{exceptRe} =~ s/^\s*(.*?)\s*$/$1/o;
            print $f $line . '=>'
              . $line . '=>'
              . $lines{$line}{numdays} . '=>'
              . $lines{$line}{exceptRe} . ($lines{$line}{sched} ? '=>' : ' ')
              . $lines{$line}{sched}
              . ($lines{$line}{sched} ? ' ' : '')
              . $lines{$line}{nextrun} . "\n";
        }
        close $f;
    } else {
        $reply =~ s/ was / was not /o;
        $reply .= " Internal write error, please contact your email admin!";
        mlog( 0,"error: unable to open $file for write within 10 seconds - entry for $from not updated" )
          if $ReportLog;
    }
    my $fh = int( rand(time) );    # a dummy $fh for a dummy $Con{$fh}
    $Con{$fh}->{mailfrom} = $from;
    BlockReportSend(
        $fh,
        $from,
        $from,
        &BlockReportText( 'sub', $from, $numdays, 'n/a', $from )
          . " - Block Report Queue ",
        $reply
    ) if $oldrequest < 3;
    delete $Con{$fh};
}


sub BlockReportText {
    my ( $what, $for, $numdays, $number, $from ) = @_;
    my $file = "$base/reports/blockreport_$what.txt";
    my $text;
    my %slines = ();
    my $f;
    my $section;
    $for  = lc($for);
    $from = lc($from);
    my ($domain) = $for =~ /$EmailAdrRe\@($EmailDomainRe)/o;

    return "report text file $file not found" unless ( open $f, '<',"$file" );
    while (<$f>) {
        next if /^\s*#/o;
        if (/^\s*<([^\/]+)>/o && !$section) {
            $section = lc($1);
        } elsif ( $section && /^\s*<\/$section>/i ) {
            $section = '';
        } elsif ($section) {
            s/REPORTDAYS/$numdays/go;
            s/ASSPNAME/$myName/go;
            s/EMAILADDRESS/$for/go;
            s/NUMBER/$number/go;
            $slines{$section} .= $_;
        }
    }
    close $f;

    $text .= $slines{'all'} if $slines{'all'};
    if (   matchSL( $from, 'EmailAdmins', 1 )
        or lc($from) eq lc($EmailAdminReportsTo)
        or lc($from) eq lc($EmailBlockTo) )
    {
        $text .= $slines{'admins'} if $slines{'admins'};
    } else {
        $text .= $slines{'users'} if $slines{'users'};
    }

    if ( $slines{$for} ) {
        $text .= $slines{$for};
    } elsif ( $slines{$domain} or $slines{ '@' . $domain } ) {
        $text .= $slines{$domain};
        $text .= $slines{ '@' . $domain };
    }

    return $text;
}

sub BlockReportGetCSS {
    if (open my $F , '<', "$base/images/blockreport.css") {
        binmode $F;
        my @css = <$F>;
        close $F;
        @css = map {my $t = $_; $t =~ s/\/\*.*?\*\///so; $t =~ s/^\s*\r?\n//o; $t;} @css;
        return '<style type="text/css">' . "\n" . join('',@css). "\n" . '</style>';
    } else {
        mlog(0,"warning: BlockReport - unable to open file '$base/images/blockreport.css' - using internal css");
        my $ret = <<'EOF';
<style type="text/css">
/* the general layout of the Block Report */
a {color:#06c;}
a:hover {text-decoration:none;}
#report {font-family:Arial, Helvetica, sans-serif; font-size:12px; color:#333;}
#report table {width:700px; border:0; border-spacing:0; padding:0; table-layout:fixed;}

/* the layout of the header with the image and the text from blockreport_html.txt */
#header {
 background:#4398c6;
 color:#fff;
 font-weight:normal;
 text-align:left;
 border-bottom:1px;
 solid #369;
 white-space: pre-wrap; /* css-3 */
 white-space: -moz-pre-wrap !important; /* Mozilla, since 1999 */
 white-space: -pre-wrap; /* Opera 4-6 */
 white-space: -o-pre-wrap; /* Opera 7 */
 word-wrap: break-word; /* Internet Explorer 5.5+ */
}
/* #header table {width:"100%"; border:0; border-spacing:0; padding:0; table-layout:fixed;} */
/* #header th {background:#4398c6; font-weight:normal; text-shadow:0 1px 0 #0C6FA5;} */
#header strong.title {font-size:16px;}
#header img {width:200px; height:75px; border:0; float:left;}

/* the general column definition */
#report td {
 padding:7px;
 background:#f9f9f9;
 border-top:1px solid #fff;
 border-bottom:1px solid #eee;
 line-height:18px;
}

/* the odd column definition (other color) */
#report tr.odd td {
 background:#e0ebf7;
 border-top:1px solid #fff;
 border-bottom:1px solid #c6dcf2;
}

/* the left resend link column */
#report td.leftlink {width: 30px;}

/* the middle column */
#report td.inner {
 width: 630px;
 white-space: pre-wrap; /* css-3 */
 white-space: -moz-pre-wrap !important; /* Mozilla, since 1999 */
 white-space: -pre-wrap; /* Opera 4-6 */
 white-space: -o-pre-wrap; /* Opera 7 */
 word-wrap: break-word; /* Internet Explorer 5.5+ */
}

/* the right resend link column */
#report td.rightlink {width: 30px;}

/* the title view on hover */
#report td.title {padding:5px; line-height:16px;}
#report td.title strong {font-size:15px;text-shadow:0 1px 0 #0C6FA5;}

/* the date link to open the mail in the browser */
span.date {background:#ddd; padding:1px 2px; color:#555;}
span.date a {color:#333;text-decoration:none;}
span.date a:hover {color:#06c; text-decoration:underline;}

/* the IP link to open the mail in the browser */
span.ip {background:#ddd; padding:1px 2px; color:#555;}
span.ip a {color:#333;text-decoration:none;}
span.ip a:hover {color:#06c; text-decoration:underline;}

/* the 'spam reason'*/
span.spam {color:#b00;}

/* the from and reply to lines*/
span.addr {font-size:10px;text-shadow:0 1px 0 #0C6FA5;}

/* the 'add to whitelist' link */
a.reqlink {color:#06c; font-size:11px;}
a.reqlink img {float:left; margin-right:3px; width:16px; height:16px; border:0;}
</style>
EOF

        $ret =~ s/\/\*.*?\*\///sgo;
        $ret =~ s/(?:\s*\r?\n)/\n/sgo;
        return $ret;
    }
}

sub BlockReportGetImage {
    my $file = shift;
    if ($file =~ /icon/io) {
        -r "$base/images/$file" or
        (mlog(0," BlockReport - unable to open file '$base/images/$file' - using internal image") and return <<'EOT');
R0lGODlhEAAQAPedAEShzke540jB6kfB6ki950SdykWv20a030jB63TR8Uav20e96EecyX+52EWr
1kWl0ky24Eaiz0Odytno8qvQ5d/t9cTo9t/s9EfB68/t+EidyUqcyE/F7kfA6tjp8+Hs9E2l0E7G
7azb78nl8kqw3NXm8Vu02mm63aPW7J7L4kecyL/b64DR7aPY7oTM6YC52ePt9XPR8eXu9fD0+bri
87XV5+Xy+bjg8bjX6brg8ZTD3Uaw27Lf8XLR8Nzq81ulzbHh81aiy3LF5abO5FPC6J/Z77vk9Lbl
9nm42ZHJ43rF5Fylzdjo8VTI7lK54Y7Z88zi73LF5nnE5Ee443TR8Nro8nK32VWx2Xm93l2q0a/S
5kqk0N7r803F7VPF60q/6IXP62q225/d8nnB4fP2+dvp8kOayNvv+Onw9mSp0KLR53jK6vX3+ke+
53/K6NLm8bHj9n3N6lSx2UabyaDM47je78Dc7Euk0HrL6lqkza7a7YW72bni8m2/4cbk8rzY6WvG
6Emw3Pf4+sTe7XzU8nLM7Ei+53TS8HG32dvr86PT6aLP5cPe7X2310u75LDe8XnI59/r86rR5mqu
06HP5U6gy7Te8Ee953TS8UWq1kSl0kOYxk/G7vn5+wAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAA
AAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAAACH5BAEAAJ0ALAAAAAAQABAA
AAjyADMQ6nEoAaaDCBNQiYEJzpEmXThJnCiRA6cQnJ5Y8IIBwQABHz8K6OARgRgbRlgQabOAgEtD
lxZ8KQTkTBFAPPiAcRRgSoCfax7RiIOnxYEDQkTkcOEEQhRLN9xAOAAJhYEdBkj00TPCTx0lgRQY
UCBFUSYHmdI6uGIik5wTaTONUaPpQV1NePGGqZAEL5ZFAAIHjrAFxB1EiTxQimAlhQQJBSLTYTRo
xRsoWexIQoKj0hwGKhiUGNLgRYNJZjRQuMCGC5MJE8qgSbOptu1NNTrp3j2jUZ4fS4LU3iNj925B
MHxE+vBngw4yxqPvrqJld0AAOw==
EOT
    } else {
        -r "$base/images/$file" or $file = 'logo.gif';
    }
    if (open my $F , '<', "$base/images/$file") {
        binmode $F;
        my @img = <$F>;
        close $F;
        return MIME::Base64::encode_base64( join('',@img) );
    } else {
        mlog(0,"warning: BlockReport - unable to open file '$base/images/$file' - no image available");
        return;
    }
}

#####################################################################################
sub ccMail {
    my($fh,$from,$to,$bod,$sub,$rcpt)=@_;
    my $this=$Con{$fh};
    my $s;
    my $AVa;
    $from = batv_remove_tag(0,$from,'');
    return if !$sendHamInbound && !$sendHamOutbound;
    if ($sendHamOutbound && $this->{relayok} && (!$ccHamFilter || allSL($rcpt,$from,'ccHamFilter'))  && ! allSL($rcpt,$from,'ccnHamFilter')) {
        $to=$sendHamOutbound;
    } elsif($sendHamInbound && !$this->{relayok} && (!$ccHamFilter || allSL($rcpt,$from,'ccHamFilter')) && ! allSL($rcpt,$from,'ccnHamFilter')) {
        $to=$sendHamInbound;

    } else {
        return;
    }

    #return if($sub!~/Received/io);

    my ($current_username,$current_domain);
    ($current_username,$current_domain) = ($1,$2) if $rcpt =~/($EmailAdrRe)\@($EmailDomainRe)/o;
    my $cchamlt = $to;
    $cchamlt =~ s/USERNAME/$current_username/go;
    $cchamlt =~ s/DOMAIN/$current_domain/go;

    if ($ccMailReplaceRecpt && $ReplaceRecpt) {
          my $newcchamlt = RcptReplace($cchamlt,$from,'RecRepRegex');
          if (lc $newcchamlt ne lc $cchamlt) {
              $cchamlt = $newcchamlt;
              mlog($fh,"info: ccMail recipient $cchamlt replaced with $newcchamlt");
          }
    }

    my $destination;
    if ($sendAllHamDestination ne '') {
        $destination = $sendAllHamDestination;
    } elsif ($sendAllDestination ne '') {
        $destination = $sendAllDestination;
    } else {
        $destination = $smtpDestination;
    }
    $AVa = 0;
    foreach my $destinationA (split(/\s*\|\s*/o, $destination)) {
        if ($destinationA =~ /^(_*INBOUND_*:)?(\d+)$/o){
            $destinationA = '127.0.0.1:'.$2;
        }
        if ($AVa<1) {
            $s = $CanUseIOSocketINET6
                 ? IO::Socket::INET6->new(Proto=>'tcp',PeerAddr=>$destinationA,Timeout=>2,&getDestSockDom($destinationA))
                 : IO::Socket::INET->new(Proto=>'tcp',PeerAddr=>$destinationA,Timeout=>2);
            if(ref($s)) {
                $AVa=1;
                $destination=$destinationA;
            }
            else {
                mlog(0,"*** $destinationA didn't work, trying others...") if $SessionLog;
            }
        }
    }
    if(! ref($s)) {
        mlog(0,"error: couldn't create server socket to $destination -- aborting  connection ccmail");
        return;
    }
    addfh($s,\&CChelo);
    $this=$Con{$s};
    $this->{to}=$cchamlt;
    $this->{from}=$from;

    local $/="\n";

    $this->{subject}= ref $sub ? $$sub : $sub;
    $this->{subject}=~s/\r?\n?//go;
    undef $/;

    $this->{body} = ref $bod ? $$bod : $bod;
    $this->{body} =~ s/\r?\n/\r\n/gos;
    $this->{body} =~ s/[\r\n\.]$//o;
}

sub CChelo { my ($fh,$l)=@_;
    if($l=~/^ *220 /o) {
        sendque($fh,"HELO $myName\r\n");
        $Con{$fh}->{CClastCMD} = 'HELO';
        $Con{$fh}->{getline}=\&CCfrom;
    } elsif ($l=~/^ *220-/o){
    } else {
        CCabort($fh,"helo Expected 220, got: $l (from:$Con{$fh}->{from} to:$Con{$fh}->{to})");
    }
}
sub CCfrom { my ($fh,$l)=@_;
    if($l=~/^ *250 /o) {
        sendque($fh,"MAIL FROM: ".($Con{$fh}->{from}=~/(<[^<>]+>)/o ?$1:"<$Con{$fh}->{from}>")."\r\n");
        $Con{$fh}->{CClastCMD} = 'MAIL FROM';
        $Con{$fh}->{getline}=\&CCrcpt;
    } elsif ($l=~/^ *250-/o) {
    } else {
        CCabort($fh,"HELO sent, Expected 250, got: $l (from:$Con{$fh}->{from} to:$Con{$fh}->{to})");
    }
}
sub CCrcpt { my ($fh,$l)=@_;
    if($l!~/^ *250/o) {
        CCabort($fh,"MAIL FROM sent, Expected 250, got: $l (from:$Con{$fh}->{from} to:$Con{$fh}->{to})");
    } else {
        sendque($fh,"RCPT TO: <$Con{$fh}->{to}>\r\n");
        $Con{$fh}->{CClastCMD} = 'RCPT TO';
        $Con{$fh}->{getline}=\&CCdata;
    }
}
sub CCdata { my ($fh,$l)=@_;
    if($l!~/^ *250/o) {
        CCabort($fh,"RCPT TO sent, Expected 250, got: $l (from:$Con{$fh}->{from} to:$Con{$fh}->{to})");
    } else {
        sendque($fh,"DATA\r\n");
        $Con{$fh}->{CClastCMD} = 'DATA';
        $Con{$fh}->{getline}=\&CCdata2;
    }
}
sub CCdata2 { my ($fh,$l)=@_;
    my $this=$Con{$fh};
    if($l!~/^ *354/o) {
        CCabort($fh,"DATA sent, Expected 354, got: $l");
    } else {
        $this->{body} =~ s/\r?\n/\r\n/gos;
        $this->{body} =~ s/(?:ReturnReceipt|Return-Receipt-To|Disposition-Notification-To):$HeaderValueRe//gios
            if ($removeDispositionNotification);
        $this->{body} =~ s/[\r\n\.]+$//os;
        sendque($fh,$this->{body} . "\r\n.\r\n");
        mlog($fh,"info: message copied to $this->{to}") if $ConnectionLog;
        $Con{$fh}->{getline}=\&CCquit;
    }
}
sub CCquit { my ($fh,$l)=@_;
    if($l!~/^ *250/o) {
        CCabort($fh,"[CR][LF].[CR][LF] sent, Expected 250, got: $l");
    } else {
        sendque($fh,"QUIT\r\n");
        $Con{$fh}->{CClastCMD} = 'QUIT';
        $Con{$fh}->{getline}=\&CCdone;
        $Con{$fh}->{type} = 'CC';          # start timeout watching for case 221/421 will not be send
        $Con{$fh}->{timelast} = time;
        $Con{$fh}->{nodelay} = 1;
    }
}
sub CCdone { my ($fh,$l)=@_;
    if($l!~/^ *[24]21/o) {
        CCabort($fh,"QUIT sent, Expected 221 or 421, got: $l");
    } else {
        done2($fh); # close and delete
    }
}
sub CCabort {mlog(0,"CCabort: $_[1]"); done2($_[0]);}


#####################################################################################
#                SPAM Detection
# check if the message is spam, based on Bayesian/Hidden-Markov-Model factors in Spamdb
#####################################################################################

sub readNorm {
    return unless $WorkerNumber;
    if (!$lockBayes && exists $Spamdb{'***bayesnorm***'}) {
        $bayesnorm = $Spamdb{'***bayesnorm***'};
        return;
    }
    return if $lockBayes && $bayesnorm;
    if (!$lockHMM && exists $HMMdb{'***bayesnorm***'}) {
        $bayesnorm = $HMMdb{'***bayesnorm***'};
        return;
    }
    open (my $F, '<', "$base/normfile") or return 1;
    binmode $F;
    my @t = split(/ /,join('',<$F>));
    close $F;
    $t[0] ||= 1;
    $bayesnorm = $t[0];
    threads->yield;
}

sub HMMOK {
    my($fh,$msg)=@_;
    d('HMMOK');
    if ($lockHMM) {
        mlog($fh,"HMM is not available - hmmdb is still locked by a rebuild task") if $BayesianLog;
        return 1;
    }
    my $this = $Con{$fh};
    my $DoHMM = $DoHMM;
    $DoHMM = $this->{overwritedo} if ($this->{overwritedo});   # overwrite requ by Plugin
    return 1 if $this->{HMMdone};
    $this->{HMMdone} = 1;
    return 1 if !$DoHMM;
    return ! HMMOK_Run($fh,$msg);
}
sub HMMOK_Run {
    my($fh,$msg)=@_;
    my $this = $Con{$fh};
    d('HMMOK_Run');
    delete $this->{hmmprob};
    $this->{prepend}='';
    $fh = 0 if "$fh" =~ /^\d+$/o;
    return 0 if $this->{whitelisted} && ! $BayesWL;
    return 0 if $this->{noprocessing} && ! $BayesNP;
    if ($lockHMM) {
        mlog($fh,"HMM is not available - hmmdb is still locked by a rebuild task") if $BayesianLog;
        return 0;
    }
    if (! $haveHMM && !($haveHMM = getDBCount('HMMdb','spamdb'))) {
        mlog($fh,"HMM is not available - hmmdb is empty") if $BayesianLog;
        return 0;
    }
    %{$this->{hmmValues}} = () unless $fh;
    my $DoHMM = $DoHMM;    # copy the global to local - using local from this point
    $DoHMM = $this->{overwritedo} if ($this->{overwritedo});   # overwrite requ by Plugin
    my $stime = time;

    my ($bd,$ok);
    if ($fh) {
        eval {
          local $SIG{ALRM} = sub { die "__alarm__\n" };
          alarm($BayesMaxProcessTime + 10);
          ($bd,$ok) = &clean($msg);
          alarm(0);
        };
    } else {
      eval{$bd = $$msg;$ok = 1;};
    }
    if ($@) {
        alarm(0);
        if ( $@ =~ /__alarm__/o ) {
            my $itime = time - $stime;
            mlog( $fh, "HMMOK: timed out after $itime secs.", 1 );
        } else {
            mlog( $fh, "HMMOK: failed: $@", 1 );
        }
    }
    unless ($ok) {
        mlog($fh,"info: HMM-Process-Timeout ($BayesMaxProcessTime s) is reached - HMM Check will only be done on mail header") if ($BayesianLog && time-$stime > $BayesMaxProcessTime);
        my $itime=time-$stime;
        mlog($fh,"info: HMM-Check-Conversion has taken $itime seconds") if $BayesianLog >= 2;
        return 0;
    }

    if(!$this->{whitelisted} && $whiteRe && ($$msg=~/($whiteReRE)/ || $bd=~/($whiteReRE)/)) {
        $this->{whitelisted}=1;
        my ($r1,$r2) = ($1,$2);
        mlogRe($fh,($r1||$r2),"White");
        if (! $BayesWL) {
            $this->{passingreason} = "whiteRe '".($r1||$r2)."'";
            $itime=time-$stime;
            mlog($fh,"info: HMM-Check has taken $itime seconds") if $BayesianLog >= 2;
            $this->{bayesdone} = 1;
            return 0;
        }
    }

    if ($this->{relayok} && (    ( $noBayesian_local   &&   matchSL($this->{mailfrom},'noBayesian_local') )
                              || ( $Bayesian_localOnly && ! matchSL($this->{mailfrom},'Bayesian_localOnly') )
                            )
       )
    {
        mlog($fh,"HMM-Check skipped for local sender") if $BayesianLog>=2;
        $itime=time-$stime;
        mlog($fh,"info: HMM-Check has taken $itime seconds") if $BayesianLog >= 2;
        $this->{bayesdone} = 1;
        return 0;
    }
    my @rcpt = ($this->{mailfrom},split(/ /o,$this->{rcpt}));
    if ($this->{nobayesian} || ($noBayesian && matchSL(\@rcpt,'noBayesian'))) {
        mlog($fh,"HMM Check skipped on noBayesian") if $BayesianLog>=2;
        $itime=time-$stime;
        mlog($fh,"info: HMM-Check has taken $itime seconds") if $BayesianLog >= 2;
        $this->{bayesdone} = 1;
        return 0;
    }
    if(!($this->{allLoveBaysSpam} & 1) && $baysSpamLoversRe && ($$msg=~/($baysSpamLoversReRE)/ || $bd=~/($baysSpamLoversReRE)/)) {
        mlogRe($fh,($1||$2),"BayesSpamLover");
        $this->{allLoveBaysSpam}=1;
    }
    if(!($this->{spamlover} & 1) && $SpamLoversRe && ($$msg=~/($SpamLoversReRE)/ || $bd=~/($SpamLoversReRE)/)) {
        mlogRe($fh,($1||$2),"SpamLover");
        $this->{spamlover}=1;
    }

    $this->{clean} = $bd unless exists $this->{hmmValues};

    my $tlit=&tlit($DoHMM);

    my @words;
    my @t;
    $this->{hmmres} = 0;

    push(@t,$URIBLaddWeight{obfuscatedip}) if $this->{obfuscatedip};
    push(@t,$URIBLaddWeight{obfuscateduri}) if $this->{obfuscateduri};
    push(@t,$URIBLaddWeight{maximumuniqueuri}) if $this->{maximumuniqueuri};
    push(@t,$URIBLaddWeight{maximumuri}) if $this->{maximumuri};

    my $privat;
    ($privat) = $this->{rcpt} =~ /(\S*)/o if ! $this->{relayok};
    my $domain = (eval('defined ${chr(ord(",") << ($DoPrivatSpamdb > 1))};')) ? lc $privat : '';
    $privat = (eval('defined ${chr(ord(",") << ($DoPrivatSpamdb & 1))};')) ? lc $privat : '';
    $domain =~ s/^[^\@]*\@/\@/o;
    @HmmBayWords = ();
    my %seen;
    keys %seen = 1024;
    while ($bd =~ /([$BayesCont]{2,})/go) {
        my @Words;
        (@Words = BayesWordClean($1)) or next;
        push @HmmBayWords, @Words if $DoBayesian;
        while (my $t = shift @Words) {
            next if length($t) > 37;
            push @words, $t;
            if (@words > $HMMSequenceLength) {
                shift @words if @words > $HMMSequenceLength + 1;
                my $sym = join($;,@words);
                next if (++$seen{$sym} > 2);
                my $res;
                if ($privat && ($res = $HMMdb{$privat.$;.$sym})) {
                    for (1...$BayesPrivatPrior) {push @t,$res;$this->{hmmres}++;}
                    ${$this->{hmmValues}}{'private: '.join(' ', @words)} = $res if exists $this->{hmmValues};
                    next;
                }
                if ($domain && ($res = $HMMdb{$domain.$;.$sym})) {
                    for (1...$BayesDomainPrior) {push @t,$res;$this->{hmmres}++;}
                    ${$this->{hmmValues}}{'domain: '.join(' ', @words)} = $res if exists $this->{hmmValues};
                    next;
                }
                next unless ($res = $HMMdb{$sym});
                push @t,$res;
                $this->{hmmres}++;
                ${$this->{hmmValues}}{join(' ', @words)} = $res if exists $this->{hmmValues};
            }
        }
    }

    if ($this->{hmmres} < int($maxBayesValues / 12 + 1)) {
        mlog(0,"warning: the current HMMdb is possibly incompatible to this version of ASSP. Please run a rebuildspamdb. current: $currentDBVersion{HMMdb} - required: $requiredDBVersion{HMMdb}") if ($currentDBVersion{HMMdb} ne $requiredDBVersion{HMMdb} && ! ($ignoreDBVersionMissMatch & 2));
        mlog($fh,'HMM-Check has given less than '.int($maxBayesValues / 12 + 1).' results - using monitoring mode only');
        $DoHMM = 2;
        $tlit=&tlit($DoHMM);
        $this->{prepend}="[HMM]";
        $this->{prepend}.="$tlit" if $DoHMM>=2;
    } elsif ($this->{hmmres} < int($maxBayesValues / 3 + 1) && $DoHMM == 1) {
        mlog(0,"warning: the current HMMdb is possibly incompatible to this version of ASSP. Please run a rebuildspamdb. current: $currentDBVersion{HMMdb} - required: $requiredDBVersion{HMMdb}") if ($currentDBVersion{HMMdb} ne $requiredDBVersion{HMMdb} && ! ($ignoreDBVersionMissMatch & 2));
        mlog($fh,'HMM-Check has given less than '.int($maxBayesValues / 3 + 1).' results - using soring mode only');
        $DoHMM = 3;
        $tlit=&tlit($DoHMM);
        $this->{prepend}="[HMM]";
        $this->{prepend}.="$tlit" if $DoHMM>=2;
    }

    $itime=time-$stime;
    mlog($fh,"info: HMM-Check has taken $itime seconds and has given $this->{hmmres} results") if $BayesianLog >= 2;
    return 0 unless $this->{hmmres};
    @t=sort {abs($main::b-.5)<=>abs($main::a-.5)} @t;
    @t=@t[0..($maxBayesValues - 1)];
    (my $p1, my $p2, my $c1, $this->{hmmprob}, $this->{hmmconf}) = BayesHMMProb(\@t);

    if ($baysConf>0) {
        mlog($fh, sprintf("HMM Check $tlit - Prob: %.5f / Confidence: %.5f => %s.%s", $this->{hmmprob}, $this->{hmmconf}, $this->{hmmconf}<$baysConf?"doubtful":"confident", ($this->{hmmprob}<$baysProbability)?"ham":"spam"),1) if $BayesianLog || $DoHMM>=2;
        $this->{bayeslowconf}=1 if ($this->{hmmprob}>=$baysProbability && $this->{hmmconf}<$baysConf && $DoHMM == 1);
    } else {
        mlog($fh, sprintf("HMM Check $tlit - Prob: %.5f => %s", $this->{hmmprob}, ($this->{hmmprob}<$baysProbability)?"ham":"spam"),1) if $BayesianLog || $DoHMM>=2;
    }
    return 0 if $DoHMM==2;
    $this->{messagereason}=sprintf("HMM Probability: %.4f", $this->{hmmprob});
    if ($this->{hmmprob}>=$baysProbability)  {
        my $valence = ($this->{relayok}) ? ${'HMMlocalValencePB'}[0] : ${'HMMValencePB'}[0];
        $valence = int($valence * $this->{hmmprob} + 0.5);
        pbAdd($fh,$this->{ip},int(($baysConf && $baysConfidenceHalfScore && $this->{hmmconf}<$baysConf) ? $valence * $this->{hmmprob} / 2 + 0.5 :$valence * $this->{hmmprob} + 0.5),"HMM") if $valence > 0 && $fh;
    } elsif ($this->{hmmprob} >= 1 - $baysProbability) {
        my $valence = ($this->{relayok}) ? ${'HMMlocalValencePB'}[0] / 2 : ${'HMMValencePB'}[0] / 2;
        $valence = int($valence * $this->{hmmprob} + 0.5);
        if ($valence > 0) {
            mlog($fh,sprintf("HMM Check $tlit - Prob: %.5f shows an 'unsure' state - doing only message scoring - calculating half scores", $this->{hmmprob}),1) if $BayesianLog;
            pbAdd($fh,$this->{ip},int(($baysConf && $baysConfidenceHalfScore && $this->{hmmconf} < $baysConf) ? $valence * $this->{hmmprob} / 2 + 0.5 : $this->{hmmprob} * $valence + 0.5),"HMM",1) if $fh;
        }
    }
    return 0 if ($NoTagInTestmode && $this->{hmmprob}>=$baysProbability && $baysTestMode && $this->{hmmconf}<$baysConf);
    return 0 if $DoHMM==3;
    return $this->{hmmprob}<$baysProbability? 0: 1;
}

sub BayesConfNorm {
    my $c = abs(1 - $bayesnorm);
    my $exp = int($c * 10.0001);
    $exp = 4 if $exp > 4;
    return 1 / (($c + 1) ** $exp);
}

sub BayesHMMProb {
    my $t = shift;
    my $p1 = 1;
    my $p2 = 1;
    my $p1c = 1;
    my $p2c = 1;
    my $cc = 0;
    my $c1;
    my $norm = BayesConfNorm();
    foreach my $p (@$t) {
        if ($p) {
            $p1 *= $p;
            $p2 *= ( 1 - $p );
            $c1++;
            if ($p < 0.01) {           # eliminate and count positive extreme ham values for confidence
                $cc++;
                next;
            }
            if ((1 - $p) < 0.01) {     # eliminate and count negative extreme spam values for confidence
                $cc--;
                next;
            }
            $p1c*=$p;                  # use the not extreme values for confidence calculation
            $p2c*=(1-$p);
        }
    }
    my $ps = $p1 + $p2;
    my $SpamProb = $ps ? ($p1 / $ps) : 1;       # default Bayesian math

    #  ignore    ham extremes if spam      and   spam extremes if ham for confidence calculation
    $cc = 0 if ($cc < 0 && $SpamProb > 0.5) or ($cc > 0 && $SpamProb <= 0.5);
    # use the spam/ham extremes left, to set a factor to reduce confidence
    $cc = 0.01 ** abs($cc);
    
    # found only extreme or no value -> set confidence to 1
    $p1c = 0 if ($p1c == 1 && $p2c == 1);

    # weight the confidence down, if not enough values are available ($c1/$maxBayesValues)**2
    my $SpamProbConfidence = abs( $p1c - $p2c ) * $cc * $norm * ($c1/$maxBayesValues) ** 2;
    $SpamProbConfidence = 1 if $SpamProbConfidence > 1;   # this should never happen -> but be save

    # return spampropval, hampropval, valcount, combined SpamProb, Confidence of combined SpamProb
    return ($p1,$p2,$c1,$SpamProb,$SpamProbConfidence);

#   $SpamProbConfidence = ((1+$p1-$p2)/2)*($c1/$maxBayesValues)**2;
}

# Unicode : detect symbolic languages and break them in to words or symbols
sub getUniWords {
    my $word = shift;
    return $word if ($] lt '5.012000');
    my @chars;
    Encode::_utf8_on($word);
    if (eval{$word =~ /^(?:$NonSymLangRE)+$/o;}) {    # return the word - this is not a symbol language
        Encode::_utf8_off($word);
        return $word;
    }
    if ($CanUseUnicodeGCString) {
        $word = join('', map {my $t = $_; utf8::encode($t) unless utf8::valid($t); $t;} split(//o,$word) );
        Encode::_utf8_on($word);
        if (! utf8::valid($word)) {
            Encode::_utf8_off($word);
            return $word;
        }
        if ($debug) {
            open(my $F , '>', "$base/debug/last_unicode_bayes_word.txt");
            binmode $F;
            print $F $word;
            close $F;
        }
        eval{@chars = map {my $t = $_->as_string;$t;} Unicode::GCString->new($word)->as_array;};
    }
    eval{@chars = split(//o,$word);} unless @chars;
    if (eval{$word !~ /$NonSymLangRE/o;}) {  # return symbols - all characters are from a symbol language
        Encode::_utf8_off($_) for @chars;
        return @chars;
    }
    $word = '';
    my @ret;
    for (@chars) {            # separate mixed contents in to separate words - try best fit
        next unless $_;
        my $issym;
        eval{$issym = $_ !~ /$NonSymLangRE/o;};
        Encode::_utf8_off($_);
        if (! $issym) {
            $word .= $_;
        } else {
            if ($word) {
                push @ret, $word;
                $word = '';
            }
            push @ret, $_;
        }
    }
    push @ret, $word if $word;
    return @ret;
}

sub BayesWords {
    my ($text,$privat) = @_;
    my $domain = (eval('defined ${chr(ord(",") << ($DoPrivatSpamdb > 1))};')) ? lc $privat : '';
    $privat = (eval('defined ${chr(ord(",") << ($DoPrivatSpamdb & 1))};')) ? lc $privat : '';
    $domain =~ s/^[^\@]*\@/\@/o;
    my @t;
    my $dummy = '';
    my (%seen, $PrevWord, $CurWord, %got, $how);
    keys %seen = 1024;
    keys %got = 1024;
    $how = 1 if [caller(2)]->[3] =~ /AnalyzeText/o;
    $how = 2 if (!$how && [caller(1)]->[3] =~ /ConfigAnalyze/o);
    $text = \$dummy if @HmmBayWords;
    while (@HmmBayWords || $$text =~ /([$BayesCont]{2,})/go) {
        my @Words;
        (@Words = @HmmBayWords ? (shift @HmmBayWords) : BayesWordClean($1)) or next;
        while ($CurWord = shift @Words) {
            next unless $CurWord;
            $CurWord = substr($CurWord,0,37) if length($CurWord) > 37;
            if (! $PrevWord) {
                $PrevWord = $CurWord;
                next ;
            }
            my $j="$PrevWord $CurWord";
            $PrevWord = $CurWord;
            next if ++$seen{$j} > 2; # first two occurances are significant
            if ($privat && (my $v = $Spamdb{"$privat $j"})) {
                if ($how) {
                    $j = assp_encode_Q($j) if ($how == 1);
                    $got{ "private: $j" } = $v;
                }
                for(1...$BayesPrivatPrior) {push(@t,$v);}
                next;
            }
            if ($domain && (my $v = $Spamdb{"$domain $j"})) {
                if ($how) {
                    $j = assp_encode_Q($j) if ($how == 1);
                    $got{ "domain: $j" } = $v;
                }
                for(1...$BayesDomainPrior) {push(@t,$v);}
                next;
            }
            if (my $v = $Spamdb{$j}) {
                if ($how) {
                    $j = assp_encode_Q($j) if ($how == 1);
                    $got{ $j } = $v;
                }
                push(@t,$v);
            }
        }
    }
    return \@t,\%got;
}

sub BayesWordClean {
    my $word = lc(shift);
    no warnings qw(utf8);
    Encode::_utf8_on($word);
    my $l = eval{length($word);};
    $word = substr($word,0,$l);
    return unless $word;
    my @words;
    local $@;
    eval{
        if ($word =~ /^$EmailAdrRe\@$EmailDomainRe$/io) {    # email addresses are too long -> MD5 (24 Byte hex)
            $word = lc substr(Digest::MD5::md5_hex($word),0,24);
        } elsif ($word =~ /^.*?(?:ht|f)tps?:\/\/($EmailDomainRe)([\?\&\/].*)?$/io && length($1) > 1) {    # get URL's
            $word = $1;
            my $text = $2;
            Encode::_utf8_off($word);
            push(@words,$word) for (2..$HMMSequenceLength);
            for my $w (split(/[\/#?=&]+/o,$text)) {
                next if length($w) < 2;
                Encode::_utf8_off($w);
                push(@words,$w);
                last if (scalar @words == ($HMMSequenceLength + 1));
            }
        } else {
            $word =~ s/#(?:[a-f0-9]{2})+/randcolor/go;
            $word =~ s/^#\d+/randdecnum/go;
            $word =~ s/(?:[a-f0-9]{2}){3,}/randword/go;
            $word =~ s/[\d,.]{2,}/randnumber/go;
            $word =~ s/[_\[\]\~\@\%\$\&\{\}<>#(),.'";:=!?*+\/\\\-]+$//o;
            $word =~ s/^[_\[\]\~\@\%\$\&\{\}<>#(),.'";:=!?*+\/\\\-]+//o;
            $word =~ s/!!!+/!!/go;
            $word =~ s/\*\*+/**/go;
            $word =~ s/--+/-/go;
            $word =~ s/__+/_/go;
            $word =~ s/^[\d:\.\-+();<>,!"'\/%]+(?:[ap]m)?$/randwildnum/o;    # ignore numbers , dates, times, versions ...
            $word =~ s/['"]/quote/go;
        }
        1;
    } or return;
    Encode::_utf8_off($word);
    unshift @words, $word;
    @words = map { getUniWords($_); } @words;
    return @words;
}

sub BayesOK {
    my($fh,$msg,$ip)=@_;
    d('BayesOK');
    if ($lockBayes) {
        mlog($fh,"Bayesian is not available - hmmdb is still locked by a rebuild task") if $BayesianLog;
        return 1;
    }
    my $this=$Con{$fh};
    my $DoBayesian = $DoBayesian;    # copy the global to local - using local from this point
    $DoBayesian = $this->{overwritedo} if ($this->{overwritedo});   # overwrite requ by Plugin
    return 1 if $this->{bayesdone};
    $this->{bayesdone} = 1;
    return 1 if !$DoBayesian;
    my $res = BayesOK_Run($fh,$msg,$ip);
    @HmmBayWords = ();
    return $res;
}
sub BayesOK_Run {
    my($fh,$msg,$ip)=@_;
    d('BayesOK_Run');
    return 1 if $lockBayes;
    my $this=$Con{$fh};
    $this->{prepend}='';
    return 1 if $this->{whitelisted} && ! $BayesWL;
    return 1 if $this->{noprocessing} && ! $BayesNP;
    $fh = 0 if "$fh" =~ /^\d+$/o;
    if (! $haveSpamdb && !($haveSpamdb = getDBCount('Spamdb','spamdb'))) {
        mlog($fh,"Bayesian is not available - spamdb is empty") if $BayesianLog;
        return 1;
    }
    if ($lockBayes) {
        mlog($fh,"Bayesian is not available - spamdb is still locked by a rebuild task") if $BayesianLog;
        return 1;
    }
    my $DoBayesian = $DoBayesian;    # copy the global to local - using local from this point
    $DoBayesian = $this->{overwritedo} if ($this->{overwritedo});   # overwrite requ by Plugin
    my $stime = time;

    my ($bd,$ok);
    if ($this->{clean}) {
        ($bd,$ok) = ($this->{clean}, 1);
        delete $this->{clean};
    }
    if (! $bd) {
        eval {
          local $SIG{ALRM} = sub { die "__alarm__\n" };
          alarm($BayesMaxProcessTime + 10);
          ($bd,$ok) = &clean($msg);
          alarm(0);
        };
        if ($@) {
            alarm(0);
            if ( $@ =~ /__alarm__/o ) {
                my $itime = time - $stime;
                mlog( $fh, "BayesOK: timed out after $itime secs.", 1 );
            } else {
                mlog( $fh, "BayesOK: failed: $@", 1 );
            }
        }
        unless ($ok) {
            mlog($fh,"info: Bayesian-Process-Timeout ($BayesMaxProcessTime s) is reached - Bayesian Check will only be done on mail header") if ($BayesianLog && time-$stime > $BayesMaxProcessTime);
            my $itime=time-$stime;
            mlog($fh,"info: Bayesian-Check-Conversion has taken $itime seconds") if $BayesianLog >= 2;
            return 1;
        }
    }

    $ip = $this->{cip} if $this->{ispip} && $this->{cip};

    if(!$this->{whitelisted} && $whiteRe && ($$msg=~/($whiteReRE)/ || $bd=~/($whiteReRE)/)) {
        $this->{whitelisted}=1;
        my ($r1,$r2) = ($1,$2);
        mlogRe($fh,($r1||$r2),"White");
        if (! $BayesWL) {
            $this->{passingreason} = "whiteRe '".($r1||$r2)."'";
            $itime=time-$stime;
            mlog($fh,"info: HMM-Check has taken $itime seconds") if $BayesianLog >= 2;
            $this->{spamprob}=0;
            return 1;
        }
    }

    if ($this->{relayok} && (    ( $noBayesian_local  &&   matchSL($this->{mailfrom},'noBayesian_local') )
                              || ( $Bayesian_localOnly && ! matchSL($this->{mailfrom},'Bayesian_localOnly') )
                            )
       )
    {
        mlog($fh,"Bayesian Check skipped for local sender") if $BayesianLog>=2;
        $itime=time-$stime;
        mlog($fh,"info: Bayesian-Check has taken $itime seconds") if $BayesianLog >= 2;
        $this->{spamprob}=0;
        return 1;
    }
    my @rcpt = ($this->{mailfrom},split(/ /o,$this->{rcpt}));
    if ($this->{nobayesian} || ($noBayesian && matchSL(\@rcpt,'noBayesian'))) {
        mlog($fh,"Bayesian Check skipped on noBayesian") if $BayesianLog>=2;
        $itime=time-$stime;
        mlog($fh,"info: Bayesian-Check has taken $itime seconds") if $BayesianLog >= 2;
        $this->{spamprob}=0;
        return 1;
    }
    if(!($this->{allLoveBaysSpam} & 1) && $baysSpamLoversRe && ($$msg=~/($baysSpamLoversReRE)/ || $bd=~/($baysSpamLoversReRE)/)) {
        mlogRe($fh,($1||$2),"BayesSpamLover");
        $this->{allLoveBaysSpam}=1;
    }
    if(!($this->{spamlover} & 1) && $SpamLoversRe && ($$msg=~/($SpamLoversReRE)/ || $bd=~/($SpamLoversReRE)/)) {
        mlogRe($fh,($1||$2),"SpamLover");
        $this->{spamlover}=1;
    }
    my $tlit=&tlit($DoBayesian);

    my ($v,$lt,$t);
    my @t;

    push(@t,$URIBLaddWeight{obfuscatedip}) if $this->{obfuscatedip};
    push(@t,$URIBLaddWeight{obfuscateduri}) if $this->{obfuscateduri};
    push(@t,$URIBLaddWeight{maximumuniqueuri}) if $this->{maximumuniqueuri};
    push(@t,$URIBLaddWeight{maximumuri}) if $this->{maximumuri};

    my $privat;
    ($privat) = lc $this->{rcpt} =~ /(\S+)/o if ! $this->{relayok};
    my ($ar,$ha) = BayesWords(\$bd,$privat);
    push(@t, @$ar); undef $ha;
    $itime=time-$stime; mlog($fh,"info: Bayesian-Check has taken $itime seconds") if $BayesianLog >= 2;
    return 1 if @t < 2 && $t[0] eq '';
    if (@t < 6 && $currentDBVersion{Spamdb} ne $requiredDBVersion{Spamdb}) {
        mlog(0,"warning: the current Spamdb is possibly incompatible to this version of ASSP. Please run a rebuildspamdb. current: $currentDBVersion{Spamdb} - required: $requiredDBVersion{Spamdb}") if ! ($ignoreDBVersionMissMatch & 1);
    }
    @t=sort {abs($main::b-.5)<=>abs($main::a-.5)} @t;
    @t=@t[0..($maxBayesValues - 1)];
    (my $p1, my $p2, my $c1, $this->{spamprob}, $this->{spamconf}) = BayesHMMProb(\@t);

    if ($baysConf>0) {
        mlog($fh, sprintf("Bayesian Check $tlit - Prob: %.5f / Confidence: %.5f => %s.%s", $this->{spamprob}, $this->{spamconf}, $this->{spamconf}<$baysConf?"doubtful":"confident", ($this->{spamprob}<$baysProbability)?"ham":"spam"),1) if $BayesianLog || $DoBayesian>=2;
        $this->{bayeslowconf}=1 if ($this->{spamprob}>=$baysProbability && $this->{spamconf}<$baysConf && $DoBayesian == 1);
    } else {
        mlog($fh, sprintf("Bayesian Check $tlit - Prob: %.5f => %s", $this->{spamprob}, ($this->{spamprob}<$baysProbability)?"ham":"spam"),1) if $BayesianLog || $DoBayesian>=2;
    }

    if (   defined $this->{hmmprob}
        && (    ($this->{hmmprob} >= $baysProbability && $this->{spamprob} < $baysProbability)
             or ($this->{hmmprob} < $baysProbability && $this->{spamprob} >= $baysProbability))
       )
    {
        mlog($fh,sprintf("info: got different spam result for Bayesian and HMM : %.5f - %.5f",$this->{spamprob},$this->{hmmprob})) if $BayesianLog >= 2;
        mlog(0,"warning: the current Spamdb is possibly incompatible to this version of ASSP. Please run a rebuildspamdb. current: $currentDBVersion{Spamdb} - required: $requiredDBVersion{Spamdb}") if $currentDBVersion{Spamdb} ne $requiredDBVersion{Spamdb} && ! ($ignoreDBVersionMissMatch & 1);
    }

    return 1 if $DoBayesian==2;
    $this->{messagereason}=sprintf("Bayesian Probability: %.5f", $this->{spamprob});
    if ($this->{spamprob} >= $baysProbability)  {
        my $valence = ($this->{relayok}) ? ${'bayslocalValencePB'}[0] : ${'baysValencePB'}[0];
        $valence = int($valence * $this->{spamprob} + 0.5);
        pbAdd($fh,$this->{ip},int(($baysConf && $baysConfidenceHalfScore && $this->{spamconf} < $baysConf) ? $valence * $this->{spamprob} / 2 + 0.5 : $this->{spamprob} * $valence + 0.5),"Bayesian") if $valence > 0 && $fh;
    } elsif ($this->{spamprob} >= 1 - $baysProbability) {
        my $valence = ($this->{relayok}) ? ${'bayslocalValencePB'}[0] / 2 : ${'baysValencePB'}[0] / 2;
        $valence = int($valence * $this->{spamprob} + 0.5);
        if ($valence > 0) {
            mlog($fh,sprintf("Bayesian Check $tlit - Prob: %.5f shows an 'unsure' state - doing only message scoring - calculating half scores", $this->{spamprob}),1) if $BayesianLog;
            mlog(0,"warning: the current Spamdb is possibly incompatible to this version of ASSP. Please run a rebuildspamdb. current: $currentDBVersion{Spamdb} - required: $requiredDBVersion{Spamdb}") if $currentDBVersion{Spamdb} ne $requiredDBVersion{Spamdb} && ! ($ignoreDBVersionMissMatch & 1);
            pbAdd($fh,$this->{ip},int(($baysConf && $baysConfidenceHalfScore && $this->{spamconf} < $baysConf) ? $valence * $this->{spamprob} / 2 + 0.5 : $this->{spamprob} * $valence + 0.5),"Bayesian",1) if $fh;
        }
    }
    return 1 if ($NoTagInTestmode && $this->{spamprob}>=$baysProbability && $baysTestMode && $this->{spamconf}<$baysConf);
    return 1 if $DoBayesian==3;
    return $this->{spamprob}<$baysProbability? 1: 0;
}

# attach a header line to the message if the config option is set
sub addSpamProb {
    my ($fh,$wl,$sp)=@_;
    my $this=$Con{$fh};
    my $spamprobheader='';
    my $mscore;
    d('addSpamProb');
    return if $NoExternalSpamProb && $this->{relayok};
    $spamprobheader = sprintf( "X-Assp-Spam-Prob: %.5f\r\n", $this->{spamprob} )
      if $this->{spamprob} > 0.00001 && $AddSpamProbHeader;
    $spamprobheader .= sprintf( "X-Assp-Bayes-Confidence: %.5f\r\n", $this->{spamconf} )
      if $AddSpamProbHeader
          && $AddConfidenceHeader
          && $baysConf
          && $this->{spamconf} > 0.00001;
    $spamprobheader .= sprintf( "X-Assp-HMM-Spam-Prob: %.5f\r\n", $this->{hmmprob} )
      if $this->{hmmprob} > 0.00001 && $AddSpamProbHeader;
    $spamprobheader .= sprintf( "X-Assp-HMM-Confidence: %.5f\r\n", $this->{hmmconf} )
      if $AddSpamProbHeader
          && $AddConfidenceHeader
          && $baysConf
          && $this->{hmmconf} > 0.00001;

    $this->{myheader}=~s/X-Assp-Spam-Prob:$HeaderValueRe//gios; # clear out existing X-Assp-Spam-Prob headers
    $this->{myheader}=~s/X-Assp-Bayes-Confidence:$HeaderValueRe//gios; # clear out existing X-Assp-Bayes-Confidence headers
    $this->{myheader}=~s/X-Assp-HMM-Spam-Prob:$HeaderValueRe//gios; # clear out existing X-Assp-HMM-Spam-Prob headers
    $this->{myheader}=~s/X-Assp-HMM-Confidence:$HeaderValueRe//gios; # clear out existing X-Assp-HMM-Confidence headers
    if ($wl || $this->{whitelisted}) {
        my $reason = $this->{passingreason} =~ /white|authenticated/oi ? $this->{passingreason} : '';
        $reason = 'whiteRe' if $reason =~ /whitere/io;
        $reason =~ s/\r?\n/ /go;
        $reason = ' ('.$reason.')' if $reason;
        $spamprobheader.="X-Assp-Whitelisted: Yes$reason\r\n";
        $this->{myheader}=~s/X-Assp-Whitelisted:$HeaderValueRe//gios; # clear out existing X-Assp-Whitelisted headers
    }
    my $strippedTag=$this->{prepend};
    $this->{saveprepend}=$this->{prepend};
    $strippedTag=~s/\[//o;
    $strippedTag=~s/\]//o;
    if ($sp && $this->{prepend} && $tagLogging) {
        $this->{myheader}=~s/X-Assp-Tag:$HeaderValueRe//gios; # clear out existing X-Assp-Tag headers
        $spamprobheader.="X-Assp-Tag: $strippedTag\r\n";
    }

    # add to our header; merge later, when client sent own headers
    $this->{myheader}.=$spamprobheader;
}

# compile the nonprocessing domains regular expression
sub setNPDRE {
    my $new=shift;
    $new||=$neverMatch; # regexp that never matches
    $new=~s/\*/\.\*/go;
    SetRE('NPDRE',"(?:$new)\$",
          $regexMod,
          'NoProcessing Domains',$_[0]);
}

# compile the whitelisted domains regular expression
sub setWhiteListedDomainsRE {
    my $new=shift;
    $new||=$neverMatch; # regexp that never matches
    SetRE('whiteListedDomainsRE',"(?:$new)\$",
          $regexMod,
          'Whitelisted Domains',$_[0]);
}

# compile the blacklisted domains regular expression
sub setBlackListedDomainsRE {
    my $new=shift;
    $new||=$neverMatch; # regexp that never matches
    $new=~s/\*/\.\*/go;
    SetRE('blackListedDomainsRE',"(?:$new)\$",
          $regexMod,
          'Blacklisted Domains',$_[0]);
}

# compile the regular expression for the list of two-level country code TLDs
sub setURIBLCCTLDSRE {
    my $new=shift;
    SetRE('URIBLCCTLDSRE', ($new ? "(?:\\.(?:$new))\$" : $neverMatch),
          $regexMod,
          'Country Code TLDs',$_[0]);
}

# compile the URIBL whitelist regular expression
sub setURIBLWLDRE {
    my $new=shift;
    $new||=$neverMatch; # regexp that never matches
    $new=~s/\*/\.\*/go;
    SetRE('URIBLWLDRE',"^(?:$new)\$",
          $regexMod,
          'Whitelisted URIBL Domains',$_[0]);
}

# compile the Max IP/Domain whitelist regular expression
sub setIPDWLDRE {
    my $new=shift;
    $new||=$neverMatch; # regexp that never matches
    $new=~s/\*/\.\*/go;
    SetRE('IPDWLDRE',"^(?:$new)",
          $regexMod,
          'Max IP/Domain Whitelisted Domains',$_[0]);
}

# compile the VFRT regular expression
sub setVFRTRE {
    my $new=shift;
    $new||=$neverMatch; # regexp that never matches
    $new=~s/\*/\.\*/go;
    SetRE('VFRTRE',"^(?:$new)",
          $regexMod,
          'skip VRFY do RCPT TO',$_[0]);
}

# see if the address in the mailfrom is on the whitelist meanwhile update the whitelist if that seems appropriate
sub onwhitelist {
    my($fh,$ba)=@_;
    d('onwhitelist');
    my $this=$Con{$fh};
    my $adr=lc $this->{mailfrom};
    $adr = batv_remove_tag(0,$adr,'');
    my $fm = $adr;

    my $whitelisted=$this->{relayok};
    if ($whitelisted) {$Stats{locals}++;}
    return $whitelisted unless $adr; # don't add to the whitelist unless there's a valid envelope -- prevent bounced mail from adding to the whitelist
    if (! $this->{red} && $redRe && $$ba=~/($redReRE)/) {
        $this->{red}=($1||$2);
        mlogRe($fh,$this->{red},"Red");
    }
    $this->{red} = batv_remove_tag(0,$this->{red},'');
    mlogRe($fh,$adr,"Redlist") if !$this->{red} && $Redlist{$adr};
    $this->{red}="$adr in Redlist" if $Redlist{$adr};

    my %senderlist = ();
    unless($whitelisted) {
        $senderlist{$adr}=1;
        if(! $NotGreedyWhitelist || $NotGreedyWhitelist == 2) {
            if (scalar @{$this->{senders}}) {
                map { $senderlist{$_}=1 } @{$this->{senders}};
            } else {
                while ($$ba =~ /($HeaderNameRe):($HeaderValueRe)/igos) {
                    my $s = $2;
                    next if $1 !~ /^(?:from|sender|reply-to|errors-to|list-\w+)$/io;
                    &headerUnwrap($s);
                    if ($s =~ /($EmailAdrRe\@$EmailDomainRe)/io) {
                        $s = batv_remove_tag(0,$1,'');
                        $senderlist{lc $s}=1;
                    }
                }
            }
        }
        foreach my $adr (keys %senderlist) {
            if ($adr && $Redlist{$adr}) {
                mlog($fh,"redlisted: $adr - not white");
                return 0;
            }
        }
        my $notAllWhite;
        foreach my $ad (split(/\s+/o,lc $this->{rcpt})) {
            my $skipPrivat;
            if (localdomains($ad) && matchRE([$ad],'whiteListedDomains',1)) {
               $skipPrivat = 1;
               mlog(0,"error: the local address '$ad' matches a definition in 'whiteListedDomains' - please remove this entry");
            }
            foreach my $adr (keys %senderlist) {
                next if $adr eq '' || localmail($adr);
                if($whiteListedDomains && matchRE([$adr],'whiteListedDomains',1)) {
                    d('whiteListedDomains ' . $lastREmatch);
                    $whitelisted=1;
                    mlog($fh,"Whitelisted sender Domain: $lastREmatch");
                } elsif($whiteListedDomains && ! $skipPrivat && matchRE(["$adr,$ad"],'whiteListedDomains',1)) {
                    d('whiteListedDomains ' . $lastREmatch);
                    $whitelisted=1;
                    $lastREmatch =~ s/,/ for /o;
                    mlog($fh,"Whitelisted sender Domain: $lastREmatch");
                } elsif(&Whitelist($adr,$ad)) {
                    d('on whitelist ' . $adr);
                    $whitelisted=1;
                    mlog($fh,"Whitelisted sender address: $adr for recipient $ad");
                } elsif ($NotGreedyWhitelist == 2) {
                    mlog($fh,"found NOT whitelisted sender address: $adr");
                    $notAllWhite = 1;
                }
            }
        }
        if ($notAllWhite) {
            mlog($fh,"not all senders addresses are whitelisted - not white (NotGreedyWhitelist)") if $whitelisted;
            $whitelisted='';
        }
        @{$this->{senders}} = keys %senderlist; # used for finding blacklisted domains
        if ($whitelisted) {
            $Stats{whites}++;
            $this->{whitelisted} = 1;
        }
    }

    # don't add to whitelist if sender is redlisted
    return $whitelisted if $this->{red} || $WhitelistLocalOnly && !$this->{relayok} || $WhitelistLocalFromOnly && ! localmail($this->{mailfrom});
    if($whitelisted) {
        $this->{doNotTimeout} = time;

        # keep the whitelist up-to-date
        my %ar = ($GreedyWhitelistAdditions == 2) ? %senderlist : ();  # all
        $ar{$fm}=1 if $GreedyWhitelistAdditions;      # all or envelope
        my $count = 0;
        while ($$ba=~/($HeaderNameRe):($HeaderValueRe)/igos) {
            my $ad=$2;
            next if $1 !~ /^(?:to|cc|bcc)$/io;
            while ($ad=~/($EmailAdrRe\@$EmailDomainRe)/go) {
                my $s = $1;
                $WorkerLastAct{$WorkerNumber} = time if (++$count % 100 == 0);
                $s = batv_remove_tag(0,$s,'');
                $ar{lc $s} = 1;
            }
        }
        $count = 0;
        foreach my $ad (split(/\s+/o,lc $this->{rcpt})) {
            $WorkerLastAct{$WorkerNumber} = time if (++$count % 100 == 0);
            $ad = batv_remove_tag(0,$ad,'');
            $ar{lc $ad} = 1;
        }

        my @checkAddr = ( @{$this->{senders}} , keys(%ar) );

        if (! $NoAutoWhite && ! matchSL( \@checkAddr, 'NoAutoWhiteAdresses' )) {
            $adr = '' unless $this->{relayok};
            $count = 0;
            foreach my $ad (keys %ar) {
                $WorkerLastAct{$WorkerNumber} = time if (++$count % 100 == 0);
                next if ! $ad || localmail($ad);
                next if $Redlist{$ad}; # don't add to whitelist if rcpt is redlisted
                next if !$EmailAllowEqual && $ad=~/\=/o;
                next if $ad=~/^\'/o;

                #next if $whiteListedDomains && matchRE([$ad],'whiteListedDomains',1);

                mlog($fh,"Admininfo: whitelist addition: $ad - AutoWhite on sent mail by $fm",1) unless &Whitelist($ad,$adr);
                &Whitelist($ad,$adr,'add');
            }
        }
        $this->{whitelisted} = 1;
        delete $this->{doNotTimeout} if (! $smtpIdleTimeout || time - $this->{doNotTimeout} < $smtpIdleTimeout - 10);
        return 1;
    }
    return 0;
}

#Email::MIME substitution for mixed alternative multipart messages
sub parts_multipart {
  my $self = shift;

  #use the original code, if don't need the hack
  return $org_Email_MIME_parts_multipart->($self) if $o_EMM_pm;

  my $boundary = $self->{ct}->{attributes}->{boundary};

  return $self->parts_single_part
    unless $boundary and $self->body_raw =~ /^--\Q$boundary\E\s*$/sm;

  $self->{body_raw} = $self->body_raw;

  # rfc1521 7.2.1
  my ($body, $epilogue) = split /^--\Q$boundary\E--\s*$/sm, $self->body_raw, 2;

  my @bits = split /^--[^\n\r]+\s*$/smo, ($body || '');

  $self->{body} = undef;
  $self->{body} = (\shift @bits) if ($bits[0] || '') !~ /:/o;

  my $bits = @bits;

  my @parts;
  for my $bit (@bits) {
    $bit =~ s/\A[\n\r]+//smgo;
    my $email = (ref $self)->new($bit);
    push @parts, $email;
  }

  $self->{parts} = \@parts;

  return @{ $self->{parts} };
}

# substitute for Email::MIME::ContentType::_parse_attributes
# to prevent carping
sub assp_parse_attributes {
    local $_ = shift;
    my $attribs = {};
    my $tspecials = quotemeta '()<>@,;:\\"/[]?=';
    while ($_) {
        s/^;//o;
        s/^\s+//o and next;
        s/\s+$//o;
        unless (s/^([^$tspecials]+)=//o) {
          # We check for $_'s truth because some mail software generates a
          # Content-Type like this: "Content-Type: text/plain;"
          # RFC 1521 section 3 says a parameter must exist if there is a
          # semicolon.
          mlog(0,"Illegal Content-Type parameter $_") if $_ && ! $IgnoreMIMEErrors && $WorkerNumber != 10001;
          return $attribs;
        }
        my $attribute = lc $1;
        my $value = assp_extract_ct_attribute_value();
        $attribs->{$attribute} = $value;
    }
    return $attribs;
}

# substitute for Email::MIME::ContentType::_extract_ct_attribute_value
# to prevent carping
sub assp_extract_ct_attribute_value {
    my $value;
    my $tspecials = quotemeta '()<>@,;:\\"/[]?=';
    my $extract_quoted =
        qr/(?:\"(?:[^\\\"]*(?:\\.[^\\\"]*)*)\"|\'(?:[^\\\']*(?:\\.[^\\\']*)*)\')/;
     while ($_) {
        s/^([^$tspecials]+)//o and $value .= $1;
        s/^($extract_quoted)//o and do {
            my $sub = $1; $sub =~ s/^["']//o; $sub =~ s/["']$//o;
            $value .= $sub;
        };
        /^;/o and last;
        /^([$tspecials])/o and do {
            mlog(0,"info: malformed MIME content detected - unquoted $1 not allowed in Content-Type!")
                if ! $IgnoreMIMEErrors && $WorkerNumber != 10001;
            return;
        }
    }
    return $value;
}

sub ImageMD5Part { AttachMD5Part(@_); };
sub AttachMD5Part {
    my $part = shift;
    $part = $part->body;
    return unless $part;
    return Digest::MD5::md5_hex(substr($part,0,512)) . ' ' . length($part);
}

sub AttachMD5Mail {
    my $m = shift;
    my $msg = ref($m) ? $m : \$m;
    return unless $$msg;
    return unless eval('$main::ASSP_AFCDetectSpamAttachRe');
    my %md5;
    my $t = Time::HiRes::time() + 3;

    $o_EMM_pm = 1;
    eval {
        $Email::MIME::ContentType::STRICT_PARAMS=0;      # no output about invalid CT
        my $re = ${'main::ASSP_AFCDetectSpamAttachReRE'};
        my $email = Email::MIME->new($$msg);

        if (Time::HiRes::time() > $t) {
            $t = sprintf("%.2f",(Time::HiRes::time() - $t + 3));
            mlog(0,"info: break attachment MD5 processing after $t seconds - parsing MIME took too long");
            return \%md5;
        }

        my $i = 0;
        foreach my $part ( $email->parts ) {
            if (Time::HiRes::time() > $t) {
                $t = sprintf("%.2f",(Time::HiRes::time() - $t + 3));
                mlog(0,"info: break attachment MD5 processing after $t seconds - processed $i MIME parts");
                last;
            }
            ++$i;
            next if $part->header("Content-Type") !~ /$re/io;
            my $MD5Part = AttachMD5Part($part);
            $md5{$MD5Part}++ if $MD5Part;
        }
    };
    $o_EMM_pm = 0;
    return \%md5;
}

sub AttachMD5File {
    my $fn = shift;
    return unless $fn;
    return unless $eF->( $fn );
    return if $dF->( $fn );
    return unless $CanUseMD5Keys;
    my $msg;
    $open->(my $F,'<', $fn ) or return;
    $F->binmode;
    $F->read($msg,[$stat->($fn)]->[7]);
    $F->close;
    return AttachMD5Mail(\$msg);
}

sub cleanMIMEHeader2UTF8 {
    my ($m , $noconvert) = @_;
    my $msg = ref($m) ? $$m : $m;
    $msg =~ s/([^\x0D])\x0A/$1\x0D\x0A/go;
    my $hl = index($msg,"\x0D\x0A\x0D\x0A");
    if ($hl > 0) {
        $msg = substr($msg,0,$hl);
        $msg = decodeMimeWords2UTF8($msg) if ! $noconvert;
        $msg .= "\x0D\x0A\x0D\x0A";
        return $msg;
    } elsif ($hl == 0) {
        return "\x0D\x0A\x0D\x0A";
    }
}

sub cleanMIMEBody2UTF8 {
    my $m = shift;
    my $msg = ref($m) ? $$m : $m;
    $msg =~ s/([^\x0D])\x0A/$1\x0D\x0A/go;
    my $body;
    my %cs;

    eval {
        local $SIG{ALRM} = sub { die "__alarm__\n"; };
        alarm(30);
        $Email::MIME::ContentType::STRICT_PARAMS=0;      # no output about invalid CT
        my $email = Email::MIME->new($msg);
        foreach my $part ( $email->parts ) {
            my ($cs, $dis, $odis);
            $dis = $odis = $part->header("Content-Type") || '';
            next if $part->header("Content-ID") && $dis !~ /text/oi;    # no inline images / app's
            my $attrs = $dis =~ s/^[^;]*;//o ? Email::MIME::ContentType::_parse_attributes($dis) : {};
            my $name =    $attrs->{name}
                       || $part->{ct}{attributes}{name}
                       || $attrs->{filename}
                       || $part->{ct}{attributes}{filename}
                       || $part->filename;
            $cs = $attrs->{charset} || $part->{ct}{attributes}{charset};
            $cs{uc $cs} = "charset=$cs" if $cs;
            if (! $name && ! $addCharsets) {
                $dis = $part->header("Content-Disposition") || '';
                $attrs = $dis =~ s/^[^;]*;//o ? Email::MIME::ContentType::_parse_attributes($dis) : {};
                $name =    $attrs->{name}
                        || $part->{ct}{attributes}{name}
                        || $attrs->{filename}
                        || $part->{ct}{attributes}{filename};
            }

            my $bd;
            if (! $addCharsets) {
                if ($name) {
                    $bd = "\r\nattachment:$name\r\n";
                    $bd .= $part->body if $odis =~ /text/oi;
                } else {
                    $bd = $part->body;
                }
                if ($bd && $cs) {
                    $bd = Encode::decode($cs, $bd);
                    $bd = e8($bd);
                }
            }
            $body .= "\r\n" if ! $addCharsets && $body && $bd && $body !~ /\r?\n$/o && $bd !~ /^\r?\n/o;
            $body .= $bd;
        }
        if ($addCharsets) {
            my @mime_coded;
            eval {@mime_coded = $msg =~ /=\?([a-zA-Z0-9\-]{2,20})\?[bq]\?/iog;
                  map {$cs{uc $_} = "charset=$_" if $_;} @mime_coded;
                 };
        }
        if (! $body) {
            my $dis = $email->header("Content-Type") || '';
            my $attrs = $dis =~ s/^[^;]*;//o ? Email::MIME::ContentType::_parse_attributes($dis) : {};
            my $cs = $attrs->{charset} || $email->{ct}{attributes}{charset};
            $cs{uc $cs} = "charset=$cs" if $cs;
            $body = $email->body unless $addCharsets;
            if ($body && $cs && ! $addCharsets) {
                $body = Encode::decode($cs, $body);
                $body = e8($body);
            }
        }
        $body = join("\n", values %cs)."\n" if scalar keys %cs && $addCharsets;
        alarm 0;
        1;
    } and alarm 0 if $CanUseEMM;
    mlog(0,"warning: UTF8 conversion for message body timed out (30s)") if $@ =~ /__alarm__/io;
    return $body;
}

# clean up source email
sub clean {
    my $m = shift;

    my $msg = ref($m) ? $$m : $m;
    my $t = time + $BayesMaxProcessTime;     # max 15 seconds for this cleaning
    my $body;
    my $header;
    my $undec = 1;

    $body = cleanMIMEBody2UTF8(\$msg);

    if ($body) {
        $header = cleanMIMEHeader2UTF8(\$msg,0);
        headerUnwrap($header);
        $undec = 0;
    }

    local $_= "\n". (($header) ? $header : $msg);
    my ($helo,$rcpt);
    if ($header) {
        ($helo)=/helo=([^)]+)\)/io;
        $helo = substr($helo,0,25); # if the helo string is long, break it up
        my (@sender,@receipt,$sub);
        while (/($HeaderNameRe):($HeaderValueRe)/igos) {
            my($head,$val) = ($1,$2);
            next if $head =~ /^(?:x-assp|(?:DKIM|DomainKey)-Signature)|X-Original-Authentication-Results/oi;
            if ($head =~ /^(to|cc|bcc)$/io) {
                push @receipt, $1 while ($val =~ /($EmailAdrRe\@$EmailDomainRe)/gio);
            }
            if ($head =~ /^(?:from|ReturnReceipt|Return-Receipt-To|Disposition-Notification-To|Return-Path|Reply-To|Sender|Errors-To|List-\w+)/io) {
                push @sender, $1 while ($val =~ /($EmailAdrRe\@$EmailDomainRe)/gio);
            }
            if ($head =~ /^(subject)$/io) {
                $sub = fixsub($val);
            }
        }
        $rcpt = ' rcpt ' . join(' rcpt ',@receipt) if scalar @receipt;
        $rcpt .= ' sender ' . join(' sender ',@sender) if scalar @sender;
        # mark the subject
        $rcpt .= "\n".$sub if $sub;
        return "helo: $helo\n$rcpt\n",0 if (time > $t);
    }

    # from now only do the body if possible
    local $_ = $body if $body;

    # replace HTML encoding
    s/&amp;?/and/gio;
    $_ = decHTMLent($_);
    return "helo: $helo\n$rcpt\n",0 if (time > $t);

    if ($undec) {
      # replace base64 encoding
      s/\n([a-zA-Z0-9+\/=]{40,}\r?\n[a-zA-Z0-9+\/=\r\n]+)/base64decode($1)/gseo;

      # clean up quoted-printable references
      s/(Subject: .*)=\r?\n/$1\n/o;
      s/=\r?\n//go;
      # strip out mime continuation
      s/.*---=_NextPart_.*\n//go;
      return "helo: $helo\n$rcpt\n",0 if (time > $t);
    }
    # clean up MIME quoted-printable line breakings
    s/=\r?\n//gos;

    # clean up &nbsp; and &amp;
#    s/(\d),(\d)/$1$2/go;
    s/\r//go; s/ *\n/\n/go;
    s/\n\n\n\n\n+/\nblines blines\n/go;
    return "helo: $helo\n$rcpt\n",0 if (time > $t);

    # clean up html stuff
    s/<\s*(head)\s*>.*?<\/\s*\1\s*>//igos;
    s/<\s*(title|h\d)\s*>(.*?)<\/\s*\1\s*>/fixsub($2)/igse;
    s/<\s*((?:no)?script)[^>]+>.*?<\s*\/\s*\1\s*>/ jscripttag /igs;
    s/<\s*(?:no)?script[^>]+>/ jscripttag /igos;
    return "helo: $helo\n$rcpt\n",0 if (time > $t);
    # remove style sheets
    s/<\s*style[^>]*>(.*?)<\s*\/\s*style\s*>/$1/iogs;
    s/<\s*select[^>]*>(.*?)<\s*\/\s*select\s*>/$1/iogs;
    # remove comments
    s/(?:<!--.*?-->|<([^>\s]+)[^>]*\s+style=['"]?[^>'"]*(?:display:\s*none|visibility:\s*hidden)[^>'"]*['"]?[^>]*>.*?<\/\1\s*>)//igs;
    s/<\s*\?\s*php[^>]*?\?\s*>/ jscripttag /igso;
    s/<\s*!\s*[a-z].*?>//igso;
    return "helo: $helo\n$rcpt\n",0 if (time > $t);

    s/<\s*(?:[biu]|strong)\s*>/ boldifytext /gio;

    # remove some tags that are not informative
    s/<\s*\/?\s*(?:p|br|div|t[drh]|li|dd|[duo]l|center|form|input)[^>]*>/\n/gios;
    s/<\s*\/?\s*(?:[biuo]|strong)\s*>//gio;
    s/<\s*\/?\s*(?:html|meta|head|body|span|table|font|col|map)[^>]*>//igos;
    return "helo: $helo\n$rcpt\n",0 if (time > $t);

    # look for linked images
    s/(<\s*a[^>]*>[^<]*<\s*img)/ linkedimage $1/giso;
    s/<[^>]*href\s*=\s*("[^"]*"|\S*)/ href $1 /isgo;
    s/(<\s*a\s[^>]*>)(.*?)(<\s*\/a\s*>)/$1.fixlinktext($2)/igseo;

    s/((?:ht|f)tps?\S*)/ href $1 /isgo;
    return "helo: $helo\n$rcpt\n",0 if (time > $t);

    s/(\S+\@\S+\.\w{2,5})\b/ href $1 /go;
    s/<?\s*img .{0,50}src\s*=\s*['"]([^'"]*)['"][^>]+>/$1/gois;
    s/["']\s*\/?s*>|target\s*=\s*['"]?_blank['"]?|<\s*\/|:\/\/ //go;
    s/ \d{2,} / 1234 /go;
    $_ = &decHTMLent($_);
    if ($CanUseASSP_WordStem) {
        my $ret = eval{&ASSP_WordStem::process($_);};
        if ($ret) {
            return ("helo: $helo\n$rcpt\n".$ret,1);
        } else {
            return ("helo: $helo\n$rcpt\n$_",1);
        }
    } else {
        return ("helo: $helo\n$rcpt\n$_",1);
    }
}

sub fixlinktext { my $t=shift; $t=~s/(\w+)/ atxt $1 /go; $t;}

sub fixsub {
 my $s=shift;
 $s=~s/ {3,}/ lotsaspaces /go;
 my $t = $s;
 my $l = $s =~ s/(\S+)/ssub $1/go;
 "\n".($l > $HMMSequenceLength ? $t.' ':'').$s;
}

sub base64decode {
 my $str = shift;
 my $res;
 $str =~ tr|A-Za-z0-9+/||cd;
 $str =~ tr|A-Za-z0-9+/| -_|;
 while ($str =~ /(.{1,60})/gso) {
  my $len = chr(32 + length($1)*3/4);
  $res .= unpack("u", $len . $1 );
 }
 $res;
}
sub formatMethod {
 my $res;
 if ($_[2]==0) {
  $res=int($_[0]/$_[1]);
  $_[0]-=$res*$_[1]; # modulus on floats
 } elsif ($_[2]==1) {
  if ($_[0]>=$_[1]) {
   $res=sprintf("%.1f",$_[0]/$_[1]);
   $_[0]=0;
  }
 }
 return $res;
}

sub formatNumDataSize {
    my $size = shift;
    my $res;
    if ($size >= 1099511627776) {
        $res = sprintf("%.2f TByte", $size / 1099511627776);
    } elsif ($size >= 1073741824) {
        $res = sprintf("%.2f GBbyte", $size / 1073741824);
    } elsif ($size >= 1048576) {
        $res = sprintf("%.2f MByte", $size / 1048576);
    } elsif ($size >= 1024) {
        $res = sprintf("%.2f kByte", $size / 1024);
    } else {
        $res = $size . ' Byte';
    }
    return $res;
}

sub formatDataSize {
 my ($size,$method)=@_;
 my ($res,$s);
 $res.=$s.'TB ' if $s=formatMethod($size,1099511627776,$method);
 $res.=$s.'GB ' if $s=formatMethod($size,1073741824,$method);
 $res.=$s.'MB ' if $s=formatMethod($size,1048576,$method);
 $res.=$s.'kB ' if $s=formatMethod($size,1024,$method);
 if ($size || !defined $res) {
  if ($method==0) {
   $res.=$size.'B ';
  } elsif ($method==1) {
   $res.=sprintf("%.1fB ",$size);
  }
 }
 $res=~s/\s$//o;
 return $res;
}

sub unformatTimeInterval {
 my ($interval,$default)=@_;
 my @a=split(/\s+/o,$interval);
 my $res=0;
 while (@a) {
  my $j = shift @a;
  my ($i,$mult)=$j=~/^(.*?) ?([smhd]?)$/o;
  $mult||=$default||'s'; # default to seconds
  if ($mult eq 's') {
   $res+=$i;
  } elsif ($mult eq 'm') {
   $res+=$i*60;
  } elsif ($mult eq 'h') {
   $res+=$i*3600;
  } elsif ($mult eq 'd') {
   $res+=$i*86400;
  }
 }
 return $res;
}

sub unformatDataSize {
 my ($size,$default)=@_;
 my @a=split(/\s+/o,$size);
 my $res=0;
 while (@a) {
  my $j = shift @a;
  my ($s,$mult)=$j=~/^(.*?) ?(B|kB|MB|GB|TB)?$/oi;
  $mult||=$default||'B'; # default to bytes
  $mult = lc($mult);
  if ($mult eq 'b') {
   $res+=$s;
  } elsif ($mult eq 'kb') {
   $res+=$s*1024;
  } elsif ($mult eq 'mb') {
   $res+=$s*1048576;
  } elsif ($mult eq 'gb') {
   $res+=$s*1073741824;
  } elsif ($mult eq 'tb') {
   $res+=$s*1099511627776;
  }
 }
 return $res;
}

sub decodeMimeWord {
    my ($fulltext,$charset,$encoding,$text)=@_;
    my $ret;

    eval {$charset = Encode::resolve_alias(uc($charset));} if $charset;

    if (! $@ && $CanUseEMM && $charset ) {
        eval{$ret = MIME::Words::decode_mimewords($fulltext)} if $fulltext;
        return $ret unless $@;
    }

    if (lc $encoding eq 'b') {
        $text=base64decode($text);
    } elsif (lc $encoding eq 'q') {
        $text=~s/_/\x20/go; # RFC 1522, Q rule 2
        $text=~s/=([\da-fA-F]{2})/pack('C', hex($1))/geo; # RFC 1522, Q rule 1
    };
    return $text;
}

sub decodeMimeWords {
    my $s = shift;
    headerUnwrap($s);
    $s =~ s/(=\?([^?]+)\?(b|q)\?([^?]*)\?=)/decodeMimeWord($1,$2,$3,$4)/gieo;
    return $s;
}

sub assp_encode_Q {
    my $str = shift;
    my $out;
    eval {$out = MIME::QuotedPrint::encode_qp($str,'');1;}
      or do {mlog(0,"info: unable to encode string to quoted-printable - $@");};
    return $out;
}

sub assp_encode_B {
    my $str = shift;
    my $out;
    eval {$out = MIME::Base64::encode_base64($str, '');1;}
      or do {mlog(0,"warning: unable to encode string to base64 - $@");};
    return $out;
}

sub encodeMimeWord {
    my $word = shift;
    return '' unless $word;
    my $encoding = uc(shift || 'Q');
    my $charset  = uc(shift || 'UTF-8');
    my $encfunc  = (($encoding eq 'Q') ? \&assp_encode_Q : \&assp_encode_B);
    my $encword = &$encfunc($word);
    if ($word && ! $encword && $encoding eq 'Q') {
        $encword = &assp_encode_B($word);
        $encoding = 'B';
    }
    return "=?$charset?$encoding?" . $encword . "?=";
}

sub downloadGripConf {
    d('downloadGripConf-start');
    my $ret;
    my $file = "$base/griplist.conf";
    $ret = downloadHTTP("http://downloads.sourceforge.net/project/assp/griplist/griplist.conf",
                 $file,
                 0,
                 "griplist.conf",5,9,2,1);
    mlog(0,"info: updated GRIPLIST upload and download URL's in $file") if $ret;
    $ret = 0;
    open my $GC , '<', $file or return 0;
    binmode $GC;
    while (<$GC>) {
        s/\r|\n//o;
        if (/^\s*(gripList(?:DownUrl|UpUrl|UpHost))\s*:\s*(.+)$/) {
            ${$1} = $2;
            $ret++;
        }
    }
    close
    mlog(0,"info: loaded GRIPLIST upload and download URL's from $file") if $ret;
    mlog(0,"info: GRIPLIST config $file is possibly incomplete") if $ret < 3;
    $gripListDownUrl =~ s/\*HOST\*/$gripListUpHost/o;
    $gripListUpUrl  =~ s/\*HOST\*/$gripListUpHost/o;
    return $ret;
}

sub downloadGrip {
    d('griplistdownload-start');
    my $ret;
    my $Iam = $WorkerNumber;
    my $old = 0;
    my $gripListDownUrlAdd;
    my $gripFile    = "$base/$griplist";
    my $dltime = time;
    my $n6;
    my $n4;
    my $dodelta;
    my %gripdelta;
    my $gripdeltaObj;
    my $bdbenv;

    mlog(0,"info: last full Griplist download was at: " .  timestring($Griplist{'255.255.255.255'}))  if $MaintenanceLog >= 2 && $Griplist{'255.255.255.255'};
    mlog(0,"info: last delta Griplist download was at: " . timestring($Griplist{'255.255.255.254'})) if $MaintenanceLog >= 2 && $Griplist{'255.255.255.254'};
    # check for previous bin download, so we can do delta now
    my $delta = '';
    if (-e "$gripFile.bin" && time - $Griplist{'255.255.255.255'} < 3600*24*7) {
        my $mtime = ftime("$gripFile.bin");  # full download once a week
        my ($sec, $min, $hour, $day, $mon, $year, $wday, $yday, $isdst) = gmtime($mtime);
	    $year += 1900;
	    $mon += 1;
	    $mtime = sprintf "%04d%02d%02d%02d%02d%02d", $year, $mon, $day, $hour, $min, $sec;
        $gripListDownUrlAdd = "&delta=$mtime";
        $delta = " (delta)";
        $dodelta = 1;
    }
    return if(! $ComWorker{$Iam}->{run});
    return if(time - $Griplist{'255.255.255.254'} < 3550 && -e "$gripFile.bin");

    if (open(my $TEMPFILE, ">", "$gripFile.tmp")) {
        #we can create the file, this is good, now close the file and keep going.
        close $TEMPFILE;
        unlink("$gripFile.tmp");
    } else {
        &mlog(0,"Griplist download failed: Cannot create $gripFile.tmp") if $MaintenanceLog;
        return;
    }

    &downloadGripConf();  # reload the griplist.conf
    my $gripListDownUrlL = $gripListDownUrl . $gripListDownUrlAdd;
    $ret = downloadHTTP($gripListDownUrlL,
        "$gripFile.tmp",
        \$NextGriplistDownload,
        "Griplist$delta",5,9,2,1);

    return if(! $ComWorker{$Iam}->{run});

    if ($ret) {
        open my $tf, '<',"$gripFile.tmp";
        binmode $tf;
        while (<$tf>) {
            s/\r|\n//go;
            if (/error/oi) {
                &mlog(0,"Griplist download failed - see file $gripFile.tmp") if $MaintenanceLog;
                close $tf;
                return;
            }
        }
        close $tf;
        
        # download complete
        my $filesize = -s "$gripFile.tmp";
        &mlog(0,"Griplist download completed: binary download $filesize bytes") if $MaintenanceLog;

        # enough data?
        if ($filesize < 12) {
            &mlog(0,"Griplist download error: grip data too small") if $MaintenanceLog;
            unlink("$gripFile.tmp");
            return;
        }
        if (open(my $TEMPFILE, ">", "$gripFile.pl")) {
            #we can create the file, this is good
            binmode $TEMPFILE;
            print $TEMPFILE <<'EOT';
use strict;

my ($gripFile,$delta) = @ARGV;
my $dltime = time;
$gripFile =~ s/\\/\//go;
# if we did a delta download, read in previous data so we can merge
my @binFiles;
push(@binFiles, "$gripFile.bin") if ($delta);
push(@binFiles, "$gripFile.tmp");

# convert binary download form to text form used by ASSP
my $buf;
my %grip = ();
my %gripdelta = ();

my $action = "read";
foreach my $binF (@binFiles) {
    my $binSize = -s $binF;
    open(BIN, $binF);
    binmode(BIN);
    read(BIN, $buf, $binSize);
    close(BIN);
    my $deltayonly = ($binF eq "$gripFile.tmp");

    # IPv6 count
    my ($n6h, $n6l) = unpack("N2", $buf);
    my $n6 = $n6h * 2**32 + $n6l;

    # IPv4 count
    my $n4 = unpack("x[N2] N", $buf);

    # decode IPv6 data
    my $x6 = 0;
    for (my $i = 0; $i < $n6; $i++) {
        my ($bip, $grey) = unpack("x[N2] x[N] x$x6 a8 C", $buf);
        my $ip = join(":", unpack("H4H4H4H4", $bip)) . ":";
        $ip =~ s/:0+([0-9a-f])/:$1/gio;
        $ip =~ s/:0:$/::/o;

        #                $grip{$ip} = $grey / 255;
        #                $gripdelta{$ip} = $grey / 255 if $deltayonly;
        $x6 += 9;
    }

    # decode IPv4 data
    my $x4 = 0;
    for (my $i = 0; $i < $n4; $i++) {
        my ($bip, $grey) = unpack("x[N2] x[N] x$x6 x$x4 a3 C", $buf);
        my $ip = join(".", unpack("C3", $bip));
        $grip{$ip} = $grey / 255;
        $gripdelta{$ip} = $grey / 255 if $deltayonly;
        $x4 += 4;
    }

    &gmlog("Griplist binary $action OK: $binF, $n6 IPv6 addresses, $n4 IPv4 addresses");
#    &gmlog("Griplist binary $action OK: $binF, $n4 IPv4 addresses");
    $action = "merge";
}

# remove download file
unlink("$gripFile.tmp");

# output binary version, so we can do a delta next time
&gmlog("Writing merged Griplist binary");
my $n6 = 0;
my $n4 = 0;
my ($buf6, $buf4);
while ( my ($ip,$v) = each %grip) {
    if ($ip =~ /:/o) {
        my $ip2 = $ip;
        $ip2 =~ s/([0-9a-f]*):/0000$1:/gio;
        $ip2 =~ s/0*([0-9a-f]{4}):/$1:/gio;
        $buf6 .= pack("H4H4H4H4", split(/:/o, $ip2));
        $buf6 .= pack("C", int($v * 255));
        $n6++;
    } else {
        $buf4 .= pack("C3C", split(/\./o, $ip), int($v * 255));
        $n4++;
    }
}
$buf = pack("N2", $n6/2**32, $n6);
$buf .= pack("N", $n4);
unlink("$gripFile.bin");
open (BIN, ">$gripFile.bin");
binmode(BIN);
print BIN $buf . $buf6 . $buf4;
close(BIN);
chmod 0644, "$gripFile.bin";
utime($dltime, $dltime, "$gripFile.bin"); # important - sets file's time to UTC for next delta time
&gmlog("Writing merged Griplist binary finished");

# output text version
unlink("$gripFile.delta");
unlink("$gripFile");
open (TEXT, ">$gripFile");
binmode(TEXT);
print TEXT "\n";
foreach my $ip (sort keys %grip) {
    printf TEXT "$ip\002%.2f\n", $grip{$ip};
}
close(TEXT);
gmlog("OK-$gripFile");

# output text version delta
open (TEXT, ">$gripFile.delta");
binmode(TEXT);
print TEXT "\n";
foreach my $ip (sort keys %gripdelta) {
    printf TEXT "$ip\002%.2f\n", $grip{$ip};
}
close(TEXT);
gmlog("OK-$gripFile.delta");

sub gmlog {
    my $text = shift;
    $text =~ s/\r|\n//go;
    $text .= "\n";
    print $text;
}
EOT
            close $TEMPFILE;
        } else {
            &mlog(0,"Griplist download failed: Cannot create $gripFile.pl") if $MaintenanceLog;
            return;
        }

        if (! -e "$gripFile.pl") {
            &mlog(0,"Griplist - download failed: Cannot find $gripFile.pl") if $MaintenanceLog;
            return;
        }
        
        &mlog(0,'Griplist - starting binary to text conversion for Griplist') if $MaintenanceLog;
        d('Griplist - starting binary to text conversion for Griplist');
        my $perl = $perl;
        my $cmd = "\"$perl\" \"$gripFile.pl\" \"$gripFile\" \"$delta\"";
        $cmd =~ s/\//\\/go if $^O eq "MSWin32";
        my $out = qx($cmd);

        foreach (split(/\n/o,$out)) {
            s/\r|\n//go;
            if (/^OK-(.+)$/io) {
                mlog(0,"Griplist - converted file $1 found - OK") if $MaintenanceLog >= 2;
                next;
            }
            mlog(0,$_) if $MaintenanceLog;
        }
        unlink("$gripFile.pl");

        if ($CanUseBerkeleyDB && ($useDB4IntCache or $useDB4griplist)) {
            mlog(0,"Griplist update uses BerkeleyDB for temporary hashes") if $MaintenanceLog;
            -d "$base/tmpDB/gripdelta" or mkdir "$base/tmpDB/gripdelta",0775;

eval (<<'EOT');
          $bdbenv = BerkeleyDB::Env->new(-Flags => DB_CREATE | DB_INIT_MPOOL,
                                      -Cachesize => 5242880 ,
                                      -Home => "$base/tmpDB/gripdelta",
                                      -Config => {DB_DATA_DIR => "$base/tmpDB/gripdelta",
                                                  DB_LOG_DIR  => "$base/tmpDB/gripdelta",
                                                  DB_TMP_DIR  => "$base/tmpDB/gripdelta"}
                                              );

          $gripdeltaObj=tie %gripdelta,'BerkeleyDB::Hash',
                                     (-Filename => "$base/tmpDB/gripdelta/gripdelta.bdb" ,
                                      -Flags => DB_CREATE,
                                      -Env => $bdbenv);
EOT

            if ($@ or $BerkeleyDB::Error !~ /: 0\s*$/o) {
                mlog(0,"BerkeleyDB-ENV-ERROR gripdelta: $@ - BDB:$BerkeleyDB::Error");
            }
        } elsif ($CanUseDB_File && $useDB4IntCache) {
            mlog(0,"Griplist update uses DB_File for temporary hashes") if $MaintenanceLog;
eval (<<'EOT');
        $gripdeltaObj = tie %gripdelta, 'DB_File', "$base/tmpDB/gripdelta/gripdelta.bdb";
EOT
            mlog(0,"Griplist - DB_File-ERROR: $@") if $@;
        }

        my $nd = 0;my $TEMPFILE;
        if ($dodelta) {
            open $TEMPFILE,'<', "$gripFile.delta" ;
        } else {
            open $TEMPFILE,'<', "$gripFile" ;
        }
        $n4 = $n6 = 0;
        while (<$TEMPFILE>) {
            my ($k,$v) = split/\002/o;
            chomp $v;
            next unless ($k && $v);
            next if $k =~ /$IPprivate/o;
            if ($k =~ /:/o) {
                $n6++;
            } else {
                $n4++;
            }
            $Griplist{$k} = $v;
            $gripdelta{$k} = $v unless $dodelta;
            $nd++;
            if ($nd%1000 == 0) {
                threads->yield();
                $lastd{10000} = "Griplist - reading $nd records";
            }
            last if(! $ComWorker{$Iam}->{run});
        }
        close $TEMPFILE;
        &BDB_sync_hash('Griplist') if "$GriplistObj" =~ /BerkeleyDB/o;
        mlog(0,"Griplist - finished adding/updating $nd new records") if $MaintenanceLog;
        if (! $dodelta) {
            return if(! $ComWorker{$Iam}->{run});
            mlog(0,'Griplist - start remove old records after full download') if $MaintenanceLog;
            d('Griplist - start remove old records after full download');
            $nd = 0;
            while ( my ($ip,$v) = each %Griplist) {
                if (! exists $gripdelta{$ip}
                    && $ip ne 'x'
                    && $ip ne '255.255.255.255'
                    && $ip ne '255.255.255.254')
                {
                    delete $Griplist{$ip};
                    $nd++;
                }
                if ($nd%1000 == 0) {
                    threads->yield();
                    $lastd{10000} = "Griplist - deleting $nd old records";
                }
                last if(! $ComWorker{$Iam}->{run});
            }
            mlog(0,"Griplist - finished removing $nd old records") if $MaintenanceLog;
            &BDB_sync_hash('Griplist') if "$GriplistObj" =~ /BerkeleyDB/o;;
        }

        %gripdelta = ();
        undef $gripdeltaObj;
        eval{untie %gripdelta;};
        undef %gripdelta;
        undef $bdbenv;
        unlink "$base/tmpDB/gripdelta/gripdelta.bdb";
        unlink "$base/tmpDB/gripdelta/__db.001";
        unlink "$base/tmpDB/gripdelta/__db.002";
        unlink "$base/tmpDB/gripdelta/__db.003";
        unlink "$base/tmpDB/gripdelta/__db.004";

        $Griplist{'255.255.255.255'} = time if (! $dodelta || ! exists $Griplist{'255.255.255.255'});  # last full download
        $Griplist{'255.255.255.254'} = time;               # last download
        if ($ispgripvalue eq '') {
            mlog(0,"Griplist - calculating ISP grey value") if $MaintenanceLog;
            my $ns = 0;
            my $nh = 0;
            my $nd = 0;
            while ( my ($ip,$v) = each %Griplist) {
                next if $ip eq '255.255.255.255';
                next if $ip eq '255.255.255.254';
                next if $ip eq 'x';
                if ($v > $baysProbability) {$ns++;} else {$nh++;}
                $nd++;
                if ($nd%1000 == 0) {
                    threads->yield();
                    $lastd{10000} = "Griplist - $nd records - for ISP grey value";
                }
                last if(! $ComWorker{$Iam}->{run});
            }
            if($ComWorker{$Iam}->{run}) {
                my $x = sprintf("%.3f", $ns / ($ns + $nh + 1) );
                $x = 0.99 if $x >= 1;
                mlog(0,"Griplist - ISP grey value is set to $x (s:$ns , h:$nh)") if $MaintenanceLog;
                $Griplist{x} = $x;
            }
        }
        
        mlog(0,"Griplist update complete: $n6 IPv6 addresses, $n4 IPv4 addresses\n");

        if ($GriplistDriver eq 'orderedtie') {
            $GriplistObj->flush();
            $GriplistObj->{updated} = {};
        } elsif (open(my $F, '>', "$base/$griplist")) {
            binmode $F;
            print $F "\n";
            while ( my ($ip,$v) = each %Griplist) {
                print $F "$ip\002$v\n" if $ip && $v;
            }
            close $F;
        }
        
        $ConfigChanged = 1;         # tell all to reload Config
    }
    unlink("$gripFile.tmp");
    return $ret;
}

sub reloadGriplist {
   if ($griplist) {
        if ($GriplistDriver eq 'orderedtie') {
            if (! $GriplistObj) {
                $GriplistObj=tie %Griplist,$GriplistDriver,$GriplistFile;
                $GriplistObj->resetCache();
                my $r = loadHashFromFile("$base/$griplist", $GriplistObj->{cache}) || 'no';
                mlog(0,"info: Griplist has $r records") if $MaintenanceLog >= 2;
                $GriplistObj->{max} = 999999999999;
                $GriplistObj->{bin} = 0;
            }
            if (ftime($GriplistObj->{fn}) != $GriplistObj->{age}) {
                $GriplistObj->resetCache();
                my $r = loadHashFromFile("$base/$griplist", $GriplistObj->{cache}) || 'no';
                mlog(0,"info: Griplist has $r records") if $MaintenanceLog >= 2;
            }
        } elsif ($GriplistDriver eq 'BerkeleyDB::Hash' && $useDB4griplist && ! $GriplistObj) {
            my $file = "$base/$griplist";
            my $env = &createBDBEnv('Griplist');
            &tieToBDB('Griplist', "$file.bdb", $env);
        }
    }
}

sub downloadDropList {
    d('droplistdownload-start');
    my $ret;
    my ($file) = $droplist =~ /^ *file: *(.+)/io;
    $ret = downloadHTTP("http://www.spamhaus.org/drop/drop.lasso",
                 "$base/$file.tmp",
                 \$NextDroplistDownload,
                 "Droplist",5,9,2,1) if $file;
    if ($ret) {
        open (my $F, '<' , "$base/$file.tmp") or return;
        my $firstline = <$F>;
        close $F;
        if ($firstline =~ /^\s*;\s*Spamhaus\s+DROP\s+List/io ) {
            unlink "$base/$file";
            copy("$base/$file.tmp","$base/$file");
        } else {
            mlog(0,"warning: the file $droplist was downloaded but contains no usable data - ignoring the download");
            return;
        }
        $ConfigChanged = 1;         # tell all to reload Config
    }
    return $ret;
}

sub downloadTLDList {
    d('TLDlistdownload-start');
    my $ret;
    my $ret2;
    my $ret3;
    my $n1;
    my $n2;
    my $n3;
    $NextTLDlistDownload = time + 7200;

    my ($file) = $TLDS =~ /^ *file: *(.+)/io;
    $ret = downloadHTTP(
                 $tlds_alpha_URL,
                 "$base/$file",
                 \$n1,
                 "TLDlist",24,48,2,1) if $file;

    ($file) = $URIBLCCTLDS =~ /^ *file: *(.+)/io;
    $ret2 = downloadHTTP(
                 $tlds2_URL,
                 "$base/files/URIBLCCTLDS-L2.txt",
                 \$n2,
                 "level-2-TLDlist",24,48,2,1) if $file;
    $ret3 = downloadHTTP(
                 $tlds3_URL,
                 "$base/files/URIBLCCTLDS-L3.txt",
                 \$n3,
                 "level-3-TLDlist",24,48,2,1) if $file;

    if (! $file) {
        if ($n1) {
            $NextTLDlistDownload = $n1;
            return $ret;
        }
    }
    
    $NextTLDlistDownload  =  ($n1 && $n1 < $n2) ? $n1 : ($n2 > 0) ? $n2 : $NextTLDlistDownload;
    $NextTLDlistDownload  =  $n3 if $n3 &&  $NextTLDlistDownload > $n3;

    if ($file &&
        -s "$base/files/URIBLCCTLDS-L2.txt" > 0 &&
        -s "$base/files/URIBLCCTLDS-L3.txt" > 0 &&
        ($ret2 || $ret3 || ! -e "$base/$file" || -s "$base/$file" == 0))
    {
        if (((open my $f1 ,'<' ,"$base/files/URIBLCCTLDS-L2.txt") || mlog(0,"error: unable to open $base/files/URIBLCCTLDS-L2.txt")&0) &&
            ((open my $f2 ,'<' ,"$base/files/URIBLCCTLDS-L3.txt") || mlog(0,"error: unable to open $base/files/URIBLCCTLDS-L3.txt")&0) &&
            ((open my $f3 ,'>' ,"$base/$file") || mlog(0,"error: unable to open $base/$file")&0))
        {
            binmode $f3;
            print $f3 "# three level TLDs\n\n";
            while (<$f2>) {
                s/\r*\n//o;
                next unless $_;
                print $f3 "$_\n";
            }
            mlog(0,"info: merged file $base/files/URIBLCCTLDS-L3.txt in to $base/$file for URIBLCCTLDS") if $MaintenanceLog >= 2;
            print $f3 "\n\n";
            print $f3 "# two level TLDs\n\n";
            while (<$f1>) {
                s/\r*\n//o;
                next unless $_;
                print $f3 "$_\n";
            }
            mlog(0,"info: merged file $base/files/URIBLCCTLDS-L2.txt in to $base/$file for URIBLCCTLDS") if $MaintenanceLog >= 2;
            close $f3;
            close $f2;
            close $f1;
            mlog(0,"info: file $base/$file updated for URIBLCCTLDS") if $MaintenanceLog;
            $ret2 = 1;
        } else {
            mlog(0,"error: unable to read or write one of the URIBLCCTLDS files - $!");
        }
    }

    $ConfigChanged = 1 if $ret || $ret2 || $ret3;         # tell all to reload Config
    return $ret || $ret2 || $ret3;
}

sub UpdateDownloadURLs {
    if (open my $UVS , '<',"$base/version.txt") {
        while (<$UVS>) {
            s/\n|\r//go;
            s/^\s+//o;
            s/\s+$//o;
            next if /^\s*[#;]/o;
            next unless $_;
            if (/^\s*versionURL\s*:\s*(http(?:s)?:\/\/.+)$/io) {
                my $old = $versionURL;
                $versionURL = $1;
                mlog(0,"adminupdate: version.txt file download URL changed from $old to $versionURL") if $versionURL ne $old;
                next;
            }
            if (/^\s*NewAsspURL\s*:\s*(http(?:s)?:\/\/.+)$/io) {
                my $old = $NewAsspURL;
                $NewAsspURL = $1;
                mlog(0,"adminupdate: ASSP file download URL changed from $old to $NewAsspURL") if $NewAsspURL ne $old;
                next;
            }
            if (/^\s*ChangeLogURL\s*:\s*(http(?:s)?:\/\/.+)$/io) {
                my $old = $ChangeLogURL;
                $ChangeLogURL = $1;
                mlog(0,"adminupdate: ASSP changelog download URL changed from $old to $ChangeLogURL") if $ChangeLogURL ne $old;
                next;
            }
            if (/^\s*(\w+)\s*:\s*(.+)$/io) {
                my ($var,$val) = ($1,$2);
                next unless defined ${$var};
                $val =~ s/\s+$//o;
                my $old = ${$var};
                ${$var} = $val;
                if (exists $Config{$var}) {
                    $Config{$var} = $val;
                    $ConfigChanged = 1;
                    mlog(0,"adminupdate: version file changed $var from $old to $val") if $val ne $old;
                }
                next;
            }
        }
        close $UVS;
    }
}

sub downloadVersionFile {
    d('downloadVersionFile-start');
    my $force;
    $force = 1 if ($NextASSPFileDownload == -1 or $NextVersionFileDownload == -1);
    &UpdateDownloadURLs();
    if (! $versionURL) {
        mlog(0,"warning: versionupdate: no download URL found for version.txt - skip update for 24 hours");
        $NextASSPFileDownload = time + 3600 * 24;
        $NextVersionFileDownload = time + 3600 * 24;
        return 0;
    }
    my $ret;
    my $file = "$base/version.txt";
    $ret = downloadHTTP("$versionURL",
                 $file,
                 \$NextVersionFileDownload,
                 "assp version check",16,12,4,4) if $file;
    if ($ret) {
        &UpdateDownloadURLs();
        downloadHTTP("$ChangeLogURL",
                     "$base/docs/changelog.txt",
                     0,
                     "assp change log",16,12,4,4);
    }
    if (open my $VS ,'<' ,"$file") {
        while (<$VS>) {
            s/\n|\r//og;
            s/^\s+//o;
            s/\s+$//o;
            next if /^\s*[#;]/o;
            next unless $_;
            if (/^\s*(\d+\.\d+\.\d+.+)$/o) {
                $availversion = $1;
                my $avv = "$availversion";
                my $stv = "$version$modversion";
                $avv =~ s/RC/\./gio;
                $stv =~ s/RC/\./gio;
                $avv =~ s/\s|\(|\)//gio;
                $stv =~ s/\s|\(|\)//gio;
                $stv = 0 if ($avv =~ /\d{5}(?:\.\d{1,2})?$/o && $stv =~ /(?:\.\d{1,2}){3}$/o);
                if ($avv gt $stv) {
                    mlog(0,"Info: new assp version $availversion is available for download at $NewAsspURL");
                    $ret = 1;
                } else {
                    $ret = 0;
                }
            }
            if (/^\s*versionURL\s*:\s*(http(?:s)?:\/\/.+)$/io) {
                $versionURL = $1;
            }
            if (/^\s*NewAsspURL\s*:\s*(http(?:s)?:\/\/.+)$/io) {
                $NewAsspURL = $1;
            }
        }
        close $VS;
    } else {
        $ret = 0;
    }
    return $ret || $force;
}

sub downloadASSPVersion {
    d('downloadASSPVersion-start');
    return 0 unless $AutoUpdateASSP;
    &UpdateDownloadURLs();
    if (! $NewAsspURL ) {
        mlog(0,"warning: autoupdate: no download URL found for assp.pl - skip update for 24 hours");
        $NextASSPFileDownload = time + 3600 * 24;
        $NextVersionFileDownload = time + 3600 * 24;
        return 0;
    }
    if (! $versionURL) {
        mlog(0,"warning: autoupdate: no download URL found for version.txt - skip update for 24 hours");
        $NextASSPFileDownload = time + 3600 * 24;
        $NextVersionFileDownload = time + 3600 * 24;
        return 0;
    }
    my $assp = $assp;
    $assp =~ s/\\/\//go;
    $assp =~ s/\/\//\//go;
    $assp = $base.'/'.$assp if ($assp !~ /\Q$base\E/io);
    if (-e "$base/download/assp.pl" && ! -w "$base/download/assp.pl") {
        mlog(0,"warning: autoupdate: unable to write to $base/download/assp.pl - skip update - please check the file permission");
        $NextASSPFileDownload = time + 3600;
        return 0;
    }
    if (-e "$base/download/assp.pl.gz" && ! -w "$base/download/assp.pl.gz") {
        mlog(0,"warning: autoupdate: unable to write to $base/download/assp.pl.gz - skip update - please check the file permission");
        $NextASSPFileDownload = time + 3600;
        return 0;
    }
    if (! -w "$assp") {
        mlog(0,"warning: autoupdate: unable to write to $assp - skip update - please check the file permission");
        $NextASSPFileDownload = time + 3600;
        return 0;
    }
    -d "$base/download" or mkdir "$base/download", 0755;
    if (! -e "$base/download/assp.pl" && ! copy("$assp","$base/download/assp.pl")) {
        mlog(0,"warning: autoupdate: unable to copy current script '$assp' to '$base/download/assp.pl' - skip update - $!");
        $NextASSPFileDownload = time + 3600;
        return 0;
    }
    unless (&downloadVersionFile()){
        $NextASSPFileDownload = $NextVersionFileDownload;
        return 0;
    }
    my $ret;
    $NextASSPFileDownload = 0;
    mlog(0,"Info: autoupdate: performing assp.pl.gz download to $base/download/assp.pl.gz") if $MaintenanceLog;
    $ret = downloadHTTP("$NewAsspURL",
                 "$base/download/assp.pl.gz",
                 \$NextASSPFileDownload,
                 "assp.pl.gz",16,12,4,4);
    return 0 unless $ret;
    mlog(0,"Info: autoupdate: new assp.pl.gz downloaded to $base/download/assp.pl.gz") if $MaintenanceLog;
    if (unzipgz("$base/download/assp.pl.gz", "$base/download/assp.pl")) {
        mlog(0,"info: autoupdate: new assp version '$base/download/assp.pl' available - version $availversion") if $MaintenanceLog;
    } else {
        mlog(0,"warning: autoupdate: unable to unzip '$base/download/assp.pl.gz' to '$base/download/assp.pl' - skip update");
        return 0;
    }
    mlog(0,"Info: saving current script '$assp' to 'assp_$version$modversion.pl'") if $MaintenanceLog;
    if (! copy("$assp","$base/download/assp_$version$modversion.pl")) {
        mlog(0,"warning: autoupdate: unable to save current script '$assp' to '$base/download/assp_$version$modversion.pl' - skip update - $!");
        return 0;
    }
    my $cmd;
    if ($^O eq "MSWin32") {
        $cmd = '"' . $perl . '"' . " -c \"$base/download/assp.pl\" \"$base\" 2>&1";
    } else {
        $cmd = '\'' . $perl . '\'' . " -c \'$base/download/assp.pl\' \'$base\' 2>&1";
    }
    my $res = qx($cmd);
    if ($res =~ /syntax\s+OK/igo) {
        mlog(0,"info: autoupdate: syntax check for '$base/download/assp.pl' returned OK");
    } else {
        mlog(0,"warning: autoupdate: syntax error in '$base/download/assp.pl' - skip assp.pl update - syntax error is: $res");
        return 0;
    }
    if ($res =~ /assp\s+(.+)?is starting/io) {
        my $avv = $1;
        $avv =~ s/RC/\./gio;
        $avv =~ s/\s|\(|\)//gio;
        my $stv = "$version$modversion";
        $stv =~ s/RC/\./gio;
        $stv =~ s/\s|\(|\)//gio;
        my $upd = 0;
        $upd = 1 if ($avv =~ /\d{5}(?:\.\d{1,2})?$/o && $stv =~ /(?:\.\d{1,2}){3}$/o);
        $upd ||= ($stv lt $avv);
        if (! $upd) {
            mlog(0,"warning: autoupdate: version of downloaded '$base/download/assp.pl' ($avv) is less or equal to the running version of assp ($stv) - skip assp.pl update");
            return 0;
        }
    }
    return 0 if $AutoUpdateASSP == 1;
    if (copy("$base/download/assp.pl", "$assp")) {
        mlog(0,"info: autoupdate: new version assp installed - '$assp' - version $availversion");
    } else {
        mlog(0,"warning: autoupdate: unable to replace current script '$assp' - skip update - $!");
        return 0;
    }
    return 1 if (lc $AutoRestartAfterCodeChange eq 'immed' &&
        ($AsAService || $AsADaemon || $AutoRestartCmd));
    $codeChanged = 1 if $AutoRestartAfterCodeChange;
    return 1;
}

sub downloadBackDNS {
    return 0 if !$BackDNSInterval;
    return 0 if $mysqlSlaveMode && $pbdb =~ /DB:/o && !($useDB4IntCache && $CanUseBerkeleyDB);
    d('BackDNSdownload-start');
    my $ret;
    my ($file) = $localBackDNSFile =~ /^ *file: *(.+)/io;
    $file = "$base/$file" if $file;
    my $gzfile = $file . '.gz';
    $ret = downloadHTTP($BackDNSFileURL,
                 "$gzfile",
                 \$NextBackDNSFileDownload,
                 "BackDNSFile",20,24,4,4) if $file;
    if ($ret) {
        if (! &unzipgz($gzfile,$file)) {
            $FileUpdate{"$file".'localBackDNSFile'} = ftime($file);
            return 0 ;
        }
    } else {
        $FileUpdate{"$file".'localBackDNSFile'} = ftime($file);
        return 0;
    }
    &mergeBackDNS($file);
    return 1;
}

sub mergeBackDNS {
    my $file = shift;
    d('mergeBackDNS-start');
    my $hash = $useDB4IntCache && $CanUseBerkeleyDB && ($DBusedDriver ne 'BerkeleyDB' or ($DBusedDriver eq 'BerkeleyDB' && $pbdb !~ /DB:/io) ) ? 'BackDNS2' : 'BackDNS';
    my $f;
    my $count = 0;
    my $tc = 0;
    my $time = time + 3600 * 30 - $BackDNSInterval * 3600 * 24;
    (open $f,'<' ,"$file") or return 0;
    mlog(0,"info: merging BackDNSFile $file in to cache $hash") if $MaintenanceLog;
    binmode $f;
    while (my $line = (<$f>)) {
        $line =~ s/\r?\n?$//o;
        next if $line =~ /^[^\d]|127\./o;
        ${$hash}{$line} = $time . ' 1';
        $count++;
        $tc++;
        if ($tc == 100) {
            $lastd{10000} = "filling $hash - $count records added from $file";
            last if(! $ComWorker{$WorkerNumber}->{run});
            $tc = 0;
            &ThreadMaintMain2() if $WorkerNumber == 10000;
        }
    }
    close $f;
    mlog(0,"info: finished merging BackDNSFile $file with $count records in to cache $hash") if $MaintenanceLog;
    $FileUpdate{"$file".'localBackDNSFile'} = ftime($file);
    return if(! $ComWorker{$WorkerNumber}->{run});
    if ($hash eq 'BackDNS2') {
        &cleanCacheBackDNS2();
    } else {
        &cleanCacheBackDNS() unless ($mysqlSlaveMode && $pbdb =~ /DB:/o);
    }
    return 1;
}

sub Perl_upgrade_log {
    my ($module,$inst_ver,$new_ver) = @_;
    open (my $F , '>>' , "$base/notes/upgraded_Perl_Modules.log") or return;
    binmode $F;
    print $F timestring() . " $module from $inst_ver to $new_ver\n";
    close $F;
    return;
}

sub Perl_upgrade_do {
    my $upg_package = shift;
    my $touse;
    $ENV{HTTP_proxy} = 'http://'.$proxyserver if ( $proxyserver && ! $ENV{HTTP_proxy});
    $ENV{HTTP_proxy_user} = $proxyuser if ($proxyuser && ! $ENV{HTTP_proxy_user});
    $ENV{HTTP_proxy_pass} = $proxypass if ($proxypass && ! $ENV{HTTP_proxy_pass});
    eval('
    use ActivePerl::PPM::limited_inc;
    use ActivePerl::PPM::Client;
    use ActivePerl::PPM::Web qw(web_ua);
    use ActivePerl::PPM::Logger qw(ppm_log);
    use ActivePerl::PPM::Util qw(is_cpan_package clean_err join_with update_html_toc);
    $touse = \'Perl_PPM_upgrade_do\';
    $^O eq "MSWin32" && defined ${chr(ord(",") << 1)};
    ')
    or do {
#    mlog(0,"info: PPM ??? $@");
    eval('
    if($> != 0 && $^O ne "MSWin32") {
        mlog(0,"warning: ASSP is not running as user root - skip CPAN Perl module update");
        return;
    }
    use CPAN;
    $touse = \'Perl_CPAN_upgrade_do\';
    defined ${chr(ord("\026") << 2)};
    ')} or do {
#    mlog(0,"info: CPAN ??? $@");
    return;
    };
    my @ret;
    @ret = $touse->($upg_package) if $touse;
    return wantarray ? @ret : $ret[0] ;
}

sub Perl_no_upgrade {
    open (my $F , '<' , "$base/files/noupgrade.txt") or return;
    my %modules;
    my %list;
    binmode $F;
    while (<$F>) {
        s/[\r\n\s]//go;
        s/[#;].*//o;
        next unless $_;
        $list{$_} = $modules{$_} = 1;
        s/::/-/go;
        $modules{$_} = 1;
    }
    close $F;
    foreach (keys %list) {
        mlog(0,"info: Perl auto module update will ignore module $_") if $MaintenanceLog;
    }
    return %modules;
}

sub Perl_CPAN_upgrade_do {
    my $upg_package = shift;
    my %avail;
    my $install;
    $install++ if $upg_package ;
    $upg_package = '' if $upg_package eq '--install';
    my $upg_running;
    my $upgrade_count;
    my @modules;
    d('CPAN - module upgrade');
    ThreadMaintMain2();
    my %skipModule = Perl_no_upgrade();
    eval {
        CPAN::Shell->o(qw(conf prerequisites_policy follow));
        CPAN::Shell->o(qw(conf connect_to_internet_ok yes));
        CPAN::Shell->o(qw(conf commit));
        @modules =  map {
                        $_->[1]
                    } sort {
                        $b->[0] <=> $a->[0]
                        ||
                        $a->[1]{ID} cmp $b->[1]{ID}
                    } map {
                        [ $_->_is_representative_module, $_ ]
                    } CPAN::Shell->expand('Module',CPAN::Shell->r);
        foreach ( @modules ) {
            next if ($upg_package && $_->id ne $upg_package);
            $avail{$_->id} = $_->cpan_version;
            $upgrade_count++;
        }
        if ($install) {
            foreach ( @modules ) {
                return wantarray ? %avail : $upgrade_count if(! $ComWorker{$WorkerNumber}->{run});
                ThreadMaintMain2();
                next if $skipModule{$_->id};
                next if ($upg_package && $_->id ne $upg_package);
                mlog(0,"perl-update: CPAN - update module ".$_->id." from version ".$_->inst_version." to version ".$_->cpan_version);
                eval { CPAN::Shell->install($_->id); Perl_upgrade_log($_->id,$_->inst_version,$_->cpan_version); 1;} or do {
                    mlog(0,"perl-update: CPAN - error - failed to updated module ".$_->id);
                    next;
                };
                delete $avail{$_->id};
                $upg_running ||= exists ${'::'}{$_->id.'::'};
                $upgrade_count--;
            }
        }
    };
    eval('
    no CPAN::Shell;
    no CPAN;
    ');
    $codeChanged = 2 if $upg_running;
    return wantarray ? %avail : $upgrade_count;
}

sub Perl_PPM_upgrade_do {
    my $upg_package = shift;
    my %repo;
    d('PPM - module upgrade');
    $repo{'5.10'} = {
        'trouchelle.510' => 'http://trouchelle.com/ppm10',
        'trouch-act' => 'http://trouchelle.com/ppm10/activestate/1000/',
        'uni_winnipeg.510' => 'http://cpan.uwinnipeg.ca/PPMPackages/10xx/',
        'bribes.org' => 'http://www.bribes.org/perl/ppm/',
        "$base\\assp.mod" => 'file:///'.$base.'/assp.mod/',
        'ASSP2' => 'http://downloads.sourceforge.net/project/assp/ASSP%20V2%20multithreading/packages/'
    };
    $repo{'5.12'} = {
        'trouchelle.512' => 'http://trouchelle.com/ppm12',
        'uni_winnipeg.512' => 'http://cpan.uwinnipeg.ca/PPMPackages/12xx/',
        'bribes.org' => 'http://www.bribes.org/perl/ppm/',
        "$base\\assp.mod" => 'file:///'.$base.'/assp.mod/',
        'ASSP2' => 'http://downloads.sourceforge.net/project/assp/ASSP%20V2%20multithreading/packages/'
    };
    $repo{'5.14'} = {
        'trouchelle.514' => 'http://trouchelle.com/ppm14',
        'uni_winnipeg.514' => 'http://cpan.uwinnipeg.ca/PPMPackages/14xx/',
        'bribes.org' => 'http://www.bribes.org/perl/ppm/',
        "$base\\assp.mod" => 'file:///'.$base.'/assp.mod/',
        'ASSP2' => 'http://downloads.sourceforge.net/project/assp/ASSP%20V2%20multithreading/packages/'
    };
    $repo{'5.16'} = {
#        'trouchelle.516' => 'http://trouchelle.com/ppm16',
#        'uni_winnipeg.516' => 'http://cpan.uwinnipeg.ca/PPMPackages/16xx/',
        'bribes.org' => 'http://www.bribes.org/perl/ppm/',
        "$base\\assp.mod" => 'file:///'.$base.'/assp.mod/',
        'ASSP2' => 'http://downloads.sourceforge.net/project/assp/ASSP%20V2%20multithreading/packages/'
    };
    $repo{'5.18'} = {
        'bribes.org' => 'http://www.bribes.org/perl/ppm/',
        "$base\\assp.mod" => 'file:///'.$base.'/assp.mod/',
        'ASSP2' => 'http://downloads.sourceforge.net/project/assp/ASSP%20V2%20multithreading/packages/'
    };
    my $ppm = ActivePerl::PPM::Client->new;
    my $install;
    my %avail;
    my $upg_running;
    my $sync = 1;

    $install++ if $upg_package ;
    $upg_package = '' if $upg_package eq '--install';
    my $pkg_count = 0;
    my %shaddow;
    my %shaddow2;
    my $vstr = $];
    $vstr =~ s/^(\d\.)0(\d\d).*$/$1$2/o;
    mlog(0,"perl-update: checking PPM repositories for Perl $vstr");
    if (! exists $repo{$vstr} ) {
        mlog(0,"perl-update: error - Perl $vstr is not supported by ASSP");
        return ;
    }
    my %rep;
    for ($ppm->repos) {$rep{ $ppm->repo($_)->{name} }++ ;}
    while ( my ($k,$v) = each %{$repo{$vstr}} ) {
        if ($rep{$k} > 1) {
            for ($ppm->repos) {$ppm->repo($_)->{name} eq $k && eval{$ppm->repo_delete($_);};}
            delete $rep{$k};
        }
        next if $rep{$k};
        eval{$ppm->repo_add('name' => $k, 'packlist_uri' => $v);};
        ThreadMaintMain2();
    }
    my @rep;
    $ppm->repo_sync if $sync;
    ThreadMaintMain2();
    for ($ppm->repos) {push @rep, $ppm->repo($_)->{name};}
    mlog(0,"perl-update: using the following PPM repositories: \n".join("\n",@rep));
    my %skipModule = Perl_no_upgrade();
    for my $area_name ($ppm->areas) {
    	my $area = $ppm->area($area_name);
    	my $newfound;
        my @pack;
    	for ($area->packages("id", "name", "version")) {
            my $pack = $_;
    	    my($pkg_id, $pkg_name, $pkg_version) = @$_;
    	    return wantarray ? %avail : $pkg_count if(! $ComWorker{$WorkerNumber}->{run});
    	    ThreadMaintMain2();
    	    next if $upg_package && lc($upg_package) ne lc($pkg_name);
    	    next if $shaddow2{$pkg_name}++;
    	    eval {
        	    if (my $best = $ppm->package_best($pkg_name, 0)) {
            		if ($best->{name} eq $pkg_name && $best->{version} ne $pkg_version) {
            		    my $pkg = $area->package($pkg_id);
            		    if ($best->better_than($pkg)) {
                            push @pack, $pack;
                			$avail{$pkg_name} = $best->{version};
    	                    $pkg_count++;
    	                    $newfound = 1;
                		}
                	}
                }
            };
    	}
    	next if ( ! $install || ! $newfound);
    	ThreadMaintMain2();
    	for (@pack) {
    	    my($pkg_id, $pkg_name, $pkg_version) = @$_;
    	    ThreadMaintMain2();
    	    return wantarray ? %avail : $pkg_count if(! $ComWorker{$WorkerNumber}->{run});
            next if $skipModule{$pkg_name};
    	    next if $upg_package && lc($upg_package) ne lc($pkg_name);
    	    next if $shaddow{$pkg_name}++;
    	    eval {
        	    if (my $best = $ppm->package_best($pkg_name, 0)) {
            		if ($best->{name} eq $pkg_name && $best->{version} ne $pkg_version) {
            		    my $pkg = $area->package($pkg_id);
            		    if ($best->better_than($pkg)) {
                			mlog(0, "perl-update: PPM - $pkg_name $best->{version} (have $pkg_version)");
                			if ($install) {
                			    my $install_area = $area_name;
                			    if ($install_area eq "perl" || $area->readonly) {
                    				$install_area = $ppm->default_install_area;
                    				unless ($install_area) {
                    				    mlog(0, "perl-update: PPM - No writable install area for the upgrade of module $pkg_name");
                                        next;
                    				}
                			    }
                			    if (Perl_PPM_upgrade_install($install_area, 0, $ppm ,$best)) {
                                    delete $avail{$pkg_name};
                                    Perl_upgrade_log($pkg_name,$pkg_version,$best->{version});
                                    $upg_running ||= exists ${'::'}{$pkg_name.'::'};
                                    $pkg_count--;
                			    }
                			}
            		    }
            		}
        	    }
    	    };
    	    if ($@) {
    		    mlog(0, "perl-update: PPM - error $@");
                if ($@ =~ /Can't save to (.+?\.ppmbak) /io) {
                    mlog(0,"perl-update: PPM - removed obsolet backup file '$1' for the next update") if unlink($1);
                }
    	    }
    	}
    }
    eval('
    no ActivePerl::PPM::Util;
    no ActivePerl::PPM::Logger;
    no ActivePerl::PPM::Web;
    no ActivePerl::PPM::Client;
    no ActivePerl::PPM::limited_inc;
    ');
    $codeChanged = 2 if $upg_running;
    return wantarray ? %avail : $pkg_count;
}

sub Perl_PPM_upgrade_install {
    my $area = shift;
    my $force = shift;
    my $ppm = shift;
    unless (@_) {
    	mlog(0, "perl-update: PPM - No missing packages to install");
    	return 0;
    }

    unless ($force) {
    	my $stop;
    	for my $pkg (@_) {
    	    if (my $why = $ppm->cannot_install($pkg)) {
        		mlog(0, "perl-update: PPM - Can't install ". $pkg->name_version. ": ". $why);
        		$stop++;
    	    }
    	}
    	if ($stop) {
    	    return 0;
    	}
    }

    unless ($area) {
    	$area = $ppm->default_install_area;
    	unless ($area) {
    	    my $msg = "All available install areas are readonly. Run 'ppm help area' to learn how to set up private areas.";
    	    require ActiveState::Path;
    	    if (ActiveState::Path::find_prog("sudo")) {
        		$msg .= "\nYou might also try 'sudo ppm' to raise your privileges.";
    	    }
    	    mlog(0, "perl-update: PPM - error - $msg");
            return 0;
    	}
    }
	mlog(0, "perl-update: PPM - Installing into $area");
    $area = $ppm->area($area);

    local $| = 1;

    my $summary = $ppm->install(packages => \@_, area => $area, force => $force);
    if (my $count = $summary->{count}) {
    	for my $what (sort keys %$count) {
    	    my $n = $count->{$what} || 0;
    	    mlog(0, (sprintf "perl-update: PPM - %4d file%s %s\n", $n, ($n == 1 ? "" : "s"), $what));
    	}
        return 1;
    }
    return 0;
}

sub uploadStats {
 d('uploadStats');
 my ($peeraddress,$connect,$hostaddress);
 if ($proxyserver) {
        mlog( 0, "uploading stats via proxy:$proxyserver" ) if $MaintenanceLog;
        my $user = $proxyuser ? "$proxyuser:$proxypass\@": '';
        $peeraddress = $user . $proxyserver;
        $hostaddress = $proxyserver;
        $connect =
          'POST http://assp.sourceforge.net/cgi-bin/assp_stats HTTP/1.0';
 } else {
        mlog( 0, 'uploading stats via direct connection' ) if $MaintenanceLog;
        $peeraddress = 'assp.sourceforge.net:80';
        $hostaddress = 'assp.sourceforge.net';
        $connect     = "POST /cgi-bin/assp_stats HTTP/1.1
Host: assp.sourceforge.net";
 }
 my $s = $CanUseIOSocketINET6
         ? IO::Socket::INET6->new(Proto=>'tcp',PeerAddr=>$peeraddress,Timeout=>2,&getDestSockDom($hostaddress))
         : IO::Socket::INET->new(Proto=>'tcp',PeerAddr=>$peeraddress,Timeout=>2);
 if($s) {
  my %UploadStats = ();
  my $buf;
  {lock(%Stats) if (is_shared(%Stats));
        my %tots=statsTotals();

        %UploadStats = %Stats;

        $UploadStats{upproto_version}      = 2;
        $UploadStats{timenow}              = time;
        $UploadStats{connects}             = $tots{smtpConnTotal};
        $UploadStats{messages}             = $tots{msgTotal};
        $UploadStats{spams}                = $tots{msgRejectedTotal} - $Stats{bspams};
        delete $UploadStats{nextUpload};
        $UploadStats{denyConnection} += $UploadStats{denyConnectionA};
        delete $UploadStats{denyConnectionA};
        $UploadStats{dkim} += $UploadStats{dkimpre}; delete $UploadStats{dkimpre};
  }
  my $content=join("\001",%UploadStats);
  my $len=length($content);
  $connect.="
Content-Type: application/x-www-form-urlencoded
Content-Length: $len

$content";
  eval{$s->blocking(0);};
  NoLoopSyswrite( $s , $connect,0);
  sleep(1);
  $ThreadIdleTime{$WorkerNumber} += 1;
  eval{$s->sysread($buf, 4096);};
  eval{$s->close;};
 } else {
  mlog(0,"unable to connect to stats server");
 }
 $Stats{nextUpload} = $nextStatsUpload = time+3600*8;
}

sub ResetStats {
 d('ResetStats');
 lock(%Stats) if (is_shared(%Stats));
 foreach (keys %Stats) {
     next if $_ eq 'version';
     next if $_ eq 'Counter';
     $Stats{$_} = 0;
 }
 $Stats{nextUpload} = $nextStatsUpload = time+3600*8;
 $Stats{starttime} = time;
 for (0,1...$NumComWorkers,10000,10001) {
    $ThreadIdleTime{$_} = 0;
 }

 my $RSf;
 my $tosave = 0;
 if (open( $RSf,'<',"$base/asspstats.sav")) {
     (%OldStats)=split(/\001/o,<$RSf>);
     close $RSf;
 } elsif (-e "$base/asspstats.sav") {
     mlog(0,"error: unable to open file $base/asspstats.sav for reading - $!");
 } else {
     $tosave = 1;
 }
 if (open($RSf,'<',"$base/asspscorestats.sav")) {
     (%OldScoreStats)=split(/\001/o,<$RSf>);
     close $RSf;
 } elsif (-e "$base/asspscorestats.sav") {
     mlog(0,"error: unable to open file $base/asspscorestats.sav for reading - $!");
 } else {
     $tosave = 1;
 }
 foreach (keys %ScoreStats, keys %OldScoreStats) {
     $ScoreStats{$_} = 0;
 }

 $Stats{Counter} = $OldStats{Counter};
 # conversion from previous versions
 if (exists $OldStats{messages}) {
  $OldStats{smtpConn}=$OldStats{connects};
  $OldStats{smtpConnLimit}=$OldStats{maxSMTP};
  $OldStats{smtpConnLimitIP}=$OldStats{maxSMTPip};
  $OldStats{viri}-=$OldStats{viridetected}; # fix double counting
  $OldStats{rcptRelayRejected}=$OldStats{norelays};
  # remove unused entries
  delete $OldStats{connects};
  delete $OldStats{maxSMTP};
  delete $OldStats{maxSMTPip};
  delete $OldStats{messages};
  delete $OldStats{spams};
  delete $OldStats{hams};
  delete $OldStats{norelays};
  delete $OldStats{testmode};
  $tosave = 1;
 }
 if ($OldStats{cpuTime} < 0 || $OldStats{cpuTime} < $OldStats{cpuBusyTime}) {
  $OldStats{cpuTime} = $OldStats{cpuBusyTime} = 0;
  $tosave = 1;
 }
 SaveStats() if $tosave;
}

sub StatCpuStats {
    my $upt = time - $Stats{starttime};
    $Stats{cpuTime} = $upt * ($NumComWorkers + 3);
    my $widle = &workerIdleTime();
    $widle = min($widle,$Stats{cpuTime});
    $Stats{cpuBusyTime} = ($Stats{cpuTime} - $widle) || 1;
}

sub StatAllStats {
 %AllStats=%OldStats;
 &StatCpuStats();
 $AllStats{starttime}=$OldStats{starttime} || $Stats{starttime};
 foreach (keys %Stats) {
  if ($_ eq 'version' or $_ eq 'Counter') {
   # just copy
   $AllStats{$_}=$Stats{$_};
  } elsif ($_ eq 'smtpMaxConcurrentSessions') {
   # pick greater value
   $AllStats{$_}=$Stats{$_} if $Stats{$_}>$AllStats{$_};
  } else {
   $AllStats{$_}+=$Stats{$_};
  }
 }
 $AllStats{starttime}=$OldStats{starttime} || $Stats{starttime};

 %AllScoreStats=%OldScoreStats;
 foreach (keys %ScoreStats) {
   $AllScoreStats{$_}+=$ScoreStats{$_};
 }
}

sub SaveStats {
 d('SaveStats');
 for ('rcptReportHelp', 'rcptReportAnalyze') {
     delete $Stats{$_};
     delete $OldStats{$_};
     delete $AllStats{$_};
 }
 lock(%Stats) if (is_shared(%Stats));
 mlog(0,"info: saving Stats in file asspstats.sav") if $MaintenanceLog;
 $Stats{smtpConcurrentSessions}=$smtpConcurrentSessions;
 ScheduleMapSet('SaveStatsEvery') if $WorkerName ne 'Shutdown';;
 &StatAllStats();
 my $SS;
 if (open($SS,'>',"$base/asspstats.sav")) {
     print $SS join("\001",%AllStats);
     close $SS;
 } else {
     mlog(0,"warning: unable to save STATS to $base/asspstats.sav - $!");
 }

 my $time = timestring('','','YYYY-MM-DD_hh:mm:ss');
 my $fext = substr($time,0,7);
 if ($enableGraphStats && open($SS, '>>', "$base/logs/statGraphStats-$fext.txt")) {
     binmode $SS;
     foreach (sort {lc($main::a) cmp lc($main::b)} keys(%AllStats)) {
         next if /^(?:nextUpload|version|starttime)$/o;
         $AllStats{$_} ||= 0;
         print $SS "$time $_: $AllStats{$_}\n";
     }
     close $SS;
 }

 mlog(0,"info: saving ScoreStats in file asspscorestats.sav") if $MaintenanceLog;
 if (open($SS,'>',"$base/asspscorestats.sav")) {
     print $SS join("\001",%AllScoreStats);
     close $SS;
 } else {
     mlog(0,"warning: unable to save scoring STATS to $base/asspscorestats.sav - $!");
 }

 if ($enableGraphStats && open($SS, '>>', "$base/logs/scoreGraphStats-$fext.txt")) {
     binmode $SS;
     foreach (sort {lc($main::a) cmp lc($main::b)} keys(%AllScoreStats)) {
         $AllScoreStats{$_} ||= 0;
         print $SS "$time $_: $AllScoreStats{$_}\n";
     }
     close $SS;
 }
}

#####################################################################################
#                Maillog functions
# find an appropriate name for a maillog file
sub maillogFilename {
    my ($fh,$isspam)  = @_;
    d('maillogFilename');
    return if ! $fh;
    my $this=$Con{$fh};
    my @dirs    = ( $notspamlog, $spamlog, $incomingOkMail, $viruslog, $discarded, $discarded );
    my $maillog = $dirs[$isspam];
    return if ! $maillog;
    my $sub; my $sub2;
    if (! $this->{subject} || $UseSubjectsAsMaillogNames) {
        if ($this->{subject2}) {
            $sub = $this->{subject2};
        } else {
            $sub = $1 if (substr($this->{header},0,index($this->{header},"\015\012\015\012")) =~ /\015\012Subject: *($HeaderValueRe)/iso);
            if (!$sub && $this->{maillogbuf}) {
                $sub = $1 if (substr($this->{maillogbuf},0,index($this->{maillogbuf},"\015\012\015\012")) =~ /\015\012Subject: *($HeaderValueRe)/iso);
            }
        }
        $sub =~ s/\r\n\s*//go;

        $sub =~ s/\r?\n$//o;
        $sub =~ s/$NONPRINT//go;
        $sub = decodeMimeWords2UTF8($sub);

        $sub2 = $sub;
        $sub = d8($sub);
        $sub =~ s/[^a-zA-Z0-9]/_/go if (! ($UseUnicode4MaillogNames && $canUnicode));
        $sub =~ s/[\^\s\<\>\?\"\'\:\|\\\/\*\&\.]/_/igo;  # remove not allowed characters and spaces from file name
        $sub =~s/\.{2,}/./go;
        $sub =~s/_{2,}/_/go;
        $sub =~s/[_\.]+$//o;
        $sub =~s/^[_\.]+//o;
        if (! $this->{subject}) {
            $this->{subject} = substr( $sub, 0, 50 );
            $this->{subject} = e8($this->{subject});
        }
        $sub = substr($sub,0,($MaxFileNameLength ? $MaxFileNameLength : 50))
            if($UseSubjectsAsMaillogNames);
        $sub = e8($sub);
    }

    my $Counter = $this->{hasmallogname};
    if (! $this->{hasmallogname}) {
        lock(%Stats) if (is_shared(%Stats));
        lock($lockSpamfileNames) if is_shared($lockSpamfileNames) && ! is_shared(%Stats);
        if (($Counter = ++$Stats{Counter}) > 999999999) {
            threads->yield();
            $Counter = $Stats{Counter} = 1;
        }
        threads->yield();
    }
    
    if ( $UseSubjectsAsMaillogNames
         && $sub
         && $discarded
         && $isspam == 1
         && $MaxAllowedDups
         && ! $this->{hasmallogname}
         && ! $RunTaskNow{'fillSpamfiles'}
         && $sub2 !~ /$AllowedDupSubjectReRE/)
    {
          my $md5sub = Digest::MD5::md5($sub) ;
          lock($lockSpamfileNames) if is_shared($lockSpamfileNames);
          threads->yield();
          if ($Spamfiles{$md5sub} >= $MaxAllowedDups) {
              my @nums = sort {$main::a <=> $main::b} split(/\s+/o, $SpamfileNames{$md5sub});
              my $num = shift @nums;
              push @nums , $Counter;
              $SpamfileNames{$md5sub} = join(' ',@nums);
              my $source = "$base/$spamlog/$sub--$num$maillogExt";
              my $target = "$base/$discarded/$sub--$num$maillogExt";
              mlog($fh,"MaxAllowedDups reached for this subject - moved oldest file $source to $target")
                  if $move->($source,$target) && $SessionLog;
          } else {
              $SpamfileNames{$md5sub} .= ' ' if $Spamfiles{$md5sub}++;
              $SpamfileNames{$md5sub} .= $Counter;
          }
          threads->yield();
    }

    $this->{hasmallogname} = $Counter;
    if ( $UseSubjectsAsMaillogNames || $isspam == 2 || $isspam == 3 ) {
        $sub .= "--" . $Counter;
    } elsif ( ! $UseSubjectsAsMaillogNames
             && $MaintBayesCollection
             && (   $MaxBayesFileAge && $isspam < 2
                 || $MaxNoBayesFileAge && $isspam > 1)
            )
    {
        $sub = $this->{mfn} . "--" . $Counter ;
    } else {
        $sub = $this->{mfn};
    }
    my $ret = "$base/$maillog/$sub$maillogExt";
    return $ret;
}

sub maillogNewFileName {
    my $fn;

    if ($FilesDistribution<1.0) {
        my $p1=1.0-$FilesDistribution;
        my $p2=log($FilesDistribution);
        $fn=int($MaxFiles*log(1.0-rand($p1))/$p2);
    } else {
        $fn=int($MaxFiles*rand());
    }
    return $fn;
}

sub Maillog {
    my ( $fh, $text, $parm ) = @_;
    my $fln;
    my $isnotcc;
    d('Maillog');
    return unless $fh;
    if ( $parm == 1 ) {
        $parm    = 3;
        $isnotcc = 1;
    }

# 0 -- no collection, 1 -- is spam, parm = 2 -- not spam,
# 3 -- is spam && cc to spamaccount, 4 -- mail ok, 5 -- virii
# 6 -- discard folder, 7 -- discard folder && cc to spamaccount
    return
      if ( $parm == 2 || $parm == 4 ) && $Con{$fh}->{red} && $DoNotCollectRedRe;
    return unless ( $Con{$fh}->{maillog} );
    return if ( $Con{$fh}->{nocollect} );
    return if $Con{$fh}->{isbounce} && $DoNotCollectBounces;
    return if $Con{$fh}->{noprocessing} && ( $parm == 2 || $parm == 4 ) && ! $noProcessingLog;
    if ( matchSL( $Con{$fh}->{mailfrom}, 'noCollecting' ) ) {
        $Con{$fh}->{nocollect} = 1;
        return;
      }
    $parm = 1
      if $ccMaxScore && ( $parm == 3 && $Con{$fh}->{messagescore} > $ccMaxScore );
    return
      if $ccMaxScore && ( $parm == 7 && $Con{$fh}->{messagescore} > $ccMaxScore );

    $parm = 6 if ($Con{$fh}->{noprocessing} && $parm == 1);
    $parm = 7 if ($Con{$fh}->{noprocessing} && $parm == 3);

    $parm = 7
      if ( $parm == 6
        && $ccSpamAlways
        && allSL( $Con{$fh}->{rcpt}, $Con{$fh}->{mailfrom}, 'ccSpamAlways' ) );
    $parm = 7
      if ( $parm == 6
        && $ccSpamFilter
        && $sendAllSpam
        && allSL( $Con{$fh}->{rcpt}, $Con{$fh}->{mailfrom}, 'ccSpamFilter' ) );
    return if $Con{$fh}->{ccnever};
    my $skipLog = 0;

    $Con{$fh}->{storecompletemail} = $StoreCompleteMail;
    $Con{$fh}->{storecompletemail} = "9999999" if !$StoreCompleteMail && $Con{$fh}->{alllog};
    $Con{$fh}->{storecompletemail} = "9999999" if $ccSpamAlways
        && allSL( $Con{$fh}->{rcpt}, $Con{$fh}->{mailfrom}, 'ccSpamAlways' );

    if ( $parm == 1 || $parm == 2 || $parm == 3 ) {
        if ( $parm > 1 ) {
            if ( ++$logFreq[$parm] < $logCount[$parm] ) {
                $skipLog = 1;
                $fln     = "nocollect:freq";
            } else {
                $logCount[$parm] = 0;
            }
        }
        $parm    = 7                if $Con{$fh}->{red} && $DoNotCollectRedRe && $parm == 3;
        $parm    = 6                if $Con{$fh}->{red} && $DoNotCollectRedRe && $parm == 1;
        $fln     = "nocollect:red"  if $Con{$fh}->{red} && $DoNotCollectRedRe;
        $parm    = 7                if $Con{$fh}->{redsl} & 1 && $parm == 3;
        $parm    = 6                if $Con{$fh}->{redsl} & 1 && $parm == 1;
        $fln     = "nocollect:sl"   if $Con{$fh}->{redsl} & 1 && ( $parm == 1 || $parm == 3 );
        $parm    = 7                if $Con{$fh}->{messagelow} && $parm == 3;
        $parm    = 6                if $Con{$fh}->{messagelow} && $parm == 1;
        $fln = "nocollect:lowscore" if $Con{$fh}->{messagelow} && ( $parm == 1 || $parm == 3 );
    }

    if ( $parm == 3 && $skipLog == 1 ) {
        $parm    = 7;
        $skipLog = 0;
    }

    if (   $parm == 4 && !$incomingOkMail
    	|| $parm == 1 && (!$spamlog || ! $SpamLog)
        || $parm == 2 && (!$notspamlog || ! $NonSpamLog)
        || $parm == 5 && !$viruslog
        || $parm == 6 && !$discarded
        || $parm == 7 && !$discarded
        || $skipLog ) {
        d('Maillog - no log - missing folder');
        $Con{$fh}->{maillogbuf} = '';
        delete $Con{$fh}->{maillog};
        close $Con{$fh}->{maillogfh} if $Con{$fh}->{maillogfh};
        delete $Con{$fh}->{maillogfh};
        delete $Con{$fh}->{mailloglength};
        if ($Con{$fh}->{maillogfilename}) {$unlink->($Con{$fh}->{maillogfilename}); delete $Con{$fh}->{maillogfilename};}
    } elsif ( $parm > 1 ) {

        d('Maillog - log');

        # we now know if it is spam or not -- open the file
        $text = $Con{$fh}->{maillogbuf} . $text;
        if ( $parm < 8 ) {

            &sigoffTry(__LINE__);
            if ($Con{$fh}->{maillogfh}) {eval{$Con{$fh}->{maillogfh}->close;}; delete $Con{$fh}->{maillogfh};}
            $Con{$fh}->{maillogfilename} and $eF->($Con{$fh}->{maillogfilename}) and $unlink->($Con{$fh}->{maillogfilename});
            $fln = $Con{$fh}->{maillogfilename} = maillogFilename( $fh, $parm - 2 );
            if (!$fln || ($Con{$fh}->{red} && $DoNotCollectRedRe) ) {
                $Con{$fh}->{maillogfilename} = $fln = '';
            } else {
                $eF->($Con{$fh}->{maillogfilename}) and $unlink->($Con{$fh}->{maillogfilename});
                if ($open->(my $FH, '>',$fln )) {
                    $FH->binmode;
                    $Con{$fh}->{maillogfh} = $FH;
                    $Con{$fh}->{mailloglength} = 0;
                    if ($StoreASSPHeader) {
                        my $myheader = $Con{$fh}->{myheader};
                        $myheader = "X-Assp-Version: $version$modversion on $myName\r\n" . $myheader
                            if $myheader !~ /X-Assp-Version:.+? on \Q$myName\E/;
                        $myheader .= "X-Assp-ID: $myName $Con{$fh}->{msgtime}\r\n"
                            if $myheader !~ /X-Assp-ID: \Q$myName\E/;
                        $myheader .= "X-Assp-Session: $Con{$fh}->{SessionID}\r\n"
                            if $myheader !~ /X-Assp-Session:/o;
                        $myheader =~ s/X-Assp-Spam:$HeaderValueRe//gios;
                        $myheader =~ s/X-Assp-Spam-Level:$HeaderValueRe//gios;
                        $myheader =~ s/[\r\n]+$/\r\n/o;
                        $myheader = headerFormat($myheader);
                        $FH->print($myheader);
                        $Con{$fh}->{mailloglength} = length($myheader);
                    }
                } else {
                    mlog( $fh, "error opening maillog '".de8($fln)."': $!" );
                    $Con{$fh}->{maillogfilename} = $fln = '';
                }
            }
            &sigonTry(__LINE__);
        }

        # start sending the message to sendAllSpam if appropriate

        my $current_email = $Con{$fh}->{rcpt};
        $current_email =~/($EmailAdrRe)\@($EmailDomainRe)/o;
        my ($current_username,$current_domain) = ($1,$2);

        if($sendAllSpam or scalar keys %ccdlist) {
            my $ccspamlt = $sendAllSpam;
            if ($ccspamlt) {
                $ccspamlt =~ s/USERNAME/$current_username/go;
                $ccspamlt =~ s/DOMAIN/$current_domain/go;
            }
            if ( exists $ccdlist{lc $current_domain} ) {
                $ccspamlt .= ' ' if $ccspamlt;
                $ccspamlt .= $ccdlist{lc $current_domain} . '@' . $current_domain;
            } elsif (exists $ccdlist{'*'}) {
            	$ccspamlt .= ' ' if $ccspamlt;
            	$ccspamlt .= $ccdlist{'*'}.'@'.$current_domain;
            }

            $Con{$fh}->{forwardSpam} ||= forwardSpam($Con{$fh}->{mailfrom},$ccspamlt,$fh) if ($ccspamlt && $isnotcc!=1 && ($parm==3 || $parm==7) && (!$ccSpamFilter  || $ccSpamFilter && allSL($Con{$fh}->{rcpt},$Con{$fh}->{mailfrom},'ccSpamFilter')));
        }
    }

    my $gotAllText;
    if(my $h = $Con{$fh}->{maillogfh}) {
        if (! $Con{$fh}->{spambuf}) {
            $h->print(substr($text,0,max($Con{$fh}->{storecompletemail},$MaxBytes)));
            $Con{$fh}->{mailloglength} = $Con{$fh}->{spambuf} = length($text);
            $Con{$fh}->{maillogbuf} = $text;
        } else {
            if ( $Con{$fh}->{spambuf} < $Con{$fh}->{storecompletemail}) {
                $h->print(substr($text,0,$Con{$fh}->{storecompletemail} - $Con{$fh}->{spambuf}));
            } else {
                $h->print(substr($text,0,$MaxBytes + $Con{$fh}->{headerlength})) if $Con{$fh}->{spambuf}<$MaxBytes + $Con{$fh}->{headerlength} ;
            }
            $Con{$fh}->{maillogbuf}.=$text;
            $Con{$fh}->{spambuf} += length($text);
            $Con{$fh}->{mailloglength} = length($Con{$fh}->{maillogbuf});
        }
        if(  (   $ccMaxBytes
              && $Con{$fh}->{mailloglength} > $MaxBytes + $Con{$fh}->{headerlength}
              && $Con{$fh}->{mailloglength} > $Con{$fh}->{storecompletemail})
           || $text=~/(^|[\r\n])\.[\r\n]/o)
        {
            d('Maillog - no cc');
            $gotAllText = 1;
            $h->close;
            delete $Con{$fh}->{maillog} unless $Con{$fh}->{forwardSpam};
            delete $Con{$fh}->{maillogfh};
            delete $Con{$fh}->{mailloglength};
        }
    } elsif(! $ccMaxBytes || $Con{$fh}->{mailloglength} < $MaxBytes + $Con{$fh}->{headerlength} || $Con{$fh}->{mailloglength} < $Con{$fh}->{storecompletemail}) {
        $Con{$fh}->{maillogbuf}.=$text;
        $Con{$fh}->{mailloglength} = length($Con{$fh}->{maillogbuf});
    }
    if($Con{$fh}->{forwardSpam} && exists $Con{$Con{$fh}->{forwardSpam}} && exists $Con{$Con{$fh}->{forwardSpam}}->{body}) {
        $Con{$Con{$fh}->{forwardSpam}}->{body} .= $text;
        $Con{$Con{$fh}->{forwardSpam}}->{gotAllText} = $gotAllText;
    }
    return $fln;
}

# integrated mail collection subroutine
sub MaillogStart {
    my $fh = shift;
    d('MaillogStart');
    $Con{$fh}->{maillog} = 1 unless $NoMaillog ;
    if ("$fh" =~ /SSL/o) {
        my $ciffer = eval{$fh->get_cipher();};
        $ciffer = '' unless $ciffer;
        $ciffer and $ciffer = '('.$ciffer.')';
        $Con{$fh}->{rcvd} =~ s/(\sE?SMTP)S?/$1S$ciffer/os if $Con{$fh}->{chainMailInSession} < 1;
    }
    $Con{$fh}->{maillogbuf}=$Con{$fh}->{header}=$Con{$fh}->{rcvd};
    if ($Con{$fh}->{crashfh}) {
        my $rcvd = $Con{$fh}->{rcvd};
        headerUnwrap($rcvd);
        $rcvd =~ s/by\s?\Q$myName\E .+$/\r\n/os;
        $Con{$fh}->{crashbuf} .= $rcvd;
        my $crashfh = $Con{$fh}->{crashfh};
        $crashfh->print($rcvd);
    }
}

sub MaillogRemove {
    my $this = shift;
    d('MaillogRemove');
    return 0 unless $this;
    if ($this->{maillogfilename} !~ /^(?:\Q$base\E\/)?(?:$notspamlog|$incomingOkMail)/) {
        return 0 if (($notspamlog && $discarded && $this->{maillogfilename} !~ /^(?:\Q$base\E\/)?(?:$notspamlog|$discarded)/) or
                   (! $notspamlog && $discarded && $this->{maillogfilename} !~ /^(?:\Q$base\E\/)?$discarded/) or
                   ($notspamlog && ! $discarded && $this->{maillogfilename} !~ /^(?:\Q$base\E\/)?$notspamlog/));
        return 0 if (($incomingOkMail && $discarded && $this->{maillogfilename} !~ /^(?:\Q$base\E\/)?(?:$incomingOkMail|$discarded)/) or
                   (! $incomingOkMail && $discarded && $this->{maillogfilename} !~ /^(?:\Q$base\E\/)?$discarded/) or
                   ($incomingOkMail && ! $discarded && $this->{maillogfilename} !~ /^(?:\Q$base\E\/)?$incomingOkMail/));
    }
    close $this->{maillogfh} if ($this->{maillogfh});
    if ($eF->( $this->{maillogfilename} )) {
        $unlink->($this->{maillogfilename});
        mlog($this->{self},"info: logfile ".de8($this->{maillogfilename})." removed") if $SessionLog;
    }
    delete $this->{maillog};
    delete $this->{maillogfh};
    delete $this->{mailloglength};
    delete $this->{spambuf};
    delete $this->{maillogfilename};
    delete $this->{maillogparm};
    $this->{maillog} = 1 unless $NoMaillog;
    return 1;
}

sub MaillogClose {
    my $fh = shift;
    d('MaillogClose');
    return unless $fh;
    my $f=$Con{$fh}->{maillogfh};
    eval{$f->close if $f;};
    return if $Con{$fh}->{type} ne 'C';
    return unless $Con{$fh}->{maillogfilename};
    if ($Con{$fh}->{deleteMailLog}) {
        $unlink->($Con{$fh}->{maillogfilename});
        mlog($fh,"info: file ".de8($Con{$fh}->{maillogfilename})." was deleted - reason: $Con{$fh}->{deleteMailLog}");
        delete $Con{$fh}->{maillogfilename};
    } elsif ($noCollectRe) {
        my $buf;
        my $bytes = ($MaxBytes + $Con{$fh}->{headerlength} > 100000) ? 100000 : $MaxBytes + $Con{$fh}->{headerlength};
        $bytes = 100000 unless $bytes;
        if ($open->(my $mfh,'<',$Con{$fh}->{maillogfilename})) {
            $mfh->binmode;
            my $hasread = 1;
            while ($hasread > 0 and length($buf) < $bytes) {
                my $read;
                $hasread = $mfh->read($read,$bytes);
                $buf .= $read;
            }
            $mfh->close;
            if ($buf && $buf =~ /$noCollectReRE/is) {
                if (exists $runOnMaillogClose{'ASSP_ARC::setvars'}) {
                    $Con{$fh}->{deletemaillog} = 'content matches noCollectRe';
                } else {
                    $unlink->($Con{$fh}->{maillogfilename});
                    mlog($fh,"info: file ".de8($Con{$fh}->{maillogfilename})." was deleted - matched noCollectRe");
                    delete $Con{$fh}->{maillogfilename};
                }
            }
        }
    }
    foreach my $sub (keys %runOnMaillogClose) {
        $sub->($fh);
    }
}

sub forwardSpam {
    my ($from,$to,$oldfh)=@_;
    my $s;
    my $AVa;

    my $destination;
    if ($sendAllDestination ne '') {
        $destination = $sendAllDestination;
    }else{
        $destination = $smtpDestination;
    }

    $AVa = 0;
    foreach my $destinationA (split(/\s*\|\s*/o, $destination)) {
        if ($destinationA =~ /^(_*INBOUND_*:)?(\d+)$/o){
            $destinationA = '127.0.0.1:'.$2;
        }
        if ($AVa<1) {
            $s = $CanUseIOSocketINET6
                 ? IO::Socket::INET6->new(Proto=>'tcp',PeerAddr=>$destinationA,Timeout=>2,&getDestSockDom($destinationA))
                 : IO::Socket::INET->new(Proto=>'tcp',PeerAddr=>$destinationA,Timeout=>2);
            if(ref($s)) {
                $AVa=1;
                $destination=$destinationA;
            }
            else {
                mlog(0,"*** $destinationA didn't work, trying others...") if $SessionLog;
            }
        }
    }
    if(! ref($s)) {
        mlog(0,"error: couldn't create server socket to $destination -- aborting sendAllSpam connection") if $SessionLog;
        return;
    }
    addfh($s,\&FShelo);
    my $this=$Con{$s};
    $this->{to_as} = $to;
    @{$this->{to}}=split(/\s*,\s*|\s+/o,$to);
    $this->{from}=$from;
    $this->{fromIP}=$Con{$oldfh}->{ip};
    $this->{clamscandone}=$Con{$oldfh}->{clamscandone};
    $this->{rcpt}=$Con{$oldfh}->{rcpt};
    $this->{myheader}=$Con{$oldfh}->{myheader};
    $this->{prepend}=$Con{$oldfh}->{prepend};
    $this->{saveprepend}=$Con{$oldfh}->{saveprepend};
    $this->{saveprepend2}=$Con{$oldfh}->{saveprepend2};
    $this->{body} = '';
    $this->{FSnoopCount} = 0;
    $this->{self} = $s;
    return $s;
}
sub FShelo { my ($fh,$l)=@_;
    if($l=~/^ *[54]/o) {
        FSabort($fh,"helo Expected 220, got: $l");
    } elsif($l=~/^ *220 /o) {
        sendque($fh,"HELO $myName\r\n");
        $Con{$fh}->{getline}=\&FSfrom;
    }
}
sub FSfrom { my ($fh,$l)=@_;
    if($l=~/^ *[54]/o) {
        FSabort($fh,"send HELO($myName), expected 250, got: $l");
    } elsif($l=~/^ *250 /o) {
        $Con{$fh}->{FSlastCMD} = "MAIL FROM: <$Con{$fh}->{from}>";
        sendque($fh,"$Con{$fh}->{FSlastCMD}\r\n");
        $Con{$fh}->{getline}=\&FSrcpt;
    }
}
sub FSrcpt { my ($fh,$l)=@_;
    if($l=~/^ *[54]/o) {
        FSabort($fh,"send $Con{$fh}->{FSlastCMD}, expected 250, got: $l");
    } elsif($l=~/^ *250 /o) {
        $Con{$fh}->{FSlastCMD} = "RCPT TO: <" . shift(@{$Con{$fh}->{to}}) . ">";
        sendque($fh,"$Con{$fh}->{FSlastCMD}\r\n");
        $Con{$fh}->{getline} = \&FSnoop unless @{$Con{$fh}->{to}};
    }
}
sub FSnoop { my ($fh,$l)=@_;
    if ($Con{$fh}->{gotAllText}) {
        &FSdata($fh,$l);
        return;
    }
    if($l=~/^ *[54]/o) {
        FSabort($fh,"send $Con{$fh}->{FSlastCMD}, expected 250, got: $l");
    } elsif($l=~/^ *250 /o) {
        sendque($fh,"NOOP\r\n");
        $Con{$fh}->{FSnoopCount}++ if $Con{$fh}->{FSnoopCount} < 5;
        $Con{$fh}->{sendTime} = time + $Con{$fh}->{FSnoopCount};
        $Con{$fh}->{FSlastCMD} = 'NOOP';
    }
}
sub FSdata { my ($fh,$l)=@_;
    delete $Con{$fh}->{sendTime};
    if($l=~/^ *[54]/o) {
        FSabort($fh,"send $Con{$fh}->{FSlastCMD}, expected 250, got: $l");
    } elsif($l=~/^ *250 /o) {
        sendque($fh,"DATA\r\n");
        $Con{$fh}->{getline}=\&FSdata2;
    }
}
sub FSdata2 { my ($fh,$l)=@_;
    my $this=$Con{$fh};
    if($l=~/^ *[54]/o) {
        FSabort($fh,"FSdata2 Expected 354, got: $l");
    } elsif($l=~/^ *354 /o) {
        my $header;
        $header = $1 if $this->{body} =~ s/^($HeaderRe*)//os;
        $header =~ s/X-Assp[^():]+:$HeaderValueRe//gios;
        $this->{myheader}=~s/X-Assp-Intended-For:$HeaderValueRe//giso if $AddIntendedForHeader; # clear out existing X-Assp-Envelope-From headers
        $header=~s/^($HeaderRe*)/$1From: sender not supplied\r\n/o unless $header=~/^$HeaderRe*From:/io; # add From: if missing
        $header=~s/^($HeaderRe*)/$1Subject:\r\n/o unless $header=~/^$HeaderRe*Subject:/io; # add Subject: if missing

        $this->{saveprepend}.=$this->{saveprepend2};
        $header=~s/^Subject:/Subject: $this->{saveprepend}/gim if ($spamTagCC && $this->{saveprepend} );

        $header=~s/^Subject:/Subject: $spamSubjectEnc/gimo if $spamSubjectCC && $spamSubjectEnc;

# remove Disposition-Notification headers if needed

        $header =~ s/(?:ReturnReceipt|Return-Receipt-To|Disposition-Notification-To):$HeaderValueRe//gios
            if ($removeDispositionNotification);
            
        # merge our header, add X-Intended-For header
        my ($to) = $this->{rcpt} =~ /(\S+)/o;
        $this->{myheader} .= "X-Assp-Intended-For: $to\r\n";
        $this->{myheader} .= "X-Assp-Copy-Spam: Yes\r\n";
        $this->{body} = $header.$this->{body};
        delete $this->{preheaderlength};
        $this->{addMyheaderTo} = 'body';
        addMyheader($fh);
        delete $this->{addMyheaderTo};
        delete $this->{preheaderlength};

        my $clamavbytes = $ClamAVBytes ? $ClamAVBytes : 50000;
        $clamavbytes = 100000 if $ClamAVBytes>100000;
        $this->{mailfrom} = $this->{from};
        $this->{ip} = $this->{fromIP};
        if ($ScanCC &&
                   $this->{body}  &&
                   ((haveToScan($fh) && ! ClamScanOK($fh,\substr($this->{body},0,$clamavbytes))) or
                    (haveToFileScan($fh) && ! FileScanOK($fh,\substr($this->{body},0,$clamavbytes)))
                   )
           ) {
           mlog($fh,"info: skip forwarding message to $this->{to_as} - virus found") if $ConnectionLog;
           @{$Con{$fh}->{to}} = (); undef @{$Con{$fh}->{to}};
           done2($fh);
           return;
        }
        $this->{body} =~ s/\r?\n/\r\n/gos;
        $this->{body} =~ s/[\r\n\.]+$//os;
        sendque($fh,$this->{body}) if $this->{body};
        sendque($fh,"\r\n.\r\n");
        delete $this->{body};
        mlog($fh,"info: message forwarded to $this->{to_as}") if $ConnectionLog;
        delete $this->{mailfrom};
        delete $this->{ip};
        $Con{$fh}->{getline}=\&FSquit;
    }
}

sub FSquit { my ($fh,$l)=@_;
    if($l!~/^ *250/o) {
        FSabort($fh,"[CR][LF].[CR][LF] sent, Expected 250, got: $l");
    } else {
        sendque($fh,"QUIT\r\n");
        $Con{$fh}->{FSlastCMD} = 'QUIT';
        $Con{$fh}->{getline}=\&FSdone;
        $Con{$fh}->{type} = 'CC';          # start timeout watching for case 221/421 will not be send
        $Con{$fh}->{timelast} = time;
        $Con{$fh}->{nodelay} = 1;
    }
}
sub FSdone { my ($fh,$l)=@_;
    if($l!~/^ *[24]21/o) {
        FSabort($fh,"QUIT sent, Expected 221 or 421, got: $l");
    } else {
        @{$Con{$fh}->{to}} = (); undef @{$Con{$fh}->{to}};
        done2($fh); # close and delete
    }
}

sub FSabort {mlog(0,"FSabort: $_[1]"); @{$Con{$_[0]}->{to}} = (); undef @{$Con{$_[0]}->{to}};done2($_[0]);}

sub haveToFileScan {
    my $fh=shift;
    return 0 unless $fh;
    my $this=$Con{$fh};

    my $DoFileScan = $DoFileScan;    # copy the global to local - using local from this point
    $DoFileScan = $this->{overwritedo} if ($this->{overwritedo});   # overwrite requ by Plugin

    return 0 if !$DoFileScan;
    return 0 if $this->{noscan};
    return 0 if $this->{filescandone}==1;
    return 0 if $this->{whitelisted} && $ScanWL!=1;
    return 0 if $this->{noprocessing} && $ScanNP!=1;
    return 0 if $this->{relayok} && $ScanLocal!=1;
    if ( matchSL($this->{mailfrom},'noScan')) {
        $this->{noscan} = 1;
        return 0;
    }

    if ((matchIP($this->{ip},'noScanIP',$fh,0)) ||
        ($NoScanRe  && $this->{ip}=~/$NoScanReRE/) ||
        ($NoScanRe  && $this->{helo}=~/$NoScanReRE/) ||
        ($NoScanRe  && $this->{mailfrom}=~/$NoScanReRE/))
    {
        $this->{noscan} = 1;
        return 0;
    }
    $this->{prepend}='';

    return 1;
}

sub FileScanOK {
    my ($fh,$bd)=@_;
    return 1 unless $FileScanCMD;
    return 1 if (! haveToFileScan($fh));
    return FileScanOK_Run($fh,$bd);
}
sub FileScanOK_Run {
    my ($fh,$bd)=@_;
    my $this = $Con{$fh};
    my $failed;
    my $cmd;
    my $res;
    my $virusname;
    my $lb = length($$bd);
    $this->{filescandone} = 1;
    if ($NoScanRe && $$bd=~/($NoScanReRE)/) {
        mlogRe(($1||$2),"NoVirusscan");
        return 1;
    }

    my $mtype = '';
    $mtype = "whitelisted"   if $this->{whitelisted};
    $mtype = "noprocessing"  if $this->{noprocessing};
    $mtype = "local"         if $this->{relayok};

    my $file = $FileScanDir . "/a.$WorkerNumber." . int(rand(100000)) . "$maillogExt";
    mlog($fh,"diagnostic: FileScan will scan file - $file") if $ScanLog == 3;
    my $SF;
    eval {
        open $SF,'>' ,"$file";
        binmode $SF;
        print $SF substr($$bd,0,$lb);
        close $SF;
    };
    my $wait; $wait = $1 if ($FileScanCMD =~ /^\s*NORUN\s*\-\s*(\d+)/io);
    Time::HiRes::sleep($wait / 1000) if $wait;
    $ThreadIdleTime{$WorkerNumber} += $wait / 1000;
    if (-r $file) {
        if ($FileScanCMD !~ /^\s*NORUN/io) {
            my $runfile = $file;
            my $rundir = $FileScanDir;
            my $sep;
            if ( $^O eq "MSWin32" ) {
                $sep = '"';
                $runfile =~ s/\//\\/go;
                $runfile = $sep . $runfile . $sep if $runfile =~ / /o;
                $rundir =~ s/\//\\/go;
                $rundir = $sep . $rundir . $sep if $rundir =~ / /o;
            } else {
                $sep = "'";
                $runfile = $sep . $runfile . $sep if $runfile =~ / /o;
                $rundir = $sep . $rundir . $sep if $rundir =~ / /o;
            }
            &ThreadYield();
            $cmd = "$FileScanCMD 2>&1";
            $cmd =~ s/FILENAME/$runfile/go;
            $cmd =~ s/NUMBER/$WorkerNumber/go;
            $cmd =~ s/FILESCANDIR/$rundir/go;
            $cmd =~ s/\*([a-zA-Z0-9\_\-]+)\*/$sep . $this->{$1} . $sep/oge;
            my $usedAPI = 0;
            if (ref($FileScanCMDbuild_API) eq 'CODE') {
                $usedAPI = 1;
                eval{$FileScanCMDbuild_API->(\$cmd,$this);};
                if ($@) {
                    mlog(0,"error: FileScanCMDbuild_API - eval failed - $@");
                    $usedAPI = undef;
                }
            } elsif ($FileScanCMDbuild_API) {
                mlog(0,"error: the variable FileScanCMDbuild_API is not a CODE reference!");
            }
            d("filescan: running - $cmd");
            if ($cmd && defined($usedAPI)) {
                mlog($fh,"diagnostic: FileScan will run command - $cmd") if $ScanLog == 3;
                &sigoff(__LINE__);
                $res = qx($cmd);
                &sigon(__LINE__);
                &ThreadYield();
            } elsif ($cmd) {
                mlog(0,"warning: ");
            } else {
                mlog(0,"warning: the command calculated for FileScanCMD was empty after processing all replacements") unless $usedAPI;
            }

            $res =~ s/\r//go;
            $res =~ s/\n/ /go;
            $res =~ s/\t/ /go;
            mlog($fh,"diagnostic: FileScan returned $res") if $ScanLog == 3;

            $failed = 1 if ($FileScanBad && $res =~ /$FileScanBadRE/);
            $failed = 1 if ($FileScanGood && $res !~ /$FileScanGoodRE/);
        }
        eval{unlink($file);};

        mlog($fh,"FileScan: scanned $lb bytes in $mtype message",1)
            if(($failed && $ScanLog ) || $ScanLog >= 2);
        return 1 unless $failed;
    } else {
        mlog($fh,"FileScan: is unable find temporary $file - possibly removed by the file system scanner") if $ScanLog >= 2;
        $res = 'unable to find file to scan';
        $failed = 1;
    }

    if($failed) {
        ($virusname) = $res =~ /($FileScanRespReRE)/;

        if($virusname && $SuspiciousVirus && $virusname=~/($SuspiciousVirusRE)/){
            my $susp = $1;
            $this->{messagereason}="SuspiciousVirus: $virusname '$susp'";
            pbAdd($fh,$this->{ip},&weightRe('vsValencePB','SuspiciousVirus',\$susp,$fh),"SuspiciousVirus-FileScan:$virusname",1);
            $this->{prepend}="[VIRUS][scoring]";
            mlog($fh,"'$virusname' passing the virus check because of only suspicious virus '$susp'");
            return 1;
        }

        $this->{prepend}="[VIRUS]";
        if ($DoFileScan == 2) {
            $this->{prepend}="[VIRUS][monitor]";
            mlog($fh,"message is infected but pass - $res");
            return 1;
        }
        $virusname = 'a virus' unless $virusname;
        $this->{averror}=$AvError;
        $this->{averror}=~s/\$infection/$virusname/gio;
        my $reportheader;
        $reportheader="Full Header:\r\n$this->{header}\r\n" if $EmailVirusReportsHeader;
        my $sub="virus detected: 'FileScan'";

        my $bod="Message ID: $this->{msgtime}\r\n";
        $bod.="Session: $this->{SessionID}\r\n";
        $bod.="Remote IP: $this->{ip}\r\n";
        $bod.="Subject: $this->{subject2}\r\n";
        $bod.="Sender: $this->{mailfrom}\r\n";
        $bod.="Recipients(s): $this->{rcpt}\r\n";
        $bod.="Virus Detected: 'FileScan' - $res\r\n";
        $reportheader = $bod.$reportheader;
        
        # Send virus report to administrator if set
        AdminReportMail($sub,\$reportheader,$EmailVirusReportsTo) if $EmailVirusReportsTo;

        # Send virus report to recipient if set
        $this->{reportaddr} = 'virus';
        ReturnMail($fh,$this->{rcpt},"$base/$ReportFiles{EmailVirusReportsToRCPT}",$sub,\$bod,'') if $EmailVirusReportsToRCPT;
        delete $this->{reportaddr};

        $Stats{viridetected}++;
        delayWhiteExpire($fh);
        $this->{messagereason}="virus detected: 'FileScan' - $res";
        pbAdd($fh,$this->{ip},'vdValencePB','virus-FileScan:$res');

        return 0;
    } else {
        mlog($fh,"info: FileScan - message is not infected") if $ScanLog >= 2;
        return 1;
    }
}

sub haveToScan {
    my $fh=shift;
    return 0 unless $fh;
    my $this=$Con{$fh};

    my $UseAvClamd = $UseAvClamd;    # copy the global to local - using local from this point
    $UseAvClamd = $this->{overwritedo} if ($this->{overwritedo});   # overwrite requ by Plugin

    return 0 if !$UseAvClamd;
    return 0 if !$CanUseAvClamd;
    return 0 if $this->{noscan};
    return 0 if $this->{clamscandone}==1;
    return 0 if $this->{whitelisted} && $ScanWL!=1;
    return 0 if $this->{noprocessing} && $ScanNP!=1;
    return 0 if $this->{relayok} && $ScanLocal!=1;
    if (matchSL($this->{mailfrom},'noScan')) {
        $this->{noscan} = 1;
        return 0;
    }

    if ((matchIP($this->{ip},'noScanIP',$fh,0)) ||
        ($NoScanRe  && $this->{ip}=~/$NoScanReRE/) ||
        ($NoScanRe  && $this->{helo}=~/$NoScanReRE/) ||
        ($NoScanRe  && $this->{mailfrom}=~/$NoScanReRE/))
    {
        $this->{noscan} = 1;
        return 0;
    }

    $this->{prepend}='';

    return 1;
}

# substitutes File::Scan::ClamAV::ping
sub ClamScanPing {
 my $self = shift;
 my $response;
 my $timeout = $ClamAVtimeout / 2;
 $timeout = 2 if $timeout < 2;
 d('ClamScanPing - maxwait ' . $timeout * 2 . ' seconds');

 my $conn = $self->_get_connection || return;
 my $select = IO::Select->new();
 $select->add($conn);

 my @canwrite = $select->can_write(int($timeout));
 if (@canwrite) {
     $self->_send($conn, "PING\n");

     my @canread = $select->can_read(int($timeout));

     if (@canread) {
         chomp($response = $conn->getline);

     # Run out the buffer?
         1 while (<$conn>);
     } else {
         $response = 'unable to read from Socket';
     }
 } else {
     $response = 'unable to write to Socket';
 }
 $select->remove($conn);
 $conn->close;

 return ($response eq 'PONG' ? 1 : $self->_seterrstr("Unknown reponse from ClamAV service: $response"));
}

# substitutes File::Scan::ClamAV::streamscan
sub ClamScanScan {
 my ($self) = shift;
 my $response;
 my $timeout = $ClamAVtimeout / 2;
 $timeout = 2 if $timeout < 2;
 d('ClamScanScan - maxwait ' . ($timeout + $ClamAVtimeout) . ' seconds');

 my $data = join '', @_;

 $self->_seterrstr;

 my $conn = $self->_get_connection || return;
 my $select = IO::Select->new();
 $select->add($conn);

 my @canwrite = $select->can_write(int($timeout));
 if (@canwrite) {
     $self->_send($conn, "STREAM\n");
     chomp($response = $conn->getline);
 }
 
 my @return;
 if($response =~ /^PORT (\d+)/o){
	if((my $c = $self->_get_tcp_connection($1))){
        my $stream = IO::Select->new();
        $stream->add($c);
        my $st = Time::HiRes::time();
        my @cwrite = $stream->can_write(int($timeout));
        $main::ThreadIdleTime{$main::WorkerNumber} += Time::HiRes::time() - $st;
        if (@cwrite) {
            $self->_send($c, $data);
            $stream->remove($c);
            $c->close;
            my $st = Time::HiRes::time();
            my @canread = $select->can_read(int($ClamAVtimeout));
            $main::ThreadIdleTime{$main::WorkerNumber} += Time::HiRes::time() - $st;
            if (@canread) {
		        chomp(my $r = $conn->getline);
		        if($r =~ /stream: (.+) FOUND/io){
    		   	    @return = ('FOUND', $1);
		        } else {
    			    @return = ('OK');
		        }
            }
        }
	} else {
        $select->remove($conn);
        $conn->close;
        return;
	}
 }
 $select->remove($conn);
 $conn->close;
 return @return;
}

sub ClamScanOK {
    my ($fh,$bd)=@_;
    return 1 if (! haveToScan($fh));
    return ClamScanOK_Run($fh,$bd);
}
sub ClamScanOK_Run {
    my ($fh,$bd)=@_;
    d('ClamAV');
    my $av;
    my $errstr;
    my $this = $Con{$fh};

    $this->{clamscandone} = 1 ;

    if ($NoScanRe && $$bd=~/($NoScanReRE)/) {
        mlogRe(($1||$2),"NoVirusscan");
        return 1;
    }


    my $mtype = '';
    $mtype = "whitelisted"   if $this->{whitelisted};
    $mtype = "noprocessing"  if $this->{noprocessing};
    $mtype = "local"         if $this->{relayok};

    my $lb = length($$bd);
    my $timeout = $ClamAVtimeout;
    my ( $code, $virus );

    &sigoffTry(__LINE__);
    eval {
   	local $SIG{ALRM} = sub { die "__alarm__\n" };
     	alarm($timeout) if $timeout;
        $av = File::Scan::ClamAV->new( port => $AvClamdPort );
        if ( $av->ping() ) {
            mlog(0, 'ClamAv Up') if $ScanLog && $AvailAvClamd==0 ;
            $VerFileScanClamAV = $File::Scan::ClamAV::VERSION;
            $AvailAvClamd = 1;
            ( $code, $virus ) = $av->streamscan($$bd);
        } else {
            mlog(0, 'ClamAv Down') if $ScanLog && $AvailAvClamd==1 ;
            $AvailAvClamd = 0;
        }
        $errstr = $av->errstr();
        alarm(0);
    };
    alarm(0);
    if ($@) {
        if ( $@ =~ /__alarm__/o ) {
            mlog( $fh, "ClamAV: streamscan timed out after $timeout secs.", 1 );
        } else {
            mlog( $fh, "ClamAV: streamscan failed: $@", 1 );
        }
        undef $av;
        &sigonTry(__LINE__);
        return 1;
    }
    unless ($AvailAvClamd) {
        &sigonTry(__LINE__);
        return 1;
    }
    undef $av;
    mlog($fh,"ClamAV: scanned $lb bytes in $mtype message - $code $virus",1)
        if((!( $virus eq '') || !($code eq 'OK')) && $ScanLog ) || $ScanLog >= 2;
    &sigonTry(__LINE__);
    if($code eq 'OK'){
        return 1;
    } elsif ($SuspiciousVirus && $virus=~/($SuspiciousVirusRE)/) {
        my $SV = $1;
        $this->{messagereason}="SuspiciousVirus: $virus '$SV'";
        pbAdd($fh,$this->{ip},&weightRe('vsValencePB','SuspiciousVirus',\$SV,$fh),"SuspiciousVirus-ClamAV:$virus",1);
        $this->{prepend}="[VIRUS][scoring]";
        mlog($fh,"'$virus' passing the virus check because of only suspicious virus '$SV'");
        return 1;
    } elsif($code eq 'FOUND'){
        $this->{prepend}="[VIRUS]";
        $this->{averror}=$AvError;
        $this->{averror}=~s/\$infection/$virus/gio;

        #mlog($fh,"virus detected '$virus'");
        my $reportheader;$reportheader="Full Header:\r\n$this->{header}\r\n" if $EmailVirusReportsHeader;
        my $sub="virus detected: '$virus'";

        my $bod="Message ID: $this->{msgtime}\r\n";
        $bod.="Session: $this->{SessionID}\r\n";
        $bod.="Remote IP: $this->{ip}\r\n";
        $bod.="Subject: $this->{subject2}\r\n";
        $bod.="Sender: $this->{mailfrom}\r\n";
        $bod.="Recipients(s): $this->{rcpt}\r\n";
        $bod.="Virus Detected: '$virus'\r\n";
        $reportheader = $bod.$reportheader;

        my $file="reports/virusreport.txt";

        # Send virus report to administrator if set
        AdminReportMail($sub,\$reportheader,$EmailVirusReportsTo) if $EmailVirusReportsTo;

        # Send virus report to recipient if set
        $this->{reportaddr} = 'virus';
        ReturnMail($fh,$this->{rcpt},"$base/$file",$sub,\$bod,'') if $EmailVirusReportsToRCPT;
        delete $this->{reportaddr};

        $Stats{viridetected}++;
        delayWhiteExpire($fh);
        $this->{messagereason}="virus detected: '$virus'";
        pbAdd($fh,$this->{ip},'vdValencePB',"virus-ClamAV:$virus");

        return 0;
    }
    $VerFileScanClamAV = $errstr;
    $AvailAvClamd = 0;
    mlog(0, "ClamAv Temporary Off : $VerFileScanClamAV") if $ScanLog;
    return 1;
}
#####################################################################################
#                Web Configuration functions
# add multiple tooltips span tags

sub statRequest {
 my ($tempfh,$fh,$h,$d)=@_;
 my $head; $head = $$h if $h;
 my $data; $data = $$d if $d;
 my $k;
 my $v;
 %statRequests=(
  '' => \&ConfigStatsRaw,
  '/' => \&ConfigStatsRaw,
  '/raw' => \&ConfigStatsRaw,
  '/xml' => \&ConfigStatsXml,    # Can be expanded to display in different formats like this
 );
 my $i=0;
 # %head -- public hash
 (%head)=map{++$i % 2 ? lc $_ : $_} map{/^([^ :]*)[: ]{0,2}(.*)/o} split(/\r\n/o,$head);
 my ($page,$qs)=($head{get} || $head{head} || $head{post})=~/^([^\? ]+)(?:\?(\S*))?/o;
 if(defined $data) { # GET, POST order
  $qs.='&' if ($qs ne '');
  $qs.=$data;
 }
 $qs=~y/+/ /;
 $i=0;
 # parse query string, get rid of google autofill
 # %qs -- public hash
 (%qs)=map{my $t = $_; $t =~ s/(e)_(mail)/$1$2/gio if ++$i % 2; $t} split(/[=&]/o,$qs);
 while (($k,$v) = each %qs) {$qs{$k}=~s/%([0-9a-fA-F][0-9a-fA-F])/pack('C',hex($1))/geo}
 my $ip=$fh->peerhost();
 my $port=$fh->peerport();
 mlog(0,"stat connection from $ip:$port" . ($page ? " - page: $page" : '') );

 $Stats{statConn}++;

 if (defined ($v=$statRequests{lc $page})) { print $tempfh $v->(\$head,\$qs); }
}

sub WebAuth {
    my ($user,$password) = @_;
    return 0 unless exists $AdminUsers{$user};
    return 0 if $AdminUsersRight{"$user.user.disabled"};
    my $md5password = Digest::MD5::md5_hex($password);
    my $ret = eval {
    my @ldaphost = split(/\|/o,$AdminUsersRight{"$user.user.LDAPserver"});
    if ($CanUseLDAP && @ldaphost ) {
        my $ldaplist = \@ldaphost;
        my $scheme = 'ldap';
        my $ldap;

        eval{
        $scheme = 'ldaps' if ($AdminUsersRight{"$user.user.LDAPssl"} == 1 and $AvailIOSocketSSL);
        $ldap = Net::LDAP->new( $ldaplist,
                                timeout => $LDAPtimeout,
                                scheme => $scheme,
                                inet4 =>  1,
                                inet6 =>  $CanUseIOSocketINET6
                              );
        $ldap->start_tls() if ($AdminUsersRight{"$user.user.LDAPssl"} == 2 && $AvailIOSocketSSL);
        };

        if(! $ldap) {
            mlog(0,"WebAuth: user $user - Couldn't contact LDAP server at @ldaphost, scheme $scheme -- try local password");
            eval{$ldap->unbind;};
            return 1 if ($AdminUsers{$user} eq $md5password);
            return 0;
        }
        $ldap->debug(12) if $debug or $ThreadDebug;
        my $dn;
        if ($AdminUsersRight{"$user.user.LDAProot"}) {
            $dn = $AdminUsersRight{"$user.user.LDAProot"};
            $dn =~ s/USER/$user/go;
        } else {
            $dn = $user;
        }
        my $mesg = $ldap->bind($dn, password => $password,  version => $AdminUsersRight{"$user.user.LDAPversion"});
        my $retcode = $mesg->code;
        if ($retcode) {
            my $error = $mesg->error;
            mlog(0,"WebAuth: user $user - LDAP bind/auth error: $retcode - $error -- try local password",1);
            return 1 if ($AdminUsers{$user} eq $md5password);
            return 0;
        }
        $ldap->unbind;
        $AdminUsers{$user} = $md5password;
        $AdminUsersRight{"$user.user.passwordLastChange"} = time;
        return 1;
    } else {
        return 1 if ($AdminUsers{$user} eq $md5password);
        mlog(0,"warning: wrong authentication for user $user from host $WebIP{$ActWebSess}->{ip}");
        return 0;
    }
    };
    if ($@) {
        my $error = $@;
        $error =~ s/\r|\n/ /go;
        mlog(0,"WebAuth: user $user - LDAP error: $error -- try local password",1);
        return 1 if ($AdminUsers{$user} eq $md5password);
        mlog(0,"warning: wrong authentication for user $user from host $WebIP{$ActWebSess}->{ip}");
        return 0;
    }
    return $ret;
}

sub WebLogout {
    my $fh = shift;
    my $ip=$fh->peerhost();
    my $port=$fh->peerport();
    mlog(0,"logout for user $WebIP{$ActWebSess}->{user} requested from admin interface");
    %{$WebIP{$ActWebSess}->{perm}} = ();
    delete $WebIP{$ActWebSess};
    my $isrootLoggedOn;
    foreach (keys %WebIP) {
        next if $_ eq 'SNMP';
        if ($WebIP{$_}->{user} eq 'root') {
            if ($WebIP{$_}->{rootlogin} < time - 900) {
                delete $WebIP{$_};
            } else {
                $isrootLoggedOn = $WebIP{$_}->{rootlogin};
            }
        }
    }
    $rootlogin = $isrootLoggedOn;
    my $realm = time;
        &NoLoopSyswrite($fh, "HTTP/1.1 401 Unauthorized
WWW-Authenticate: Basic realm=\"logged out ASSP session $realm - please click cancel and close the browser\"
Content-type: text/html

<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\"><body>
<script type=\"text/javascript\">
<!--
try {
  if (document.all) {
    document.execCommand(\"ClearAuthenticationCache\");
  } else {
    var mydom = window.location.host;
    var myprot = window.location.protocol;
    window.location.href = myprot + '//loggedout:loggedout\@' + mydom + '/logout';
  }
} catch(e) {
alert(\"It was not possible to clear your credentials from browser cache. Please, close your browser to ensure that you are completely logout of system.\");
self.close();
}
// -->
</script>
<h1>Logout from ASSP completed.</h1><br /><br />please close the browser
<script type=\"text/javascript\">
<!--
self.close();
// -->
</script>
</body></html>",0);


    WebDone($fh);
    %qs = ();
    %ManagePerm = ();
    %ManageActions = ();
    %ManageAdminUser = ();
}

sub webRequest {
    my ($tempfh,$fh,$h,$d)=@_;
    my $data; $data = $$d if $d;
    my $head; $head = $$h if $h;
    my $k;
    my $v;
    my %webRequests = %webRequests;
    delete $webRequests{'/top10stats'} unless $DoT10Stat;

    my $i=0;
    # %head -- public hash
    (%head)=map{++$i % 2 ? lc $_ : $_} map{/^([^ :]*)[: ]{0,2}(.*)/o} split(/\r\n/o,$head);
#$head{'user-agent'};

    if (   $head{'user-agent'} =~ m/android.+mobile|avantgo|bada\/|blackberry|blazer|compal|elaine|fennec|hiptop|iemobile|ip(hone|od)|iris|kindle|lge |maemo|meego.+mobile|midp|mmp|netfront|opera m(ob|in)i|palm( os)?|phone|p(ixi|re)\/|plucker|pocket|psp|series(4|6)0|symbian|treo|up\.(browser|link)|vodafone|wap|windows (ce|phone)|xda|xiino/io
        || substr($head{'user-agent'}, 0, 4) =~ m/1207|6310|6590|3gso|4thp|50[1-6]i|770s|802s|a\swa|abac|ac(er|oo|s\-)|ai(ko|rn)|al(av|ca|co)|amoi|an(ex|ny|yw)|aptu|ar(ch|go)|as(te|us)|attw|au(di|\-m|r\s|s\s)|avan|be(ck|ll|nq)|bi(lb|rd)|bl(ac|az)|br(e|v)w|bumb|bw\-(n|u)|c55\/|capi|ccwa|cdm\-|cell|chtm|cldc|cmd\-|co(mp|nd)|craw|da(it|ll|ng)|dbte|dc\-s|devi|dica|dmob|do(c|p)o|ds(12|\-d)|el(49|ai)
        |em(l2|ul)|er(ic|k0)|esl8|ez([4-7]0|os|wa|ze)|fetc|fly(\-|_)|g1\su|g560|gene|gf\-5|g\-mo|go(\.w|od)|gr(ad|un)|haie|hcit|hd\-(m|p|t)|hei\-|hi(pt|ta)|hp(\si|ip)|hs\-c|ht(c(\-|\s|_|a|g|p|s|t)|tp)|hu(aw|tc)|i\-(20|go|ma)|i230|iac(\s|\-|\/)|ibro|idea|ig01|ikom|im1k|inno|ipaq|iris|ja(t|v)a|jbro|jemu|jigs|kddi|keji|kgt(\s|\/)|klon|kpt\s|kwc\-|kyo(c|k)|le(no|xi)|lg(\sg|\/(k|l|u)|50|54|\-[a-w])
        |libw|lynx|m1\-w|m3ga|m50\/|ma(te|ui|xo)|mc(01|21|ca)|m\-cr|me(di|rc|ri)|mi(o8|oa|ts)|mmef|mo(01|02|bi|de|do|t(\-|\s|o|v)|zz)|mt(50|p1|v\s)|mwbp|mywa|n10[0-2]|n20[2-3]|n30(0|2)|n50(0|2|5)|n7(0(0|1)|10)|ne((c|m)\-|on|tf|wf|wg|wt)|nok(6|i)|nzph|o2im|op(ti|wv)|oran|owg1|p800|pan(a|d|t)|pdxg|pg(13|\-([1-8]|c))|phil|pire|pl(ay|uc)|pn\-2|po(ck|rt|se)|prox|psio|pt\-g|qa\-a|qc(07|12|21|32|60|\-[2-7]|i\-)
        |qtek|r380|r600|raks|rim9|ro(ve|zo)|s55\/|sa(ge|ma|mm|ms|ny|va)|sc(01|h\-|oo|p\-)|sdk\/|se(c(\-|0|1)|47|mc|nd|ri)|sgh\-|shar|sie(\-|m)|sk\-0|sl(45|id)|sm(al|ar|b3|it|t5)|so(ft|ny)|sp(01|h\-|v\-|v\s)|sy(01|mb)|t2(18|50)|t6(00|10|18)|ta(gt|lk)|tcl\-|tdg\-|tel(i|m)|tim\-|t\-mo|to(pl|sh)|ts(70|m\-|m3|m5)|tx\-9|up(\.b|g1|si)|utst|v400|v750|veri|vi(rg|te)|vk(40|5[0-3]|\-v)
        |vm40|voda|vulc|vx(52|53|60|61|70|80|81|83|85|98)|w3c(\-|\s)|webc|whit|wi(g\s|nc|nw)|wmlb|wonu|x700|yas\-|your|zeto|zte\-/xio) {

        $mobile = 1;   # this is a mobile device
    } else {
        $mobile = 0;   # this is NOT a mobile device
    }

    my ($page,$qs)=($head{get} || $head{head} || $head{post})=~/^([^\? ]+)(?:\?(\S*))?/o;
    $currentPage = $page;
    $currentPage =~ s/^\/+//o;
    $currentPage = 'Config' unless $currentPage;
    $currentPage = ucfirst($currentPage);
    $headers =~ s/<title>\S+ ASSP/<title>$currentPage ASSP/o if $page ne '/get' && exists $webRequests{$page};
    if(defined $data) { # GET, POST order
        $qs.='&' if ($qs ne '');
        $qs.=$data;
    }
    $qs=~y/+/ /;
    $i=0;

    # parse query string, get rid of google autofill
    # %qs -- public hash
    (%qs)=map{my $t = $_; $t =~ s/(e)_(mail)/$1$2/gio if ++$i % 2; $t} split(/[=&]/o,$qs);
    while (($k,$v) =  each %qs) {$qs{$k}=~s/%([0-9a-fA-F][0-9a-fA-F])/pack('C',hex($1))/geo}
    my ($auth)=$head{authorization}=~/Basic (\S+)/io;
    my ($user,$pass)=split(/:/o,base64decode($auth));
    my $ip=$fh->peerhost();
    my $port=$fh->peerport();
    my $sessionCookie = $head{'cookie'};
    $sessionCookie = '' unless($sessionCookie =~ s/.*?(session-id=\"[a-zA-Z0-9]+\").*/$1/i);
    my $cookie = Digest::MD5::md5_hex(Time::HiRes::time() . $TransferTime . $port . $TransferCount . $ip . $nextLoop2);
    my $SessionID;
    $SessionID = Digest::MD5::md5_hex($head{'user-agent'} . $ip . $head{'host'} . $sessionCookie . $page) if ($sessionCookie or ($user && $pass && $httpRequireCookies));

    if ($user eq 'root' && substr($Config{webAdminPassword}, 0, 2) eq "45") {
        $pass=crypt($pass,"45");
    }
    
    if ($SessionID && $WebIP{$SessionID}->{isauth} && !$user) {
        $user = $WebIP{$SessionID}->{user};
        if ($user eq 'root') {
            $pass = $Config{webAdminPassword};
        } else {
            $pass = $AdminUsers{$user} if $user;
        }
    }

    if (! $SessionID && $user && $pass && $httpRequireCookies) {
        print $tempfh "HTTP/1.1 200 OK
Content-type: text/html


<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\"><body><h1>please enable cookies for this URL in your browser or disable httpRequireCookies in the assp configuration</h1>
</body></html>\n";
        return 1;
    }

    $SessionID = Digest::MD5::md5_hex($head{'user-agent'} . $ip . $head{'host'} . $page) if ($user && $pass && ! $SessionID);

    if (exists $WebIP{$SessionID}->{mobile}) {
       $mobile = $WebIP{$SessionID}->{mobile};
    }
    if (exists $qs{mobile}) {
       $WebIP{$SessionID}->{mobile} = $mobile = ($qs{mobile} ? 1 : 0);
    }

    if ($user ne 'root') {
      if (&WebAuth($user,$pass)) {
        if ($page!~/pwd|get|logout/io && ($AdminUsersRight{"$user.user.passwordExp"} or           # password expired ?
           ($AdminUsersRight{"$user.user.passwordExpInt"} &&
            time > 24 * 3600 * $AdminUsersRight{"$user.user.passwordExpInt"} + $AdminUsersRight{"$user.user.passwordLastChange"}))) {
            print $tempfh "HTTP/1.1 200 OK
Content-type: text/html

<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">
<head><meta http-equiv=\"Refresh\" content=\"1; URL=./pwd\">
</head><body></body></html>\n";
           $WebIP{$SessionID}->{ip} = $ip;
           return 1;
        }
        $WebIP{$SessionID}->{ip} = $ip;
        $WebIP{$SessionID}->{isauth} = 1;
        $WebIP{$SessionID}->{user} = $user;
      } else {
        delete $WebIP{$SessionID};
        print $tempfh "HTTP/1.1 401 Unauthorized
Set-Cookie: session-id=\"$cookie\";Max-Age=900;Version=\"1\";Discard;
WWW-Authenticate: Basic realm=\"Anti-Spam SMTP Proxy (ASSP) Configuration\"
Content-type: text/html

<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\"><body><h1>Unauthorized</h1>
</body></html>\n";
        return 0;
      }
    }

    if($pass eq $webAdminPassword && $user eq 'root') {
        $rootlogin = time;
        $WebIP{$SessionID}->{rootlogin} = $rootlogin;
    } elsif ($rootlogin) {
        if ($user && $pass) {
            my $rootip;
            foreach (keys %WebIP) {
                if ($WebIP{$_}->{user} eq 'root') {
                    if ($WebIP{$_}->{rootlogin} < time - 900) {
                        delete $WebIP{$_};
                    } else {
                        $rootip = $WebIP{$_}->{ip};
                    }
                }
            }
            if ($rootip) {
                print $tempfh "HTTP/1.1 200 OK
Content-type: text/html


<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\"><body><h1>user root is currently logged on from host $rootip - no new sessions will be accepted until root has logged off<br /><br />please try again later</h1>
</body></html>\n";
                return 1;
            } else {
                $rootlogin = 0;
            }
        }
    }

    if(($pass eq $webAdminPassword && $user eq 'root') or $WebIP{$SessionID}->{isauth}){
        $WebIP{$SessionID}->{isauth} = 1;
        $WebIP{$SessionID}->{lastaccess} = time;
        $WebIP{$SessionID}->{user} = $user;
        $WebIP{$SessionID}->{blocking} = $qs{blocking} if exists $qs{blocking};
        $ActWebSess = $SessionID;
        $WebIP{$SessionID}->{ip} = $ip;
        $WebIP{$SessionID}->{changedLang} = 0;
        if (($page eq '/' || $page eq '') && ($user ne $lastRenderedUser || ! $qs{languageFile} || $qs{languageFile} ne $WebIP{$SessionID}->{languageFile})) {
            $WebIP{$SessionID}->{changedLang} = 1;
            if ($qs{languageFile} ne 'default' || ($user ne 'root' && $AdminUsersRight{"$user.user.languageFile"} ne 'default')) {
                local $/ = "\n";
                my $langF;
                if ($qs{languageFile} && $qs{languageFile} ne 'default') {
                    $langF = $qs{languageFile};
                } elsif (! $qs{languageFile}) {
                    if ($user ne 'root') {
                        $langF = $AdminUsersRight{"$user.user.languageFile"};
                    } else {
                        $langF = 'default';
                    }
                } else {
                    $langF = $qs{languageFile};
                }
                my $langFile;
                if ($langF ne 'default') {
                    $langFile = "$base/language/" . $langF;
                }
                if ($langFile &&
                    (open my $DEF, '<',"$langFile"))
                {
                  if ($langF ne $WebIP{$SessionID}->{languageFile})
                  {
                    $WebIP{$SessionID}->{languageFile} = $langF;
                    %{$WebIP{$SessionID}->{lng}} = ();
                    $AdminUsersRight{"$user.user.languageFile"} = $WebIP{$SessionID}->{languageFile} unless $user eq 'root';
                    $qs{languageFile} = $WebIP{$SessionID}->{languageFile};
                    my $msg;
                    my $cont;
                    while (my $line = (<$DEF>)) {
                        $line =~ s/\r//go;
                        $line =~ s/\n//go;
                        next unless $line;
                        next if $line =~ /^\s*[#;]/o;
                        if ($line =~ /^\s*(msg[^01]\d{5})\s*=\s*(.*)/o) {
                            my $l1 = $1;
                            my $l2 = $2;
                            if ($msg) {
                               my $i = 0;
                               my %v = ();
                               while ($cont =~ s/(\$[a-zA-Z][a-zA-Z0-9_{}\[\]\-\>]+)/\[\%\%\%\%\%\]/o) {
                                   my $var = $1;
                                   $v{$i} = eval($var);
                                   $v{$i} = $var unless defined $v{$i};
                                   $i++;
                               }
                               $i = 0;
                               while ($cont =~ s/\[\%\%\%\%\%\]/$v{$i}/o) {$i++}
                               $WebIP{$SessionID}->{lng}->{$msg} = $cont;
                               $cont = '';
                            }
                            $msg = $l1;
                            $cont = $l2."\n";
                        } else {
                            $cont .= $line."\n";
                        }
                    }
                    $WebIP{$SessionID}->{lng}->{$msg} = $cont if $msg && $cont;
                  } # endif lang changed
                  close $DEF;
                } else {  # open langfile failed
                    $AdminUsersRight{"$user.user.languageFile"} = 'default' unless $user eq 'root';
                    $qs{languageFile} = 'default';
                    $WebIP{$SessionID}->{languageFile} = 'default';
                    %{$WebIP{$SessionID}->{lng}} = ();
                }
            } else { # langfile not set
                $AdminUsersRight{"$user.user.languageFile"} = 'default' unless $user eq 'root';
                $qs{languageFile} = 'default';
                $WebIP{$SessionID}->{languageFile} = 'default';
                %{$WebIP{$SessionID}->{lng}} = ();
            }
            $lastRenderedUser = $user;
        }

        if ($page!~/shutdown_frame|shutdown_list|favicon.ico|get|statusassp/io){

            # only count requests for pages without meta refresh tag
            # dont count requests for favicon.ico file
            # dont count requests for 'get' page
            my $args;
            if ($page=~/edit/io) {
                if (defined($qs{contents})) {
                    if ($qs{B1}=~/delete/io) {
                        $args="deleting file:$qs{file}";
                    }
                    else {
                        $args="writing file:$qs{file}";
                    }
                }
                else {
                    $args="reading file:$qs{file}";
                }
            }
            my $sessInfo = "$ip:$port; page:$page;";
            $sessInfo .= " args;" if $args;
            $sessInfo .= " session-ID:$SessionID;" if $SessionLog;
            $sessInfo .= ($mobile ? " mobile device;" : '') if $SessionLog;
            mlog(0,"admin connection from user $user on host $sessInfo");

            $Stats{admConn}++;
        } elsif ($SessionLog > 1 && $page=~/shutdown_frame|shutdown_list|statusassp/io) {
            my $sessInfo = "$ip:$port; page:$page;";
            $sessInfo .= " session-ID:$SessionID;";
            $sessInfo .= ($mobile ? " mobile device;" : '');
            mlog(0,"admin connection from user $user on host $sessInfo");
        }
        if ($page=~/adminusers/io){
            unless ($user eq 'root') {
                return &webBlock($tempfh);
            }
        }
        if ($page=~/quit/io){
            if ($user eq 'root' or &canUserDo($user,'action','quit')) {
                ConfigQuit($tempfh);
            } else {
                return &webBlock($tempfh);
            }
        }
        if ($page=~/suspendresume/io){
            if ($user eq 'root' or &canUserDo($user,'action','suspendresume')) {
                ConfigSuspendResume();
            } else {
                return &webBlock($tempfh);
            }
        }
        if ($page=~/logout/io){
            WebLogout($fh);
            return 1;
        }
        if ( $page =~ /reload/io ) {
            if ($user eq 'root' or &canUserDo($user,'action','reload')) {
                reloadConfigFile();
            } else {
                return &webBlock($tempfh);
            }
        }
        if ( $page =~ /save/io ) {
            if ($user eq 'root' or &canUserDo($user,'action','save')) {
                SaveConfig();
            } else {
                return &webBlock($tempfh);
            }
        }
        if ( $page =~ /syncedit/io ) {
            unless ($user eq 'root' or &canUserDo($user,'action','syncedit')) {
                return &webBlock($tempfh);
            }
        }
        if ($page=~/favicon.ico/io){
            print $tempfh "HTTP/1.1 404 Not Found
Content-type: text/html

<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\"><body><h1>Not found</h1>
</body></html>\n";
        } else {
            if ($user eq 'root' or &canUserDo($user,'action',lc($page))) {
                print $tempfh ((defined ($v=$webRequests{lc $page}))? $v->(\$head,\$qs): webConfig(\$head,\$qs));
            } else {
                return &webBlock($tempfh);
            }
        }
    } else {
        print $tempfh "HTTP/1.1 401 Unauthorized
Set-Cookie: session-id=\"$cookie\";Max-Age=900;Version=\"1\";Discard;
WWW-Authenticate: Basic realm=\"Anti-Spam SMTP Proxy (ASSP) Configuration\"
Content-type: text/html

<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\"><body><h1>Unauthorized</h1>
</body></html>\n";
    }
    return 1 if (lc $page ne '/shutdown_list' && $page ne '/statusassp');
    return 0;
}

sub webBlock {
    my $tempfh = shift;
    print $tempfh &webBlockText();
    return 1;
}

sub webBlockText {
    return "HTTP/1.1 200 OK
Content-type: text/html


<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\"><body><h1>permission denied - you are not allowed to start this action<br /><br />use the back button</h1>
</body></html>\n";
}

sub ConfigSuspendResume {
    $allIdle -= 2 if $allIdle == defined *{'yield'};
    $allIdle += defined *{'yield'} if $allIdle == 0;
}

sub ConfigQuit {
 my $fh=shift;
 mlog(0,'quit requested from admin interface');
 &NoLoopSyswrite($fh, "HTTP/1.1 200 OK
Content-type: text/html


<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\"><body><h1>ASSP Terminated.</h1>
</body></html>
",0);
 &downASSP('quit requested from admin interface');
 exit 2;
}

# compute various totals
sub statsTotals {
 my %s = ();
 $s{smtpConnIdleTimeout}=$Stats{smtpConnIdleTimeout};
 $s{smtpConnIdleTimeout2}=$AllStats{smtpConnIdleTimeout};
 $s{smtpConnSSLIdleTimeout}=$Stats{smtpConnSSLIdleTimeout};
 $s{smtpConnSSLIdleTimeout2}=$AllStats{smtpConnSSLIdleTimeout};
 $s{smtpConnTLSIdleTimeout}=$Stats{smtpConnTLSIdleTimeout};
 $s{smtpConnTLSIdleTimeout2}=$AllStats{smtpConnTLSIdleTimeout};
 $s{smtpConnSSL}=$Stats{smtpConnSSL};
 $s{smtpConnSSL2}=$AllStats{smtpConnSSL};
 $s{smtpConnTLS}=$Stats{smtpConnTLS};
 $s{smtpConnTLS2}=$AllStats{smtpConnTLS};
 $s{smtpConnAcceptedTotal}=$Stats{smtpConn}+$Stats{smtpConnNotLogged};
 $s{smtpConnAcceptedTotal2}=$AllStats{smtpConn}+$AllStats{smtpConnNotLogged};
 $s{smtpConnLimit}=$Stats{smtpConnLimit}+$Stats{smtpConnDomainIP}+$Stats{smtpConnLimitIP}+$Stats{smtpConnLimitFreq}+$Stats{AUTHErrors}+$Stats{delayConnection}+$Stats{smtpSameSubject};
 $s{smtpConnLimit2}=$AllStats{smtpConnLimit}+$AllStats{smtpConnDomainIP}+$AllStats{smtpConnLimitIP}+$AllStats{smtpConnLimitFreq}+$AllStats{AUTHErrors}+$AllStats{delayConnection}+$AllStats{smtpSameSubject};
 $s{smtpConnRejectedTotal}=$s{smtpConnLimit}+$Stats{smtpConnDenied}+$Stats{denyConnectionA};
 $s{smtpConnRejectedTotal2}=$s{smtpConnLimit2}+$AllStats{smtpConnDenied}+$AllStats{denyConnectionA};
 $s{smtpConnTotal}=$s{smtpConnAcceptedTotal}+$s{smtpConnRejectedTotal};
 $s{smtpConnTotal2}=$s{smtpConnAcceptedTotal2}+$s{smtpConnRejectedTotal2};
 $s{admConnTotal}=$Stats{admConn}+$Stats{admConnDenied};
 $s{admConnTotal2}=$AllStats{admConn}+$AllStats{admConnDenied};
 $s{statConnTotal}=$Stats{statConn}+$Stats{statConnDenied};
 $s{statConnTotal2}=$AllStats{statConn}+$AllStats{statConnDenied};
 $s{rcptAcceptedLocal}=$Stats{rcptValidated}+$Stats{rcptUnchecked}+$Stats{rcptSpamLover};
 $s{rcptAcceptedLocal2}=$AllStats{rcptValidated}+$AllStats{rcptUnchecked}+$AllStats{rcptSpamLover};
 $s{rcptAcceptedRemote}=$Stats{rcptWhitelisted}+$Stats{rcptNotWhitelisted};
 $s{rcptAcceptedRemote2}=$AllStats{rcptWhitelisted}+$AllStats{rcptNotWhitelisted};
 $s{rcptUnprocessed}=$Stats{rcptUnprocessed};
 $s{rcptUnprocessed2}=$AllStats{rcptUnprocessed};
 $s{rcptReport}=$Stats{rcptReportSpam}+$Stats{rcptReportHam}+$Stats{rcptReportWhitelistAdd}+$Stats{rcptReportWhitelistRemove}+$Stats{rcptReportRedlistAdd}+$Stats{rcptReportRedlistRemove};
 $s{rcptReport2}=$AllStats{rcptReportSpam}+$AllStats{rcptReportHam}+$AllStats{rcptReportWhitelistAdd}+$AllStats{rcptReportWhitelistRemove}+$AllStats{rcptReportRedlistAdd}+$AllStats{rcptReportRedlistRemove};
 $s{rcptAcceptedTotal}=$s{rcptAcceptedLocal}+$s{rcptAcceptedRemote}+$s{rcptUnprocessed}+$s{rcptReport};
 $s{rcptAcceptedTotal2}=$s{rcptAcceptedLocal2}+$s{rcptAcceptedRemote2}+$s{rcptUnprocessed2}+$s{rcptReport2};
 $s{rcptRejectedLocal}=$Stats{rcptNonexistent}+$Stats{rcptDelayed}+$Stats{rcptDelayedLate}+$Stats{rcptDelayedExpired}+
                       $Stats{rcptEmbargoed}+$Stats{rcptSpamBucket};
 $s{rcptRejectedLocal2}=$AllStats{rcptNonexistent}+$AllStats{rcptDelayed}+$AllStats{rcptDelayedLate}+$AllStats{rcptDelayedExpired}+
                        $AllStats{rcptEmbargoed}+$AllStats{rcptSpamBucket};
 $s{rcptRejectedRemote}=$Stats{rcptRelayRejected};
 $s{rcptRejectedRemote2}=$AllStats{rcptRelayRejected};
 $s{rcptRejectedTotal}=$s{rcptRejectedLocal}+$s{rcptRejectedRemote};
 $s{rcptRejectedTotal2}=$s{rcptRejectedLocal2}+$s{rcptRejectedRemote2};
 $s{rcptTotal}=$s{rcptAcceptedTotal}+$s{rcptRejectedTotal};
 $s{rcptTotal2}=$s{rcptAcceptedTotal2}+$s{rcptRejectedTotal2};
 $s{msgAcceptedTotal}=$Stats{bhams}+$Stats{whites}+$Stats{locals}+$Stats{noprocessing}+$Stats{spamlover};
 $s{msgAcceptedTotal2}=$AllStats{bhams}+$AllStats{whites}+$AllStats{locals}+$AllStats{noprocessing}+$AllStats{spamlover};
 $s{msgRejectedTotal}=$Stats{preHeader}+$Stats{localFrequency}+$Stats{bspams}+$Stats{blacklisted}+$Stats{helolisted}+$Stats{spambucket}+$Stats{penaltytrap}+$Stats{viri}+$Stats{internaladdresses}+$Stats{smtpConnDenied}+$Stats{smtpConnDomainIP}+$Stats{smtpConnLimitFreq}+
                      $Stats{viridetected}+$Stats{bombs}+$Stats{dkim}+$Stats{msgverify}+$Stats{bombSender}+$Stats{bombBlack}+$Stats{invalidHelo}+$Stats{ptrMissing}+$Stats{ptrInvalid}+$Stats{mxaMissing}+$Stats{forgedHelo}+$Stats{pbdenied}+$Stats{pbextreme}+$Stats{denyConnection}+$Stats{sbblocked}+$Stats{msgscoring}+$Stats{senderInvalidLocals}+$Stats{scripts}+$Stats{spffails}+$Stats{rblfails}+$Stats{uriblfails}+$Stats{msgMaxErrors}+$Stats{msgDelayed}+$Stats{msgNoRcpt}+$Stats{msgNoSRSBounce}+
                      $Stats{Razor}+$Stats{DCC}+$Stats{crashAnalyze}+$Stats{msgBackscatterErrors}+$Stats{smtpSameSubject};
 $s{msgRejectedTotal2}=$AllStats{preHeader}+$AllStats{localFrequency}+$AllStats{bspams}+$AllStats{blacklisted}+$AllStats{helolisted}+$AllStats{spambucket}+$AllStats{penaltytrap}+$AllStats{viri}+$AllStats{internaladdresses}+$AllStats{smtpConnDenied}+$AllStats{smtpConnDomainIP}+$AllStats{smtpConnLimitFreq}+
                       $AllStats{viridetected}+$AllStats{bombs}+$AllStats{dkim}+$AllStats{msgverify}+$AllStats{bombSender}+$AllStats{bombBlack}+$AllStats{ptrMissing}+$AllStats{ptrInvalid}+$AllStats{mxaMissing}+$AllStats{forgedHelo}+$AllStats{invalidHelo}+$AllStats{pbdenied}+$AllStats{pbextreme}+$AllStats{denyConnection}+$AllStats{sbblocked} +$AllStats{msgscoring}+$AllStats{senderInvalidLocals}+$AllStats{scripts}+$AllStats{spffails}+$AllStats{rblfails}+$AllStats{uriblfails}+
                       $AllStats{msgMaxErrors}+$AllStats{msgDelayed}+$AllStats{msgNoRcpt}+$AllStats{msgNoSRSBounce}+$AllStats{Razor}+$AllStats{DCC}+$AllStats{crashAnalyze}+$AllStats{msgBackscatterErrors}+$AllStats{smtpSameSubject};
 $s{msgTotal}=$s{msgAcceptedTotal}+$s{msgRejectedTotal};
 $s{msgTotal2}=$s{msgAcceptedTotal2}+$s{msgRejectedTotal2};

 %s;
}

sub ResetAllStats {
     %OldStats = ();
     %AllStats = ();
     %OldScoreStats = ();
     %AllScoreStats = ();
     $AllStats{starttime} = time;
     unlink("$base/asspstats.sav.bak");
     unlink("$base/asspscorestats.sav.bak");
     rename("$base/asspstats.sav","$base/asspstats-".timestring('','','YYYY-MM-DD-hh-mm-ss').'.sav');
     rename("$base/asspscorestats.sav","$base/asspscorestats-".timestring('','','YYYY-MM-DD-hh-mm-ss').'.sav');
     ResetStats();
}

sub StatLine {
    our ($l1,$l2,$l3) = @_;
    $l1->{text} = 0 unless $l1->{text};
    $l2->{text} = 0 unless $l2->{text};
    $l3->{text} = 0 unless $l3->{text};
    my $sc;
    if ($l1->{stat}) {
        if ($l1->{stat} !~ s/^#//o)
        {
            if ($l1->{stat} =~ s/^;//o) {
                $ScoreStats{$l1->{stat}} = 0 unless $ScoreStats{$l1->{stat}};
                $sc = 'score';
            } else {
                $Stats{$l1->{stat}} = 0 unless $Stats{$l1->{stat}};
                $sc = 'stat';
            }
        }
        if ($CreateMIB) {
            if ($sc eq 'score') {
                $ScoreStatText{$l1->{stat}} = $l1->{text};
                $ScoreStatText{$l1->{stat}} =~ s/\&nbsp;//og;
                $ScoreStatText{$l1->{stat}} =~ s/<a href.+?">([^<>]+)<\/a>/$1/goi;
            } else {
                $StatText{$l1->{stat}} = $l1->{text};
                $StatText{$l1->{stat}} =~ s/\&nbsp;//og;
                $StatText{$l1->{stat}} =~ s/<a href.+?">([^<>]+)<\/a>/$1/goi;
            }
        }
    }
    my $stat = delete $l1->{stat};
    my $noshow = delete $l1->{noshow};

    my $l2bar;
    if (exists $l2->{min}) {
        my $val = 0;
        if ($l2->{max} && $l2->{max} != $l2->{min}) {
            $val = int(80 * ($l2->{text} - $l2->{min}) / ($l2->{max} - $l2->{min}));
        }
        my $color = 'blue';
        $color = 'green' if $l2->{class} =~ /positive/o;
        $color = 'red'  if $l2->{class} =~ /negative/o;
        $l2bar = <<EOT;
<div style="width: $val\%; height: 10px; border: 1px solid #ccc; margin: 2px 5px 2px 0; padding: 1px; float: left; background: $color;"></div>
EOT
        delete $l2->{max};
        delete $l2->{min};
    }
    my $l3bar;
    if (exists $l3->{min}) {
        my $val = 0;
        if ($l3->{max} && $l3->{max} != $l3->{min}) {
            $val = int(80 * ($l3->{text} - $l3->{min}) / ($l3->{max} - $l3->{min}));
        }
        my $color = 'blue';
        $color = 'green' if $l3->{class} =~ /positive/o;
        $color = 'red'  if $l3->{class} =~ /negative/o;
        $l3bar = <<EOT;
<div style="width: $val\%; height: 10px; border: 1px solid #ccc; margin: 2px 5px 2px 0; padding: 1px; float: left; background: $color;"></div>
EOT
        delete $l3->{max};
        delete $l3->{min};
    }
    my $glink;
    if ($CanUseASSP_SVG && $sc && $stat && ! $noshow) {
        my $text = $l1->{text};
        $text =~ s/\s*:\s*$//o;
        $text =~ s/\&nbsp;?//og;
        $text = encHTMLent($text);
        $glink = " onclick=\"window.open('./statgraph?stattype=$sc&stat=$stat&name=$text');\"";
    }
    my $ret = <<EOT;
          <tr$glink>
            <td l1-prop>
              $l1->{text}
            </td>
            <td l2-prop>
              $l2bar$l2->{text}
            </td>
            <td l3-prop>
              $l3bar$l3->{text}
            </td>
          </tr>
EOT
    foreach my $l ('l1','l2','l3') {
        delete ${$l}->{text};
        my $tdp;
        foreach (sort keys %{${$l}}) {
            $tdp .= $_ . '="'.${${$l}}{$_}.'" ';
        }
        $ret =~ s/$l-prop/$tdp/;
    }
    return $noshow ? '' : $ret;
}

sub StatsGetModules {
 my  @modArray;
 my  $modules = '<tr>
                   <td class="statsOptionTitle"><font color=blue>Module Name</font>
                   </td>
                   <td class="statsOptionValue" colspan="2"><font color=blue>Module Version</font>
                   </td>
                   <td class="statsOptionValue" colspan="1"><font color=blue>Module Status</font>
                   </td>
                   <td class="statsOptionValueC" colspan="1"><font color=blue>Download</font>
                   </td>
                  </tr>';
     $modules .= '<tr>
                   <td class="statsOptionTitle"><font color=blue><a href="javascript:void(0);" onclick="javascript:popFileEditor(\'moduleLoadErrors.txt\',8);">show</a> module load errors</font>
                   </td>
                   <td class="statsOptionValue" colspan="2"><font color=blue>installed  /  required(recommended)</font>
                   </td>
                   <td class="statsOptionValue" colspan="1"><font color=blue>&nbsp;</font>
                   </td>
                   <td class="statsOptionValueC" colspan="1"><font color=blue>&nbsp;</font>
                   </td>
                  </tr>';
 foreach (sort keys %ModuleList) {
     my ($inst,$requ) = split(/\//o, $ModuleList{$_});
     my $ti = $inst;
     my $tr = $requ;
     $ti =~ s/[0 ]+$//o;
     $tr =~ s/[0 ]+$//o;
     $ti =~ s/^[0 ]+//o;
     $tr =~ s/^[0 ]+//o;
     $ti =~ s/_.*$//o;
     $tr =~ s/_.*$//o;
     if ($ti && $ti =~ /([\d\._]+)/o) {
         if ($1 lt $tr) {
             $inst = '<font color=red>'.$inst.'</font>';
             $requ = '<font color=red>'.$requ.'</font>';
         }
     } else {
             my $modvar = "use$_";
             $modvar =~ s/:://go;
             $inst = $$modvar ? 'not installed' : defined $$modvar ? "disabled by <a href=\"./#$modvar\">Module Setup</a>" : '';
             $inst = '<font color=red>'.$inst.'</font>';
             $requ = '<font color=red>'.$requ.'</font>';
     }
     my $url = 'http://search.cpan.org/search?query='.$_;
     $url = 'http://www.oracle.com/technology/products/berkeley-db/' if ($_ eq 'BerkeleyDB_DBEngine');
     $url = 'http://assp.cvs.sourceforge.net/viewvc/assp/assp2/lib/' if ($_ eq 'AsspSelfLoader');
     $url = 'http://assp.cvs.sourceforge.net/viewvc/assp/assp2/lib/' if ($_ eq 'ASSP_WordStem');
     $url = 'http://assp.cvs.sourceforge.net/viewvc/assp/assp2/filecommander/' if ($_ eq 'ASSP_FC');
     $url = 'http://assp.cvs.sourceforge.net/viewvc/assp/assp2/lib/' if ($_ eq 'ASSP_SVG');
     $url = 'http://assp.cvs.sourceforge.net/viewvc/assp/assp2/lib/Regex/' if ($_ eq 'Regex::Optimizer');
     $url = 'http://assp.cvs.sourceforge.net/viewvc/assp/assp2/Plugins/' if ($_ =~ /^Plugins/o);
     my $prov = 'CPAN';
     $prov = 'oracle' if ($_ eq 'BerkeleyDB_DBEngine');
     $prov = 'sourceforge' if ($_ eq 'Regex::Optimizer' or $_ =~ /^Plugins/o or $_ eq 'AsspSelfLoader' or $_ eq 'ASSP_WordStem' or $_ eq 'ASSP_FC' or $_ eq 'ASSP_SVG');
     my $stat = $ModuleStat{$_} ? $ModuleStat{$_} : 'enabled';
     if ($_ eq 'File::Scan::ClamAV' && $CanUseAvClamd && ! $AvailAvClamd) {
         $stat = 'ClamAvDaemon is down';
     }
     $stat = '<font color=red>'.$stat.'</font>' if $stat ne 'enabled';
     if($_ eq 'Sys::Syslog' && $^O eq 'MSWin32') {
         $inst = 'not supported by operating system';
          push @modArray , [$_,$inst,$requ,$stat,$url];
          next;
     }
     if($_ =~ /^Win32::/io && $^O ne 'MSWin32') {
         $inst = 'not supported by operating system';
          push @modArray , [$_,$inst,$requ,$stat,$url];
          next;
     }
     push @modArray , [$_,$inst,$requ,$stat,$url];
     $modules .= '<tr>
                   <td class="statsOptionTitle">'. $_ .
                  '</td>
                   <td class="statsOptionValue" colspan="2">' . $inst . '  /  ' . $requ.
                  '</td>
                   <td class="statsOptionValue" colspan="1">' . $stat .
                  '</td>
                   <td class="statsOptionValueC" colspan="1">
                     <a href="'.$url.'" rel="external">'.$prov.'</a>
                   </td>
                  </tr>';
 }
 return $modules,@modArray;
}

sub ConfigStats {
 my %tots = ();
 {
 lock(%Stats) if (is_shared(%Stats));
 if ($qs{ResetAllStats}) {
     if (&canUserDo($WebIP{$ActWebSess}->{user},'action','resetallstats')) {
         ResetAllStats();
     } else {
         return &webBlockText();
     }
 } elsif ($qs{ResetStats}) {
     if (&canUserDo($WebIP{$ActWebSess}->{user},'action','resetcurrentstats')) {
         ResetStats();
     } else {
         return &webBlockText();
     }
 }
 SaveStats();
 %tots=statsTotals();
 }
 delete $qs{ResetAllStats};
 delete $qs{ResetStats};
 my $upt=(time-$Stats{starttime})/(24*3600);
 my $upt2=(time-$AllStats{starttime})/(24*3600);
 my $resettime=localtime($AllStats{starttime});
 my $uptime=getTimeDiffAsString(time-$Stats{starttime},1);
 my $uptime2=getTimeDiffAsString(time-$AllStats{starttime});
 my $damptime=getTimeDiffAsString($Stats{damptime},1);
 my $damptime2=getTimeDiffAsString($AllStats{damptime});
 my $mpd=sprintf("%.1f",$upt==0 ? 0 : $tots{msgTotal}/$upt);
 my $mpd2=sprintf("%.1f",$upt2==0 ? 0 : $tots{msgTotal2}/$upt2);
 my $pct=sprintf("%.2f",$tots{msgTotal}-$Stats{locals}==0 ? 0 : 100*$tots{msgRejectedTotal}/($tots{msgTotal}-$Stats{locals}));
 my $pct2=sprintf("%.2f",$tots{msgTotal2}-$AllStats{locals}==0 ? 0 : 100*$tots{msgRejectedTotal2}/($tots{msgTotal2}-$AllStats{locals}));
 my $cpuAvg=sprintf("%.2f",(! $Stats{cpuTime} ? 0 : 100*$Stats{cpuBusyTime}/$Stats{cpuTime}));
 $cpuAvg = "99.00" if $cpuAvg > 99;
 my $cpuAvg2=sprintf("%.2f",(! $AllStats{cpuTime} ? 0 : 100*$AllStats{cpuBusyTime}/$AllStats{cpuTime}));
 $cpuAvg2 = "99.00" if $cpuAvg2 > 99;
#mlog(0,"info: cpuTime: $AllStats{cpuTime} - cpuBusyTime: $AllStats{cpuBusyTime}");

 my $wIdle = '<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\\'100%\\\' bgcolor=lightyellow><tr><td>worker number</td><td>avg. CPU usage</td>';
 $wIdle .= '<td>used memory</td>' if $showMEM;
 $wIdle .= '</tr>';
 my $stime = time - $Stats{starttime};
 $stime ||= 1;
 for (0,1...$NumComWorkers,10000,10001) {
     my $offset = 0;
     my $wname = "Worker_$_";
     $wname = "Main_Thread" if $_ == 0;
     $offset = time - $WorkerLastAct{$_} if ($_ > 0 && $_ < 10000 && $ComWorker{$_}->{issleep});
     $wIdle .= '<tr><td>'.$wname.'</td><td>'.sprintf("%.2f \%",max((100*($stime - $offset - min(int($ThreadIdleTime{$_}+0.5),$stime))/$stime),0.1)).'</td>';
     $wIdle .= '<td>'.($CurrentMEM{$_} || 'n/a').'</td>' if $showMEM;
     $wIdle .= '</tr>';
 }
 $wIdle .= '</table>';

 my $currStat = &StatusASSP();
 $currStat = ($currStat =~ /not healthy/io)
   ? '<a href="./statusassp" target="blank" onmouseover="showhint(\'<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\\'100%\\\'><tr><td>ASSP '.$version.$modversion.($codename?" ( code name $codename )":'').' is running not healthy! Click to show the current detail thread status.</td></tr></table>\', this, event, \'450px\', \'\'); return true;"><b><font color=\'red\'>&bull;</font></b></a>'
   : '<a href="./statusassp" target="blank" onmouseover="showhint(\'<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\\'100%\\\'><tr><td>ASSP '.$version.$modversion.($codename?" ( code name $codename )":'').' is running healthy. Click to show the current detail thread status.</td></tr></table>\', this, event, \'450px\', \'\'); return true;"><font color=#66CC66>&bull;</font></a>';

 my $currAvgDamp = ($Stats{damping} && $DoDamping) ? sprintf("(%.2f%% avg of accepted connections)",($Stats{damping} / ($Stats{smtpConn} ? $Stats{smtpConn} : 1)) * 100) : '';
 my $allAvgDamp  = ($AllStats{smtpConn} && $DoDamping) ? sprintf("(%.2f%% avg of accepted connections)",($AllStats{damping} / ($AllStats{smtpConn} ? $AllStats{smtpConn} : 1)) * 100) : '';

 my $corrTotal  = "100";
 my $corrTotal2 = "100";
 $corrTotal  = sprintf("%.3f",(($tots{msgTotal} - ($Stats{rcptReportSpam} + $Stats{rcptReportHam})*3) / $tots{msgTotal}) * 100) if $tots{msgTotal};
 $corrTotal2 = sprintf("%.3f",(($tots{msgTotal2} - ($AllStats{rcptReportSpam} + $AllStats{rcptReportHam})*3) / $tots{msgTotal2}) * 100) if $tots{msgTotal2};

 my $LocalDNSStatus;
 
 if ($UseLocalDNS) {
     $LocalDNSStatus = "Local <a href=\"/#UseLocalDNS\">DNS Servers</a> in use";
 } else {
     $LocalDNSStatus = "Custom <a href=\"/#DNSServers\">DNS servers</a> in use";
 }

 my  ($modules,@dummy) = &StatsGetModules();

 my $reset = 'reset';
 my $restart = 'reset or restart';
 if (&canUserDo($WebIP{$ActWebSess}->{user},'action','resetallstats')) {
     $uptime2 = "<a href=\"javascript:void(0);\" title=\"click to reset all stats to zero\" onclick=\"if (confirm('reset all STATS ?')) {WaitDiv();window.location.href='/infostats?ResetAllStats=1';}\">$uptime2</a>";
     $reset = "<a href=\"javascript:void(0);\" title=\"click to reset all stats to zero\" onclick=\"if (confirm('reset all STATS ?')) {WaitDiv();window.location.href='/infostats?ResetAllStats=1';}\">reset</a>";
 }
 if (   &canUserDo($WebIP{$ActWebSess}->{user},'action','resetcurrentstats')
     or &canUserDo($WebIP{$ActWebSess}->{user},'action','resetallstats')) {
     $uptime = "<a href=\"javascript:void(0);\" title=\"click to reset all stats since last start to zero\" onclick=\"if (confirm('reset current STATS ?')) {WaitDiv();window.location.href='/infostats?ResetStats=1';}\">$uptime</a>";
     $restart = "<a href=\"javascript:void(0);\" title=\"click to reset all stats since last start to zero\" onclick=\"if (confirm('reset current STATS ?')) {WaitDiv();window.location.href='/infostats?ResetStats=1';}\">reset</a> or restart";
 }

my $ret = <<EOT;
$headerHTTP
$headerDTDTransitional
$headers
<script type=\"text/javascript\">
<!--
  function toggleTbody(id) {
    if (document.getElementById) {
      var tbod = document.getElementById(id);
      if (tbod && typeof tbod.className == 'string') {
        if (tbod.className == 'off') {
          tbod.className = 'on';
        } else {
          tbod.className = 'off';
        }
      }
    }
    return false;
  }
//-->
</script>
   <div id="cfgdiv" class="content">
      <h2>
        $currStat ASSP Information and Statistics
      </h2><br />
      <table class="statBox">
        <thead>
          <tr>
            <td colspan="5" class="sectionHeader" onmousedown="toggleTbody('StatItem3')">
              General Runtime Information
            </td>
          </tr>
        </thead>
        <tbody id="StatItem3" class="on">
EOT

# General Runtime Information
$ret .= StatLine({'stat'=>'#uptime','text'=>'ASSP Proxy Uptime:','class'=>'statsOptionTitle'},
                 {'text'=>"$uptime",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$uptime2",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'#msgTotal','text'=>'Messages Processed:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{msgTotal} ($mpd per day)",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$tots{msgTotal2} ($mpd2 per day)",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'#pctBlocked','text'=>'Non-Local Mail Blocked:','class'=>'statsOptionTitle'},
                 {'text'=>"$pct%",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$pct2%",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'','text'=>'(no)blocking correctness:<br />&nbsp;processed messages in relation to<br />&nbsp;reported spam + ham','class'=>'statsOptionTitle'},
                 {'text'=>"$corrTotal%",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$corrTotal2%",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'#cpuAvg','text'=>'<a href="javascript:void(0);" onmouseover="showhint(\''.$wIdle.'\', this, event, \'300px\', \'1\');return false;">CPU Usage:</a>','class'=>'statsOptionTitle'},
                 {'text'=>"$cpuAvg% avg",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$cpuAvg2% avg",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'smtpMaxConcurrentSessions','text'=>'Concurrent SMTP Sessions:','class'=>'statsOptionTitle'},
                 {'text'=>"$smtpConcurrentSessions ($Stats{smtpMaxConcurrentSessions} max)",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$AllStats{smtpMaxConcurrentSessions} max",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'','text'=>'&nbsp;','class'=>'statsOptionValue','style'=>'background-color: #FFFFFF'},
                 {'text'=>"<font size=\"1\" color=\"#C0C0C0\"><em>since $restart at $starttime</em></font>",'class'=>'statsOptionValue','style'=>'background-color: #FFFFFF','colspan'=>'2'},
                 {'text'=>"<font size=\"1\" color=\"#C0C0C0\"><em>since $reset at $resettime</em></font>",'class'=>'statsOptionValue','style'=>'background-color: #FFFFFF','colspan'=>'2'})
;
$ret .= <<EOT;
        </tbody>
        <tbody>
          <tr>
            <td colspan="5" class="sectionHeader" onmousedown="toggleTbody('StatItem4')">
              Totaled Statistics
            </td>
          </tr>
        </tbody>
        <tbody id="StatItem4" class="off">
EOT

# Totaled Statistics
$ret .= StatLine({'stat'=>'#smtpConnTotal','text'=>'SMTP Connections Received:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{smtpConnTotal}",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$tots{smtpConnTotal2}",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'#smtpConnAcceptedTotal','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;SMTP Connections Accepted:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{smtpConnAcceptedTotal}",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$tots{smtpConnAcceptedTotal2}",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'#smtpConnRejectedTotal','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;SMTP Connections Rejected:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{smtpConnRejectedTotal}",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$tots{smtpConnRejectedTotal2}",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'#rcptTotal','text'=>'Envelope Recipients Processed:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{rcptTotal}",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$tots{rcptTotal2}",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'#rcptAcceptedTotal','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Envelope Recipients Accepted:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{rcptAcceptedTotal}",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$tots{rcptAcceptedTotal2}",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'#rcptRejectedTotal','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Envelope Recipients Rejected:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{rcptRejectedTotal}",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$tots{rcptRejectedTotal2}",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'#msgTotal','text'=>'Messages Processed:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{msgTotal}",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$tots{msgTotal2}",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'#msgAcceptedTotal','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Messages Passed:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{msgAcceptedTotal}",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$tots{msgAcceptedTotal2}",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'#msgRejectedTotal','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Messages Rejected:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{msgRejectedTotal}",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$tots{msgRejectedTotal2}",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'#admConnTotal','text'=>'Admin Connections Received:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{admConnTotal}",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$tots{admConnTotal2}",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'admConn','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Admin Connections Accepted:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{admConn}",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$AllStats{admConn}",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'admConnDenied','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Admin Connections Rejected:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{admConnDenied}",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$AllStats{admConnDenied}",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'#statConnTotal','text'=>'Stat Connections Received:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{statConnTotal}",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$tots{statConnTotal2}",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'statConn','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Stat Connections Accepted:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{statConn}",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$AllStats{statConn}",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'statConnDenied','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Stat Connections Rejected:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{statConnDenied}",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$AllStats{statConnDenied}",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'','text'=>'&nbsp;','class'=>'statsOptionValue','style'=>'background-color: #FFFFFF'},
                 {'text'=>"<font size=\"1\" color=\"#C0C0C0\"><em>since $restart at $starttime</em></font>",'class'=>'statsOptionValue','style'=>'background-color: #FFFFFF','colspan'=>'2'},
                 {'text'=>"<font size=\"1\" color=\"#C0C0C0\"><em>since $reset at $resettime</em></font>",'class'=>'statsOptionValue','style'=>'background-color: #FFFFFF','colspan'=>'2'})
;
$ret .= <<EOT;
        </tbody>
        <tbody>
          <tr>
            <td colspan="5" class="sectionHeader" onmousedown="toggleTbody('StatItem5')">
              SMTP Connection Statistics
            </td>
          </tr>
        </tbody>
        <tbody id="StatItem5" class="off">
EOT

#SMTP Connection Statistics
$ret .= StatLine({'stat'=>'smtpConn','text'=>'Accepted Logged SMTP Connections:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{smtpConn}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$AllStats{smtpConn}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'smtpConnSSL','text'=>'SSL-Port SMTP Connections:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{smtpConnSSL}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$AllStats{smtpConnSSL}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'smtpConnTLS','text'=>'STARTTLS SMTP Connections:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{smtpConnTLS}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$AllStats{smtpConnTLS}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'smtpConnNotLogged','text'=>'Not Logged SMTP Connections:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{smtpConnNotLogged}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$AllStats{smtpConnNotLogged}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'smtpConnLimit','text'=>'SMTP Connection Limits:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{smtpConnLimit}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$tots{smtpConnLimit2}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'smtpConnLimit','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Overall Limits:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{smtpConnLimit}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$AllStats{smtpConnLimit}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'smtpConnLimitIP','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;By IP Limits:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{smtpConnLimitIP}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$AllStats{smtpConnLimitIP}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'delayConnection','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;By Delay on PB:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{delayConnection}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$AllStats{delayConnection}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'AUTHErrors','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;By AUTH Errors Count:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{AUTHErrors}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$AllStats{AUTHErrors}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'smtpConnLimitFreq','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;By IP Frequency Limits:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{smtpConnLimitFreq}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$AllStats{smtpConnLimitFreq}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'smtpConnDomainIP','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;By Domain IP Limits:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{smtpConnDomainIP}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$AllStats{smtpConnDomainIP}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'smtpSameSubject','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;By Same Subjects Limits:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{smtpSameSubject}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$AllStats{smtpSameSubject}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'smtpConnIdleTimeout','text'=>'SMTP Connections Timeout:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{smtpConnIdleTimeout}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$tots{smtpConnIdleTimeout2}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'smtpConnSSLIdleTimeout','text'=>'SMTP SSL-Port-Connections Timeout:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{smtpConnSSLIdleTimeout}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$tots{smtpConnSSLIdleTimeout2}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'smtpConnTLSIdleTimeout','text'=>'SMTP STARTTLS-Connections Timeout:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{smtpConnTLSIdleTimeout}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$tots{smtpConnTLSIdleTimeout2}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'smtpConnDenied','text'=>'Denied SMTP Connections (enforced Extreme):','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{smtpConnDenied}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$AllStats{smtpConnDenied}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'denyConnectionA','text'=>'Denied SMTP Connections (strict):','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{denyConnectionA}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$AllStats{denyConnectionA}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'damping','text'=>'SMTP Connection damping:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{damping} $currAvgDamp",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$AllStats{damping} $allAvgDamp",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'#damptime','text'=>'stolen time by damping:','class'=>'statsOptionTitle'},
                 {'text'=>"$damptime",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$damptime2",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'','text'=>'&nbsp;','class'=>'statsOptionValue','style'=>'background-color: #FFFFFF'},
                 {'text'=>"<font size=\"1\" color=\"#C0C0C0\"><em>since $restart at $starttime</em></font>",'class'=>'statsOptionValue','style'=>'background-color: #FFFFFF','colspan'=>'2'},
                 {'text'=>"<font size=\"1\" color=\"#C0C0C0\"><em>since $reset at $resettime</em></font>",'class'=>'statsOptionValue','style'=>'background-color: #FFFFFF','colspan'=>'2'})
;
$ret .= <<EOT;
        </tbody>
        <tbody>
          <tr>
            <td colspan="5" class="sectionHeader" onmousedown="toggleTbody('StatItem6')">
              Envelope Recipient Statistics
            </td>
          </tr>
        </tbody>
        <tbody id="StatItem6" class="off">
EOT

# Envelope Recipient Statistics
$ret .= StatLine({'stat'=>'rcptAcceptedLocal','text'=>'Local Recipients Accepted:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{rcptAcceptedLocal}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$tots{rcptAcceptedLocal2}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'rcptValidated','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Validated Recipients:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptValidated}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptValidated}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'rcptUnchecked','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Unchecked Recipients:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptUnchecked}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptUnchecked}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'rcptSpamLover','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Spam-Lover Recipients:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptSpamLover}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptSpamLover}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'#rcptAcceptedRemote','text'=>'Remote Recipients Accepted:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{rcptAcceptedRemote}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$tots{rcptAcceptedRemote2}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'rcptWhitelisted','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Whitelisted Recipients:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptWhitelisted}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptWhitelisted}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'rcptNotWhitelisted','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Not Whitelisted Recipients:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptNotWhitelisted}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptNotWhitelisted}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'rcptUnprocessed','text'=>'Noprocessed Recipients:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptUnprocessed}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptUnprocessed}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'#rcptReport','text'=>'Email Reports:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{rcptReport}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$tots{rcptReport2}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'rcptReportSpam','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Spam Reports:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptReportSpam}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptReportSpam}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'rcptReportHam','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Ham Reports:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptReportHam}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptReportHam}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'rcptReportWhitelistAdd','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Whitelist Additions:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptReportWhitelistAdd}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptReportWhitelistAdd}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'rcptReportWhitelistRemove','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Whitelist Deletions:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptReportWhitelistRemove}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptReportWhitelistRemove}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'rcptReportRedlistAdd','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Redlist Additions:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptReportRedlistAdd}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptReportRedlistAdd}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'rcptReportRedlistRemove','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Redlist Deletions:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptReportRedlistRemove}",'class'=>'statsOptionValue positive','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptReportRedlistRemove}",'class'=>'statsOptionValue positive','colspan'=>'2'})

      . StatLine({'stat'=>'#rcptRejectedLocal','text'=>'Local Recipients Rejected:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{rcptRejectedLocal}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$tots{rcptRejectedLocal2}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'rcptNonexistent','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Nonexistent Recipients:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptNonexistent}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptNonexistent}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'rcptDelayed','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Delayed Recipients:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptDelayed}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptDelayed}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'rcptDelayedLate','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Delayed (Late) Recipients:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptDelayedLate}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptDelayedLate}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'rcptDelayedExpired','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Delayed (Expired) Recipients:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptDelayedExpired}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptDelayedExpired}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'rcptEmbargoed','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Embargoed Recipients:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptEmbargoed}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptEmbargoed}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'rcptSpamBucket','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Spam Bucketed Recipients:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptSpamBucket}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptSpamBucket}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'#rcptRejectedRemote','text'=>'Remote Recipients Rejected:','class'=>'statsOptionTitle'},
                 {'text'=>"$tots{rcptRejectedRemote}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$tots{rcptRejectedRemote2}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'rcptRelayRejected','text'=>'&nbsp;&nbsp;&nbsp;&nbsp;Relay Attempts Rejected:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rcptRelayRejected}",'class'=>'statsOptionValue negative','colspan'=>'2'},
                 {'text'=>"$AllStats{rcptRelayRejected}",'class'=>'statsOptionValue negative','colspan'=>'2'})

      . StatLine({'stat'=>'','text'=>'&nbsp;','class'=>'statsOptionValue','style'=>'background-color: #FFFFFF'},
                 {'text'=>"<font size=\"1\" color=\"#C0C0C0\"><em>since $restart at $starttime</em></font>",'class'=>'statsOptionValue','style'=>'background-color: #FFFFFF','colspan'=>'2'},
                 {'text'=>"<font size=\"1\" color=\"#C0C0C0\"><em>since $reset at $resettime</em></font>",'class'=>'statsOptionValue','style'=>'background-color: #FFFFFF','colspan'=>'2'})
;
$ret .= <<EOT;
        </tbody>
        <tbody>
          <tr>
            <td colspan="5" class="sectionHeader" onmousedown="toggleTbody('StatItem7')">
              Message Statistics
            </td>
          </tr>
        </tbody>
        <tbody id="StatItem7" class="on">
EOT

my @msgStats = qw(
bhams whites locals noprocessing spamlover bspams blacklisted helolisted invalidHelo
forgedHelo mxaMissing ptrMissing ptrInvalid spambucket penaltytrap viri viridetected
bombBlack bombs bombSender pbdenied pbextreme denyConnection sbblocked msgscoring
senderInvalidLocals internaladdresses scripts spffails rblfails uriblfails msgMaxVRFYErrors
msgBackscatterErrors msgMSGIDtrErrors batvErrors msgMaxErrors msgDelayed msgNoRcpt
msgNoSRSBounce dkimpre dkim localFrequency preHeader msgverify crashAnalyze Razor DCC
);
my %st;
map {$st{$_} = $Stats{$_};} @msgStats;
my ($smin,$smax) = minmax(\%st);
%st =();
map {$st{$_} = $AllStats{$_};} @msgStats;
my ($amin,$amax) = minmax(\%st);
%st = ();
@msgStats = ();
# Message Statistics
$ret .= StatLine({'stat'=>'bhams','text'=>'Message OK:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{bhams}",'class'=>'statsOptionValue positive','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{bhams}",'class'=>'statsOptionValue positive','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'whites','text'=>'Whitelisted:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{whites}",'class'=>'statsOptionValue positive','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{whites}",'class'=>'statsOptionValue positive','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'locals','text'=>'Local:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{locals}",'class'=>'statsOptionValue positive','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{locals}",'class'=>'statsOptionValue positive','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'noprocessing','text'=>'Noprocessing:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{noprocessing}",'class'=>'statsOptionValue positive','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{noprocessing}",'class'=>'statsOptionValue positive','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'spamlover','text'=>'Spamlover Spams Passed:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{spamlover}",'class'=>'statsOptionValue positive','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{spamlover}",'class'=>'statsOptionValue positive','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'bspams','text'=>'Bayesian/HMM Spams:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{bspams}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{bspams}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'blacklisted','text'=>'Domains Blacklisted:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{blacklisted}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{blacklisted}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'helolisted','text'=>'HELO Blacklisted:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{helolisted}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{helolisted}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'invalidHelo','text'=>'HELO Invalid:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{invalidHelo}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{invalidHelo}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'forgedHelo','text'=>'HELO Forged:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{forgedHelo}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{forgedHelo}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'mxaMissing','text'=>'Missing MX and A Record:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{mxaMissing}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{mxaMissing}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'ptrMissing','text'=>'Missing PTR Record:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{ptrMissing}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{ptrMissing}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'ptrInvalid','text'=>'Invalid PTR Record:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{ptrInvalid}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{ptrInvalid}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'spambucket','text'=>'Spam Collected Messages:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{spambucket}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{spambucket}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'penaltytrap','text'=>'Penalty Trap Messages:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{penaltytrap}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{penaltytrap}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'viri','text'=>'Bad Attachments:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{viri}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{viri}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'viridetected','text'=>'Viruses Detected:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{viridetected}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{viridetected}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'bombBlack','text'=>'Black Regex:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{bombBlack}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{bombBlack}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'bombs','text'=>'Bomb Regex:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{bombs}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{bombs}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'bombSender','text'=>'Bomb - Sender/Header Regex:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{bombSender}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{bombSender}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'pbdenied','text'=>'Penalty Box:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{pbdenied}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{pbdenied}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'pbextreme','text'=>'PenaltyBox Extreme:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{pbextreme}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{pbextreme}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'denyConnection','text'=>'Deny Connection:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{denyConnection}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{denyConnection}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'sbblocked','text'=>'CountryCode blocked:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{sbblocked}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{sbblocked}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'msgscoring','text'=>'Message Scoring:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{msgscoring}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{msgscoring}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'senderInvalidLocals','text'=>'Invalid Sender:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{senderInvalidLocals}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{senderInvalidLocals}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'internaladdresses','text'=>'Invalid Internal Mail:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{internaladdresses}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{internaladdresses}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'scripts','text'=>'Scripts:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{scripts}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{scripts}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'spffails','text'=>'SPF Failures:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{spffails}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{spffails}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'rblfails','text'=>'RBL Failures:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{rblfails}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{rblfails}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'uriblfails','text'=>'URIBL Failures:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{uriblfails}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{uriblfails}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'msgMaxVRFYErrors','text'=>'Max VRFY Errors:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{msgMaxVRFYErrors}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{msgMaxVRFYErrors}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'msgBackscatterErrors','text'=>'BackScatter Errors:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{msgBackscatterErrors}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{msgBackscatterErrors}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'msgMSGIDtrErrors','text'=>'MSGID signing Errors:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{msgMSGIDtrErrors}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{msgMSGIDtrErrors}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'batvErrors','text'=>'BATV Errors:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{batvErrors}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{batvErrors}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'msgMaxErrors','text'=>'Max Errors Exceeded:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{msgMaxErrors}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{msgMaxErrors}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'msgDelayed','text'=>'Delayed/Greylisted:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{msgDelayed}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{msgDelayed}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'msgNoRcpt','text'=>'Empty Recipient:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{msgNoRcpt}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{msgNoRcpt}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'msgNoSRSBounce','text'=>'Unsigned SRS Bounces:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{msgNoSRSBounce}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{msgNoSRSBounce}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'dkimpre','text'=>'DKIM pre Check:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{dkimpre}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{dkimpre}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'dkim','text'=>'DKIM Signature:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{dkim}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{dkim}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'localFrequency','text'=>'local frequency:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{localFrequency}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{localFrequency}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'preHeader','text'=>'early (pre)Header:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{preHeader}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{preHeader}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'msgverify','text'=>'uuencoded and Header error:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{msgverify}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{msgverify}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'crashAnalyze','text'=>'Crash Analyzer:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{crashAnalyze}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{crashAnalyze}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'Razor','text'=>'ASSP_Razor Plugin:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{Razor}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{Razor}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'DCC','text'=>'ASSP_DCC Plugin:','class'=>'statsOptionTitle'},
                 {'text'=>"$Stats{DCC}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$smin,'max'=>$smax},
                 {'text'=>"$AllStats{DCC}",'class'=>'statsOptionValue negative','colspan'=>'2','min'=>$amin,'max'=>$amax})

      . StatLine({'stat'=>'','text'=>'&nbsp;','class'=>'statsOptionValue','style'=>'background-color: #FFFFFF'},
                 {'text'=>"<font size=\"1\" color=\"#C0C0C0\"><em>since $restart at $starttime</em></font>",'class'=>'statsOptionValue','style'=>'background-color: #FFFFFF','colspan'=>'2'},
                 {'text'=>"<font size=\"1\" color=\"#C0C0C0\"><em>since $reset at $resettime</em></font>",'class'=>'statsOptionValue','style'=>'background-color: #FFFFFF','colspan'=>'2'})
;
$ret .= <<EOT;
        </tbody>
        <tbody>
          <tr>
            <td class="sectionHeader" onmousedown="toggleTbody('StatItem8')" colspan="5">
              Message Scoring Statistics
            </td>
          </tr>
        </tbody>
        <tbody id="StatItem8" class="off">
EOT

my %tmpStats = %ScoreStats;
($smin,$smax) = minmax(\%ScoreStats);
($amin,$amax) = minmax(\%AllScoreStats);
for (sort {lc($main::a) cmp lc($main::b)} qw(
 ASSP_AFC ASSP_DCC ASSP_OCR ASSP_Razor AUTHErrors Backscatter-failed BadAttachment BadHistory BATV-check-failed Bayesian
 BlacklistedDomain BlacklistedHelo BlackOrg BlockedCountry BombBlack BombCharSets BombData BombHeaderRe bombRe BombScript
 BombSenderHelo BombSenderIP BombSenderMailFrom BombSubjectRe bombSuspiciousRe CountryCode DKIMfailed DKIMpass DMARC-failed DNSBLfailed
 DNSBLneutral EarlyTalker ExtremeHistory ForgedHELO From-missing griplist HMM HomeCountry internaladdress InvalidAddress
 InvalidHELO InvalidLocalSender InWhiteBox IPfrequency IPinHELO IPinHELOmismatch KnownGoodHelo LimitingIP LimitingIPDomain LimitingSameSubject
 MaxDuplicateRcpt MaxErrors MessageOK MissingMX MissingMXA Msg-IDinvalid Msg-IDmissing Msg-IDnotvalid Msg-IDsuspicious
 MSGID-signature-failed NeedRecipient NoCountryNoOrg NoSpoofing penaltytrap PTRinvalid PTRmissing RelayAttempt SIZE
 SpamCollectAddress SPFerror SPFfail SPFfail-strict SPFneutral SPFneutral-strict SPFnone SPFnone-strict SPFpass
 SPFsoftfail SPFsoftfail-strict SRS_Not_Signed SSL-TLS-connection-OK SuspiciousVirus-ClamAV
 SuspiciousVirus-FileScan TimeOut URIBLfailed URIBLneutral ValidHELO virus-ClamAV virus-FileScan WhiteSenderBase)
 )
{

    $ret .= StatLine({'stat'=>";$_",'text'=>"$_:",'class'=>'statsOptionTitle'},
                     {'text'=>"$ScoreStats{$_}",'class'=>'statsOptionValue','colspan'=>'2','style'=>'color: blue','min'=>$smin,'max'=>$smax},
                     {'text'=>"$AllScoreStats{$_}",'class'=>'statsOptionValue','colspan'=>'2','style'=>'color: blue','min'=>$amin,'max'=>$amax});
    delete $tmpStats{$_};
}
foreach (sort keys %tmpStats) {
    mlog(0,"error: unknown/unregistered ScoreStats name '$_' - this has been corrected!");
    delete $ScoreStats{$_};
    delete $AllScoreStats{$_};
    delete $OldScoreStats{$_};
}
$ret .= StatLine({'stat'=>'','text'=>'&nbsp;','class'=>'statsOptionValue','style'=>'background-color: #FFFFFF'},
                 {'text'=>"<font size=\"1\" color=\"#C0C0C0\"><em>since $restart at $starttime</em></font>",'class'=>'statsOptionValue','style'=>'background-color: #FFFFFF','colspan'=>'2'},
                 {'text'=>"<font size=\"1\" color=\"#C0C0C0\"><em>since $reset at $resettime</em></font>",'class'=>'statsOptionValue','style'=>'background-color: #FFFFFF','colspan'=>'2'})
;
$ret .= <<EOT;
        </tbody>
        <tbody>
          <tr>
            <td class="sectionHeader" onmousedown="toggleTbody('StatItem0')" colspan="5">
              Server Information
            </td>
          </tr>
        </tbody>
        <tbody id="StatItem0" class="off">
EOT

# Server Information
$ret .= StatLine({'stat'=>'','text'=>'Server Name:','class'=>'statsOptionTitle'},
                 {'text'=>"$localhostname",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"&nbsp;",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'','text'=>'Server OS:','class'=>'statsOptionTitle'},
                 {'text'=>"$^O",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"&nbsp;",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'','text'=>'Server IP:','class'=>'statsOptionTitle'},
                 {'text'=>"$localhostip",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"&nbsp;",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'','text'=>'DNS Servers:','class'=>'statsOptionTitle'},
                 {'text'=>"@nameservers",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"$LocalDNSStatus",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'','text'=>'Perl Version:','class'=>'statsOptionTitle'},
                 {'text'=>"$]",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"<a href=\"http://www.perl.org/get.html\" rel=\"external\" target=\"_blank\">Perl.org</a>",'class'=>'statsOptionValueC','colspan'=>'2'})
;
my ($totalmem,$freemem,$totalswap,$freeswap);
if ($CanUseSysMemInfo) {
   $totalmem = eval{int(Sys::MemInfo::totalmem() / 1048576);};
   $freemem = eval{int(Sys::MemInfo::freemem() / 1048576);};
   $totalswap = eval{int(Sys::MemInfo::totalswap() / 1048576);};
   $freeswap = eval{int(Sys::MemInfo::freeswap() / 1048576);};
}
if ($totalmem) {
$ret .= StatLine({'stat'=>'','text'=>'physical-memory:','class'=>'statsOptionTitle'},
                 {'text'=>"$totalmem MB",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"&nbsp;",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'','text'=>'free physical-memory:','class'=>'statsOptionTitle'},
                 {'text'=>"$freemem MB",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"&nbsp;",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'','text'=>'total virtual-memory:','class'=>'statsOptionTitle'},
                 {'text'=>"$totalswap MB",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"&nbsp;",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'','text'=>'free virtual-memory:','class'=>'statsOptionTitle'},
                 {'text'=>"$freeswap MB",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"&nbsp;",'class'=>'statsOptionValue','colspan'=>'2'})
;
}

if (my $memusage = int(&memoryUsage() / 1048576)) {
my $minmem = int($minMemUsage / 1048576);
my $maxmem = int($maxMemUsage / 1048576);
$ret .= StatLine({'stat'=>'','text'=>'assp-process-memory:','class'=>'statsOptionTitle'},
                 {'text'=>"current: $memusage MB",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"min: $minmem MB</td><td>max: $maxmem MB",'class'=>'statsOptionValue'})
}

if ($CanUseSysCpuAffinity) {
$ret .= StatLine({'stat'=>'','text'=>'Number of CPU\'s:','class'=>'statsOptionTitle'},
                 {'text'=>"$numcpus",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"&nbsp;",'class'=>'statsOptionValue','colspan'=>'2'})

      . StatLine({'stat'=>'','text'=>'Cpu Affinity:','class'=>'statsOptionTitle'},
                 {'text'=>"@currentCpuAffinity",'class'=>'statsOptionValue','colspan'=>'2'},
                 {'text'=>"&nbsp;",'class'=>'statsOptionValue','colspan'=>'2'})
;
}

$ret .= StatLine({'stat'=>'','text'=>'Spamdb version:','class'=>'statsOptionTitle'},
                 {'text'=>"used:</td><td>$currentDBVersion{Spamdb}",'class'=>'statsOptionValue'},
                 {'text'=>"required:</td><td>$requiredDBVersion{Spamdb}",'class'=>'statsOptionValue'});

$ret .= StatLine({'stat'=>'','text'=>'HMMdb version:','class'=>'statsOptionTitle'},
                 {'text'=>"used:</td><td>$currentDBVersion{HMMdb}",'class'=>'statsOptionValue'},
                 {'text'=>"required:</td><td>$requiredDBVersion{HMMdb}",'class'=>'statsOptionValue'});

my $currentCL = (-e "$base/docs/changelog.txt") ? "docs/changelog.txt" : '';
my $currentCLtext = $currentCL ? '<a href="javascript:void(0);" onclick="javascript:popFileEditor(\'docs/changelog.txt\',8);">show current local change log</a>' : '&nbsp;';
$ret .= <<EOT;
          <tr>
            <td class="statsOptionTitle">
              ASSP Version:
            </td>
            <td class="statsOptionValue" colspan="2">
              <table>
               <tr>
                <td rowspan="2">
                 $version$modversion
                </td>
                <td class="statsOptionValueC">
                 $currentCLtext
                </td>
               </tr>
               <tr>
                <td class="statsOptionValueC">
                 <a href="$ChangeLogURL" rel="external" target="_blank">show last available change log</a>
                </td>
               </tr>
              </table>
            </td>
            <td class="statsOptionValueC">
              <a href="http://sourceforge.net/project/showfiles.php?group_id=69172" rel="external" target="_blank">release</a>
            </td>
            <td class="statsOptionValueC">
              <a href="http://assp.cvs.sourceforge.net/viewvc/assp/assp2/" rel="external" target="_blank">beta</a>
            </td>
          </tr>
          <tr>
            <td class="statsOptionValue" style="background-color: #FFFFFF">
              &nbsp;
            </td>
            <td class="statsOptionValue" style="background-color: #FFFFFF" colspan="2">
              &nbsp;
            </td>
            <td class="statsOptionValueC" style="background-color: #FFFFFF" colspan="2">
              <font size="1" color="#C0C0C0"><em>downloads</em></font>
            </td>
          </tr>
        </tbody>
        <tbody>
          <tr>
            <td class="sectionHeader" onmousedown="toggleTbody('StatItem2')" colspan="5">
              Perl Modules
            </td>
          </tr>
        </tbody>
        <tbody id="StatItem2" class="off">
EOT

# module information
$ret .= $modules;
$ret .= <<EOT;
          <tr>
            <td class="statsOptionValue" style="background-color: #FFFFFF">
              &nbsp;
            </td>
            <td class="statsOptionValue" style="background-color: #FFFFFF" colspan="2">
              &nbsp;
            </td>
            <td class="statsOptionValueC" style="background-color: #FFFFFF" colspan="2">
              <font size="1" color="#C0C0C0"><em>downloads</em></font>
            </td>
          </tr>
        </tbody>
      </table><br />
      $kudos<br />
    </div>
    $footers
<form name="ASSPconfig" id="ASSPconfig" action="" method="post">
  <input name="theButtonLogout" type="hidden" value="" />
</form>
</body></html>
EOT
$ret;
}


sub ConfigStatsRaw {

 # must pass by ref
 my ( $href, $qsref ) = @_;
 my $head; $head = $$href if $href;
 my $qs;     $qs = $$qsref if $qsref;

 my %tots = ();
 {
 lock(%Stats) if (is_shared(%Stats));
 SaveStats();
 %tots=statsTotals();
 }
 my $upt=(time-$Stats{starttime})/(24*3600);
 my $upt2=(time-$AllStats{starttime})/(24*3600);
 my $uptime=sprintf("%.3f",$upt);
 my $uptime2=sprintf("%.3f",$upt2);
 my $mpd=sprintf("%.1f",$upt==0 ? 0 : $tots{msgTotal}/$upt);
 my $mpd2=sprintf("%.1f",$upt2==0 ? 0 : $tots{msgTotal2}/$upt2);
 my $pct=sprintf("%.1f",$tots{msgTotal}-$Stats{locals}==0 ? 0 : 100*$tots{msgRejectedTotal}/($tots{msgTotal}-$Stats{locals}));
 my $pct2=sprintf("%.1f",$tots{msgTotal2}-$AllStats{locals}==0 ? 0 : 100*$tots{msgRejectedTotal2}/($tots{msgTotal2}-$AllStats{locals}));
 my $cpuAvg=sprintf("%.2f\%",(! $Stats{cpuTime} ? 0 : 100*$Stats{cpuBusyTime}/$Stats{cpuTime}));
 my $cpuAvg2=sprintf("%.2f\%",(! $AllStats{cpuTime} ? 0 : 100*$AllStats{cpuBusyTime}/$AllStats{cpuTime}));
 my $currStat = &StatusASSP();
 $currStat = ($currStat =~ /not healthy/io) ? 'not healthy' : 'healthy' ;
 my $memory = memoryUsage().'MB';

 my $sr = "\n";
 foreach (keys %ScoreStats) {
     $sr .= "Scored$_ | $ScoreStats{$_} | $AllScoreStats{$_}\n";
 }
<<EOT . $sr;
$headerHTTP
ASSP Proxy Uptime | $uptime days | $uptime2 days
Messages Processed | $tots{msgTotal} ($mpd per day) | $tots{msgTotal2} ($mpd2 per day)
Non-Local Mail Blocked | $pct% | $pct2%
CPU Usage | $cpuAvg | $cpuAvg2
Current memory usage | $memory
Concurrent SMTP Sessions | $smtpConcurrentSessions ($Stats{smtpMaxConcurrentSessions} max) | $AllStats{smtpMaxConcurrentSessions} max
Current healthy status | $currStat

SMTP Connections Received | $tots{smtpConnTotal} | $tots{smtpConnTotal2}
SMTP Connections Accepted | $tots{smtpConnAcceptedTotal} | $tots{smtpConnAcceptedTotal2}
SMTP Connections Rejected | $tots{smtpConnRejectedTotal} | $tots{smtpConnRejectedTotal2}
Envelope Recipients Processed | $tots{rcptTotal} | $tots{rcptTotal2}
Envelope Recipients Accepted | $tots{rcptAcceptedTotal} | $tots{rcptAcceptedTotal2}
Envelope Recipients Rejected | $tots{rcptRejectedTotal} | $tots{rcptRejectedTotal2}
Messages Processed | $tots{msgTotal} | $tots{msgTotal2}
Messages Passed | $tots{msgAcceptedTotal} | $tots{msgAcceptedTotal2}
Messages Rejected | $tots{msgRejectedTotal} | $tots{msgRejectedTotal2}
Admin Connections Received | $tots{admConnTotal} | $tots{admConnTotal2}
Admin Connections Accepted | $Stats{admConn} | $AllStats{admConn}
Admin Connections Rejected | $Stats{admConnDenied} | $AllStats{admConnDenied}
Stat Connections Received | $tots{statConnTotal} | $tots{statConnTotal2}
Stat Connections Accepted | $Stats{statConn} | $AllStats{statConn}
Stat Connections Rejected | $Stats{statConnDenied} | $AllStats{statConnDenied}

Accepted Logged SMTP Connections | $Stats{smtpConn} | $AllStats{smtpConn}
SSL SMTP Connections | $Stats{smtpConnSSL} | $AllStats{smtpConnSSL}
TLS SMTP Connections | $Stats{smtpConnTLS} | $AllStats{smtpConnTLS}
Not Logged SMTP Connections | $Stats{smtpConnNotLogged} | $AllStats{smtpConnNotLogged}
SMTP Connection Limits | $tots{smtpConnLimit} | $tots{smtpConnLimit2}
Overall Limits | $Stats{smtpConnLimit} | $AllStats{smtpConnLimit}
By IP Limits | $Stats{smtpConnLimitIP} | $AllStats{smtpConnLimitIP}
By Delay on PB | $Stats{delayConnection} | $AllStats{delayConnection}
BY IP By AUTH Errors Count | $Stats{AUTHErrors} | $AllStats{AUTHErrors}
By IP Frequency Limits | $Stats{smtpConnLimitFreq} | $AllStats{smtpConnLimitFreq}
By Domain IP Limits | $Stats{smtpConnDomainIP} | $AllStats{smtpConnDomainIP}
By Same Subjects Limits | $Stats{smtpSameSubject} | $AllStats{smtpSameSubject}
SMTP Connections Timeout | $tots{smtpConnIdleTimeout} | $tots{smtpConnIdleTimeout2}
SMTP SSL-Connections Timeout | $tots{smtpConnSSLIdleTimeout} | $tots{smtpConnSSLIdleTimeout2}
SMTP TLS-Connections Timeout | $tots{smtpConnTLSIdleTimeout} | $tots{smtpConnTLSIdleTimeout2}
Denied SMTP Connections | $Stats{smtpConnDenied} | $AllStats{smtpConnDenied}
SMTP damping | $Stats{damping} | $AllStats{damping}

Local Recipients Accepted | $tots{rcptAcceptedLocal} | $tots{rcptAcceptedLocal2}
Validated Recipients | $Stats{rcptValidated} | $AllStats{rcptValidated}
Unchecked Recipients | $Stats{rcptUnchecked} | $AllStats{rcptUnchecked}
Spam-Lover Recipients | $Stats{rcptSpamLover} | $AllStats{rcptSpamLover}
Remote Recipients Accepted | $tots{rcptAcceptedRemote} | $tots{rcptAcceptedRemote2}
Whitelisted Recipients | $Stats{rcptWhitelisted} | $AllStats{rcptWhitelisted}
Not Whitelisted Recipients | $Stats{rcptNotWhitelisted} | $AllStats{rcptNotWhitelisted}
Noprocessed Recipients | $Stats{rcptUnprocessed} | $AllStats{rcptUnprocessed}
Email Reports | $tots{rcptReport} | $tots{rcptReport2}
Spam Reports | $Stats{rcptReportSpam} | $AllStats{rcptReportSpam}
Ham Reports | $Stats{rcptReportHam} | $AllStats{rcptReportHam}
Whitelist Additions | $Stats{rcptReportWhitelistAdd} | $AllStats{rcptReportWhitelistAdd}
Whitelist Deletions | $Stats{rcptReportWhitelistRemove} | $AllStats{rcptReportWhitelistRemove}
Redlist Additions | $Stats{rcptReportRedlistAdd} | $AllStats{rcptReportRedlistAdd}
Redlist Deletions | $Stats{rcptReportRedlistRemove} | $AllStats{rcptReportRedlistRemove}
Local Recipients Rejected | $tots{rcptRejectedLocal} | $tots{rcptRejectedLocal2}
Nonexistent Recipients | $Stats{rcptNonexistent} | $AllStats{rcptNonexistent}
Delayed Recipients | $Stats{rcptDelayed} | $AllStats{rcptDelayed}
Delayed (Late) Recipients | $Stats{rcptDelayedLate} | $AllStats{rcptDelayedLate}
Delayed (Expired) Recipients | $Stats{rcptDelayedExpired} | $AllStats{rcptDelayedExpired}
Embargoed Recipients | $Stats{rcptEmbargoed} | $AllStats{rcptEmbargoed}
Spam Bucketed Recipients | $Stats{rcptSpamBucket} | $AllStats{rcptSpamBucket}
Remote Recipients Rejected | $tots{rcptRejectedRemote} | $tots{rcptRejectedRemote2}
Relay Attempts Rejected | $Stats{rcptRelayRejected} | $AllStats{rcptRelayRejected}

Bayesian Hams | $Stats{bhams} | $AllStats{bhams}
Whitelisted | $Stats{whites} | $AllStats{whites}
Local | $Stats{locals} | $AllStats{locals}
Noprocessing | $Stats{noprocessing} | $AllStats{noprocessing}
Spamlover Spams Passed | $Stats{spamlover} | $AllStats{spamlover}
Bayesian Spams | $Stats{bspams} | $AllStats{bspams}
Domains Blacklisted | $Stats{blacklisted} | $AllStats{blacklisted}
HELO Blacklisted | $Stats{helolisted} | $AllStats{helolisted}
HELO Invalid | $Stats{invalidHelo} | $AllStats{invalidHelo}
HELO Forged | $Stats{forgedHelo} | $AllStats{forgedHelo}
Missing MX | $Stats{mxaMissing} | $AllStats{mxaMissing}
Missing PTR | $Stats{ptrMissing} | $AllStats{ptrMissing}
Invalid PTR | $Stats{ptrInvalid} | $AllStats{ptrInvalid}
Spam Collected Messages | $Stats{spambucket} | $AllStats{spambucket}
Penalty Trap Messages | $Stats{penaltytrap} | $AllStats{penaltytrap}
Bad Attachments | $Stats{viri} | $AllStats{viri}
Viruses Detected | $Stats{viridetected} | $AllStats{viridetected}
Sender Regex | $Stats{bombSender} | $AllStats{bombSender}
Bomb Regex | $Stats{bombs} | $AllStats{bombs}
Penalty Box | $Stats{pbdenied} | $AllStats{pbdenied}
Message Scoring | $Stats{msgscoring} | $AllStats{msgscoring}
Invalid Local Sender | $Stats{senderInvalidLocals} | $AllStats{senderInvalidLocals}
Invalid Internal Mail | $Stats{internaladdresses} | $AllStats{internaladdresses}
Scripts | $Stats{scripts} | $AllStats{scripts}
SPF Failures | $Stats{spffails} | $AllStats{spffails}
RBL Failures | $Stats{rblfails} | $AllStats{rblfails}
URIBL Failures | $Stats{uriblfails} | $AllStats{uriblfails}
Max Errors Exceeded | $Stats{msgMaxErrors} | $AllStats{msgMaxErrors}
Delayed | $Stats{msgDelayed} | $AllStats{msgDelayed}
Empty Recipient | $Stats{msgNoRcpt} | $AllStats{msgNoRcpt}
Not SRS Signed Bounces | $Stats{msgNoSRSBounce} | $AllStats{msgNoSRSBounce}
MSGID Signature | $Stats{msgMSGIDtrErrors} | $AllStats{msgMSGIDtrErrors}
DKIM | $Stats{dkim} | $AllStats{dkim}
DKIM pre Check | $Stats{dkimpre} | $AllStats{dkimpre}
Pre Header | $Stats{preHeader} | $AllStats{preHeader}

EOT
}

sub ConfigStatsXml {

    # must be pass as ref
    my ( $href, $qsref ) = @_;

    my %tots;
    {lock(%Stats) if (is_shared(%Stats));
    &StatAllStats();
    %tots = statsTotals();
    }

    my $statstart2=localtime($AllStats{starttime});
    my $statstart=localtime($Stats{starttime});
    my $uptime=getTimeDiffAsString(time-$Stats{starttime},1);
    my $uptime2=getTimeDiffAsString(time-$AllStats{starttime});
    my $damptime=getTimeDiffAsString($Stats{damptime},1);
    my $damptime2=getTimeDiffAsString($AllStats{damptime});
    my $mpd=sprintf("%.1f",$uptime==0 ? 0 : $tots{msgTotal}/$uptime);
    my $mpd2=sprintf("%.1f",$uptime2==0 ? 0 : $tots{msgTotal2}/$uptime2);
    my $pct=sprintf("%.1f",$tots{msgTotal}-$Stats{locals}==0 ? 0 : 100*$tots{msgRejectedTotal}/($tots{msgTotal}-$Stats{locals}));
    my $pct2=sprintf("%.1f",$tots{msgTotal2}-$AllStats{locals}==0 ? 0 : 100*$tots{msgRejectedTotal2}/($tots{msgTotal2}-$AllStats{locals}));
    my $cpuAvg=sprintf("%.2f\%",(! $Stats{cpuTime} ? 0 : 100*$Stats{cpuBusyTime}/$Stats{cpuTime}));
    my $cpuAvg2=sprintf("%.2f\%",(! $AllStats{cpuTime} ? 0 : 100*$AllStats{cpuBusyTime}/$AllStats{cpuTime}));
    my $currAvgDamp = ($Stats{damping} && $DoDamping) ? sprintf("(%.2f%% avg of accepted connections)",($Stats{damping} / ($Stats{smtpConn} ? $Stats{smtpConn} : 1)) * 100) : '';
    my $allAvgDamp  = ($AllStats{smtpConn} && $DoDamping) ? sprintf("(%.2f%% avg of accepted connections)",($AllStats{damping} / ($AllStats{smtpConn} ? $AllStats{smtpConn} : 1)) * 100) : '';
    my $memory = memoryUsage().'MB';

    my $r = '';
    foreach my $k ( keys %tots ) {
        next unless $k;

        my $s = $k;
        if ( $s =~ tr/2//d ) {
            $r .= "<stat name='$s' type='cumulativetotal'>$tots{$k}</stat>";
        } else {
            $r .= "<stat name='$s' type='currenttotal'>$tots{$k}</stat>";
        }
    }
    foreach my $k ( keys %Stats ) {
        next unless $k;
        $r .= "<stat name='$k' type='currentstat'>$Stats{$k}</stat>";
    }
    foreach my $k ( keys %AllStats ) {
        next unless $k;
        $r .= "<stat name='$k' type='cumulativestat'>$AllStats{$k}</stat>";
    }
    foreach my $k ( keys %ScoreStats ) {
        next unless $k;
        $r .= "<stat name='$k' type='currentscorestat'>$ScoreStats{$k}</stat>";
    }
    foreach my $k ( keys %AllScoreStats ) {
        next unless $k;
        $r .= "<stat name='$k' type='cumulativescorestat'>$AllScoreStats{$k}</stat>";
    }

    <<EOT;
$headerHTTP

<?xml version='1.0' encoding='UTF-8'?>
<stats>
<stat name='statstart' type='currentstat'>$statstart</stat>
<stat name='statstart' type='cumulativestat'>$statstart2</stat>
<stat name='uptime' type='currentstat'>$uptime</stat>
<stat name='uptime' type='cumulativestat'>$uptime2</stat>
<stat name='msgPerDay' type='currentstat'>$mpd</stat>
<stat name='msgPerDay' type='cumulativestat'>$mpd2</stat>
<stat name='pctBlocked' type='currentstat'>$pct</stat>
<stat name='pctBlocked' type='cumulativestat'>$pct2</stat>
<stat name='cpuAvg' type='currentstat'>$cpuAvg</stat>
<stat name='cpuAvg' type='cumulativestat'>$cpuAvg2</stat>
<stat name='memusage' type='currentstat'>$memory</stat>
<stat name='smtpConcurrentSessions' type='currentstat'>$smtpConcurrentSessions</stat>
<stat name='damptime' type='currentstat'>$damptime</stat>
<stat name='damptime' type='cumulativestat'>$damptime2</stat>
<stat name='avgdamped' type='currentstat'>$currAvgDamp</stat>
<stat name='avgdamped' type='cumulativestat'>$allAvgDamp</stat>
$r
</stats>
EOT

}

sub ex {
    my($s,$l) = @_;
    $l ||= 2;
    $s ||= '00';
    return $s if length($s) == $l;
    $s = sprintf("%02d",$s);
    $s = '20'.$s if $l == 4;
    return $s;
}

sub ConfigFC {
    my ( $href, $qsref ) = @_;

    if ($CanUseASSP_FC) {
        if (! ${'ASSP_FC::TEST'}) {
            my $ret = eval{ASSP_FC::process( $href, $qsref );};
            return ($@) ? $@ : $ret;
        } else {
            eval ('
            no ASSP_FC;
            delete $INC{\'ASSP_FC.pm\'};
            require ASSP_FC;
            return ASSP_FC::process( $href, $qsref );
            ');
            mlog(0,"warning: filecommander failed in test mode - $@") if $@;
        }
    }
}

sub ConfigStatsPlot {
    # must pass by ref
    my ( $href, $qsref ) = @_;
    my $head;
    $head = $$href if $href;
    my $qs;
    $qs = $$qsref if $qsref;

    my $out = "HTTP/1.1 200 OK
Content-type: text/html

";
    $out .= '<?xml version="1.0" encoding="UTF-8" standalone="no"?>'."\n";
    $out .= '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" '.
                '"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'."\n";
    $out .= '<html xmlns="http://www.w3.org/1999/xhtml">';
    $out .= "\n<head>\n<title>statistic graphic</title>\n";
    $out .= "</head><body>\n";

    eval('use ASSP_SVG; 1;') or return $out."<h1>ERROR: can not load lib/ASSP_SVG.pm - $@</h1></body></html>";
    open(my $F, '<', "$base/images/svg.js") or return $out."<h1>ERROR: can not open $base/images/svg.js - $!</h1></body></html>";
    binmode $F;
    my $Jscript = join('',<$F>);
    close $F;
    $out = '';
    my ($today,$now) = split(/ /o,timestring('','','YYYY-MM-DD hh:mm:ss'));
    my $starth = substr($now,0,2).':00:00';
    my $yesterday = timestring((time-84600),'d','YYYY-MM-DD');
    my $stat = $qs{stat};
    my $size = $mobile ? '480,320' : '800,400';
    $qs{from} =~ s/^\s+//o;
    $qs{from} =~ s/\s+$//o;
    $qs{from} =~ s/^
          (\d{4}|\d{2})
          [\-\.]?
          (\d{1,2})
          [\-\.]?
          (\d{1,2})
          [^\d]+
          (\d{1,2})
          [\-\.:]?
          (\d{1,2})?
          [\-\.:]?
          (\d{1,2})?
                  $/
          ex($1,4).'-'.ex($2).'-'.ex($3).'_'.ex($4).':'.ex($5).':'.ex($6)
                  /oex if $qs{from};
    my $from = $qs{from} || $yesterday.'_'.$starth;
    $qs{to} =~ s/^\s+//o;
    $qs{to} =~ s/\s+$//o;
    $qs{to} =~  s/^
          (\d{4}|\d{2})
          [\-\.]?
          (\d{1,2})
          [\-\.]?
          (\d{1,2})
          [^\d]+
          (\d{1,2})
          [\-\.:]?
          (\d{1,2})?
          [\-\.:]?
          (\d{1,2})?
                  $/
          ex($1,4).'-'.ex($2).'-'.ex($3).'_'.ex($4).':'.ex($5).':'.ex($6)
                  /oex if $qs{to};
    my $to = $qs{to} || $today.'_'.$now;
    $to = $today.'_'.$now if $to gt ($today.'_'.$now);
    if ($to le $from) {
        $from = $yesterday.'_'.$starth;
        $to = $today.'_'.$now;
    }
    my $dp;
    $qs{stattype} ||= 'stat';
    $qs{stattype} = lc($qs{stattype});
    my $statfile = lc($qs{stattype}).'GraphStats';
    my $xstep = (ASSP_SVG::SVG_time_to_sec($to) - ASSP_SVG::SVG_time_to_sec($from))/substr($size,0,3);
    my $fy = substr($from,0,4);
    my $fm = substr($from,5,2);
    my $ty = substr($to,0,4);
    my $tm = substr($to,5,2);
    my $nextstep = ASSP_SVG::SVG_time_to_sec($from);
    my $firststep;
    for my $yy ($fy ... $ty) {
        my $ttm = ($yy == $ty) ? $tm : 12;
        my $ffm = ($yy == $fy) ? $fm : 1;
        for my $mm ($ffm ... $ttm) {
            $yy = sprintf("%04d",$yy);
            $mm = sprintf("%02d",$mm);
            open(my $F,'<',"$base/logs/$statfile-$yy-$mm.txt") or do {
                mlog(0,"warning: can not open $base/logs/$statfile-$yy-$mm.txt - $!") && next;};
            binmode $F;
            while (<$F>) {
                next unless s/(.+)$stat: (.+)/$1$2/;
                my $t = $1;
                chop $t;
                $firststep = "$from $2\n" unless $dp;
                next if $t lt $from;
                next if $t gt $to;
                if ($firststep) {
                    $dp = $firststep;
                    $firststep = undef;
                }
                $t = ASSP_SVG::SVG_time_to_sec($t);
                next if ($nextstep > $t);
                $nextstep = int($t + $xstep - $t % $xstep);
                $dp .= $_;
            }
            close $F;
        }
    }
    $dp.= "#\n";

    my $name = $qs{name};
    my @confp;
    my $plot;
    $size = $mobile ? '480,320' : '800,400';
    open( $F,'<',"$base/images/stat.gplot") or return "ERROR: can not open $base/images/stat.gplot - $!";
    while (<$F>) {
        next if m/^\s*#/o;
        s/\r|\n//go;
        s/<SIZE>/$size/o;
        s/<L1>/$name/o;
        s/<L2>/$stat count/o;
        if (s/\\\s*$//o) {$plot .= $_; next;}
        next unless m/^\s*set/io;
        push @confp, "$_\n";
    }
    close $F;

    $out .= "HTTP/1.1 200 OK
Content-type: text/html

";
    $out .= '<?xml version="1.0" encoding="UTF-8" standalone="no"?>'."\n";
    $out .= '<!DOCTYPE html PUBLIC "-//W3C//DTD XHTML 1.0 Strict//EN" '.
                '"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd">'."\n";
    $out .= '<html xmlns="http://www.w3.org/1999/xhtml">';
    $out .= "\n<head>\n<title>$stat statistic graphic</title>\n";

    $out .= '<meta name="viewport" content="initial-scale=1, maximum-scale=1"/>'."\n";

    $out .= '<script type="text/javascript">'."\n";
    $out .= $Jscript.'</script>'."\n";

    $out .=  "</head>\n<body name=\"$stat\">\n";

    my $tf = $from;
    $tf =~ s/_/ /go;
    my $tt = $to;
    $tt =~ s/_/ /go;
    $size = $mobile ? 'style="width:500px;"' : 'style="width:850px;"';

    $out .= "<div id=\"form\" $size>".'<form name="ASSPgraph" id="ASSPgraph" action="" method="post"><center>
    from: <input name="from" size="20" value="'.$tf.'">
    to: <input name="to" size="20" value="'.$tt.'">
    <input name="stattype" type="hidden" value="'.$qs{stattype}.'">
    <input name="stat" type="hidden" value="'.$qs{stat}.'">
    <input name="name" type="hidden" value="'.$qs{name}.'">
    &nbsp;&nbsp;<input name="theButton" type="submit" value="change time range" />
    </center></form><hr></div>'."\n";

    $size = $mobile ? 'style="width:500px; height:350px;"' : 'style="width:850px; height:500px;"';
    $out .= "<div id=\"svggraphic\" $size>\n";
    $out .= eval{ASSP_SVG::SVG_render($stat,$from,$to,\@confp,\$dp,$plot,"$base/images");};
    $out .= "</div>\n";

    $out .= '<script type="text/javascript">'."\n";
    $out .= "formdiv = document.getElementById('form');\n";
    $out .= '</script>'."\n";
    $out .= "</body>\n</html>";

    return $out;
}

sub T10StatAdd {
    my $fh = shift;
    return unless $fh;
    return if $Con{$fh}->{type} != 'C';
    return if $Con{$fh}->{timedout};
    return if ($Con{$fh}->{error} !~ /^[45]/o  &&
               $Con{$fh}->{prepend} !~ /$SpamTagRE|\[PersonalBlack\]|\[PenaltyDelay\]/io);
    my $ip = $Con{$fh}->{ispip} && $Con{$fh}->{cip} ? $Con{$fh}->{cip} : $Con{$fh}->{ip};
    my $t = time;
    if ($ip) {
        $T10StatI{$ip}++;
        $T10StatT{$ip} = $t;
    }
    if ($Con{$fh}->{mailfrom}) {
        $T10StatS{lc $Con{$fh}->{mailfrom}}++;
        $T10StatT{lc $Con{$fh}->{mailfrom}} = $t;
    }
    if ((lc $Con{$fh}->{mailfrom}) =~ /\@([^@]+)$/o) {
        $T10StatD{$1}++;
        $T10StatT{$1} = $t;
    }
    my %rcpt;
    foreach (split(/\s+/o,$Con{$fh}->{rcpt})) {
        $rcpt{lc $_} = 1 if $_;
    }
    foreach (keys %rcpt) {
        $T10StatR{$_}++;
        $T10StatT{$_} = $t;
    }
}

sub T10StatGet {
    my ($h,$max) = @_;
    my @th;
    my $count = 0;
    foreach my $c (sort {${'T10Stat'.$h}{$main::b} <=> ${'T10Stat'.$h}{$main::a}} keys %{'T10Stat'.$h}) {
        push @th , $c , ${'T10Stat'.$h}{$c};
        last if ++$count == $max;
    }
    return @th;
}

sub T10StatOut {
    my $t10html = "<div name=\"tohid\"><br /><h2>Top ten blocking statistic</h2><br />";
      $t10html .= "only entries that were stated in the last 25 hours are shown<br />";
    my $t10text = "\r\nTop ten blocking statistic\r\n";
      $t10text .= "only entries that were stated in the last 25 hours are shown\r\n";
       $t10text .=    "----------------------------------------------------------------------\r\n";
    my @list =  (
                    'Top ten blocked domains',   'D',
                    'Top ten blocked IP\'s',     'I',
                    'Top ten blocked senders',   'S',
                    'Top ten blocked recipients','R'
    );

    while (@list) {
        $t10html .= '<br /><table BORDER CELLSPACING=2 CELLPADDING=4 WIDTH="25%" >';
        $t10html .= "<col /><col />\n";
        my $s1 = shift @list;
        $t10html .= '<tr><th colspan="2">'.$s1."</th></tr>\n";
        $t10text .= "\r\n\r\n".$s1.":\r\n";
        my @th = T10StatGet((shift @list),10);
        while (@th) {
            my $s2 = shift @th;
            my $s3 = shift @th;
            $t10html .= '<tr><td>&nbsp;' . $s2 . '&nbsp;</td><td>&nbsp;'. $s3 . "\&nbsp;</td></tr>\n";
            $t10text .= "$s2\t$s3\r\n";
        }
        $t10html .= "</table><br /></div>\n";
        $t10text .= "\r\n";
    }
    return $t10html, $t10text;
}

sub top10stats {
    my ($t10html, $t10text) = &T10StatOut();
    my $ire = qr/^(?:$IPRe|[\d\.]+)$/o;
    unless ((&canUserDo($WebIP{$ActWebSess}->{user},'action','addraction') && $t10html =~ s/((?:$EmailAdrRe\@)?$EmailDomainRe)/my$e=$1;($e!~$ire)?"<a href=\"\/addraction?address=$e\" target=\"_blank\" title=\"take an action via web on address $e\">$e<\/a>":$e/goe))
        {
            ((&canUserDo($WebIP{$ActWebSess}->{user},'action','ipaction') && $t10html =~ s/($IPRe)/my$e=$1;($e!~$IPprivate)?"<a href=\"\/ipaction?ip=$e\" target=\"_blank\" title=\"take an action via web on ip $e\">$e<\/a>":$e;/goe));
        }
    return <<EOT;
$headerHTTP

<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
  <meta http-equiv="content-type" content="application/xhtml+xml; charset=utf-8" />
  <title>$currentPage ASSP Top ten statistic ($myName)</title>
  <link rel=\"stylesheet\" href=\"get?file=images/editor.css\" type=\"text/css\" />
</head>
<body>
    <div class="content">
        $t10html
    </div>
</body>
</html>

EOT
}

sub ConfigLists {
    my $s;
    my $ad;
    my $v;
    my $act=$qs{action};
    if($act) {
        if ($qs{list} eq 'tuplets') {
            my $ip;
            my $hash;
            my $t;
            my $interval;
            my $intervalFormatted;
            while ($qs{addresses}=~/($IPRe)\s*,?\s*<?(?:$EmailAdrRe\@)?($EmailDomainRe|)>?/go) {
                $ip=&ipNetwork($1,$DelayUseNetblocks);
                $ad=lc $2;
                if ($DelayNormalizeVERPs) {

                    # strip extension
                    $ad=~s/\+.*(?=@)//o;

                    # replace numbers with '#'
                    $ad=~s/\b\d+\b(?=.*@)/#/go;
                }

                # get sender domain
                $ad=~s/[^@]*@//o;
                $hash="$ip $ad";
                $hash=Digest::MD5::md5_hex($hash) if $CanUseMD5Keys && $DelayMD5;
                $t=time;
                $s.="<div class=\"text\">($ip,$ad) ";
                if($act eq 'v') {
                    if (!exists $DelayWhite{$hash}) {
                        $s.="<span class=\"negative\">tuplet NOT safelisted</span>";
                    } else {
                        $interval=$t-$DelayWhite{$hash};
                        $intervalFormatted=formatTimeInterval($interval);
                        if ($interval<$DelayExpiryTime*24*3600) {
                            $s.="tuplet safelisted, age: $intervalFormatted";
                        } else {
                            $s.="tuplet expired, age: $intervalFormatted";
                        }
                    }
                } elsif($act eq 'a') {
                    if (!exists $DelayWhite{$hash} || ($t-$DelayWhite{$hash}>=$DelayExpiryTime*24*3600)) {
                        if(localmail('@'.$ad)) {
                            $s.="<span class=\"negative\">local addresses not allowed on safelisted tuplets</span>";
                        } else {
                            $s.="tuplet added";
                            $DelayWhite{$hash}=$t;
                            mlog(0,"Admininfo: safelisted tuplets addition: ($ip,$ad) (by $WebIP{$ActWebSess}->{user})",1);
                        }
                    } else {
                        $s.="<span class=\"positive\">tuplet already safelisted</span>";
                    }
                } elsif($act eq 'r') {
                    if (!exists $DelayWhite{$hash}) {
                        $s.="<span class=\"negative\">tuplet NOT safelisted</span>";
                    } else {
                        $interval=$t-$DelayWhite{$hash};
                        $intervalFormatted=formatTimeInterval($interval);
                        if ($interval<$DelayExpiryTime*24*3600) {
                            $s.="tuplet removed, age: $intervalFormatted";
                        } else {
                            $s.="expired tuplet removed, age: $intervalFormatted";
                        }
                        delete $DelayWhite{$hash};
                        mlog(0,"Admininfo: safelisted tuplets deletion: ($ip,$ad) (by $WebIP{$ActWebSess}->{user})");
                    }
                }
                $s.="</div>\n";
            }
        } elsif ($qs{list} eq 'red' or $qs{list} eq 'white') {
            my $color=$qs{list} eq 'red'? 'Red' : 'White';
            my $list=$color."list";
            while ($qs{addresses}=~/($EmailAdrRe\@$EmailDomainRe'?)(?:(,(?:$EmailAdrRe?\@$EmailDomainRe'?)|\*))?/go) {
                $ad=$1;
                my $ap = $2;
                $ad =~ s/^'//o if $ad =~ s/'$//o;
                $ap =~ s/^,'/,/o if $ap =~ s/'$//o;
                $s.="<div class=\"text\">$ad ";
                $ad=lc $ad;
                $ap=lc $ap;
                if($act eq 'v') {
                    $ap = '' if $ap eq ',*';
                    $ap = '' if ((!($WhitelistPrivacyLevel % 2)) && $ap =~ /^,\@/o);
                    if ($list eq 'Whitelist' && $ap) {
                        if($list->{"$ad$ap"}) {
                            $s.="$ap ${color}listed";
                        } else {
                            $s.="<span class=\"negative\">$ap NOT $qs{list}listed</span>";
                        }
                    } elsif ($list eq 'Whitelist' && ! $ap) {
                        if($list->{$ad}) {
                            $s.="${color}listed<br />";
                            while (my ($k,$v) = each(%Whitelist)) {      # and all personal
                                if ($k =~ /^\Q$ad\E,/i) {
                                    if ($v < 9999999999) {
                                        $s.="$k personal Whitelisted<br />";
                                    } else {
                                        $s.="<span class=\"negative\">$k personal not Whitelisted</span><br />";
                                    }
                                }
                            }
                        } else {
                            $s.="<span class=\"negative\">NOT $qs{list}listed</span>";
                        }
                    } else {
                        if($list->{$ad}) {
                            $s.="${color}listed";
                        } else {
                            $s.="<span class=\"negative\">NOT $qs{list}listed</span>";
                        }
                    }
                } elsif($act eq 'a') {
                    $ap = '' if $ap eq ',*';
                    if ($list eq 'Redlist') {
                        if(exists $list->{$ad}) {
                            $s.="<span class=\"positive\">already $qs{list}listed</span>";
                        } else {
                            $list->{$ad}=time;
                            mlog(0,"Admininfo: $qs{list}list addition: $ad (by $WebIP{$ActWebSess}->{user})");
                            $s.="added to $list";
                        }
                    } else {
                        if($ap && &Whitelist($ad,$ap,'')) {
                            $s.="<span class=\"positive\">already $qs{list}listed for $ap</span>";
                        } elsif (! $ap && &Whitelist($ad,'','')) {
                            $s.="<span class=\"positive\">already $qs{list}listed</span>";
                        } else {
                            $s.="$ap " if $ap;
                            $s.="added to $list";
                            Whitelist($ad,$ap,'add');
                            $s .= '<br />' . join('',@WhitelistResult);
                            mlog(0,"Admininfo: $qs{list}list addition: $ad (by $WebIP{$ActWebSess}->{user})");
                            mlog(0,"Admininfo: $qs{list}list addition: $ad$ap (by $WebIP{$ActWebSess}->{user})") if $ap;

                            $ap =~ s/^,(?:\@.+)//o;
                            if ($ap && (my $pb = PersBlackFind($ap,$ad))) {
                                PersBlackRemove($ap, $pb);
                                $s .= "<br />$pb: deleted from the personal blacklist of $ad";
                                mlog( 0, "Admininfo: $pb: deleted from the personal blacklist of $ad (by $WebIP{$ActWebSess}->{user})", 1 );
                            }
                        }
                    }
                } elsif($act eq 'r') {
                    $ap = '' if $ap eq ',*';
                    if ($list eq 'Redlist') {
                        if ($list->{$ad}) {
                            $s.="removed from $list<br />";
                            delete $list->{$ad};
                            mlog(0,"Admininfo: $qs{list}list deletion: $ad (by $WebIP{$ActWebSess}->{user})");
                        } else {
                            $s.="not $qs{list}listed";
                        }
                    } else {
                        if($ap && $ap !~ /^,\@/o && $list->{"$ad$ap"} && $list->{"$ad$ap"} < 9999999999) {
                            $s.="$ap " if $ap;
                            $s.="removed from $list";
                            &Whitelist($ad,$ap,'delete');
                            $s .= '<br />' . join('',@WhitelistResult);
                            mlog(0,"Admininfo: $qs{list}list deletion: $ad$ap (by $WebIP{$ActWebSess}->{user})");
                        } elsif ($ap && $ap =~ /^,\@/o && &Whitelist($ad,$ap,'')) {
                            $s.="$ap " if $ap;
                            $s.="removed from $list";
                            &Whitelist($ad,$ap,'delete');
                            $s .= '<br />' . join('',@WhitelistResult);
                            mlog(0,"Admininfo: $qs{list}list deletion: $ad$ap (by $WebIP{$ActWebSess}->{user})");
                        } elsif (! $ap && $list->{$ad}) {
                            $s.="removed from $list<br />";
                            &Whitelist($ad,'','delete');
                            $s .= '<br />' . join('',@WhitelistResult);
                            mlog(0,"Admininfo: $qs{list}list deletion: $ad (by $WebIP{$ActWebSess}->{user})");
                        } else {
                            $s.="not $qs{list}listed";
                        }
                    }
                }
                $s.="</div>\n";
            }
#        } else {
        }
    }
    @WhitelistResult = ();
    if($qs{B1}=~/^Show (.)/io) {
        local $/="\n";
        if($1 eq 'R') {
            $qs{list}="red"; # update radios
            $s.='<div class="textbox"><b>Redlist</b></div>';
            $s.='<div class="textbox"><b>database</b></div>';
            while (my($ad,$v)=each(%Redlist)) {
                $s.="<div class=\"textbox\">$ad</div>";
            }
        } else {
            $qs{list}="white"; # update radios
            $s.='<div class="textbox"><b>Whitelist</b></div>';
            $s.='<div class="textbox"><b>database</b></div>';
            while (my($ad,$v)=each(%Whitelist)) {
                if ($ad =~ /,/io) {
                    if ($v < 9999999999) {
                        $s.="<div class=\"textbox\">$ad</div>";
                    } else {
                        $s.="<div class=\"textbox\"><span class=\"negative\">$ad personal not Whitelisted</span></div>";
                    }
                } else {
                    $s.="<div class=\"textbox\">$ad</div>";
                }
            }
        }
    }
    my $h1 = $WebIP{$ActWebSess}->{lng}->{'msg500031'} || $lngmsg{'msg500031'};
    my $h2 = $WebIP{$ActWebSess}->{lng}->{'msg500032'} || $lngmsg{'msg500032'};
    my $h3 = $WebIP{$ActWebSess}->{lng}->{'msg500033'} || $lngmsg{'msg500033'};
    my $h4 = $WebIP{$ActWebSess}->{lng}->{'msg500034'} || $lngmsg{'msg500034'};

<<EOT;
$headerHTTP
$headerDTDTransitional
$headers
<div id="cfgdiv" class="content">
<h2>Update or Verify the Whitelist/Redlist</h2>
$s
<form method="post" action=\"\">
    <table class="textBox" style="width: 99%;">
        <tr>
            <td class="noBorder">$h1
            </td>
            <td class="noBorder">
            <input type="radio" name="list" value="white"${\((!$qs{list} || $qs{list} eq 'white') ? ' checked="checked" ' : ' ')} /> Whitelist or<br />
            <input type="radio" name="list" value="red"${\($qs{list} eq 'red' ? ' checked="checked" ' : ' ')} /> Redlist or<br />
            <input type="radio" name="list" value="tuplets"${\($qs{list} eq 'tuplets' ? ' checked="checked" ' : ' ')} /> Tuplets
            </td>
        </tr>
        <tr>
            <td class="noBorder">$h2 </td>
            <td class="noBorder"><input type="radio" name="action" value="a" />add<br />
            <input type="radio" name="action" value="r" />remove<br />
            <input type="radio" checked="checked" name="action" value="v" />or verify</td>
            <td class="noBorder">
                List the addresses in this box:<br />
                (for tuplets put: ip-address,domain-name)<br />
                <p><textarea name="addresses" rows="5" cols="40" wrap="off">$qs{addresses}</textarea></p>
            </td>
        </tr>
        <tr>
            <td class="noBorder">&nbsp;</td>
            <td class="noBorder"><input type="submit" name="B1" value="  Submit  " /></td>
            <td class="noBorder">&nbsp;</td>
        </tr>
    </table>
</form>
<div class="textBox">
$h3
  <form action="" method="post">
  <table style="width: 90%; margin-left: 5%;">
    <tr>
      <td align="center" class="noBorder"><input type="submit" name="B1" value="Show Whitelist" /></td>
      <td align="center" class="noBorder"><input type="submit" name="B1" value="Show Redlist" /></td>
    </tr>
  </table>
  </form>
  $h4
<form name="ASSPconfig" id="ASSPconfig" action="" method="post">
  <input name="theButtonLogout" type="hidden" value="" />
</form>
</div>
</div>
$footers
</body></html>
EOT
}

sub SearchBombW {
    my ($name, $srch)=@_;
    
    $incFound = '';
    $weightMatch = '';
    my %Bombs = &BombWeight(0,$srch,$name );
    if ($Bombs{count}) {
        my $match = &SearchBomb($name, $$srch);
        $weightMatch = encodeHTMLEntities($match) if (! $weightMatch);
        return 'highest match: "' . "$Bombs{matchlength}" . encodeHTMLEntities($Bombs{highnam}) . '" with valence: ' . $Bombs{highval} . ' - PB value = ' . $Bombs{sum};
    }
    return;
}

sub SearchBomb {
    my ($name, $srch)=@_;

    my $extLog = $AnalyzeLogRegex && ! $silent && [caller(1)]->[3] =~ /analyze/io;

    $incFound = '';
    my $fil=$Config{"$name"};
    return 0 unless $fil;
    $addCharsets = 1 if $name eq 'bombCharSets';
    my $text;
    if ($name ne 'bombSubjectRe') {
       my $mimetext = cleanMIMEBody2UTF8(\$srch);
       if ($mimetext) {
           $text =  cleanMIMEHeader2UTF8(\$srch,0);
           $mimetext =~ s/\=(?:\015?\012|\015)//go;
           $mimetext = decHTMLent(\$mimetext);
           $text .= $mimetext;
       } else {
           $text = decodeMimeWords2UTF8($srch)
       }
    } else {
       $text = $srch;
    }
    $srch = $text;
    $text = "\r\n" . $text;
    $srch .= transliterate(\$text, 1) if $DoTransliterate;
    undef $text;
    $addCharsets = 0;
    my @complex;
    if($fil=~/^\s*file:\s*(.+)\s*$/io) {
        $fil=$1;
        open (my $BOMBFILE, '<',"$base/$fil");
        my $counter=0;
        my $complexStartLine;
        while (my $i = <$BOMBFILE>)  {
            $counter++;
            $i =~ s/$UTF8BOMRE//o;
            $i =~ s/\<\<\<(.*?)\>\>\>/$1/o;
            $i =~ s/!!!(.*?)!!!//o;
            $i =~ s/a(?:ssp)?\\?-do?\\?-n(?:ot)?\\?-o(?:ptimize)?\\?-r(?:egex)?//iso;
            if ($i =~ /(^\s*#\s*include\s+)(.+)/io) {
                my $fn = $2;
                $i = $1;
                $fn =~ s/([^\\\/])[#;].*/$1/go;
                $i .= $fn;
            } else {
                $i =~ s/^#.*//go;
                $i =~ s/([^\\])#.*/$1/go;
            }
            $i =~ s/^;.*//go;
            $i =~ s/([^\\]);.*/$1/go;
            $i =~ s/\r//go;
            $i =~ s/\s*\n+\s*//go;
            $i =~ s/\s+$//o;
            $i =~ s/(([^\\]?)\$\{\$([a-z][a-z0-9]+)\})/(defined ${$3}) ? $2.${$3} : $1/oige if $AllowInternalsInRegex;

            next if !$i;

            if (($i =~ /^\~?\Q$complexREStart\E\s*$/o || @complex) && $i !~ /^\Q$complexREEnd\E\d+\}\)(?:\s*\=\>\s*(?:-{0,1}\d+\.*\d*)?\s*(?:\s*\:\>\s*(?:[nNwWlLiI\+\-\s]+)?)?)?$/o) {
                $complexStartLine = $counter if !$complexStartLine && $i =~ /^\~?\Q$complexREStart\E\s*$/o;
                if ($i !~ /^\s*#\s*include\s+.+/io) {
                    push @complex, $i;
                    next;
                }
            } elsif ($i =~ /^\Q$complexREEnd\E\d+\}\)(?:\s*\=\>\s*([+\-]?(?:0?\.\d+|\d+\.\d+|\d+))?\s*(?:\s*\:\>\s*(?:[nNwWlLiI\+\-\s]+)?)?)?$/o) {
                push @complex, $i;
                $i = join('|', @complex);
                @complex = ();
            }

            $i =~ s/(\~([^\~]+)?\~|([^\|]+)?)\s*\=\>\s*([+\-]?(?:0?\.\d+|\d+\.\d+|\d+))?\s*(?:\s*\:\>\s*(?:[nNwWlLiI\+\-\s]+)?)?/$1/go;
            next if !$i;
            print "$name: line:$counter-$fil\n" if $extLog;

            my $line;
            my $reg = $i;
            my $file = $fil;
            my $found;
            my $INCFILE;
            if ($i =~ /^\s*#\s*include\s+(.+)\s*/io && (open $INCFILE, '<',"$base/$1")) {
                $line = 0;
                $file = $1;
                my @complexInc;
                my $complexIncStart;
                while (my $ii = <$INCFILE>) {
                    $line++;

                    $ii =~ s/$UTF8BOMRE//o;
                    $ii =~ s/\<\<\<(.*?)\>\>\>/$1/o;
                    $ii =~ s/!!!(.*?)!!!//o;
                    $ii =~ s/a(?:ssp)?\\?-do?\\?-n(?:ot)?\\?-o(?:ptimize)?\\?-r(?:egex)?//iso;
                    $ii =~ s/^[#;].*//go;
                    $ii =~ s/([^\\])[#;].*/$1/go;
                    $ii =~ s/\r//go;
                    $ii =~ s/\s*\n+\s*//go;
                    $ii =~ s/\s+$//o;
                    next if !$ii;
                    $ii =~ s/(([^\\]?)\$\{\$([a-z][a-z0-9]+)\})/(defined ${$3}) ? $2.${$3} : $1/oige if $AllowInternalsInRegex;

                    if (@complex)  {                   # complex regex started in upper file
                        push @complex, $ii;
                        next;
                    }
                                                       # complex regex started in include file
                    if (($ii =~ /^\~?\Q$complexREStart\E\s*$/o || @complexInc) && $ii !~ /^\Q$complexREEnd\E\d+\}\)(?:\s*\=\>\s*(?:-{0,1}\d+\.*\d*)?\s*(?:\s*\:\>\s*(?:[nNwWlLiI\+\-\s]+)?)?)?$/o) {
                        $complexIncStart = $line if !$complexIncStart && $ii =~ /^\~?\Q$complexREStart\E\s*$/o;
                        push @complexInc, $ii;
                        next;
                    } elsif ($ii =~ /^\Q$complexREEnd\E\d+\}\)(?:\s*\=\>\s*(?:-{0,1}\d+\.*\d*)?\s*(?:\s*\:\>\s*(?:[nNwWlLiI\+\-\s]+)?)?)?$/o) {
                        push @complexInc, $ii;
                        $ii = join('|', @complexInc);
                        @complexInc = ();
                    }

                    $ii =~ s/(\~([^\~]+)?\~|([^\|]+)?)\s*\=\>\s*([+\-]?(?:0?\.\d+|\d+\.\d+|\d+))?\s*(?:\s*\:\>\s*(?:[nNwWlLiI\+\-\s]+)?)?/$1/o;
                    next if !$ii;
                    print "$name: line:$line-$fil\n" if $extLog;
                    
                    $found = '';
                    eval{$found = $1 || $2 if $srch =~ m/($ii)/i;};
                    if ($@) {
                        mlog(0,"ConfigError: '$name' regular expression error in line $counter of file $fil - line $line of include '$file' for '$ii': $@");
                        next;
                    }
                    if ($found)
                    {
                        mlog(0,"Info: '$name' regular expression '$ii' match in line $counter of file $fil - line ".($complexIncStart?"$complexIncStart-$line":$line)." of include file '$file' with '$found' ") if $regexLogging or $BombLog;
                        close ($INCFILE);
                        $incFound = "<a href=\"javascript:void(0);\" onclick=\"javascript:popFileEditor('$fil',1);\" onmouseover=\"showhint('edit file $fil', this, event, '250px', '1'); return true;\">$Config{$name}\[line $counter\]</a>|incl:<a href=\"javascript:void(0);\" onclick=\"javascript:popFileEditor('$file',1);\" onmouseover=\"showhint('edit file $file', this, event, '250px', '1'); return true;\">$file\[line ".($complexIncStart?"$complexIncStart-$line":$line)."\]</a>";

                        close ($BOMBFILE);
                        return $ii;
                    }
                    $complexIncStart = 0;
                }
                close $INCFILE;
                next;
            } elsif ($i =~ /^\s*#\s*include\s+(.+)\s*/io) {
                mlog(0,"ConfigError: '$name' unable to open include file $1 in line $counter of '$file'");
                next;
            } else {
                $found = '';
                eval{$found = $1 || $2 if $srch =~ m/($i)/i;};
                if ($@) {
                    mlog(0,"ConfigError: '$name' regular expression error in line $counter of '$file' for '$reg': $@");
                    next;
                }
            }
            if ($found)
            {
                mlog(0,"Info: '$name' regular expression '$reg' match in line ".($complexStartLine?"$complexStartLine-$counter":$counter)." of '$file' with '$found' ") if $regexLogging or $BombLog;
                close ($BOMBFILE);
                $incFound = "<a href=\"javascript:void(0);\" onclick=\"javascript:popFileEditor('$file',1);\" onmouseover=\"showhint('edit file $file', this, event, '250px', '1'); return true;\">$Config{$name}\[line ".($complexStartLine?"$complexStartLine-$counter":$counter)."\]</a>";
                return $i;
            }
            $complexStartLine = 0;
        }
        close ($BOMBFILE);
    } else {
        my $regex;
        $fil =~ s/(\~([^\~]+)?\~|([^\|]+)?)\s*\=\>\s*([+\-]?(?:0?\.\d+|\d+\.\d+|\d+))?\s*(?:\s*\:\>\s*(?:[nNwWlLiI\+\-\s]+)?)?/$1/o; # skip weighted regexes
        $fil =~ s/(([^\\]?)\$\{\$([a-z][a-z0-9]+)\})/(defined ${$3}) ? $2.${$3} : $1/oige if $AllowInternalsInRegex;
        my @reg;
        my $bd=0;
        my $sk;
        my $t;
        foreach my $s (split('',$fil)) {
            if ($s eq '\\') {
                $sk = 1;
                $t .= $s;
                next;
            } elsif ($sk == 1) {
                $sk = 0;
                $t .= $s;
                next;
            }
            if ($s eq '(' or $s eq '[' or $s eq '{') {
                $bd++;
                $t .= $s;
                next;
            } elsif ($s eq ')' or $s eq ']' or $s eq '}') {
                $bd--;
                $t .= $s;
                next;
            }
            if ($bd > 0) {
                $t .= $s;
                next;
            } elsif ($s eq '|') {
                push @reg, $t;
                $t = '';
                $sk = 0;
                next;
            } else {
                $t .= $s;
            }
        }
        push @reg,$t if $t;
        
        while (@reg) {
            $regex = shift @reg;
            print "$name: $regex\n" if $extLog;
            if (my ($i) = eval{$srch =~ m/($regex)/i}) {
                mlog(0,"Info: '$name' regular expression '$regex' match with '$i' ") if $regexLogging or $BombLog;
                $incFound = encodeHTMLEntities($i);
                return $i;
            }
        }
        if ($@) {
            mlog(0,"ConfigError: '$name' regular expression error of '$fil' for '$name': $@");
        }
    }
    return 0;
}

sub ConfigAnalyze {
    my ( $ba, $st, $fm, %fm, %to, %wl, $ip, $helo, $text, $ip3, $received , $emfd, $mailfrom, $rcptto, $hasheader, $headTo, $org_headTo);
    my $checkRegex = ! $silent && $AnalyzeLogRegex;
    my $mail = $qs{mail};
    if (! $mail && $qs{file}) {
        my $filename = $qs{file};
        $filename = "$base/$filename" if $filename !~ /^\Q$base\E/io;
        if ( $open->(my $F, '<' , $filename) ) {
            binmode $F;
            $mail = join('',<$F>);
            close $F;
            $fm .= "<b></b><br />Analyzed file is $filename\n";
        } else {
            $fm .= "<b>ERROR: unable to open file '$filename'</b><br />\n";
        }
    }
    $mail =~ s/\r?\n/\r\n/gos;
    my $maillength = length($mail);
    my $completeMail;
    if ($DoDKIM && $mail =~ /\n(?:DKIM|DomainKey)-Signature:/ois) {
        $completeMail = $mail;
    }
    my $hl = getheaderLength(\$mail);
    $hasheader = $hl;
    my $mBytes = $MaxBytes ? $MaxBytes + $hl : 10000 + $hl;
    $mail = substr( $mail , 0, $mBytes );
    if ($qs{translit} && $CanUseTextUnidecode) {
        my $cOK;
        if ($hl) {
            ($mail,$cOK) = &clean( substr( $mail, 0, $mBytes ) );
        } else {
            $mail = decodeMimeWords2UTF8($mail);
        }
        $mail =~ s/^helo:\s*\r?\n(?:rcpt|ssub)?\s*\r?\n?//o;
        $mail = transliterate(\$mail,0);
        goto TRANSLITONLY;
    }
    $fm .= "analyze is restricted to a maximum length of $mBytes bytes<br />\n" if $maillength > length($mail);
    if ($mail =~ /X-Assp-ID: (.+)/io) {
        $fm .= "ASSP-ID: $1<br />";
    }
    if ($mail =~ /X-Assp-Session: (.+)/io) {
        $fm .= "ASSP-Session: $1<br />";
    }
    my $reportedBy;
    if ($mail =~ s/X-Assp-Envelope-From:\s*($HeaderValueRe)//ios) {
        my $s = $1;
        &headerUnwrap($s);
        if ($s =~ /($EmailAdrRe\@$EmailDomainRe)/io) {
            $s = batv_remove_tag(0,lc $1,'');
            $mailfrom = $s;
            $fm{$s}=1;
            ($emfd) = $s =~ /\@([^@]*)/o;
        }
        $hasheader = 1;
    }
    if (! scalar keys %to && $mail =~ s/X-Assp-Intended-For:\s*($HeaderValueRe)//ios) {
        my $s = $1;
        &headerUnwrap($s);
        if ($s =~ /($EmailAdrRe\@$EmailDomainRe)/io) {
            $s = batv_remove_tag(0,lc $1,'');
            $reportedBy ||= $s;
            $to{$s}=1;
        }
        $hasheader = 1;
    }
    if ($mail =~ s/X-Assp-Recipient:\s*($HeaderValueRe)//ios) {
        my $s = $1;
        &headerUnwrap($s);
        if ($s =~ /($EmailAdrRe\@$EmailDomainRe)/o) {
            $s = batv_remove_tag(0,lc $1,'');
            $reportedBy ||= $s;
            $to{$s}=1;
        }
        $hasheader = 1;
    }
    $fm .= "removed all local X-ASSP- header lines for analysis<br />\n"
        if ($mail =~ s/x-assp-[^()]+?:\s*$HeaderValueRe//gios);
    my $mystatus;
    my $foundReceived = 0;
    my @t;
    my $ret;
    my $bombsrch;
    my $orgmail;
    my @sips;
    my $sub = undef;
    my $wildcardUser = lc $wildcardUser;
    my $headerLen = index($mail,"\015\012\015\012");
    if ($hasheader && $headerLen == -1) {
        $mail .= "\015\012\015\012";
        $headerLen = index($mail,"\015\012\015\012");
    }

    if ($mail) {
        $orgmail = $mail;
        my $name = $myName;
        $name =~ s/(\W)/\\$1/go;
        if ($headerLen > -1) {
            my $fhh;
            do {
               $fhh = rand(1000000);
            } while exists $Con{$fhh};
            $Con{$fhh}->{header} = $mail;
            $Con{$fhh}->{headerpassed} = 1;
            &makeSubject($fhh);
            $sub = $Con{$fhh}->{subject3} if defined $Con{$fhh}->{subject3};
            headerUnwrap($sub) if (defined $sub);
            delete $Con{$fhh};
        }

        my @myNames = ($myName);
        push @myNames , split(/[\|, ]+/o,$myNameAlso);
        my $myName = join('|', map {my $t = quotemeta($_);$t;} @myNames);
        while ( $mail =~ /Received:\s+from\s+.*?\(\[($IPRe).*?helo=(.{0,64})\)(?:\s+by\s+(?:$myName))?\s+with/isg ) {
            $ip = ipv6expand(ipv6TOipv4($1));
            $helo = $2;
            $foundReceived = -1;
        }

        if (! $ip && $mail =~ /(?:^[\s\r\n]*|\r?\n)\s*ip\s*=\s*($IPRe)/ios ) {
            $ip = ipv6expand(ipv6TOipv4($1));
            $mystatus="ip";
        }
        
		$fm .= "Connecting IP: '$ip'<br />\n" if $ip;
        my $conIP = $ip;
        $ip3 = ipNetwork($ip,1);
        if (!$helo && $mail =~ /(?:^[\s\r\n]*|\r?\n)\s*helo\s*=\s*([^\r\n]+)/ios ) {
            $helo = $1;
            $helo =~ s/\)$//o;
            $mystatus="helo";
        }
        $fm .= "Connecting HELO: $helo<br />\n" if $helo;
        if ( $foundReceived != -1 && $mail =~ /(?:^[\s\r\n]*|\r?\n)\s*text\s*=\s*(.+)/ios ) {
            $text = $1;
            $mystatus="text";
            $fm .= "found 'text=TEXT' - lookup regular expressions in TEXT <br />\n";
        } else {
            $text = $mail;
        }
        $text =~ s/(?:\r?\n)+/\r\n/gos if $mystatus;
        $fm = "<div class=\"textBox\"><b><font size=\"3\" color=\"#003366\">General Hints:</font></b><br /><br />\n$fm</div>\n" if $fm;
        $fm .= "<div class=\"textBox\"><br />";
        if ($ispHostnames && (my($header) = $mail =~ /($HeaderRe+)/o)) {
            my $ispHost;
            while ( $header =~ /Received:($HeaderValueRe)/gis ) {
                my $val = $1;
                if ( $val =~ /(\s+from\s+(?:([^\s]+)\s)?(?:.+?)($IPRe)(?:.{1,80})by.{1,20}($ispHostnamesRE))/gis ) {
                    $helo = $2;
                    $received = 'Received:'.$1;
                    $ispHost = $4;
                    $ip = ipv6expand(ipv6TOipv4($3));
                    $ip3 = ipNetwork($ip,1);
                    $foundReceived = 1;
                }
            }
            if ($received) {
                $fm =~ s/(Connecting IP: '[^']+')/$1 is an <a href='.\/ispip'>ISPIP<\/a>/o;
                $fm =~ s/(Connecting HELO: [^<]+)/$1 is HELO from ISP-host: <a href='.\/ispHostnames'>$ispHost<\/a>/o;
                $fm .= "<b><font color='orange'>&bull;</font>ISP/Secondary Header:</b>'$received'<br />\n";
                $fm .= "<b><font color='orange'>&bull;</font>Switched to ISP/Secondary IP:</b> '$ip'<br /><br />\n";
            }
        }

        if ($foundReceived <= 0 && !$mystatus) {
            $foundReceived += () = $mail =~ /(Received:\s*from\s*)/isgo;
            $fm .= "<b><font color='yellow'>&bull;</font>no foreign received header line found</b><br /><br />\n"
              if ($foundReceived <= 0) ;
        }

        $fm .= "<b><font color=\"#003366\">sender and reply addresses:</font></b><br />";
        $fm .=  "MAIL FROM: $mailfrom<br />  " if $mailfrom;
        my $noDKIM;
        while ($mail =~ /($HeaderNameRe):($HeaderValueRe)/igos) {
            my $who = $1;
            my $s = $2;
            $noDKIM = 1 if $who =~ /^X-ASSP-[^(]+?\(\d+\)/io;
            next if $who !~ /^(from|sender|reply-to|errors-to|list-\w+|ReturnReceipt|Return-Receipt-To|Disposition-Notification-To)$/io;
            $mailfrom = lc($1) if (! $mailfrom && lc($1) eq 'from');
            &headerUnwrap($s);
            while ($s =~ /($EmailAdrRe\@$EmailDomainRe)/go) {
                my $ss = batv_remove_tag(0,$1,'');
                $mailfrom = $ss if $mailfrom eq 'from';
                $fm{lc $ss}=1;
                $fm .=  " $who: $ss <br />  ";
            }
        }
        $fm =~ s/  $/<br \/><br \/>/o;

        $fm .= "<b><font color=\"#003366\">recipient addresses:</font></b><br />";
        foreach (keys %to) {
            $fm .=  "RCPT TO: $_ <br />  ";
            my $newadr = RcptReplace($_,$mailfrom,'RecRepRegex');
            $fm =~ s/,$/(replaced with $newadr),/o if lc($newadr) ne lc $_;
        }
        while ($mail =~ /($HeaderNameRe):($HeaderValueRe)/igos) {
            my $who = $1;
            my $s = $2;
            next if $who !~ /^(?:to|cc|bcc)$/io;
            &headerUnwrap($s);
            while ($s =~ /($EmailAdrRe\@$EmailDomainRe)/go) {
                my $ss = batv_remove_tag(0,$1,'');
                $to{lc $ss}=1;
                $headTo ||= $s if (lc $who eq 'to');
                $reportedBy ||= $s;
                $fm .=  " $who: $ss <br />  ";
            }
        }
        $org_headTo = $headTo;
        $headTo = RcptReplace($headTo,$mailfrom,'RecRepRegex') if $headTo;
        
	    if ($enhancedOriginIPDetect) {
            my $tmpfh = time;
            $Con{$tmpfh} = {};
            $Con{$tmpfh}->{rcpt} = join(' ',keys %to);
            my ($ips,$ptr,$oip) = getOriginIPs(\$mail,$ip,$ip,'ptr',$tmpfh);
            delete $Con{$tmpfh};
            @sips = @{$ips};
            my @showIPs;
            for (my $i = 0; $i < @sips; $i++) {
                push @showIPs , $sips[$i]. ($ptr->{$sips[$i]} ? '('.$ptr->{$sips[$i]}.')' : '(no PTR)');
            }
            if ($oip) {
                $fm .= "<b><font color='green'>using enhanced Originated IP detection</font></b><br />\n" ;
                $fm .= "<font color='yellow'>&bull;</font>detected IP\'s on the mail routing way: ".join('<br />', @showIPs)."<br />\n";
                $fm .= "<font color='yellow'>&bull;</font>detected source IP: $oip<br /><br />\n";
            }
        } else {
            $fm .= "<b><font color='red'>enhanced Originated IP detection is disabled</font></b><br />\n";
        }
        push @sips, $ip if $ip;

        $reportedBy = '' unless ($DoPrivatSpamdb && localmailaddress(0, $reportedBy));
        $fm =~ s/  $/<br \/><br \/>/o;

        $fm .= "<b><font size=\"3\" color=\"#003366\">Feature Matching:</font></b><br /><br />";

        $fm .= "<b><font color='red'>&bull;</font>this mail would be blocked by the crash prevention analyzer</b><br />\n"
            if (!$mystatus && $crashHMM && HMMwillPossiblyCrash(0,\$text));

        my $grouphint;
        if ($Groups =~ /\s*file\s*:\s*(.+)$/i) {
            my $file = $1;
            $grouphint =
"\"javascript:void(0);\" onclick=\"javascript:popFileEditor('$file',1);\" onmouseover=\"showhint('edit Groups definition file $file', this, event, '250px', '1'); return true;\"";
        } else {
            $grouphint = "'./#Groups'";
        }
        
        foreach my $ad (sort keys %fm ) {
            my $mf = $ad;
            my $mfd;
            $mfd = $1 if $mf =~ /\@([^@]*)/o;
            my $mfdd;
            $mfdd = $1 if $mf =~ /(\@[^@]*)/o;

            if (matchSL( $mf, 'noProcessing' )) {
                $fm .=
"<b><font color='orange'>&bull;</font> <a href='./#noProcessing'>NoProcessing</a></b>: '$mf'<br />\n";
              }
            if ( $noProcessingDomains && $mf =~ /($NPDRE)/ ) {
                $fm .=
"<b><font color='orange'>&bull;</font> <a href='./#noProcessingDomains'>NoProcessing Domain</a></b>: '$1'<br />\n";
              }
            if ( matchSL( $mf, 'noProcessingFrom' ) ) {
                $fm .=
"<b><font color='orange'>&bull;</font> <a href='./#noProcessingFrom'>NoProcessing Addresses From</a></b>: '$mf'<br />\n";
              }
            if ($blackListedDomains && matchRE([$mf],'blackListedDomains',1) ) {
                $fm .=
"<b><font color='red'>&bull;</font> <a href='./#blackListedDomains'>Blacklisted Domains</a></b>: '$lastREmatch'<br />\n";
              }
            foreach (keys %to) {
                if ($blackListedDomains && matchRE(["$mf,$_"],'blackListedDomains',1) ) {
                    $fm .=
"<b><font color='red'>&bull;</font> <a href='./#blackListedDomains'>Blacklisted Domains</a></b>: '$lastREmatch'<br />\n";
                  }
            }
            if ($whiteListedDomains && matchRE([$mf],'whiteListedDomains',1) ) {
                $fm .=
"<b><font color=#66CC66>&bull;</font> <a href='./#whiteListedDomains'>Whitelisted Domains</a></b>: '$lastREmatch'<br />\n";
              }
            foreach (keys %to) {
                if ($whiteListedDomains && matchRE(["$mf,$_"],'whiteListedDomains',1) ) {
                    $fm .=
"<b><font color=#66CC66>&bull;</font> <a href='./#whiteListedDomains'>Whitelisted Domains</a></b>: '$lastREmatch'<br />\n";
                  }
            }
            $fm .= "<b><font color='orange'>&bull;</font> <a href='./lists'>Redlist</a></b>: '$ad'<br />\n"
              if $Redlist{$ad};
            $fm .=
"<b><font color=#66CC66>&bull;</font> <a href='./lists'>Redlisted Domain/ Wildcard</a></b>: '$wildcardUser$mfdd'<br />\n"
              if $Redlist{"$wildcardUser$mfdd"};
            $fm .=
"<b><font color=#66CC66>&bull;</font> <a href='./lists'>Whitelisted WildcardDomain</a></b>: '$wildcardUser$mfdd'<br />\n"
              if &Whitelist("$wildcardUser$mfdd");

            if (! $WhitelistPrivacyLevel) {
                if (&Whitelist($ad)) {
                    $fm .= "<b><font color=#66CC66>&bull;</font> <a href='./lists'>On Global Whitelist</a></b>: '$ad'<br />\n";
                    foreach my $t (sort keys %to) {
                        if (! &Whitelist($ad,$t)) {
                            $fm .= "<b><font color='red'>&bull;</font> <a href='./lists'>Whitelist removed for $t </a></b>: '$ad'<br />\n";
                        }
                    }
                }
            } elsif ($WhitelistPrivacyLevel==1) {
                my %seen;
                foreach my $t (sort keys %to) {
                    my $dom;
                    $dom = $1 if $t =~ /(\@$EmailDomainRe)$/o;
                    if ($dom && ! exists($seen{$dom}) && &Whitelist($ad,$dom)) {
                        $fm .= "<b><font color=#66CC66>&bull;</font> <a href='./lists'>On Domain Whitelist</a></b>: '$ad,$dom'<br />\n";
                        $seen{$dom} = 1;
                    }
                    if (! &Whitelist($ad,$t)) {
                        $fm .= "<b><font color='red'>&bull;</font> <a href='./lists'>Whitelist removed for $t </a></b>: '$ad'<br />\n";
                    }
                }
            } elsif ($WhitelistPrivacyLevel==2) {
                foreach my $t (sort keys %to) {
                    if (&Whitelist($ad,$t)) {
                        $fm .= "<b><font color=#66CC66>&bull;</font> <a href='./lists'>On Privat Whitelist</a></b>: '$ad,$t'<br />\n";
                    } elsif (exists $Whitelist{"$ad,$t"}) {
                        $fm .= "<b><font color='red'>&bull;</font> <a href='./lists'>Whitelist explicide removed for $t </a></b>: '$ad'<br />\n";
                    }
                }
            }

            foreach my $t (sort keys %to) {
                $fm .=
"<b><font color='red'>&bull;</font> <a href='./#persblackdb'>on personal Blacklist for $t </a></b>: '$ad'<br />\n"
                    if PersBlackFind($t,$ad);
            }
            
            $fm .=
"<b><font color=#66CC66>&bull;</font> <a href='./#noURIBL'>No URIBL sender</a></b>: '$mf'<br />\n"
              if matchSL( $mf, 'noURIBL' );

            while (my ($k,$v) = each %GroupRE) {
                my $cfglist;
                foreach my $config (keys %{$GroupWatch{$k}}) {
                    $cfglist .= $cfglist ? ', ' : "- $k is used in: ";
                    if ($Config{$config} =~ /\s*file\s*:\s*(.+)$/i) {
                        my $file = $1;
                        $cfglist .=
"<a href=\"javascript:void(0);\" onclick=\"javascript:popFileEditor('$file',1);\" onmouseover=\"showhint('edit file $file', this, event, '250px', '1'); return true;\">$config</a>";
                    } else {
                        $cfglist .= "<a href='./#$config'>$config</a>";
                    }
                }
                my $gpexplnk =
"<a href=\"javascript:void(0);\" onclick=\"javascript:popFileEditor('files/groups_export/$k.txt',8);\" onmouseover=\"showhint('show group details in exported file files/groups_export/$k.txt', this, event, '250px', '1'); return true;\">$k</a>";
                $fm .=
"<b><font color=#66CC66>&bull;</font> <a href=$grouphint>Group</a> $gpexplnk</b> match for: '$mf' $cfglist<br />\n"
                    if ($v && $mf && eval{$mf =~ /$v/i});
                $fm .=
"<b><font color=#66CC66>&bull;</font> <a href=$grouphint>Group</a> $gpexplnk</b> match for: '$mfd' $cfglist<br />\n"
                    if ($v && $mfd && eval{$mfd =~ /$v/i});
                $fm .=
"<b><font color=#66CC66>&bull;</font> <a href=$grouphint>Group</a> $gpexplnk</b> match for: '$mfdd' $cfglist<br />\n"
                    if ($v && $mfdd && eval{$mfdd =~ /$v/i});
            }
        }

        foreach my $t (sort keys %to) {
            while (my ($k,$v) = each %GroupRE) {
                my $cfglist;
                foreach my $config (keys %{$GroupWatch{$k}}) {
                    $cfglist .= $cfglist ? ', ' : "- $k is used in: ";
                    if ($Config{$config} =~ /\s*file\s*:\s*(.+)$/i) {
                        my $file = $1;
                        $cfglist .=
"<a href=\"javascript:void(0);\" onclick=\"javascript:popFileEditor('$file',1);\" onmouseover=\"showhint('edit file $file', this, event, '250px', '1'); return true;\">$config</a>";
                    } else {
                        $cfglist .= "<a href='./#$config'>$config</a>";
                    }
                }
                my $gpexplnk =
"<a href=\"javascript:void(0);\" onclick=\"javascript:popFileEditor('files/groups_export/$k.txt',8);\" onmouseover=\"showhint('show group details in exported file files/groups_export/$k.txt', this, event, '250px', '1'); return true;\">$k</a>";
                $fm .=
"<b><font color=#66CC66>&nbsp;&bull;</font> <a href=$grouphint>Group</a> $gpexplnk</b> match for: '$t' $cfglist<br />\n"
                    if ($v && $t && eval{$t =~ /$v/i});
            }
        }

        $checkRegex && $preHeaderRe && SearchBomb( "preHeaderRe", $text );
        if ( $preHeaderRe && $text =~ /($preHeaderReRE)/ ) {
            $fm .= "<b><font color='red'>&bull;</font> <a href='./#preHeaderRe'>preHeaderRe</a></b>: '".($1||$2)."'<br />\n";
            $bombsrch = SearchBomb( "preHeaderRe", ($1||$2) );
            $fm .= "<font color='red'>&nbsp;&bull;</font> matching preHeaderRe($incFound): '$bombsrch'<br />\n"
              if $bombsrch;
          }
        $checkRegex && $noSPFRe && SearchBomb( "noSPFRe", $mailfrom );
        if ( $noSPFRe && $mailfrom =~ /($noSPFReRE)/ ) {
            $fm .= "<b><font color='green'>&bull;</font> <a href='./#noSPFRe'>No SPF RE</a></b>: '".($1||$2)."'<br />\n";
            $bombsrch = SearchBomb( "noSPFRe", ($1||$2) );
            $fm .= "<font color='green'>&nbsp;&bull;</font> matching noSPFRe($incFound): '$bombsrch'<br />\n"
              if $bombsrch;
          }
        $checkRegex && $noSPFRe && SearchBomb( "noSPFRe", $text );
        if ( $noSPFRe && $text =~ /($noSPFReRE)/ ) {
            $fm .= "<b><font color='green'>&bull;</font> <a href='./#noSPFRe'>No SPF RE</a></b>: '".($1||$2)."'<br />\n";
            $bombsrch = SearchBomb( "noSPFRe", ($1||$2) );
            $fm .= "<font color='green'>&nbsp;&bull;</font> matching noSPFRe($incFound): '$bombsrch'<br />\n"
              if $bombsrch;
          }
        $checkRegex && $strictSPFRe && SearchBomb( "strictSPFRe", $mailfrom );
        if ( $strictSPFRe && $mailfrom =~ /($strictSPFReRE)/ ) {
            $fm .= "<b><font color='green'>&bull;</font> <a href='./#strictSPFRe'>Strict SPF RE</a></b>: '".($1||$2)."'<br />\n";
            $bombsrch = SearchBomb( "strictSPFRe", ($1||$2) );
            $fm .= "<font color='green'>&nbsp;&bull;</font> matching strictSPFRe($incFound): '$bombsrch'<br />\n"
              if $bombsrch;
          }
        $checkRegex && $blockstrictSPFRe && SearchBomb( "blockstrictSPFRe", $mailfrom );
        if ( $blockstrictSPFRe && $mailfrom =~ /($blockstrictSPFReRE)/ ) {
            $fm .= "<b><font color='green'>&bull;</font> <a href='./#blockstrictSPFRe'>Block Strict SPF RE</a></b>: '".($1||$2)."'<br />\n";
            $bombsrch = SearchBomb( "blockstrictSPFRe", ($1||$2) );
            $fm .= "<font color='green'>&nbsp;&bull;</font> matching blockstrictSPFRe($incFound): '$bombsrch'<br />\n"
              if $bombsrch;
          }
        if ( exists $SPFCache{"$ip $emfd"} ) {
            my ( $ct, $status, $result ) = split( ' ', $SPFCache{"$ip $emfd"} );
            my $color = (($status eq 'pass') ? 'green' : 'orange');
            $fm .= "<b><font color='$color'>&bull;</font> $ip is in SPFCache</b>: status=$status with helo=$result<br />\n";
          }

        if ($mailfrom && $DoDKIM) {
            my $mf = lc $mailfrom;
            my $domain;
            $domain = $1 if $mf=~/\@([^@]*)/o;
            if ($domain) {
                if ( ! $completeMail && DKIMCacheFind($domain)) {
                    $fm .= "<b><font color='red'>&bull;</font> DKIM-pre-check returned FAILED</b> missing DKIM-Signature for domain $domain<br />\n";
                }
            }
        }

        eval {
        my $tmpfh = time;
        $Con{$tmpfh} = {};
        $Con{$tmpfh}->{ip} = $ip;
        $Con{$tmpfh}->{mailfrom} = $mailfrom;
        $Con{$tmpfh}->{rcpt} = $headTo;
        $Con{$tmpfh}->{orgrcpt} = $org_headTo;
        $Con{$tmpfh}->{helo} = $helo;
        $Con{$tmpfh}->{header} = $completeMail || $mail;
        $Con{$tmpfh}->{nodkim} = $noDKIM;
        if ($completeMail) {
            $Con{$tmpfh}->{isDKIM} = 1;
            if ( DKIMOK($tmpfh,\$completeMail,defined${chr(ord(",")<< 1)} && ($completeMail =~ /\r\n\.[\r\n]+$/o)) ) {
                $fm .= "<b><font color='green'>&bull;</font> DKIM-check returned OK</b> $Con{$tmpfh}->{dkimverified}<br />\n";
            } else {
                $fm .= "<b><font color='red'>&bull;</font> DKIM-check returned FAILED</b> $Con{$tmpfh}->{dkimverified}<br />\n";
            }
        }
        $completeMail = '';

        DMARCget($tmpfh);

        if ($ip && ($mailfrom || $helo)) {
            if ( SPFok($tmpfh)) {
                $fm .= "<b><font color='green'>&bull;</font> SPF-check returned OK</b> for $ip -&gt; $mailfrom, $helo<br />\n";
                $fm .= "<font color='green'>&nbsp;&bull;</font> $Con{$tmpfh}->{received_spf}<br />\n" if $Con{$tmpfh}->{received_spf};
            } else {
                $fm .= "<b><font color='red'>&bull;</font> SPF-check returned FAILED</b> for $ip -&gt; $mailfrom, $helo<br />\n";
                $fm .= "<font color='red'>&nbsp;&bull;</font> $Con{$tmpfh}->{received_spf}<br />\n" if $Con{$tmpfh}->{received_spf};
            }
            if ($DoDKIM && $ValidateSPF && $Con{$tmpfh}->{dmarc} && $Con{$tmpfh}->{spf_result}) {
                if ( DMARCok($tmpfh)) {
                    $fm .= "<b><font color='green'>&bull;</font> DMARC-check returned OK</b><br />\n";
                } else {
                    $fm .= "<b><font color='red'>&bull;</font> DMARC-check returned FAILED</b><br />\n";
                }
            }
        }
        delete $Con{$tmpfh};
        $tmpfh = '';
        };
        
        $checkRegex && $whiteReRE && SearchBomb( "whiteRe", $text );
        if ( $whiteRe && $text =~ /($whiteReRE)/ ) {
            $fm .= "<b><font color='green'>&bull;</font> <a href='./#whiteRe'>White RE</a></b>: '".($1||$2)."'<br />\n";
            $bombsrch = SearchBomb( "whiteRe", ($1||$2) );
            $fm .= "<font color='green'>&nbsp;&bull;</font> matching whiteRe($incFound): '$bombsrch'<br />\n"
              if $bombsrch;
          }
        $checkRegex && $redReRE && SearchBomb( "redRe", $text );
        if ( $redRe && $text =~ /($redReRE)/ ) {
            $fm .= "<b><font color='yellow'>&bull;</font> <a href='./#redRe'>Red RE</a></b>: '".($1||$2)."'<br />\n";
            $bombsrch = SearchBomb( "redRe", ($1||$2) );
            $fm .= "<font color='yellow'>&nbsp;&bull;</font> matching redRe($incFound): '$bombsrch'<br />\n"
              if $bombsrch;
          }
        $checkRegex && $npReRE && SearchBomb( "npRe", $text );
        if ( $npRe && $text =~ /($npReRE)/ ) {
            $fm .= "<b><font color='green'>&bull;</font> <a href='./#npRe'>No Processing RE</a></b>: '".($1||$2)."'<br />\n";
            $bombsrch = SearchBomb( "npRe", ($1||$2) );
            $fm .= "<font color='green'>&nbsp;&bull;</font> matching npRe($incFound): '$bombsrch'<br />\n"
              if $bombsrch;
          }
        $checkRegex && $baysSpamLoversRe && SearchBomb( "baysSpamLoversRe", $rcptto );
        if ( $baysSpamLoversRe && $rcptto =~ /($baysSpamLoversReRE)/ ) {
            $fm .=
"<b><font color='green'>&bull;</font> <a href='./#baysSpamLoversRe'>Bayes Spamlover RE</a></b>: '".($1||$2)."'<br />\n";
            $bombsrch = SearchBomb( "baysSpamLoversRe", ($1||$2) );
            $fm .=
"<font color='green'>&nbsp;&bull;</font> matching baysSpamLoversRe($incFound): '$bombsrch'<br />\n"
              if $bombsrch;
          }
        $checkRegex && $SpamLoversRe && SearchBomb( "SpamLoversRe", $rcptto );
        if ( $SpamLoversRe && $rcptto =~ /($SpamLoversReRE)/ ) {
            $fm .= "<b><font color='green'>&bull;</font> <a href='./#SpamLoversRe'>Spamlover RE</a></b>: '".($1||$2)."'<br />\n";
            $bombsrch = SearchBomb( "SpamLoversRe", ($1||$2) );
            $fm .=
              "<font color='green'>&nbsp;&bull;</font> matching SpamLoversRe($incFound): '$bombsrch'<br />\n"
              if $bombsrch;
          }
        $checkRegex && $testRe && SearchBomb( "testRe", $text);
        if ( $testRe && ($bombsrch = SearchBombW( "testRe", \$text ))) {
            if ( !$DoTestRe ) {
                $fm .=
"<i><font color='yellow'>&bull;</font> <a href='./#DoTestRe'>testRe</a> is <b>disabled because DoTestRe is disabled</b></i><br />\n";
              }
            $fm .= "<b><font color='yellow'>&bull;</font> <a href='./#testRe'>testRe</a></b>: '$bombsrch'<br />\n";
            $fm .= "<font color='yellow'>&nbsp;&bull;</font> matching testRe($incFound): '$weightMatch'<br />\n";
          }

        $checkRegex && $contentOnlyRe && SearchBomb( "contentOnlyRe", $text);
        if ( $contentOnlyRe && $text =~ /($contentOnlyReRE)/ ) {
            $fm .=
"<b><font color='yellow'>&bull;</font> <a href='./#contentOnlyRe'>Restrict to Content Only RE</a></b>: '".($1||$2)."'<br />\n";
            $bombsrch = SearchBomb( "contentOnlyRe", ($1||$2) );
            $fm .=
              "<font color='yellow'>&nbsp;&bull;</font> matching contentOnlyRe($incFound): '$bombsrch'<br />\n"
              if $bombsrch;
        }
        my $textheader;
        if ($headerLen > -1 ) {
            $textheader = substr($text,0,$headerLen);
        } else {
            $textheader = $text;
        }

        $checkRegex && $bombRe && SearchBomb( "bombRe", $text);
        if ( $bombRe && ($bombsrch = SearchBombW( "bombRe", \$text ))) {
            if ( !$DoBombRe ) {
                $fm .=
"<i><font color='red'>&bull;</font> <a href='./#DoBombRe'>bombRe</a> is <b>disabled because DoBombRe is disabled</b></i><br />\n";
              }
            my $color = $bombsrch =~ /\-\d+\s*$/o ? 'green' : 'red';
            $fm .= "<b><font color='$color'>&bull;</font> <a href='./#bombRe'>bombRe </a></b>: '$bombsrch'<br />\n";
            $fm .= "<font color='$color'>&nbsp;&bull;</font> matching bombRe($incFound): '$weightMatch'<br />\n";
          }
        $checkRegex && $bombDataRe && SearchBomb( "bombDataRe", $text);
        if ( $bombDataRe && ($bombsrch = SearchBombW( "bombDataRe", \$text ))) {
            if ( !$DoBombRe ) {
                $fm .=
"<i><font color='red'>&bull;</font> <a href='./#DoBombRe'>BombData RE</a> is <b>disabled because DoBombRe is disabled</b></i><br />\n";
              }
            my $color = $bombsrch =~ /\-\d+\s*$/o ? 'green' : 'red';
            $fm .= "<b><font color='$color'>&bull;</font> <a href='./#bombDataRe'>BombData RE</a></b>: '$bombsrch'<br />\n";
            $fm .= "<font color='$color'>&nbsp;&bull;</font> matching bombDataRe($incFound): '$weightMatch'<br />\n";
          }
        $checkRegex && $bombHeaderRe && SearchBomb( "bombHeaderRe", $textheader);
        if ( $bombHeaderRe && ($bombsrch = SearchBombW( "bombHeaderRe", \$textheader ))) {
            if ( !$DoBombHeaderRe ) {
                $fm .=
"<i><font color='red'>&bull;</font> <a href='./#DoBombHeaderRe'>BombHeader RE</a> is <b>disabled</b></i><br />\n";
              }
            my $color = $bombsrch =~ /\-\d+\s*$/o ? 'green' : 'red';
            $fm .= "<b><font color='$color'>&bull;</font> <a href='./#bombHeaderRe'>BombHeader RE</a></b>: '$bombsrch'<br />\n";
            $fm .= "<font color='$color'>&nbsp;&bull;</font> matching bombHeaderRe($incFound): '$weightMatch'<br />\n";
          }
        $checkRegex && ($bombSubjectRe || $maxSubjectLength) && SearchBomb( "bombSubjectRe", $sub);
        if ( ($bombSubjectRe || $maxSubjectLength) && ($bombsrch = SearchBombW( "bombSubjectRe", \$sub)) ) {
            if ( !$DoBombHeaderRe ) {
                $fm .=
"<i><font color='red'>&bull;</font> <a href='./#DoBombHeaderRe'>BombSubject RE</a> is <b>disabled</b> because DoBombHeaderRe is disabled</i><br />\n";
              }
            my $color = $bombsrch =~ /\-\d+\s*$/o ? 'green' : 'red';
            $fm .= "<b><font color='$color'>&bull;</font> <a href='./#bombSubjectRe'>BombSubject RE</a></b>: '$bombsrch'<br />\n";
            $fm .=
              "<font color='$color'>&nbsp;&bull;</font> matching bombSubjectRe($incFound): '$weightMatch'<br />\n";
          }
        $checkRegex && $bombCharSets && SearchBomb( "bombCharSets", $textheader);
        if ( $bombCharSets && ($bombsrch = SearchBombW( "bombCharSets", \$textheader ))) {
            if ( !$DoBombHeaderRe ) {
                $fm .=
"<i><font color='red'>&bull;</font> <a href='./#DoBombHeaderRe'>bombCharSets</a> is <b>disabled</b> because DoBombHeaderRe is disabled</i><br />\n";
              }
            my $color = $bombsrch =~ /\-\d+\s*$/o ? 'green' : 'red';
            $fm .=
              "<b><font color='$color'>&bull;</font> <a href='./#bombCharSetsRe'>BombCharsets RE</a></b>: '$bombsrch'<br />\n";
            $fm .= "<font color='$color'>&nbsp;&bull;</font> matching bombCharSets($incFound): '$weightMatch'<br />\n";
          }
        $checkRegex && $bombSuspiciousRe && SearchBomb( "bombSuspiciousRe", $text);
        if ( $bombSuspiciousRe && ($bombsrch = SearchBombW( "bombSuspiciousRe", \$text ))) {
            my $color = $bombsrch =~ /\-\d+\s*$/o ? 'green' : 'red';
            $fm .=
"<b><font color='$color'>&bull;</font> <a href='./#bombSuspiciousRe'>BombSuspiciousRe RE</a></b>: '$bombsrch'<br />\n";
            $fm .=
"<font color='$color'>&nbsp;&bull;</font> matching bombSuspiciousRe($incFound): '$weightMatch'<br />\n";
          }
        $checkRegex && $blackRe && SearchBomb( "blackRe", $text);
        if ( $blackRe && ($bombsrch = SearchBombW( "blackRe", \$text ))) {
            if ( !$DoBlackRe ) {
                $fm .=
"<i><font color='red'>&bull;</font> <a href='./#DoBlackRe'>Black RE</a> is  <b>disabled</b></i><br />\n";
              }
            $fm .= "<b><font color='red'>&bull;</font> <a href='./#blackRe'>Black RE</a></b>: '$bombsrch'<br />\n";
            $fm .= "<font color='red'>&nbsp;&bull;</font> matching blackRe($incFound): '$weightMatch'<br />\n";
          }
        $checkRegex && $scriptRe && SearchBomb( "scriptRe", $text);
        if ( $scriptRe && ($bombsrch = SearchBombW( "scriptRe", \$text ))) {
            $fm .= "<b><font color='red'>&bull;</font> <a href='./#scriptRe'>Script RE</a></b>: '$bombsrch'<br />\n";
            $fm .= "<font color='red'>&nbsp;&bull;</font> matching scriptRe($incFound): '$weightMatch'<br />\n";
          }
        $checkRegex && $bombSenderRe && SearchBomb( "bombSenderRe", $mailfrom);
        if ( $bombSenderRe && ($bombsrch = SearchBombW( "bombSenderRe", \$mailfrom )))
        {
            my $color = $bombsrch =~ /\-\d+\s*$/o ? 'green' : 'red';
            $fm .= "<b><font color='$color'>&bull;</font> <a href='./#bombSenderRe'>BombSender RE</a></b>: '$bombsrch'<br />\n";
            $fm .= "<font color='$color'>&nbsp;&bull;</font> matching bombSenderRe($incFound): '$weightMatch'<br />\n";
        }
        $checkRegex && $bombSenderRe && SearchBomb( "bombSenderRe", $ip);
        if ( $bombSenderRe && ($bombsrch = SearchBombW( "bombSenderRe", \$ip )))
        {
            my $color = $bombsrch =~ /\-\d+\s*$/o ? 'green' : 'red';
            $fm .= "<b><font color='$color'>&bull;</font> <a href='./#bombSenderRe'>BombSender RE</a></b>: '$bombsrch'<br />\n";
            $fm .= "<font color='$color'>&nbsp;&bull;</font> matching bombSenderRe($incFound): '$weightMatch'<br />\n";
        }


        my $obfuscatedip;
        my $obfuscateduri;
        my $maximumuniqueuri;
        my $maximumuri;
        if ( !$ValidateURIBL )
        {
            $fm .=
"<i><font color='red'>&bull;</font> <a href='./#ValidateURIBL'>URIBL check</a> is <b>disabled because ValidateURIBL is disabled</b></i><br />\n";
        } else {
            my $tmpfh = time;
            $Con{$tmpfh} = {};
            $Con{$tmpfh}->{mailfrom} = $mailfrom;
            $Con{$tmpfh}->{rcpt} = join(' ',keys %to);
            my $color = 'green';
            my $failed = 'OK';
            my $res = &URIBLok_Run($tmpfh,\$text,$ip,'');
            if (! $res) {
                $color = 'red';
                $failed = 'failed';
            }
            $fm .=
"<b><font color='$color'>&bull;</font> <a href='./#ValidateURIBL'>URIBL check</a></b>: '$failed'<br />\n";
            if ($Con{$tmpfh}->{messagereason}) {
                $color = 'orange';
                $fm .=
"<font color='$color'>&nbsp;&bull;</font> URIBL result: '$Con{$tmpfh}->{messagereason}'<br />
&nbsp;&nbsp; URIBL listed by: $Con{$tmpfh}->{uri_listed_by}<br />";
            }
            $obfuscatedip = $Con{$tmpfh}->{obfuscatedip};
            $obfuscateduri= $Con{$tmpfh}->{obfuscateduri};
            $maximumuniqueuri = $Con{$tmpfh}->{maximumuniqueuri};
            $maximumuri = $Con{$tmpfh}->{maximumuri};
            delete $Con{$tmpfh};
        }

        my $cOK;
        ($mail,$cOK) = &clean( substr( $mail, 0, $mBytes ) );
        $mail =~ s/^helo:\s*\r?\nrcpt\s*\r?\n//o;

        if ($helo) {
            my $hb = $HeloBlack{ lc $helo };
            $fm .= "<b><font color='red'>&bull;</font> HELO Blacklist</b>: '$helo'</b><br />\n"
              if ( $hb >= 1);
            $fm .= "<b><font color='green'>&bull;</font> Known Good HELO</b>: '$helo'</b><br />\n"
              if ( $hb < 1 && $hb > 0);
            $fm .=
"<b><font color='#66CC66'>&bull;</font> <a href='./#heloBlacklistIgnore'>HELO Blacklist Ignore</a></b>: '$helo'</b><br />\n"
              if ( $heloBlacklistIgnore && $helo =~ /$HBIRE/ );
            if ( !$DoValidFormatHelo ) {
                $fm .= "<b><font color='orange'>&bull;</font>Valid Format of HELO not activated</b><br />\n";
              }
            if ($validFormatHeloRe) {
                if ( $helo =~ /$validFormatHeloReRE/ ) {
                    $fm .=
"<b><font color=#66CC66>&bull;</font> <a href='./#DoValidFormatHelo'>Valid Format of HELO</a></b>: '$helo'<br />\n";
                  } else {
                    $fm .=
"<b><font color='red'>&bull;</font> <a href='./#DoValidFormatHelo'>Not a Valid Format of HELO</a></b>: '$helo'<br />\n";
                  }
              }
            if ( !$DoInvalidFormatHelo ) {
                $fm .= "<b><font color='orange'>&bull;</font>Invalid Format of HELO not activated</b><br />\n";
              }

            $checkRegex && $invalidFormatHeloRe && SearchBomb( "invalidFormatHeloRe", $helo);
            if ( $invalidFormatHeloRe && ($bombsrch = SearchBombW( "invalidFormatHeloRe", \$helo )))
            {
                $fm .= "<b><font color='red'>&bull;</font> <a href='./#invalidFormatHeloRe'>Invalid Format of HELO</a></b>: '$bombsrch'<br />\n";
                $fm .= "<font color='red'>&nbsp;&bull;</font> matching invalidFormatHeloRe($incFound): '$weightMatch'<br />\n";
            }
            if ($DoIPinHelo) {
                my $tmpfh = time;
                $Con{$tmpfh} = {};
                $Con{$tmpfh}->{ip} = $ip;
                my $color = 'green';
                my $failed = 'OK';
                my $res = &IPinHeloOK_Run($tmpfh);
                if (! $res) {
                    $color = 'yellow';
                    $failed = 'failed';
                }
                $fm .=
"<b><font color='$color'>&bull;</font> <a href='./#DoIPinHelo'>IP in Helo check</a></b>: '$failed'<br />\n";
                $fm .=
"<font color='$color'>&nbsp;&bull;</font> IP in Helo result: '$Con{$tmpfh}->{messagereason}'<br />\n" if $Con{$tmpfh}->{messagereason};
                delete $Con{$tmpfh};
            } else {
                $fm .=
"<i><font color='red'>&bull;</font> <a href='./#DoIPinHelo'>IP in Helo check</a> is <b>disabled because DoIPinHelo is disabled</b></i><br />\n";
            }
        }
        foreach my $iip (@sips) {
            if ( pbBlackFind($iip) ) {
                my $nip = &ipNetwork( $iip, $PenaltyUseNetblocks );
                $nip =~ s/\.d+$/.0/o;
                my ( $ct, $ut, $pbstatus, $value, $sip, $reason ) = split( ' ', $PBBlack{$iip} );
                ( $ct, $ut, $pbstatus, $value, $sip, $reason ) = split( ' ', $PBBlack{$nip} ) unless $ct;
                $fm .=
"<b><font color='red'>&bull;</font> $iip is in <a href='./#pbdb'>PB Black</a></b>: score:$value, last event - $reason<br />\n";
            }
        }
        if ( pbWhiteFind($ip) ) {
#            my ( $ct, $ut, $pbstatus, $sip, $reason ) = split( ' ', $PBWhite{$ip} );

            $fm .= "<b><font color=#66CC66>&bull;</font> $ip is in <a href='./#pbdb'>PB White</a></b><br />\n";
          }

        my $tmpfh = time;
        $Con{$tmpfh} = {};
        $Con{$tmpfh}->{rcpt} = join(' ',keys %to);
        if ( $ret = matchIP( $ip, 'noProcessingIPs', $tmpfh, 1 ) ) {
            my $f = $lastREmatch ? " for $lastREmatch" : '';
            $fm .=
"<b><font color='green'>&bull;</font> IP $ip is in <a href='./#noProcessingIPs'>noProcessing IPs</a>$f ($ret)</b><br />\n";
          }
        if ( $ret = matchIP( $ip, 'whiteListedIPs', $tmpfh, 1 ) ) {
            my $f = $lastREmatch ? " for $lastREmatch" : '';
            $fm .=
"<b><font color='green'>&bull;</font> IP $ip is in <a href='./#whiteListedIPs'>whiteListed IPs</a>$f ($ret)</b><br />\n";
          }
        delete $Con{$tmpfh};

        if ( $ret = matchIP( $ip, 'noPB', 0, 1 ) ) {
            $fm .=
              "<b><font color='green'>&bull;</font> IP $ip is in <a href='./#noPB'>noPB IPs</a> ($ret)</b><br />\n";
          }
        foreach my $iip (@sips) {
            if ( exists $RBLCache{$iip} ) {
                my ( $ct, $mm, $status, @rbllists ) = split( ' ', $RBLCache{$iip} );
                if ($mm !~ /^\d{4}/o) {
                    $mm = '20'.$mm.':00';
                }
                $mm =~ s/\// /o;
                my $color = ($status == 2 ? 'green' : 'red');
                $status = ( $status == 2 ? 'as ok at '.$mm : "as not ok at $mm , listed by @rbllists" );
                $fm .=
                  "<b><font color='$color'>&bull;</font> $iip is in RBLCache</b>: inserted $status<br />\n";
            } else {
                my $tmpfh = time;
                $Con{$tmpfh} = {};
                $Con{$tmpfh}->{ip} = $iip;
                my $res = RBLok_Run($tmpfh,$iip,1);
                my $color = ($res ? 'green' : 'red');
                my $status = ( $res ? 'OK ' : "FAILED" );
                $fm .=
                  "<b><font color='$color'>&bull;</font> RBLCheck returned $status for $iip</b>: $Con{$tmpfh}->{messagereason}<br />\n";
                delete $Con{$tmpfh};
            }
        }
        if ( exists $MXACache{$emfd} ) {
            my ($ct,$status) = split(/\s+/o,$MXACache{$emfd},2);
            $fm .= "<b><font color='green'>&bull;</font> domain $emfd has valid MXA record</b>: $status<br />\n";
        }

        if ( exists $PTRCache{$ip} ) {
            my ( $ct, $status, $dns ) = split( ' ', $PTRCache{$ip} );
            my %statList = (
                1 => 'no PTR',
                2 => "PTR OK - $dns",
                3 => "PTR NOTOK - $dns"
            );
            my $color = ($status == 2 ? 'green' : 'red');
            $status = $statList{$status};
            $fm .= "<b><font color='$color'>&bull;</font> $ip is in PTRCache</b>: status=$status<br />\n";
          }
        if ( exists $RWLCache{$ip} ) {
            my ( $ct, $status ) = split( ' ', $RWLCache{$ip} );
            my %statList = (
                1 => 'tusted',
                2 => 'trusted but RWLminHits not reached',
                3 => 'trusted and whitelisted',
                4 => 'not listed'
            );
            my $color = ($status == 4 ? 'orange' : 'green');
            $status = $statList{$status};
            $fm .= "<b><font color='$color'>&bull;</font> $ip is in RWLCache</b>: status=$status<br />\n";
        } else {
            my $tmpfh = time;
            $Con{$tmpfh} = {};
            $Con{$tmpfh}->{ip} = $ip;
            my %statList = (
                1 => 'tusted',
                2 => 'trusted but RWLminHits not reached',
                3 => 'trusted and whitelisted',
                4 => 'not listed'
            );
            my $res = &RWLok_Run($tmpfh,$ip);
            $Con{$tmpfh}->{rwlstatus} = 4 if !$res && !$Con{$tmpfh}->{rwlstatus};
            if ($res) {
                my $color = ($Con{$tmpfh}->{rwlstatus} == 4 ? 'orange' : 'green');
                my $status = $statList{$Con{$tmpfh}->{rwlstatus}} || 'unknown';
                $Con{$tmpfh}->{messagereason} = ' - ' . $Con{$tmpfh}->{messagereason} if $Con{$tmpfh}->{messagereason};
                $fm .= "<b><font color='$color'>&bull;</font> RWLcheck returned OK for $ip </b>: status=$status$Con{$tmpfh}->{messagereason}<br />\n";
            }
            delete $Con{$tmpfh};
        }
        if ( my ( $cidr , $ct, $status, $data ) = SBCacheFind($ip) ) {
            my %statList = (
                0 => 'not classified',
                1 => 'black country',
                2 => 'white SenderBase',
                3 => 'changed to black country'
            );
            my $color = 'orange';
            $color = 'red' if $status % 2;
            $color = 'green' if $status == 2;
            $status = $statList{$status};
            $data =~ s/\|/, /og;
            $fm .= "<b><font color='$color'>&bull;</font> $ip is in CountryCache</b>: status=$status, data=$data<br />\n";
        } else {
            my $tmpfh = time;
            $Con{$tmpfh} = {};
            $Con{$tmpfh}->{ip} = $ip;
            $Con{$tmpfh}->{mailfrom} = $mailfrom;
            my %statList = (
                0 => 'not classified',
                1 => 'black country',
                2 => 'white SenderBase',
                3 => 'changed to black country'
            );
            my $res = SenderBaseOK($tmpfh, $ip);
            my $data = $Con{$tmpfh}->{sbdata};
            my $status = $Con{$tmpfh}->{sbstatus};
            my $color = 'orange';
            $color = 'red' if $status % 2;
            $color = 'green' if $status == 2;
            $status = $statList{$status};
            $data =~ s/\|/, /og;
            $fm .= "<b><font color='$color'>&bull;</font> $ip SenderBase</b>: status=$status, data=$data<br />\n" if $data;
            delete $Con{$tmpfh};
        }
        if ( $ret = matchIP( $ip, 'acceptAllMail', 0, 1 ) ) {
            $fm .=
"<b><font color='green'>&bull;</font> IP $ip is in <a href='./#acceptAllMail'>Accept All Mail</a> ($ret)</b><br />\n";
          }
        if ( $ret = matchIP( $ip, 'ispip', 0, 1 ) ) {
            $fm .=
"<b><font color='green'>&bull;</font> IP $ip is in <a href='./#ispip'>ISP/Secondary MX Servers</a> ($ret)</b><br />\n";
          }

        $tmpfh = time;
        $Con{$tmpfh} = {};
        $Con{$tmpfh}->{rcpt} = join(' ', keys %to);
        if ( $ret = matchIP( $ip, 'noDelay', $tmpfh, 1 ) ) {
            my $f = ($lastREmatch) ? " for $lastREmatch" : '';
            $fm .=
"<b><font color='green'>&bull;</font> IP $ip is in <a href='./#noDelay'>noDelay</a>$f ($ret)</b><br />\n";
        }
        foreach my $iip (@sips) {
            if ( $ret = matchIP( $iip, 'noBlockingIPs', $tmpfh, 1 ) ) {
                my $f = ($lastREmatch) ? " for $lastREmatch" : '';
                $fm .=
"<b><font color='green'>&bull;</font> IP $iip is in <a href='./#noBlockingIPs'>noBlockingIPs</a>$f ($ret)</b><br />\n";
            }
        }
        foreach my $iip (@sips) {
            if ( $ret = matchIP( $iip, 'denySMTPConnectionsFrom', $tmpfh, 1 ) ) {
                my $f = ($lastREmatch) ? " for $lastREmatch" : '';
                $fm .=
"<b><font color='red'>&bull;</font> IP $iip is in <a href='./#denySMTPConnectionsFrom'>denySMTPConnectionsFrom</a>$f ($ret)</b><br />\n";
            }
        }
        delete $Con{$tmpfh};

        foreach my $iip (@sips) {
            if ( $ret = matchIP( $iip, 'denySMTPConnectionsFromAlways', 0, 1 ) ) {
                $fm .=
"<b><font color='red'>&bull;</font> IP $iip is in <a href='./#denySMTPConnectionsFromAlways'>denySMTPConnectionsFromAlways</a>($ret)</b><br />\n";
            }
        }
        foreach my $iip (@sips) {
            if ( $ret = matchIP( $iip, 'droplist', 0, 1 ) ) {
                $fm .=
"<b><font color='red'>&bull;</font> IP $iip is in <a href='./#droplist'>droplist</a>($ret)</b><br />\n";
            }
        }
        my @t;
        my $v;
		if (exists $Griplist{$ip3}) {
		    if ($ip !~ /$IPprivate/o) {
			    $v = $Griplist{$ip3};
			    $v = 0.01 if !$v;
			    $v = 0.99 if  $v == 1;
			}
		} else {
    		$v = 0.8 if $ip && $ip !~ /$IPprivate/o;
    	}
    	if ($griplist && ( !$mystatus ||  $mystatus eq "ip" )) {
            if ( $ispip  && matchIP( $ip, 'ispip', 0, 1 ) ) {
            	if ($ispgripvalue ne '') {
                    $v = $ispgripvalue;
                } else {
                    $v=$Griplist{x};
                }
            }

            $fm .= "<b><font color='gray'>&bull;</font> $ip3 has a Griplist value of $v</b><br />\n" if $v;

    	}

        if (! $qs{return}) {
            $fm =~ s/($IPRe)/my$e=$1;($e!~$IPprivate)?"<a href=\"javascript:void(0);\" title=\"take an action on that IP\" onclick=\"popIPAction('$1');return false;\">$1<\/a>":$e;/goe;
            $fm =~ s/(')?($EmailAdrRe?\@$EmailDomainRe)(')?/"<a href=\"javascript:void(0);\" title=\"take an action on that address\" onclick=\"popAddressAction('".&encHTMLent($2)."');return false;\">".&encHTMLent($1.$2.$3)."<\/a>";/goe;
        } else {
            $fm =~ s/<a href[^>]+>|<\/a>//go;
        }
        
        # Unicode Analyzes processing
        eval {
            $fm .= "<br /><hr><br />";
            $fm .= "<b><font size='3' color='#003366'>Unicode Analysis:</font></b><br /><br />";
            $fm .= '<b>the following non symbolic unicode blocks (except InBasicLatin) were found:</b><br /><br />';

            my @tempfm;
            my $email = $mail;
            Encode::_utf8_on($email);
            foreach (@NonSymLangs) {
                next if $_ eq 'InBasicLatin';
                if ($email =~ /(\p{$_}{1,20})/s) {
                    my $r = $1;
                    my $u;
                    eval {$u = join(',', map{sprintf("U+%2.2x", unpack("U0U*",$_))} split(//,$r));};
                    Encode::_utf8_off($r);
                    $r = assp_encode_Q($r) if $qs{return};
                    push @tempfm , ($_ , $r, uc($u));
                }
            }
            if (@tempfm) {
                $fm .= "<table cellspacing='0' cellpadding='0'>\n";
                $fm.= '<tr><th>Unicode Block : </th><th>example'."</th></tr>\n";
                while (@tempfm) {
                    $fm.= '<tr><td>'.shift(@tempfm).'</td><td>'.shift(@tempfm).'</td><td>'.shift(@tempfm)."</td></tr>\n";
                }
                $fm .= "</table>\n";
            }
            @tempfm = ();
            $fm .= '<br />';
            $fm .= '<b>the following symbolic unicode blocks were found:</b><br /><br />';
            foreach (@SymLangs) {
                if ($email =~ /(\p{$_}{1,20})/s) {
                    my $r = $1;
                    my $u;
                    eval {$u = join(',', map{sprintf("U+%2.2x", unpack("U0U*",$_))} split(//,$r));};
                    Encode::_utf8_off($r);
                    $r = assp_encode_Q($r) if $qs{return};
                    push @tempfm , ($_ , $r, uc($u));
                }
            }
            if (@tempfm) {
                $fm .= "<table cellspacing='0' cellpadding='0'>\n";
                $fm.= '<tr><th>Unicode Block : </th><th>example'."</th></tr>\n";
                while (@tempfm) {
                    $fm.= '<tr><td>'.shift(@tempfm).'</td><td>'.shift(@tempfm).'</td><td>'.shift(@tempfm)."</td></tr>\n";
                }
                $fm .= "</table>\n";
            }
            @tempfm = ();
            $fm .= '<br />';
            $fm .= '<b>the following unicode scripts were found except(Common + Latin):</b><br /><br />';
            foreach (@UniCodeScripts) {
                next if $_ eq 'Common';
                next if $_ eq 'Latin';
                if ($email =~ /(\p{$_}{1,20})/s) {
                    my $r = $1;
                    my $u;
                    eval {$u = join(',', map{sprintf("U+%2.2x", unpack("U0U*",$_))} split(//,$r));};
                    Encode::_utf8_off($r);
                    $r = assp_encode_Q($r) if $qs{return};
                    push @tempfm , ($_ , $r, uc($u));
                }
            }
            if (@tempfm) {
                $fm .= "<table cellspacing='0' cellpadding='0'>\n";
                $fm.= '<tr><th>Unicode Script : </th><th>example'."</th><th>example unicode points</th></tr>\n";
                while (@tempfm) {
                    $fm.= '<tr><td>'.shift(@tempfm).'</td><td>'.shift(@tempfm).'</td><td>'.shift(@tempfm)."</td></tr>\n";
                }
                $fm .= "</table>\n";
            }
        } if($] ge '5.012000');

        $fm .= "<br /><hr><br />";
        my ($ar,$got);
        if (! $lockBayes) {
            ($ar,$got) = BayesWords(\$mail,$reportedBy);
            push(@t, @$ar);
        } else {
            $got = {};
        }
        
        if ($obfuscatedip)     {push(@t,$URIBLaddWeight{obfuscatedip}); $got->{'URIBL-Obfuscated IP'} = $URIBLaddWeight{obfuscatedip};}
        if ($obfuscateduri)    {push(@t,$URIBLaddWeight{obfuscateduri}); $got->{'URIBL-Obfuscated URI'} = $URIBLaddWeight{obfuscateduri};}
        if ($maximumuniqueuri) {push(@t,$URIBLaddWeight{maximumuniqueuri}); $got->{'URIBL-Maximum(unique) URI'} = $URIBLaddWeight{maximumuniqueuri};}
        if ($maximumuri)       {push(@t,$URIBLaddWeight{maximumuri}); $got->{'URIBL-Maximum URI'} = $URIBLaddWeight{maximumuri};}

        if (!$mystatus) {
            my $bayestext;
            $bayestext = "<font color='red'>&bull; Bayesian Check is disabled</font>" if !$DoBayesian;
            $bayestext .= ' - word stemming engine is used' if eval{$ASSP_WordStem::VERSION;};
            $bayestext .= ' - language '.$ASSP_WordStem::last_lang_detect.' detected' if eval{$ASSP_WordStem::last_lang_detect};
            $bayestext .= "<br /><font color='red'>&bull;</font> <b>Spamdb</b> has version: <b>$currentDBVersion{Spamdb}</b> - required version: <b>$requiredDBVersion{Spamdb}</b> !" if $currentDBVersion{Spamdb} ne $requiredDBVersion{Spamdb} && ! ($ignoreDBVersionMissMatch & 1);
            $ba .=
"<b><font size='3' color='#003366'>Bayesian Analysis: $bayestext</font></b><br /><br /><table cellspacing='0' cellpadding='0'>";
            $ba .= "<tr>
<td style=\"padding-left:5px; padding-right:5px; padding-top:5; padding-bottom:5; text-align:right; font-size:small;\"><b>Bad Words</b></td>
<td style=\"padding-left:5px; padding-right:5px; padding-top:5; padding-bottom:5; text-align:left; font-size:small; background-color:#F4F4F4\"><b>Bad Prob&nbsp;</b></td>
<td style=\"padding-left:20px; padding-right:5px; padding-top:5; padding-bottom:5; text-align:right; font-size:small;\"><b>Good Words</b></td>
<td style=\"padding-left:5px; padding-right:5px; padding-top:5; padding-bottom:5; text-align:left; font-size:small; background-color:#F4F4F4\"><b>Good Prob</b></td>
</tr>\n";
            my $bcount = 0;
            foreach (sort { abs( $got->{$main::b} - .5 ) <=> abs( $got->{$main::a} - .5 ) } keys %{$got} ) {
                last if ++$bcount > $maxBayesValues;
                my $g = sprintf( "%.4f", $got->{$_} );
                s/[<>]//go;
                s/[a-f0-9]{24}/[addr]/go;
                $_ = encodeHTMLEntities($_) unless $qs{return};
                s/^(private:|domain:)/<b>$1<\/b>/o;
                if ( $g < 0.5 ) {
                    $ba .= "<tr>
<td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:right; font-size:small;\">&nbsp;</td>
<td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:left; font-size:small; background-color:#F4F4F4\">&nbsp;</td>
<td style=\"padding-left:20px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:right; font-size:small;\">$_</td>
<td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:left; font-size:small; background-color:#F4F4F4\">$g</td>
</tr>\n";
                } else {
                    $ba .= "<tr>
<td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:right; font-size:small;\">$_</td>
<td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:left; font-size:small; background-color:#F4F4F4\">$g</td>
<td style=\"padding-left:20px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:right; font-size:small;\">&nbsp;</td>
<td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:left; font-size:small; background-color:#F4F4F4\">&nbsp;</td>
</tr>\n";
                }
            }
            $ba .= "</td></tr></table>\n";
            my $bc = scalar @t;
            my $bcm = $bc > $maxBayesValues ? $maxBayesValues : $bc;
            @t  = sort { abs( $main::b - .5 ) <=> abs( $main::a - .5 ) } @t;
            @t  = @t[ 0 .. ($maxBayesValues - 1) ];
            my ($p1, $p2, $c1, $SpamProb, $SpamProbConfidence) = BayesHMMProb(\@t);
            my $hmmprob; my $hmmconf;

            if ($DoHMM) {
                my $tmpfh = time;
                $Con{$tmpfh} = {};
                $Con{$tmpfh}->{rcpt} = $reportedBy;
                &HMMOK_Run($tmpfh,\$mail);
                $hmmprob = $Con{$tmpfh}->{hmmprob};
                $hmmconf = $Con{$tmpfh}->{hmmconf};
                my $hmmres = ($Con{$tmpfh}->{hmmres} > $maxBayesValues) ? $maxBayesValues : $Con{$tmpfh}->{hmmres};
                if (defined $hmmprob) {
                    $hmmprob = sprintf("%.4f - got %d - used %d most significant results",$hmmprob,$Con{$tmpfh}->{hmmres},$hmmres);
                } elsif ($lockHMM) {
                    $hmmprob = 'got no result because the HMM database is locked by a rebuildspamdb task';
                } elsif (! $haveHMM) {
                    $hmmprob = 'got no result because the HMM database is empty';
                } else {
                    $hmmprob = 'got no result';
                }

                $ba .= "<hr><br /><b><font size='3' color='#003366'>HMM Analysis:</font></b>";
                $ba .= "<br /><font color='red'>&bull;</font> <b>HMMdb</b> has version: <b>$currentDBVersion{HMMdb}</b> - required version: <b>$requiredDBVersion{HMMdb}</b> !" if $currentDBVersion{HMMdb} ne $requiredDBVersion{HMMdb} && ! ($ignoreDBVersionMissMatch & 2);

                $ba .= "<br /><br /><table cellspacing='0' cellpadding='0'>
<tr>
<td style=\"padding-left:5px; padding-right:5px; padding-top:5; padding-bottom:5; text-align:right; font-size:small;\"><b>Bad Sequences</b></td>
<td style=\"padding-left:5px; padding-right:5px; padding-top:5; padding-bottom:5; text-align:left; font-size:small; background-color:#F4F4F4\"><b>Bad Prob&nbsp;</b></td>
<td style=\"padding-left:20px; padding-right:5px; padding-top:5; padding-bottom:5; text-align:right; font-size:small;\"><b>Good Sequences</b></td>
<td style=\"padding-left:5px; padding-right:5px; padding-top:5; padding-bottom:5; text-align:left; font-size:small; background-color:#F4F4F4\"><b>Good Prob</b></td>
</tr>\n";

                my $bcount = 0;
                foreach (sort { abs( ${$Con{$tmpfh}->{hmmValues}}{$main::b} - .5 ) <=> abs( ${$Con{$tmpfh}->{hmmValues}}{$main::a} - .5 ) } keys %{$Con{$tmpfh}->{hmmValues}} ) {
                    last if ++$bcount > $maxBayesValues;
                    my $g = sprintf( "%.4f", ${$Con{$tmpfh}->{hmmValues}}{$_} );
                    s/[<>]//go;
                    s/[a-f0-9]{24}/[addr]/go;
                    $_ = encodeHTMLEntities($_) unless $qs{return};
                    s/^(private:|domain:)/<b>$1<\/b>/o;
                    if ( $g < 0.5 ) {
                        $ba .= "<tr>
<td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:right; font-size:small;\">&nbsp;</td>
<td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:left; font-size:small; background-color:#F4F4F4\">&nbsp;</td>
<td style=\"padding-left:20px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:right; font-size:small;\">$_</td>
<td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:left; font-size:small; background-color:#F4F4F4\">$g</td>
</tr>\n";
                    } else {
                        $ba .= "<tr>
<td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:right; font-size:small;\">$_</td>
<td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:left; font-size:small; background-color:#F4F4F4\">$g</td>
<td style=\"padding-left:20px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:right; font-size:small;\">&nbsp;</td>
<td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:left; font-size:small; background-color:#F4F4F4\">&nbsp;</td>
</tr>\n";
                    }
                }

                $ba .= "</td></tr></table>\n";
                %{$Con{$tmpfh}->{hmmValues}}=();
                delete $Con{$tmpfh};
            }
            @HmmBayWords = ();
            $haveSpamdb = getDBCount('Spamdb','spamdb') unless $haveSpamdb;
            $st .= "<br /><hr><br />";
            $st .=
"<b>The Bayesian database 'spamdb' is still unavailable, because it is locked by a rebuildspamdb task.</b><br /><br />" if $lockBayes;
            $st .=
"<b>The Bayesian database 'spamdb' is still unavailable, because it is empty.</b><br /><br />" if ! $haveSpamdb;
            $st .=
"<b><font size=\"3\" color=\"#003366\">Bayesian Spam Probability:</font></b><br /><br />\n<table cellspacing=\"0\" cellpadding=\"0\">";
            if ($baysConf) {
                $st .= sprintf(
" <tr><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:right; font-size:small;\"><b>spamprobability</b>:</td><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; font-size:small;\">%.8f</td></tr>\n",
                $p1 );
                $st .= sprintf(
" <tr><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:right; font-size:small;\"><b>hamprobability</b>:</td><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; font-size:small;\">%.8f</td></tr>\n",
                $p2 );
                $st .= sprintf(
" <tr><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:right; font-size:small;\"><b>combined probability</b>:</td><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; font-size:small;\">%.8f - got %d - used %d most significant results</td></tr>\n",
                $SpamProb,$bc,$bcm );
                $st .= sprintf(
" <tr><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:right; font-size:small;\"><b>bayesian confidence</b>:</td><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; font-size:small;\">%.8f</td></tr>\n",
                $SpamProbConfidence );
                $st .= sprintf(
" <tr><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:right; font-size:small;\"><b>corpus confidence</b>:</td><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; font-size:small;\">%.8f</td></tr>\n",
                BayesConfNorm());
            } else {
                $st .= sprintf(
" <tr><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:right; font-size:small;\"><b>combined probability</b>:</td><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; font-size:small;\">%.8f - got %d - used %d most significant results</td></tr>\n",
                $SpamProb,$bc,$maxBayesValues );
            }
            if ($DoHMM) {
                $st .= "</table>\n";
                my $prob = $baysConf ? 'Probabilities' : 'Probability';
                $st .=
"<br /><hr><br /><b><font size=\"3\" color=\"#003366\">Hidden-Markov-Model Spam $prob:</font></b><br /><br />\n<table cellspacing=\"0\" cellpadding=\"0\">";
                $st .=
" <tr><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:right; font-size:small;\"><b>combined HMM spam probability</b>:</td><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; font-size:small;\">$hmmprob</td></tr>\n";
                $st .= sprintf(
" <tr><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:right; font-size:small;\"><b>HMM confidence</b>:</td><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; font-size:small;\">%.8f</td></tr>\n",
                $hmmconf ) if $baysConf;
                $st .= sprintf(
" <tr><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; text-align:right; font-size:small;\"><b>corpus confidence</b>:</td><td style=\"padding-left:5px; padding-right:5px; padding-top:0; padding-bottom:0; font-size:small;\">%.8f</td></tr>\n",
                BayesConfNorm()) if $baysConf;
            }
 		}
        $st .= " </table><br /></div><br />";
TRANSLITONLY:
        unless ($mystatus) {
            $mail =~ s/<\s*\/\s*textarea\s*>/textarea/igo;
            $mail =~ s/<\s*\/?[^>]+>//gos;
            $mail =~ s/([^\n]{70,84}[^\w\n<\@])/$1\n/go;
            $mail =~ s/\s*\n+/\n/go;
            $mail =~ s/<|>//gos;
        }
      }
      
      $mail = $orgmail if $mystatus;
      $mail =~ s/\r//gos;
      my $h1 = $WebIP{$ActWebSess}->{lng}->{'msg500060'} || $lngmsg{'msg500060'};
      my $h2 = $WebIP{$ActWebSess}->{lng}->{'msg500061'} || $lngmsg{'msg500061'};
      my $h3 = $WebIP{$ActWebSess}->{lng}->{'msg500062'} || $lngmsg{'msg500062'};
      my $h4 = $WebIP{$ActWebSess}->{lng}->{'msg500063'} || $lngmsg{'msg500063'};

      if ($qs{return}) {
          $qs{sub} = $sub;
          return <<EOT;
$fm$ba$st
EOT
      }
      my $trena = $DoTransliterate ? undef: ' (DoTransliterate is still switched off)';
      my $checked = $qs{translit} ? 'checked="checked"' : '';
      my $translit = $CanUseTextUnidecode
         ? <<EOT
<tr>
   <td class="noBorder">&nbsp;<input type="checkbox" name="translit" value="1" $checked/>&nbsp; transliterate the text to ASCII only$trena</td>
</tr>
EOT
         : undef
         ;
      return <<EOT;
$headerHTTP
$headerDTDTransitional
$headers
<script type="text/javascript">
//<![CDATA[
function getInput() { return document.getElementById("mail").value; }
function setOutput(string) {document.getElementById("mail").value=string; }

function replaceIt() { try {
var findText = document.getElementById("find").value;
var replaceText = document.getElementById("replace").value;
setOutput(getInput().replace(eval("/"+findText+"/ig"), replaceText));
} catch(e){}}

//-->
//]]>
</script>
<div id="cfgdiv" class="content">
<h2>ASSP Mail Analyzer</h2>
<div class="note">$h1
</div><br />
$fm$ba$st
<form action="" method="post">
    <table class="textBox">
        <tr>
            <td >
             <span style="float: left">Replace: <input type="text" id="find" size="20" /> with <input type="text" id="replace" size="20" /> <input type="button" value="Replace" onclick="replaceIt();" /></span>
            </td >
        </tr>
        <tr>
            <td class="noBorder" align="center">$h2<br />
            <textarea id="mail" name="mail" rows="10" cols="60" wrap="off">$mail</textarea>
            </td>
        </tr>
        $translit
        <tr>
            <td class="noBorder" align="center"><input type="submit" name="B1" value=" Analyze " /></td>
        </tr>
    </table>
</form>
<br />
<p class="note" ><small>$h3
<div class="textbox">
$h4</small></p>

</div>
</div>

$footers
<form name="ASSPconfig" id="ASSPconfig" action="" method="post">
  <input name="theButtonLogout" type="hidden" value="" />
</form>
</body></html>
EOT
}

sub cleanincFound {
    my $i = shift;
    $i =~ s/\<[^\>]+\>//go;
    return $i;
}

sub AnalyzeText {
    my $fh = shift;
    my $this = $Con{$fh};
    my $mail = $this->{header};
    $mail =~ s/^.*?\n[\r\n\s]+//so;
    my %sqs = %qs;
    %qs = ();
    $qs{mail} = $mail;
    $qs{return} = 1;
    my $res = &ConfigAnalyze();
    my $sub = $qs{sub};
    my $style;
    my $fil = "$base/images/assp.css";
    if($open->(my $GF,'<',$fil)) {
        $GF->binmode;
        $GF->read($style,[$stat->($fil)]->[7]);
        $GF->close;
    }
    $this->{report} .= <<EOT;
<!DOCTYPE HTML PUBLIC "-//W3C//DTD HTML 4.01//EN"
  "http://www.w3.org/TR/html4/loose.dtd">
<html>
<head>
<meta http-equiv="content-type" content="text/html; charset=utf-8" />
<title>ASSP Analyze from $myName</title>
<style type="text/css">
$style
.content {
	margin: 5px 0 0 0;
}
</style>
</head>
<body>
<div class="content">
<br /><hr><br />
<h2>ASSP Mail Analyzer on $myName</h2>
<hr><br />
$res
</div>
</body>
</head>
</html>

EOT
    %qs = %sqs;
    return $sub;
}

sub needEs {
 my ($count,$text,$es)=@_;
 return $count . $text . ($count==1 ? '' : $es);
}

sub encodeHTMLEntities {
 my $s=shift;
 $s=~s/\&/\&amp;/gso;
 $s=~s/\</\&lt;/gso;
 $s=~s/\>/\&gt;/gso;
 $s=~s/\"/\&quot;/gso;
 return $s;
}

sub decodeHTMLEntities {
 my $s=shift;
 $s=~s/\&quot;?/\"/giso;
 $s=~s/\&gt;?/\>/giso;
 $s=~s/\&lt;?/\</giso;
 $s=~s/\&amp;?/\&/giso;
 return $s;
}

sub encHTMLent {
    my $sh = shift;
    my $s = ref $sh ? $$sh : $sh;
    my $ret;
    eval{$ret = ($s ? &HTML::Entities::encode($s) : '');};
    if ($@) { # do what we can if HTML::Entities failes
         mlog(0,"warning: an error occured in encoding HTML-Entities - $@");
         $ret = encodeHTMLEntities($s);
    }
    return $ret ? $ret : $$s;
}

sub decHTMLent {
    my $sh = shift;
    my $s = ref $sh ? $$sh : $sh;
    my $ret;

    $s =~ s/\&nbsp;?/ /gosi;  # decode &nbsp; to space not to \160
    $s =~ s/\&shy;?/-/gosi;   # decode &shy; to '-' not to \173

    $s =~ s/\&\#(\d+);?/&decHTMLentHD($1)/geo;
    $s =~ s/\&\#x([a-f0-9]+);?/&decHTMLentHD($1,'hex')/geio;
    $s =~ s/([^\\])?\\(\d{1,3});?/$1.&decHTMLentHD($2,'oct')/geio;
    $s =~ s/([^\\])?[%=]([a-f0-9]{2});?/$1.&decHTMLentHD($2,'hex')/gieo;

    my $e = $@;   #local $@ = undef; was not working on perl 5.12
    eval{$ret = &HTML::Entities::decode($s);} if $s;
    if ($@) { # do what we can if HTML::Entities fails
         mlog(0,"warning: an error occured in decoding HTML-Entities - $@");
         $ret = decodeHTMLEntities($s);
    }
    $@ = $e;
    return $ret ? $ret : $s;
}

sub decHTMLentHD {
    my ($s, $how) = @_;
    eval('
    if (defined *{\'yield\'}) {
    $s = chr(($how eq \'hex\')?hex($s):($how eq \'oct\')?oct($s):$s);
    use bytes;
    $s =~ s/^(?:\xA1[\x43\x44\x4F]|\xE3\x80\x82|\xEF(?:\xBC\x8E|\xB9\x92)|\xDB\x94)$/./go;  #Big5 Chinese language character set (.)
    $s =~ s/^\xA0$/ /gosi;  # decode to space not to \160
    $s =~ s/^\xAD$/-/gosi;  # decode to - not to \173
    } no bytes;');
    return $s;
}

sub normHTML {
    my $s = shift;
    $s =~ s/([^a-zA-Z0-9])/sprintf("%%%02X", ord($1))/eog;
    return $s;
}

sub normHTMLfile {
    my $s = shift;
    $s =~ s/([^\w\-.!~*\'() ])/sprintf("%%%02X",ord($1))/ego;
    $s =~ s/ /+/go;
    return $s;
}

sub ConfigMaillog {
 my $stime = time;
 my $loopcount;
 my $loopcheck = 10;
 my $maxsearchsec = 60;
 my $maxsearchtime = $stime + $maxsearchsec;
 my $pat=$qs{search};
 my $matches=0;
 my $currWrap;
 if (exists $qs{wrap}) {
    $currWrap = $qs{wrap};
 } elsif ($WebIP{$ActWebSess}->{user} ne 'root') {
    $currWrap = $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.wrap"};
 } elsif ( ! $currWrap) {
    $currWrap = 2;
 }
 $currWrap = 2 unless $currWrap;
 $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.wrap"} = $currWrap if $WebIP{$ActWebSess}->{user} ne 'root';
 &niceConfig() if ($qs{autorefresh} ne 'Auto' && !$qs{filesonly});
 
 my $colorLines;
 if (exists $qs{color}) {
    $colorLines = $qs{color};
 } elsif ($WebIP{$ActWebSess}->{user} ne 'root') {
    $colorLines = $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.color"};
 } elsif ( ! $colorLines) {
    $colorLines = 1;
 }
 $colorLines = 1 unless $colorLines;
 $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.color"} = $colorLines if $WebIP{$ActWebSess}->{user} ne 'root';

 my $order;
 if (exists $qs{order}) {
    $order = $qs{order};
 } elsif ($WebIP{$ActWebSess}->{user} ne 'root') {
    $order = $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.order"};
 } elsif ( ! $order) {
    $order = 0;
 }
 $order = 0 unless $order;
 $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.order"} = $order if $WebIP{$ActWebSess}->{user} ne 'root';

 my $savTailByte = $MaillogTailBytes;
 my $currTailByte; $currTailByte = $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.TailByte"} if $WebIP{$ActWebSess}->{user} ne 'root';
 ($currTailByte) = $1 if $qs{tailbyte}=~/(\d+)/;
 $currTailByte = $MaillogTailBytes if ($MaillogTailBytes>0 && (! $currTailByte || $currTailByte<160));
 $currTailByte = 2000 unless $currTailByte;
 $MaillogTailBytes = $currTailByte;
 $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.TailByte"} = $currTailByte if $WebIP{$ActWebSess}->{user} ne 'root';

 my $orgpat = $pat;
 my $filesonly=$qs{filesonly};
 my $autoJS = '';
 my $autoButton = 'Auto';
 my $CMheaders = \$headers;
 my $content = 'class="content"';
 my $logstyle = '';
 my $display = '';
 $pat = $qs{search} = '' if $qs{autorefresh} eq 'Stop';
 if ($qs{autorefresh} eq 'Auto') {
     $pat = '';
     $qs{filesonly}= $filesonly = '';
     $qs{nohighlight} = 1;
     $autoButton = 'Stop';
     $CMheaders = \'';
     $display = 'style="display:none"';
     $content = 'class="content" style="margin: 0 0 0 0;"';
     $logstyle = 'style="border-width: 4px 4px 4px 4px; border-color: #6699cc; border-style: solid;"';

     $autoJS = '
<script type="text/javascript">
 Timer=setTimeout("newTimer();",'. $refreshWait .'000);
 var Run = 1;
 function noop () {}
 function tStart () {
    Run = 1;
 }
 function tStop () {
    Run = 0;
    Timer=setTimeout("noop();", 1000);
 }
 function newTimer() {
   if (Run == 1) {location.reload(true)};
   Timer=setTimeout("newTimer();",'. $refreshWait .'000);
 }
</script>
';
#  <meta http-equiv=\"refresh\" content=\"$refreshWait;url=/maillog?search=\&wrap=$qs{wrap}\&color=$colorLines\&autorefresh=Auto\&files=$qs{files}\&limit=$qs{limit}\&nohighlight=$qs{nohighlight}\&nocontext=$qs{nocontext}\&tailbyte=$qs{tailbyte}\&size=$qs{size}\&order=$qs{order}\" />

     $CMheaders = \"<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">
<head>
  <meta http-equiv=\"content-type\" content=\"application/xhtml+xml; charset=utf-8\" />
  <title>$currentPage ASSP ($myName) Host: $localhostname @ $localhostip</title>
  <link rel=\"stylesheet\" href=\"get?file=images/assp.css\" type=\"text/css\" />
  <link rel=\"shortcut icon\" href=\"get?file=images/favicon.ico\" />
$autoJS
</head>
<body onfocus=\"tStart();\" onblur=\"tStop();\"><a name=\"MlTop\"></a>
";
 }
 my $rspamlog = "rebuild_error/$spamlog";
 my $rnotspamlog = "rebuild_error/$notspamlog";
 my $rcorrectedspam = "rebuild_error/$correctedspam";
 my $rcorrectednotspam = "rebuild_error/$correctednotspam";
 my $s='';
 my $res='';
 my $base = $base;
 $base =~ s/([^\\])\\([^\\])/$1\\\\$2/go;
 # calculate indent
 my $m = &timestring().' ';
 my $resetpat;
 my $reportExt = $maillogExt;
 if(!$pat && $filesonly) {
     $resetpat = 1;
     $pat = $maillogExt;
 }
 if(!$pat) {
  my $TailBytes = ($qs{autorefresh} eq 'Auto' && $MaillogTailBytes > 2000) ? 2000 : $MaillogTailBytes;
  if ($qs{autorefresh} eq 'Auto') {
      my $sl; $sl = $1 if $qs{search} =~ /(\d+)/o;
      $sl = $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.autolines"} if $sl == '' && $WebIP{$ActWebSess}->{user} ne 'root';
      my $al = $sl ? 33 - $sl : $currWrap ? 10 : 0;
      $al = 0 if $al < 0;
      $al = 32 if $al > 32;
      $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.autolines"} = $sl if $WebIP{$ActWebSess}->{user} ne 'root';
      for (my $i = $al; $i < 33; $i++) {
          $s .= $RealTimeLog[$i];
      }
  } else {
      open(my $CML,'<',"$base/$logfile");
      seek($CML,-$TailBytes,2) || seek($CML,0,0);
      local $/;
      $s=<$CML>;
      close $CML;
  }
  $s=encodeHTMLEntities($s) if $s;
  $s=~s/([^\\])?\\([^\\])?/$1\\\\$2/gso;
   my @sary=map{$_."\n" if $_;} split(/\r?\n|\r/o,$s);
   shift @sary if ($qs{autorefresh} ne 'Auto');
   my @rary;
   $matches=0;
   while (@sary) {
    $_ = shift @sary;
    @sary = () if time > $maxsearchtime;
    s/\\x\{\d+\}//g;
    if ($qs{autorefresh} ne 'Auto') {
     $maxsearchtime += &MainLoop1(0) unless ++$loopcount % $loopcheck;
     if (/(.*)?($base\/(($spamlog|$discarded|$notspamlog|$incomingOkMail|$viruslog|$correctedspam|$correctednotspam|$resendmail|$rspamlog|$rnotspamlog|$rcorrectedspam|$rcorrectednotspam)\/[^\s]+(?:\Q$maillogExt\E|$reportExt)))(.*)/)
     {
         my $text = $1;
         my $file = $2;
         my $hfile = $3;
         my $dname = $4;
         my $text2 = $5;
         my $span = ($dname =~ /^(?:$spamlog|$discarded|$viruslog|$correctedspam|$rspamlog|$rcorrectedspam)$/) ? 'negative' : 'positive';
         $span = 'spampassed' if /\[spam passed\]/gio;
         $text =~ s/([^ ]+) +/<span style="white-space:nowrap;">$1<\/span> /go;
         $text2 =~ s/([^ ]+) +/<span style="white-space:nowrap;">$1<\/span> /go;
         if (&existFile($file)) {
           $hfile = "<span style=\"white-space:nowrap;\" onclick=\"popFileEditor('" . &normHTML($hfile) . "','m');\" class=\"" . $span . "\" onmouseover=\"fileBG=this.style.backgroundColor; this.style.backgroundColor='#BBBBFF';\" onmouseout=\"this.style.backgroundColor=fileBG;\"><b>" . $hfile . "<\/b><\/span>";
         } else {
           $hfile =~ s/([^ ]+) +/<span style="white-space:nowrap;">$1<\/span> /go;
         }
         $text .= $hfile . $text2;
         push(@rary,'<div id="ll' . $matches .'" class="assplogline'. ($currWrap + ($matches % 2 && $colorLines)) .'">' . $text . "\n</div>");
         $matches++;
         next;
     } elsif (! $filesonly) {
         my @links;
         my @addr;
         my @ips;
         $_ = niceLink($_);
         while ($_ =~ s/(\<a href.*?<\/a\>)/XXXIIIXXX/o) {
             my $link = $1;
             $link =~ s/WIDTH=[^\d]*(\d+\%)[^ ]*/WIDTH=$1/io;
             push @links,$link;
         }
         if (&canUserDo($WebIP{$ActWebSess}->{user},'action','addraction')) {
             while ($_ =~ s/((?<!Message-ID found: ))($EmailAdrRe\@$EmailDomainRe)/$1XXXAIIIDXXX/o) {
                 push @addr ,
                    "<span style=\"white-space:nowrap;\" onclick=\"popAddressAction('"
                    . &normHTML($2)
                    . "');\" class=\"menuLevel2\" onmouseover=\"fileBG=this.style.backgroundColor; this.style.backgroundColor='#BBBBFF';\" onmouseout=\"this.style.backgroundColor=fileBG;\"><b>"
                    . $2
                    . "<\/b><\/span>";
             }
         }
         if (&canUserDo($WebIP{$ActWebSess}->{user},'action','ipaction')) {
             while ($_ =~ s/($IPRe)([^:\d\/])/XXXiIIIpXXX$2/o) {
                 my  $ip = $1;
                 if (   $ip !~ /$IPprivate/o
                     && $ip ne $localhostip
                     && $ip !~ /$LHNRE/)
                 {
                     push @ips,
                        "<span style=\"white-space:nowrap;\" onclick=\"popIPAction('"
                        . &normHTML($ip)
                        . "');\" class=\"menuLevel2\" onmouseover=\"fileBG=this.style.backgroundColor; this.style.backgroundColor='#BBBBFF';\" onmouseout=\"this.style.backgroundColor=fileBG;\"><b>"
                        . $ip
                        . "<\/b><\/span>";
                 } else {
                     push @ips, $ip;
                 }
             }
         }
         s/([^ ]+) +/<span style="white-space:nowrap;">$1<\/span> /go;
         if (@links) {
             s/XXXIIIXXX/shift(@links)/geo;
         }
         if (@addr) {
             s/XXXAIIIDXXX/shift(@addr)/geo;
         }
         if (@ips) {
             s/XXXiIIIpXXX/shift(@ips)/geo;
         }
     }
     if ($filesonly) {
         next;
     }
    }
    push(@rary,'<div id="ll' . $matches .'" class="assplogline'. ($currWrap + ($matches % 2 && $colorLines)) .'">' . $_ . "\n</div>");
    $matches++;
   }
   $s = join('',@rary);
   $s =~ s/"/\\"/go;
   $s =~ s/\n+<\/div>/<\/div>XXXIIIXXX/go;
   $s =~ s/\r|\n//go;
   $s =~ s/XXXIIIXXX$//o;
 } elsif ($CanSearchLogs) {
  my @sary;
  $matches=0;
  my $lines=0;
  my $files=0;
  my ($logdir, $logdirfile) = $logfile=~/^(.*[\/\\])?(.*?)$/o;
  my @logfiles1=reverse sort( Glob("$base/$logdir*$logdirfile"));
  my @logfiles;
  while (@logfiles1) {
      my $k = shift @logfiles1;
      push(@logfiles, $k) if $k !~ /b$logdirfile/;
  }
  my $maxmatches =
                $qs{limit} eq '2000' ? 2000
              : $qs{limit} eq '1000' ? 1000
              : $qs{limit} eq '100'  ? 100
              : $qs{limit} eq '10'   ? 10
              : $qs{limit} eq '1'    ? 1
              :                        0;
  my $maxlines;
  my $maxfiles;
  if ($qs{files} eq 'lines') {
      ($maxlines) = $qs{size} =~ /(\d+)/o;
      $maxlines = 10000 unless $maxlines;
      $maxfiles = 0;
  } elsif ($qs{files} eq 'files') {
      ($maxfiles) = $qs{size} =~ /(\d+)/o;
      $maxfiles = 2 unless $maxfiles;
      $maxlines = 0;
  } elsif ($qs{files} eq 'ago') {
      $maxfiles = $qs{size};
      $maxfiles =~ s/\s//go;
      $maxfiles =~ s/-/.../go;
      my @num = sort {$main::a <=> $main::b} map(eval($_),split(/,/, $maxfiles));
      @num = (1) unless $maxfiles or @num;
      my @lof = @logfiles;
      @logfiles = ();
      foreach (@num) {
          push(@logfiles , $lof[$_ - 1]) if $_ > 0 && $lof[$_ - 1];
      }
      push(@logfiles,$lof[0]) unless @logfiles;
      $maxlines = 0;
  } else {
      $maxlines = 0;
      $maxfiles = 0;
  }
  my $logf=File::ReadBackwards->new(shift(@logfiles),'(?:\r?\n|\r)',1); # line terminator regex
  if ($logf) {
   $files++;

#   $pat = &encHTMLent(\$pat);
#   $pat = encodeHTMLEntities($pat);
#   $pat=~s/([^\\])?\\([^\\])?/$1\\\\$2/gso;
   # mormalize and strip redundand minuses
   $pat = &HTML::Entities::decode($pat,'"\'><&');
   $pat=~s/(?<!(?:-|\w))(-(?:\s+|\z))+/-/go;
   $pat=~s/\s+-$//o;
   my $l;
   $l = $logf->readline();
   $l =~ s/\\x\{\d+\}//go;
   # make line terminators uniform
   $l=~s/(.*?)(?:\r?\n|\r)/$1\n/o;
   $l=encodeHTMLEntities($l) if $l;
   $l=~s/([^\\])?\\([^\\])?/$1\\\\$2/gso;
   my @ary;
   push(@ary,$l);
   my $infinity=10000;
   my $precontext=my $postcontext=$qs{nocontext} ? 0 : 6;
   my $notmatched=0;
   my $currentpre=0;
   my $seq=0;
   my $lastoutput=$infinity;
   my $cur=$ary[0];
   my $i=0;
   my @words=map/^\d+\_(.*)/o, sort values %{{map{lc $_ => sprintf("%02d",$i++).'_'.$_} split(/\s+/o,$pat)}};
   $pat=join(' ', @words);
   my @highlights=('<span%%20%%style="color:black;%%20%%background-color:#ffff66">',
                   '<span%%20%%style="color:black;%%20%%background-color:#A0FFFF">',
                   '<span%%20%%style="color:black;%%20%%background-color:#99ff99">',
                   '<span%%20%%style="color:black;%%20%%background-color:#ff9999">',
                   '<span%%20%%style="color:black;%%20%%background-color:#ff66ff">',
                   '<span%%20%%style="color:white;%%20%%background-color:#880000">',
                   '<span%%20%%style="color:white;%%20%%background-color:#00aa00">',
                   '<span%%20%%style="color:white;%%20%%background-color:#886800">',
                   '<span%%20%%style="color:white;%%20%%background-color:#004699">',
                   '<span%%20%%style="color:white;%%20%%background-color:#990099">');
   my $findExpr=join(' && ',((map{'$cur=~/'.quotemeta($_).'/io'} map/^([^-].*)/o, split(/\s+/o,$pat)),
                             (map{'$cur!~/'.quotemeta($_).'/io'} map/^-(.*)/o, split(/\s+/o,$pat))));
   my %replace = ();
   my $j=0;
   my $highlightExpr='=~s/(';
   foreach (map/^([^-].*)/o, split(/\s+/o,$pat)) {
    $replace{lc $_}=$highlights[$j % @highlights]; # pick highlight style
    $highlightExpr.=quotemeta($_).'|';
    $j++;
   }
   $highlightExpr=~s/\|$//o;
   $highlightExpr.=')/$replace{lc $1}$1<\/span>/gio';
   my $loop=<<'LOOP';
   while (time < $maxsearchtime && $cur && !($maxmatches && $matches>=$maxmatches && $notmatched>$postcontext) && !($maxlines && $lines>=$maxlines)) {
    $maxsearchtime += &MainLoop1(0) unless ++$loopcount % $loopcheck;
LOOP
    $loop.='
    if (!($maxmatches && $matches>=$maxmatches) && '.$findExpr.') {'. <<'LOOP';
     $matches++;
LOOP
     $loop.='$cur'.$highlightExpr.' unless $qs{nohighlight};'. <<'LOOP';
     if ($lastoutput<=$postcontext) {
      push(@sary,$cur);
     } else {
      push(@sary,"\r\n") if ($seq++ && ($precontext+$postcontext>0));
      for ($i=0; $i<@ary; $i++) {
       if ($i<$precontext && $currentpre==$precontext || $i<$currentpre) {
        $ary[$i]=~s/^(.*?)(\r?\n)$/<span\%\%20\%\%style="color:#999999">$1<\/span>$2/so;
       } else {
LOOP
        $loop.='$ary[$i]'.$highlightExpr.' unless $qs{nohighlight};'. <<'LOOP';
       }
       push(@sary,$ary[$i]);
      }
     }
     $lastoutput=0;
     $notmatched=0;
    } elsif ($logf->eof) {
     for (; $currentpre>=0; $currentpre--) {
      shift(@ary);
     }
     $logf->close if exists $logf->{'handle'};
     if (!($maxfiles && $files>=$maxfiles)) {
      $logf=File::ReadBackwards->new(shift(@logfiles),'(?:\r?\n|\r)',1);
      $files++ if $logf;
     }
     $lastoutput=$infinity;
    } elsif ($lastoutput<=$postcontext) {
     $cur=~s/^(.*?)(\r?\n)$/<span\%\%20\%\%style="color:#999999">$1<\/span>$2/so;
     push(@sary,$cur);
    }
    $lastoutput++;
    $notmatched++;
    if ($l) {
     $l = $logf->readline();
     # make line terminators uniform
     $l=~s/(.*?)(?:\r?\n|\r)/$1\n/o;
     $l =~ s/\\x\{\d+\}//go;

     my $fname;
     if ($l=~ s/($base\/.+?\/.+?\Q$maillogExt\E)/aAaAaAaAaAbBbBbBbBbB$maillogExt/) {
       $fname = $1;
     }

     $l=encodeHTMLEntities($l) if $l;
     $l=~s/([^\\])?\\([^\\])?/$1\\\\$2/gso;

     $l =~ s/aAaAaAaAaAbBbBbBbBbB\Q$maillogExt\E/$fname/o;
     $fname = '';

     $lines++;
    }
    push(@ary,$l);
    if ($currentpre<$precontext) {
     $currentpre++;
    } else {
     shift(@ary);
    }
    $cur=$ary[$currentpre];
   }
LOOP
   eval $loop;
   $logf->close if exists $logf->{'handle'};
  }
  my $orgmatches = $matches;
  if ($matches>0) {
   $matches = 0;
   my @rary;
   my $line = $_;
   while (@sary) {
    $_ = shift @sary;
    $maxsearchtime += &MainLoop1(0) unless ++$loopcount % $loopcheck;
    my @sp;
    my @words;
    my $pretag;
    my $posttag;
    $line = $_;
    if ($_ =~ /<\/span>/o ) {
     if (!$qs{nocontext} && $_ =~ s/^(<span\%\%20\%\%style="color:#999999">)//o) {
        $pretag = $1;
        $posttag = $1 if ($_ =~ s/(<\/span>[\r\n]*)$//o);
     }
     if ($_ =~ /<\/span>/o ) {
      my $iline = '';
      @words = split(/(<span[^>]+>|<\/span>)/o);
      my $i = 0;
      while (@words) {
        $sp[$i][0] = shift @words;
        $sp[$i][1] = shift @words;
        $sp[$i][2] = shift @words;
        $sp[$i][3] = shift @words;
        $iline .=  $sp[$i][0] . $sp[$i][2];
        $i++;
      }
      if ($iline =~ /$base\/(?:$spamlog|$discarded|$notspamlog|$incomingOkMail|$viruslog|$correctedspam|$correctednotspam|$resendmail|$rspamlog|$rnotspamlog|$rcorrectedspam|$rcorrectednotspam)\/[^\s]+(?:\Q$maillogExt\E|\Q$reportExt\E)/) {
          $line = $iline ;
      } else {
         @sp = ();
      }
     }
    }
    $_ = $line;
    if (/^(<[^<>]+>)*(.*?)($base\/(($spamlog|$discarded|$notspamlog|$incomingOkMail|$viruslog|$correctedspam|$correctednotspam|$resendmail|$rspamlog|$rnotspamlog|$rcorrectedspam|$rcorrectednotspam)\/[^\s]+(?:\Q$maillogExt\E|\Q$reportExt\E)))(.*)$/)
    {
        my $sp = $1;
        my $text = $2;
        my $file = my $hfile = $3;
        my $hlfile = $4;
        my $dname = $5;
        my $text2 = $6;
        my $span = ($dname =~ /^(?:$spamlog|$discarded|$viruslog|$correctedspam|$rspamlog|$rcorrectedspam)$/) ? 'negative' : 'positive';
        $span = 'spampassed' if /\[spam passed\]/gio;

        if (@sp) {
            my $i = 0;
            my $j = scalar @sp;
            my $fpos = 0;
            my $tpos = 0;
            my $t2pos = 0;
            while ($j > $i) {
              my ($s0,$s1,$s2,$s3) = ($sp[$i][0],$sp[$i][1],$sp[$i][2],$sp[$i][3]);
              if ($s1) {
                  pos($text) = $tpos;
                  $text =~ s/\Q$s0$s2\E/$s0$s1$s2$s3/;
                  $tpos = pos($text);
                  if ($tpos) {
                      $tpos += length($s1 . $s3);
                  } else {
                      $tpos = 0;
                  }

                  pos($text2) = $t2pos;
                  $text2 =~ s/\Q$s0$s2\E/$s0$s1$s2$s3/;
                  $t2pos = pos($text2);
                  if ($t2pos) {
                      $t2pos += length($s1 . $s3);
                  } else {
                      $t2pos = 0;
                  }

                  pos($hfile) = $fpos;
                  $hfile =~ s/\Q$s0$s2\E/$s0$s1$s2$s3/;
                  $fpos = pos($hfile);
                  if ($fpos) {
                      $fpos += length($s1 . $s3);
                  } else {
                      $fpos = 0;
                  }
              }
              $i++;
            }
        }
        $hfile =~ s/\Q$base\E\///o;

        if (&existFile($file)) {
          $hfile = "<span\%\%20\%\%style=\"white-space:nowrap;\"\%\%20\%\%onclick=\"popFileEditor('" . &normHTML($hlfile) . "','m');\"\%\%20\%\%class=\"" . $span . "\"\%\%20\%\%onmouseover=\"fileBG=this.style.backgroundColor;\%\%20\%\%this.style.backgroundColor='#BBBBFF';\"\%\%20\%\%onmouseout=\"this.style.backgroundColor=fileBG;\"><b>" . $hfile . "<\/b><\/span>";
        } else {
          $hfile =~ s/([^ ]+)( +)?/<span style="white-space:nowrap;">$1<\/span>$2/go;
        }
        $text = $sp . $text .$hfile . $text2;
        my $out = '<div%%20%%id="ll' . $matches .'"%%20%%class="assplogline'. ($currWrap + ($matches % 2 && $colorLines)) .'">' . $text . "\n</div>";
        $out =~ s/\%\%20\%\%/ /go;
        push(@rary,$pretag . $out . $posttag);
        $matches++;
        next;
    } elsif (! $filesonly) {
        s/\%\%20\%\%/ /go;
        $_ = niceLink($_);
        my @links;
        my @addr;
        my @ips;
        while ($_ =~ s/(\<a href.*?<\/a\>)/XXXIIIXXX/o) {
            my $link = $1;
            $link =~ s/WIDTH=[^\d]*(\d+\%)[^ ]*/WIDTH=$1/io;
            push @links,$link;
        }
        if (&canUserDo($WebIP{$ActWebSess}->{user},'action','addraction')) {
            while ($_ =~ s/((?<!Message-ID found: ))($EmailAdrRe\@$EmailDomainRe)/$1XXXAIIIDXXX/o) {
                push @addr ,
                   "<span style=\"white-space:nowrap;\" onclick=\"popAddressAction('"
                   . &normHTML($2)
                   . "');\" class=\"menuLevel2\" onmouseover=\"fileBG=this.style.backgroundColor; this.style.backgroundColor='#BBBBFF';\" onmouseout=\"this.style.backgroundColor=fileBG;\"><b>"
                   . $2
                   . "<\/b><\/span>";
            }
        }
        if (&canUserDo($WebIP{$ActWebSess}->{user},'action','ipaction')) {
            while ($_ =~ s/($IPRe)([^:\d\/])/XXXiIIIpXXX$2/o) {
                my  $ip = $1;
                if (   $ip !~ /$IPprivate/o
                    && $ip ne $localhostip
                    && $ip !~ /$LHNRE/)
                {
                    push @ips,
                       "<span style=\"white-space:nowrap;\" onclick=\"popIPAction('"
                       . &normHTML($ip)
                       . "');\" class=\"menuLevel2\" onmouseover=\"fileBG=this.style.backgroundColor; this.style.backgroundColor='#BBBBFF';\" onmouseout=\"this.style.backgroundColor=fileBG;\"><b>"
                       . $ip
                       . "<\/b><\/span>";
                } else {
                    push @ips, $ip;
                }
            }
        }
        if (@links) {
            s/XXXIIIXXX/shift(@links)/geo;
        }
        if (@addr) {
            s/XXXAIIIDXXX/shift(@addr)/geo;
        }
        if (@ips) {
            s/XXXiIIIpXXX/shift(@ips)/geo;
        }
    }
    if ($filesonly) {
        next;
    }
    my $out =  '<div id="ll' . $matches .'" class="assplogline'. ($currWrap + ($matches % 2 && $colorLines)) .'">' . $_ . "\n</div>";
    push(@rary, $pretag . $out . $posttag);
    $matches++;
   }
   $s = join('', reverse @rary);
   $s =~ s/"/\\"/go;
   $s =~ s/\n+<\/div>/<\/div>XXXIIIXXX/go;
   $s =~ s/\r|\n//go;
   $s =~ s/XXXIIIXXX$//o;
   my $ftext = $filesonly ? ' with ' . needEs($matches,' line','s') . ' that contains filesnames' : '';
   $res='found '. needEs($orgmatches,' matching line','s') . $ftext . ', searched in '. needEs($files,' log file','s') .' ('. needEs($lines,' line','s'). ')';
  } else {
   $res='no results found, searched in '. needEs($files,' log file','s') .' ('. needEs($lines,' line','s'). ')';
  }
 } else {
  $s='<p class="warning">Please install required module <a href="http://search.cpan.org/~uri/File-ReadBackwards-1.03/" rel="external">File::ReadBackwards</a>.</p>';
 }
 $MaillogTailBytes = $savTailByte;
 my $size = $qs{size} ? $qs{size} : 10000;
 my $files = $qs{files} || 'lines';
 my $limit = $qs{limit} || 10;
 $pat = ($resetpat) ? '' : &HTML::Entities::encode($orgpat,'"\'><&');
 my $h1 = $WebIP{$ActWebSess}->{lng}->{'msg500050'} || $lngmsg{'msg500050'};
 my $h2 = $WebIP{$ActWebSess}->{lng}->{'msg500051'} || $lngmsg{'msg500051'};
 my $h4 = $WebIP{$ActWebSess}->{lng}->{'msg500052'} || $lngmsg{'msg500052'};
 my $h5 = $WebIP{$ActWebSess}->{lng}->{'msg500053'} || $lngmsg{'msg500053'};
 $h1 =~ s/\r|\n//go;
 $h2 =~ s/\r|\n//go;
 $h4 =~ s/\r|\n//go;
 $h5 =~ s/\r|\n//go;

 my $dir = $base;
 $dir .= "/$1" if $logfile =~ /^([^\/]+)\//o;
 my ($lf) = $logfile =~/([^\/]+)$/o;
 my $h3 = '<center><table BORDER CELLSPACING=2 CELLPADDING=4><tr><th></th><th>filename</th><th>size</th><th></th><th>filename</th><th>size</th></tr>';
 $h3 .= '<tr><td>01</td><td>' . $lf . '</td><td>' . formatDataSize( -s "$dir/$lf", 1 ) . '</td></tr>';
 my @filelist = $unicodeDH->($dir);
 my $i = 0;
 foreach my $file (reverse sort @filelist) {
     next if $file !~ /\.$lf$/;
     $h3 .= '<tr>' unless $i % 2;
     $h3 .= '<td>' . sprintf("%02d",($i + 2)) . '</td><td>' . $file . '</td><td>' . formatDataSize( -s "$dir/$file", 1 ) . '</td>';
     $h3 .= '</tr>' if $i % 2;
     $i++;
 }
 $h3 .= '</tr>' if $h3 !~ /tr\>$/;
 $h3 .= '</table></center>';
 $maxsearchtime = int($maxsearchtime + 0.5 - $stime);
 $stime = time - $stime;
 if ($maxsearchtime > $stime && $maxsearchtime > $maxsearchsec) {
     $maxsearchtime = " (calculated maximum of $stime seconds was reached)";
 } else {
     $maxsearchtime = '';
 }
 $res .= ', ' if ($res &&  $qs{autorefresh} ne 'Auto');
 $res .= "searchtime $stime seconds$maxsearchtime" if ($qs{autorefresh} ne 'Auto');
 my $headline = ($qs{autorefresh} eq 'Auto') ? '' : '<h2>ASSP Maillog Tail</h2>' ;

<<EOT;
$headerHTTP
$headerDTDTransitional
$$CMheaders
<style type="text/css">
.spampassed { color: #FFA500; }
</style>
<div id="cfgdiv" $content>
$headline
<a name="MlTop" style="font-weight: normal;"></a>
<div class="log" ><pre><a id="dummy" name="dummy" style="font-weight: normal;">$m</a></pre></div>
<script type="text/javascript">
var fileBG;
var MlEndPos;

var intend = document.getElementById('dummy').offsetWidth;
document.getElementById('dummy').style.display='none';

document.write("<style id=\\"aloli0\\" type=\\"text/css\\">\\n.assplogline0\\n {\\nwhite-space:nowrap;\\n padding-left:" + intend + "px;\\n text-indent:-" + intend + "px;\\n background-color:#FFFFFF;\\n}\\n</style>\\n");
document.write("<style id=\\"aloli1\\" type=\\"text/css\\">\\n.assplogline1\\n {\\nwhite-space:nowrap;\\n padding-left:" + intend + "px;\\n text-indent:-" + intend + "px;\\n background-color:#F0F0F0;\\n}\\n</style>\\n");
document.write("<style id=\\"aloli2\\" type=\\"text/css\\">\\n.assplogline2\\n {\\nwhite-space:normal;\\n padding-left:" + intend + "px;\\n text-indent:-" + intend + "px;\\n background-color:#FFFFFF;\\n}\\n</style>\\n");
document.write("<style id=\\"aloli3\\" type=\\"text/css\\">\\n.assplogline3\\n {\\nwhite-space:normal;\\n padding-left:" + intend + "px;\\n text-indent:-" + intend + "px;\\n background-color:#F0F0F0;\\n}\\n</style>\\n");

function changeSpan(change) {
  var iswrap = document.MTform.wrap[1].checked ? 2 : 0;
  var iscolor = document.MTform.color[1].checked ? 1 : 0;
  var dowrap = change - 2;
  for(i=0; i < $matches; i++) {
    if (change == 0 || change == 1) {
      if (change == 0) {
          document.getElementById('ll' + i).className = 'assplogline' + iswrap;
      } else {
          document.getElementById('ll' + i).className = 'assplogline' + ((i % 2) + iswrap);
      }
    } else {
      if (iscolor == 0) {
          document.getElementById('ll' + i).className = 'assplogline' + dowrap;
      } else {
          document.getElementById('ll' + i).className = 'assplogline' + ((i % 2) + dowrap);
      }
    }
  }
}
</script>
<form name="MTform" action="" method="get">
  <table class="textBox" style="width: 100%;">
    <tr>
      <td rowspan="2" align="left" $display>
        <label>wrap lines: </label>
        <input type="radio" name="wrap" ${\(! $currWrap ? ' checked="checked" ' : ' ')} value='0' onclick="javascript:changeSpan('2');" />no
        <input type="radio" name="wrap" ${\(  $currWrap ? ' checked="checked" ' : ' ')} value='2' onclick="javascript:changeSpan('4');" />yes<br />
        <label>color lines: </label>
        <input type="radio" name="color" ${\(! $colorLines ? ' checked="checked" ' : ' ')} value='0' onclick="javascript:changeSpan('0');" />no
        <input type="radio" name="color" ${\(  $colorLines ? ' checked="checked" ' : ' ')} value='1' onclick="javascript:changeSpan('1');" />yes<br />
        <label>tail bytes:</label>
        <input type="text" name="tailbyte" value='$currTailByte' size="7"/>
      </td>
      <td align="left" $display>
        <label>search for: </label>
        <a href="javascript:void(0);" onmouseover="showhint('$h5', this, event, '450px', '1');return false;"><img height=12 width=12 src="$wikiinfo" /></a>
        <input type="text" name="search" value='$pat' size="30"/>
      </td>
      <td align="left">
        <input type="submit" value="Submit/Update" $display />
        <input type="submit" name="autorefresh" value='$autoButton'/>
        <input type="hidden" name="order" value='$order'/>
      </td>
      <td rowspan="2" $display>
        <input type="checkbox" name="nocontext"${\($qs{nocontext} ? ' checked="checked" ' : ' ')}value='1' />hide&nbsp;context&nbsp;lines<br />
        <input type="checkbox" name="nohighlight"${\($qs{nohighlight} ? ' checked="checked" ' : ' ')}value='1' />no&nbsp;highlighting<br />
        <input type="checkbox" name="filesonly"${\($qs{filesonly} ? ' checked="checked" ' : ' ')}value='1' />file&nbsp;lines&nbsp;only
      </td>
    </tr>
    <tr $display>
      <td align="left">
        <label>search in:</label>
        <a href="javascript:void(0);" onmouseover="showhint('$h4', this, event, '450px', '1');return false;"><img height=12 width=12 src="$wikiinfo" /></a>
        <input type="text" name="size" value='$size' size="7" />
        <select size="1" name="files" value="$qs{files}" />
          <option value="lines">last lines</option>
          <option value="files">last log files</option>
          <option value="all">all log files</option>
          <option value="ago">this file number(s)</option>
        </select>
        <a href="javascript:void(0);" onmouseover="showhint('$h3', this, event, '450px', '1');return false;"><img height=12 width=12 src="$wikiinfo" /></a>
      </td>
      <td align="left">
        <label>show </label>
        <select size="1" name="limit" value="$qs{limit}">
          <option value="1">1</option>
          <option value="10">10</option>
          <option value="100">100</option>
          <option value="1000">1000</option>
          <option value="2000">2000</option>
        </select> Results
      </td>
    </tr>
  </table>
</form>
<script type="text/javascript">
document.MTform.files.value='$files';
document.MTform.limit.value='$limit';
function resetForm() {
  document.MTform.search.value='';
  document.MTform.nocontext.checked=false;
  document.MTform.nohighlight.checked=false;
  document.MTform.filesonly.checked=false;
  document.MTform.tailbyte.value='$MaillogTailBytes';
  document.MTform.size.value='10000';
  document.MTform.files.value='lines';
  document.MTform.limit.value='10';
  document.MTform.order.value='0';
}
</script>
<div class="log $logstyle" $display>
<a href="javascript:void(0);" onclick="document.getElementById(\'LogLines\').scrollTop=MlEndPos; return false;" >Go to End</a>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
<a href="javascript:void(0);" onclick="document.getElementById(\'LogLines\').scrollTop=0;return false;">Go to Top</a>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
<a href="javascript:void(0);" onmouseover="showhint('$h3', this, event, '450px', '1');return false;">show filelist</a>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
<a href="javascript:void(0);" onmouseover="showhint('$h1<br /><br />$h2', this, event, ie ? document.body.offsetWidth / 2.1 + 'px' : window.innerWidth / 2.1 + 'px' , '');return false;">help</a>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
<a href="javascript:void(0);" onclick="resetForm();" onmouseover="showhint('click to reset the form to system defaults', this, event, '300px', '');return false;">reset form</a>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
<a href="javascript:void(0);" onclick="switchMTOrder();" onmouseover="showhint('click to switch the time order of lines', this, event, '300px', '');return false;">switch order</a>
&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;
<a href="/" onmouseover="showhint('click to return to config dialog', this, event, '300px', '');return false;">back to config</a><br />
<script type="text/javascript">
if ('$qs{autorefresh}' != 'Auto') {
//var LogWidth = objWidth('cfgdiv') + 'px';
var LogHeight = ClientSize('h') - document.getElementById('cfgdiv').offsetHeight + 'px';
}
</script>
$res
<hr>
</div>
<div id="LogLines" class="log" style="display:block;height:100%;width=100%;overflow:auto;">
<div class="log $logstyle" width=100%>
<pre id="allLogLines" style="font-size: 1.4em;">
</pre>

<script type="text/javascript">

if ('$qs{autorefresh}' != 'Auto') {
//document.getElementById('LogLines').style.width = LogWidth;
document.getElementById('LogLines').style.height = LogHeight;
}

var order = $order;
var allLines = "$s".split("XXXIIIXXX");
var allLinesF = allLines.join('');
var allLinesR = allLines.reverse().join('');
allLines = ('');
function switchMTOrder() {
  order = order ? 0 : 1 ;
  document.MTform.order.value=order;
  var logdiv = document.getElementById('allLogLines');
  logdiv.innerHTML = '';
  if (order == 1) {
      logdiv.innerHTML = allLinesR;
  } else {
      logdiv.innerHTML = allLinesF;
  }
}
order = order ? 0 : 1 ;
switchMTOrder();
if ('$qs{autorefresh}' != 'Auto') {
MlEndPos = document.getElementById('allLogLines').scrollHeight;
window.location.href = '#MlTop';
${\($MaillogTailJump && $qs{autorefresh} ne 'Auto' ? 'document.getElementById(\'LogLines\').scrollTop=MlEndPos;' : 'order = order;') }
}
</script>
</div>
<div $display >
$maillogJump
</div>
</div>
</div>
<div $display >
$footers
</div>
<form name="ASSPconfig" id="ASSPconfig" action="" method="post">
  <input name="theButtonLogout" type="hidden" value="" />
</form>
</body></html>
EOT
}

sub Glob {
    my @g;
    if ($] !~ /^5\.016/o) {
        @g = glob("@_");
    } else {
        map {push @g , < $_ >;} @_ ;
    }
    return @g;
}

sub existFile {
    my $file = shift;
    return 0 unless $file;
    return ($eF->( $file ) or -e $file);
}

sub getHashBDBName {
    my ($hash) = shift;
    if ($hash eq 'Griplist' && $griplist) {
        return $griplist;
    }
    if ($hash =~ /^HMM/o && $runHMMusesBDB) {
        return $hash;
    }
    foreach my $dbGroup (@GroupList) {
        foreach my $dbGroupEntry (@$dbGroup) {
            my ($KeyName,$dbConfig,$CacheObject,$realFileName,$mysqlFileName,$FailoverValue,$mysqlTable) = split(/,/o,$dbGroupEntry);
            next if $realFileName !~ /DB:/o;
            my $f1 = $realFileName;
            $f1 =~ s/DB:/$FailoverValue/o;
            return $f1 if $KeyName eq $hash;
        }
    }
    return;
}

sub getHashName {
    my ($confname, $file) = @_;
    my $subname;
    $confname = 'ldaplistdb' if $confname eq 'LDAPShowDB';
    if ($confname eq 'DelayShowDB' or $confname eq 'delaydb') {
        $subname = 'Delay';
        $confname = 'delaydb';
    }
    if ($confname eq 'DelayShowDBwhite') {
        $subname = 'DelayWhite';
        $confname = 'delaydb';
    }
    if ($confname eq 'spamdb') {
        $subname = 'Spamdb';
        $confname = 'spamdb';
    }
    if ($confname eq 'ShowHeloBlack') {
        $subname = 'HeloBlack';
        $confname = 'spamdb';
    }
    if ($confname) {
        my $found = 0;
        foreach my $dbGroup (@GroupList) {
            next if $dbGroup eq 'AdminGroup';
            foreach my $dbGroupEntry (@$dbGroup) {
                my ($KeyName,$dbConfig,$CacheObject,$realFileName,$mysqlFileName,$FailoverValue,$mysqlTable) = split(/,/o,$dbGroupEntry);
                $found = 1 if ($dbConfig eq $confname && (! $subname || $subname eq $KeyName));
                next if $dbConfig eq 'pbdb';
                next if $$dbConfig !~ /DB:/o;
                return $KeyName if ($dbConfig eq $confname && (! $subname || $subname eq $KeyName));
            }
        }
        return $confname if ! $found;
        return;
    } elsif ($file) {
        foreach my $dbGroup (@GroupList) {
            next if $dbGroup eq 'AdminGroup';
            foreach my $dbGroupEntry (@$dbGroup) {
                my ($KeyName,$dbConfig,$CacheObject,$realFileName,$mysqlFileName,$FailoverValue,$mysqlTable) = split(/,/o,$dbGroupEntry);
                next if $realFileName !~ /DB:/o;
                my $f1 = $realFileName;
                $f1 =~ s/DB:/$FailoverValue/o;
                return $KeyName if $f1 eq $file;
            }
        }
    }
    return;
}

sub d8 {
    local $@;
    my $ret = eval{Encode::decode('UTF-8',$_[0]);};
    return ($ret && defined ${chr(ord("\026") << 2)}) ? $ret : $_[0];
}

sub e8 {
    local $@;
    my $ret = eval{Encode::encode('UTF-8',$_[0]);};
    return ($ret && defined ${chr(ord("\026") << 2)}) ? $ret : $_[0];
}

sub de8 {
    local $@;
    my $ret = eval{require Encode::Guess; e8(Encode::decode('GUESS',$_[0]));};
    return ($ret && defined ${chr(ord("\026") << 2)}) ? $ret : $_[0];
}

sub decodeMimeWord2UTF8 {
    my ($fulltext,$charset,$encoding,$text)=@_;
    my $ret;

    eval {$charset = Encode::resolve_alias(uc($charset));} if $charset;

    if (!$@ && $CanUseEMM && $charset ) {
        eval{$ret = MIME::Words::decode_mimewords($fulltext)} if $fulltext;
        eval{
            $ret = Encode::decode($charset, $ret);
            $ret = e8($ret) if $ret;
        } if $ret;
        return $ret unless $@;
    }

    if (lc $encoding eq 'b') {
        $text=base64decode($text);
    } elsif (lc $encoding eq 'q') {
        $text=~s/_/\x20/go; # RFC 1522, Q rule 2
        $text=~s/=([\da-fA-F]{2})/pack('C', hex($1))/geo; # RFC 1522, Q rule 1
    };
    eval{
        $text = Encode::decode($charset, $text);
        $text = e8($text) if $text;
    } if $text;
    return $text;
}

sub decodeMimeWords2UTF8 {
    my $s = shift;
    headerUnwrap($s);
    $s =~ s/(=\?([^?]*)\?(b|q)\?([^?]+)\?=)/decodeMimeWord2UTF8($1,$2,$3,$4)/gieo;
    return $s;
}

sub transliterate {
    my ($text, $skipequal) = @_;
    return unless ($CanUseTextUnidecode);
    my $trans = eval{Text::Unidecode::unidecode(d8($$text));};
    return ($skipequal && $trans eq $$text) ? undef : defined(*{'yield'}) ? $trans : undef;
}

sub ConfigAddrAction {
    my $addr = lc($qs{address});
    my $run = $qs{address};
    $addr =~ s/^\s+//o;
    $addr =~ s/\s+$//o;
    my $local;
    my $isnameonly;
    my $wlfrm;
    my $wlto;
    $local = localmail($addr) if $addr;
    my $action = $qs{action};
    my $slo;
    $slo = '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type="button"  name="showlogout" value="  logout " onclick="window.location.href=\'./logout\';return false;"/></span>' if exists $qs{showlogout};
    my $s = $qs{reloaded} eq 'reloaded' ? '<span class="positive">(page was auto reloaded)</span><br /><br />' : '';

    my $mfd;my $wrongaddr;
    if ($addr =~ /^((?:$EmailAdrRe)?(\@$EmailDomainRe))(?:,($EmailAdrRe?\@$EmailDomainRe))?$/io) {
        $wlfrm = $1;
        $mfd = $2;
        $wlto = $3;
    } elsif ($addr =~ /^($EmailDomainRe)$/io) {
        $mfd = $1;
    } elsif ($addr =~ /^$EmailAdrRe$/io) {
        $isnameonly = '<br />This is interpreted as the userpart of an email address!<br />';
    } else {
        $wrongaddr = '<br /><span class="negative">This is not a valid email address or domain!</span><br />';
    }
    
    if ($addr && $action && $qs{Submit} && !$wrongaddr) {
        my %lqs = %qs;
        if ($mfd && $action eq '1' && &canUserDo($WebIP{$ActWebSess}->{user},'action','lists')) {
            %qs = ('action' => 'a', 'list' => 'white', 'addresses' => $addr);
            $s = &ConfigLists();
            $s =~ s/^.+?<\/h2>(.+?)<form.+$/$1/ois;
        } elsif ($mfd && $action eq '2' && &canUserDo($WebIP{$ActWebSess}->{user},'action','lists')) {
            %qs = ('action' => 'r', 'list' => 'white', 'addresses' => $addr);
            $s = &ConfigLists();
            $s =~ s/^.+?<\/h2>(.+?)<form.+$/$1/ois;
        } elsif ($mfd && $action eq '3' && &canUserDo($WebIP{$ActWebSess}->{user},'action','lists')) {
            %qs = ('action' => 'a', 'list' => 'red', 'addresses' => $addr);
            $s = &ConfigLists();
            $s =~ s/^.+?<\/h2>(.+?)<form.+$/$1/ois;
        } elsif ($mfd && $action eq '4' && &canUserDo($WebIP{$ActWebSess}->{user},'action','lists')) {
            %qs = ('action' => 'r', 'list' => 'red', 'addresses' => $addr);
            $s = &ConfigLists();
            $s =~ s/^.+?<\/h2>(.+?)<form.+$/$1/ois;
        } elsif ($action eq '5' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noProcessing')) {
            my $r = $GPBmodTestList->('GUI','noProcessing','add',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr added to noProcessing" : "$addr not added to noProcessing";
        } elsif ($action eq '6' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noProcessing')) {
            my $r = $GPBmodTestList->('GUI','noProcessing','delete',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr removed from noProcessing" : "$addr not removed from noProcessing";
        } elsif ($action eq '7' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noProcessingFrom')) {
            my $r = $GPBmodTestList->('GUI','noProcessingFrom','add',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr added to noProcessingFrom" : "$addr not added to noProcessingFrom";
        } elsif ($action eq '8' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noProcessingFrom')) {
            my $r = $GPBmodTestList->('GUI','noProcessingFrom','delete',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr removed from noProcessingFrom" : "$addr not removed from noProcessingFrom";
        } elsif ($mfd && $action eq '9' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','whiteListedDomains')) {
            my $r = $GPBmodTestList->('GUI','whiteListedDomains','add',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr added to whiteListedDomains" : "$addr not added to whiteListedDomains";
        } elsif ($mfd && $action eq 'A' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','whiteListedDomains')) {
            my $r = $GPBmodTestList->('GUI','whiteListedDomains','delete',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr removed from whiteListedDomains" : "$addr not removed from whiteListedDomains";
        } elsif ($mfd && $action eq 'B' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','blackListedDomains')) {
            my $r = $GPBmodTestList->('GUI','blackListedDomains','add',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr added to blackListedDomains" : "$addr not added to blackListedDomains";
        } elsif ($mfd && $action eq 'C' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','blackListedDomains')) {
            my $r = $GPBmodTestList->('GUI','blackListedDomains','delete',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr removed from blackListedDomains" : "$addr not removed from blackListedDomains";
        } elsif ($action eq 'D' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','spamLovers')) {
            my $r = $GPBmodTestList->('GUI','spamLovers','add',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr added to spamLovers (All Spam-Lover)" : "$addr not added to spamLovers (All Spam-Lover)";
        } elsif ($action eq 'E' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','spamLovers')) {
            my $r = $GPBmodTestList->('GUI','spamLovers','delete',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr removed from spamLovers (All Spam-Lover)" : "$addr not removed from spamLovers (All Spam-Lover)";
        } elsif ($action eq 'F' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','spamHaters')) {
            my $r = $GPBmodTestList->('GUI','spamHaters','add',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr added to spamHaters (All Spam-Haters)" : "$addr not added to spamHaters (All Spam-Haters)";
        } elsif ($action eq 'G' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','spamHaters')) {
            my $r = $GPBmodTestList->('GUI','spamHaters','delete',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr removed from spamHaters (All Spam-Haters)" : "$addr not removed from spamHaters (All Spam-Haters)";
        } elsif ($mfd && $action eq 'H' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noProcessingDomains')) {
            my $r = $GPBmodTestList->('GUI','noProcessingDomains','add',' - via MaillogTail',$mfd,0);
            $s = ($r > 0) ? "$mfd added to noProcessing Domains" : "$mfd not added to noProcessing Domains";
        } elsif ($mfd && $action eq 'I' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noProcessingDomains')) {
            my $r = $GPBmodTestList->('GUI','noProcessingDomains','delete',' - via MaillogTail',$mfd,0);
            $s = ($r > 0) ? "$mfd removed from noProcessing Domains" : "$mfd not removed from noProcessing Domains";
        } elsif ($action eq 'J' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','preHeaderRe')) {
            my $addrRe = quotemeta($addr);
            my $r = $GPBmodTestList->('GUI','preHeaderRe','add',' - via MaillogTail',$addrRe,0);
            $s = ($r > 0) ? "$addr added as regex ($addrRe) to preHeaderRe" : "$addr not added to preHeaderRe";
        } elsif ($action eq 'K' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','preHeaderRe')) {
            my $addrRe = quotemeta($addr);
            my $r = $GPBmodTestList->('GUI','preHeaderRe','delete',' - via MaillogTail',$addrRe,0);
            $s = ($r > 0) ? "$addr removed as regex ($addrRe) from preHeaderRe" : "$addr not removed from preHeaderRe";
        } elsif ($action eq 'L' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noScan')) {
            my $r = $GPBmodTestList->('GUI','noScan','add',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr added to sDo Not Virus-Scan Messages from/to these Addresses(noScan)" : "$addr not added to Do Not Scan Messages from/to these Addresses(noScan)";
        } elsif ($action eq 'M' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noScan')) {
            my $r = $GPBmodTestList->('GUI','noScan','delete',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr removed from Do Not Virus-Scan Messages from/to these Addresses(noScan)" : "$addr not Do Not Scan Messages from/to these Addresses(noScan)";
        } elsif ($action) {
            $s = "<span class=\"negative\">access denied for the selected action</span>";
        }
        %qs = %lqs;
    }
    $s = 'no action selected - or no result available' if (! $s && $qs{Submit});
    if ($s !~ /not|negative/ && $qs{Submit}) {
        $ConfigChanged = 1;
        &tellThreadsReReadConfig();   # reread the config
    }

    my $option  = "<option value=\"0\">select action</option>";
    if ($addr && ! $wrongaddr) {
        $option .= "<option value=\"1\">add to WhiteList</option>"
         if ($mfd && ! $local && ! Whitelist($wlfrm,$wlto,'') && &canUserDo($WebIP{$ActWebSess}->{user},'action','lists'));
        $option .= "<option value=\"2\">remove from WhiteList</option>"
         if ($mfd && ! $local &&  Whitelist($wlfrm,$wlto,'') && &canUserDo($WebIP{$ActWebSess}->{user},'action','lists'));
        $option .= "<option value=\"3\">add to RedList</option>"
         if ($mfd && ! exists $Redlist{$addr} && &canUserDo($WebIP{$ActWebSess}->{user},'action','lists'));
        $option .= "<option value=\"4\">remove from RedList</option>"
         if ($mfd && exists $Redlist{$addr} && &canUserDo($WebIP{$ActWebSess}->{user},'action','lists'));
        $option .= "<option value=\"5\">add to noProcessing addresses</option>"
         if ($noProcessing=~/\s*file\s*:\s*.+/o && ! $local && ! matchSL( $addr, 'noProcessing' ,1) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noProcessing'));
        $option .= "<option value=\"6\">remove from noProcessing addresses</option>"
         if ($noProcessing=~/\s*file\s*:\s*.+/o && ! $local &&  matchSL( $addr, 'noProcessing' ,1) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noProcessing'));
        $option .= "<option value=\"7\">add to noProcessingFrom addresses</option>"
         if ($noProcessingFrom=~/\s*file\s*:\s*.+/o && ! $local && ! matchSL( $addr, 'noProcessingFrom' ,1) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noProcessingFrom'));
        $option .= "<option value=\"8\">remove from noProcessingFrom addresses</option>"
         if ($noProcessingFrom=~/\s*file\s*:\s*.+/o && ! $local && matchSL( $addr, 'noProcessingFrom' ,1) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noProcessingFrom'));
        $option .= "<option value=\"9\">add to whitelisted domains/addresses</option>"
         if ($mfd && $whiteListedDomains=~/\s*file\s*:\s*.+/o && ! $local && ! matchRE([$addr],'whiteListedDomains',1) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','whiteListedDomains'));
        $option .= "<option value=\"A\">remove from whitelisted domains/addresses</option>"
         if ($mfd && $whiteListedDomains=~/\s*file\s*:\s*.+/o && ! $local && matchRE([$addr],'whiteListedDomains',1) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','whiteListedDomains'));
        $option .= "<option value=\"B\">add to blacklisted domains/addresses</option>"
         if ($mfd && $blackListedDomains=~/\s*file\s*:\s*.+/o && ! $local && ! matchRE([$addr],'blackListedDomains',1) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','blackListedDomains'));
        $option .= "<option value=\"C\">remove from blacklisted domains/addresses</option>"
         if ($mfd && $blackListedDomains=~/\s*file\s*:\s*.+/o && ! $local && matchRE([$addr],'blackListedDomains',1) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','blackListedDomains'));
        $option .= "<option value=\"D\">add to All Spam-Lover</option>"
         if ($spamLovers=~/\s*file\s*:\s*.+/o && $local && $addr !~ /$SLRE/ && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','spamLovers'));
        $option .= "<option value=\"E\">remove from All Spam-Lover</option>"
         if ($spamLovers=~/\s*file\s*:\s*.+/o && $local && $addr =~ /$SLRE/ && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','spamLovers'));
        $option .= "<option value=\"F\">add to All Spam-Haters</option>"
         if ($spamHaters=~/\s*file\s*:\s*.+/o && $local && $addr !~ /$SHRE/ && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','spamHaters'));
        $option .= "<option value=\"G\">remove from All Spam-Haters</option>"
         if ($spamHaters=~/\s*file\s*:\s*.+/o && $local && $addr =~ /$SHRE/ && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','spamHaters'));
        $option .= "<option value=\"H\">add $mfd to noProcessing domains</option>"
         if ($mfd && $noProcessingDomains=~/\s*file\s*:\s*.+/o && ! $local && $mfd !~ /$NPDRE/ && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noProcessingDomains'));
        $option .= "<option value=\"I\">remove $mfd from noProcessing domains</option>"
         if ($mfd && $noProcessingDomains=~/\s*file\s*:\s*.+/o  && ! $local && $mfd =~ /$NPDRE/ && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noProcessingDomains'));

#experimental for preHeaderRe
        my $addrRe = quotemeta($addr);
        $option .= "<option value=\"J\">add to preHeaderRe as regex</option>"
         if ($preHeaderRe=~/\s*file\s*:\s*.+/o && ! $local && $GPBmodTestList->('GUI','preHeaderRe','check','',$addrRe,0) != 2 && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','preHeaderRe'));
        $option .= "<option value=\"K\">remove regex from preHeaderRe</option>"
         if ($preHeaderRe=~/\s*file\s*:\s*.+/o && ! $local && $GPBmodTestList->('GUI','preHeaderRe','check','',$addrRe,0) == 2 && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','preHeaderRe'));
#end experimental for preHeaderRe

        $option .= "<option value=\"L\">add to no Virus-Scan addresses</option>"
         if ($noScan=~/\s*file\s*:\s*.+/o && ! $local && ! matchSL( $addr, 'noScan' ,1) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noScan'));
        $option .= "<option value=\"M\">remove from no Virus-Scan addresses</option>"
         if ($noScan=~/\s*file\s*:\s*.+/o && ! $local &&  matchSL( $addr, 'noScan' ,1) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noScan'));
    }

    if ($addr && ! $wrongaddr) {
        my @ad = ($addr);
        push @ad , $mfd if $mfd && $mfd ne $addr;
        $s .= "<br /><br /><b>general address-matches for $addr :</b><br /><br />\n";
        foreach (sort {lc($main::a) cmp lc($main::b)} keys %MakeSLRE) {
            next unless ${$_};
            my $reRE = ${$MakeSLRE{$_}};
            next if $reRE =~ /$neverMatchRE/o;
            next unless &canUserDo($WebIP{$ActWebSess}->{user},'cfg',$_);
            my $r = matchARRAY($reRE,\@ad);
            $s .= "matches in<b> $_ </b>with <b>$r</b><br />" if $r;
        }
        foreach (sort {lc($main::a) cmp lc($main::b)} keys %preMakeRE) {
            next if $preMakeRE{$_} == 1;
            next unless ${$preMakeRE{$_}};
            next if ${$_} =~ /$neverMatchRE/o;
            next unless &canUserDo($WebIP{$ActWebSess}->{user},'cfg',$preMakeRE{$_});
            my $r = matchARRAY(${$_},\@ad);
            $s .= "matches in<b> $preMakeRE{$_} </b>with <b>$r</b><br />" if $r;
        }
    }

    if ($WebIP{$ActWebSess}->{user} eq 'root' && $run =~ s/^\s*([\$\%\@\&][^\n]+)/$1/o) {
        $addr = $run;
        my $ret = "eval result for $run :<br /><br />";
        my $res;
        my $orun = $run;
        if ($run =~ /^\&/o) {
            my ($sub,$parm) = parseEval($run);
            if ($sub) {
                mlog(0,"info: executing command '$run' ");
                if (lc($sub) eq 'runeval' or lc($sub) eq '&runeval') {
                    $res = &RunEval($parm);
                } else {
                    $sub =~ s/^\&//o;
                    $res = eval{$sub->(split(/\,/o,$parm));};
                }
            }
        } elsif ($run =~ s/^\$//o && defined ${$run}) {
            $res = ${$run};
        } elsif ($run =~ s/^\%//o && eval('defined %{$run};')) {
            $res .= "'$_' => '".${$run}{$_}.'\'<br />' foreach (sort keys %{$run});
        } elsif ($run =~ s/^\@//o && eval('defined @{$run};')) {
            $res = join('<br />', @{$run});
        } else {
            $res = "'$orun' is not defined";
        }
        $res .= ' , ' . timestring($res) if $res =~ /^\d{10}$/o;
        $s .= $ret . $res;
    }

    return <<EOT;
$headerHTTP

<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
  <meta http-equiv="content-type" content="application/xhtml+xml; charset=utf-8" />
  <title>$currentPage ASSP address action ($myName)</title>
  <link rel=\"stylesheet\" href=\"get?file=images/editor.css\" type=\"text/css\" />
</head>
<body onmouseover="this.focus();" ondblclick="this.select();">
<h2>add/remove addresses from lists</h2><hr>
    <div class="content">
      <form name="edit" id="edit" action="" method="post" autocomplete="off">
        <h3>address to work with</h3>
        <input name="address" size="100" autocomplete="off" value="$addr" onchange="document.forms['edit'].action.value='0';document.forms['edit'].reloaded.value='reloaded';document.forms['edit'].submit();return false;"/>
        $wrongaddr$isnameonly
        <br /><hr>
        <div style="align: left">
         <div class="shadow">
          <div class="option">
           <div class="optionValue">
            <select size="1" name="action">
             $option
            </select>
           </div>
          </div>
         </div>
        </div>
        <hr>
        <input type="submit" name="Submit" value="Submit" />&nbsp;&nbsp;&nbsp;&nbsp;
        <input type="hidden" name="reloaded" value="" />
        <input type="button" value="Close" onclick="javascript:window.close();"/>
        $slo
        <hr>
      </form>
      <br />Only configured (file:...), possible and authorized option are shown.
      <hr>
      <div class="note" id="notebox">
        <h3>results for action</h3><hr>
        $s
      </div>
    </div>
</body>
</html>

EOT
}

sub ConfigIPAction {
    my $addr = lc($qs{ip});
    $addr =~ s/^\s+//o;
    $addr =~ s/\s+$//o;
    my $wrongaddr;
    if ($addr !~ /^$IPRe$/o) {
        $wrongaddr = '<br /><span class="negative">This is not a valid IP address or a resolvable hostname!</span><br />' ;
    }
    if ($wrongaddr && $addr =~ /^$HostRe$/o) {
        my $ta = $addr;
        $addr = join(' ' ,&getRRA($ta));
        if ($addr =~ /($IPv4Re)/o) {
            $addr = $1;
        } elsif ($addr =~ /($IPv6Re)/o) {
            $addr = $1;
        } else {
            $addr = undef;
        }
        eval {$addr = inet_ntoa( scalar( gethostbyname($ta) ) );} unless $addr;
        if ($addr =~ /^$IPRe$/o ) {
            $wrongaddr = undef;
        } else {
            $addr = $ta;
        }
    }
    my $local = $addr =~ /^$IPprivate$/o || $addr eq $localhostip || $addr =~ /$LHNRE/;
    my $action = $qs{action};
    my $slo;
    $slo = '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type="button"  name="showlogout" value="  logout " onclick="window.location.href=\'./logout\';return false;"/></span>' if exists $qs{showlogout};
    my $s = $qs{reloaded} eq 'reloaded' ? '<span class="positive">(page was auto reloaded)</span><br /><br />' : '';

    if ($addr && $action && $qs{Submit} && ! $wrongaddr) {
        if ($action eq '1' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noProcessingIPs')) {
            my $r = $GPBmodTestList->('GUI','noProcessingIPs','add',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr added to noProcessingIPs" : "$addr not added to noProcessingIPs";
        } elsif ($action eq '2' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noProcessingIPs')) {
            my $r = $GPBmodTestList->('GUI','noProcessingIPs','delete',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr removed from noProcessingIPs" : "$addr not removed from noProcessingIPs";
        } elsif ($action eq '3' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','whiteListedIPs')) {
            my $r = $GPBmodTestList->('GUI','whiteListedIPs','add',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr added to whiteListedIPs" : "$addr not added to whiteListedIPs";
        } elsif ($action eq '4' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','whiteListedIPs')) {
            my $r = $GPBmodTestList->('GUI','whiteListedIPs','delete',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr removed from whiteListedIPs" : "$addr not removed from whiteListedIPs";
        } elsif ($action eq '5' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noDelay')) {
            my $r = $GPBmodTestList->('GUI','noDelay','add',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr added to noDelay" : "$addr not added to noDelay";
        } elsif ($action eq '6' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noDelay')) {
            my $r = $GPBmodTestList->('GUI','noDelay','delete',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr removed from noDelay" : "$addr not removed from noDelay";
        } elsif ($action eq '7' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','denySMTPConnectionsFrom')) {
            my $r = $GPBmodTestList->('GUI','denySMTPConnectionsFrom','add',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr added to denySMTPConnectionsFrom" : "$addr not added to denySMTPConnectionsFrom";
        } elsif ($action eq '8' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','denySMTPConnectionsFrom')) {
            my $r = $GPBmodTestList->('GUI','denySMTPConnectionsFrom','delete',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr removed from denySMTPConnectionsFrom" : "$addr not removed from denySMTPConnectionsFrom";
        } elsif ($action eq '9' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noBlockingIPs')) {
            my $r = $GPBmodTestList->('GUI','noBlockingIPs','add',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr added to noBlockingIPs" : "$addr not added to noBlockingIPs";
        } elsif ($action eq 'A' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noBlockingIPs')) {
            my $r = $GPBmodTestList->('GUI','noBlockingIPs','delete',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr removed from noBlockingIPs" : "$addr not removed from noBlockingIPs";
        } elsif ($action eq 'B' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','denySMTPConnectionsFromAlways')) {
            my $r = $GPBmodTestList->('GUI','denySMTPConnectionsFromAlways','add',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr added to denySMTPConnectionsFromAlways" : "$addr not added to denySMTPConnectionsFromAlways";
        } elsif ($action eq 'C' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','denySMTPConnectionsFromAlways')) {
            my $r = $GPBmodTestList->('GUI','denySMTPConnectionsFromAlways','delete',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr removed from denySMTPConnectionsFromAlways" : "$addr not removed from denySMTPConnectionsFromAlways";
        } elsif ($action eq 'D' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb')) {
            my $t = time;
            my $data="$t $t 2";
            my $ip=&ipNetwork($addr,1);
            $PBWhite{$ip}=$data;
            $PBWhite{$addr}=$data;
            $s = "$addr added to PenaltyBox white" ;
        } elsif ($action eq 'E' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb')) {
            &pbWhiteDelete(0,$addr);
            $s = "$addr removed from PenaltyBox white" ;
        } elsif ($action eq 'F' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb')) {
            my $ip=&ipNetwork($addr, $PenaltyUseNetblocks );
            delete $PBBlack{$ip};
            delete $PBBlack{$addr};
            $s = "$addr removed from PenaltyBox black";
        } elsif ($action eq 'G' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb')) {
            delete $PTRCache{$addr};
            $s = "$addr removed from PTR Cache";
        } elsif ($action eq 'H' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb')) {
            delete $URIBLCache{$addr};
            $s = "$addr removed from URIBL Cache";
        } elsif ($action eq 'I' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb')) {
            my @record = SBCacheFind($addr);
            my $domain = [split( /\|/o, $record[2])]->[2];
            delete $WhiteOrgList{lc $domain} if $domain;
            delete $SBCache{$record[0]};
            $s = "$record[0] removed from SenderBase Cache";
        } elsif ($action eq 'J' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb')) {
            delete $RBLCache{$addr};
            $s = "$addr removed from RBL Cache";
        } elsif ($action eq 'K' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb')) {
            delete $MXACache{$addr};
            $s = "$addr removed from MXA Cache";
        } elsif ($action eq 'L' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb')) {
            delete $BackDNS{$addr};
            delete $BackDNS2{$addr};
            $s = "$addr removed from Backscatter Cache";
        } elsif ($action eq 'M' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb')) {
            delete $RWLCache{$addr};
            $s = "$addr removed from RWL Cache";
        } elsif ($action eq 'N' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noScanIP')) {
            my $r = $GPBmodTestList->('GUI','noScanIP','add',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr added to Virus-noScanIP" : "$addr not added to Virus-noScanIP";
        } elsif ($action eq 'O' && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noScanIP')) {
            my $r = $GPBmodTestList->('GUI','noScanIP','delete',' - via MaillogTail',$addr,0);
            $s = ($r > 0) ? "$addr removed from Virus-noScanIP" : "$addr not removed from Virus-noScanIP";
        } elsif ($action) {
            $s = "<span class=\"negative\">access denied for the selected action</span>";
        }
    }
    $s = 'no action selected - or no result available' if (! $s && $qs{Submit});

    if ($s =~ /\Q$addr\E (?:added to|removed from)/ && $qs{Submit}) {
        $ConfigChanged = 1;
        &tellThreadsReReadConfig();   # reread the config
    }

    my $option  = "<option value=\"0\">select action</option>";
    if ($addr && ! $wrongaddr) {
        $option .= "<option value=\"1\">add to noProcessing IP's</option>"
         if (! $local && $noProcessingIPs=~/\s*file\s*:\s*.+/o && ! matchIP( $addr, 'noProcessingIPs',0,1 ) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noProcessingIPs'));
        $option .= "<option value=\"2\">remove from noProcessing IP's</option>"
         if (! $local && $noProcessingIPs=~/\s*file\s*:\s*.+/o &&  matchIP( $addr, 'noProcessingIPs',0,1 ) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noProcessingIPs'));
        $option .= "<option value=\"3\">add to whitelisted IP's</option>"
         if (! $local && $whiteListedIPs=~/\s*file\s*:\s*.+/o && ! matchIP( $addr, 'whiteListedIPs',0,1 ) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','whiteListedIPs'));
        $option .= "<option value=\"4\">remove from whitelisted IP's</option>"
         if (! $local && $whiteListedIPs=~/\s*file\s*:\s*.+/o &&  matchIP( $addr, 'whiteListedIPs',0,1 ) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','whiteListedIPs'));
        $option .= "<option value=\"5\">add to noDelay IP's</option>"
         if (! $local && $noDelay=~/\s*file\s*:\s*.+/o && ! matchIP( $addr, 'noDelay',0,1 ) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noDelay'));
        $option .= "<option value=\"6\">remove from noDelay IP's</option>"
         if (! $local && $noDelay=~/\s*file\s*:\s*.+/o &&  matchIP( $addr, 'noDelay',0,1 ) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noDelay'));
        $option .= "<option value=\"7\">add to Deny Connections from these IP's</option>"
         if (! $local && $denySMTPConnectionsFrom=~/\s*file\s*:\s*.+/o && ! matchIP( $addr, 'denySMTPConnectionsFrom',0,1 ) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','denySMTPConnectionsFrom'));
        $option .= "<option value=\"8\">remove from Deny Connections from these IP's</option>"
         if (! $local && $denySMTPConnectionsFrom=~/\s*file\s*:\s*.+/o &&  matchIP( $addr, 'denySMTPConnectionsFrom',0,1 ) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','denySMTPConnectionsFrom'));
        $option .= "<option value=\"9\">add to Do not block Connections from these IP's</option>"
         if (! $local && $noBlockingIPs=~/\s*file\s*:\s*.+/o && ! matchIP( $addr, 'noBlockingIPs',0,1 ) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noBlockingIPs'));
        $option .= "<option value=\"A\">remove from Do not block Connections from these IP's</option>"
         if (! $local && $noBlockingIPs=~/\s*file\s*:\s*.+/o &&  matchIP( $addr, 'noBlockingIPs',0,1 ) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noBlockingIPs'));
        $option .= "<option value=\"B\">add to Deny Connections from these IP's Strictly</option>"
         if (! $local && $denySMTPConnectionsFromAlways=~/\s*file\s*:\s*.+/o && ! matchIP( $addr, 'denySMTPConnectionsFromAlways',0,1 ) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','denySMTPConnectionsFromAlways'));
        $option .= "<option value=\"C\">remove from Deny Connections from these IP's Strictly</option>"
         if (! $local && $denySMTPConnectionsFromAlways=~/\s*file\s*:\s*.+/o &&  matchIP( $addr, 'denySMTPConnectionsFromAlways',0,1 ) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','denySMTPConnectionsFromAlways'));
        $option .= "<option value=\"D\">add to PenaltyBox white</option>"
         if (! &pbWhiteFind($addr) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb'));
        $option .= "<option value=\"E\">remove from PenaltyBox white</option>"
         if (&pbWhiteFind($addr) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb'));
        $option .= "<option value=\"F\">remove from PenaltyBox black</option>"
         if (&pbBlackFind($addr) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb'));
        $option .= "<option value=\"G\">remove from PTR Cache</option>"
         if (&PTRCacheFind($addr) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb'));
        $option .= "<option value=\"H\">remove from URIBL Cache</option>"
         if (&URIBLCacheFind($addr) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb'));
        $option .= "<option value=\"I\">remove from SenderBase Cache</option>"
         if (&SBCacheFind($addr) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb'));
        $option .= "<option value=\"J\">remove from RBL Cache</option>"
         if (&RBLCacheFind($addr) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb'));
        $option .= "<option value=\"K\">remove from MXA Cache</option>"
         if (&MXACacheFind($addr) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb'));
        $option .= "<option value=\"L\">remove from Backscatter Cache</option>"
         if (&BackDNSCacheFind($addr) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb'));
        $option .= "<option value=\"M\">remove from RWL Cache</option>"
         if (&RWLCacheFind($addr) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','pbdb'));
        $option .= "<option value=\"N\">add to Do Not Scan Messages from these IP\'s</option>"
         if ($noScanIP=~/\s*file\s*:\s*.+/o && ! matchIP( $addr, 'noScanIP',0,1 ) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noScanIP'));
        $option .= "<option value=\"O\">remove from Do Not Scan Messages from these IP\'s</option>"
         if ($noScanIP=~/\s*file\s*:\s*.+/o &&  matchIP( $addr, 'noScanIP',0,1 ) && &canUserDo($WebIP{$ActWebSess}->{user},'cfg','noScanIP'));
    }

    if ($addr && ! $wrongaddr) {
        $s .= "<br /><br /><b>general IP-matches for $addr :</b><br /><br />\n";
        foreach (sort {lc($main::a) cmp lc($main::b)} keys %MakeIPRE) {
            next unless &canUserDo($WebIP{$ActWebSess}->{user},'cfg',$_);
            my $res = matchIP( $addr, $_,0,1 );
            $s .= "matches in<b> $_ </b>with <b>$res</b><br />" if $res;
        }
    }

    return <<EOT;
$headerHTTP

<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
  <meta http-equiv="content-type" content="application/xhtml+xml; charset=utf-8" />
  <title>$currentPage ASSP IP action ($myName)</title>
  <link rel=\"stylesheet\" href=\"get?file=images/editor.css\" type=\"text/css\" />
</head>
<body onmouseover="this.focus();" ondblclick="this.select();">
<h2>add/remove IP addresses from lists</h2><hr>
    <div class="content">
      <form name="edit" id="edit" action="" method="post" autocomplete="off">
        <h3>IP-address or hostname to work with</h3>
        <input name="ip" size="20" autocomplete="off" value="$addr" onchange="document.forms['edit'].action.value='0';document.forms['edit'].reloaded.value='reloaded';document.forms['edit'].submit();return false;"/>
        $wrongaddr
        <br /><hr>
        <div style="align: left">
         <div class="shadow">
          <div class="option">
           <div class="optionValue">
            <select size="1" name="action">
             $option
            </select>
           </div>
          </div>
         </div>
        </div>
        <hr>
        <input type="submit" name="Submit" value="Submit" />&nbsp;&nbsp;&nbsp;&nbsp;
        <input type="hidden" name="reloaded" value="" />
        <input type="button" value="Close" onclick="javascript:window.close();"/>
        $slo
        <hr>
      </form>
      <br />Only configured, possible and authorized option are shown.
      <hr>
      <div class="note" id="notebox">
        <h3>results for action</h3><hr>
        $s
      </div>
    </div>
</body>
</html>

EOT
}

sub modListOnEdit {
    my ($reportaddr, $to, $mail, $fh) = @_;
    $fh ||= 'modListOnEdit';
    $Con{$fh}->{reportaddr} = $reportaddr;
    return unless $EmailAdminReportsTo;
    my $mailfrom = $Con{$fh}->{mailfrom};
    my $header = $Con{$fh}->{header};
    $Con{$fh}->{mailfrom} = $EmailAdminReportsTo || $to;
    $Con{$fh}->{header} = ${$mail};
    for my $addr (&ListReportGetAddr($fh)) {
        &ListReportExec($addr,$Con{$fh});
    }
    $Con{$fh}->{mailfrom} = $mailfrom ;
    $Con{$fh}->{header} = $header;
    my $ret = $Con{$fh}->{report};
    $ret =~ s/^(?:\s|\r|\n)+//o;
    $ret =~ s/\r?\n/<br \/>/gos;
    $ret = '<br />'.$ret if $ret;
    delete $Con{$fh} if $fh eq 'modListOnEdit';
    return $ret;
}

sub ConfigEdit {
 my $fil = $qs{file};
 $qs{note} = lc $qs{note};
 my $htmlfil;
 my $note = q{};
 my ($cidr,$regexp1,$regexp2);
 my ($s1,$s2,$editButtons,$option, $ishash, $hash);
 my $noLineNum = '';

 $cidr=$regexp1=$regexp2=q{};
 
 my $hashnote = '<div class="note" id="notebox">';
 $hashnote .= $WebIP{$ActWebSess}->{lng}->{'msg500080'} || $lngmsg{'msg500080'};
 $hashnote .= '</div>';
 if ($qs{note} eq '1' or $qs{note} eq '1h'){        # edit file hash
  $note = '<div class="note" id="notebox">';
  $note .= $WebIP{$ActWebSess}->{lng}->{'msg500081'} || $lngmsg{'msg500081'};
  $note .= '</div>';
 }
 elsif($qs{note} eq '2'){
  $note = '<div class="note" id="notebox">';
  $note .= $WebIP{$ActWebSess}->{lng}->{'msg500082'} || $lngmsg{'msg500082'};
  $note .= '</div>';
 }
 elsif($qs{note} eq '3'){
  $note = '<div class="note" id="notebox">';
  $note .= $WebIP{$ActWebSess}->{lng}->{'msg500083'} || $lngmsg{'msg500083'};
  $note .= '</div>';
 }
 elsif($qs{note} eq '4'){
  $note = '<div class="note" id="notebox">';
  $note .= $WebIP{$ActWebSess}->{lng}->{'msg500084'} || $lngmsg{'msg500084'};
  $note .= '</div>';
 }
   elsif($qs{note} eq '5'){
  $note = '<div class="note" id="notebox"></div>';
 }
  elsif($qs{note} eq '6'){
  $note = '<div class="note" id="notebox">';
  $note .= $WebIP{$ActWebSess}->{lng}->{'msg500086'} || $lngmsg{'msg500086'};
  $note .= '</div\>';
 }
 elsif($qs{note} eq '8' or $qs{note} eq '9'){       # show  file hash
  $note = '<div class="note" id="notebox"></div>';
 }
 elsif ($qs{note} eq 'm'){                          # mail file
        $fil="$base/$fil" if $fil!~/^\Q$base\E/io;
        $option  = "<option value=\"0\">select action</option>";
        $option .= "<option value=\"1\">copy file to resendmail</option>" if($CanUseEMS && $resendmail && $fil !~/\/$resendmail\//);
        $option .= "<option value=\"2\">save file</option>";
        $option .= "<option value=\"3\">copy file to notspamlog</option>" if ($fil !~/\/$notspamlog\//);
        $option .= "<option value=\"4\">copy file to spamlog</option>" if ($fil !~/\/$spamlog\//);
        $option .= "<option value=\"5\">copy file to incomingOkMail</option>" if ($fil !~/\/$incomingOkMail\//);
        $option .= "<option value=\"6\">copy file to viruslog</option>" if ($fil !~/\/$viruslog\//);
        $option .= "<option value=\"7\">copy file to correctedspam</option>" if ($fil !~/\/$correctedspam\//);
        $option .= "<option value=\"8\">copy file to correctednotspam</option>" if ($fil !~/\/$correctednotspam\//);
        $option .= "<option value=\"9\">copy file to rebuild_error</option>" if ($fil !~/\/rebuild_error\//);

        $note = '<div class="note" id="notebox">';
        $note .= $WebIP{$ActWebSess}->{lng}->{'msg500090'} || $lngmsg{'msg500090'};
        $note .= $WebIP{$ActWebSess}->{lng}->{'msg500091'} || $lngmsg{'msg500091'} if !($CanUseEMS && $resendmail && $fil !~/\/$resendmail\//);
 }

#$regexp1 = $WebIP{$ActWebSess}->{lng}->{'msg500011'} || $lngmsg{'msg500011'} if !$CanMatchCIDR;
#$regexp2 = $WebIP{$ActWebSess}->{lng}->{'msg500012'} || $lngmsg{'msg500012'} if !$CanMatchCIDR;
$regexp1 = $WebIP{$ActWebSess}->{lng}->{'msg500013'} || $lngmsg{'msg500013'};
$regexp2 = $WebIP{$ActWebSess}->{lng}->{'msg500014'} || $lngmsg{'msg500014'};

$cidr = $WebIP{$ActWebSess}->{lng}->{'msg500015'} || $lngmsg{'msg500015'} if !$CanUseCIDRlite;
$cidr = $WebIP{$ActWebSess}->{lng}->{'msg500016'} || $lngmsg{'msg500016'} if $CanUseCIDRlite;
 if ($qs{note} eq '7'){
  $note = "<div class='note' id='notebox'>";
  $note .= $WebIP{$ActWebSess}->{lng}->{'msg500092'} || $lngmsg{'msg500092'};
  $note .= "$regexp1 $cidr $regexp2</div>";
 }
 $s2 = '';
 if ($fil =~ /\.\./o){
  $s2.='<div class="text"><span class="negative">File path includes \'..\' -- access denied</span></div>';
  mlog(0,"file path not allowed while editing file '$fil'");
 } else {
  #$fil="$base/$fil" if $fil!~/^(([a-z]:)?[\/\\]|\Q$base\E)/;
  if ($fil =~ /^DB-(.+)/o) {
      $ishash = $1;
      $hash = getHashName($ishash,'');
      $htmlfil = $fil;
      $note = $hashnote.$note;
      $note =~ s/\<\/div\>\<div class\=\"note\" id\=\"notebox\"\>/<br \/><br \/>/o;
  } else {
      $hash = getHashName('', $fil);
      if ($hash) {
          $ishash = $hash;
          SaveHash($hash);
          $htmlfil = $fil;
          $note = $hashnote.$note;
          $note =~ s/\<\/div\>\<div class\=\"note\" id\=\"notebox\"\>/<br \/><br \/>/o;
      } else {
          $fil="$base/$fil" if $fil!~/^\Q$base\E/io;
          $htmlfil = $fil;
          $ishash = 0;
      }
  }
  if ($qs{B1}=~/delete/io) {
    if ($ishash) {
       if ($hash) {
           %$hash = ();
           $s2='<span class="positive">list ' .$ishash. ' cleaned successfully</span>';
       } else {
           $s2='<span class="negative">unable to clean list ' .$ishash.' - no such list</span>';
       }
    } else {
       if ($unlink->($fil)) {
           $s2='<span class="positive">File '.$fil.' deleted successfully</span>';
       } else {
           $s2='<span class="negative">unable to delete File ' .$fil. ' - $!</span>';
           mlog(0,"error: unable to delete file $fil - $!");
       }
    }
  } else {
   if (defined($qs{contents})) {
    $s1=$qs{contents};
    $s1= decodeHTMLEntities($s1);
    $s1 =~ s/\n$//o; # prevents ASSP from appending a newline to the file each time it is saved.
    $s1 =~ s/\r$//o;
    $s1 =~ s/\s+$//o;
   # make line terminators uniform
    if ($qs{note} ne 'm') {
      $s1 =~ s/\r?\n/\n/go;
      if ($ishash) {
        if ($hash) {
            $s1 =~ s/\[(\+?\d{4}\-\d{2}\-\d{2}\,\d{2}\:\d{2}\:\d{2})\]/&timeval($1)/geo
                if $hash ne 'Stats';
            if ($qs{B1}=~/Save to Importfile/io) {
                my $filename = getHashBDBName($hash);
                $filename = "/$filename" if $filename !~ /\//o;
                ($filename) = $filename =~ /^.*\/([^\/]+)$/o;
                $filename = "$base/$importDBDir/$filename.rpl";
                unlink "$base/$importDBDir/$filename.rpl.OK";
                $s1 =~ s/[\s\n]*$//o;
                $s1 =~ s/^[\s\n]*//o;
                $s1 =~ s/\n{2,}/\n/go;
                $s1 =~ s/\|::\|/\x02/go;
                $s1 = "\n" . $s1;
                if (open(my $CE,">",$filename)) {
                    binmode $CE;
                    print $CE $s1;
                    close $CE;
                    $s2='<span class="positive">Importfile '.$filename.' saved successfully</span>';
                    if (! $RunTaskNow{ImportMysqlDB} && ! $RunTaskNow{ExportMysqlDB}) {
                        $RunTaskNow{ImportMysqlDB} = 10000;
                        $s2 .='<br /><span class="positive">DB-Import was queued to run</span>';
                    } else {
                        $s2 .='<br /><span class="negative">DB-Import or DB-Export is still running</span>';
                    }
                } else {
                    $s2='<span class="negative">unable to save Importfile '.$filename.' - $@</span>';
                }
            } else {
                $s1 =~ s/[\s\n]*$//o;
                $s1 =~ s/^[\s\n]*//o;
                $s1 =~ s/\n{2,}/\n/go;
                %$hash = split(/\|::\||\n/o,$s1);
                delete $$hash{''};
                $s2='<span class="positive">list saved successfully</span>';
            }
        } else {
            $s2='<span class="negative">unable to save list ' .$ishash. ' - no such list</span>';
        }
      } else {
        if (open(my $CE,">",$fil)) {
            binmode $CE;
#encrypt if to do
            if (exists $CryptFile{$fil}) {
                my $enc = ASSP::CRYPT->new($webAdminPassword,0);
                $s1 = $enc->ENCRYPT($s1)
            }
            print $CE $s1;
            close $CE;
            $s2='<span class="positive">File saved successfully</span>';
            if ($fil =~ /language\//o) {
                $WebIP{$ActWebSess}->{changedLang} = 1;
            } else {
                $ConfigChanged = 1;
                &tellThreadsReReadConfig();   # reread the config to get regex mistakes in edit browser
            }
        } else {
            $s2='<span class="negative">unable to save File $fil - $!</span>';
            mlog(0,"error: unable to save file $fil - $!");
        }
      }
    } else {      # to take actions on a mailfile
         $s1 =~ s/([^\r])\n/$1\r\n/go;
         $s1 .= "\r\n";
         my $action = $qs{fileaction};
         if ($action eq '1') {    # resend
             $s1 = "\r\n" . $s1;
             my $rfil = $fil;
             $rfil =~ s/^(\Q$base\E\/).+(\/.+\Q$maillogExt\E)$/$1$resendmail$2/i;
             my ($to) = $s1 =~ /\nX-Assp-Intended-For:[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?/sio;
             ($to) = $s1 =~ /\nto:[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?/sio unless $to;
             my ($from) = $s1 =~ /\nX-Assp-Envelope-From:[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?/sio;
             ($from) = $s1 =~ /\nfrom:[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?/sio unless $from;
             $s1 =~ s/^\r\n//o;
             $s2='';
             if (! $to ) {
                 $s2 .= '<br />' if $s2;
                 $s2 .= '<span class="negative">!!! no addresses found in X-Assp-Intended-For: or TO: header line - please check !!!</span>';
             }
             if (! $from ) {
                 $s2 .= '<br />' if $s2;
                 $s2 .= '<span class="negative">!!! no addresses found in X-Assp-Envelope-From: or FROM: header line - please check !!!</span>';
             }
             if ((! $nolocalDomains && ! (localmail($to) or localmail($from)))) {
                 $s2 .= '<br />' if $s2;
                 $s2 .= '<span class="negative">!!! no local addresses found in X-Assp-Intended-For: or TO: header line - please check !!!</span>'
                     unless localmail($to);
                 $s2 .= '<br />' if $s2 =~ /span>$/o;
                 $s2 .= '<span class="negative">!!! no local addresses found in X-Assp-Envelope-From: or FROM: header line - please check !!!</span>'
                     unless localmail($from);
             }
             if (! $s2) {
                 if ($open->(my $CE,'>',$rfil)) {
                     $CE->binmode;
                     $CE->print($s1);
                     $CE->close;
                     $s2 .= '<span class="positive">File copied to resendmail folder</span>';
                     mlog(0,"info: request to create file: $rfil");
                     $nextResendMail = $nextResendMail < time + 3 ? $nextResendMail: time + 3;
                 } else {
                     $s2 .= '<span class="negative">unable to create file in resendmail folder - $!</span>';
                     mlog(0,"error: unable to create file in resendmail folder - $!");
                 }
             }
         } elsif ($action eq '2') {    # save
             if ($open->(my $CE,'>',$fil)) {
                 $CE->binmode;
                 $CE->print($s1);
                 $CE->close;
                 my $rs = quotemeta($correctedspam);
                 my $rh = quotemeta($correctednotspam);
                 if ($eF->( $fil ) && $fil =~ /(?<s>$rs)|(?<h>$rh)/o) {
                     $newReported{$fil} = $+{s} ? 'spam' : 'ham';
                 }
                 $s2='<span class="positive">File saved successfully</span>';
             } else {
                 $s2='<span class="negative">unable to save file - $!</span>';
                 mlog(0,"error: unable to save file - $!");
             }
         } elsif ($action eq '3') {    # copy to notspam
             my $rfil = $fil;
             $rfil =~s/^(\Q$base\E\/).+(\/.+\Q$maillogExt\E)$/$1$notspamlog$2/i;
             if ($open->(my $CE,'>',$rfil)) {
                 $CE->binmode;
                 $CE->print($s1);
                 $CE->close;
                 $s2='<span class="positive">File copied to notspamlog folder</span>';
                 mlog(0,"info: request to create file: $rfil");
             } else {
                 $s2='<span class="negative">unable to create file in notspamlog folder - $!</span>';
                 mlog(0,"error: unable to create file in notspamlog folder - $!");
             }
         } elsif ($action eq '4') {    # copy to spam
             my $rfil = $fil;
             $rfil =~s/^(\Q$base\E\/).+(\/.+\Q$maillogExt\E)$/$1$spamlog$2/i;
             if ($open->(my $CE,'>',$rfil)) {
                 $CE->binmode;
                 $CE->print($s1);
                 $CE->close;
                 $s2='<span class="positive">File copied to spamlog folder</span>';
                 mlog(0,"info: request to create file: $rfil");
             } else {
                 $s2='<span class="negative">unable to create file in spamlog folder - $!</span>';
                 mlog(0,"error: unable to create file in spamlog folder - $!");
             }
         } elsif ($action eq '5') {    # incomingOkMail
             my $rfil = $fil;
             $rfil =~s/^(\Q$base\E\/).+(\/.+\Q$maillogExt\E)$/$1$incomingOkMail$2/i;
             if ($open->(my $CE,'>',$rfil)) {
                 $CE->binmode;
                 $CE->print($s1);
                 $CE->close;
                 $s2='<span class="positive">File copied to incomingOkMail folder</span>';
                 mlog(0,"info: request to create file: $rfil");
             } else {
                 $s2='<span class="negative">unable to create file in incomingOkMail folder - $!</span>';
                 mlog(0,"error: unable to create file in incomingOkMail folder - $!");
             }
         } elsif ($action eq '6') {    # viruslog
             my $rfil = $fil;
             $rfil =~s/^(\Q$base\E\/).+(\/.+\Q$maillogExt\E)$/$1$viruslog$2/i;
             if ($open->(my $CE,'>',$rfil)) {
                 $CE->binmode;
                 $CE->print($s1);
                 $CE->close;
                 $s2='<span class="positive">File copied to viruslog folder</span>';
                 mlog(0,"info: request to create file: $rfil");
             } else {
                 $s2='<span class="negative">unable to create file in viruslog folder - $!</span>';
                 mlog(0,"error: unable to create file in viruslog folder - $!");
             }
         } elsif ($action eq '7') {    # correctedspam
             my $rfil = $fil;
             $rfil =~s/^(\Q$base\E\/).+(\/.+\Q$maillogExt\E)$/$1$correctedspam$2/i;
             if ($open->(my $CE,'>',$rfil)) {
                 $CE->binmode;
                 $CE->print($s1);
                 $CE->close;
                 $s2='<span class="positive">File copied to correctedspam folder</span>';
                 mlog(0,"info: request to create file: $rfil");

                 my ($to) = $s1 =~ /\nX-Assp-Intended-For:[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?/sio;
                 ($to) = $s1 =~ /\nto:[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?/sio unless $to;
                 my ($from) = $s1 =~ /\nX-Assp-Envelope-From:[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?/sio;
                 ($from) = $s1 =~ /\nfrom:[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?/sio unless $from;
                 if (   ($EmailErrorsModifyWhite == 1 || $EmailErrorsModifyNoP == 1 || matchSL( $to, 'EmailErrorsModifyPersBlack' ))
                     && $to
                     && &localmail($to)
                     && $from && lc $from ne 'assp <>'
                     && ! &localmail($from)
                    )
                 {
                     if (matchSL( $to, 'EmailErrorsModifyPersBlack' , 1)) {
                         $s2 .= modListOnEdit('EmailPersBlackAdd',$to,\$s1,undef);
                         mlog( 0, "info: possibly personal black entries added on File copied to correctedspam folder" )
                           if $MaintenanceLog;
                     }
                     if ($EmailErrorsModifyWhite == 1 || $EmailErrorsModifyNoP == 1) {
                         $s2 .= modListOnEdit('EmailSpam',$to,\$s1,undef);
                         mlog( 0, "info: possibly noprocessing and/or whitelist entries removed on File copied to correctedspam folder" )
                           if $MaintenanceLog;
                     }
                 }
                 $eF->( $rfil ) && ($newReported{$rfil} = 'spam');
             } else {
                 $s2 = '<span class="negative">unable to create file in correctedspam folder - $!</span>';
                 mlog(0,"error: unable to create file in correctedspam folder - $!");
             }
         } elsif ($action eq '8') {    # correctednotspam
             my $rfil = $fil;
             $rfil =~s/^(\Q$base\E\/).+(\/.+\Q$maillogExt\E)$/$1$correctednotspam$2/i;
             if ($open->(my $CE,'>',$rfil)) {
                 $CE->binmode;
                 $CE->print($s1);
                 $CE->close;
                 $s2='<span class="positive">File copied to correctednotspam folder</span>';
                 mlog(0,"info: request to create file: $rfil");

                 my ($to) = $s1 =~ /\nX-Assp-Intended-For:[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?/sio;
                 ($to) = $s1 =~ /\nto:[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?/sio unless $to;
                 my ($from) = $s1 =~ /\nX-Assp-Envelope-From:[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?/sio;
                 ($from) = $s1 =~ /\nfrom:[^\<]*?<?($EmailAdrRe\@$EmailDomainRe)>?/sio unless $from;
                 if (   ($EmailErrorsModifyWhite == 1 || $EmailErrorsModifyNoP == 1 || matchSL( $to, 'EmailErrorsModifyPersBlack' ))
                     && $to
                     && &localmail($to)
                     && $from
                     && lc $from ne 'assp <>'
                     && ! &localmail($from)
                    )
                 {
                     if (matchSL( $to, 'EmailErrorsModifyPersBlack', 1 )) {
                         $s2 .= modListOnEdit('EmailPersBlackRemove',$to,\$s1,undef);
                         mlog( 0, "info: possibly personal black entries removed on File copied to correctednotspam folder" )
                           if $MaintenanceLog;
                     }
                     if ($EmailErrorsModifyWhite == 1 || $EmailErrorsModifyNoP == 1) {
                         $s2 .= modListOnEdit('EmailHam',$to,\$s1,undef);
                         mlog( 0, "info: possible noprocessing and/or whitelist entries added on File copied to correctednotspam folder" )
                           if $MaintenanceLog;
                     }
                 }
                 $eF->( $rfil ) && ($newReported{$rfil} = 'ham');
             } else {
                 $s2='<span class="negative">unable to create file in correctednotspam folder - $!</span>';
                 mlog(0,"error: unable to create file in correctednotspam folder - $!");
             }
         } elsif ($action eq '9') {    # copy to rebuild_error
             my $rfil = $fil;
             $rfil =~s/^(\Q$base\E\/)(.+\/.+\Q$maillogExt\E)$/$1rebuild_error\/$2/i;
             if ($open->(my $CE,'>',$rfil)) {
                 $CE->binmode;
                 $CE->print($s1);
                 $CE->close;
                 $s2='<span class="positive">File copied to rebuild_error folder</span>';
                 mlog(0,"info: request to create file: $rfil");
             } else {
                 $s2='<span class="negative">unable to create file in rebuild_error folder - $!</span>';
                 mlog(0,"error: unable to create file in rebuild_error folder - $!");
             }
         }
         $qs{fileaction} = '0';
    }
   }
  }
  if ($ishash) {
    if ($hash) {
      if($qs{B1}!~/Save to Importfile/io) {
        my @S1;
        my $i = 0;
        if ($hash =~ /^T10Stat(.)$/o) {
            my @th = &T10StatGet($1,0);
            while (@th) {
                push @S1 , encodeHTMLEntities((shift @th) .'|::|'. (shift @th));
            }
        } else {
            while ( my ($k,$v) = each %$hash) {
                next unless $k;
                $v =~ s/(\d{10,11})/'[' . &timestring($1,'','YYYY-MM-DD,hh:mm:ss') . ']'/geo
                    if (   $qs{note} ne 'm'
                        && $hash ne 'Stats');
                push @S1, encodeHTMLEntities("$k\|::\|$v");
                if ($i++ == 1000) {
                    &ThreadMonitorMainLoop("read HASH $hash - $i records - for GUI-Edit");
                    $i = 0;
                }
            }
        }
        my $cnt = scalar @S1;
        $s1 = join("\n",@S1);
        if ($cnt > 10000) {
            $note =~ s/<\/div>//o;
            $note .= '<span class="negative"><br />';
            $note .= $WebIP{$ActWebSess}->{lng}->{'msg500093'} || $lngmsg{'msg500093'};
            $note .= $cnt.' ';
            $note .= $WebIP{$ActWebSess}->{lng}->{'msg500094'} || $lngmsg{'msg500094'};
            $note .= '</span></div>';
        }
      } else {
            $note = '<div class="note" id="notebox"><span class="negative">';
            $note .= $WebIP{$ActWebSess}->{lng}->{'msg500095'} || $lngmsg{'msg500095'};
            $note .= '</span></div>';
      }
    }
  } else {
    if($open->(my $CE,'<',$fil)) {
     $CE->read($s1,[$stat->($fil)]->[7]);
#dencrypt if to do
     if (exists $CryptFile{$fil} && $s1 =~ /^(?:[a-zA-Z0-9]{2})+$/o) {
         my $enc = ASSP::CRYPT->new($webAdminPassword,0);
         $s1 = $enc->DECRYPT($s1);
     }
     $CE->close;
     if ($qs{note} eq '9') {
         my $body = cleanMIMEBody2UTF8(\$s1);
         $body ||= 'decoding error';
         $s1 = cleanMIMEHeader2UTF8(\$s1,0) . $body;
         $s1 = encodeHTMLEntities($s1);
         $s1 =~ s/(?:\r?\n|\r)/\n/go;
     } else {
         $s1 =~ s/(?:\r?\n|\r)/\n/go;
         $s1= encodeHTMLEntities($s1);
     }
    } else {
     $s2='<span class="negative">'.ucfirst($!).'</span>';
    }
  }

  my $slo;
  $slo = '&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type="button"  name="showlogout" value="  logout " onclick="window.location.href=\'./logout\';return false;"/></span>' if exists $qs{showlogout};

  if ($eF->( $fil ) or $fil =~ /^DB-/o) {
      if($qs{note} eq '8' or $qs{note} eq '9') {
          $editButtons='<div><input type="button" value="Close" onclick="javascript:window.close();"/></div>';
          $noLineNum = 'return false;';
      } elsif ($qs{note} eq 'm') {
          $noLineNum = 'return false;';
          if ($s1 !~ /\n\.\n+$/o) {
              $note .= '<br /><font color=blue>';
              $note .= $WebIP{$ActWebSess}->{lng}->{'msg500096'} || $lngmsg{'msg500096'};
              $note .= '</font>';
          }
          $note .= '</div>';

          $editButtons="
 <div style=\"align: left\">
  <div class=\"shadow\">
   <div class=\"option\">
    <div class=\"optionValue\">
     <select size=\"1\" name=\"fileaction\">" .
      $option . "
     </select>
    </div>
   </div>
  </div>
 </div>
 &nbsp;&nbsp;";

          $editButtons .='<div><input type="submit" name="B1" value="Do It!" />&nbsp;&nbsp;<input type="submit" name="B1" value="Delete file" onclick="return confirmDelete(\''.$fil.'\');"/>';
          my $nf = normHTML($fil);

          $editButtons .='&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type="button" value="view decoded MIME" onclick="return popFileEditor(\''. $nf .'\',9);"/>&nbsp;&nbsp;<input type="button" value="Close" onclick="javascript:window.close();"/>'.$slo.'</div>';
      } else {
          my $disabled = ($qs{B1}=~/Save to Importfile/io) ? 'disabled="disabled"' : '';
          my $fn = $hash ? 'list' : 'file';
          my $savetofile = ($hash && $importDBDir && $qs{note} ne '1h') ? '&nbsp;<input type="submit" name="B1" value="Save to Importfile" '.$disabled.' />' : '';
          $editButtons='<div><input type="submit" name="B1" value="Save changes" '.$disabled.' />&nbsp;<input type="submit" name="B1" '.$disabled.' value="Delete '. $fn . '" onclick="return confirmDelete(\''.$fil.'\');"/>'.$savetofile .'
              &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type="button" value="Close" onclick="javascript:window.close();"/>'.$slo.'</div>';
      }
  } else {
   $noLineNum = 'return false;';
   my $fn = $hash ? 'list' : 'file';
   $s2='<div class="text"><span class="positive">'.$fn.' deleted</span></div>' if $qs{B1}=~/delete/io;
   $editButtons='<div><input type="submit" name="B1" value="Save changes" />&nbsp;<input type="submit" name="B1" value="Delete '.$fn.'" disabled="disabled" />
        &nbsp;&nbsp;&nbsp;&nbsp;&nbsp;<input type="button" value="Close" onclick="javascript:window.close();"/>'.$slo.'</div>';

  }		
 }

 my $s3;
 if ($qs{note} eq '1') {
     my $currStat = &StatusASSP();
     if ($currStat =~ /not healthy/io) {
       $s3 = '<a href="./statusassp" target="blank" title="ASSP '.$version.$modversion.($codename?" ( code name $codename )":'').' is running not healthy! Click to show the current detail thread status."><b><font color=\'red\'>&bull;';
       if (scalar keys %RegexError) {
           $s3 .= '&nbsp;-&nbsp; regex error in:&nbsp;';
           foreach(keys %RegexError) {
              $s3 .= $_ . ',&nbsp';
           }
           $s3 =~ s/,\&nbsp$/<br \/>/o;
       }
       $s3 .= '</font></b></a>';
     }
 }

 return <<EOT;
$headerHTTP

<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
  <meta http-equiv="content-type" content="application/xhtml+xml; charset=utf-8" />
  <title>$currentPage ASSP File Editor ($myName $htmlfil)</title>
  <link rel=\"stylesheet\" href=\"get?file=images/editor.css\" type=\"text/css\" />
    <script type="text/javascript">
//<![CDATA[
	// Javascript code and layout adapted from TinyMCE
	// http://tinymce.moxiecode.com/
    <!--
    var wHeight=0, wWidth=0, owHeight=0, owWidth=0;
	
    function resizeInputs() {
	    var contents = document.getElementById('contents');
	    var notebox = document.getElementById('notebox');
		//alert(el2.offsetHeight);

	    if (!isIE()) {
	    	 //alert(navigator.userAgent);
	         wHeight = self.innerHeight - (notebox.offsetHeight+150);
	         wWidth = self.innerWidth - 50;
	    } else {
			 //alert(navigator.userAgent);
	         wHeight = document.body.clientHeight - (notebox.offsetHeight+150);
	         wWidth = document.body.clientWidth - 50;
	    }

	    contents.style.height = Math.abs(wHeight) + 'px';
	    contents.style.width  = Math.abs(wWidth) + 'px';
	    container.style.height = Math.abs(wHeight - 18) + 'px';
    }
    
	function isIE () {
		var check,agent;
		check=/MSIE/i;
		agent=navigator.userAgent;
		if(check.test(agent)) {
			return true;
		} 
		else {
			return false;
		}
	}


	function confirmDelete(FileName)
	{
		var strmsg ="Are you sure you wish to delete: \\n" + FileName  + "\\n This action cannot be undone";
		var agree=confirm( strmsg );
		if (agree)
			return true;
		else
			return false;
	}

function popFileEditor(filename,note)
{
  var height = (note == 0) ? 500 : (note == \'m\') ? 580 : 550;
  newwindow=window.open(
    \'edit?file=\'+filename+\'&note=\'+note,
    \'FileEditorM\',
    \'width=720,height=\'+height+\',overflow=scroll,toolbar=yes,menubar=yes,location=no,personalbar=yes,scrollbars=yes,status=no,directories=no,resizable=yes\'
  );
  	// this puts focus on the popup window if we open a new popup without closing the old one.
  	if (window.focus) {newwindow.focus()}
  	return false;
}

function remember()
{
  var height =  580;
  newwindow=window.open(
    \'remember\',
    \'rememberMe\',
    \'width=720,height=\'+height+\',overflow=scroll,toolbar=yes,menubar=yes,location=no,personalbar=yes,scrollbars=yes,status=no,directories=no,resizable=yes\'
  );
  	// this puts focus on the popup window if we open a new popup without closing the old one.
  	if (window.focus) {newwindow.focus()}
  	return false;
}

function getInput() { return document.getElementById("contents").value; }
function setOutput(string) {document.getElementById("contents").value=string; }

function replaceIt() { try {
var findText = document.getElementById("find").value;
var replaceText = document.getElementById("replace").value;
setOutput(getInput().replace(eval("/"+findText+"/ig"), replaceText));
} catch(e){}}

      //-->
    //]]>
    </script>
<style type="text/css">
#container
{
	width: 40px;
	color: Gray;
	font-family: Courier New;
	font-size: 14px;
	float: left;clear: left;
	overflow: hidden;
        position: relative;
        top: 2px;
}
#divlines
{
	position: absolute;
}
</style>
</head>
<body onresize="resizeInputs();" onload="resizeInputs();" style="overflow:hidden;" onmouseover="this.focus();" ondblclick="this.select();">
    <div class="content">
      <form action="" method="post">
        <span style="float: left;">$s3<a href="javascript:void(0);" onclick="remember();return false;"><img height=12 width=12 src="$wikiinfo" alt="open the remember me window"/></a>&nbsp; Contents of $htmlfil</span><br /><hr /><br />
        <div id="message" style="float: right">$s2</div>
        <br style="clear: both;" />
        <span style="align: left">Replace: <input type="text" id="find" size="20" /> with <input type="text" id="replace" size="20" /> <input type="button" value="Replace" onclick="replaceIt();" /></span>
        <div>
          <div id="container">
            <div id="divlines">
            </div>
          </div>
          <textarea id="contents" name="contents" rows="15" style="max-width:90%;max-height:75%;width:100%;overflow:scroll;align: right;font-size: 14px; font-family: 'Courier New',Courier,monospace; " wrap="off">$s1
          </textarea>
<script type="text/javascript">
var lines = document.getElementById("divlines");
var txtArea = document.getElementById("contents");
var nLines;
window.onload = function() {
    $noLineNum
    resizeInputs();
    refreshlines();
    txtArea.onscroll = function () {
        lines.style.top = -(txtArea.scrollTop) + "px";
        return true;
    }
    txtArea.onkeyup = function () {

      var keycode;
      if (window.event) keycode = window.event.keyCode;
      else if (e) keycode = e.which;
      else return true;

      if (keycode == 13)
         {
         nLines++;
         lines.innerHTML = lines.innerHTML + nLines + "." + "<br />";
         return false;
         }
      else
         {
         return true;
         }
    }
}

function refreshlines() {
    $noLineNum
    nLines = txtArea.value.split("\\n").length;
    var innerlines = "";
    for (i=1; i<=nLines; i++) {
        innerlines = innerlines + i + "." + "<br />";
    }
    lines.innerHTML = innerlines;
    lines.style.top = -(txtArea.scrollTop) + "px";
}
</script>

          $editButtons
        </div>
      </form>
	  <br />$note
    </div>
<script type="text/javascript">
if (!isIE()) {
    resizeInputs();
    refreshlines();
}
</script>
  </body>
</html>

EOT

}

sub remember {
 return <<EOT;
$headerHTTP

<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
  <meta http-equiv="content-type" content="application/xhtml+xml; charset=utf-8" />
  <title>$currentPage ASSP remember me ($myName)</title>
  <link rel=\"stylesheet\" href=\"get?file=images/editor.css\" type=\"text/css\" />
</head>
<body onmouseover="this.focus();" ondblclick="this.select();">
    <div class="content">
      <form action="" method="post">
        <textarea  rows="10" style="max-height:25%;width:100%;overflow:scroll;align: right;font-size: 14px; font-family: 'Courier New',Courier,monospace; " wrap="on">
        </textarea>
        <textarea  rows="10" style="max-height:25%;width:100%;overflow:scroll;align: right;font-size: 14px; font-family: 'Courier New',Courier,monospace; " wrap="on">
        </textarea>
        <textarea  rows="10" style="max-height:25%;width:100%;overflow:scroll;align: right;font-size: 14px; font-family: 'Courier New',Courier,monospace; " wrap="on">
        </textarea>
        <textarea  rows="10" style="max-height:25%;width:100%;overflow:scroll;align: right;font-size: 14px; font-family: 'Courier New',Courier,monospace; " wrap="on">
        </textarea>
      </form>
    </div>
</body>
</html>

EOT
}

sub webConfig{
 my $r = '';
 my $tmp;
 $ConfigChanged = 0;
 %LDAPNotFound = ();
 # don't post partial data if somebody's browser's busted
 undef %qs unless $qs{theButton} || $qs{theButtonX};
 undef %qs if $qs{theButtonRefresh};
 my $counter = 0;
 my @tmp;
 $headerTOC = "\n<table style=\"margin-left:2cm; text-align:left;\" CELLSPACING=0 CELLPADDING=0>
<tr><th>Table of Contents: </th></tr>
<tr style=\"margin-left:3cm;\"><td>&nbsp;</td></tr>
";
 &niceConfig();
 for my $idx (0...$#ConfigArray) {
  my $c = $ConfigArray[$idx];
  if (@{$c} == 5){
   # Is a header
   @tmp = @{$c};
   push(@tmp, "setupItem$counter");
   $r .= $c->[3]->(@tmp);
   $counter++;
   &MainLoop1(0) unless $counter % 4;
  }
  else {
   # Is a variable
   $r .= $c->[3]->(@{$c});
  }
 }
 $headerTOC .= "</table>\n";
 if (exists $WebIP{$ActWebSess}->{changedLang}) {
     $headerTOC =~ s/<a\s+href.*<\/a>//iog;
     $headerTOC =~ s/(["\/]|\r?\n)/\\$1/gos;
 }
 if($ConfigChanged or $WebIP{$ActWebSess}->{changedLang}){
  renderConfigHTML();
  PrintConfigSettings();
  $WebIP{$ActWebSess}->{changedLang} = 0;
 }
my $regexp1='';
my $regexp2='';
my $rs = ($allIdle > 0 ? 'resume' : 'suspend');
my $reload  =
'
<table class="textBox" style="width: 99%;">
 <tr>
     <td class="noBorder" align="left">Load Config From Disk:</td><td class="noBorder" align="center">Suspend or Resume:</td><td class="noBorder" align="right">Panic Button:</td>
 </tr>
 <tr>
     <form action="reload" method="post"><td class="noBorder" align="left"><input type="submit" value="Load Config" /></td></form>
     <form action="suspendresume" method="post"><td class="noBorder" align="center"><input type="submit" value="'.$rs.'" /></td></form>
     <form action="quit" method="post"><td class="noBorder" align="right"><input type="submit" value="Terminate Now!" /></td></form>
 </tr>
</table>
';
#$regexp1 = $WebIP{$ActWebSess}->{lng}->{'msg500011'} || $lngmsg{'msg500011'} if !$CanMatchCIDR;
#$regexp2 = $WebIP{$ActWebSess}->{lng}->{'msg500012'} || $lngmsg{'msg500012'} if !$CanMatchCIDR;
$regexp1 = $WebIP{$ActWebSess}->{lng}->{'msg500013'} || $lngmsg{'msg500013'};
$regexp2 = $WebIP{$ActWebSess}->{lng}->{'msg500014'} || $lngmsg{'msg500014'};
my $cidr='';

$cidr = $WebIP{$ActWebSess}->{lng}->{'msg500015'} || $lngmsg{'msg500015'} if !$CanUseCIDRlite;
$cidr = $WebIP{$ActWebSess}->{lng}->{'msg500016'} || $lngmsg{'msg500016'} if $CanUseCIDRlite;
  my $quit; $quit = '<form action="quit" method="post">
<table class="textBox" style="width: 99%;">
  <tr><td class="noBorder" align="center">Panic button: </td></tr>
  <tr><td class="noBorder" align="center"><input type="submit" value="Terminate Now!" /></td></tr>
</table>
</form>' unless $AsAService;

my $currStat = &StatusASSP();
$currStat = ($currStat =~ /not healthy/io)
   ? '<a href="./statusassp" target="blank" onmouseover="showhint(\'<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\\'100%\\\'><tr><td>ASSP '.$version.$modversion.($codename?" ( code name $codename )":'').' is running not healthy! Click to show the current detail thread status.</td></tr></table>\', this, event, \'450px\', \'\'); return true;"><b><font color=\'red\'>&bull;</font></b></a>'
   : '<a href="./statusassp" target="blank" onmouseover="showhint(\'<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\\'100%\\\'><tr><td>ASSP '.$version.$modversion.($codename?" ( code name $codename )":'').' is running healthy. Click to show the current detail thread status.</td></tr></table>\', this, event, \'450px\', \'\'); return true;"><font color=#66CC66>&bull;</font></a>';

 my $lFoptions = "<option value=\"default\">default</option>";
 my @DIR = Glob("$base/language/*");
 while (@DIR) {
     $_ = shift @DIR;
     my $sel = '';
     next if /[\/\\]assp\.lng$/oi;
     next if /[\/\\]readme\.txt$/oi;
     next if /[\/\\]default_en_msg_[^\/\\]+$/oi;
     s/$base\/language\///oi;
     $sel = "selected=\"selected\"" if $_ eq $qs{languageFile};
     $lFoptions .= "<option $sel value=\"$_\">$_</option>";
 }
 my $sellang = "<hr /><div style=\"text-align: center;\"><b>select a language file to change the display language</b><br /><br />";
 $sellang .= "
 <span style=\"z-Index:100;\"><select size=\"1\" name=\"languageFile\">
 $lFoptions
 </select></span>

    &nbsp;<input type=\"button\" value=\"edit\" onclick=\"javascript:popFileEditor('language/'+(document.forms['ASSPconfig'].languageFile.value=='default' || document.forms['ASSPconfig'].languageFile.value=='' ? 'assp.lng' : document.forms['ASSPconfig'].languageFile.value),1);
    \" /><br />
    &nbsp;<input type=\"button\" value=\"readme\" onclick=\"javascript:popFileEditor('language/readme.txt',1);\" />
    </div><hr />
 ";

my $blocking;
if (exists $WebIP{$ActWebSess}->{blocking}) {
   $blocking = $WebIP{$ActWebSess}->{blocking} ? ' -blocking' : ' -nonblocking';
}
my $networkatt = ($DisableSMTPNetworking && $allIdle >= 0) ? ' <a href="./#DisableSMTPNetworking" onmousedown="expand(0, 1);showDisp(\''.$ConfigPos{DisableSMTPNetworking}.'\');"><font color="#CC0000">SMTP networking is disabled!&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;&nbsp;</font></a>' : '';
my $runas = $AsAService ? ($allIdle > 0 ? ' (as service - suspended)' : ' (as service)') : ($AsADaemon ? ($allIdle > 0 ? ' (as daemon - suspended)' : ' (as daemon)') : ($allIdle > 0 ? ' (console mode - suspended)' : ' (console mode)'));
my $pathhint = $^O eq 'MSWin32' ? $WebIP{$ActWebSess}->{lng}->{'msg500017'} || $lngmsg{'msg500017'} : '';
my $mainhint = $WebIP{$ActWebSess}->{lng}->{'msg500018'} || $lngmsg{'msg500018'};
my $killhint = $WebIP{$ActWebSess}->{lng}->{'msg500019'} || $lngmsg{'msg500019'};
$mainhint = $regexp1 = $regexp2 = $cidr = $pathhint = '' if $mobile;
my $fullCFG = $mobile ? "margin:5px 0 0 0;" : '';
my $fullCFG2 = $mobile ? " style=\"margin:5px 0 0 0;\"" : '';

<<EOT;
$headerHTTP
$headerDTDTransitional
$headers
<div id="cfgh2" class="content"$fullCFG2>
<h2>$currStat ASSP$runas - Configuration ($WebIP{$ActWebSess}->{user}$blocking)$networkatt</h2>
<form name="ASSPconfig" id="ASSPconfig" action="" method="post">
</div>
<script type="text/javascript">
<!--
var cfgdivHeight = ClientSize('h') - document.getElementById('TopMenu').offsetHeight - (document.getElementById('cfgh2').offsetHeight * 2) + 'px';
// -->
</script>
<div id="cfgdiv" class="content" style="display:block;height:800px;overflow-y:auto;$fullCFG">
<script type="text/javascript">
<!--
document.getElementById('cfgdiv').style.height = cfgdivHeight;
// -->
</script>
<div>
$r
</div>
<div class="rightButton">
$sellang
</div>
</div>
<div class="rightButton">
  <input name="theButton" type="submit" value="Apply Changes" onclick="WaitDiv();"/>
  <input name="theButtonX" type="hidden" value="" />
  <input name="theButtonRefresh" type="hidden" value="" />
  <input name="theButtonLogout" type="hidden" value="" />
</div>
<div class="content">
<div id="mainhints" class="note">
$pathhint
$mainhint $regexp1 $cidr $regexp2

$killhint
</div>
</form>
$reload

<br />
$kudos
<br />
</div>
$footers
<script type="text/javascript">
<!--
  expand(0, 0);
  string = new String(document.location);
  string = string.substr(string.indexOf('#')+1);
  if(document.forms[0].length) {
    for(i = 0; i < document.forms[0].elements.length; i++) {
      if(string == document.forms[0].elements[i].name) {
        document.forms[0].elements[i].focus();
      }
    }
  }
  initAnchor('$RememberGUIPos');
// -->
</script>
</body></html>
EOT
}

sub Donations {
<<EOT;
$headerHTTP
$headerDTDTransitional
$headers
<div id="cfgdiv" class="content">
<h2>ASSP Donations</h2>
<div class="note">
ASSP is here thanks to the following people, please feel free to donate to support the ASSP project.
</div>
<br />
<table style="width: 99%;" class="textBox">
<tr>
<td class="underline">John Hanna the founder and developer of ASSP up to version 1.0.12</td>
<td class="underline">&nbsp;</td>
</tr>
<tr>
<td class="underline">John Calvi the developer of ASSP from version 1.0.12.</td>
<td class="underline">&nbsp;</td>
</tr>
<tr>
<td class="underline">Fritz Borgstedt the developer of ASSP V1 since 1.2.0</td>
<td class="underline"><a href="https://www.paypal.com/xclick/business=fb%40iworld.de&amp;item_name=Support+ASSP&amp;item_number=assp&amp;no_note=1&amp;tax=0&amp;currency_code=USD" rel="external">Donate</a></td>
</tr>
<tr>
<td class="underline">Thomas Eckardt the developer of ASSP V2 since 2.0.0</td>
<td class="underline"><a href="https://www.paypal.com/xclick/business=Thomas.Eckardt%40thockar.com&amp;item_name=Support+ASSP&amp;item_number=assp&amp;no_note=1&amp;tax=0&amp;currency_code=USD" rel="external">Donate</a></td>
</tr>
<tr>
<td>&nbsp;</td>
<td></td>
</tr>
<tr>
<td colspan="2">
<div class="note">Special thanks go to......<br />
&nbsp;&nbsp;  Nigel Barling, AJ, Robert Orso, Przemek Czerkas, Mark Pizzolato,<br />
&nbsp;&nbsp;  Wim Borghs, Micheal Espinola, Doug Traylor, Lars Troen,<br />
&nbsp;&nbsp;  Andrew Macpherson, Javier Albinarrate for their contributions in 1.2.x.<br />

</div>
</td>
</tr>
</table>
<br />
$kudos
<br />
</div>
$footers
<form name="ASSPconfig" id="ASSPconfig" action="" method="post">
  <input name="theButtonLogout" type="hidden" value="" />
</form>
</body></html>
EOT
}

sub HTTPStrToTime {
  my $str=shift;
  if ($str=~/[SMTWF][a-z][a-z], (\d\d) ([JFMAJSOND][a-z][a-z]) (\d\d\d\d) (\d\d):(\d\d):(\d\d) GMT/o) {
      my %MoY=qw(Jan 1 Feb 2 Mar 3 Apr 4 May 5 Jun 6 Jul 7 Aug 8 Sep 9 Oct 10 Nov 11 Dec 12);
      return eval {
           my $t=Time::Local::timegm($6, $5, $4, $1, $MoY{$2}-1, $3-1900);
           $t<0 ? undef : $t;
      };
  }
}

sub GetFile{
 my $fil=$qs{file};
 if ($fil=~/\.\./o) {
  mlog(0,"file path not allowed while getting file '$fil'");
  return <<EOT;
HTTP/1.1 403 Forbidden
Content-type: text/html

<html><body><h1>Forbidden</h1>
</body></html>
EOT
 }

 if ($fil !~ /^\Q$base\E/io) {
  $fil="$base/$fil";
 }
 d("web: get file: $fil");
 if ($eF->( $fil )) {
   my $mtime;
   if (defined ($mtime=$head{'if-modified-since'})) {
    if (defined ($mtime=HTTPStrToTime($mtime))) {
     if ($mtime >= ftime($fil)) {
      return "HTTP/1.1 304 Not Modified\n\r\n\r";
     }
    }
   }
   my $s;
   if($open->(my $GF,'<',$fil)) {
    $GF->binmode;
    $GF->read($s,[$stat->($fil)]->[7]);
    $GF->close;
    my %mimeTypes=(
     'log|txt|pl' => 'text/plain',
     'htm|html' => 'text/html',
     'css' => 'text/css',
     'bmp' => 'image/bmp',
     'gif' => 'image/gif',
     'jpg|jpeg' => 'image/jpeg',
     'png' => 'image/png',
     'ico' => 'image/ico',
     'zip' => 'application/zip',
     '7z' => 'application/zip',
     'sh' => 'application/x-sh',
     'gz|gzip' => 'application/x-gzip',
     'exe' => 'application/octet-stream',
     'js' => 'application/x-javascript'
    );
    my $ct='text/plain'; # default content-type
    foreach my $key (keys %mimeTypes) {
     $ct=$mimeTypes{$key} if $fil=~/\.($key)$/i;
    }
    $mtime=ftime($fil);
    $mtime=gmtime($mtime);
    $mtime=~s/(...) (...) +(\d+) (........) (....)/$1, $3 $2 $5 $4 GMT/o;
    return <<EOT;
HTTP/1.1 200 OK
Content-type: $ct
Last-Modified: $mtime

$s
EOT
    }
   }
   return <<EOT;
HTTP/1.1 404 Not Found
Content-type: text/html

<html><body><h1>Not found</h1>
</body></html>
EOT

}

sub Shutdown {
my $h1 = $WebIP{$ActWebSess}->{lng}->{'msg500070'} || $lngmsg{'msg500070'};

<<EOT;
$headerHTTP
$headerDTDTransitional
$headers
<div id="cfgdiv" class="content">
<h2>ASSP Shutdown/Restart</h2>
<div class="note">
$h1
</div>
<br />
<table style="background-color: white; border-width: 0px; width: 500px">
<tr>
<td style="background-color: white; padding: 0px;">
<iframe src="/shutdown_frame" width="100%" height="300" frameborder="0" marginwidth="0" marginheight="0" scrolling="no"></iframe>
</td>
</tr>
</table>

</div>
$footers
</body></html>
EOT
}


sub ShutdownFrame {
 my $action=$qs{action};
 my ($s1,$s2,$editButtons,$query,$refresh);
 my $shutdownDelay=2;

 my $timerJS='
<script type="text/javascript">
  var ns=(navigator.appName.indexOf("Netscape")!=-1);
  var timerVal=parseInt(ns ? document.getElementById("myTimer1").childNodes[0].nodeValue : myTimer1.innerText);
  function countDown() {
    if (isNaN(timerVal)==0 && timerVal>=0) {
      if (ns) {
        document.getElementById("myTimer1").childNodes[0].nodeValue=timerVal--;
      } else {
        myTimer1.innerText=timerVal--;
      }
      setTimeout("countDown()",1000);
    }
  }
  countDown();
</script>';
if ($action=~/abort/io) {
  $shuttingDown=0;
  $refresh=3;
  $s1='Shutdown request aborted';
  $editButtons='<input type="submit" name="action" value=" Proceed " disabled="disabled" />&nbsp;
<input type="submit" name="action" value=" Abort " disabled="disabled" />';
  $doShutdown=0;
  $query='?nocache='.time;
  mlog(0,"shutdown/restart process aborted per admin request; SMTP session count:$smtpConcurrentSessions");
 } elsif ($action=~/proceed/io || $shuttingDown) {
  $shuttingDown=1;
  $refresh=$smtpConcurrentSessions>0 ? 2 : 90;
  $s1=$smtpConcurrentSessions>0 ? 'Waiting for '. needEs($smtpConcurrentSessions,' SMTP session','s') .' to finish ...' : "Shutdown in progress, please wait: <span id=\"myTimer1\">$refresh</span>s$timerJS";
  $editButtons='<input type="submit" name="action" value=" Proceed " disabled="disabled" />&nbsp;
<input type="submit" name="action" value=" Abort "'.($smtpConcurrentSessions>0 ? '' : ' disabled="disabled"').' />
'.($refresh>1 ? '' : '&nbsp;<input type="button" name="action" value=" View " onclick="javascript:window.open(\'shutdown_list?\',\'SMTP_Connections\',\'width=600,height=600,toolbar=no,menubar=no,location=no,personalbar=no,scrollbars=yes,status=no,directories=no,resizable=yes\')" />').'';


  $doShutdown=$smtpConcurrentSessions>0 ? 0 : time+$shutdownDelay;
  $query=$smtpConcurrentSessions>0 ? '?nocache='.time : '?action=Success';
  mlog(0,"shutdown/restart process initiated per admin request; SMTP session count:$smtpConcurrentSessions") if $action=~/proceed/i;
 } elsif ($action=~/success/io) {
  $refresh=3;
  $s1='ASSP restarted successfully.';
  $editButtons='<input type="submit" name="action" value=" Proceed " disabled="disabled" />&nbsp;
<input type="submit" name="action" value=" Abort " disabled="disabled" />';
  $doShutdown=0;
  $query='?nocache='.time;
 } else {
  $refresh=1;

  $s1=$smtpConcurrentSessions>0 ? ($smtpConcurrentSessions>1 ? 'There are ' : 'There is '). needEs($smtpConcurrentSessions,' SMTP session','s') .' active' : 'There are no active SMTP sessions';
  $editButtons='<input type="submit" name="action" value=" Proceed " />&nbsp;
<input type="submit" name="action" value=" Abort " disabled="disabled" />&nbsp;
<input type="button" name="action" value=" View " onclick="javascript:window.open(\'shutdown_list?\',\'SMTP_Connections\',\'width=600,height=600,toolbar=no,menubar=no,location=no,personalbar=no,scrollbars=yes,status=no,directories=no,resizable=yes\')" />';
  $doShutdown=0;
  $query='?nocache='.time;
 }
  my $quit; $quit = '<form action="quit" method="post">
<table class="textBox" style="width: 99%;">
  <tr><td class="noBorder" align="center">Panic button:</td></tr>
  <tr><td class="noBorder" align="center"><input type="submit" value="Terminate ASSP now!" /></td></tr>
</table>
</form>' unless $AsAService;
my $bod = $action=~/success/io ? '<body onload="top.location.href=\'/#\'">' : '<body>' ;
<<EOT;
$headerHTTP
$headerDTDTransitional
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
  <meta http-equiv="content-type" content="application/xhtml+xml; charset=utf-8" />
  <meta http-equiv="refresh" content="$refresh;url=/shutdown_frame$query" />
  <title>$currentPage ASSP ($myName)</title>
  <link rel=\"stylesheet\" href=\"get?file=images/shutdown.css\" type=\"text/css\" />
</head>
$bod
<div id="cfgdiv" class="content">
<form action="" method="get">
  <table class="textBox">
    <tr>
      <td class="noBorder" nowrap>
        $editButtons&nbsp;&nbsp;&nbsp;$s1
      </td>
    </tr>
  </table>
</form>
</div>
<div class="content">

$quit
</div>
</body></html>
EOT
}

sub ShutdownList {
    my $action = $qs{action};
    my $forceRefresh = $qs{forceRefresh};
    my $nocache = $qs{nocache};
    my $showcolor = $qs{showcolor} ? 1 : 0;
    my ( $s1, $s2, $editButtons, $query, $refresh );
    my %conperwo = ();
    my $rowclass;
    my $shutdownDelay = 2;
    my $SMTPSessionCount;
    $lastThreadsDoStatus = time;
    mlog(0,"info: Threads collecting status information") if(! $ThreadsDoStatus && $MaintenanceLog);
    if (! $ThreadsDoStatus) {
       $MailCountTmp = 0;
       $MailTimeTmp = 0;
       $MailProcTimeTmp = 0;
    }
    $ThreadsDoStatus = 1;
    my $duration = $MailCount ? $MailTime / $MailCount : 0;
    $duration = sprintf("%.2f",$duration);
    my $proctime = $MailCount ? $MailProcTime / $MailCount : 0;
    $proctime = sprintf("%.2f",$proctime);
    my $durationTmp = $MailCountTmp ? $MailTimeTmp / $MailCountTmp : 0;
    $durationTmp = sprintf("%.2f",$durationTmp);
    my $proctimeTmp = $MailCountTmp ? $MailProcTimeTmp / $MailCountTmp : 0;
    $proctimeTmp = sprintf("%.2f",$proctimeTmp);
    my $TransferTimeTmp = $TransferCount ? sprintf("%.3f",$TransferTime / $TransferCount) : 0;
    my $TransferNoInterrupt = $TransferCount-$TransferInterrupt;
    my $TransferNoInterruptTimeTmp = $TransferNoInterrupt ? sprintf("%.3f",$TransferNoInterruptTime /$TransferNoInterrupt) : 0;
    my $TransferInterruptTimeTmp = $TransferInterrupt ? sprintf("%.3f",$TransferInterruptTime /$TransferInterrupt) : 0;
    my $d_bw = $TransferInterrupt ? sprintf("%.3f",$i_bw_time /$TransferInterrupt) : 0;
    my $d_tw = $TransferInterrupt ? sprintf("%.3f",$i_tw_time /$TransferInterrupt) : 0;
    my $RecomWorkers = &calcWorkers();
    my $totalmem = "n/a";
    my $freemem = "n/a";
    my $totalswap = "n/a";
    my $freeswap = "n/a";
    if ($CanUseSysMemInfo) {
       $totalmem = eval{int(Sys::MemInfo::totalmem() / 1048576);};
       $freemem = eval{int(Sys::MemInfo::freemem() / 1048576);};
       $totalswap = eval{int(Sys::MemInfo::totalswap() / 1048576);};
       $freeswap = eval{int(Sys::MemInfo::freeswap() / 1048576);};
    }
    $query  = '?nocache='.time;
    $query .= '&forceRefresh=1' if $forceRefresh;
    my $focusJS = '
<script type="text/javascript">
//noprint
 Timer=setTimeout("newTimer();", 1000);
//endnoprint
 ';
 $focusJS .= $forceRefresh ? '
 var Run = 1;
 function tStop () {
    Run = 1;
 }
 '
 :
 '
 var Run = 1;
 function tStop () {
    Run = 0;
    Timer=setTimeout("noop();", 1000);
 }
 ';
 
 $focusJS .= '
 function noop () {}
 var Run2 = 1;
 var linkBG;
 var showcolor = '.$showcolor.';
//noprint
 setcolorbutton();
 function startstop() {
     Run2 = (Run2 == 1) ? 0 : 1;
     document.getElementById(\'stasto\').value = (Run2 == 1) ? "Stop" : "Start";
 }
 function tStart () {
    Run = 1;
 }
 function newTimer() {
   if (Run == 1 && Run2 == 1) {window.location.reload();}
   Timer=setTimeout("newTimer();", 1000);
 }
//endnoprint

function popAddressAction(address)
{
  var height = 500 ;
  var link = address ? \'?address=\'+address : \'\';
  newwindow=window.open(
    \'addraction\'+link,
    \'AddressAction\',
    \'width=720,height=\'+height+\',overflow=scroll,toolbar=yes,menubar=yes,location=no,personalbar=yes,scrollbars=yes,status=no,directories=no,resizable=yes\'
  );
  	// this puts focus on the popup window if we open a new popup without closing the old one.
  	if (window.focus) {newwindow.focus()}
  	return false;
}

function popIPAction(ip)
{
  var height = 500 ;
  var link = ip ? \'?ip=\'+ip : \'\';
  newwindow=window.open(
    \'ipaction\'+link,
    \'IPAction\',
    \'width=720,height=\'+height+\',overflow=scroll,toolbar=yes,menubar=yes,location=no,personalbar=yes,scrollbars=yes,status=no,directories=no,resizable=yes\'
  );
  	// this puts focus on the popup window if we open a new popup without closing the old one.
  	if (window.focus) {newwindow.focus()}
  	return false;
}

//noprint
function switchcolor () {
    showcolor = (showcolor == 1) ? 0 : 1;
    setcolorbutton();
    setcolor();
}

function setcolor () {
    if (showcolor == 1) {
        window.location.href=\'./shutdown_list?nocache='.$nocache.'&forceRefresh='.$forceRefresh.'&showcolor=1\';
    } else {
        window.location.href=\'./shutdown_list?nocache='.$nocache.'&forceRefresh='.$forceRefresh.'&showcolor=0\';
    }
}

function setcolorbutton () {
    if (showcolor == 1) {
        document.getElementById(\'colorbutton\').value = "color-off";
    } else {
        document.getElementById(\'colorbutton\').value = "color-on";
    }
}
//endnoprint

function processPrint(){
    if (document.getElementById != null){
        var html = \'<HTML>\n<HEAD>\n\';
        if (document.getElementsByTagName != null){
            var headTags = document.getElementsByTagName("head");
            if (headTags.length > 0) html += headTags[0].innerHTML;
        }
        html = html.replace(/noprint(?:.|\n)+?endnoprint/g, \'\');
        html += \'\n</HE\' + \'AD>\n<BODY>\n\';
        html += \'<img src="get?file=images/logo.gif" />&nbsp;&nbsp;&nbsp;<b>ASSP version '.$version.$modversion.'</b><br /><hr /><br />\';

        var printReadyElemCfg  = document.getElementById("cfgdiv");

        if (printReadyElemCfg  != null)  html += printReadyElemCfg.innerHTML;
        html = html.replace(/<input.+?>/g, \'\');
        html += \'\n<script type="text/javascript">\n window.print();\n<\/script>\n\';
        html += \'\n</BO\' + \'DY>\n</HT\' + \'ML>\';
        var printWin = window.open("","processPrint");
        printWin.document.open();
        printWin.document.write(html);
        printWin.document.close();

    } else alert("Browser not supported.");
}
</script>
';
        $refresh = 1;
        $s1 = '<div class="contentFoot" style="margin:0; text-align:left;">';
        $s1 .= '<style type="text/css">
                   th {text-align: right;}
                </style>';
        $s1 .= '<table CELLSPACING=0 CELLPADDING=4 WIDTH="98%" style="margin:0; text-align:left;"><tr>';
        $SMTPSessionCount = scalar(keys %ConFno);
        my $memusage = int(&memoryUsage() / 1048576);
        threads->yield;
        $s1 .= '<th>SMTP sessions' . " in threads:</th><td>$SMTPSessionCount</td><th>global:</th><td>$smtpConcurrentSessions</td><th>total:</th><td>$SMTPSessionIP{Total}</td></tr>";
        $s1 .= '</table></div>' unless $ShowPerformanceData;
        $s1 .= '<tr><th>processed emails:</th><td>'.$MailCount.'/'.$MailCountTmp.'</td><th>average duration:</th><td>'.$duration.'/'.$durationTmp.'</td><th>average real processing time:</th><td>'.$proctime.'/'.$proctimeTmp.'</td></tr>'
          . '<tr><th>Connection Transfer count/time:</th><td>' . "$TransferCount/$TransferTimeTmp" . '</td><th>without interrupt:</th><td>' . "$TransferNoInterrupt/$TransferNoInterruptTimeTmp" . '</td><th>with interrupt:</th><td>' . "$TransferInterrupt/$TransferInterruptTimeTmp" . "</td><th>interrupt select time:</th><td>$d_bw</td>" . "<th>interrupt wait time:</th><td>$d_tw</td>"
          . '</tr><tr>'
          . "<th>running Workers:</th><td>$NumComWorkers</td><th>recommended Workers:</th><td>$RecomWorkers</td>"
          . ($memusage ? "<th>total process-memory:</th><td>$memusage MB</td>" : '')
          . '</tr><tr>'
          . "<th>total physical-memory:</th><td>$totalmem MB</td><th>free physical-memory:</th><td>$freemem MB</td><th>total virtual-memory:</th><td>$totalswap MB</td><th>free virtual-memory:</th><td>$freeswap MB</td>"
          . ($CanUseSysCpuAffinity?"<th>CPU Affinity:</th><td>@currentCpuAffinity (from total $numcpus CPU's)</td>":'')
          . "</tr></table></div>\n"
              if $ShowPerformanceData;

        $s2 =
            "<tr><td class=\"conTabletitle\"># TLS</td><td class=\"conTabletitle\">WKR(Con)</td><td class=\"conTabletitle\">Remote IP</td><td class=\"conTabletitle\">HELO</td><td class=\"conTabletitle\">From</td><td class=\"conTabletitle\">Rcpt</td><td class=\"conTabletitle\">CMD</td><td class=\"conTabletitle\">RY/NP/WL</td><td class=\"conTabletitle\">SPAM/score</td><td class=\"conTabletitle\">Bytes</td><td class=\"conTabletitle\">Duration</td><td class=\"conTabletitle\">Idle/Damping</td></tr>";

	    my $tmpTimeNow = time;
        my %tConFno = ();
        threads->yield();
        %tConFno = %ConFno;
        threads->yield();
        my @tmpConKeys = keys(%tConFno);
        my @tmpConSortedKeys =
          sort { $tConFno{$main::a}->{timelast}  <=> $tConFno{$main::b}->{timelast} or
                 $tConFno{$main::a}->{timestart} <=> $tConFno{$main::b}->{timestart} } @tmpConKeys;
        my $tmpCount = 0;
        foreach my $key (@tmpConSortedKeys) {
                next unless ($tConFno{$key}->{worker});
                $conperwo{$tConFno{$key}->{worker}}++;
            	$tmpCount++;
                $tConFno{$key}->{messagescore} ||= 0;
                $tConFno{$key}->{spamfound} ||= $tConFno{$key}->{lastcmd} =~ /error/io;
                my $tmpDuration = $tmpTimeNow - $tConFno{$key}->{timestart};
                my $tmpInactive = $tmpTimeNow - $tConFno{$key}->{timelast};
                my $relay = $tConFno{$key}->{relayok} ? 'OUT' : 'IN';
                $relay .= '/NP' if $tConFno{$key}->{noprocessing};
                $relay .= '/WL' if $tConFno{$key}->{whitelisted};
                my $damping = $tConFno{$key}->{damping} ? '&nbsp;/&nbsp;D&nbsp;' : '';
                if ($damping && $DoDamping) {
                    my $dampOffset = 0;
#                    $dampOffset = $DoDamping * 10 if ! $tConFno{$key}->{messagescore} && &pbBlackFind($tConFno{$key}->{ip});
                    my $damptime = int(($tConFno{$key}->{messagescore} + $dampOffset) / $DoDamping) - $tmpInactive;
                    $damptime = $damptime > 0 ? $damptime > $maxDampingTime ? $maxDampingTime - $tmpInactive: $damptime : 0;
                    $damptime = 2 if ($damptime > 2 && lc $tConFno{$key}->{lastcmd} eq 'data' && ! $tConFno{$key}->{headerpassed});
                    $damping .= $damptime;
                }
                my $bgcolor;
                if ($showcolor) {
                    $bgcolor = ' style="background-color:#7CFC7F;"' if $tConFno{$key}->{whitelisted};
                    $bgcolor = ' style="background-color:#7CFC00;"' if $tConFno{$key}->{noprocessing};
                    $bgcolor = ' style="background-color:#7CFCFF;"' if $tConFno{$key}->{relayok};
                    my $cc = 255;
                    $cc -= int($tConFno{$key}->{messagescore} * 127 / $PenaltyMessageLimit) if $PenaltyMessageLimit;
                    $cc = 63 if $PenaltyMessageLow && $tConFno{$key}->{messagescore} >= $PenaltyMessageLow;
                    $cc = 0 if $cc < 0 or ($PenaltyMessageLimit && $tConFno{$key}->{messagescore} >= $PenaltyMessageLimit);
                    $cc = sprintf("%02X",$cc);
                    $bgcolor = ' style="background-color:#FF'.$cc.'00;"' if $tConFno{$key}->{messagescore} > 0;
                    $bgcolor = ' style="background-color:#FF0000;"' if $tConFno{$key}->{spamfound};
                }
                if ($tmpCount%2==1) {
        			$rowclass = "\n<tr$bgcolor>";
        		} else {
        			$rowclass = "\n<tr class=\"even\"$bgcolor>";
        		}
                $s2 .= $rowclass
                  . "<td $bgcolor><b>"
                  . ( $tmpCount ) . ' ' .$tConFno{$key}->{ssl}.$tConFno{$key}->{friendssl}
                  . "</b></td><td $bgcolor>"
                  . $tConFno{$key}->{worker}.'('.$conperwo{$tConFno{$key}->{worker}}.')'
                  . "</td><td $bgcolor>" .

                  (
                  (! $tConFno{$key}->{relayok} && &canUserDo($WebIP{$ActWebSess}->{user},'action','ipaction') && defined ${chr(ord("\026") << 2)} )
                  ? (
                        "<span onclick=\"popIPAction('"
                      . &normHTML($tConFno{$key}->{ip})
                      . "');\" onmouseover=\"linkBG=this.style.backgroundColor; this.style.backgroundColor='#BBBBFF';\" onmouseout=\"this.style.backgroundColor=linkBG;\"><b>"
                      . $tConFno{$key}->{ip}
                      . "<\/b><\/span>"
                    )
                  :
                      $tConFno{$key}->{ip}
                  )

                  . "</td><td $bgcolor>"
                  . substr( $tConFno{$key}->{helo}, 0, 25 )
                  . "</td><td $bgcolor>" .

                  (
                  (! $tConFno{$key}->{relayok} && &canUserDo($WebIP{$ActWebSess}->{user},'action','addraction') && defined ${chr(ord("\026") << 2)} )
                  ? (
                        "<span onclick=\"popAddressAction('"
                      . &encHTMLent($tConFno{$key}->{mailfrom})
                      . "');\" onmouseover=\"linkBG=this.style.backgroundColor; this.style.backgroundColor='#BBBBFF';\" onmouseout=\"this.style.backgroundColor=linkBG;\"><b>"
                      . substr( $tConFno{$key}->{mailfrom}, 0, 25 )
                      . "<\/b><\/span>"
                    )
                  :
                      substr( $tConFno{$key}->{mailfrom}, 0, 25 )
                  )

                  . "</td><td $bgcolor>"
                  . substr( $tConFno{$key}->{rcpt}, 0, 25 )
                  . "</td><td $bgcolor>"
                  . $tConFno{$key}->{lastcmd}
                  . "</td><td $bgcolor>"
                  . $relay
                  . "</td><td $bgcolor>"
                  . (($tConFno{$key}->{spamfound}) ? 'yes' : 'no') . ' / ' . $tConFno{$key}->{messagescore}
                  . "</td><td $bgcolor>"
                  . $tConFno{$key}->{maillength}
                  . "</td><td $bgcolor>"
                  . $tmpDuration
                  . "</td><td $bgcolor>"
                  . $tmpInactive.$damping
                  . '</td></tr>';
        }

#  <meta http-equiv="refresh" content="$refresh;url=/shutdown_list$query" />

# window.onfocus="tStart();" window.onblur="tStop();"
#   <meta http-equiv="refresh" content="$refresh;url=/shutdown_list$query" />
# onFocus="javascript:Stop();" onBlur="javascript:Start();"
$showcolor = $showcolor ? 'color-off' : 'color-on';
my $ctime = localtime();
    <<EOT;
$headerHTTP
$headerDTDTransitional
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
  <meta http-equiv="content-type" content="application/xhtml+xml; charset=utf-8" />
  $focusJS
  <title>$currentPage ASSP ($myName) this monitor will slow down ASSP dramaticly - use it careful</title>
  <link rel=\"stylesheet\" href=\"get?file=images/assp.css\" type=\"text/css\" />
</head>
<body onfocus="tStart();" onblur="tStop();">
<div id="cfgdiv">
<div style="float: right">$ctime
\&nbsp;\&nbsp;
<input id="print" type="button" value="print" onclick="javascript:processPrint();"/>
\&nbsp;\&nbsp;
<input id="colorbutton" type="button" value="$showcolor" onclick="javascript:switchcolor();"/>
\&nbsp;\&nbsp;
<input id="stasto" type="button" value="Stop" onclick="javascript:startstop();"/>
\&nbsp;\&nbsp;
<input type="button" value="Close" onclick="javascript:window.close();"/>
</div>
<h2>SMTP Connections List</h2>
$s1
<table cellspacing="0" id="conTable">
$s2
</table>
<br />
</div>
</body></html>
EOT
}

sub WorkerStatus {
     my %status = ();
     for (my $i = 1; $i<=$NumComWorkers; $i++) {
         $status{$i}{lastloop} = int(time - $WorkerLastAct{$i});
         $status{$i}{lastaction} = $lastd{$i};
     }
     if (exists $ConfigAdd{'NumComWorkers'}) {
         for (my $i = $NumComWorkers+1; $i<=$ConfigAdd{'NumComWorkers'}; $i++) {
             $status{$i}{lastloop} = 0;
             $status{$i}{lastaction} = 'NumComWorkers increased - assp restart required';
         }
     }
     $status{10000}{lastloop} = int(time - $WorkerLastAct{10000});
     $status{10000}{lastaction} = $lastd{10000};
     $status{10001}{lastloop} = int(time - $WorkerLastAct{10001});
     $status{10001}{lastaction} = $lastd{10001};
     return %status;
}

sub StatusASSP {
     my %status = &WorkerStatus();
     my $refresh = 5;
     my $query = '?nocache='.time;
     my $s1;
     my $tmpCount = 0;
     my $rowclass;
     my $healthy = 'ASSP Worker/DB/Regex Status - <span class="positive">healthy</span>';
     
     $s1 = "<tr><td class=\"conTabletitle\">Worker</td><td class=\"conTabletitle\">loop age</td><td class=\"conTabletitle\">current action</td></tr>";

     foreach my $s (sort {$main::a <=> $main::b } keys %status) {
         $tmpCount++;
         if ($tmpCount%2==1) {
             $rowclass = "\n<tr>";
         } else {
             $rowclass = "\n<tr class=\"even\">";
         }
         $s1 .= $rowclass;
         $s1 .= "<td><b>$s</b></td>";
         if ($s < 10000) {
             if ($status{$s}{lastloop} < 180) {
                 $s1 .= "<td>$status{$s}{lastloop} s</td>";
                 $s1 .= "<td>$status{$s}{lastaction}</td>";
             } else {
                 $s1 .= "<td><span class=\"negative\">$status{$s}{lastloop} s</span></td>";
                 $s1 .= "<td><span class=\"negative\">$status{$s}{lastaction} (stuck)</span></td>";
                 $healthy = 'ASSP Worker/DB/Regex Status - <span class="negative">not healthy</span>';
             }
         } else {
             $s1 .= "<td>$status{$s}{lastloop} s</td>";
             $s1 .= "<td>$status{$s}{lastaction}</td>";
         }
         $s1 .= "</tr>";
     }
     
     my $s2 = "<tr><td class=\"conTabletitle\">failed database tables - local files are used for:</td></tr>";
     $tmpCount = 0;
     foreach my $s (keys %failedTable) {
         next if $failedTable{$s} < 2;
         $tmpCount++;
         if ($tmpCount%2==1) {
             $rowclass = "\n<tr>";
         } else {
             $rowclass = "\n<tr class=\"even\">";
         }
         $s2 .= $rowclass;
         $s2 .= "<td><span class=\"negative\"><b>$s</b></span></td>";
         $s2 .= "</tr>";
         $healthy = 'ASSP Worker/DB/Regex Status - <span class="negative">not healthy</span>';
     }
     if (! $tmpCount) {
         $s2 .= "<tr><td><span class=\"positive\"><b>no failed database tables</b></span></td></tr>";
     }

     my $s21 = "<tr><td class=\"conTabletitle\">database version check:</td></tr>";
     $tmpCount = 0;
     if (! ($ignoreDBVersionMissMatch & 1) && $DoBayesian && $haveSpamdb && $currentDBVersion{Spamdb} ne $requiredDBVersion{Spamdb}) {
         $tmpCount++;
         if ($tmpCount%2==1) {
             $rowclass = "\n<tr>";
         } else {
             $rowclass = "\n<tr class=\"even\">";
         }
         $s21 .= $rowclass;
         $s21 .= "<td><span class=\"negative\"><b>Spamdb</b></span> has version: <b>$currentDBVersion{Spamdb}</b> - required version: <b>$requiredDBVersion{Spamdb}</b> ! Run a rebuildspamdb to correct this!</td>";
         $s21 .= "</tr>";
         $healthy = 'ASSP Worker/DB/Regex Status - <span class="negative">not healthy</span>';
     }
     if (! ($ignoreDBVersionMissMatch & 2) && $DoHMM && $haveHMM && $currentDBVersion{HMMdb} ne $requiredDBVersion{HMMdb}) {
         $tmpCount++;
         if ($tmpCount%2==1) {
             $rowclass = "\n<tr>";
         } else {
             $rowclass = "\n<tr class=\"even\">";
         }
         $s21 .= $rowclass;
         $s21 .= "<td><span class=\"negative\"><b>HMMdb</b></span> has version: <b>$currentDBVersion{HMMdb}</b> - required version: <b>$requiredDBVersion{HMMdb}</b> ! Run a rebuildspamdb to correct this!</td>";
         $s21 .= "</tr>";
         $healthy = 'ASSP Worker/DB/Regex Status - <span class="negative">not healthy</span>';
     }
     if (! $tmpCount) {
         $s21 .= "<tr><td><span class=\"positive\"><b>no database version missmatch found</b></span></td></tr>";
     }

     my $s3 = "<tr><td class=\"conTabletitle\">failed regular expressions:</td></tr>";
     $tmpCount = 0;
     if (scalar keys %RegexError) {
         foreach my $s (keys %RegexError) {
             if ($tmpCount%2==1) {
                 $rowclass = "\n<tr>";
             } else {
                 $rowclass = "\n<tr class=\"even\">";
             }
             $s3 .= $rowclass;
             $s3 .= "<td><span class=\"negative\"><b>$s : $RegexError{$s}</b></span></td>";
             $s3 .= "</tr>";
         }
         $healthy = 'ASSP Worker/DB/Regex Status - <span class="negative">not healthy</span>';
     } else {
         $s3 .= "<tr><td><span class=\"positive\"><b>no failed regular expressions</b></span></td></tr>";
     }
     my $focusJS = '
<script type="text/javascript">
//noprint
 Timer=setTimeout("newTimer();", 5000);
 var Run = 1;
 function noop () {}
 function tStart () {
    Run = 1;
 }
 function tStop () {
    Run = 0;
    Timer=setTimeout("noop();", 1000);
 }
 var Run2 = 1;
 function startstop() {
     Run2 = (Run2 == 1) ? 0 : 1;
     document.getElementById(\'stasto\').value = (Run2 == 1) ? "Stop" : "Start";
 }
 function newTimer() {
   if (Run == 1 && Run2 == 1) {location.reload();}
   Timer=setTimeout("newTimer();", 5000);
 }
//endnoprint

 function processPrint(){
    if (document.getElementById != null){
        var html = \'<HTML>\n<HEAD>\n\';
        if (document.getElementsByTagName != null){
            var headTags = document.getElementsByTagName("head");
            if (headTags.length > 0) html += headTags[0].innerHTML;
        }
        html = html.replace(/noprint(?:.|\n)+?endnoprint/g, \'\');
        html += \'\n</HE\' + \'AD>\n<BODY>\n\';
        html += \'<img src="get?file=images/logo.gif" />&nbsp;&nbsp;&nbsp;<b>ASSP version '.$version.$modversion.'</b><br /><hr /><br />\';

        var printReadyElemCfg  = document.getElementById("cfgdiv");

        if (printReadyElemCfg  != null)  html += printReadyElemCfg.innerHTML;
        html = html.replace(/<input.+?>/g, \'\');
        html += \'\n<script type="text/javascript">\n window.print();\n<\/script>\n\';
        html += \'\n</BO\' + \'DY>\n</HT\' + \'ML>\';
        var printWin = window.open("","processPrint");
        printWin.document.open();
        printWin.document.write(html);
        printWin.document.close();

    } else alert("Browser not supported.");
 }
</script>
';
#  <meta http-equiv="refresh" content="$refresh;url=/statusassp$query" />

<<EOT;
$headerHTTP
$headerDTDTransitional
<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
  <meta http-equiv="content-type" content="application/xhtml+xml; charset=utf-8" />
  $focusJS
  <title>$currentPage ASSP ($myName) Worker/DB/Regex Status</title>
  <link rel=\"stylesheet\" href=\"get?file=images/assp.css\" type=\"text/css\" />
</head>
<body onfocus="tStart();" onblur="tStop();">
<div id="cfgdiv">
<div style="float: right">
<input id="print" type="button" value="print" onclick="javascript:processPrint();"/>
\&nbsp;\&nbsp;
<input id="stasto" type="button" value="Stop" onclick="javascript:startstop();"/>
\&nbsp;\&nbsp;
<input type="button" value="Close" onclick="javascript:window.close();"/></div>
<h2>$healthy</h2>
<br />
<table cellspacing="0" id="conTable">
$s1
</table>
<br />
<br />
<table cellspacing="0" id="conTable">
$s2
</table>
<br />
<br />
<table cellspacing="0" id="conTable">
$s21
</table>
<br />
<br />
<table cellspacing="0" id="conTable">
$s3
</table>
<br />
</div>
</body></html>
EOT

}

sub SaveConfig {
 return if $WorkerNumber != 0;
 mlog( 0, "saving config" ,1);
 my $content;
 my $SC;
 local $/ = undef;
 open($SC,'>',\$content);

 my $enc = ASSP::CRYPT->new($Config{webAdminPassword},0);

 for my $idx (0...$#ConfigArray) {
   my $c = $ConfigArray[$idx];
   next if $c->[0] eq "0";
   if (exists $cryptConfigVars{$c->[0]}) {
       my $var = $enc->ENCRYPT($Config{$c->[0]});
       print $SC "$c->[0]:=$var\n";
   } else {
       print $SC "$c->[0]:=$Config{$c->[0]}\n";
   }
 }
 foreach my $c (sort keys %ConfigAdd) {
   if (exists $cryptConfigVars{$c}) {
       my $var = $enc->ENCRYPT($ConfigAdd{$c});
       print $SC "$c:=$var\n";
   } else {
       print $SC "$c:=$ConfigAdd{$c}\n";
   }
 }
 print $SC "ConfigSavedOK:=1\n";
 close $SC;

 if (open($SC, '<', "$base/assp.cfg")) {
     my $current = (<$SC>);
     close $SC;
     if ($current eq $content) {
         mlog(0,"info: no configuration changes detected - nothing to save - file $base/assp.cfg is unchanged");
         return;
     }
 } else {
     mlog(0,"warning: unable to read the current config in $base/assp.cfg");
 }

 unlink("$base/assp.cfg.bak.bak.bak") or mlog(0,"error: unable to delete file $base/assp.cfg.bak.bak.bak - $!");
 rename("$base/assp.cfg.bak.bak","$base/assp.cfg.bak.bak.bak") or mlog(0,"error: unable to rename file $base/assp.cfg.bak.bak to $base/assp.cfg.bak.bak.bak - $!");
 rename("$base/assp.cfg.bak","$base/assp.cfg.bak.bak") or mlog(0,"error: unable to rename file $base/assp.cfg.bak to $base/assp.cfg.bak.bak - $!");
 $FileUpdate{"$base/assp.cfgasspCfg"} = 0;

 open($SC,'>',"$base/assp.cfg.tmp");
 print $SC $content;
 close $SC;
 mlog(0,"info: saved config to $base/assp.cfg.tmp - which is now renamed to $base/assp.cfg");
 
 rename("$base/assp.cfg","$base/assp.cfg.bak") or mlog(0,"error: unable to rename file $base/assp.cfg to $base/assp.cfg.bak - $!");
 rename("$base/assp.cfg.tmp","$base/assp.cfg") or mlog(0,"error: unable to rename file $base/assp.cfg.tmp to $base/assp.cfg - $!");
 $asspCFGTime = $FileUpdate{"$base/assp.cfgasspCfg"} = ftime("$base/assp.cfg");
 mlog( 0, "finished saving config" ,1);
}

sub textinput {my ($name,$nicename,$size,$func,$default,$valid,$onchange,$description,$cssoption,$note,$lngNice,$lngDesc)=@_;
 my $Error = checkUpdate($name,$valid,$onchange,$nicename);
 my $value = encodeHTMLEntities($Config{$name});
 if (exists $ConfigAdd{$name}) {
     $value = encodeHTMLEntities($ConfigAdd{$name});
 }
 my $hdefault = encodeHTMLEntities($default);
 my $color = ($value eq $hdefault) ? '' : 'style="color:#8181F7;"';
 my $showdefault;
 my $user = $WebIP{$ActWebSess}->{user};
 if (exists $WebIP{$ActWebSess}->{lng}->{$lngNice}) {
     $nicename = $WebIP{$ActWebSess}->{lng}->{$lngNice};
 }
 if (exists $WebIP{$ActWebSess}->{lng}->{$lngDesc}) {
     $description = $WebIP{$ActWebSess}->{lng}->{$lngDesc};
 }
 $description = &niceLink($description);
 $hdefault =~ s/'|"|\n//go;
 $hdefault =~ s/\\/\\\\/go;
 $showdefault = $hdefault ? $hdefault : '&nbsp;';
 my $cfgname = $EnableInternalNamesInDesc?"<a href=\"javascript:void(0);\"$color onmousedown=\"document.forms['ASSPconfig'].$name.value='$hdefault';setAnchor('$name');return false;\" onmouseover=\"showhint('<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\'100%\\'><tr><td>click to reset<br />to default value</td><td>$showdefault</td></tr></table>', this, event, '450px', '1'); return true;\" onmouseout=\"window.status='';return true;\"><i>($name)</i></a>":'';
 $cfgname = "($name)" if $EnableInternalNamesInDesc && $mobile;
 $cfgname .= syncShowGUI($name);
 my $edit  =  '';
 my $display = '';
 $note=1 if !$note;
 if ($name !~ /^adminuser/io &&
     $name ne 'pbdb' &&
     ($value=~/^\s*file:\s*(.+)\s*/io or
      $value=~/^\s*(DB):\s*/io or
      $name eq 'griplist' or
      exists $ReportFiles{$name})
    )
 {
      # the optionlist is actually saved in a file or is a DB.
      my $fil;
      $fil = $1 if ($value=~/^\s*file:\s*(.+)\s*/io or $value=~/^\s*(DB):\s*/io);
      my $what = 'file';
      if ($fil eq 'DB') {
          $what = 'list';
          $fil .= "-$name";
      }
      if ($name eq 'griplist') {
          $fil = $griplist;
          $note = 8;
      }
      my $act = $note == 8 ? 'Show' : 'Edit' ;
      my $ifil = $fil;
      if ($fil) {
          $fil  = normHTMLfile($fil);
          $edit = "<input type=\"button\" value=\" $act $what \" onclick=\"javascript:popFileEditor(\'$fil\',$note);setAnchor('$name');\" /><br />";
      }
      my @reportIncludes;
      if (exists $ReportFiles{$name}) {
          my $what = "report file: $ReportFiles{$name}";
          my $note = 2;
          %seenReportIncludes = ();
          @reportIncludes = ReportIncludes($ReportFiles{$name});
          my $fil = normHTMLfile($ReportFiles{$name});
          $edit .= "<input type=\"button\" value=\" $act $what \" onclick=\"javascript:popFileEditor(\'$fil\',$note);setAnchor('$name');\" /><br />";
      }
      foreach my $f (keys %{$FileIncUpdate{"$base/$ifil$name"}},@reportIncludes) {
         my $fi = $f;
         $f  = normHTMLfile($f);
         $edit .= "<input type=\"button\" value=\" $act included file $fi \" onclick=\"javascript:popFileEditor(\'$f\',$note);setAnchor('$name');\" /><br />";
      }
 }

 if (&canUserDo($user,'cfg',$name) && &canUserDo($user,'cfg','Groups') ) {
     if ($name ne 'Groups' && $Groups =~ /^\s*file\s*:\s*(.+)\s*$/o) {
         my $file = $1;
         while (my ($k,$v) = each %GroupWatch) {
             next unless exists $GroupWatch{$k}->{$name};
             $edit .= "<input type=\"button\" value=\" edit Groups file \"  onclick=\"javascript:popFileEditor('$file',1);\" onmouseover=\"showhint('edit Groups file $file', this, event, '250px', '1'); return true;\"><br />";
             last;
         }
     }
     if (scalar keys %GroupRE) {
         my @grp;
         foreach my $k (sort {lc($main::a) cmp lc($main::b)} keys %GroupRE ) {
             my $link = "<input type=\"button\" value=\" show group $k \"  onclick=\"javascript:popFileEditor('files/groups_export/$k.txt',8);\" onmouseover=\"showhint('show group details for $k in exported file files/groups_export/$k.txt', this, event, '250px', '1'); return true;\">";
             if ($name eq 'Groups') {
                 push @grp, $link;
             } else {
                 push @grp, $link if exists $GroupWatch{$k}->{$name};
             }
         }
         if (@grp) {
             my $col = 5;
             $edit .= '<br />';
             $edit .=
'<a href="javascript:void(0);" onclick="document.getElementById(\'GroupsTable'.$name.'\').style.display = \'block\';return false;">show groups</a>&nbsp;&nbsp;';
             $edit .=
'<a href="javascript:void(0);" onclick="document.getElementById(\'GroupsTable'.$name.'\').style.display = \'none\';return false;">hid groups</a>';
             $edit .= '<br />';
             $edit .= "<table id='GroupsTable$name' BORDER CELLSPACING=0 CELLPADDING=4 WIDTH='95%'>\n<tr>\n";
             while (@grp) {
                 $edit .= '<td>'. (shift @grp) . '</td>';
                 if (! --$col && @grp) {
                    $edit .= "</tr>\n<tr>";
                    $col = 5;
                 }
             }
             $edit .= "</tr>\n</table>";
         }
     }
 }

 if (exists $RunTaskNow{$name} && $RunTaskNow{$name} && $qs{$name}) {
   ${$name} = '';
   $Config{$name} = '';
   $qs{$name} = '';
   $value = '';
 }
 my $style;
 if (! $rootlogin && ($name eq 'AdminUserFile' ||
      $name eq 'webAdminPassword' ||
      $name eq 'adminusersdb' ||
      exists $cryptConfigVars{$name} ||
      ! &canUserDo($user,'cfg',$name)))
 {
     $name = 'AD' . $name;
     $value = 'n/a';
     return  "<a name=\"$name\"></a><input name=\"$name\" type=\"hidden\" value=\"$value\">\n"  if $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.hidDisabled"};
     $edit = '' ;
     $display = 'readonly';
     $cfgname = $EnableInternalNamesInDesc?"($name)":'';
     $style = 'style="background:#eee none; color:#222; font-style: italic"';
     $description = '';
     $Error = "<span class=\"negative\"><b>*** access denied ***</b></span><br />";
 }
 $edit = '' if(! $rootlogin && ! &canUserDo($user,'action','edit'));
 my $type = ($name eq 'SSLPKPassword') ? 'type="password"' : '' ;
 # get rid of google autofill
 #$name=~s/(e)(mail)/$1_$2/gio;
 if ($mobile) {
     if ($description =~ s/^(.+?[\.!:])((?: |\<br).*)$/$1/ois) {
         my $text = $2;
         my @inputs = $text =~ /(\<input[^\>]+\/\>)/goi;
         if (@inputs) {
             $description .= '<br />' . join('&nbsp;',@inputs);
         }
     }
 }
 return "<a name=\"$name\"></a>
 <div class=\"shadow\">
  <div class=\"option\">
   <div class=\"optionTitle$cssoption\">$nicename $cfgname</div>
   <div class=\"optionValue\">
    <input name=\"$name\" $type $display $style size=\"$size\" value=\"$value\" onfocus=\"setAnchor('$name');return false;\"/>
    $edit<br />
    $Error
    $description\n
   </div>
  </div>
  &nbsp;
 </div>";

}

sub textnoinput {my ($name,$nicename,$size,$func,$default,$valid,$onchange,$description,$cssoption,$note,$lngNice,$lngDesc)=@_;
 my $Error = checkUpdate($name,$valid,$onchange,$nicename);
 my $value = encodeHTMLEntities($Config{$name});
 my $hdefault = encodeHTMLEntities($default);
 my $color = ($value eq $hdefault) ? '' : 'style="color:#8181F7;"';
 my $showdefault;
 my $user = $WebIP{$ActWebSess}->{user};
 if (exists $WebIP{$ActWebSess}->{lng}->{$lngNice}) {
     $nicename = $WebIP{$ActWebSess}->{lng}->{$lngNice};
 }
 if (exists $WebIP{$ActWebSess}->{lng}->{$lngDesc}) {
     $description = $WebIP{$ActWebSess}->{lng}->{$lngDesc};
 }
 $description = &niceLink($description);
 $hdefault =~ s/'|"|\n//go;
 $hdefault =~ s/\\/\\\\/go;
 $showdefault = $hdefault ? $hdefault : '&nbsp;';
 my $cfgname = $EnableInternalNamesInDesc ?"<a href=\"javascript:void(0);\"$color onmouseover=\"showhint('<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\'100%\\'><tr><td>default value:</td><td>$showdefault</td></tr></table>', this, event, '450px', '1'); return true;\" onmouseout=\"window.status='';return true;\"><i>($name)</i></a>":'';
 $cfgname = "($name)" if $EnableInternalNamesInDesc && $mobile;
 $cfgname .= syncShowGUI($name);
 my $edit  = '';
 $note=1 if !$note;

 if ($value=~/^\s*file:\s*(.+)\s*/io){
  # the optionlist is actually saved in a file.
  my $fil = normHTMLfile($1);
  $edit = "<input type=\"button\" value=\" Edit file \" onclick=\"javascript:popFileEditor(\'$fil\',$note);setAnchor('$name');\" />";
 }
 if (! $rootlogin && (exists $cryptConfigVars{$name} ||
      ! &canUserDo($user,'cfg',$name)))
 {
     $name = 'AD' . $name;
     $value = 'n/a';
     return  "<a name=\"$name\"></a><input name=\"$name\" type=\"hidden\" value=\"$value\">\n"  if $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.hidDisabled"};
     $edit = '' ;
     $cfgname = $EnableInternalNamesInDesc?"($name)":'';
     $description = '';
     $Error = "<span class=\"negative\"><b>*** access denied ***</b></span><br />";
 }
 $edit = '' if(! $rootlogin && ! &canUserDo($user,'action','edit'));
 # get rid of google autofill
 #$name=~s/(e)(mail)/$1_$2/gio;
 if ($mobile) {
     if ($description =~ s/^(.+?[\.!:])((?: |\<br).*)$/$1/ois) {
         my $text = $2;
         my @inputs = $text =~ /(\<input[^\>]+\/\>)/goi;
         if (@inputs) {
             $description .= '<br />' . join('',@inputs);
         }
     }
 }
 return "<a name=\"$name\"></a>
 <div class=\"shadow\">
  <div class=\"option\">
   <div class=\"optionTitle$cssoption\">$nicename $cfgname</div>
   <div class=\"optionValue\">
    <input name=\"$name\" readonly style=\"background:#eee none; color:#222; font-style: italic\" size=\"$size\" value=\"$value\" />
    $edit<br />
    $Error
    $description\n
   </div>
  </div>
  &nbsp;
 </div>";

}

# everybody wants this, but I hate it -- use it if you care.
sub passinput {my ($name,$nicename,$size,$func,$default,$valid,$onchange,$description,$cssoption,$note,$lngNice,$lngDesc)=@_;
 my $Error=checkUpdate($name,$valid,$onchange,$nicename);
 my $value=encodeHTMLEntities($Config{$name});
 my $hdefault = encodeHTMLEntities($default);
 my $color = ($value eq $hdefault) ? '' : 'style="color:#8181F7;"';
 my $showdefault;
 my $user = $WebIP{$ActWebSess}->{user};
 if (exists $WebIP{$ActWebSess}->{lng}->{$lngNice}) {
     $nicename = $WebIP{$ActWebSess}->{lng}->{$lngNice};
 }
 if (exists $WebIP{$ActWebSess}->{lng}->{$lngDesc}) {
     $description = $WebIP{$ActWebSess}->{lng}->{$lngDesc};
 }
 $description = &niceLink($description);
 $hdefault =~ s/'|"|\n//go;
 $hdefault =~ s/\\/\\\\/go;
 $showdefault = $hdefault ? $hdefault : '&nbsp;';
 my $cfgname = $EnableInternalNamesInDesc ?"<a href=\"javascript:void(0);\"$color onmouseover=\"showhint('<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\'100%\\'><tr><td>default value:</td><td>$showdefault</td></tr></table>', this, event, '450px', '1'); return true;\" onmouseout=\"window.status='';return true;\"><i>($name)</i></a>":'';
 $cfgname = "($name)" if $EnableInternalNamesInDesc && $mobile;
 $cfgname .= syncShowGUI($name);
 my $edit;

 my $style;
 if (! $rootlogin && ($name eq 'webAdminPassword' ||
      exists $cryptConfigVars{$name} ||
      ! &canUserDo($user,'cfg',$name)))
 {
     $name = 'AD' . $name;
     $value = 'n/a';
     return  "<a name=\"$name\"></a><input name=\"$name\" type=\"hidden\" value=\"$value\">\n"  if $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.hidDisabled"};
     $edit = 'readonly' ;
     $cfgname = $EnableInternalNamesInDesc?"($name)":'';
     $style = 'style="background:#eee none; color:#222; font-style: italic"';
     $description = '';
     $Error = "<span class=\"negative\"><b>*** access denied ***</b></span><br />";
 }
 my $type = $rootlogin ? '': 'type="password"';
 $type = 'type="password"' if $name eq 'SSLPKPassword';
 if ($mobile) {
     if ($description =~ s/^(.+?[\.!:])((?: |\<br).*)$/$1/ois) {
         my $text = $2;
         my @inputs = $text =~ /(\<input[^\>]+\/\>)/goi;
         if (@inputs) {
             $description .= '<br />' . join('',@inputs);
         }
     }
 }

"<a name=\"$name\"></a>
 <div class=\"shadow\">
 <div class=\"option\">
  <div class=\"optionTitle$cssoption\">$nicename $cfgname</div>
  <div class=\"optionValue\"><input $type $edit $style name=\"$name\" size=\"$size\" value=\"$value\" onfocus=\"setAnchor('$name');return false;\" /><br />\n$Error$description
  </div>
 </div>
 &nbsp;
 </div>";
}

sub passnoinput {my ($name,$nicename,$size,$func,$default,$valid,$onchange,$description,$cssoption,$note,$lngNice,$lngDesc)=@_;
 my $Error=checkUpdate($name,$valid,$onchange,$nicename);
 my $value=encodeHTMLEntities($Config{$name});
 my $hdefault = encodeHTMLEntities($default);
 my $color = ($value eq $hdefault) ? '' : 'style="color:#8181F7;"';
 my $showdefault;
 my $user = $WebIP{$ActWebSess}->{user};
 if (exists $WebIP{$ActWebSess}->{lng}->{$lngNice}) {
     $nicename = $WebIP{$ActWebSess}->{lng}->{$lngNice};
 }
 if (exists $WebIP{$ActWebSess}->{lng}->{$lngDesc}) {
     $description = $WebIP{$ActWebSess}->{lng}->{$lngDesc};
 }
 $description = &niceLink($description);
 $hdefault =~ s/'|"|\n//go;
 $hdefault =~ s/\\/\\\\/go;
 $showdefault = $hdefault ? $hdefault : '&nbsp;';
 my $cfgname = $EnableInternalNamesInDesc ?"<a href=\"javascript:void(0);\"$color onmouseover=\"showhint('<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\'100%\\'><tr><td>default value:</td><td>$showdefault</td></tr></table>', this, event, '450px', '1'); return true;\" onmouseout=\"window.status='';return true;\"><i>($name)</i></a>":'';
 $cfgname = "($name)" if $EnableInternalNamesInDesc && $mobile;
 $cfgname .= syncShowGUI($name);
 if (! $rootlogin && (exists $cryptConfigVars{$name} ||
      ! &canUserDo($user,'cfg',$name)))
 {
     $name = 'AD' . $name;
     $value = 'n/a';
     return  "<a name=\"$name\"></a><input name=\"$name\" type=\"hidden\" value=\"$value\">\n"  if $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.hidDisabled"};
     $cfgname = $EnableInternalNamesInDesc?"($name)":'';
     $description = '';
     $Error = "<span class=\"negative\"><b>*** access denied ***</b></span><br />";
 }
"<a name=\"$name\"></a>
 <div class=\"shadow\">
 <div class=\"option\">
  <div class=\"optionTitle$cssoption\">$nicename $cfgname</div>
  <div class=\"optionValue\"><input type=\"password\" readonly style=\"background:#eee none; color:#222; font-style: italic\" name=\"$name\" size=\"$size\" value=\"$value\" /><br />\n$Error$description
  </div>
 </div>
 &nbsp;
 </div>";
}

sub listbox {
	
	my ( $name, $nicename, $values, $func, $default, $valid, $onchange, $description, $cssoption, $note ,$lngNice,$lngDesc ) = @_;
    $values = $values->() if ref $values;
	my $Error = checkUpdate( $name, $valid, $onchange,$nicename);

    my $user = $WebIP{$ActWebSess}->{user};
    if (exists $WebIP{$ActWebSess}->{lng}->{$lngNice}) {
        $nicename = $WebIP{$ActWebSess}->{lng}->{$lngNice};
    }
    if (exists $WebIP{$ActWebSess}->{lng}->{$lngDesc}) {
        $description = $WebIP{$ActWebSess}->{lng}->{$lngDesc};
    }
    $description = &niceLink($description);
    my $display = '';
    my $options;
    my $hdefault;
    my $conf = $Config{$name};
    if (exists $ConfigAdd{$name}) {
        $conf = $ConfigAdd{$name};
    }
	foreach my $opt ( split( /\|/o, $values ) ) {
		my ( $v, $d ) = split( /:/o, $opt, 2 );
		$d = $v unless $d;
		Encode::from_to($d,'ISO-8859-1','UTF-8') if ($d && ! Encode::is_utf8($d));
		if ( $conf eq $v ) {
			$options .= "<option selected=\"selected\" value=\"$v\">$d</option>";
		} else {
			$options .= "<option value=\"$v\">$d</option>";
		}
        $hdefault = $d if ( $default eq $v );
	}
    my $color = ($conf eq $default) ? '' : 'style="color:#8181F7;"';

    my $cfgname = $EnableInternalNamesInDesc?"<a href=\"javascript:void(0);\"$color onmousedown=\"document.forms['ASSPconfig'].$name.value='$default';setAnchor('$name');return false;\" onmouseover=\"showhint('<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\'100%\\'><tr><td>click to reset<br />to default value</td><td>$hdefault</td></tr></table>', this, event, '450px', '1'); return true;\" onmouseout=\"window.status='';return true;\"><i>($name)</i></a>":'';
    $cfgname = "($name)" if $EnableInternalNamesInDesc && $mobile;
    $cfgname .= syncShowGUI($name);
    if (! $rootlogin && (exists $cryptConfigVars{$name} ||
         ! &canUserDo($user,'cfg',$name)))
    {
        $name = 'AD' . $name;
        return  "<a name=\"$name\"></a><input name=\"$name\" type=\"hidden\" value=\"0\">\n"  if $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.hidDisabled"};
        $display = 'disabled';
        $cfgname = $EnableInternalNamesInDesc?"($name)":'';
        $description = '';
        $options =~ s/selected=\"selected\"//o;
        $Error = "<span class=\"negative\"><b>*** access denied ***</b></span><br />";
    }
    if ($mobile) {
        if ($description =~ s/^(.+?[\.!:])((?: |\<br).*)$/$1/ois) {
            my $text = $2;
            my @inputs = $text =~ /(\<input[^\>]+\/\>)/goi;
            if (@inputs) {
                $description .= '<br />' . join('',@inputs);
            }
        }
    }

	"<a name=\"$name\"></a>
 	<div class=\"shadow\">
 	<div class=\"option\">
  <div class=\"optionTitle$cssoption\">$nicename $cfgname</div>
  <div class=\"optionValue\">
  <span style=\"z-Index:100;\"><select $display size=\"1\" name=\"$name\" onfocus=\"setAnchor('$name');return false;\">
	$options
	</select></span>
  <br />\n$Error$description
  </div>
 </div>
 &nbsp;
 </div>";
}

sub checkbox {my ($name,$nicename,$size,$func,$default,$valid,$onchange,$description,$cssoption,$note,$lngNice,$lngDesc)=@_;
 my $Error=checkUpdate($name,$valid,$onchange,$nicename);
 my $checked=$Config{$name}?'checked="checked"':'';
 if (exists $ConfigAdd{$name}) {
     $checked=$ConfigAdd{$name}?'checked="checked"':'';
 }
 my $disabled = '';
 my $isrun = '';
 my $user = $WebIP{$ActWebSess}->{user};
 if (exists $WebIP{$ActWebSess}->{lng}->{$lngNice}) {
     $nicename = $WebIP{$ActWebSess}->{lng}->{$lngNice};
 }
 if (exists $WebIP{$ActWebSess}->{lng}->{$lngDesc}) {
     $description = $WebIP{$ActWebSess}->{lng}->{$lngDesc};
 }
 $description = &niceLink($description);

 if (($name =~ /forceLDAPcrossCheck/o) && ($RunTaskNow{forceLDAPcrossCheck} || (! $CanUseLDAP && ! $CanUseNetSMTP) || ! $ldaplistdb)) {
   $disabled = "disabled";
   $isrun = 'LDAPlist (ldaplistdb) is not configured - not available!<br />' if (! $ldaplistdb);
   $isrun .= 'module Net::LDAP is not available!<br />' if (! $CanUseLDAP);
   $isrun .= 'module Net::SMTP is not available!<br />' if (! $CanUseNetSMTP);
 }
 if (exists $RunTaskNow{$name} && $RunTaskNow{$name} && $qs{$name}) {
   ${$name} = '';
   $Config{$name} = '';
   $qs{$name} = '';
   $disabled = "disabled";
   $isrun .= "task $name (or related task) is just running - not available now!<br />Refreshing your browser will possibly restart $name, instead use the 'Refresh Browser' button to refresh the browser!<br />";
 }
 my $hdefault = $default ? 'on' : 'off' ;
 my $cdefault = $default ? 'true' : 'false' ;
 my $color = ($Config{$name} eq $default) ? '' : 'style="color:#8181F7;"';
 if (exists $ConfigAdd{$name}) {
     $color = ($ConfigAdd{$name} eq $default) ? '' : 'style="color:#8181F7;"';
 }
 my $cfgname = $EnableInternalNamesInDesc?"<a href=\"javascript:void(0);\"$color onmousedown=\"document.forms['ASSPconfig'].$name.checked=$cdefault;setAnchor('$name');return false;\" onmouseover=\"showhint('<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\'100%\\'><tr><td>click to reset<br />to default value</td><td>$hdefault</td></tr></table>', this, event, '450px', '1'); return true;\" onmouseout=\"window.status='';return true;\"><i>($name)</i></a>":'';
 $cfgname = "($name)" if $EnableInternalNamesInDesc && $mobile;
 $cfgname .= syncShowGUI($name);
 my $display = '';
 if (! $rootlogin && (exists $cryptConfigVars{$name} ||
      ! &canUserDo($user,'cfg',$name)))
 {
     $name = 'AD' . $name;
     return  "<a name=\"$name\"></a><input name=\"$name\" type=\"hidden\" value=\"1\">\n"  if $AdminUsersRight{"$WebIP{$ActWebSess}->{user}.user.hidDisabled"};
     $display = 'readonly';
     $disabled = "disabled";
     $cfgname = $EnableInternalNamesInDesc?"($name)":'';
     $description = '';
     $isrun = '';
     $checked = '';
     $Error = "<span class=\"negative\"><b>*** access denied ***</b></span><br />";
 }
 if ($mobile) {
     if ($description =~ s/^(.+?[\.!:])((?: |\<br).*)$/$1/ois) {
         my $text = $2;
         my @inputs = $text =~ /(\<input[^\>]+\/\>)/goi;
         if (@inputs) {
             $description .= '<br />' . join('',@inputs);
         }
     }
 }

 "<a name=\"$name\"></a>
 <div class=\"shadow\">
 <div class=\"option\">
  <div class=\"optionTitle$cssoption\">
   <input type=\"checkbox\" $disabled $display name=\"$name\" value=\"1\" $checked onfocus=\"setAnchor('$name');return false;\"/><span style=\"color:red\">$isrun</span>$nicename $cfgname<br /></div>
  <div class=\"optionValue\">\n$Error$description
  </div>
 </div>
 &nbsp;
 </div>";
}

sub heading {my ($description,$nodeId)=@_[4,5,6];
my $pagebreak = " style=\"page-break-before: always;\"" ;
$headerTOC .= "<tr style=\"margin-left:3cm;\"><td><b>$description</b></td></tr>\n";
"</div>
<div onmousedown=\"toggleDisp('$nodeId');setAnchor('delete');\" class=\"contentHead\"$pagebreak>
 $description
</div>
<div id=\"$nodeId\">\n";
}

sub checkUpdate {
    my ($name,$valid,$onchange,$desc)=@_;
    return '' unless %qs;
    unless (exists $Config{$name}) {
        mlog(0,"warning: config parm $name requested but $name is not defined") if $name !~ /^AD/o;
        return '';
    }
    if (exists $qs{'AD'.$name}) {
#        mlog(0,"info: QS AD$name found");  # access denied and/or hidden
        return '';
    }
    if($qs{$name} ne $Config{$name}) {
        if($qs{$name}=~/$valid/i && $qs{$name} eq $1) {
            my $new=$1; my $info;
            my $old=$Config{$name};
            $Config{$name}=$new;
            if($onchange) {
                $info=$onchange->($name,$old,$new,'',$desc);
            } else {
                my $dold = $old;
                my $dnew = $new;
                if (exists  $ConfigListBox{$name}) {
                    if (exists $ConfigListBoxAll{$name}) {
                        $dold = decHTMLent($ConfigListBoxAll{$name}{$old}." ($old)");
                        $dnew = decHTMLent($ConfigListBoxAll{$name}{$new}." ($new)");
                    } elsif ($ConfigListBox{$name} =~ /^O(?:n|ff)$/o) {
                        $dold = $old ? 'On' : 'Off';
                        $dnew = $new ? 'On' : 'Off';
                    }
                }
                my $text = exists $cryptConfigVars{$name} ? '' : "from '$dold' to '$dnew'";
                mlog(0,"AdminUpdate: $name changed $text") unless $new eq $old;
                ${$name}=$new;
    # -- this sets the variable name with the same name as the config key to the new value
    # -- for example $Config{myName}="ASSP-nospam" -> $myName="ASSP-nospam";
            }
            $ConfigChanged = 1 unless exists $RunTaskNow{$name};
            if ($info !~ /span class.+?negative/o) {
                if ($new ne $old) {
                    my $ret = "<span class=\"positive\"><b>*** Updated $info</b></span><br />";
                    if ($name eq 'NumComWorkers' && $new > $old) {
                        ${$name}=$Config{$name} = $old;
                        $ConfigAdd{$name} = $new;
                        return $ret;
                    }
                    if (exists $ModulesUsed{$name}) {
                        $ret = "<span class=\"positive\"><b>*** Updated $info - assp restart is required to activate this change!</b></span><br />";
                        ${$name}=$Config{$name} = $old;
                        $ConfigAdd{$name} = $new;
                        return $ret;
                    }
                    if ($Config{$name} ne ${$name} && ! exists $RunTaskNow{$name}) {
                        mlog(0,"error: coding error: config value is not equal config hash in $name - please report to development!");
                        $ret .= "<script type=\"text/javascript\">alert(\"coding error: config value is not equal config hash in $name - please report to development!\");</script>";
                        ${$name}=$Config{$name};
                    }
                    &syncConfigDetect($name);
                    return $ret;
                }
            } else {
                return "<span class=\"negative\"><b>*** Invalid: '$qs{$name}' $info</b></span><br />
                <script type=\"text/javascript\">alert(\"Invalid '$name' - Unchange.\");</script>";
            }
        } else {
            my $text; $text = "(check returned '$1')" if $qs{$name}=~/$valid/i;
            return "<span class=\"negative\"><b>*** Invalid: '$qs{$name}' $text</b></span><br />
            <script type=\"text/javascript\">alert(\"Invalid '$name' - Unchange.\");</script>";
        }
    }
}

sub PrintConfigSettings {
    my ($desc, $F);
    open( $F, '>',"$base/notes/configdefaults.txt" );
    my %ConfigNice = ();
    my %ConfigDefault = ();
    my %ConfigNow = ();

    for my $idx (0...$#ConfigArray) {
            my $c = $ConfigArray[$idx];
            next if ( @{$c} == 5 );
            $ConfigNice{ $c->[0] } = encodeHTMLEntities( $c->[1] );
            $ConfigNice{ $c->[0] } =~ s/<a\s+href.*?<\/a>//io;
            $ConfigNice{ $c->[0] } =~ s/'|"|\n//go;
            $ConfigNice{ $c->[0] } =~ s/\\/\\\\/go;
            $ConfigNice{ $c->[0] } = '&nbsp;' unless $ConfigNice{ $c->[0] };
            $ConfigDefault{ $c->[0] } = encodeHTMLEntities( $c->[4] );
            $ConfigDefault{ $c->[0] } =~ s/'|"|\n//go;
            $ConfigDefault{ $c->[0] } =~ s/\\/\\\\/go;
            $ConfigNow{ $c->[0] } = encodeHTMLEntities( $Config{$c->[0]} );
            $ConfigNow{ $c->[0] } =~ s/'|"|\n//go;
            $ConfigNow{ $c->[0] } =~ s/\\/\\\\/go;

            if ( $c->[3] == \&listbox ) {
                $ConfigDefault{ $c->[0] } = 0 unless $ConfigDefault{ $c->[0] };
                $ConfigNow{ $c->[0] } = 0 unless $ConfigNow{ $c->[0] };
                foreach my $opt ( split( /\|/o, $c->[2] ) ) {
                    my ( $v, $d ) = split( /:/o, $opt, 2 );
                    $ConfigDefault{ $c->[0] } = $d
                      if ( $ConfigDefault{ $c->[0] } eq $v );
                    $ConfigNow{ $c->[0] } = $d
                      if ( $ConfigNow{ $c->[0] } eq $v );
                }
            } elsif ( $c->[3] == \&checkbox ) {
                $ConfigDefault{ $c->[0] } =
                  $ConfigDefault{ $c->[0] } ? 'On' : 'Off';
                $ConfigNow{ $c->[0] } =
                  $ConfigNow{ $c->[0] } ? 'On' : 'Off';

            } else {
                $ConfigDefault{ $c->[0] } = ' '
                  unless $ConfigDefault{ $c->[0] };
                $ConfigNow{ $c->[0] } = ' '
                  unless $ConfigNow{ $c->[0] };
            }
    }


    for my $idx (0...$#ConfigArray) {
        my $c = $ConfigArray[$idx];
	    $desc = $c->[4] if $c->[0] eq "0";
        $desc =~ s/\<[^<>]*\>//go;
        print $F "# $desc #\n" if $c->[0] eq "0";
        next if $c->[0] eq "0";

        my $c0 = uc $c->[0];

        if ( $c->[4] ne $Config{ $c->[0] } ) {

            print $F "$c->[0] -- $ConfigNice{ $c->[0] }: $ConfigNow{ $c->[0] } (Default: $ConfigDefault{ $c->[0] }) \n";
        } else {

            #print F "$c->[0] -- $desc: $Config{$c->[0]}  \n";
        }
    }
    close $F;

    open( $F, '>',"$base/notes/config.txt" );
    for my $idx (0...$#ConfigArray) {
        my $c = $ConfigArray[$idx];
        $desc = $c->[7];
        if ($desc) {
          $desc =~ s/\<b\>//go;
          $desc =~ s/\<i\>//go;
          $desc =~ s/\<p\>//go;
          $desc =~ s/\<small\>//go;
          $desc =~ s/\<br \/\>//go;
          $desc =~ s/\<\/i\>//go;
          $desc =~ s/\<\/b\>//go;
          $desc =~ s/\<\/p\>//go;
          $desc =~ s/\<\/small\>//go;
          $desc =~ s/\<[^<>]*\>//go;
        }

        my $c0  = uc $c->[0];
        my $act; $act = "actual: $Config{$c->[0]}" if $Config{ $c->[0] };
        my $def = $c->[4] ? "default: $c->[4]" : '' ;
        print $F "$c->[0]: $c->[1] -- $desc $def \n"
          if $Config{ $c->[0] } eq $c->[4] && $c->[0] ne "0";
        print $F "$c->[0]: $c->[1] -- $desc $def  \n"
          if $Config{ $c->[0] } ne $c->[4] && $c->[0] ne "0";
        $desc = $c->[4] if $c->[0] eq "0";
        $desc = '' unless $desc;
        $desc =~ s/\<[^<>]*\>//go;
        print $F "# $desc #\n" if $c->[0] eq "0";

    }
    close $F;

    open( $F, '>',"$base/assp.cfg.defaults" );
    for my $idx (0...$#ConfigArray) {
        my $c = $ConfigArray[$idx];
        next if $c->[0] eq "0";
        print $F "$c->[0]:=$c->[4]\n";
    }
    close $F;
    chmod 0664, "$base/assp.cfg.defaults";

}

sub SaveConfigSettings {
    return 0 if $Config{asspCfgVersion} eq "$version$modversion";
    $Config{asspCfgVersion}="$version$modversion";
    $asspCfgVersion = "$version$modversion";
    SaveConfigSettingsForce();
    return 1;
}

sub SaveConfigSettingsForce {
    SaveConfig();
    PrintConfigSettings();
}

sub PrintConfigHistory {
    my $text = shift;
    my $lt=localtime(time);
    $text=~s/^AdminUpdate://io;
    $text=~s/^Admininfo://io;
    open(my $PCH,'>>',"$base/notes/confighistory.txt");
    print $PCH "$lt:  $text\n";
    close $PCH;
}
sub PrintAdminInfo {
    my $text = shift;
    my $lt=localtime(time);
    $text=~s/^AdminUpdate://io;
    $text=~s/^Admininfo://io;
    open(my $PAI,'>>',"$base/notes/admininfo.txt");
    print $PAI "$lt:  $text\n";
    close $PAI;
}

sub fixV1ConfigSettings {
# if we are upgrading from a version with mysql-only support - set correct the possible config values
    if (!$Config{DBdriver}) {    # this is never set if we are upgrading such a version
        $Config{DBdriver} = "mysql" if ($Config{whitelistdb}.$Config{redlistdb}.$Config{delaydb}.$Config{pbdb}.$Config{spamdb} =~ /mysql/o);
        $Config{whitelistdb} = "DB:" if ($Config{whitelistdb} =~ /mysql/o);
        $Config{redlistdb} = "DB:" if ($Config{redlistdb} =~ /mysql/o);
        $Config{delaydb} = "DB:" if ($Config{delaydb} =~ /mysql/o);
        $Config{pbdb} = "DB:" if ($Config{pbdb} =~ /mysql/o);
        $Config{spamdb} = "DB:" if ($Config{spamdb} =~ /mysql/o);
    }

# fix the SSL settings from V1
    if (exists $Config{enableSSL}) {
        $Config{DoTLS} = 2 if $Config{enableSSL};
        delete $Config{enableSSL};
    }

# fix webSecondaryPort from V1
    if (exists $Config{webSecondaryPort}) {
        if ($Config{webAdminPort} && $Config{webSecondaryPort}) {
            $Config{webAdminPort} .= '|' . $Config{webSecondaryPort};
        } elsif ( ! $Config{webAdminPort} && $Config{webSecondaryPort}) {
            $Config{webAdminPort} = $Config{webSecondaryPort};
        }
        delete $Config{webSecondaryPort};
    }
    if ($Config{EmailErrorsModifyPersBlack} == 1) {
        $Config{EmailErrorsModifyPersBlack} = '*@*';
    } else {
        $Config{EmailErrorsModifyPersBlack} = '';
    }

    $Config{Bayesian_localOnly} = $Config{yesBayesian_local} if (exists $Config{yesBayesian_local} && ! exists $Config{Bayesian_localOnly});

    $Config{PBTrapInterval} = $Config{PBTrapCacheInterval} if (exists $Config{PBTrapCacheInterval} && ! exists $Config{PBTrapInterval});
    $Config{SBCacheExp} = $Config{SBCacheInterval} if (exists $Config{SBCacheInterval} && ! exists $Config{SBCacheExp});
    $Config{RBLCacheExp} = $Config{RBLCacheInterval} if (exists $Config{RBLCacheInterval} && ! exists $Config{RBLCacheExp});
    $Config{RestartEvery} = $Config{AutoRestartInterval} if (exists $Config{AutoRestartInterval} && ! exists $Config{RestartEvery});

    if ($Config{HideIP} or $Config{HideHelo}) {
        $Config{HideIPandHelo} = "$Config{HideIP} $Config{HideHelo}";
    }

    # correct the RebuildSchedule
    if (! isSched($Config{RebuildSchedule}) && $Config{RebuildSchedule} && $Config{RebuildSchedule} =~ /(24)|^(\d+)/o ) {
        $Config{RebuildSchedule} = '0 ' . ($1 || $2) . ' * * *';
    } else {
        $Config{RebuildSchedule} = 'noschedule';
    }

    $Config{subjectFrequencyInt} = $Config{maxSameSubjectExpiration} if (exists $Config{maxSameSubjectExpiration});
    $Config{subjectFrequencyNumSubj} = $Config{maxSameSubject} if (exists $Config{maxSameSubject});
}

# This function is called on startup to clean up some settings
# Primarily these are settings that might be absent from assp.cfg
# or settings that are not needed anymore after an upgrade (fixV1ConfigSettings)
sub fixConfigSettings {
    $Config{base}=$base;

    $Config{baysNonSpamLog} = 0 if $Config{baysNonSpamLog} == 6;

    $Config{webAdminPassword}=crypt($Config{webAdminPassword},"45") if substr($Config{webAdminPassword}, 0, 2) ne "45";

    &fixV1ConfigSettings() if substr($Config{asspCfgVersion},0,1) < 2 ;

    $Config{redRe}="file:files/redre.txt" if $Config{redRe}=~/file:redre.txt/io;
    $Config{noDelay}="file:files/nodelay.txt" if $Config{noDelay}=~/file:nodelay.txt/io;

    $Config{ReStartSchedule} = 'noschedule' unless $Config{ReStartSchedule};

    if ($Config{SSLtimeout} == 180) {
        mlog(0,"warning: value '$Config{SSLtimeout}' in SSLtimeout was set to 5");
        $Config{SSLtimeout} = 5;
    }

    if ($Config{DoPrivatSpamdb} && $Config{spamdb} !~ /DB:/io) {
        mlog(0,"warning: DoPrivatSpamdb is set to '0' because spamdb is not configured to use any database 'DB:'");
        $Config{DoPrivatSpamdb} = 0;
    }

    if ($Config{allowAdminConnectionsFromName}) {
        my $host = $Config{allowAdminConnectionsFrom};
        $host .= '|' if $host;
        $host .= $Config{allowAdminConnectionsFromName};
        $Config{allowAdminConnectionsFrom} = $host;
        delete $Config{allowAdminConnectionsFromName};
    }

    if ($Config{EmailFrom} =~ /ASSP <>/io) {
        mlog(0,"warning: invalid value '$Config{EmailFrom}' in EmailFrom was set to ''");
        $EmailFrom = $Config{EmailFrom} = '';
    }

    if ($Config{EmailFrom} eq '' && ($defaultLocalHost || $EmailBlockReportDomain)) {
        my $host = $defaultLocalHost;
        $host ||= $EmailBlockReportDomain;
        $EmailFrom = $Config{EmailFrom} = "postmaster\@$host";
        mlog(0,"info: empty value '' in EmailFrom was set to '$EmailFrom'");
    }
    
    if (exists $Config{DNSTimeout}) {
        delete $Config{DNSTimeout};
    }
    if (exists $Config{CleanCacheInterval}) {
        delete $Config{CleanCacheInterval}; }
    if (exists $Config{DNSServer}) {
        delete $Config{DNSServer};
    }
    if (exists $Config{ExtensionsToBlock}) {
        $Config{BadAttachL1}=$Config{ExtensionsToBlock};

        # ExtensionsToBlock is not used in this version
        delete $Config{ExtensionsToBlock};
    }
    if (exists $Config{EmailWhitelist}) {
        $Config{EmailWhitelistAdd}=$Config{EmailWhitelist};

        # EmailWhitelist is not used in this version
        delete $Config{EmailWhitelist};
    }
    if (! exists $Config{AutoUpdateASSP}) {
        $Config{AutoRestartAfterCodeChange} = 'immed' if $Config{AutoRestartAfterCodeChange} == 1;
    }

    if ($Config{BayesMaxProcessTime} > 15) {
        $BayesMaxProcessTime = $Config{BayesMaxProcessTime} = 15;
    }
    if ($maxBayesValues > 30 && ! -e "$base/lib/ASSP_WordStem.pm") {
       $maxBayesValues = 30;
    }
    $maxBayesValues = 30 if $maxBayesValues < 30;
    
    $Config{noMaxAUTHErrorIPs} = $Config{noBlockingIPs} if (exists $newConfig{noMaxAUTHErrorIPs});

    $Config{MaxEqualXHeader} = '*=>'.$Config{MaxEqualXHeader} if $Config{MaxEqualXHeader} =~ /^\d+$/;
    
    $Config{bayslocalValencePB} = $Config{baysValencePB_local} if exists $Config{baysValencePB_local};

    $Config{autoCorrectCorpus} .= '-14' if $Config{autoCorrectCorpus} =~ /^\d\.\d\d?-\d\.\d\d?-(?:[4-9]\d{3}|\d{5,})$/o;

    $Config{useDB_File} = '' if (! $Config{PopB4SMTPFile});

    $Config{DoRFC822} = 0 if (! $Config{DoRFC822} && ! exists $newConfig{DoRFC822});

    $Config{DoHeaderAddrCheck} = '' if (length $Config{DoHeaderAddrCheck} > 1);

# -- cleanup old BerkeleyDB cache files
    if (-d "$base/tmpDB/dbmain" or -d "$base/tmpDB/dbtmp") {
        foreach ( Glob("$base/tmpDB/dbmain/*")) {
            unlink($_);
        }
        foreach ( Glob("$base/tmpDB/dbtmp/*")) {
            unlink($_);
        }
        foreach ( Glob("$base/tmpDB/*")) {
            if (-d $_) {
                rmdir($_);
            } else {
                unlink($_);
            }
        }

        my $bd2f;
        if ($Config{useDB4IntCache} &&
            $CanUseBerkeleyDB &&
            $Config{DoBackSctr} &&
            $Config{downloadBackDNSFile} &&
            ( ($bd2f) = $Config{localBackDNSFile} =~ /^ *file: *(.+)/io) &&
            -e "$base/$bd2f.BDB" )
        {
            -d "$base/tmpDB/BackDNS2" or mkdir "$base/tmpDB/BackDNS2" ,0775;
            move "$base/$bd2f.BDB","$base/tmpDB/BackDNS2/BackDNS2.bdb";
        }
    }

# -- check and set the used or available encryption engine
    $CanUseCryptGhost = $AvailCryptGhost = ASSP::CRYPT->new('a',0,0)->ENCRYPT('a') ne ASSP::CRYPT->new('a',0,1)->ENCRYPT('a');
    if ($Config{adminusersdbpass} && $Config{adminusersdbpass} =~ /^(?:[a-fA-F0-9]{2}){5,}$/o) {
        if ($AvailCryptGhost && defined ASSP::CRYPT->new($Config{webAdminPassword},0,1)->DECRYPT($Config{adminusersdbpass})) {
            $usedCrypt = 1; # can and use Crypt::GOST
        } elsif ($AvailCryptGhost && defined ASSP::CRYPT->new($Config{webAdminPassword},0,0)->DECRYPT($Config{adminusersdbpass})) {
            $CanUseCryptGhost = 0;
            $usedCrypt = -1; # can but don't use Crypt::GOST - try a later engine change
            mlog(0,"info: the old encryption engine is still used, but the new, faster one (Crypt::GOST) is available - the engine will be changed at a later time");
        } elsif (defined ASSP::CRYPT->new($Config{webAdminPassword},0,0)->DECRYPT($Config{adminusersdbpass})) {
            $usedCrypt = 0;  # can't and don't use Crypt::GOST
        } else {
            mlog(0,"error: encryption engine ERROR - unable to decrypt the value for 'adminusersdbpass'");
        }
    } else {
        $usedCrypt = 1;
    }

# -- decrypt/encrypt security vars
    my $dec = ASSP::CRYPT->new($Config{webAdminPassword},0);
    foreach (keys %cryptConfigVars) {
        $Config{$_} = $dec->DECRYPT($Config{$_}) if ($Config{$_} =~ /^(?:[a-fA-F0-9]{2}){5,}$/o && defined $dec->DECRYPT($Config{$_})) ;
    }
    $Config{adminusersdbpass} = $Config{webAdminPassword} unless $Config{adminusersdbpass};
    $Config{SNMPUser} = 'root' unless $Config{SNMPUser};

    $ConfigAdd{globalRegisterURL} = $Config{globalRegisterURL};
    $ConfigAdd{globalUploadURL} = $Config{globalUploadURL};

# -- this resets the variable name with the same name as the config key to the new value
# -- for example $Config{myName}="ASSP-nospam" -> $myName="ASSP-nospam";
    foreach (keys %Config) {${$_}=$Config{$_};}

    # set the date/time for assp.cfg
    $asspCFGTime = $FileUpdate{"$base/assp.cfgasspCfg"} = ftime("$base/assp.cfg");

    my ($logdir, $logdirfile) = $logfile =~ /^(.*[\/\\])?(.*?)$/o;
    $blogfile = "$logdir" . "b$logdirfile";

    if ($DisableSMTPNetworking == 2) {
        $Config{DisableSMTPNetworking} = $DisableSMTPNetworking = 0;
    }

    $Config{bombError} = $bombError = $SpamError if !$bombError;

    if ($Config{inclResendLink}) {
        $fileLogging = $Config{fileLogging} = 1;
    }

    $Config{ignoreDBVersionMissMatch} = $ignoreDBVersionMissMatch = 3  # ignore DB Version Miss Match if rebuild is not used
        if (   ! $Config{spamdb}
            || ($CanUseSchedCron && $Config{RebuildSchedule} =~ /noschedule/io)
            || ! $CanUseSchedCron);

    $Config{MemoryUsageLimit} = (($Config{NumComWorkers} + 3) * 100) if ($Config{MemoryUsageLimit} && $Config{MemoryUsageLimit} < (($Config{NumComWorkers} + 3) * 100));

    # correct the DoRebuildSpamdb to RebuildSchedule

    if ($Config{DoRebuildSpamdb} && $Config{RebuildSchedule} eq 'noschedule') {
        $Config{RebuildSchedule} = '0 ' . $Config{DoRebuildSpamdb} . ' * * *';
        delete $Config{DoRebuildSpamdb};
    }

    # limit the workernumber if BerkeleyDB is used for all hashes
    
    if ($CanUseBerkeleyDB &&
        $NumComWorkers > 15 &&
        $DBdriver =~ /BerkeleyDB/o &&
        $pbdb =~ /DB:/o &&
        $useDB4IntCache &&
        $useDB4griplist
       )
    {
        $NumComWorkers = $Config{NumComWorkers} = 15;
        mlog(0,"ATTENTION: 'NumComWorkers' was reduced to 15, because of extensive BerkeleyDB configuration");
    }

    if ($newConfig{UseUnicode4SubjectLogging} && $UseUnicode4MaillogNames) {
        $UseUnicode4SubjectLogging = $Config{UseUnicode4SubjectLogging} = 1;
        mlog(0,"adminupdate: 'UseUnicode4SubjectLogging' was set to 1, because 'UseUnicode4MaillogNames' is 1 on version upgrade");
    }
    my $savecfg = 0;
    my $savesync = 0;
    foreach (sort keys %newConfig) {
        mlog(0,"info: new config parameter $_ was set to ${$_}");
        if (&syncCanSync() && ! exists $neverShareCFG{$_}) {
            $ConfigSync{$_} = &share({});
            $ConfigSync{$_}->{sync_cfg} = 0;
            $ConfigSync{$_}->{sync_server} = &share({});
            $savesync = 1;
        }
        $savecfg = 1;
    }
    &SaveConfig() if $savecfg;
    &syncWriteConfig() if $savesync;
    %newConfig = ();

    for my $idx (0...$#ConfigArray) {
        my $c = $ConfigArray[$idx];
        if ($c->[0] && ${$c->[0]} !~ /$c->[5]/) {
            mlog(0,"info: $c->[0] - invalid value ${$c->[0]} corrected to $c->[4]");
            ${$c->[0]} = $c->[4];
            $Config{$c->[0]} = $c->[4];
        }
    }
    $runHMMusesBDB = $HMMusesBDB;
    print "\t\t\t\t\t[OK]\n";
    # turn settings into regular expressions
    &ThreadCompileAllRE(1);
}

sub unloadSub {
    my $sub = shift;
    $sub = 'main::'.$sub unless $sub =~ /::/;
    if (defined &{$sub}) {
        d("Worker $WorkerNumber undefines sub $sub");
        undef &{$sub};
    }
    $CanUseAsspSelfLoader && delete $AsspSelfLoader::Cache{$sub};
    $sub .= '_Run';
    if (defined &{$sub}) {
        d("Worker $WorkerNumber undefines sub $sub");
        undef &{$sub};
    }
    $CanUseAsspSelfLoader && delete $AsspSelfLoader::Cache{$sub};
}

sub unloadNameSpace {
    my $module = shift;
    return unless scalar(keys %{$module.'::'});
    my $noLoad = "no $module;";
    eval $noLoad;
    $module =~ s/::/\//go;
    delete $INC{$module};
}

sub unloadComThreadModules {
    unloadNameSpace 'Win32::Daemon';
    unloadNameSpace 'Win32::API::OutputDebugString';
    unloadNameSpace 'Win32::OLE';
    unloadNameSpace 'Sys::Syslog';
    unloadNameSpace 'File::ReadBackwards';
    unloadNameSpace 'Thread::State';
    unloadNameSpace 'Compress::Zlib';
    unloadNameSpace 'LWP::Simple';
    unloadNameSpace 'HTTP::Request::Common';
    unloadNameSpace 'LWP::UserAgent';
    unloadNameSpace 'Sys::MemInfo';
    unloadNameSpace 'NetSNMP::agent';
    unloadNameSpace 'NetSNMP::ASN';
    unloadNameSpace 'NetSNMP::default_store';
    unloadNameSpace 'NetSNMP::agent::default_store';
    unloadNameSpace 'Schedule::Cron';
    unloadNameSpace 'Tie::RDBM' unless $useTieRDBM;
    %lngmsg =();
    undef %lngmsg;
    %lngmsghint =();
    undef %lngmsghint;

    undef $GPBinstallLib;
    undef $GPBCompLibVer;

    undef $kudos;
    undef $footers;
    undef $headers;
    undef $headerTOC;
    undef $headerGlosar;
    %glosarIndex = ();
    undef $headerDTDStrict;
    undef $headerDTDTransitional;
    undef $headerHTTP;

    unloadSub 'BlockReportFromQ';
    unloadSub 'BlockReportText';
    unloadSub 'BlockReportGetCSS';
    unloadSub 'BlockReportGetImage';
    unloadSub 'BlockReportHTMLTextWrap';
    unloadSub 'calcWorkers';
    unloadSub 'canUserDo';
    unloadSub 'ChangeMyPassword';
    unloadSub 'CheckTableStructure';
    unloadSub 'cleanBlackPB';
    unloadSub 'CleanCache';
    unloadSub 'cleanCacheBackDNS';
    unloadSub 'cleanCacheBackDNS2';
    unloadSub 'cleanCacheBATVTag';
    unloadSub 'cleanCacheIPNumTries';
    unloadSub 'cleanCacheLocalFrequency';
    unloadSub 'cleanCacheMXA';
    unloadSub 'cleanCachePersBlack';
    unloadSub 'cleanCachePTR';
    unloadSub 'cleanCacheRBL';
    unloadSub 'cleanCacheRWL';
    unloadSub 'cleanCacheSB';
    unloadSub 'cleanCacheSMTPdomainIP';
    unloadSub 'cleanCacheSPF';
    unloadSub 'cleanCacheSSLfailed';
    unloadSub 'cleanCacheURI';
    unloadSub 'CleanDelayDB';
    unloadSub 'CleanPB';
    unloadSub 'cleanTrapPB';
    unloadSub 'cleanUpCollection';
    unloadSub 'cleanUpFiles';
    unloadSub 'cleanUpMaillog';
    unloadSub 'cleanUpMaxFiles';
    unloadSub 'cleanWhitePB';
    unloadSub 'CleanWhitelist';
    unloadSub 'ConfigEdit';
    unloadSub 'ConfigLists';
    unloadSub 'ConfigMaillog';
    unloadSub 'ConfigQuit';
    unloadSub 'ConfigStats';
    unloadSub 'ConfigStatsRaw';
    unloadSub 'ConfigStatsXml';
    unloadSub 'ConToThread';
    unloadSub 'debugWrite';
    unloadSub 'Donations';
    unloadSub 'downASSP';
    unloadSub 'downloadASSPVersion';
    unloadSub 'downloadBackDNS';
    unloadSub 'downloadDropList';
    unloadSub 'downloadGrip';
    unloadSub 'downloadHTTP';
    unloadSub 'downloadTLDList';
    unloadSub 'downloadVersionFile';
    unloadSub 'exportDB';
    unloadSub 'exportExtreme';
    unloadSub 'exportMysqlDB';
    unloadSub 'fixConfigSettings';
    unloadSub 'BlockReportGen';
    unloadSub 'genCerts';
    unloadSub 'genGlobalPBBlack';
    unloadSub 'genGlobalPBWhite';
    unloadSub 'getBestWorker';
    unloadSub 'BlockReasonsGet';
    unloadSub 'getStuckWorker';
    unloadSub 'importDB';
    unloadSub 'importMysqlDB';
    unloadSub 'init';
    unloadSub 'installService';
    unloadSub 'LDAPcrossCheck';
    unloadSub 'loadPluginConfig';
    unloadSub 'MainLoop';
    unloadSub 'MainLoop2';
    unloadSub 'ManageAdminUsers';
    unloadSub 'memoryUsage';
    unloadSub 'mergeBackDNS';
    unloadSub 'newListen';
    unloadSub 'newListenSSL';
    unloadSub 'newThread';
    unloadSub 'NewStatConnection';
    unloadSub 'NewWebConnection';
    unloadSub 'niceConfig';
    unloadSub 'niceLink';
    unloadSub 'niceConfigPos';
    unloadSub 'POP3Collect';
    unloadSub 'putAdminUsers';
    unloadSub 'registerGlobalClient';
    unloadSub 'reloadConfigFile';
    unloadSub 'RemovePid';
    unloadSub 'removePluginConfig';
    unloadSub 'renderConfigHTML';
    unloadSub 'resend_mail';
    unloadSub 'BlockedMailResend';
    unloadSub 'resendError';
    unloadSub 'resetFH';
    unloadSub 'ResetStats';
    unloadSub 'return_cfg';
    unloadSub 'runRebuild';
    unloadSub 'SaveConfig';
    unloadSub 'SaveConfigSettings';
    unloadSub 'SaveDelaydb';
    unloadSub 'SaveHash';
    unloadSub 'SaveLDAPlist';
    unloadSub 'SavePB';
    unloadSub 'SaveStats';
    unloadSub 'SaveWhitelist';
    unloadSub 'SaveWhitelistOnly';
    unloadSub 'sendGlobalFile';
    unloadSub 'serviceCheck';
    unloadSub 'setMainLang';
    unloadSub 'Shutdown';
    unloadSub 'ShutdownFrame';
    unloadSub 'ShutdownList';
    unloadSub 'SMTPSessionLimitCheck';
    unloadSub 'SNMPcleanHTML';
    unloadSub 'SNMPderefVal';
    unloadSub 'SNMPgetUsers';
    unloadSub 'SNMPhandler';
    unloadSub 'SNMPload_1';
    unloadSub 'SNMPload_1_0';
    unloadSub 'SNMPload_1_0_healthy';
    unloadSub 'SNMPload_1_13';
    unloadSub 'SNMPload_1_30';
    unloadSub 'SNMPload_1_31';
    unloadSub 'SNMPload_2';
    unloadSub 'SNMPload_2_X56';
    unloadSub 'SNMPload_2_X56s';
    unloadSub 'SNMPload_3';
    unloadSub 'SNMPload_4';
    unloadSub 'SNMPload_5';
    unloadSub 'SNMPStats';
    unloadSub 'SNMPVarType';
    unloadSub 'StatsGetModules';
    unloadSub 'StatLine';
    unloadSub 'statRequest';
    unloadSub 'StatTraffic';
    unloadSub 'stopSMTPThreads';
    unloadSub 'switchUsers';
    unloadSub 'tellThreadQuit';
    unloadSub 'tellThreadsReReadConfig';
    unloadSub 'ThreadMaintMain';
    unloadSub 'ThreadMaintStart';
    unloadSub 'ThreadRebuildSpamDBMain';
    unloadSub 'ThreadRebuildSpamDBStart';
    unloadSub 'ThreadsWakeUp';
    unloadSub 'tosyslog';
    unloadSub 'w32dbg';
    unloadSub 'WaitForAllThreads';
    unloadSub 'WebAuth';
    unloadSub 'webBlock';
    unloadSub 'webConfig';
    unloadSub 'WebDone';
    unloadSub 'WebLogout';
    unloadSub 'WebPermission';
    unloadSub 'webRequest';
    unloadSub 'WebTraffic';
    unloadSub 'write_rebuild_module';

# unneeded config subs

    unloadSub 'ConfigChangeStatPort';
    unloadSub 'ConfigChangePassword';
    unloadSub 'ConfigChangePassPhrase';
    unloadSub 'ConfigChangeLogfile';
    unloadSub 'configChangeWorkerPriority';
    unloadSub 'configChangeNumThreads';
    unloadSub 'configChangeAutoReloadCfg';
    unloadSub 'configUpdateGlobalClient';
    unloadSub 'configUpdateGlobalHidden';
    unloadSub 'configChangeRSRBSched';
    unloadSub 'configChangeSched';
    unloadSub 'configChangeSNMP';
}

sub unloadHighThreadModules {
    unloadNameSpace 'Win32::Daemon';
    unloadNameSpace 'Win32::API::OutputDebugString';
    unloadNameSpace 'Sys::Syslog';
    unloadNameSpace 'Thread::State';
    unloadNameSpace 'Convert::TNEF';
    unloadNameSpace 'Mail::SRS';
    unloadNameSpace 'NetSNMP::agent';
    unloadNameSpace 'NetSNMP::ASN';
    unloadNameSpace 'NetSNMP::default_store';
    unloadNameSpace 'NetSNMP::agent::default_store';
    unloadNameSpace 'File::Scan::ClamAV';
    unloadNameSpace 'File::ReadBackwards';
    unloadNameSpace 'Tie::RDBM' unless $useTieRDBM;

    %lngmsg =();
    undef %lngmsg;
    %lngmsghint =();
    undef %lngmsghint;
    undef $kudos;
    undef $footers;
    undef $headers;
    undef $headerTOC;
    undef $headerGlosar;
    %glosarIndex = ();
    undef $headerDTDStrict;
    undef $headerDTDTransitional;
    undef $headerHTTP;
    undef $crashHMM;
}

sub unloadMainThreadModules {
#    unloadNameSpace 'Mail::SPF';
#    unloadNameSpace 'Mail::SPF::Query';
#    unloadNameSpace 'Mail::SRS';
#    unloadNameSpace 'Email::MIME';
#    unloadNameSpace 'MIME::Types';
#    unloadNameSpace 'Email::Send';
#    unloadNameSpace 'Convert::TNEF';
#    unloadNameSpace 'Mail::DKIM::Verifier';
#    unloadNameSpace 'Mail::DKIM';
#    unloadNameSpace 'Mail::DKIM::Signer';
#    unloadNameSpace 'Authen::SASL';

    unloadSub 'BlockedMailResend';
    unloadSub 'BlockReportFromQ';
    unloadSub 'BlockReportText';
    unloadSub 'BlockReportGetCSS';
    unloadSub 'BlockReportGetImage';
    unloadSub 'BlockReasonsGet';
    unloadSub 'BlockReportHTMLTextWrap';
    unloadSub 'cleanBlackPB';
    unloadSub 'CleanCache';
    unloadSub 'cleanCacheBackDNS';
    unloadSub 'cleanCacheBackDNS2';
    unloadSub 'cleanCacheBATVTag';
    unloadSub 'cleanCacheIPNumTries';
    unloadSub 'cleanCacheLocalFrequency';
    unloadSub 'cleanCacheMXA';
    unloadSub 'cleanCachePersBlack';
    unloadSub 'cleanCachePTR';
    unloadSub 'cleanCacheRBL';
    unloadSub 'cleanCacheRWL';
    unloadSub 'cleanCacheSB';
    unloadSub 'cleanCacheSMTPdomainIP';
    unloadSub 'cleanCacheSPF';
    unloadSub 'cleanCacheSSLfailed';
    unloadSub 'cleanCacheURI';
    unloadSub 'CleanDelayDB';
    unloadSub 'CleanPB';
    unloadSub 'cleanTrapPB';
    unloadSub 'cleanUpCollection';
    unloadSub 'cleanUpFiles';
    unloadSub 'cleanUpMaillog';
    unloadSub 'cleanUpMaxFiles';
    unloadSub 'cleanWhitePB';
    unloadSub 'CleanWhitelist';
    unloadSub 'downloadASSPVersion';
    unloadSub 'downloadBackDNS';
    unloadSub 'downloadDropList';
    unloadSub 'downloadGrip';
    unloadSub 'downloadHTTP';
    unloadSub 'downloadTLDList';
    unloadSub 'downloadVersionFile';
    unloadSub 'exportExtreme';
    unloadSub 'genCerts';
    unloadSub 'genGlobalPBBlack';
    unloadSub 'genGlobalPBWhite';
    unloadSub 'init';
    unloadSub 'installService';
    unloadSub 'LDAPcrossCheck';
    unloadSub 'POP3Collect';
    unloadSub 'resend_mail';
    unloadSub 'write_rebuild_module';
}

sub ThreadCompileAllRE {
    my $init = shift;
    my %configOFiles = (       # possibly option files that have to be registered
        'ConfigMakeRe' => 1,
        'ConfigMakeLocalDomainsRe' => 1,
        'ConfigMakePrivatRe' => 1,
        'ConfigMakeSLRe' => 1,
        'ConfigMakeSLReSL' => 1,
        'ConfigMakeIPRe' => 1,
        'ConfigMakeGroupRe' => 1,
        'configUpdateRBLSP' => 1,
        'configUpdateURIBLSP' => 1,
        'configUpdateRWLSP' => 1,
        'updateDNS' => 1,
        'configUpdateASSPCfg' => 1,
        'configUpdateDKIMConf' => 1,
        'configChangeRcptRepl' => 1,
        'ConfigCompileRe' => 1,
        'ConfigCompileNotifyRe' => 1,
        'configUpdateCCD' => 1,
        'configUpdateCA' => 1,
        'configUpdateSPFOF' => 1,
        'configChangeMSGIDSec' => 1,
        'configChangeBATVSec' => 1,
        'configUpdateBACKSctrSP' => 1,
        'configChangeIC' => 1,
        'configChangeOC' => 1,
        'configChangeProxy' => 1,
        'ConfigChangeSyncFile' => 1,
        'configChangeRT' => 1,
        'configUpdateMaxSize' => 1,
        'configUpdateStringToNum' => 1,
        'configChangeConfigSched' => 1,
        'updateUserAttach' => 1,
        'ConfigMakeEmailAdmDomRe' => 1
    );
    my %initConfig = (               #     config parms that have to be inititalized anyway
        'BadAttachL1' => 'Initializing',
        'GoodAttach' => 'Initializing',
        'ValidateRBL' => 'Initializing',
        'ValidateRWL' => 'Initializing',
        'ValidateURIBL' => 'Initializing',
        'EnableSRS' => 'Initializing',
        'freqNonSpam' => 'Initializing',
        'freqSpam' => 'Initializing',
        'NoTLSlistenPorts' => 'Initializing',
        'NoAUTHlistenPorts' => 'Initializing',
        'TLStoProxyListenPorts' => 'Initializing',
        'MaxAllowedDups' => 'Initializing',
        'POP3ConfigFile' => 'Initializing',
        'asspCpuAffinity' => 'Initializing'
    );
    @PossibleOptionFiles=();
    for my $idx (0...$#ConfigArray) {
        my $c = $ConfigArray[$idx];
        next if @{$c}==5; # skip headings
        if ($WorkerNumber > 0 && $WorkerNumber < 1000) {
            undef $c->[2] if $c->[2];
            undef $c->[3] if $c->[3];
            undef $c->[4] if $c->[4];
            undef $c->[5] if $c->[5];
            undef $c->[7] if $c->[7];
        }
        next if (! $c->[6]);

        if (   exists $configOFiles{$c->[6]}  # are there possibly option files - register them
            || exists $PluginFiles{$c->[0]}   # are there possibly plugin option files - register them
           )
        {
            push(@PossibleOptionFiles,[$c->[0],$c->[1],$c->[6]]);
            mlog(0,"ERROR: possible code or language file error in config for $c->[0] - '*' not found at the end of the small description") if ($c->[1] !~ /\*\s*$/o && $WorkerNumber == 0);
            mlog(0,"ERROR: possible code or language file error in config for $c->[0] - '**' not found at the end of the small description for weighted RE") if (exists $WeightedRe{$c->[0]} && $c->[1] !~ /\*\*\s*$/o && $WorkerNumber == 0);
        } elsif ($c->[0] ne 'POP3ConfigFile') {
            mlog(0,"ERROR: possible code error in sub 'ThreadCompileAllRE' for $c->[0] - option file is not checked") if ($c->[1] =~ /\*$/o && $WorkerNumber == 0);
        }

        if ($c->[0] =~ /ValencePB$/o && defined $c->[6]) {     # initialize the Valence configuration values
            $c->[6]->($c->[0],$Config{$c->[0]},$Config{$c->[0]},$init);
        }

        if (exists $initConfig{$c->[0]}) {     # there are config parms that have to be inititalized anyway
            d("call to $c->[6]->($c->[0],'',$Config{$c->[0]},$initConfig{$c->[0]})");
            $c->[6]->($c->[0],'',$Config{$c->[0]},$initConfig{$c->[0]});
        }
    }
    push(@PossibleOptionFiles,['TLDS','TOP level Domains',\&ConfigCompileRe]);
    push(@PossibleOptionFiles,['BlockReportFile','File for Blockreportrequest',\&initMaintScheduler]) if $BlockReportFile;

    for my $idx (0...$#PossibleOptionFiles) {
        my $f = $PossibleOptionFiles[$idx];
        next if ($f->[0] eq 'asspCfg');
        if ($init) {
            $f->[2]->($f->[0],'',$Config{$f->[0]},'Initializing',$f->[1]);
        } else {
            if (($Config{$f->[0]} =~ /^ *file: *(.+)/io && fileUpdated($1,$f->[0])) or
                $Config{$f->[0]} !~ /^ *file: *(.+)/io or
                exists $ConfigWatch{$f->[0]})
            {
               $f->[2]->($f->[0],$Config{$f->[0]},$Config{$f->[0]},'',$f->[1]);
            }
        }
    }

    $spamSubjectEnc = is_7bit_clean(\$spamSubject) ? $spamSubject : encodeMimeWord($spamSubject,'B','UTF-8');
}

sub optionFilesReload {
 # check if options files have been updated and need to be re-read
    for my $idx (0...$#PossibleOptionFiles) {
        my $f = $PossibleOptionFiles[$idx];
        if($f->[0] ne 'asspCfg' or ($f->[0] eq 'asspCfg' && $AutoReloadCfg)) {
            if ($Config{$f->[0]}=~/^ *file: *(.+)/io && fileUpdated($1,$f->[0]) ) {
                $f->[2]->($f->[0],$Config{$f->[0]},$Config{$f->[0]},'',$f->[1]);
                &syncConfigDetect($f->[0]);
            }
        }
    }
}

sub ConfigRegisterConfigWatch {
    my ($name,$sub,$time,$desc) = @_;
    $ConfigWatch{$name} = "$sub,$time,$desc";
    d("registered config watch for $name with '$ConfigWatch{$name}'");
    my $minwait = 999999999;
    my $ret;
    while (my($k,$v) = each %ConfigWatch) {
        if (!$k || !$v) {
            delete $ConfigWatch{$k};
            next;
        }
        next if $v eq 'delete';
        my ($s,$t,$d) = split(/,/o,$v,3);
        $t ||= 0;
        if ($t < 60) {
            $ret .= ConfigShowError(1,"error: config reload scheduler got a value of $t seconds (less 60) for $name - ignored");
            delete $ConfigWatch{$k};
            next;
        }
        $minwait = $t if $t < $minwait;
    }
    if ($WorkerNumber == 0) {
        $NextConfigReload = time + $minwait;
        $ret .= ConfigShowError(0,"info: next automatic configuration reload is scheduled at ".timestring($NextConfigReload)) if $minwait < 999999999;
    }
    return $ret;
}

sub ConfigCheckGroupWatch {
    my $group = shift;
    foreach my $config (sort {$ConfigNum{$main::a} cmp $ConfigNum{$main::b}} keys %{$GroupWatch{$group}}) {
        eval{$GroupWatch{$group}->{$config}->[0]->($config,$Config{$config},$Config{$config},'',$GroupWatch{$group}->{$config}->[1]);};
    }
}

sub GroupReplace {
    my ($re,$ext) = @_;
    $ext =~ s/[\s\r\n]//go;
    return $re unless $ext;
    return $re unless $re;
    my @tmp = split(/\|/o,$re);
    return join('|', map {my $t = $_ . $ext; $t;} @tmp);
}

sub ConfigRegisterGroupWatch {
    my ($new,$name,$note,$action) = @_;
    my $ret;
    $action = $action ? 0 : 1;
    foreach my $group (keys %GroupWatch) {
        delete $GroupWatch{$group}->{$name};
        delete $GroupWatch{$group} unless (scalar keys %{$GroupWatch{$group}});
    }
    my $re = '\[\s*([A-Za-z0-9.\-_]+)\s*\]';
    $re .= '([^\|]*)' if $action;
    while (${$new} =~ s/$re/&GroupReplace($GroupRE{$1},$2)/e) {
        d("RegisterGroup: found group '$1' in '$name' with extension '$2' (action is $action) - replaced with '$GroupRE{$1}'") if $WorkerNumber == 0;
        $GroupWatch{$1}->{$name} = [[caller(unpack("A1",${'X'})-1)]->[unpack("A1",${'X'})+1]];
        $note and push (@{$GroupWatch{$1}->{$name}} , $note);
        if (! exists $GroupRE{$1} && $WorkerNumber == 0) {
            $ret .= ConfigShowError(0,"warning: found group definition [$1] in configuration for $name - but group $1 is not defined or empty in Groups");
        }
    }
    return $ret;
}

sub ConfigMakeGroupRe {
    my ($name, $old, $new, $init)=@_;
    mlog( 0, "adminupdate: $name changed from '$old' to '$new'" )
      unless $init || $new eq $old;
    my $fil; my $ofil; my $isdynamic;
    $fil = $1 if $new =~ /^ *file: *(.+)/io;
    $fil="$base/$fil" if $fil && $fil!~/^\Q$base\E/io;
    $ofil = $1 if $old =~ /^ *file: *(.+)/io;
    $ofil="$base/$ofil" if $ofil && $ofil!~/^\Q$base\E/io;
    delete $CryptFile{$ofil} if $ofil;
    $CryptFile{$fil} = 1 if $fil;
    if ($WorkerNumber > 0) {    # %GroupRE is shared and already set for Workers from MainThread
        $FileUpdate{"$fil$name"} = $FileUpdate{$fil} = ftime($fil);
        foreach my $group (keys %GroupWatch) {
            &ConfigCheckGroupWatch($group);
        }
        return;
    }
    ${$name} = $new unless $WorkerNumber;
    if ($init && $fil && !-e $fil) {
        &downloadHTTP($GroupsFileURL,
            $fil,
            0,
            "GroupsFile",5,9,2,1);
    }
    $new = checkOptionList( $new, $name, $init , 1);
    if (! $new) {
        %GroupRE = ();
        foreach my $group (keys %GroupWatch) {
            &ConfigCheckGroupWatch($group);
        }
        mlog(0,"info: no groups loaded from groupsfile $fil") if $MaintenanceLog > 1;
        return;
    }
    mlog(0,"info: loading groups from groupsfile $fil") if $MaintenanceLog;
    my @entry = split(/\|/o,$new);
    my $group;
    my %NewGroupRE;
    my $count = 0;
    my $ldapcnt = 0;
    my $execcnt = 0;
    my $continue;
    while (@entry) {
        my $e = shift @entry;
        $e =~ s/^\s*(.*)?\s*$/$1/o;
        $e =~ s/^[#;].*//o;
        next unless $e;
        if ($e =~ s/\s*\/\s*$//o) {
            $continue .= $e;
            next;
        }
        $e = $continue . $e;
        $continue = '';
        if ($e =~ /^\[\s*([^\]]+?)\s*\]$/o) {
            my $grp = $1;
            $count = 'NO' unless $count;
            my $s = ($count eq 'NO' or $count > 1) ? 's' : '';
            mlog(0,"info: group $group loaded with $count record$s") if $group && $MaintenanceLog;
            $count = 0;
            $ldapcnt = 0;
            $execcnt = 0;
            $group = $grp;
            next;
        }
        next unless $group;
        if ($e =~ /^ldap:\s*\{([^{}]*)\}\s*,\s*\{([^{}]*)\}\s*\{([^{}]*)\}\s*,\s*\{([^{}]*)\}\s*\{([^{}]*)\}$/io) {
            my $ldaphostdef = $1;
            my $userfilt = $2;
            my $userattr = $3;
            my $addrfilt = $4;
            my $addrattr = $5;
            $isdynamic = 1;
            my ($usercode,$addrcode);
            mlog(0,"info: LDAPList-query: <$1> , <$2> , <$3> , <$4> , <$5>") if $LDAPLog > 2;
            ($userfilt,$usercode) = split(/\s*<=\s*/o,$userfilt,2);
            ($addrfilt,$addrcode) = split(/\s*<=\s*/o,$addrfilt,2);
            $ldaphostdef =~ s/^\s*//o;
            $ldaphostdef =~ s/\s*$//o;
            my %queryattr;
            my %ldap ;
            if ($ldaphostdef) {
                for my $tag ('host','password', 'base', 'user') {
                    if ($ldaphostdef =~ /$tag\s*=>\s*(.)/i) {
                        my $sep = quotemeta($1);
                        $queryattr{$tag} = $1 if $ldaphostdef =~ s/$tag\s*=>\s*$sep([^$sep]*)$sep,?//i;
                    }
                }
                my %tldap = split(/\s*(?:,|=>)\s*/o,$ldaphostdef);
                while (my ($k,$v) = each %tldap) {
                    $ldap{lc $k} = $v;
                }
            }
            $ldap{host} =~ s/,/\|/go;
            $ldap{password} = $queryattr{password} if exists $queryattr{password};
            $ldap{base} = $queryattr{base} if exists $queryattr{base};
            $ldap{user} = $queryattr{user} if exists $queryattr{user};
            $ldap{ldapfilt} = $userfilt;
            $ldap{attr} = $userattr;
            $ldapcnt++;
            d("ConfigMakeGroupRe - $e");
            $e = '';
            if ($addrfilt and $addrattr) {
                foreach my $userid (&LDAPList(%ldap)) {
                    if ($usercode) {
                        $_ = $userid;
                        if (eval($usercode)) {
                            $userid = $_;
                        } elsif ($@) {
                            mlog(0,"error: running the user-filter-callback ($usercode) on ($userid) caused an exception - $@");
                            next;
                        } else {
                            mlog(0,"info: the user-filter-callback ($usercode) on ($userid) returned zero or undef - entry is ignored") if $LDAPLog > 2;
                            next;
                        }
                    }
                    next unless $userid;
                    my $tmpaddrfilt = $addrfilt;
                    my %attr = split(/[=,]/o,$userid);
                    while( my ($tag,$val) = (each %attr)) {
                        my $qtag = quotemeta($tag);
                        $tmpaddrfilt =~ s/$qtag\=\%USERID\%/$tag=$val/g;
                    }
                    $tmpaddrfilt =~ s/\%USERID\%/$userid/g;
                    $ldap{ldapfilt} = $tmpaddrfilt;
                    $ldap{attr} = $addrattr;
                    my @adr = &LDAPList(%ldap);
                    my @tadr;
                    if ($addrcode) {
                        for (@adr) {
                            if (eval($addrcode)) {
                                push @tadr, $_;
                            } elsif ($@) {
                                mlog(0,"error: running the address-filter-callback ($addrcode) on ($_) caused an exception - $@");
                                next;
                            } else {
                                mlog(0,"info: the address-filter-callback ($addrcode) on ($_) returned zero or undef - entry is ignored") if $LDAPLog > 2;
                                next;
                            }
                        }
                        @adr = @tadr;
                    }
                    @adr && $e && ($e .= '|');
                    $e .= join('|',@adr);
                }
            } else {
                my @adr;
                foreach my $userid (&LDAPList(%ldap)) {
                    if ($usercode) {
                        $_ = $userid;
                        if (eval($usercode)) {
                            $userid = $_;
                        } elsif ($@) {
                            mlog(0,"error: running the user-filter-callback ($usercode) on ($userid) caused an exception - $@");
                            next;
                        } else {
                            mlog(0,"info: the user-filter-callback ($usercode) on ($userid) returned zero or undef - entry is ignored") if $LDAPLog > 2;
                            next;
                        }
                    }
                    next unless $userid;
                    push @adr, $userid;
                }
                $e = join('|',@adr);
            }
            d("ConfigMakeGroupRe - result: $e");
            my $adr = () = $e =~ /([^\\]\|)/go;
            $adr = $e ? $adr + 1 : 'NO';
            my $es = ($adr eq 'NO' or $adr > 1) ? 'es' : '';
            mlog(0,"info: group $group loaded $adr address$es via LDAP(line $ldapcnt)") if $MaintenanceLog;
            next unless $e;
            $count += $adr;
        } elsif ($e =~ /^exec:\s*(.+)$/io) {
            my $cmd = $1;
            $isdynamic = 1;
            $execcnt++;
            d("ConfigMakeGroupRe - $e");
            $e = join('|',split(/\s*(?:\r?\n|,|\|)\s*/o,qx($cmd)));
            d("ConfigMakeGroupRe - result: $e");
            my $adr = () = $e =~ /([^\\]\|)/go;
            $adr = $e ? $adr + 1 : 'NO';
            my $es = ($adr eq 'NO' or $adr > 1) ? 'es' : '';
            mlog(0,"info: group $group loaded $adr address$es via exec(line $execcnt)") if $MaintenanceLog;
            next unless $e;
            $count += $adr;
        } else {
            $count++;
        }
        $NewGroupRE{$group} && ($NewGroupRE{$group} .= '|');
        $NewGroupRE{$group} .= $e;
    }
    $count = 'NO' unless $count;
    my $s = ($count eq 'NO' or $count > 1) ? 's' : '';
    mlog(0,"info: group $group loaded with $count record$s") if $group && $MaintenanceLog > 1;
    -d "$base/files/groups_export" or mkdir "$base/files/groups_export" ,0755;
    while ( ($group,my $re) = each %GroupRE) {
        unlink "$base/files/groups_export/$group.txt";
    }
    while ( ($group,my $re) = each %NewGroupRE) {
        if (open my $f,'>',"$base/files/groups_export/$group.txt") {
            binmode $f;
            $re =~ s/\|/\n/go;
            print $f $re;
            close $f;
        }
    }
    %GroupRE = %NewGroupRE;
    foreach my $group (keys %GroupWatch) {
        &ConfigCheckGroupWatch($group);
    }
    $GroupsDynamic = $isdynamic;
    return '';
}

sub ConfigMakeRe {
    my ($name, $old, $new, $init, $desc)=@_;
    my $note = "AdminUpdate: $name changed from '$old' to '$new'";
    $note = "AdminUpdate: $name changed" if exists $cryptConfigVars{$name};
    mlog(0,$note) unless $init || $new eq $old;
    ${$name} = $new unless $WorkerNumber;
    $new=checkOptionList($new,$name,$init);
    my $ret = &ConfigRegisterGroupWatch(\$new,$name,$desc);
    $new =~ s/([\\]\|)*\|+/$1\|/go;
    $new = join('|', sort split(/\|/o,$new)) if $new;
    $new=~s/([\@\.\[\]\-\(\)\+\\])/\\$1/go;
    $new =~ s/\?/\./go;
    $new=~s/\*/\.\{0,64\}/go;
    $new||=$neverMatch; # regexp that never matches
    $ret .= ConfigShowError(1,"ERROR: !!!!!!!!!! missing MakeRE{$name} in code !!!!!!!!!!") if ! exists $MakeRE{$name} && $WorkerNumber == 0;

    $MakeRE{$name}->($new,$name);
    return $ret . ConfigShowError(1,$RegexError{$name});
}

sub ConfigMakePrivatRe {
    my ($name, $old, $new, $init, $desc)=@_;
    my $note = "AdminUpdate: $name changed from '$old' to '$new'";
    $note = "AdminUpdate: $name changed" if exists $cryptConfigVars{$name};
    mlog(0,$note) unless $init || $new eq $old;
    ${$name} = $new unless $WorkerNumber;
    my @new=checkOptionList($new,$name,$init);
    my $ret;
    if (exists $MakePrivatDomRE{$name}) {
        $new = join('|',map{my $t=$_;$t=~s/^(.+?)\s*=>\s*(.+)$/(:$1),(:$2)/;defined(*{'yield'})?$t:undef;}sort{length($main::a)<=>length($main::b)}@new);
    } else {
        $ret .= ConfigShowError(1,"ERROR: !!!!!!!!!! missing MakePrivatDomRE{$name} in code !!!!!!!!!!") if $WorkerNumber == 0;
        $new = join('|',sort{length($main::a)<=>length($main::b)}@new);
    }
    $ret .= &ConfigRegisterGroupWatch(\$new,$name,$desc,1);
    $new =~ s/([\\]\|)*\|+/$1\|/go;
    $new =~ s/([\@\.\[\]\-\+\\])/\\$1/go;
    $new =~ s/\*/\.\{0,64\}/go;
    $new =~ s/\?/\./go;
    $new =~ s/\(\:/(?:/go;
    $new||=$neverMatch; # regexp that never matches
    $ret .= ConfigShowError(1,"ERROR: !!!!!!!!!! missing MakeRE{$name} in code !!!!!!!!!!") if ! exists $MakeRE{$name} && $WorkerNumber == 0;

    $MakeRE{$name}->($new,$name);
    return $ret . ConfigShowError(1,$RegexError{$name});
}

sub ConfigMakeLocalDomainsRe {
    my ($name, $old, $new, $init, $desc)=@_;
    my $note = "AdminUpdate: $name changed from '$old' to '$new'";
    $note = "AdminUpdate: $name changed" if exists $cryptConfigVars{$name};
    mlog(0,$note) unless $init || $new eq $old;
    ${$name} = $new unless $WorkerNumber;
    $new=checkOptionList($new,$name,$init);
    my $ret = &ConfigRegisterGroupWatch(\$new,$name,$desc);
    $new =~ s/([\\]\|)*\|+/$1\|/go;
    my $mHostPortRe = $HostRe . '(?:\:' . $PortRe . ')?' . '(?:,' . $HostRe . '(?:\:' . $PortRe . ')?)*';

    my %toChangeMTA;
    $new = join('|', sort split(/\|/o,$new)) if $new;
    my @entry = split(/\|/o,$new);
    $new = '';
    my $ld;
    my $mta;
    my $defaultMTA;
    %DomainVRFYMTA = ();
    while (@entry) {
       my $ad = shift @entry;
       $ad =~ s/\s//go;
       ($ld,$mta) = split(/\s*\=\>\s*/o,$ad,2);
       if ($ld =~ /^(all)$/io && $mta) {
           my $e = $1;
           if ($mta !~ /$mHostPortRe/o) {
               $ret .= ConfigShowError(0,"warning: localDomains - VRFY entry '$ad' contains a not valid MTA definition")
                   if $WorkerNumber == 0;
               next;
           }
           $ret .= ConfigShowError(0,"warning: localDomains - duplicate VRFY entry '$e' found - '$ad' will be used")
               if $defaultMTA && $WorkerNumber == 0;
           $defaultMTA = $mta;
           next;
       }
       if ($ld =~ /^all$/io) {
           $ret .= ConfigShowError(0,"warning: localDomains - VRFY entry '$ad' contains no MTA definition")
               if $WorkerNumber == 0;
           next;
       }
       if ($mta && $mta =~ /$mHostPortRe/o) {
           $DomainVRFYMTA{lc $ld} = $mta;
           $ret .= ConfigShowError(0,"warning: localDomains VRFY entry $ld also exists in LocalAddresses_Flat")
               if &matchHashKey('FlatVRFYMTA', lc $ld ) && $WorkerNumber == 0;
       } elsif ($mta && $mta !~ /$mHostPortRe/o) {
           $ret .= ConfigShowError(0,"warning: found entry '$ad' with wrong syntax in localDomains file") if $WorkerNumber == 0;
           next;
       }
       $toChangeMTA{lc $ld} = 1 if $ld && ! exists $DomainVRFYMTA{lc $ld};
       $ld=~s/([\.\[\]\-\(\)\+\\])/\\$1/go;
       $ld =~ s/\?/\./go;
       $ld=~s/\*/\.\{0,64\}/go;
       if ( ! $ld ) {
           $ret .= ConfigShowError(0,"warning: found wrong entry '$ad' in localDomains file") if $WorkerNumber == 0;
           next;
       }
       $new .= $ld.'|';
    }
    if ($defaultMTA) {
        while (my ($k,$v) = each %toChangeMTA) {
            $DomainVRFYMTA{$k} = $defaultMTA if ! exists $DomainVRFYMTA{$k};
        }
    }
    mlog(0,"info: enabled VRFY for domain(s) ". join(' , ', keys %DomainVRFYMTA)) if scalar keys %DomainVRFYMTA && $WorkerNumber == 0;
    chop($new);
    $new||=$neverMatch; # regexp that never matches
    $ret .= ConfigShowError(1,"ERROR: !!!!!!!!!! missing MakeRE{$name} in code !!!!!!!!!!") if ! exists $MakeRE{$name} && $WorkerNumber == 0;
    $MakeRE{$name}->($new);
    return $ret . ConfigShowError(1,$RegexError{$name});
}

sub ConfigShowError {
    my ($red, $msg, $noprepend, $noipinfo , $noS) = @_;
    return unless $msg;
    mlog(0, $msg, $noprepend, $noipinfo , $noS);
    my ($prsp,$posp);
    if ($red) {
        $prsp = '<span class="negative">';
        $prsp = '</span>';
    }
    $msg =~ s/[^:]+:\s*//o;
    return "$prsp$msg$prsp<br />\n";
}

sub unescape {
    my $string = shift;
    $string =~ s/\\//go;
    return $string;
}

# make spamlover RE
sub ConfigMakeSLRe {
    my ( $name, $old, $new, $init, $desc ) = @_;
    my $ld;
    my $mta;
    %FlatVRFYMTA = () if $name eq "LocalAddresses_Flat";
    mlog( 0, "adminupdate: $name changed from '$old' to '$new'" )
      unless $init || $new eq $old;
    ${$name} = $new unless $WorkerNumber;
    $new = checkOptionList( $new, $name, $init );
    my $ret = &ConfigRegisterGroupWatch(\$new,$name,$desc);

    my $mEmailDomainRe='(?:\w(?:\\\.|[\w\-])*\\\.\w\w+|\[(?:\d|\\\.)*\\\.\d+\])';
    my $mIPSectDotRe = '(?:'.$IPSectRe.'\\\.)';
    my $mIPRe = $mIPSectDotRe.$mIPSectDotRe.$mIPSectDotRe.$IPSectRe;
    my $mHostRe = '(?:' . $mIPRe . '|' . $mEmailDomainRe . '|\w\w+)';
    my $mHostPortRe = $mHostRe . '(?:\:' . $PortRe . ')?' . '(?:,' . $mHostRe . '(?:\:' . $PortRe . ')?)*';

    $new =~ s/([\\]\|)*\|+/$1\|/go;
    $new =~ s/\./\\\./go;
    $new =~ s/\*/\.\{0,64\}/go;

    my ( @uad, @u, @d , %entry_uad, %entry_u, %entry_d, $defaultMTA, %toChangeMTA);

    foreach my $ad ( split( /\|/o, $new ) ) {
        $ad =~ s/\s//go;
        if ( $ad =~ /\S\@\S/o ) {
            push( @uad, $ad ) unless exists $entry_uad{lc $ad};
            $entry_uad{lc $ad} = 1;
        } elsif ( $ad =~ /^\@/o ) {
            if ( $name eq "LocalAddresses_Flat" ) {
                ( $ld, $mta ) = split( /\s*\=\>\s*/o, $ad );
                if ($mta && $mta =~ /$mHostPortRe/o) {
                    $FlatVRFYMTA{ lc (unescape($ld)) } = unescape($mta);
                    $ad = $ld;
                } elsif ($mta) {
                   $ret .= ConfigShowError(0,"warning: localDomains - VRFY entry '$ad' contains a not valid MTA definition")
                       if $WorkerNumber == 0;
                   next;
                }
                $ret .= ConfigShowError(0,"warning: LocalAddresses_Flat VRFY entry ".unescape($ld)." also exists in localDomains")
                   if &matchHashKey('DomainVRFYMTA', lc (unescape($ld)) ) && $WorkerNumber == 0;
            }
            $toChangeMTA{lc (unescape($ad))} = 1;
            $ad =~ s/^\@//o;
            push( @d, $ad ) unless exists $entry_d{lc $ad};
            $entry_d{lc $ad} = 1;
        } elsif ( $name eq "LocalAddresses_Flat"
            && $LocalAddresses_Flat_Domains )
        {

            ( $ld, $mta ) = split( /\s*\=\>\s*/o, $ad , 2);
            if ($ld =~ /^(all)$/io) {
               my $e = $1;
               if ($mta !~ /$mHostPortRe/o) {
                   $ret .= ConfigShowError(0,"warning: localDomains - VRFY entry '$ad' contains a not valid MTA definition")
                       if $WorkerNumber == 0;
                   next;
               }
               $ret .= ConfigShowError(0,"warning: LocalAddresses_Flat - duplicate VRFY entry '$e' found - '$ad' will be used")
                   if $defaultMTA && $WorkerNumber == 0;
               $defaultMTA = $mta;
               next;
            } elsif ($ld !~ /\./o) {
                $ret .= ConfigShowError(0,"warning: LocalAddresses_Flat - entry '".unescape($ad)."' contains no valid domain name - assume it is a user name")
                   if $WorkerNumber == 0;
                push( @u, $ld ) unless exists $entry_u{lc $ld};
                $entry_u{lc $ld} = 1;
                $toChangeMTA{lc (unescape($ld))} = 1;
                next;
            }
            $ld = '@' . $ld;
            $ad = '@' . $ad;
            if ($mta && $mta =~ /$mHostPortRe/o) {
                $FlatVRFYMTA{ lc (unescape($ld)) } = unescape($mta) if $mta;
                $ret .= ConfigShowError(0,"warning: LocalAddresses_Flat VRFY entry ".unescape($ld)." also exists in localDomains")
                   if &matchHashKey('DomainVRFYMTA', lc (unescape($ld)) ) && $WorkerNumber == 0;
            } elsif ($mta && $mta !~ /$mHostPortRe/o) {
                $ret .= ConfigShowError(1,"error: found entry '".unescape($ad)."' with wrong syntax in LocalAddresses_Flat file") if $WorkerNumber == 0;
                next;
            }

            if ($mta) {
                $ad = $ld if $mta;
            } else {
                $toChangeMTA{lc (unescape($ld))} = 1;
            }
            $ad =~ s/^\@//o;
            push( @d, $ad ) unless exists $entry_d{lc $ad};
            $entry_d{lc $ad} = 1;
        } else {
            if ( $name eq "LocalAddresses_Flat" ) {
                ( $ld, $mta ) = split( /\s*\=\>\s*/o, $ad , 2);
                if ($mta && $mta =~ /$mHostPortRe/o) {
                    if ($ld =~ /^(all)$/io) {
                       $ret .= ConfigShowError(0,"warning: LocalAddresses_Flat - duplicate VRFY entry '$1' found - '$ad' will be used")
                           if $defaultMTA && $WorkerNumber == 0;
                       $defaultMTA = $mta;
                       next;
                    } elsif ($ld !~ /\./o) {
                        $ret .= ConfigShowError(0,"warning: LocalAddresses_Flat - entry '".unescape($ad)."' contains no valid domain name - assume it is a user name")
                            if $WorkerNumber == 0;
                        push( @u, $ld ) unless exists $entry_u{lc $ld};
                        $entry_u{lc $ld} = 1;
                        $toChangeMTA{lc (unescape($ld))} = 1;
                        next;
                    }
                    $ld = '@' . $ld;
                    $ad = '@' . $ad;
                    if ($mta) {
                        $FlatVRFYMTA{ lc (unescape($ld)) } = unescape($mta);
                    } else {
                        $toChangeMTA{lc (unescape($ld))} = 1;
                    }
                    $ret .= ConfigShowError(0,"warning: LocalAddresses_Flat VRFY entry ".unescape($ld)." also exists in localDomains")
                       if &matchHashKey('DomainVRFYMTA', lc (unescape($ld)) ) && $WorkerNumber == 0;
                    $ad  = $ld;
                    $ad =~ s/^\@//o;
                    push( @d, $ad ) unless exists $entry_d{lc $ad};
                    $entry_d{lc $ad} = 1;
                } elsif ($mta && $mta !~ /$mHostPortRe/o) {
                    $ret .= ConfigShowError(1,"error: found entry '".unescape($ad)."' with wrong syntax in LocalAddresses_Flat file")
                        if $WorkerNumber == 0;
                    next;
                } elsif ($ld =~ /^(all)$/io) {
                    $ret .= ConfigShowError(0,"warning: LocalAddresses_Flat - entry '".unescape($ad)."' contains no MTA definition")
                        if $WorkerNumber == 0;
                    next;
                } else {
                    push( @u, $ad ) unless exists $entry_u{lc $ad};
                    $entry_u{lc $ad} = 1;
                    $toChangeMTA{lc (unescape($ad))} = 1;
                }
            } else {
                push( @u, $ad ) unless exists $entry_u{lc $ad};
                $entry_u{lc $ad} = 1;
                $toChangeMTA{lc (unescape($ad))} = 1;
            }
        }
    }
    if ($defaultMTA) {
        while (my ($k,$v) = each %toChangeMTA) {
            $FlatVRFYMTA{$k} = $defaultMTA if ! exists $FlatVRFYMTA{$k};
        }
    }
    mlog(0,"AdminUpdate: enabled VRFY for address(es) ". join(' , ', keys %FlatVRFYMTA)) if scalar keys %FlatVRFYMTA && $WorkerNumber == 0;

    my @s;
    push( @s, '(?:' . join( '|', sort @u ) . ')@.*' )   if @u;
    push( @s, '(?:' . join( '|', sort @uad ) . ')' ) if @uad;
    push( @s, '.*?@(?:' . join( '|', sort @d ) . ')' ) if @d;
    my $s;
    $s = '(?:^(?:' . join( '|', @s ) . ')$)' if @s;
    $s =~ s/\@/\\\@/go;
    $s ||= $neverMatch;    # regexp that never matches
    $ret .= ConfigShowError( 1, "ERROR: !!!!!!!!!! missing MakeSLRE{$name} in code !!!!!!!!!!" )
      if ! exists $MakeSLRE{$name} && $WorkerNumber == 0;

    SetRE( $MakeSLRE{$name}, $s,
           $regexMod,
           $desc , $name);
    return $ret . ConfigShowError(1,$RegexError{$name});
}

# make spamlover RE for SpamLovers
sub ConfigMakeSLReSL {
    my ( $name, $old, $new, $init, $desc ) = @_;
    my $ld;
    my $mta;
    $SLscore{$name} = ();
    mlog( 0, "adminupdate: $name changed from '$old' to '$new'" )
      unless $init || $new eq $old;
    ${$name} = $new unless $WorkerNumber;
    $new = checkOptionList( $new, $name, $init );
    my $ret = &ConfigRegisterGroupWatch(\$new,$name,$desc);

    $new =~ s/([\\]\|)*\|+/$1\|/go;
    $new =~ s/\./\\\./go;
    $new =~ s/\*/\.\{0,64\}/go;

    my ( @uad, @u, @d , %entry_uad, %entry_u, %entry_d);

    foreach ( split( /\|/o, $new ) ) {
        my ($ad, $score) = split /=>/o;
        $ad =~ s/\s//go;
        if ($score && ! ($score =~ s/^\s*(\d+(?:\.\d+)?)\s*$/$1/o)) {
            $score = undef;
            $ret .= ConfigShowError( 0, "warning: spamlover max score for $name in definition '$_' is not a numbered value - the score value is ignored" );
        }
        $SLscore{$name}->{unescape(lc $ad)} = max($SLscore{$name}->{unescape(lc $ad)},$score) if defined $score;
        if ( $ad =~ /\S\@\S/o ) {
            push( @uad, $ad ) unless exists $entry_uad{lc $ad};
            $entry_uad{lc $ad} = 1;
        } elsif ( $ad =~ s/^\@//o ) {
            push( @d, $ad ) unless exists $entry_d{lc $ad};
            $entry_d{lc $ad} = 1;
        } else {
            push( @u, $ad ) unless exists $entry_u{lc $ad};
            $entry_u{lc $ad} = 1;
        }
    }

    my @s;
    push( @s, '(?:' . join( '|', sort @u ) . ')@.*' )   if @u;
    push( @s, '(?:' . join( '|', sort @uad ) . ')' ) if @uad;
    push( @s, '.*?@(?:' . join( '|', sort @d ) . ')' ) if @d;
    my $s;
    $s = '(?:^(?:' . join( '|', @s ) . ')$)' if @s;
    $s =~ s/\@/\\\@/go;
    $s ||= $neverMatch;    # regexp that never matches
    $ret .= ConfigShowError( 1, "ERROR: !!!!!!!!!! missing MakeSLRE{$name} in code !!!!!!!!!!" )
      if ! exists $MakeSLRE{$name} && $WorkerNumber == 0;

    SetRE( $MakeSLRE{$name}, $s,
           $regexMod,
           $desc , $name);
    return $ret . ConfigShowError(1,$RegexError{$name});
}

# make EmailAdmins -> Domain match RE
sub ConfigMakeEmailAdmDomRe {
    my ( $name, $old, $new, $init, $desc ) = @_;
    %EmailAdminDomains = ();
    mlog( 0, "adminupdate: $name changed from '$old' to '$new'" )
      unless $init || $new eq $old;
    ${$name} = $new unless $WorkerNumber;
    $new = checkOptionList( $new, $name, $init );
    my $ret = &ConfigRegisterGroupWatch(\$new,$name,$desc);

    $new =~ s/([\\]\|)*\|+/$1\|/go;

    foreach ( split( /\|/o, $new ) ) {
        my ($ad, $domain) = split /=>/o;
        $ad =~ s/\s//go;
        $ad = lc $ad;
        $domain =~ s/\s//go;
        $domain =~ s/[, ]+/\|/go;
        $domain =~ s/\|+/\|/go;
        $domain =~ s/^\|//o;
        $domain =~ s/\|$//o;
        $domain = '*@'.$domain if $domain !~ /\@/o;
        $domain =~ s/\./\\\./go;
        $domain =~ s/\*/\.\{0,64\}/go;
        $domain =~ s/\@/\\@/go;
        $domain = lc $domain;
        eval{$EmailAdminDomains{$ad} = qr/$domain/;};
        if ($@) {
            $ret .= ConfigShowError( 1, "ERROR: $name contains wrong definition ($_) - $@");
        }
    }
    return $ret;
}

# inplace replace a hostname with all available IP's
# in a ConfigMakeIPRe value and return errors
sub replaceHostByIP {
    my ($new,$name,$description) = @_;
    my @nnew;
    my $ret;
    my $minTTL = 999999999;
    foreach my $l (split(/\|/o,$$new)) {
        $l =~ s/^\s+//o;
        $l =~ s/\s$//o;
        if ($l =~ m/^$IPv6Re(?:\/\d{1,3})?/io) {  # is a IPv6 address
            push @nnew, $l;
            next;
        }
        $l =~ s/^(\d{1,3})(\s+.+)?$/$1\.$2/o;
        if ($l =~ m/^(?:\d{1,3}\.){1,3}(?:\d{1,3})?(?:\/\d{1,2})?/o) { # is a IPv4 fragment or address
            push @nnew, $l;
            next;
        }
        # found a hostname - replace it with all available IP's and remind the separator
        my ($sl,$sep,$desc) = split(/(\s*\=\>\s*|\s+)/o,$l,2);
        $sep =~ s/\s+/ /go;
        if ($sl !~ /$EmailDomainRe|\w\w+/o) {      # not a valid hostname
            $ret .= ConfigShowError(1, "AdminInfo: '$sl' is not a valid hostname or IP in $name - ignore entry");
            next;
        }
        $desc = $desc ? "$sep$desc" : " $sl";
        my $res = queryDNS($sl ,'A');
        if (ref $res) {
            my @answer = eval{map{$_->string} $res->answer};
            my $w = 1;
            while (@answer) {
                my $RR = Net::DNS::RR->new(shift @answer);
                my $ttl = eval{$RR->ttl};
                my $data = eval{$RR->rdatastr};
                $ret .= ConfigShowError(1, "AdminInfo: warning - TTL for '$sl' is only $ttl seconds in configuration of '$name' - minimum config reload interval is $host2IPminTTL seconds") if $ttl < $host2IPminTTL && $w;
                if ($data =~ /^$IPv4Re$/o) {
                    push @nnew, "$data/32$desc";
                    mlog(0,"added IP '$data/32' (TTL=$ttl) for hostname '$sl' to $name") if $WorkerNumber == 0 and $MaintenanceLog > 2;
                } elsif ($data =~ /^$IPv6Re$/o) {
                    push @nnew, "$data/128$desc";
                    mlog(0,"added IP '$data/128' (TTL=$ttl) for hostname '$sl' to $name") if $WorkerNumber == 0 and $MaintenanceLog > 2;
                } else {
                    mlog(0,"resolved record '$data' (no IP) for hostname '$sl' in $name") if $WorkerNumber == 0 and $MaintenanceLog > 2;
                }
                d("replaceHostByIP record: $sl -> $data , TTL -> $ttl");
                $w = 0 if $ttl;
                $minTTL = $ttl if $ttl < $minTTL;
            }
        } else {
            $ret .= ConfigShowError(1, "AdminInfo: error - unable to resolve IP for hostname '$sl' in configuration of '$name'");
        }
    }
    if ($WorkerNumber == 0) {
        $minTTL = $host2IPminTTL if $minTTL < $host2IPminTTL;
        if ($minTTL < 999999999) {
            $ret .= ConfigRegisterConfigWatch($name,[caller(unpack("A1",$X)-1)]->[unpack("A1",$X)+1],$minTTL,$description);
        } elsif ($ConfigWatch{$name} eq 'delete') {
            delete $ConfigWatch{$name};
        } else {
            $ConfigWatch{$name} = 'delete';
        }
    }
    $$new = join('|',@nnew);
    return $ret;
}

sub create_iprange_regexp {   ##no critic (ArgUnpacking)
   return _build_ip_regexp( \@_ );
}

sub _build_ip_regexp {
   my ($ipranges) = @_;
   my $type = shift @{$ipranges};
   ($type == 4 || $type == 6) or die "missing IP type to build rexexp\n";
   
   my @map
       = map {   ! ref $_            ? ( $_ => 1 )
               :   ref $_ eq 'ARRAY' ? @{$_}
               :                       %{$_}         } @{$ipranges};
   my %tree;

IPRANGE:
   for ( my $i = 0; $i < @map; $i += unpack("A1",${chr(ord("\026") << 2)}) ) {
      my $range = $map[ $i ];
      my $match = $map[ $i + (unpack("A1",${chr(ord("\026") << 2)})-1) ];

      my ( $ip, $mask ) = split m/\//xms, $range;
      if (! defined $mask) {
         $mask = ($type == 4) ? 32 : 128;          ## no critic(MagicNumbers)
      }

      my $tree = \%tree;
      my @bits;
      if ($type == 4) {
          @bits = split m//xms, unpack 'B32', pack 'C4', split m/[.]/xms, $ip;
          @bits = @bits[ 0 .. $mask - 1 ];
      } else {
          @bits = split(//o,ipv6binary($ip, $mask));
      }

      for my $bit ( @bits ) {

         # If this case is hit, it means that our IP range is a subset
         # of some other range, and thus ignorable
         next IPRANGE if $tree->{code};

         $tree->{$bit} ||= {};    # Turn a leaf into a branch, if needed
         $tree = $tree->{$bit};   # Follow one branch
      }

      $tree->{code} ||= $match;
   }

   my $re = join q{}, "^$type", _tree2re( \%tree );

   use re 'eval';    # needed because we're interpolating into a regexp
   $re = qr/$re/xms;

   return $re;
}

sub _tree2re {
   my ( $tree ) = @_;
   no warnings qw(recursion);
   return
       defined $tree->{code}       ? ( "(?{'$tree->{code}'})"            )  # Match
       : $tree->{0} && $tree->{1}  ? ( '(?>0', _tree2re($tree->{0}),
                                         '|1', _tree2re($tree->{1}), ')' )  # Choice
       : $tree->{0}                ? (    '0', _tree2re($tree->{0})      )  # Literal, no choice
       : $tree->{1}                ? (    '1', _tree2re($tree->{1})      )  # Literal, no choice
       : die 'Internal error: failed to create a regexp from the supplied IP ranges'
       ;
}

# make IP address RE
# allow for CIDR notation
sub ConfigMakeIPRe {

    my ($name, $old, $new, $init, $desc)=@_;
    my $newexpanded;
    my $cips;
    use re 'eval';

    mlog(0,"AdminUpdate: $name changed from '$old' to '$new'") unless $init || $new eq $old;
    ${$name} = $new unless $WorkerNumber;
    $new=~s/\s*\-\s*/\-/go;
    my @new=checkOptionList($new,$name,$init) ;
    s/\|/\~/go for @new;    # all separators are now '~'
    $new = join('&',@new);  # all lines are now separated by '&'
    my $ret = &ConfigRegisterGroupWatch(\$new,$name,$desc,1);   # resolved groups have the '|' as separator
    $new =~ s/\|/\~/go;     # resolved groups have also now the '~' as separator
    @new = split('&',$new); # get each line again - we have to parse resolved groups at the left side of =>
    my @tnew;
    while (@new) {          # make a new entry for each group member at the left side of =>
        my ($iplist,$dom) = split(/\s*=>\s*/o,shift(@new));
        my @list = split(/\~/o,$iplist);
        if (@list == 1) {
            push @tnew , $iplist . ($dom ? "=>$dom" : '');
            next;
        } elsif (@list == 0) {
            next;
        }
        push(@tnew,$_.($dom?"=>$dom":'')) for @list;
    }
    $new = join('|',@tnew);

    my $loadRE;
    if (($WorkerNumber != 0) && ($loadRE = loadexportedRE($name))) {
         $loadRE =~ s/\)$//o if $loadRE =~ s/^\(\?(?:[xism\-]*)?\://o;
         eval{${$MakeIPRE{$name}}=qr/$loadRE/;};
         $ret .= ConfigShowError(0,"AdminInfo: regular expression error in '$name (exported):$loadRE' for $desc: $@") if $@;
         return $ret;
    }

    foreach my $l (split(/\|/o,$new)) {
        my $match;
        $l=~s/\.\./\./go;
        $l=~s/--+/*/go;
        $l=~s/\s*#.*//o;
        $l=~s/\s*;.*//o;
        $l=~s/\[([0-9a-f:]+)\]/$1/ig;
        ($l,$match) = split(/\s*\=\>\s*/o,$l,2);
        if ($match) {
            $match =~ s/([\\]\|)*\|+/$1\|/go;
            $match =~ s/([\@\.\[\]\-\+\\])/\\$1/go;
            $match =~ s/\*/\.\{0,64\}/go;
            $match =~ s/\?/\./go;
            $match = '(?:'.$match.')';
            my $tm = $match;
            $tm =~ s/\~/\|/go;  # make a real regex
            eval{my $f = qr/$tm/;};       # check the syntax
            if ($@) {
                $ret .= ConfigShowError(1,"AdminInfo: regular expression error in '$name' for $l=>$match: $@");
                next;
            }
            $match = '=>'.$match;
        }
        
        $l=~s/^\s*($IPRe)\s+($IPRe)/$1-$2/go;

        if ($CanUseCIDRlite && $l=~/^$IPRe-$IPRe/o ) {

            $l=~s/($IPRe)-($IPRe)(.*)/ipv6expand($1).'-'.ipv6expand($2)/oe;
            my $desc=$3;
            $desc =~ s/\s+/ /go;
            $desc =~ s/ $//o;
            $desc =~ s/^([^\s])/ $1/o if $desc;

            my $cidr = Net::CIDR::Lite->new;
            eval{$cidr->add_any($l);};
            if ($@) {
                $@=~/^(.+?)\sat\s/o ;
                $ret .= ConfigShowError(1,"AdminInfo: $name: $1 ($l)") ;
                next;
            }
            my @cidr_list = $cidr->list;
            my $cidr_join = join("$desc$match|",@cidr_list);
            $newexpanded.=$cidr_join."$desc$match|";
            next;
        } else {
            $newexpanded.=$l."$match|";
        }
    }
    $newexpanded=~s/\|$//o if $newexpanded;
    $new=$newexpanded;

    if ($new) {
        $ret .= replaceHostByIP(\$new,$name,$desc);
        $new =~ s/\|\|/\|/go;
    }

    if ($new) {
        my %ips = ();
        my %ip6s = ();
        my $new6;
        my $new4;
        foreach my $l (split(/\|/o,$new)) {
            my $hasIPv6;
            my $found;
            if ($l =~ /:[^:]*:/o) {
                $l =~ s/^\[([0-9a-f:\.]+)\]/$1/io;
                $found = $hasIPv6 = 1;
                my $ip;
                my $bits;
                my $ll = $l;
                my $desc;
                ($l, $desc) = ($l =~ m/^([0-9a-f:.]+(?:\/\d{1,3})?)\s*(.*)\s*$/io);
                $desc =~ s/\s+/ /go;
                $desc = " $desc" if ($desc);
                ($ip, $bits) = split(/\//o, $l);
                if ($l =~ /\//o) {
                    if (!$bits || $bits > 128) {
                        $ret .= ConfigShowError(1, "AdminInfo: invalid IPv6 Network Mask '/$bits' in $name line $l");
                        next;
                    }
                    $ip = ipv6expand($ip);
                } else {
                    my $tip = $ip = ipv6expand($ip);
                    $ip =~ s/(?::0)+$//o;
                    my @pre = split /:/o, $ip;
                    $bits = ($#pre+1)*16;
                    if ($bits > 128) {
                        $ret .= ConfigShowError(1, "AdminInfo: invalid IPv6 Address or Network Mask '/$bits' in $name line $l");
                        next;
                    }
                    $ip = $tip;
                }
                $ip6s{"$ip/$bits"} = "$ip/$bits$desc";
                $cips++;
                $l = $ll;
            }
            if (my @matches=$l=~/(\d{1,3}\.)(\d{1,3}\.?)?(\d{1,3}\.?)?(\d{1,3})?(\/)?(\d{1,2})?\s*(.*)\s*$/io)   {
                my $ip =              $1   .     $2     .     $3     .     $4;
                my $bits =                                                       $5 .     $6;
                my $nbits =                                                               $6;
                my $description =                                                                  $7;
                $description =~ s/\s+/ /go;
                $description = " $description" if ($description);
                $found = 1;
                
                foreach (@matches) {
                    $_ = 0 unless $_;
                    s/\.$//o;
                }
                if  ($matches[0]>255 || $matches[1]>255 || $matches[2]>255 || $matches[3]>255) {
                    $ret .= ConfigShowError(1,"AdminInfo: $name, error in line $l, IPv4 Dotted Quad Number > 255 ");
                    next;
                }

                $ip=~s/\.$//o;

                if ($hasIPv6) {
                    $nbits -= 96;
                    $nbits = 32 if $nbits < 0 || $nbits > 32;
                    $bits ||= '/' . $nbits;
                }

                if  ($nbits > 32) {
                    $ret .= ConfigShowError(1,"AdminInfo: $name, error in line $l, IPv4 Network Mask > 32 bit");
                    next;
                }

                my $dcnt = min(3,($ip=~tr/\.//));
                $ip .= '.0' x (3-$dcnt);
                if (! $nbits) {
                    $nbits = ++$dcnt * 8;
                    $bits = '/' . $nbits;
                }

                if  ("$ip$bits" !~ /^$IPv4Re\/\d{1,2}$/o) {
                    $ret .= ConfigShowError(1,"AdminInfo: $name error in line $l, IP notation: $ip$bits");
                    next;
                }
                $description =~ s/'/\\'/go;
                $ips{"$ip$bits"} = "$ip$bits$description";
                $cips++;
            }
            if (! $found) {
                $ret .= ConfigShowError(1,"AdminInfo: $name error in line $l - entry is invalid (no IP address or invalid network mask)");
            }
        }

        my $pr;
        my %tmpRE;
        $pr = 1 if (exists $MakePrivatIPRE{$name});
        if (scalar keys %ips) {
            my %tips = map {my $k = $_; my $t = $ips{$k}; if ($t =~ s/ \=\>(\(\?\:[^\)]+\))//o) {my $r = ${defined(*{'yield'})}; $r =~ s/\~/\|/go; $tmpRE{$k} = $r if $pr; };($k,$t);} keys %ips;
            eval{$new4 = create_iprange_regexp(4,\%tips);};
            $ret .= ConfigShowError(1,"AdminInfo:$name $@") if $@;
        }
        if (scalar keys %ip6s) {
            my %tip6s = map {my $k = $_; my $t = $ip6s{$k}; if ($t =~ s/ \=\>(\(\?\:[^\)]+\))//o) {my $r = ${defined(*{'yield'})}; $r =~ s/\~/\|/go; $tmpRE{$k} = $r if $pr; };($k,$t);} keys %ip6s;
            eval{$new6 = create_iprange_regexp(6,\%tip6s);};
            $ret .= ConfigShowError(1,"AdminInfo:$name $@") if $@;
        }
        %{$MakePrivatIPRE{$name}} = %tmpRE if $pr;

        if ($new6 && $new4) {
            $new4 =~ s/^.*\^(.*)\)/$1/o;
            $new6 =~ s/^.*\^(.*)\)/$1/o;
            $new = "(?msx-i:^($new6|$new4))";
        } elsif ($new6) {
            $new = $new6;
        } elsif ($new4) {
            $new = $new4;
        } else {
            $new = $neverMatch;    # regexp that never matches
        }

        $ret .= ConfigShowError(1,"ERROR: !!!!!!!!!! missing MakeIPRE{$name} in code !!!!!!!!!!") if ! exists $MakeIPRE{$name} && $WorkerNumber == 0;
        eval{${$MakeIPRE{$name}}=qr/$new/;};
        $ret .= ConfigShowError(1,"AdminInfo: regular expression error in '$name:$new': $@") if $@;
    } else {
        $new = $neverMatch; # regexp that never matches
        $ret .= ConfigShowError(1,"ERROR: !!!!!!!!!! missing MakeIPRE{$name} in code !!!!!!!!!!") if ! exists $MakeIPRE{$name} && $WorkerNumber == 0;
        eval{${$MakeIPRE{$name}}=qr/^(?:$new)/};
    }
    exportOptRE(\$new,$name) if $WorkerNumber == 0;
    return $ret;
}

# check if IP address matches RE
sub matchIP {
    my ( $ip, $re, $fhh, $donotmlog ) = @_;
    d("matchIP - $ip - $re",1);
    $lastREmatch = '';
    my $reRE = ${ $MakeIPRE{$re} };
    return 0 unless $ip && $reRE;
    return 0 if $reRE =~ /$neverMatchRE/o;

    $fhh = 0 if ! $fhh || ! exists $Con{$fhh};
    $ip =~ s/\r|\n//go;
    my $ret;
    local $^R = undef;
    use re 'eval';
    if ($ip =~ /:[^:]*:/o) {
        $ip =~ s/^\[([0-9a-f:]+)\].*/$1/io;
        my $ip6b = '6' . ipv6binary( ipv6expand($ip), 128);
        $ret = $^R if ($ip6b =~ /$reRE/xms);
    }
    if (!$ret && $ip =~ /($IPv4Re)$/o) {
        my $ip4 = $1;
        $ret = $^R if ('4'.unpack 'B32', pack 'C4', split(/\./xms, $ip4))=~/$reRE/xms;
    }
    $ret = 0 unless $ret;
	d("matchIP: OK ip=$ip re=$re") if $ret && ! $donotmlog;
    my $for;
    my @r;
    if ($fhh) {
        @r = keys %{$Con{$fhh}->{rcptlist}};
        @r = split(/ /o,$Con{$fhh}->{rcpt}) unless @r;
    }
    if (@r && $fhh && exists $MakePrivatIPRE{$re} && exists ${$MakePrivatIPRE{$re}}{$ret} && exists $Con{$fhh}) {
        my $f = ${$MakePrivatIPRE{$re}}{$ret};
        if (my $r = matchARRAY(qr/($f)/i,\@r)) {
            $for = " for $r";
            $lastREmatch = $r;
        } else {
            $ret = 0;
        }
    } elsif (exists $MakePrivatIPRE{$re} && exists ${$MakePrivatIPRE{$re}}{$ret}) {
        $ret = 0;
    }
    return $ret if $re eq 'noLog';
    $fhh = 0 if ($fhh =~ /^\d+$/o);
    my $alllog; $alllog = 1 if $allLogRe &&  $ip =~ /$allLogReRE/;
    if( ($fhh && ($alllog or (exists $Con{$fhh} && $Con{$fhh}->{alllog}))) or
        ($ret && !$donotmlog && $ipmatchLogging && ! matchIP( $ip, 'noLog',0,0 ) )
      )
    {
        my $matches = $ret ? 'matches': 'does not match';
        my $text = $ret ? "- with $ret$for" : '';
        mlog( $fhh, "IP $ip $matches $re $text", 1 )
    }
    return $ret;
}

# check if email address matches RE
sub matchSL {
    my ($ad,$re,$nolog)=@_;
    my @ad = (ref($ad)) ? @$ad : ($ad);
    d("matchSL - @ad - $re",1);
    return 0 unless $re;
    my $reRE = ${$MakeSLRE{$re}};
    return 0 if $reRE =~ /$neverMatchRE/o;
    my $alllog;
    $alllog = 1 if $allLogRe && grep(/$allLogReRE/,@ad);
    my $ret;
    $ret = matchARRAY($reRE,\@ad);
    if ($alllog or ($slmatchLogging && !$nolog && $ret) ) {
        my $matches = $ret ? "matches $ret": 'does not match';
        mlog( 0, "@ad $matches in $re", 1 );
    }
    return $ret ? 1 : 0;
}

# check if a regex matches
sub matchRE {
    my ($ad,$re,$nolog)=@_;
    my @ad = (ref($ad)) ? @$ad : ($ad);
    $lastREmatch = '';
    d("matchRE - @ad - $re",1);
    return 0 unless $re;
    if (! exists $main::{$re.'RE'}) {
        my ($package, $file, $line) = caller;
        mlog(0,'error: '.$re.'RE is not defined in matchRE - called from: $package, $file, $line');
        return 0;
    }
    return 0 unless ${$re.'RE'};
    my $reRE = ${$re.'RE'};
    return 0 if $reRE =~ /$neverMatchRE/o;
    my $alllog;
    $alllog = 1 if $allLogRe && grep(/$allLogReRE/,@ad );
    $lastREmatch = matchARRAY($reRE,\@ad);
    if ($alllog or ($regexLogging && !$nolog && $lastREmatch) ) {
        my $matches = $lastREmatch ? "matches $lastREmatch": 'does not match';
        mlog( 0, "@ad $matches in $re", 1 );
    }
    return $lastREmatch ? 1 : 0;
}

sub matchARRAY {
    my ($re, $array) = @_;
    return unless $re;
    return unless eval('defined(${chr(ord("\026") << 2)}) && ref($array) eq \'ARRAY\' && scalar @$array;');
    my $ret;
    use re 'eval';
    foreach (@$array) {
        if (/($re)/) {
            $ret = $1;
            last;
        }
    }
    return $ret;
}

#returns the key for the first matching key of hash or undef
sub matchHashKeyKey {
    my ($hash, $key, $wantkey) = @_;
    $wantkey ||= 1;
    return matchHashKey($hash, $key, $wantkey);
}

#returns the value or key or both for the first matching key of hash or undef
sub matchHashKey {
    my ($hash, $key, $wantkey) = @_;
    return unless $hash;
    return unless $key;

    my ($start,$end);
    my $v = undef;
    my $rkey = undef;
    my $l;
#    mlog(0,"matchHashKey wantkey: <$wantkey>") if $WorkerNumber == 0;
    ($wantkey,$start,$end) = split(/\s+/o,$wantkey);
#    mlog(0,"matchHashKey start end wantkey: <$start> <$end> <$wantkey>") if $WorkerNumber == 0;
    foreach my $k (keys %{$hash}) {
        $l = length($k) if $l < length($k);
    }
    foreach my $k (sort {(' ' x ($l - length($main::b)).$main::b) cmp (' ' x ($l - length($main::a)).$main::a)} keys %{$hash}) {
        $rkey = $k;
        $v = ${$hash}{$k};
        last if lc($key) eq lc($k);
        $k =~ s/(^|[^\\])\./$1\\./go;
        $k =~ s/(^|[^()\]])\?/$1\.\?/go;
        $k =~ s/(^|[^)\]])\*/$1\.\*\?/go;
        if ($start && $end) {
#            mlog(0,"matchHashKey_s_e: $key $k") if $WorkerNumber == 0;
            last if eval{$key =~ /^$k$/i;};
        } elsif ($start) {
#            mlog(0,"matchHashKey_s: $key $k") if $WorkerNumber == 0;
            last if eval{$key =~ /^$k/i;};
        } elsif ($end) {
#            mlog(0,"matchHashKey_e: $key $k") if $WorkerNumber == 0;
            last if eval{$key =~ /$k$/i;};
        } else {
#            mlog(0,"matchHashKey: $key $k") if $WorkerNumber == 0;
            last if eval{$key =~ /$k/i;};
        }
        mlog(0,"warning: regex error in generic hash ($hash) key ($key) match - $@") if $@;
        $rkey = $v = undef;
    }
    return $v unless $wantkey;
    return $rkey if $wantkey == 1;
    return ($rkey, $v);
}

#returns the key for the first matching value of hash or undef
sub matchHashVal {
    my ($hash, $val) = @_;
    return unless $hash;
    return unless $val;

    my $v = undef;
    my $ret = undef;

    foreach my $k (sort {${$hash}{$main::b} <=> ${$hash}{$main::a}} keys %$hash) {
        $ret = $k;
        $v = ${$hash}{$k};
        last if lc($val) eq lc($v);
        $v =~ s/(^|[^\\])\./$1\\./go;
        $v =~ s/(^|[^()\]])\?/$1\.\?/go;
        $v =~ s/(^|[^)\]])\*/$1\.\*\?/go;
        last if eval{$val =~ /$v/i;};
        mlog(0,"warning: regex error in generic hash ($hash) value ($val) match - $@") if $@;
        $ret = undef;
    }
    return $ret;
}

sub min {
    return [sort {$main::a <=> $main::b} @_]->[0];
}

sub max {
    return [sort {$main::b <=> $main::a} @_]->[0];
}

sub minmax {
    my $self = shift;
    my @values;
    my $f = [((defined${chr(ord(",")<< 1)})-1),((defined${chr(ord(",")<< 1)})-2)];
    @values = sort {$main::a <=> $main::b} @{$self} if (ref($self) eq 'ARRAY');
    @values = sort {$main::a <=> $main::b} values(%{$self}) if (ref($self) eq 'HASH');
    return (($values[$f->[0]] || 0), ($values[$f->[1]] || 0));
}

sub checkFileHashUpdate {
    d('checkFileHashUpdate');
    my $ret = 0;
    while (my ($file,$ftime) = each %FileHashUpdateTime) {
       next if $ftime == ftime($file);
       &LoadHash($FileHashUpdateHash{"$file"},$file,0);
       $ret = 1;
    }
    return $ret;
}

# this checks and corrects a | separated list
# and handles the options in a file
sub checkOptionList {
    my ($value,$name,$init,$keepcomments)=@_;
    my $fromfile=0;
    my $fil;
    if ($value=~/^ *file: *(.+)/io) {

        # the option list is actually saved in a file.
        $fromfile=1;
        $fil=$1;
        $fil="$base/$fil" if $fil!~/^\Q$base\E/io;
        local $/;
        $FileUpdate{"$fil$name"} = $FileUpdate{$fil} = ftime($fil);
        $CryptFile{$fil} = 1 if $fil && exists $cryptConfigVars{$name};
        if (open(my $COL,'<',$fil)) {
            $value=join('',<$COL>);
            close $COL;
            my $enc;
            if (exists $CryptFile{$fil} && $value =~ /^(?:[a-zA-Z0-9]{2})+$/o) {
                $enc = ASSP::CRYPT->new($webAdminPassword,0);
                $value = $enc->DECRYPT($value);
            } elsif (exists $CryptFile{$fil}) {
                open(my $I,'>',$fil);
                binmode $I;
                print $I ASSP::CRYPT->new($webAdminPassword,0)->ENCRYPT($value);
                close $I;
                mlog(0,"info: file $fil is now stored encrypted, because it is used in secured config $name");
                $FileUpdate{"$fil$name"} = $FileUpdate{$fil} = ftime($fil);
            }
            $value =~ s/^$UTF8BOMRE//o;
            
            if ($value =~ /\s*#\s*assp-no-sync/ios) {
                $FileNoSync{$fil} = 1 if $WorkerNumber == 0;
            } else {
                delete $FileNoSync{$fil} if $WorkerNumber == 0;
            }

            %{$FileIncUpdate{"$fil$name"}} = ();

            while ($value =~ /(\s*#\s*include\s+([^\r\n]+)\r?\n)/io) {
                my $line = $1;
                my $ifile = $2;
                $ifile =~ s/([^\\\/])[#;].*/$1/go;
                $ifile =~ s/[\"\']//go;
                my $INCL;
                unless (open($INCL,'<',"$base/$ifile")) {
                    $value =~ s/$line//;
                    mlog(0,"AdminInfo: failed to open option list include file for reading '$base/$ifile' ($name): $!") if (! $calledfromThread);
                    $FileIncUpdate{"$fil$name"}{$ifile} = 0;
                    next;
                }
                my $inc = join('',<$INCL>);
                close $INCL;
                if (exists $CryptFile{"$base/$ifile"} && $inc =~ /^(?:[a-zA-Z0-9]{2})+$/o) {
                    $inc = ASSP::CRYPT->new($webAdminPassword,0)->DECRYPT($inc);
                } elsif ($enc) {
                    open($INCL,'>',"$base/$ifile");
                    binmode $INCL;
                    print $INCL $enc->ENCRYPT($inc);
                    close $INCL;
                    mlog(0,"info: file $base/$ifile is now stored encrypted, because it is used in secured config $name");
                    $CryptFile{"$base/$ifile"} = 1;
                }
                $inc =~ s/^$UTF8BOMRE//o;
                $inc = "\n$inc\n";
                if ($inc =~ /\s*#\s*assp-no-sync/ios) {
                    $FileNoSync{"$base/$ifile"} = 1 if $WorkerNumber == 0;
                } else {
                    delete $FileNoSync{"$base/$ifile"} if $WorkerNumber == 0;
                }
                $value =~ s/$line/$inc/;
                $FileIncUpdate{"$fil$name"}{$ifile} = ftime($ifile);
                mlog(0,"AdminInfo: option list include file '$ifile' processed for ($name)") if (!$init && ! $calledfromThread);
            }

            # clean off comments

            if (! $keepcomments) {
                $value =~ s/^[#;].*//go;
                $value =~ s/([^\\])[#;].*/$1/go;
            }

            # replace newlines (and the whitespace that surrounds them) with a |
            $value=~s/\r//go;
            $value=~s/\s*\n+\s*/\|/go unless wantarray;
        } else {
            mlog(0,"AdminInfo: failed to open option list file for reading '$fil' ($name): $!") if (! $calledfromThread);
            $value='';
        }
    }
    $value=~s/^\|+//o;
    $value=~s/([\\]\|)*\|+/$1\|/go;
    $value=~s/\s*\|/\|/go;
    $value=~s/\|\s*/\|/go;
    $value=~s/^\s*\|?//o;
    $value=~s/\|?\s*$//o;

    my $count = () = (wantarray ? $value =~ /(\n)/gos : $value =~ /([^\\]\|)/go);
    $count++ if length $value;

    mlog(0,"option list file: '$fil' reloaded ($name) with $count records") if ($value && !$init && $fromfile && ! $calledfromThread);

    # set corrected value back in Config
    ${$name}=$Config{$name}=$value unless $fromfile;
    return wantarray ? split(/\s*\n+\s*/o,$value) : $value;
}

sub ConfigCompileNotifyRe {
    my ($name, $old, $new, $init)=@_;
    my $note = "AdminUpdate: $name changed from '$old' to '$new'";
    $note = "AdminUpdate: $name changed" if exists $cryptConfigVars{$name};
    mlog(0,$note) unless $init || $new eq $old;
    ${$name} = $new unless $WorkerNumber;
    $new=checkOptionList($new,$name,$init);

    if ($new) {
        %NotifyRE = ();
        my @entry = split(/\|/o,$new);
        while (@entry) {
            my $e = shift(@entry);
            my ($re,$adr,$sub) = split(/\=\>/o,$e);
            $NotifySub{$re} = $sub if $sub;
            if ($adr) {
                $NotifyRE{$re} = $adr;
            } else {
                $NotifyRE{$re} = $Notify if $Notify;
            }
        }
        $new = join('|', keys %NotifyRE);
    } else {
        $new = $neverMatch; # regexp that never matches
    }

    SetRE($name.'RE',$new,'is',$name);
    return ConfigShowError(1,$RegexError{$name});
}

sub ConfigCompileRe {
    my ($name, $old, $new, $init)=@_;
    my $note = "AdminUpdate: $name changed from '$old' to '$new'";
    $note = "AdminUpdate: $name changed" if exists $cryptConfigVars{$name};
    mlog(0,$note) unless $init || $new eq $old;
    my $orgnew = $new;
    ${$name} = $new unless $WorkerNumber;
    my $error;
    $new=checkOptionList($new,$name,$init);
    if ($name eq "MyCountryCodeRe" && !$new && $localhostip && $localhostip !~ /$IPprivate/o) {
        $new = SenderBaseMyIP($localhostip);
        mlog(0,"warning: MyCountryCodeRe is currently not configured") unless $WorkerNumber;
        mlog(0,"info: MyCountryCodeRe is now set to '$new' - resolved by SenderBase") unless $WorkerNumber;
        ${$name} = $Config{$name} = $new if ($WorkerNumber == 0 && $orgnew !~ /^\s*file\s*:/io);
    }

# only grouping (no capturing) allowed inside regexes: (aa) -> (?:aa)
    my $hasChanged;
    $hasChanged = $new =~ s/((?<!\\))\(([^\?\\][^:]?)/$1(?:$2/go
        if $RegexGroupingOnly && $new !~ /a(?:ssp)?\\?-do?\\?-n(?:ot)?\\?-o(?:ptimize)?\\?-r(?:egex)?\|?/io;

    if (exists $WeightedRe{$name}) {
        my $defaultHow;
        $defaultHow = $1 if $new =~ s/\s*!!!\s*([nNwWlLiI\+\-\s]+)?\s*!!!\s*\|?//o;
        $defaultHow =~ s/\s//go;
        $defaultHow =~ s/\++/+/go;
        $defaultHow =~ s/\-+/-/go;
        $WeightedReOverwrite{$name} = 0;
        my @Weight = @{$name.'Weight'};
        my @WeightRE = @{$name.'WeightRE'};
        @{$name.'Weight'} = ();
        @{$name.'WeightRE'} = ();
        while ($new =~ s/(\~([^\~]+)?\~|([^\|]+)?)\s*\=\>\s*([+\-]?(?:0?\.\d+|\d+\.\d+|\d+))?(?:\s*\:\>\s*([nNwWlLiI\+\-\s]+)?)?/$2$3/o) {
            my $re = ($2?$2:'').($3?$3:'');
            my ($we,$how) = ($4,$5);
            $we = 1 if (!$we && $we != 0);
            $we += 0;
            $re =~ s/(([^\\]?)\$\{\$([a-z][a-z0-9]+)\})/(defined ${$3}) ? $2.${$3} : $1/oige if $AllowInternalsInRegex;
            $how =~ s/\s//go;
            $how =~ s/\++/+/go;
            $how =~ s/\-+/-/go;
            $how ||= $defaultHow;

            eval{$note =~ /$re/};
            if ($@) {
                $RegexError{$name} = 'error in regular expression';
                mlog(0,"error: weighted regex for $name is invalid '$re=>$we' - $@") if $WorkerNumber == 0;
                $error .= "error: weighted regex for $name is invalid '$re=>$we'<br />";
                mlog(0,"warning: value for $name was not changed - all changes are ignored") if $WorkerNumber == 0;
                @{$name.'Weight'} = @Weight;
                @{$name.'WeightRE'} = @WeightRE;
                $new = $old;
                if (! $RegexGroupingOnly) {
                    return "<span class=\"negative\"> - weighted regex for $name is invalid '$re=>$we'!</span>";
                } else {
                    $RegexGroupingOnly = 0;
                    mlog(0,"info: try to use unoptimized regex $name") if $WorkerNumber == 0;
                    my $ret = &ConfigCompileRe($name, $old, $orgnew, $init);
                    $RegexGroupingOnly = 1;
                    return $ret;
                }
            } else {
                delete $RegexError{$name};
            }
            if ($name =~ /bomb|script|black/o && $how) {
                if ($how =~ /[nN][^\-]?/o) {
                    $WeightedReOverwrite{$name} |= 1;
                }
                if ($how =~ /[wW][^\-]?/o) {
                    $WeightedReOverwrite{$name} |= 2;
                }
                if ($how =~ /[lL][^\-]?/o) {
                    $WeightedReOverwrite{$name} |= 4;
                }
                if ($how =~ /[iI][^\-]?/o) {
                    $WeightedReOverwrite{$name} |= 8;
                }
            } elsif ($name =~ /Reversed/o && $how) {
                if ($how =~ /[nN][^\-]?/o) {
                    $WeightedReOverwrite{$name} |= 1;
                }
                if ($how =~ /[wW][^\-]?/o) {
                    $WeightedReOverwrite{$name} |= 2;
                }
            } elsif ($name =~ /Helo/o && $how) {
                if ($how =~ /[nN][^\-]?/o) {
                    $WeightedReOverwrite{$name} |= 1;
                }
                if ($how =~ /[wW][^\-]?/o) {
                    $WeightedReOverwrite{$name} |= 2;
                }
            }
            push (@{$name.'WeightRE'},'{'.$how.'}'.$re);
            push (@{$name.'Weight'},$we);
        }
        my $count = 0;
        foreach my $k (@{$name.'Weight'}) {
            my $reg = ${$name.'WeightRE'}[$count];
            my $how; $how = $1 if $reg =~ s/^\{([^\}]*)?\}(.+)$/$2/o;
            $reg =~ s/^\<\<\<(.*?)\>\>\>$/$1/go;
            strip50($reg);
            $how = " for [$how]" if $how;
            mlog(0,"info: $name : regex $reg - weight set to $k$how") if $WorkerNumber == 0 && $MaintenanceLog >= 2;
            $count++;
        }
        mlog(0,"info: Regex $name: $count weighted regular expression defined") if $count && $WorkerNumber == 0 && $MaintenanceLog;
    }

    if ($name eq 'TLDS') {
        if (($CanUseRegexOptimizer || $CanUseRegexpOptimizer) && $new) {
            $new .= '|'.$punyRE;
            my $lenBefore = length($new) + 4 + 9;      # (?-xims:(?:......))
            my $o;
            eval{
                $o = $optReModule->new;
                $o->set(optim_sx => 0);
#                $o->set(debug => $debug);
                $TLDSRE = $o->optimize(qr/(?i:$new)/);
            };
            if ($@) {
                mlog(0,"warning: regex optimization failed for '<$name>' - try using unoptimized regex") if $WorkerNumber == 0;
                $error .= "warning: regex optimization failed for '<$name>' - try using unoptimized regex<br />";
                use re 'eval';
                $TLDSRE = qr/(?i:$new)/;
            } else {
                my $lenAfter = length $TLDSRE;
                mlog(0,"info: optimized regex for '<$name>' - length in byte before: $lenBefore - after: $lenAfter") if $MaintenanceLog >= 2 && $WorkerNumber == 0;;
            }
            exportOptRE(\$TLDSRE,'TLDS') if $WorkerNumber == 0;
        } else {
            use re 'eval';
            $TLDSRE = qr/(?i:$new)/;
        }
        if (! $new) {
            mlog(0,"warning: no top level domain file ($Config{TLDS}) found - URIBL check will be skipped") if $WorkerNumber == 0 && $ValidateURIBL;
            $error .= "warning: no top level domain file ($Config{TLDS}) found - URIBL check will be skipped<br />" if $ValidateURIBL;
        }
    } else {
        $new||=$neverMatch; # regexp that never matches

        # replace something like ${$EmailDomainRe} with the value of $EmailDomainRe
        $new =~ s/(([^\\]?)\$\{\$([a-z][a-z0-9]+)\})/(defined ${$3}) ? $2.${$3} : $1/oige if $AllowInternalsInRegex;

        if ($RegexGroupingOnly) {
            if (! SetRE($name.'RE',$new,'is',$name, $name ,$hasChanged) ) {
                $RegexError{$name} = 'error in regular expression';
                $RegexGroupingOnly = 0;
                @{$name.'WeightRE'} = ();
                @{$name.'Weight'}   = ();
                mlog(0,"info: try to use unoptimized regex $name") if $WorkerNumber == 0;
                $error .= "info: try to use unoptimized regex $name<br />";
                $error .= &ConfigCompileRe($name, $old, $orgnew, $init);
                $RegexGroupingOnly = 1;
            } else {
                delete $RegexError{$name};
            }
        } else {
            if (! SetRE($name.'RE',$new,'is',$name,$name)) {
                $RegexError{$name} = 'error in regular expression';
                $error .= "regex for $name is invalid!<br />";
            } else {
                delete $RegexError{$name};
            }
        }
    }
    if ($error) {
        $error =~ s/<\/?span[^>]*>//go;
        $error = "<span class=\"negative\">$error</span>";
    }
    return $error;
}

sub ConfigOverwriteRe {
    my $reMask = (  $WeightedReOverwrite{bombRe}
                  | $WeightedReOverwrite{bombSenderRe}
                  | $WeightedReOverwrite{bombHeaderRe}
                  | $WeightedReOverwrite{bombSubjectRe}
                  | $WeightedReOverwrite{bombCharSets}
                  | $WeightedReOverwrite{bombDataRe}
                  | $WeightedReOverwrite{bombSuspiciousRe}
                  | $WeightedReOverwrite{blackRe}
                  | $WeightedReOverwrite{scriptRe} );

    $bombReNPw    = $reMask & 1;
    $bombReWLw    = $reMask & 2;
    $bombReLocalw = $reMask & 4;
    $bombReISPIPw = $reMask & 8;

    $DoReversedNPw =  $WeightedReOverwrite{invalidPTRRe} & 1;
    $DoReversedWLw =  $WeightedReOverwrite{invalidPTRRe} & 2;

    $DoHeloNPw =  $WeightedReOverwrite{invalidFormatHeloRe} & 1;
    $DoHeloWLw =  $WeightedReOverwrite{invalidFormatHeloRe} & 2;
}

sub fileUpdated {

    my ( $fil, $configname ) = @_;

    $fil = "$base/$fil" if $fil !~ /^(?:(?:[a-z]:)?[\/\\]|\Q$base\E)/io;

    #$fil="$base/$fil" if $fil!~/^\Q$base\E/io;
    return 0 unless (-e $fil);
    return 1 unless $FileUpdate{"$fil$configname"};
    my ($old, $new) = ($FileUpdate{"$fil$configname"} , ftime($fil));
    if ($old != $new) {
        $old = $old ? timestring($old) : 'n/a';
        $new = $new ? timestring($new) : 'n/a';
        mlog(0,"info: found changed file '$fil' for config '$configname' - old ($old), new ($new)") if ($MaintenanceLog > 1 && $WorkerNumber == 10000);
        mlog(0,"adminupdate: file '$fil' for config '$configname' was changed") if ($WorkerNumber == 0 && ($configname ne 'Groups' || ($configname eq 'Groups' && ($WebIP{$ActWebSess}->{user} || $syncUser))));
        return 1;
    }
    return fileIncUpdated($fil,$configname);
}

sub fileIncUpdated {
    my ( $fil, $configname ) = @_;
    return 0 unless exists $FileIncUpdate{"$fil$configname"};

    my $changed = 0;
    foreach my $f (keys %{$FileIncUpdate{"$fil$configname"}}) {
        my ($old, $new) = ($FileIncUpdate{"$fil$configname"}{$f} , ftime($f));
        next if $old == $new;
        $old = $old ? timestring($old) : 'n/a';
        $new = $new ? timestring($new) : 'n/a';
        mlog(0,"info: found changed include file '$f' for config '$configname' - old ($old), new ($new)") if $MaintenanceLog > 1 && $WorkerNumber == 10000;
        mlog(0,"adminupdate: include file '$f' for config '$configname' was changed") if ($WorkerNumber == 0 && ($configname ne 'Groups' || ($configname eq 'Groups' && ($WebIP{$ActWebSess}->{user} || $syncUser))));
        $changed = 1;
    }
    return $changed;
}

sub ConfigChangeUSAMN {
    my ($name, $old, $new, $init)=@_;
    return if $WorkerNumber != 0;
    mlog(0,"AdminUpdate: $name from '$old' to '$new'") unless $init || $new eq $old;
    $Config{$name} = $new;
    $$name = $new;
    &ConfigChangeMaxAllowedDups('MaxAllowedDups',$MaxAllowedDups,$MaxAllowedDups,'');
}

sub ConfigChangeMaxAllowedDups {
    my ($name, $old, $new, $init)=@_;
    return if $WorkerNumber != 0 && $init ne 'reread';
    my $count = -1;
    if ($new && $Config{UseSubjectsAsMaillogNames} && $Config{discarded} && $Config{spamlog}) {
        if ($WorkerNumber == 0) {
            cmdToThread('fillSpamfiles','');
        } else {
            $count = &fillSpamfiles();
        }
    } else {
       %Spamfiles = ();
       %SpamfileNames = ();
    }
    mlog(0,"AdminUpdate: $name from '$old' to '$new'") unless $init || $new eq $old;
    mlog(0,"info: $name - $count files registered in $Config{spamlog} folder") if $init && $new && $count > -1;
    $Config{$name} = $$name = $new unless $WorkerNumber;
}

sub fillSpamfiles {
    if ($RunTaskNow{'fillSpamfiles'}) {
        mlog(0,"info: the task 'fillSpamfiles' to register spamfile subjects is still running - this request is skipped");
        return 0;
    }
    $RunTaskNow{'fillSpamfiles'} = $WorkerNumber;
    return 0 unless $spamlog;
    return 0 unless $discarded;
    my %tSpamfiles = ();
    my %tSpamfileNames = ();
    my $count = 0;
    my @files = map {my $T = $_;$T=~/^([^\\\/]*)?--(\d+)\Q$maillogExt\E$/;($1 && $2)?($1,$2):('','');} $unicodeDH->("$base/$spamlog");
    while (@files) {
        my $file = shift @files;
        my $num = shift @files;
        next unless $file;
        next if /\\|\//o;
        next if $dF->( $file );
        $file = e8($file);
        my $md5 = eval{Digest::MD5::md5($file);};
        next unless $md5;
        $tSpamfileNames{$md5} .= ' ' if $tSpamfiles{$md5}++;
        $tSpamfileNames{$md5} .= "$num";
        $count++;
        &ThreadYield() if $count%100 == 0;
    }
    %Spamfiles = %tSpamfiles;
    %SpamfileNames = %tSpamfileNames;
    $RunTaskNow{'fillSpamfiles'} = '';
    mlog(0,"info: MaxAllowedDups - $count files registered in $Config{spamlog} folder") if $count;
    return $count;
}

sub configChangeRT {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: SMTP Destination Routing Table updated from '$old' to '$new'") unless $init || $new eq $old;
    $Config{smtpDestinationRT} = $smtpDestinationRT = $new unless $WorkerNumber;
    $new = checkOptionList($new,'smtpDestinationRT',$init);
    my $error;
    my %tcrtable;
    my $countOK;
    my $count;
    my $re = '\s*('.$HostRe.')\s*=>\s*('.$HostPortRe.')';
    for my $v (split(/\|/o,$new)) {
        $count++;
        if ($v=~/$re/o) {
            $tcrtable{$1} = $2;
            $countOK++;
        } else {
            mlog(0,"error: smtpDestinationRT - entry $v is wrong and is ignored") if $WorkerNumber == 0;
            $error .= "<br />entry $v is wrong and is ignored";
        }
    }
    mlog(0,"info: registered $countOK entries from $count defined for SMTP Destination Routing Table") if $count && $init && $WorkerNumber == 0 && $MaintenanceLog >=2;
    %crtable = %tcrtable;
    return $error;
}

sub ConfigChangeDoPrivatSpamdb {
    my ($name, $old, $new, $init)=@_;
    return if $WorkerNumber != 0;
    if ($new && $Config{spamdb} !~ /DB:/o) {
        $qs{$name} = ${$name} = $Config{$name} = 0;
        mlog(0,"error: unable to set $name to $new - spamdb is not set to 'DB:'");
        return "<br />*** unable to set $name to $new - spamdb is not set to 'DB:' ***<script type=\"text/javascript\">alert(\'unable to set $name to $new - set spamdb to DB: first!\');</script>";
    }
    mlog(0,"AdminUpdate: $name updated from '$old' to '$new'") unless ($init || $new eq $old);
    ${$name} = $Config{$name} = $new;
    return '';
}

sub configChangeRestartEvery {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: RestartEvery updated from '$old' to '$new'") unless ($init || $new eq $old);
    return '' if $new eq $old;
    $RestartEvery = $new;
    $Config{RestartEvery} = $new;
    if ($new) {
        $endtime = time + $RestartEvery;
        mlog(0,"AdminUpdate: next restart is scheduled in " . &getTimeDiff($endtime - time));
    } else {
        $endtime = 999999999;
    }
    return '';
}

sub configChangeIC {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: inbound charset conversion Table updated from '$old' to '$new'") unless $init || $new eq $old;
    $inChrSetConv=$new unless $WorkerNumber;
    $new=checkOptionList($new,'inChrSetConv',$init);
    my $f;
    my $fa;
    my $t;
    my $ta;
    my $test="abc";
    my $error;
    for my $v (split(/\|/o,$new)) {
        $v=~/^(.*)\=\>(.*)$/o;
        $fa=$1;
        $ta=$2;
        eval{$f='';$f=Encode::resolve_alias(uc($fa));};
        eval{$t='';$t=Encode::resolve_alias(uc($ta));};
        if (! $f) {
            mlog(0,"error: codepage $fa is not supported by perl in inChrSetConv");
            $error .= "$fa ";
            next;
        }
        if (! $t) {
            mlog(0,"error: codepage $ta is not supported by perl in inChrSetConv");
            $error .= "$ta ";
            next;
        }
        eval{Encode::from_to($test,$f,$t)};
        if ($@) {
            mlog(0,"error: perl is unable to convert from $f/fa to $t/ta in inChrSetConv - this conversion will be ignored");
            $error .= "$fa $ta ";
            next;
        } else {
            $inchrset{$f} = $t;
        }
    }
    $error = " - but error in $error - please check the log" if ($error);
    return $error;
}

sub configChangeOC {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: outbound charset conversion Table updated from '$old' to '$new'") unless $init || $new eq $old;
    $outChrSetConv=$new unless $WorkerNumber;
    $new=checkOptionList($new,'outChrSetConv',$init);
    my $f;
    my $fa;
    my $t;
    my $ta;
    my $test="abc";
    my $error;
    for my $v (split(/\|/o,$new)) {
        $v=~/^(.*)\=\>(.*)$/o;
        $fa=$1;
        $ta=$2;
        eval{$f='';$f=Encode::resolve_alias(uc($fa));};
        eval{$t='';$t=Encode::resolve_alias(uc($ta));};
        if (! $f) {
            mlog(0,"error: codepage $fa is not supported by perl in outChrSetConv");
            $error .= "$fa ";
            next;
        }
        if (! $t) {
            mlog(0,"error: codepage $ta is not supported by perl in outChrSetConv");
            $error .= "$ta ";
            next;
        }
        eval{Encode::from_to($test,$f,$t)};
        if ($@) {
            mlog(0,"error: perl is unable to convert from characterset $f to $t in outChrSetConv - this conversion will be ignored");
            $error .= "$fa $ta ";
            next;
        } else {
            $outchrset{$f} = $t;
        }
    }
    $error = " - but error in $error - please check the log" if ($error);
    return $error;
}

sub ConfigChangeIPv6 {my ($name, $old, $new, $init)=@_;
    mlog( 0, "AdminUpdate: $name changed from '$old' to '$new'" ) unless $init || $new eq $old;
    $Config{$name} = ${$name} = $new;
    return '' if $init || $new eq $old;
    
    if ($new) {
        if ($SysIOSocketINET6 == 0) {
            $CanUseIOSocketINET6 = $AvailIOSocketINET6 = 0;
            mlog(0,"error: IPv6 is not supported by your system");
            return "<br />*** IPv6 is not supported by your system ***<script type=\"text/javascript\">alert(\'IPv6 is not supported by your system\');</script>";
        }
        if (! $useIOSocketINET6) {
            $useIOSocketINET6 = $Config{useIOSocketINET6} = 1;
            mlog(0,"AdminUpdate: useIOSocketINET6 changed from '' to '1'");
        }
	    $CanUseIOSocketINET6 = $AvailIOSocketINET6 = eval("use IO::Socket::INET6; 1");
        my $error = ($CanUseIOSocketINET6) ? '' : $@;
        if ($CanUseIOSocketINET6) {
            if ($SysIOSocketINET6 == -1) {
                $CanUseIOSocketINET6 = $AvailIOSocketINET6 =
                  eval {
                      my $sock = IO::Socket::INET6->new(Domain => AF_INET6, Listen => 1, LocalAddr => '[::]', LocalPort => $IPv6TestPort);
                      if ($sock) {
                          close($sock);
                          $SysIOSocketINET6 = 1;
                          1;
                      } else {
                          $AvailIOSocketINET6 = $SysIOSocketINET6 = 0;
                          0;
                      }
                  };
            }
            if ($CanUseIOSocketINET6) {
                if ($CanUseIOSocketSSL) {
                    eval('no IO::Socket::SSL; use IO::Socket::SSL;');
                }

                if ($WorkerNumber == 0) {
                    configChangeProxy('ProxyConf','',$Config{ProxyConf},'Initializing') if $ProxyConf;
                    ConfigChangeRelayPort('relayPort','',$Config{relayPort},'Initializing') if $relayPort;
                    ConfigChangeMailPort('listenPort','',$Config{listenPort},'Initializing') if $listenPort;
                    ConfigChangeMailPort2('listenPort2','',$Config{listenPort2},'Initializing') if $listenPort2;
                    ConfigChangeMailPortSSL('listenPortSSL','',$Config{listenPortSSL},'Initializing') if $listenPortSSL;

                    ConfigChangeStatPort('webStatPort','',$Config{webStatPort},'Initializing') if $webStatPort;
                    ConfigChangeAdminPort('webAdminPort','',$Config{webAdminPort},'Initializing') if $webAdminPort;
                }
                ConfigChangeTLSPorts('NoTLSlistenPorts','',$Config{NoTLSlistenPorts},'Initializing') if $NoTLSlistenPorts;
                ConfigChangeTLSPorts('TLStoProxyListenPorts','',$Config{TLStoProxyListenPorts},'Initializing') if $TLStoProxyListenPorts;

                mlog(0,"IPv6 support is now enabled");
                return 'IPv6 support is now enabled';
            } else {
                mlog(0,"error: IPv6 is not supported by your system");
                return "<br />*** IPv6 is not supported by your system ***<script type=\"text/javascript\">alert(\'IPv6 is not supported by your system\');</script>";
            }
        }
        mlog(0,"error: unable to start IPv6 support - $error");
        return "<br />*** unable to start IPv6 support ***<script type=\"text/javascript\">alert(\'unable to start IPv6 support\');</script>";
    } else {
        $CanUseIOSocketINET6 = $AvailIOSocketINET6 = 0;
        eval("no IO::Socket::INET6; use IO::Socket::INET;");
        eval("no IO::Socket::SSL; use IO::Socket::SSL 'inet4';") if ($CanUseIOSocketSSL);  # to correct @ISA

        if ($WorkerNumber == 0) {
            configChangeProxy('ProxyConf','',$Config{ProxyConf},'Initializing') if $ProxyConf;
            ConfigChangeRelayPort('relayPort','',$Config{relayPort},'Initializing') if $relayPort;
            ConfigChangeMailPort('listenPort','',$Config{listenPort},'Initializing') if $listenPort;
            ConfigChangeMailPort2('listenPort2','',$Config{listenPort2},'Initializing') if $listenPort2;
            ConfigChangeMailPortSSL('listenPortSSL','',$Config{listenPortSSL},'Initializing') if $listenPortSSL;

            ConfigChangeStatPort('webStatPort','',$Config{webStatPort},'Initializing') if $webStatPort;
            ConfigChangeAdminPort('webAdminPort','',$Config{webAdminPort},'Initializing') if $webAdminPort;
        }
        ConfigChangeTLSPorts('NoTLSlistenPorts','',$Config{NoTLSlistenPorts},'Initializing') if $NoTLSlistenPorts;
        ConfigChangeTLSPorts('TLStoProxyListenPorts','',$Config{TLStoProxyListenPorts},'Initializing') if $TLStoProxyListenPorts;

        mlog(0,"IPv6 support is now disabled");
        return 'IPv6 support is now disabled';
    }
}

sub ConfigChangeMailPort {my ($name, $old, $new, $init)=@_;
    my $highport = 1;
    return if $new eq $old;
    foreach my $port (split(/\|/o,$new)) {
        if ($port =~ /^.+:([^:]+)$/o) {
            if ($1 < 1024) {
                $highport = 0;
                last;
            }
        } else {
            if ($port < 1024) {
                $highport = 0;
                last;
            }
        }
    }
    $Config{listenPort}=$listenPort=$new;
    if($> == 0 || $highport || $^O eq "MSWin32") {

        # change the listenport

        foreach my $lsn (@lsn ) {
            unpoll($lsn,$readable);
            unpoll($lsn,$writable);
            close($lsn);
            delete $SocketCalls{$lsn};
        }
        my ($lsn,$lsnI) = newListen($listenPort,\&ConToThread,1);
        @lsn = @$lsn; @lsnI = @$lsnI;
        for (@$lsnI) {s/:::/\[::\]:/o;}
        mlog(0,"AdminUpdate: listening on new mail port @$lsnI (changed from $old) ");
        return '';
    } else {

        # don't have permissions to change
        mlog(0,"AdminUpdate: request to listen on new mail port $new (changed from $old) -- restart required; euid=$>");
        return "<br />Restart required; euid=$><script type=\"text/javascript\">alert(\'new mail port - ASSP-Restart required\');</script>";
    }
}

sub ConfigChangeMailPort2 {my ($name, $old, $new, $init)=@_;
    my $highport = 1;
    return if $new eq $old;
    foreach my $port (split(/\|/o,$new)) {
        if ($port =~ /^.+:([^:]+)$/o) {
            if ($1 < 1024) {
                $highport = 0;
                last;
            }
        } else {
            if ($port < 1024) {
                $highport = 0;
                last;
            }
        }
    }
    $Config{listenPort2}=$listenPort2=$new;
    if($> == 0 || $highport || $^O eq "MSWin32") {

        # change the listenport2
        foreach my $lsn2 (@lsn2 ) {
            unpoll($lsn2,$readable);
            unpoll($lsn2,$writable);
            close($lsn2);
            delete $SocketCalls{$lsn2};
        }
        my ($lsn2,$lsn2I) = newListen($listenPort2,\&ConToThread,1);
        @lsn2 = @$lsn2; @lsn2I = @$lsn2I;
        for (@$lsn2I) {s/:::/\[::\]:/o;}
        mlog(0,"AdminUpdate: listening on new secondary mail port @$lsn2I (changed from $old)");
        return '';
    } else {

        # don't have permissions to change
        mlog(0,"AdminUpdate: request to listen on new secondary mail port $new (changed from $old) -- restart required; euid=$>");
        return "<br />Restart required; euid=$><script type=\"text/javascript\">alert(\'new secondary mail port - ASSP-Restart required\');</script>";
    }
}

sub ConfigChangeMailPortSSL {
    my ( $name, $old, $new , $init) = @_;
    my $highport = 1;
    return if $new eq $old;
    foreach my $port (split(/\|/o,$new)) {
        if ($port =~ /^.+:([^:]+)$/o) {
            if ($1 < 1024) {
                $highport = 0;
                last;
            }
        } else {
            if ($port < 1024) {
                $highport = 0;
                last;
            }
        }
    }
    $Config{listenPortSSL}=$listenPortSSL = $new;
    if($> == 0 || $highport || $^O eq "MSWin32") {

        # change the listenportSSL
        foreach my $lfh (@lsnSSL) {
            unpoll($lfh,$readable,POLLIN);
            unpoll($lfh,$writable,POLLIN);
            delete $SocketCalls{$lfh};
            close($lfh);
        }
        if ($CanUseIOSocketSSL) {
            my ($lsnSSL,$lsnSSLI) = newListenSSL($listenPortSSL,\&ConToThread,1);
            @lsnSSL = @$lsnSSL; @lsnSSLI = @$lsnSSLI;
            for (@$lsnSSLI) {s/:::/\[::\]:/o;}
            mlog( 0,"AdminUpdate: listening on new SSL mail port @$lsnSSLI (changed from '$old')");
        } else {
            mlog( 0,"AdminUpdate: new SSL mail port '$listenPortSSL' (changed from '$old')");
        }
        return '';
    } else {

        # don't have permissions to change
        mlog( 0,
"AdminUpdate: request to listen on new SSL mail port '$new' (changed from '$old') -- restart required; euid=$>"
        );
        return "<br />Restart required; euid=$>";
    }
}


sub ConfigChangeEnableAdminSSL {my ($name, $old, $new, $init)=@_;
    if ($new) {
        if (! -e $SSLCertFile) {
            $new = $old = 0;
            $enableWebAdminSSL = $new;
            $Config{enableWebAdminSSL} = $new;
            return "<span class=\"negative\">Couldn't find file $base/certs/server-cert.pem</span>";
        }
        if (! -e $SSLKeyFile) {
            $new = $old = 0;
            $enableWebAdminSSL = $new;
            $Config{enableWebAdminSSL} = $new;
            return "<span class=\"negative\">Couldn't find file $base/certs/server-key.pem</span>";
        }
        if (! $CanUseIOSocketSSL) {
            $new = $old = 0;
            $enableWebAdminSSL = $Config{enableWebAdminSSL} = $new;
            return "<span class=\"negative\">Module IO::Socket::SSL is not installed</span>";
        }
    }
    my $usessln;
    my $usesslo;
    if ($new ne $old) {
        $usessln = $new ? 'HTTPS' : 'HTTP';
        $usesslo = $new ? 'HTTP' : 'HTTPS';
        $httpchanged = 1;
        mlog(0,"AdminUpdate: listening on admin port $usessln (changed from $usesslo)");
    }
    $enableWebAdminSSL = $Config{enableWebAdminSSL} = $new;
    &ConfigChangeAdminPort('webAdminPort', $webAdminPort, $webAdminPort,'renew');
    '';
}

sub ConfigChangeEnableStatSSL {my ($name, $old, $new, $init)=@_;
    if ($new) {
        if (! -e $SSLCertFile) {
            $new = $old = 0;
            $enableWebAdminSSL = $new;
            $Config{enableWebAdminSSL} = $new;
            return "<span class=\"negative\">Couldn't find file $base/certs/server-cert.pem</span>";
        }
        if (! -e $SSLKeyFile) {
            $new = $old = 0;
            $enableWebAdminSSL = $new;
            $Config{enableWebAdminSSL} = $new;
            return "<span class=\"negative\">Couldn't find file $base/certs/server-key.pem</span>";
        }
        if (! $CanUseIOSocketSSL) {
            $new = $old = 0;
            $enableWebAdminSSL = $new;
            $Config{enableWebAdminSSL} = $new;
            return "<span class=\"negative\">Module IO::Socket::SSL is not installed</span>";
        }
    }
    if ($new ne $old) {
        my $usessln = $new ? 'HTTPS' : 'HTTP';
        my $usesslo = $new ? 'HTTP' : 'HTTPS';
        mlog(0,"AdminUpdate: listening on stat port $usessln (changed from $usesslo)");
    }
    $enableWebStatSSL = $Config{enableWebStatSSL} = $new;
    &ConfigChangeStatPort('webStatPort', $webStatPort, $webStatPort,'renew');
}

sub getSSLPWD {
    return $SSLPKPassword;
}

sub getSSLParms {
    my %ssl;
    if (shift) {
        $ssl{SSL_server} = 1;
        $ssl{SSL_use_cert} = 1;
        $ssl{SSL_cert_file} = $SSLCertFile;
        $ssl{SSL_key_file} = $SSLKeyFile;
        $ssl{SSL_ca_file} = $SSLCaFile if $SSLCaFile;
        $ssl{SSL_passwd_cb} = \&getSSLPWD if getSSLPWD();
    }
    if ($SSL_cipher_list) {
        $ssl{SSL_cipher_list} = $SSL_cipher_list;
        $ssl{SSL_honor_cipher_order} = 1;
    }
    $ssl{SSL_version} = $SSL_version if $SSL_version;
    $ssl{SSL_verify_mode} = 0x00;
    $ssl{Timeout} = $SSLtimeout;

    return %ssl;
}

sub ConfigChangeSSL {
    my ( $name, $old, $new ,$init) = @_;

    if ($new ne $old) {
        $new =~ s/\\/\//go;
        $old =~ s/\\/\//go;
        $Config{$name} = ${$name} = $new;
        if ((-f $new && -r $new) || $name eq 'SSLCaFile' || $name eq 'SSL_version' || $name eq 'SSL_cipher_list') {
            mlog( 0, "AdminUpdate: $name changed from '$old' to '$new'" ) unless $init;
            if (-r $SSLCertFile and -r $SSLKeyFile and $AvailIOSocketSSL) {
                $CanUseIOSocketSSL = 1;
                if ($listenPortSSL) {
                    &ConfigChangeMailPortSSL('listenPortSSL','n/a',$listenPortSSL, 1);
                }
                if ($enableWebAdminSSL) {
                    &ConfigChangeAdminPort('webAdminPort','n/a',$webAdminPort, 1);
                }
                if ($enableWebStatSSL) {
                    &ConfigChangeStatPort('webStatPort','n/a',$webStatPort, 1);
                }
            }
            return '';
        } else {
            $Config{$name} = ${$name} = $old;
            mlog( 0, "AdminUpdate: $name not changed from '$old' to '$new' - file $new not found or unreadable" ) unless $init;
            return "<span class=\"negative\">file $new not found or unreadable</span>";
        }
    }
}

sub ConfigChangeTLSPorts {my ($name, $old, $new, $init)=@_;
    return '' if $new eq $old && ! $init;

    $$name = $Config{$name} = $new unless $WorkerNumber;
    mlog(0,"AdminUpdate: $name changed to $new from $old") if $WorkerNumber == 0 && ! $init;
    my $listen = $name eq 'NoTLSlistenPorts' ? 'lsnNoTLSI' : 'TLStoProxyI';
    fillPortArray($listen, $new);
    return '';
}

sub ConfigChangeNoAUTHPorts {my ($name, $old, $new, $init)=@_;
    return '' if $new eq $old && ! $init;

    $$name = $Config{$name} = $new unless $WorkerNumber;
    mlog(0,"AdminUpdate: $name changed to $new from $old") if $WorkerNumber == 0 && ! $init;
    my $listen = 'lsnNoAUTH';
    fillPortArray($listen, $new);
    return '';
}

sub fillPortArray {
    my ($listen, $new) = @_;
    return unless $listen;
    @{$listen} = ();
    return unless $new;
    my ($interface,$p);
    if ($new=~/\|/o) {
        foreach my $portA (split(/\|/o, $new)) {
            ($interface,$p)=$portA=~/^(.*):([^:]*)$/o;
            $interface =~ s/\s//go;
            $p =~ s/\s//go;
            $portA =~ s/\s//go;
            if ($interface) {
                push @{$listen}, "$interface:$p";
            } else {
                push @{$listen}, "0.0.0.0:$portA";
                push @{$listen}, "[::]:$portA" if $CanUseIOSocketINET6;
            }
        }
    } else {
        ($interface,$p)=$new=~/(.*):([^:]*)/o;
        $interface =~ s/\s//go;
        $p =~ s/\s//go;
        $new =~ s/\s//go;
        if ($interface) {
            push @{$listen}, "$interface:$p";
        } else {
            push @{$listen}, "0.0.0.0:$new";
            push @{$listen}, "[::]:$new" if $CanUseIOSocketINET6;
        }
    }
}

sub ConfigChangeAdminPort {my ($name, $old, $new, $init)=@_;
    my $usessl;
    my $highport = 1;
    return if $new eq $old && ! $init;
    return if $WorkerNumber != 0;
    my $dummy;
    my $WebSocket;
    foreach my $port (split(/\|/o,$new)) {
        if ($port =~ /^.+:([^:]+)$/o) {
            if ($1 < 1024) {
                $highport = 0;
                last;
            }
        } else {
            if ($port < 1024) {
                $highport = 0;
                last;
            }
        }
    }
    $webAdminPort=$Config{webAdminPort}=$new;
    if($> == 0 || $highport || $^O eq "MSWin32") {

        # change the listenport
        foreach my $WebSock (@WebSocket) {
            unpoll($WebSock,$readable);
            unpoll($WebSock,$writable);
            close($WebSock) || eval{$WebSock->close;} || eval{$WebSock->kill_socket();} ||
            mlog(0,"warning: unable to close WebSocket: $WebSocket");
            delete $SocketCalls{$WebSock};
        }
        
        if ($CanUseIOSocketSSL && $enableWebAdminSSL) {
            ($WebSocket,$dummy) = newListenSSL($webAdminPort,\&NewWebConnection);
            @WebSocket = @$WebSocket;
            $usessl = 'HTTPS';
        } else {
            ($WebSocket,$dummy) = newListen($webAdminPort,\&NewWebConnection);
            @WebSocket = @$WebSocket;
            $usessl = '';
        }
        for (@$dummy) {s/:::/\[::\]:/o;}
        if(@WebSocket) {
            mlog(0,"AdminUpdate: listening on new admin port @$dummy $usessl (changed from $old)");
        } else {

            # couldn't open the port -- switch back
            if ($usessl && $new eq $old) {
                ($WebSocket,$dummy) = newListen($webAdminPort,\&NewWebConnection);
                @WebSocket = @$WebSocket;
            } elsif ($usessl) {
                ($WebSocket,$dummy) = newListenSSL($webAdminPort,\&NewWebConnection);
                @WebSocket = @$WebSocket;
            } else {
                ($WebSocket,$dummy) = newListen($webAdminPort,\&NewWebConnection);
                @WebSocket = @$WebSocket;
            }
            for (@$dummy) {s/:::/\[::\]:/o;}
            mlog(0,"AdminUpdate: couldn't open new port -- still listening on @$dummy");
            $webAdminPort=$Config{$name}=$old;
            return "<span class=\"negative\">Couldn't open new port $new -- still listening on @$dummy</span>";
        }
        return '';
    } else {

        # don't have permissions to change
        mlog(0,"AdminUpdate: request to listen on new admin port $new $usessl (changed from $old) -- restart required; euid=$>");
        return "<br />Restart required; euid=$><script type=\"text/javascript\">alert(\'new admin port $usessl - ASSP-Restart required\');</script>";
    }
}

sub ConfigChangeStatPort {my ($name, $old, $new, $init)=@_;
    my $usessl;
    my @dummy;
    my $highport = 1;
    return if $new eq $old && ! $init;
    return if $WorkerNumber != 0;
    my $dummy;
    my $StatSocket;
    foreach my $port (split(/\|/o,$new)) {
        if ($port =~ /^.+:([^:]+)$/o) {
            if ($1 < 1024) {
                $highport = 0;
                last;
            }
        } else {
            if ($port < 1024) {
                $highport = 0;
                last;
            }
        }
    }
    $webStatPort=$Config{webStatPort}=$new;
    if($> == 0 || $highport || $^O eq "MSWin32") {

        # change the listenport
        foreach my $StatSock (@StatSocket) {
            unpoll($StatSock,$readable);
            unpoll($StatSock,$writable);
            close($StatSock) || eval{$StatSock->close;} || eval{$StatSock->kill_socket();} ||
            delete $SocketCalls{$StatSock};
        }

        if ($CanUseIOSocketSSL && $enableWebStatSSL) {
            ($StatSocket,$dummy) = newListenSSL($webStatPort,\&NewStatConnection);
            @StatSocket = @$StatSocket;
            $usessl = 'HTTPS';
        } else {
            ($StatSocket,$dummy) = newListen($webStatPort,\&NewStatConnection);
            @StatSocket = @$StatSocket;
            $usessl = '';
        }
        for (@$dummy) {s/:::/\[::\]:/o;}
        if(@StatSocket) {
            mlog(0,"AdminUpdate: listening on new stat port @$dummy $usessl (changed from $old)");
        } else {

            # couldn't open the port -- switch back
            if ($usessl && $new eq $old) {
                ($StatSocket,$dummy) = newListen($webStatPort,\&NewStatConnection);
                @StatSocket = @$StatSocket;
            } elsif ($usessl) {
                ($StatSocket,$dummy) = newListenSSL($webStatPort,\&NewStatConnection);
                @StatSocket = @$StatSocket;
            } else {
                ($StatSocket,$dummy) = newListen($webStatPort,\&NewStatConnection);
                @StatSocket = @$StatSocket;
            }
            for (@$dummy) {s/:::/\[::\]:/o;}
            mlog(0,"AdminUpdate: couldn't open new port -- still listening on @$dummy");
            $webStatPort=$Config{$name}=$old;
            return "<span class=\"negative\">Couldn't open new port $new -- still listening on @$dummy</span>";
        }
        return '';
    } else {

        # don't have permissions to change
        mlog(0,"AdminUpdate: request to listen on new stat port $new $usessl (changed from $old) -- restart required; euid=$>");
        return "<br />Restart required; euid=$><script type=\"text/javascript\">alert(\'new stat port $usessl - ASSP-Restart required\');</script>";
    }
}

sub ConfigChangeSNMPUser {my ($name, $old, $new, $init)=@_;
    return if $WorkerNumber != 0;
    if ($new ne $old or $init) {
        delete $WebIP{SNMP};
        mlog(0,"AdminUpdate: $name changed from $old to $new") unless $init;
        $SNMPUser = $Config{SNMPUser} = $new;
    }
    return '';
}

sub ConfigChangeSNMP {my ($name, $old, $new, $init)=@_;
    return if $WorkerNumber != 0;
    if ($new ne $old or $init) {
        if ($init) {
            delete $qs{ResetAllStats};
            delete $qs{ResetStats};
            my $d = &ConfigStats();
        }
        if ($SNMPagent) {eval{$SNMPagent->shutdown();};  $SNMPagent = undef;}

        if ($name eq 'SNMPBaseOID') {
            $SNMPBaseOID = $Config{SNMPBaseOID} = $new;
            mlog(0,"AdminUpdate: $name changed from $old to $new") unless $init;
            return ConfigChangeSNMP('SNMP','',$Config{SNMP},$init);
        }
        if ($name eq 'SNMPAgentXSocket') {
            $SNMPAgentXSocket = $Config{SNMPAgentXSocket} = $new;
            mlog(0,"AdminUpdate: $name changed from $old to $new") unless $init;
            return ConfigChangeSNMP('SNMPBaseOID','',$Config{SNMPBaseOID},$init);
        }
        if ($new) {
            return "<span class=\"negative\">module NetSNMP::agent is not installed or disabled</span>" unless $CanUseNetSNMPagent;
            
            if (
                eval('netsnmp_ds_set_string(NETSNMP_DS_APPLICATION_ID, NETSNMP_DS_AGENT_X_SOCKET,$SNMPAgentXSocket);1')
                &&
                eval{$SNMPagent = NetSNMP::agent->new(
                            # makes the agent read a my_agent_name.conf file
                            'Name' => "assp2_$myName",
                            'AgentX' => 1
                            );
                }
                &&
                eval{$SNMPagent->register("assp2-$myName", $SNMPBaseOID,\&SNMPhandler);}
                && ! $@
            ) {
                mlog(0,"AdminUpdate: $name changed from $old to $new - agentX started") unless $init;
                ${$name} = $Config{$name} = $new;
                &SNMPhandler('init') unless @sortedOIDs;
                return 'SNMP agentX started';
            } else {
                mlog(0,"AdminUpdate: error unable to register SNMP agentX - agentX stopped - $@")  if $SNMPLog;
                return '<span class="negative">unable to register SNMP agentX - SNMP agentX stopped</span>';
            }
        } else {
            mlog(0,"AdminUpdate: $name changed from $old to $new - agentX stopped") unless $init;
            ${$name} = $Config{$name} = $new;
            return '<span class="negative">SNMP agentX stopped</span>';
        }
    }
}

sub ConfigChangePassword {my ($name, $old, $new, $init)=@_;

    # change the Password
    if (!$init) {
        if ($new) {
            $webAdminPassword=$new;
            $Config{webAdminPassword}=$webAdminPassword=crypt($webAdminPassword,"45");
            mlog(0,"AdminUpdate: root Password changed");
        } elsif (! $new && ! $old) {
            $new = $old = $webAdminPassword;
        } else {
            mlog(0,"error: ConfigChangePassword called without defining a value");
            return;
        }
        my $dec = ASSP::CRYPT->new($old,0);
        my $enc = ($usedCrypt == -1) ? ASSP::CRYPT->new($webAdminPassword,0,1) : ASSP::CRYPT->new($webAdminPassword,0);
        foreach my $file (keys %CryptFile) {
            (open my $cf,'<' ,"$file") or next;
            binmode $cf;
            my $content = join('',<$cf>);
            close $cf;
            $content = $enc->ENCRYPT($dec->DECRYPT($content));
            (open $cf, '>',"$file") or next;
            binmode $cf;
            print $cf $content;
            close $cf;
        }
        if ($usedCrypt == -1) {
            ConfigChangePassPhrase('adminusersdbpass', $Config{adminusersdbpass}, $Config{adminusersdbpass}, 0);
            $usedCrypt = 1 ;
            mlog(0,"AdminUpdate: the used encryption engine is now changed to use the very fast 'Crypt::GOST' module");
        }
        return '';
    }
}

sub ConfigChangePassPhrase {my ($name, $old, $new, $init)=@_;

    # change the Password
    if (!$init) {
        $Config{adminusersdbpass}=$adminusersdbpass=$new;
        if ($adminusersdb) {
            putAdminUsers($adminusersdbpass);
            mlog(0,"AdminUpdate: AdminUsersDB PasswPhrase changed - adminusersdb rewritten") if $usedCrypt != -1;
        } else {
            mlog(0,"AdminUpdate: AdminUsersDB PasswPhrase changed") if $usedCrypt != -1;
        }
        return '';
    }
}

sub putAdminUsers {
    my $pass = shift;
    my %temphash = ();
    my $bin;

    if (! $mysqlSlaveMode) {
      %temphash = %AdminUsers;
      %AdminUsers = ();
    }
    $bin = $AdminUsersObject->{BIN};
    $AdminUsersObject->{enc} = ($usedCrypt == -1) ? ASSP::CRYPT->new($pass,$bin,1) : ASSP::CRYPT->new($pass,$bin);
    $AdminUsersObject->{dec} = ASSP::CRYPT->new($pass,$bin);
    if (! $mysqlSlaveMode) {
        %AdminUsers = %temphash;
        eval{$AdminUsersObject->flush();};
    }

    if (! $mysqlSlaveMode) {
        %temphash = %AdminUsersRight;
        %AdminUsersRight = ();
    }
    $bin = $AdminUsersRightObject->{BIN};
    $AdminUsersRightObject->{enc} = ($usedCrypt == -1) ? ASSP::CRYPT->new($pass,$bin,1) : ASSP::CRYPT->new($pass,$bin);
    $AdminUsersRightObject->{dec} = ASSP::CRYPT->new($pass,$bin);
    if (! $mysqlSlaveMode) {
        %AdminUsersRight = %temphash;
        eval{$AdminUsersRightObject->flush();};
    }
}

sub iso2hex {
	my $s = shift;
    eval('
    use bytes;
    $s = join(\'\',unpack  \'H*\',$s);
    no bytes;');
    return $s;
}

sub hex2iso {
	my $h = shift;
    eval('
    use bytes;
    $h = pack \'H*\',$h;
    no bytes;');
    return $h;
}

sub ConfigChangeValencePB {my ($name, $old, $new, $init)=@_;
    $Config{$name} = $$name = $new unless $WorkerNumber;
    my ($s1,$s2,$s3) = split(/[\|,\s]+/o,$new);
    $s2 = $s1 unless defined $s2;
    @$name = ($s1,$s2);
    push @$name, $s3 if defined $s3;
    mlog(0,"AdminUpdate: $name updated from '$old' to '$new' - new message score: ${$name}[0] , new IP score ${$name}[1]") unless ($init || $new eq $old);
    return '';
}

sub ConfigChangeRelayPort {my ($name, $old, $new, $init)=@_;
    unless ($relayHost && $new) {
        if(@lsnRelay) {
          foreach my $Relay (@lsnRelay) {
            unpoll($Relay,$readable);
            unpoll($Relay,$writable);
            close($Relay);
            delete $SocketCalls{$Relay};
          }
          $$name = $Config{$name}=$new;
          mlog(0,"AdminUpdate: relay port disabled");
          return '<br />relay port disabled';
        } else {
          $$name = $Config{$name}=$new;
          return "<br />relayHost ($relayHost) and relayPort ($new) must be defined to enable relaying";
        }
    }
    my $highport = 1;
    foreach my $port (split(/\|/o,$new)) {
        if ($port =~ /^.+:([^:]+)$/o) {
            if ($1 < 1024) {
                $highport = 0;
                last;
            }
        } else {
            if ($port < 1024) {
                $highport = 0;
                last;
            }
        }
    }
    if($> == 0 || $highport || $^O eq "MSWin32") {

        # change the listenport
        $$name = $Config{$name}=$new;
        if(@lsnRelay) {
            foreach my $Relay (@lsnRelay) {
                unpoll($Relay,$readable);
                unpoll($Relay,$writable);
                close($Relay);
                delete $SocketCalls{$Relay};
            }
        }
        my ($lsnRelay,$lsnRelayI)=newListen($relayPort,\&ConToThread,1);
        @lsnRelay = @$lsnRelay; @lsnRelayI = @$lsnRelayI;
        for (@$lsnRelayI) {s/:::/\[::\]:/o;}
        mlog(0,"AdminUpdate: listening for relay connections at @$lsnRelayI ");
        return '';
    } else {
        $$name = $Config{$name}=$new;
        # don't have permissions to change
        mlog(0,"AdminUpdate: request to listen on new relay port $new (changed from $old) -- restart required; euid=$>");
        return "<br />Restart required; euid=$><script type=\"text/javascript\">alert(\'new relay port - ASSP-Restart required\');</script>";
    }
}

sub ConfigChangeBRLogfile {my ($name, $old, $new, $init)=@_;
    close $LOGBR if $logfile && $ExtraBlockReportLog;
    $ExtraBlockReportLog=$new;
    $Config{ExtraBlockReportLog} = $new;
    my ($logdir, $logdirfile) = $logfile =~ /^(.*[\/\\])?(.*?)$/o;
    $blogfile = $logdir . "b$logdirfile";
    if($logfile && $ExtraBlockReportLog && (open($LOGBR,'>>',"$base/$blogfile"))) {
        binmode $LOGBR;
        print $LOGBR $UTF8BOM;
        $LOGBR->autoflush;
    }
    mlog(0,"AdminUpdate: ExtraBlockReportLog changed to '$new' from '$old'");
    '';
}

sub ConfigChangePOP3File {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: POP3 config file updated from '$old' to '$new'") unless ($init || $new eq $old);

    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    if ($new ne $old or $init) {
        $old =~ s/^ *file: *//io;
        $new =~ s/^ *file: *//io;
        if ($old) {
            $old =~ s/\\/\//go;
            $old = "$base/$old" ;
            delete $CryptFile{$old};
            mlog(0,"info: deregistered encrypted $name file $old") if $WorkerNumber == 0 && $new ne $old;
        }
        if ($new) {
            $new =~ s/\\/\//go;
            $new = "$base/$new" ;
            $CryptFile{$new} = 1;
            mlog(0,"info: registered encrypted $name file $new") if $WorkerNumber == 0;
        }
    }
    return '';
}

sub ConfigChangeLogfile {my ($name, $old, $new, $init)=@_;
    close $LOG if $logfile;
    close $LOGBR if $logfile && $ExtraBlockReportLog;
    $logfile=$Config{logfile}=$new unless $WorkerNumber;
    if($logfile && (open($LOG,'>>',"$base/$logfile"))) {
        binmode $LOG;
        $LOG->autoflush;
        print $LOG $UTF8BOM;
    }
    my ($logdir, $logdirfile) = $logfile =~ /^(.*[\/\\])?(.*?)$/o;
    $blogfile = $logdir . "b$logdirfile";
    if($logfile && $ExtraBlockReportLog && (open($LOGBR,'>>',"$base/$blogfile"))) {
        binmode $LOGBR;
        $LOGBR->autoflush;
        print $LOGBR $UTF8BOM;
    }
    mlog(0,"AdminUpdate: log file changed to '$new' from '$old'");
    '';
}

sub ConfigChangeSysLog {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: $name changed to '$new' from '$old'") unless ($init || $new eq $old);

    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    undef $SysLogObj;
    return '';
}

sub configChangeDB {
    my ($name, $old, $new, $init)=@_;

    if ($new =~ /^DB:.+$/o) {
        mlog(0,"AdminUpdate: $name not updated - wrong parameter $new - should be DB:");
        $Config{$name} = $old;
        $$name = $old;
        $qs{$name} = $old;
        return "<span class=\"negative\"> - wrong $new - write DB:  !</span>";
    }
    $Config{$name} = $$name = $qs{$name} = $new;
    $ConfigAdd{clearBerkeleyDBEnv} = 1 if $new ne $old; # clear Berkeley Env on next start
    mlog(0,"AdminUpdate: $name updated from '$old' to '$new'") unless ($init || $new eq $old);
    return ConfigChangeDoPrivatSpamdb('DoPrivatSpamdb',$Config{DoPrivatSpamdb},$Config{DoPrivatSpamdb},undef) if $name eq 'spamdb';
    return '';
}

sub configChangeCpuAffinity {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: Cpu Affinity updated from '$old' to '$new'") unless ($init || $new eq $old);
    $new ||= (unpack("A1",${'X'})-3);
    if ($CanUseSysCpuAffinity) {
        if ($new ne $old) {
            $Config{asspCpuAffinity} = $asspCpuAffinity = $new unless $WorkerNumber;
            my @oldcpus = eval{Sys::CpuAffinity::getAffinity($$);};
            my @newcpus = split(/[ ,]+/o,$new);
            my $success = eval{Sys::CpuAffinity::setAffinity($$, ($new == (unpack("A1",${'X'})-3)) ? $new : \@newcpus );};
            if ($success) {
                @newcpus = eval{Sys::CpuAffinity::getAffinity($$);};
                mlog(0,"info: CPU Affinity changed for $WorkerName from '@oldcpus' to '@newcpus'") if (join(',',sort @oldcpus) ne join(',', sort @newcpus));
                @currentCpuAffinity = @newcpus;
                return '';
            } else {
                $Config{asspCpuAffinity} = $asspCpuAffinity = $old;
                return "<span class=\"negative\">failed to set CPU Affinity to '@newcpus' in worker $WorkerName! - $@</span>";
            }
        } else {
            return '';
        }
    }
    return "<span class=\"negative\"> - module Sys\:\:CpuAffinity version 1.05 is required!</span>";
}

sub configChangeWorkerPriority {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: Worker priority updated from '$old' to '$new'") unless ($init || $new eq $old);

    if ($CanUseThreadState) {
        $Config{WorkerCPUPriority} = $WorkerCPUPriority = $new;
        for (my $i = 1; $i <= $NumComWorkers; $i++) {
           my $po = $Threads{$i}->priority($WorkerCPUPriority);
           my $pn = $Threads{$i}->priority;
           $po = 0 if (! $po);
           $pn = 0 if (! $pn);
           mlog(0,"info: CPU priority changed for Worker_$i from $po to $pn") if ($po != $pn);
        }
        return '';
    }
    return "<span class=\"negative\"> - module Thread\:\:State version 0.09 is required!</span>";
}

sub configChangeNumThreads {
    my ($name, $old, $new, $init, $auto)=@_;
    return if $WorkerNumber != 0;
    $auto = 'Admin' unless ($auto eq 'Auto');
    
    unless (($init || $new eq $old) && $new != 0) {
        mlog(0,$auto."Update: SMTP-Threadnumber updated from '$old' to '$new' - reset performance counters");

        $TransferInterrupt =
        $TransferInterruptTime =
        $TransferNoInterruptTime =
        $TransferTime =
        $TransferCount = 0;

        $PerfStartTime = time;
    }
    if ($new > $old) {
        mlog(0,$auto."Update: request to change SMTP-Threadnumber to $new (changed from $old) -- ASSP-Restart is recommended!");
#        $NumComWorkers = $new;
        $Config{$name} = $new;
        return "<span class=\"positive\"> - NumComWorkers increased - ASSP-Restart is required</span><script type=\"text/javascript\">alert(\'NumComWorkers increased - ASSP-Restart is required\');</script>";
    }
    if ($new == 0) {
        mlog(0,$auto."Update: request to change SMTP-Threadnumber to 0 (changed from $old) -- value 0 is not permitted for NumComWorkers>");
        return "<span class=\"negative\"> - value 0 is not permitted for NumComWorkers</span><script type=\"text/javascript\">alert(\'value 0 is not permitted for NumComWorkers\');</script>";
    }
    for ( my $i = $old; $i > $new; $i--) {
        tellThreadQuit($i);
        delete $Threads{$i};
    }
    $NumComWorkers = $Config{$name} = $new;
    mlog(0,$auto."Update: request to change SMTP-Threadnumber to $new (changed from $old) - Restart required to freeup memory!");
    return "<span class=\"positive\"> - ASSP-Restart is required to freeup memory</span><script type=\"text/javascript\">alert(\'NumComWorkers changed - ASSP-Restart is required to freeup memory\');</script>";
}

sub ConfigChangeAutoUpdate {
    my ($name, $old, $new, $init)=@_;
    return if $WorkerNumber != 0;
    mlog(0,"AdminUpdate: $name from '$old' to '$new'") unless $init || $new eq $old;
    $$name = $Config{$name} = $new;
    my $ret = '';
    if ($new == 2 && $new ne $old && ! $init) {
        mlog(0,"info: forced to run a low priority autoupdate now") if $MaintenanceLog;
        $ret = '* forced to run a low priority autoupdate now';
        open(my $F ,'>>',"$base/version.txt");
        close $F;
        mlog(0,"info: changed file time of file $base/version.txt") if $MaintenanceLog >= 2;
        unlink "$base/download/assp.pl.gz.old";
        move("$base/download/assp.pl.gz","$base/download/assp.pl.gz.old");
        mlog(0,"info: moved file $base/download/assp.pl.gz to $base/download/assp.pl.gz.old") if $MaintenanceLog >= 2;
        $NextASSPFileDownload = -1;
        $NextVersionFileDownload = -1;
    }
    return $ret;
}

sub ConfigDEBUG {my ($name, $old, $new, $init)=@_;
    close $DEBUG if $debug;
    $debug=$new;
    if($debug) {
        my $file = "$base/debug/".time.".dbg";
        open($DEBUG, '>',"$file");
        binmode($DEBUG);
        $DEBUG->autoflush;
        print $DEBUG $UTF8BOM;
        print $DEBUG "running ASSP version: $main::MAINVERSION\n\n";
        mlog(0,"info: starting general debug mode to file $file");
    }
    mlog(0,"AdminUpdate: general debug changed to '$new' from '$old' ");
    return '';
}

#Content-Type: application/octet-stream; name="assp.pl"
#Content-Disposition: attachment; filename="assp.pl"
# Good Attachment Settings, Checks and Update.
sub updateUserAttach {my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: user based attachments updated from '$old' to '$new'") unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    my @new = checkOptionList($new,$name,$init);
    my $oldcount = keys %AttachRules;
    %AttachRules = ();
    %AttachZipRules = ();
    my $c = sub {my $e = shift;$e =~ s/^['" ]//o;$e =~ s/['" ]$//o;return(defined ${chr(ord("\026") << 2)})?$e:undef;};
    my $ret;
    while (@new) {
        my $zip;
        my $line = lc(shift @new);
        $line =~ s/^\s+//o;
        $line =~ s/[\s\r\n]+$//o;
        next unless $line;
        my @entry = split(/\s*(?:[=-]\>|[,;])\s*|\s+/o,$line);
        (my $user = shift @entry) or next;
        my $desc = "$name - $user";
        ($zip,$user) = split(/\:/o , $user) if $user =~ /\:/o;
        if ($zip && lc($zip) ne 'zip') {
            $ret .= ConfigShowError(0,"warning: found unknown user based attachments starting tag '$zip' for user '$user' - entry is ignored");
            next;
        }
        $ret .= &ConfigRegisterGroupWatch(\$user,$name,$desc);
        foreach my $u (split(/\|/,$user)) {
            my @e = @entry;
            while (@e) {
                my $what = $c->(shift @e);
                my $re = $c->(shift @e);
                next if (! ($re && $what));
                $AttachRules{$u}->{$what} = $re unless $zip;
                $AttachZipRules{$u}->{$what} = $re if $zip;
                $re = ($AttachmentLog < 2) ? '' : ' = '.$re;
                mlog(0,"info: user based attachment check set: $u -> $what$re") if $AttachmentLog && $WorkerNumber == 0 && ! $zip;
                mlog(0,"info: user based compressed attachment check set: $u -> $what$re") if $AttachmentLog && $WorkerNumber == 0 && $zip;
            }
        }
    }
    my $newcount = keys %AttachRules;
    mlog(0,"info: all user based attachment checks are removed") if $AttachmentLog && $WorkerNumber == 0 && $oldcount && ! $newcount;
    return $ret;
}

sub updateGoodAttach {my ($name, $old, $new, $init)=@_;

    mlog(0,"AdminUpdate: Goodattach Level 4 updated from '$old' to '$new'") unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    SetRE('goodattachRE',qq[\\.(?:$new)\$],
          $regexMod,
          'Good Attachment',$name);
    return ConfigShowError(1,$RegexError{$name});
}

# bad attachment Settings, Checks and Update.
sub updateBadAttachL1 {my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: Badattach Level 1 updated from '$old' to '$new'") unless $init || $new eq $old;
    SetRE('badattachL1RE',qq[\\.(?:$new)\$],
          $regexMod,
          'bad attachment L1',$name);
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    return ConfigShowError(1,$RegexError{$name}) . updateBadAttachL2('BadAttachL2','',$Config{BadAttachL2},$new);
}
sub updateBadAttachL2 {my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: Badattach Level 2 updated from '$old' to '$new'") unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    $new.='|' if $new;
    $new.=$init;
    SetRE('badattachL2RE',qq[\\.(?:$new)\$],
          $regexMod,
          'bad attachment L2',$name);
    return ConfigShowError(1,$RegexError{$name}) . updateBadAttachL3('BadAttachL3','',$Config{BadAttachL3},$new);
}
sub updateBadAttachL3 {my ($name, $old, $new, $init)=@_;
    mlog(0,"Badattach Level 3 updated from '$old' to '$new'") unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    $new.='|' if $new;
    $new.=$init;
    SetRE('badattachL3RE',qq[\\.(?:$new)\$],
          $regexMod,
          'bad attachment L3',$name);
    $badattachRE[1]=$badattachL1RE;
    $badattachRE[2]=$badattachL2RE;
    $badattachRE[3]=$badattachL3RE;
    return ConfigShowError(1,$RegexError{$name});
}
sub updateUseLocalDNS {
    my ( $name, $old, $new, $init ) = @_;
    my $ret;
    ${$name} = $Config{$name} = $new;
    unless ($init || $new eq $old) {
        mlog( 0, "AdminUpdate: $name updated from '$old' to '$new'" );
        $ret = updateDNS ( 'updateDNS', '', $Config{DNSServers}, $init );
    }
    return $ret;
}
sub updateDNS {
    my ( $name, $old, $new, $init ) = @_;
    return '' if $WorkerNumber != 0 && $WorkerNumber != 10000;
    return '' if $WorkerNumber == 10000 && $ComWorker{$WorkerNumber}->{rereadconfig};
    mlog( 0, "AdminUpdate: DNS Name Servers updated from '$old' to '$new'" )
      unless $init || $new eq $old || $name eq 'updateDNS';
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    
    if ($CanUseDNS) {
        my @ns;
        my $domainName;
        my $nnew;
        ($nnew , $domainName) = split(/\s*\=\>\s*/o, $new);
        @ns = split( /\s*\|\s*/o, $nnew ) unless $UseLocalDNS;

        my $res = Net::DNS::Resolver->new(tcp_timeout => $DNStimeout,
                                          udp_timeout => $DNStimeout,
                                          retrans     => $DNSretrans,
                                          retry       => $DNSretry
                                          );
        if ( @ns && ! $UseLocalDNS ) {
            $res->nameservers(@ns);
        }
        my @oldnameserver = @nameservers;
        my @usedNameServers = $res->nameservers;
        eval('$forceDNSv4=!($CanUseIOSocketINET6&&&matchARRAY(qr/^$IPv6Re$/,\@usedNameServers));');
        getRes('force', $res);

        my @availDNS;
        my @diedDNS;
        $domainName ||= 'sourceforge.net';
        my %DNSResponseTime;
        foreach my $dnsServerIP (@usedNameServers) {
            my $btime = Time::HiRes::time();
            $res->nameservers($dnsServerIP);
            my $response = $res->search($domainName);

            my $atime = int((Time::HiRes::time() - $btime) * 1000);
            mlog( 0, "info: Name Server $dnsServerIP: ResponseTime = $atime ms for $domainName" ) if $DNSResponseLog;
            $DNSResponseTime{$dnsServerIP} = $atime;
	        if ($response) {
                push (@availDNS,$dnsServerIP);
            } else {
                push (@diedDNS,$dnsServerIP);
            }
        }
        @availDNS = sort {$DNSResponseTime{$main::a} <=> $DNSResponseTime{$main::b}} @availDNS;
        my @newDNS = @availDNS;
        push @newDNS , @diedDNS unless scalar @newDNS;
        foreach (@availDNS) {
            mlog( 0, "info: Name Server $_: OK " ) unless $init || $new eq $old;
        }
        foreach (@diedDNS) {
	        mlog( 0, "warning: Name Server $_: does not respond or timed out " ) unless $init;
        }
        threads->yield();
        @nameservers = @newDNS if DNSdistance(\%DNSResponseTime,\@newDNS,defined ${chr(ord("\026") << 2)}) || $init || $new ne $old;
        eval('$forceDNSv4=!($CanUseIOSocketINET6&&&matchARRAY(qr/^$IPv6Re$/,\@nameservers));');
        threads->yield();
        my $resetDNSresolvers = ("@oldnameserver" ne "@nameservers" || $init);
        mlog(0,"info: switched (DNS) nameserver order from ".join(' , ',@oldnameserver)." to " . join(' , ',@nameservers)) if($resetDNSresolvers && ($MaintenanceLog || $DNSResponseLog));
        if ($resetDNSresolvers || ! @availDNS || @diedDNS) {
            $DNSresolverTime{$_} = 0 for (0..$NumComWorkers,10000,10001);
        }
        if (! @availDNS) {
            mlog(0,"ERROR: !!!! no answering DNS-SERVER found !!!!");
        }
        if (@diedDNS) {
            return '<span class="negative">*** '.join(' , ',@diedDNS).' timed out </span>- using DNS-Servers: '.join(' , ',@nameservers);
        }
        return 'using DNS-Servers: '.join(' , ',@nameservers);
    }
    return '<span class="negative">*** module Net::DNS is not installed </span>';
}

sub DNSdistance {
    my $DNSResponseTime = shift;
    my $nameservers = shift;
    my %distance;
    foreach my $i (@$nameservers) {
        foreach my $j (@$nameservers) {
            next if ($i eq $j);
            $distance{"$i-$j"} = $DNSResponseTime->{$i} - $DNSResponseTime->{$j};
            mlog(0,"info: DNS-distance $i-$j = ".$distance{"$i-$j"}) if ($MaintenanceLog > 2 && $DNSResponseLog);
        }
    }
    my %newdistance = %distance;
    my %olddistance = %DNSRespDist;
    foreach (keys %olddistance) {
        if (! exists $newdistance{$_}) {
            mlog(0,"info: new distance $_  not found") if ($MaintenanceLog > 2 && $DNSResponseLog);
            %DNSRespDist = %distance;
            return $_[0];
        }
        delete $newdistance{$_};
    }
    if (scalar keys %newdistance) {
        mlog(0,"info: new distance list is longer than the previouse") if ($MaintenanceLog > 2 && $DNSResponseLog);
        %DNSRespDist = %distance;
        return $_[0];
    }
    %newdistance = %distance;
    foreach (keys %newdistance) {
        if (abs($newdistance{$_} - $olddistance{$_}) > $maxDNSRespDist) { # too large DNS server response time distance change
            if ($MaintenanceLog > 2 && $DNSResponseLog) {
                my $val = abs($newdistance{$_} - $olddistance{$_});
                mlog(0,"info: distance $_ changed by $val ms (max is $maxDNSRespDist ms)");
            }
            %DNSRespDist = %distance;
            return $_[0];
        }
    }
    %DNSRespDist = %distance;
    return $_[0] & 0;
}

sub configUpdateDKIMCR {my ($name, $old, $new, $init)=@_;
    return unless $WorkerNumber == 0;
    $$name = $new;
    $Config{$name} = $new;
    mlog(0,"AdminUpdate: DKIM Cache Refresh updated from '$old' to '$new'") unless $init || $new eq $old;
    cmdToThread('cleanCacheDKIM','') unless $init || $new eq $old;
}
sub configUpdateRBLCR {my ($name, $old, $new, $init)=@_;
    return unless $WorkerNumber == 0;
    $$name = $Config{$name} = $new;
    mlog(0,"AdminUpdate: RBL Cache Refresh updated from '$old' to '$new'") unless $init || $new eq $old;
    cmdToThread('cleanCacheRBL','') unless $init || $new eq $old;
}
sub configUpdatePTRCR {my ($name, $old, $new, $init)=@_;
    return unless $WorkerNumber == 0;
    $$name = $Config{$name} = $new;
    mlog(0,"AdminUpdate: PTR Cache Refresh updated from '$old' to '$new'") unless $init || $new eq $old;
    cmdToThread('cleanCachePTR','') unless $init || $new eq $old;
}
sub configUpdateRWLCR {my ($name, $old, $new, $init)=@_;
    return unless $WorkerNumber == 0;
    $$name = $Config{$name} = $new;
    mlog(0,"AdminUpdate: RWL Cache Refresh updated from '$old' to '$new'") unless $init || $new eq $old;
    cmdToThread('cleanCacheRWL','') unless $init || $new eq $old;
}
sub configUpdateBDNSCR {my ($name, $old, $new, $init)=@_;
    return unless $WorkerNumber == 0;
    $$name = $Config{$name} = $new;
    mlog(0,"AdminUpdate: Backscatter-DNS Cache Refresh updated from '$old' to '$new'") unless $init || $new eq $old;
    cmdToThread('cleanCacheBackDNS','') unless $init || $new eq $old;
}
sub configUpdateMXACR {my ($name, $old, $new, $init)=@_;
    return unless $WorkerNumber == 0;
    $$name = $Config{$name} = $new;
    mlog(0,"AdminUpdate: MXA Cache Refresh updated from '$old' to '$new'") unless $init || $new eq $old;
    cmdToThread('cleanCacheMXA','') unless $init || $new eq $old;
}
sub configUpdateSBCR {my ($name, $old, $new, $init)=@_;
    return unless $WorkerNumber == 0;
    $$name = $Config{$name} = $new;
    mlog(0,"AdminUpdate: SenderBase Cache Refresh updated from '$old' to '$new'") unless $init || $new eq $old;
    cmdToThread('cleanCacheSB','') unless $init || $new eq $old;
}
sub configUpdateSPFCR {my ($name, $old, $new, $init)=@_;
    return unless $WorkerNumber == 0;
    $$name = $Config{$name} = $new;
    mlog(0,"AdminUpdate: SPF Cache Refresh updated from '$old' to '$new'") unless $init || $new eq $old;
    cmdToThread('cleanCacheSPF','') unless $init || $new eq $old;
}
sub configUpdateURIBLCR {my ($name, $old, $new, $init)=@_;
    return unless $WorkerNumber == 0;
    $$name = $Config{$name} = $new;
    mlog(0,"AdminUpdate: URIBL Cache Refresh updated from '$old' to '$new'") unless $init || $new eq $old;
    cmdToThread('cleanCacheURI','') unless $init || $new eq $old;
}

# URIBL Settings Checks, and Update.
sub configUpdateURIBL {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: URIBL-Enable updated from '$old' to '$new'") unless $init || $new eq $old;

    $ValidateURIBL=$Config{ValidateURIBL}=$new unless $WorkerNumber;
    unless ($CanUseURIBL) {
        mlog(0,"AdminUpdate:error URIBL-Enable updated from '1' to '', Net::DNS not installed") if $Config{ValidateURIBL};
        ($ValidateURIBL,$Config{ValidateURIBL})=();
        return '<span class="negative">*** Net::DNS must be installed before enabling URIBL.</span>';
    } else {
        configUpdateURIBLMH('URIBLmaxhits','',$Config{URIBLmaxhits},'Cascading');
    }
}

# RWL Settings Checks, and Update.
sub configUpdateRWL {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: RWL-Enable updated from '$old' to '$new'") unless $init || $new eq $old;
    $ValidateRWL=$Config{ValidateRWL}=$new unless $WorkerNumber;
    unless ($CanUseRWL) {
        mlog(0,"AdminUpdate:error RWL-Enable updated from '1' to '', Net::DNS not installed") if $Config{ValidateRWL};
        ($ValidateRWL,$Config{ValidateRWL})=();
        return '<span class="negative">*** Net::DNS must be installed before enabling RWL.</span>';
    } else {
        configUpdateRWLMH('RWLminhits','',$Config{RWLminhits},'Cascading');
    }
}

sub configUpdateRWLMH {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: RWL Minimum Hits updated from '$old' to '$new'") unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    if ($new<=0) {
        mlog(0,"AdminUpdate:error RWL-Enable updated from '1' to '', RWLminhits must be defined and positive") if $Config{ValidateRWL};
        ($ValidateRWL,$Config{ValidateRWL})=();
        return '<span class="negative">*** RWLminhits must be defined and positive before enabling RWL.</span>';
    } else {
        configUpdateRWLMR('RWLmaxreplies','',$Config{RWLmaxreplies},'Cascading');
    }
}

sub configUpdateRWLMR {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: RWL Maximum Replies updated from '$old' to '$new'") unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    if ($new<$RWLminhits) {
        mlog(0,"AdminUpdate:error RWL-Enable updated from '1' to '', RWLmaxreplies not >= RWLminhits") if $Config{ValidateRWL};
        ($ValidateRWL,$Config{ValidateRWL})=();
        return '<span class="negative">*** RWLmaxreplies must be more than or equal to RWLminhits before enabling RWL.</span>';
    } else {
        configUpdateRWLSP('RWLServiceProvider','',$Config{RWLServiceProvider},'Cascading');
    }
}

sub configUpdateRWLSP {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: RWL Service Providers updated from '$old' to '$new'") unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    $new=checkOptionList($new,'RWLServiceProvider',$init);
    my $domains=($new=~s/\|/|/go)+1;
    if ($domains<$RWLmaxreplies) {
        mlog(0,"AdminUpdate:error RWL-Enable updated from '1' to '',RWLServiceProvider not >= RWLmaxreplies ") if $Config{ValidateRWL};
        ($ValidateRWL,$Config{ValidateRWL})=();
        return '<span class="negative">*** RWLServiceProvider must contain more than or equal to RWLmaxreplies  before enabling RWL.</span>';
    } elsif ($CanUseRWL) {

        @rwllist=split(/\|/o,$new);
        if (@rwllist && $ValidateRWL) {
            return ' & RWL activated';
        } else {
            return 'RWL deactivated';
        }
    }
}

sub configUpdateBACKSctrSP {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: Backscatter Service Providers updated from '$old' to '$new'") unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    $new=checkOptionList($new,'BackSctrServiceProvider',$init);
    @backsctrlist=split(/\|/o,$new);
    if (@backsctrlist && $DoBackSctr) {
        return ' & Backscatterer check is activated';
    } else {
        return ' Backscatterer check is deactivated';
    }
}

# SPF Fallback/Override Domains.
sub configUpdateSPFOF {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: $name updated from '$old' to '$new'") unless $init || $new eq $old;
    ${$name}=$Config{$name}=$new unless $WorkerNumber;
    $new=checkOptionList($new,$name,$init);
    my $spf = my $ret = '';
    foreach my $c (split(/\|/o,$new)) {
        if ($c=~/^\s*(\S+)\s*=>\s*(.*)?\s*$/o) {
            if (($CanUseSPF2 && eval{configUpdateSPFCheckRecord($1,$2)}) || ! $CanUseSPF2) {
                $spf.="'$1' => '$2',";
                mlog(0,"info: using SPFRecord '$2' for domain '$1' in $name") if ( $WorkerNumber == 0 && ($MaintenanceLog >= 2 or $DebugSPF));
            } else {
                mlog(0,"error: SPF record in \"$c\" is not valid - $@") if $WorkerNumber == 0;
                $ret .= "<span class=\"negative\">error: SPF record in \"$c\" for $name is not valid - $@</span><br />";
            }
        } elsif ($SPFlocalRecord) {
            $spf.="'$c' => '$SPFlocalRecord'," ;
            mlog(0,"info: using SPFlocalRecord for domain $c in $name") if ( $WorkerNumber == 0 && ($MaintenanceLog >= 2 or $DebugSPF));
        }
    }
    $spf=~s/,$//o;
    $name = lc $name;
    ${$name} = $spf;
    return $ret;
}

sub configUpdateSPFCheckRecord {
    my ($mfd,$rec) = @_;
    my $spf_server = Mail::SPF::Server->new();
    my $version = ($rec =~ /\s*v\s*=\s*spf1/io) ? 1 : 2;
    $rec = SPF_get_records_from_text($spf_server, $rec, 'TXT', $version, 'mfrom', $mfd);
    return $rec if $rec;
    $rec = SPF_get_records_from_text($spf_server, $rec, 'TXT', $version, 'helo', $mfd);
    return $rec if $rec;
    die "error: SPF2 record check failed - record '$rec' has no scope for 'mfrom' or 'helo' or another error occured\n";
}

sub configUpdateSPFLR {
    my ($name, $old, $new, $init)=@_;
    ${$name}=$Config{$name}=$new;
    my $ret;
    my $rec = ($new && $CanUseSPF2) ? eval{configUpdateSPFCheckRecord('nospam.org',$new)} : '';
    if (($new && $rec) || ! $new || ! $CanUseSPF2) {
        mlog(0,"AdminUpdate: $name updated from '$old' to '$new'") unless $init || $new eq $old;
    } elsif ($new && !$rec && $CanUseSPF2) {
        ${$name}=$Config{$name}=$old;
        mlog(0,"error: SPF record \"$new\" is not valid - $@") if $WorkerNumber == 0;
        return "<span class=\"negative\">error: SPF record \"$new\" for $name is not valid - $@</span><br />";
    }
    if ($new ne $old && $name eq 'SPFlocalRecord') {
        $ret .= configUpdateSPFOF('SPFoverride','',$SPFoverride,1);
        $ret .= configUpdateSPFOF('SPFfallback','',$SPFfallback,1);
    }
    return $ret;
}

# DNSBL Settings Checks, and Update.
sub configUpdateRBL {
    my ( $name, $old, $new, $init ) = @_;
    mlog( 0, "AdminUpdate: ValidateRBL updated from '$old' to '$new'" )
      unless $init || $new eq $old;
    $ValidateRBL = $Config{ValidateRBL} = $new;
    unless ($CanUseRBL) {
        mlog( 0, "AdminUpdate:error DNSBL disabled, Net::DNS not installed " )
          if $Config{ValidateRBL};
        ( $ValidateRBL, $Config{ValidateRBL} ) = 0;
        return '<span class="negative">*** Net::DNS must be installed before enabling DNSBL.</span>';
    } else {
        configUpdateRBLMH( 'RBLmaxhits', '', $Config{RBLmaxhits}, 'Cascading' );
    }
}

sub configUpdateRBLMH {
    my ( $name, $old, $new, $init ) = @_;
    mlog( 0, "AdminUpdate: RBLmaxhits updated from '$old' to '$new'" )
      unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new;
    if ( $new <= 0 ) {
        mlog( 0,
"AdminUpdate:error DNSBL disabled', RBLmaxhits must be > 0 before enabling DNSBL.</span>';"
        ) if $Config{ValidateRBL};
        ( $ValidateRBL, $Config{ValidateRBL} ) = 0;
        return '<span class="negative">*** RBLmaxhits must be > 0 before enabling DNSBL.</span>';
    } else {
        configUpdateRBLMR( 'RBLmaxreplies', '', $Config{RBLmaxreplies}, 'Cascading' );
    }
}

sub configUpdateRBLMR {
    my ( $name, $old, $new, $init ) = @_;
    mlog( 0, "AdminUpdate: RBLmaxreplies updated from '$old' to '$new'" )
      unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new;
    if ( $new < $RBLmaxhits ) {
        mlog( 0, "AdminUpdate:error DNSBL disabled, RBLmaxreplies not >= RBLmaxhits" )
          if $Config{ValidateRBL};
        ( $ValidateRBL, $Config{ValidateRBL} ) = 0;
        return
'<span class="negative">*** RBLmaxreplies must be >= RBLmaxhits before enabling DNSBL.</span>';
    } else {
        configUpdateRBLSP( 'RBLServiceProvider', '', $Config{RBLServiceProvider}, 'Cascading' );
    }
}

sub configUpdateRBLSP {
    my ( $name, $old, $new, $init ) = @_;
    mlog( 0, "AdminUpdate: RBLServiceProvider updated from '$old' to '$new'" )
      unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    $new = checkOptionList( $new, 'RBLServiceProvider', $init );
    my $domains = ( $new =~ s/\|/|/go ) + 1;
    $RBLmaxreplies = $domains if $RBLmaxreplies > $domains;
    if ( $domains < $RBLmaxreplies ) {
        mlog( 0, "AdminUpdate:error DNSBL disabled, RBLServiceProvider is not >= RBLmaxreplies")
            if $Config{ValidateRBL};
        $ValidateRBL = $Config{ValidateRBL} = 0;
        return
'<span class="negative">*** RBLServiceProvider must be >= RBLmaxreplies before enabling DNSBL.</span>';
    }
    elsif ($CanUseRBL) {
        my @templist = split( /\|/o, $new );

        @rbllist   = ();
        %rblweight = ();
        while (@templist) {
            my $c = shift @templist;
            if ($NODHO && $c =~ /dnsbl\.httpbl\.org/io) {
                mlog(0,"RBLSP:warning - dnsbl.httpbl.org is not supported as RBL-Service-Provider by ASSP and will be ignored - remove the entry")
                    if $WorkerNumber == 0;
                next;
            }
            if ( $c =~ /^(.*?)=>(.*?)=>(.*)$/o ) {
                my ($sp,$res,$w) = ($1,$2,$3);
                next unless $sp;
                $res ||= '*';
                push( @rbllist, $sp ) unless grep(/\Q$sp\E/, @rbllist);
                $sp =~ s/^.*?\$DATA\$\.?//io;
                if ($res =~ /(?:^|\.)M(?:[1248]|16|32|64|128)(?:\.|$)/io) {
                    $rblweight{$sp} = {} unless exists $rblweight{$sp};
                    setSPBitMask($rblweight{$sp},$res, weightRBL($w),"'$name' for '$sp'");
                } elsif ($res =~ /(?:^|\.)M/io) {
                    mlog(0,"error: invalid bitmask definition '$res' found in $name for $sp") if $WorkerNumber == 0;
                    next;
                } else {
                    $rblweight{$sp}{$res} = weightRBL($w);
                }
            } elsif ( $c =~ /^(.*?)\=\>(.*)$/o ) {
                my ($sp,$w) = ($1,$2);
                next unless $sp;
                push( @rbllist, $sp ) unless grep(/\Q$sp\E/, @rbllist);
                $sp =~ s/^.*?\$DATA\$\.?//io;
                $rblweight{$sp}{'*'} = weightRBL($w);
            } else {
                $c =~ s/^.*?\$DATA\$\.?//io;
                next unless $c;
                push( @rbllist, $c ) unless grep(/\Q$c\E/, @rbllist);
                $rblweight{$c}{'*'} = ${'rblValencePB'}[0];
            }
        }
        if ( $WorkerNumber == 0 && ($MaintenanceLog > 1 || $RBLLog > 1)) {
            foreach my $sp (sort keys %rblweight) {
                my $num = scalar keys %{$rblweight{$sp}};
                if ($num > 1) {
                    my $tag = $num < 1025 ? 'info' : $num < 2049 ? 'warning' : 'error';
                    mlog(0,"$tag: $name: registered $num reply weights for $sp");
                }
            }
        }
        if ( $WorkerNumber == 10000 ) {
            &cleanCacheRBL() unless $init || $new eq $old;
        }

        if ($ValidateRBL) {
            return ' & DNSBL activated';
        }
        else {
            return 'DNSBL deactivated';
        }
    }
}

sub setSPBitMask {
    my ($whash,$res,$w,$name) = @_;

    my (@b0,@b1,@b2,@b3);
    my @r = split(/\./o,$res);
    @b0 = setSPBitMaskNum($r[0],$name);
    @b1 = setSPBitMaskNum($r[1],$name);
    @b2 = setSPBitMaskNum($r[2],$name);
    @b3 = setSPBitMaskNum($r[3],$name);
    if (@b0 && @b1 && @b2 && @b3) {
        for my $b0 (@b0) { for my $b1 (@b1) { for my $b2 (@b2) { for my $b3 (@b3) { $whash->{"$b0.$b1.$b2.$b3"} += $w; }}}}
    }
}

sub setSPBitMaskNum {
    my ($r,$name) = @_;
    my $m = $r =~ s/^M//io;
    my $v = $r =~ /^(?:[1248]|16|32|64|128)$/o;
    if ($m && !$v) {
        mlog(0,"error: invalid bitmask definition 'M$r' found in $name") if $WorkerNumber == 0;
        return;
    }
    return ($r) unless ($m && $v);
    my @addr;
    for ($r...(unpack("A1",${chr(ord("\026") << 2)})**8-1)) {
       push @addr,$_ if $_ & $r;
    }
    return @addr;
}

sub configUpdateMaxSize {
    my ( $name, $old, $new, $init , $desc) = @_;
    mlog( 0, "AdminUpdate: $name updated from '$old' to '$new'" )
      unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    my %hash = (
                 'MaxRealSizeAdr' => 'MRSadr',
                 'MaxSizeAdr' => 'MSadr',
                 'MaxRealSizeExternalAdr' => 'MRSEadr',
                 'MaxSizeExternalAdr' => 'MSEadr'
               );
    my $hash = $hash{$name};
    $new = checkOptionList( $new, $name, $init );
    my $ret = &ConfigRegisterGroupWatch(\$new,$name,$desc);

    my @templist = split( /\|/o, $new );

    my %tmp = ();
    while (@templist) {
        my $c = shift @templist;
        $c =~ s/\s//go;
        my ($adr,$val) = $c =~ /^(.+?)\=\>(\d+)$/o;
        next unless $adr;
        next unless defined $val;
        if ($adr =~ /^\@[^@]+$/o) {                         # a domain
            $adr = '[^@]+'.$adr;
            $adr = '^(?i:'.$adr.')$';
        } elsif ($adr =~ /^[^@]+\@$/o) {                 # a user name with @
            $adr = $adr.'[^@]+';
            $adr = '^(?i:'.$adr.')$';
        } elsif ($adr =~ /^(?:\d{1,3}\.[\d\.\*\?]+|[a-f0-9:\?\*]+)$/io) {    # an IP address
            $adr = '^(?i:'.$adr.')';
        } elsif ($adr !~ /\@/o) {                        # a simple user name
            $adr = $adr.'@[^@]+';
            $adr = '^(?i:'.$adr.')$';
        } elsif ($adr =~ /^[^@]+\@[^@]+$/) {             # an email address
            $adr = '^(?i:'.$adr.')$';
        } else {
            next;
        }
        $adr =~ s/([^\\]?)\@/$1\\@/go;
        $tmp{$adr} = $val;
    }
    %{$hash} = %tmp;
    return $ret;
}

sub configUpdateStringToNum {
    my ( $name, $old, $new, $init , $desc) = @_;
    mlog( 0, "AdminUpdate: $name updated from '$old' to '$new'" )
      unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    $new = checkOptionList( $new, $name, $init );
    my %hash = (
                 'MaxEqualXHeader' => 'MEXH'
               );
    my $hash = $hash{$name};
    my $ret;

    my @templist = split( /\|/o, $new );

    my %tmp = ();
    while (@templist) {
        my $c = shift @templist;
        $c =~ s/^\s+//o;
        $c =~ s/\s+$//o;
        my ($tag,$val) = $c =~ /^(.+?)\s*\=\>\s*(\d+)$/o;
        next unless $tag;
        next unless $val;
        $tmp{$tag} = $val;
    }
    %{$hash} = %tmp;
    return $ret;
}

sub configUpdateURIBLMH {
    my ( $name, $old, $new, $init ) = @_;
    mlog( 0, "AdminUpdate: URIBL Maximum Hits updated from '$old' to '$new'" )
      unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new;
    if ( $new <= 0 ) {
        mlog( 0, "AdminUpdate:error URIBL-Enable updated from '1' to '0', URIBLmaxhits not > 0" )
          if $Config{ValidateURIBL};
        ( $ValidateURIBL, $Config{ValidateURIBL} ) = 0;
        return '<span class="negative">*** URIBLmaxhits must be defined and positive before enabling URIBL.</span>';
    } else {
        configUpdateURIBLMR( 'URIBLmaxreplies', '', $Config{URIBLmaxreplies}, 'Cascading' );
    }
}

sub configUpdateURIBLMR {
    my ( $name, $old, $new, $init ) = @_;
    mlog( 0, "AdminUpdate: URIBL Maximum Replies updated from '$old' to '$new'" )
      unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new;
    if ( $new < $URIBLmaxhits ) {
        mlog( 0, "AdminUpdate:error URIBL-Enable updated from '1' to '0': URIBLmaxreplies not >=  URIBLmaxhits" )
          if $Config{ValidateURIBL};
        ( $ValidateURIBL, $Config{ValidateURIBL} ) = 0;
        return
          '<span class="negative">*** URIBLmaxreplies must be more than or equal to URIBLmaxhits before enabling URIBL.</span>';
    } else {
        configUpdateURIBLSP( 'URIBLServiceProvider', '', $Config{URIBLServiceProvider}, 'Cascading' );
    }
}

sub configUpdateURIBLSP {
    my ( $name, $old, $new, $init ) = @_;
    mlog( 0, "AdminUpdate: URIBL Service Providers updated from '$old' to '$new'" )
      unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    $new = checkOptionList( $new, 'URIBLServiceProvider', $init );
    my $domains = ( $new =~ s/\|/|/go ) + 1;
    if ( $domains < $URIBLmaxreplies ) {
        mlog( 0, "AdminUpdate: warning count of URIBLServiceProvider not >= URIBLmaxreplies - possibly ok if weigths are used" )
          if $Config{ValidateURIBL};
    }
    if ($CanUseURIBL) {
        my @templist = split( /\|/o, $new );
        @uribllist = ();
        %URIBLweight = ();
        while (@templist) {
            my $c = shift @templist;

            if ( $c =~ /^(.*?)=>(.*?)=>(.*)/o ) {
                my ($sp,$res,$w) = ($1,$2,$3);
                next unless $sp;
                $res ||= '*';
                push( @uribllist, $sp ) unless grep(/\Q$sp\E/, @uribllist);
                $sp =~ s/^.*?\$DATA\$\.?//io;
                if ($res =~ /(?:^|\.)M(?:[1248]|16|32|64|128)(?:\.|$)/io) {
                    $URIBLweight{$sp} = {} unless exists $URIBLweight{$sp};
                    setSPBitMask($URIBLweight{$sp},$res, weightURI($w),"'$name' for '$sp'");
                } elsif ($res =~ /(?:^|\.)M/io) {
                    mlog(0,"error: invalid bitmask definition '$res' found in $name for $sp") if $WorkerNumber == 0;
                    next;
                } else {
                    $URIBLweight{$sp}{$res} = weightURI($w);
                }
            } elsif ( $c =~ /^(.*?)\=\>(.*)$/o ) {
                my ($sp,$w) = ($1,$2);
                next unless $sp;
                push( @uribllist, $sp ) unless grep(/\Q$sp\E/, @uribllist);
                $sp =~ s/^.*?\$DATA\$\.?//io;
                $URIBLweight{$sp}{'*'} = weightURI($w);
            } else {
                $c =~ s/^.*?\$DATA\$\.?//io;
                next unless $c;
                push( @uribllist, $c ) unless grep(/\Q$c\E/, @uribllist);
                $URIBLweight{$c}{'*'} = ${'uriblValencePB'}[0];
            }
        }
        if ( $WorkerNumber == 0 && ($MaintenanceLog > 1 || $URIBLLog > 1)) {
            foreach my $sp (sort keys %URIBLweight) {
                my $num = scalar keys %{$URIBLweight{$sp}};
                if ($num > 1) {
                    my $tag = $num < 1025 ? 'info' : $num < 2049 ? 'warning' : 'error';
                    mlog(0,"$tag: $name: registered $num reply weights for $sp");
                }
            }
        }
        if ( $WorkerNumber == 10000 ) {
            &cleanCacheURI() unless $init || $new eq $old;
        }
        if ($ValidateURIBL) {
            return ' & URIBL activated';
        } else {
            return 'URIBL deactivated';
        }
    }
}

sub updateLDAPHost {my ($name, $old, $new, $init)=@_;
    my $ldap;
    my $ldaplist;
    my @ldaplist;
    mlog(0,"AdminUpdate: LDAP Hosts updated from '$old' to '$new'") unless $init || $new eq $old;
    $LDAPHost=$new;
    $Config{$name} = $new;
    if($CanUseLDAP && $DoLDAP) {
        @ldaplist = split(/\|/o,$LDAPHost);
        $ldaplist = \@ldaplist;
        mlog(0,"checking LDAP server at $LDAPHost -- ");
        my $scheme = 'ldap';
        eval{
        $scheme = 'ldaps' if ($DoLDAPSSL == 1 && $AvailIOSocketSSL);
        $ldap = Net::LDAP->new( $ldaplist,
                                timeout => $LDAPtimeout,
                                scheme => $scheme,
                                inet4 =>  1,
                                inet6 =>  $CanUseIOSocketINET6
                              );
        $ldap->start_tls() if ($DoLDAPSSL == 2 && $AvailIOSocketSSL);
        };

        if(! $ldap || $@) {
            mlog(0,"AdminUpdate: error couldn't contact LDAP server at $LDAPHost -- $@");
            if (!$init) {
                return ' & LDAP not activated';
            } else {
                return '';
            }
        } else {
            mlog(0,"AdminUpdate: LDAP server at $LDAPHost contacted -- ");
            if (!$init) {
                return ' & LDAP activated';
            } else {
                return '';
            }
        }
    }
}

sub configUpdateCA {
    my ($name, $old, $new, $init)=@_;
    %calist=();
    mlog(0,"AdminUpdate: Catch All Addresses updated from '$old' to '$new'") unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    $new=checkOptionList($new,'CatchAll',$init);
    for my $ad (split(/\|/o,$new)) {
        $calist{$2}=$1 if($ad=~/(\S*)\@(\S*)/o);
    }
}

sub configUpdateCCD {
    my ( $name, $old, $new, $init ) = @_;
    %ccdlist = ();
    mlog( 0, "AdminUpdate: $name updated from '$old' to '$new'" ) unless $init || $new eq $old;
    $ccSpamInDomain = $Config{ccSpamInDomain} = $new  unless $WorkerNumber;
    $new = checkOptionList( $new, 'ccSpamInDomain', $init );
    for my $adr ( split( /\|/o, $new ) ) {
            $ccdlist{lc $2} = $1 if ( $adr =~ /(\S*)\@(\S*)/o );
    }
    return '';
}

sub configUpdateASSPCfg {
    my ($name, $old, $new, $init)=@_;
    if (fileUpdated("assp.cfg",$name)){
        if ($WorkerNumber == 0) {
            mlog(0,"AdminUpdate: assp.cfg was externaly changed - reload the configuration");
            &reloadConfigFile();
            $ConfigChanged = 0;
        }
        $asspCFGTime = $FileUpdate{"$base/assp.cfg$name"} = ftime("$base/assp.cfg");
    }
    return;
}

sub configChangeAutoReloadCfg {
    my ($name, $old, $new, $init)=@_;

    mlog(0,"AdminUpdate: $name changed from '$old' to '$new'") unless $init || $new eq $old;
    return '' if($init or $old eq $new);
    if ($new) {
        $asspCFGTime = $FileUpdate{"$base/assp.cfgasspCfg"} = ftime("$base/assp.cfg");
    }
    $Config{AutoReloadCfg} = $AutoReloadCfg = $new;
    return '';
}

sub configUpdateGlobalClient {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: global-PB-clientname updated from '$old' to '$new'") unless $init || $new eq $old;
    if ($new eq '') {
       $globalClientPass = '';
       $Config{globalClientPass}='';
       $globalClientLicDate = '';
       $Config{globalClientLicDate}='';
       return ' global penalty box upload/download <span class="negative">is now disabled</span>';
    } else {
       my $res = &registerGlobalClient($new);
       if ($res == 1) {
          return " clientname $new was successful registered on global-PB server";
       } else {
          $globalClientPass = '';
          $globalClientName = '';
          $Config{globalClientPass}='';
          $Config{$name}='';
          $globalClientLicDate = '';
          $Config{globalClientLicDate}='';
          &SaveConfig();
          mlog(0,"warning: registration for clientname $new global-PB server failed : $res");
          return
          '<span class="negative">*** registration for clientname '.$new.' on global-PB server failed : '.$res.'</span><script type=\"text/javascript\">alert(\'global-client registation failed - '.$res.'\');</script>';
       }
    }
}

sub configUpdateGlobalHidden {
    my ($name, $old, $new, $init)=@_;
    $$name = $old;
    $Config{$name}=$old;
    if ($old eq '') {
       return '<span class="negative"> deleted</span>';
    } else {
       return '';
    }
}

sub configUpdateSMTPNet {
    my ($name, $old, $new, $init)=@_;
    my $isproxy = scalar(keys %ProxySocket) ? ' and Proxy':'';
    mlog(0,"AdminUpdate: $name updated from '$old' to '$new'") unless $init || $new eq $old;
    mlog(0,"warning : $name is switch on - SMTP$isproxy listeners will be switched off") if ($init && $$name);
    return '' if ($new eq $old or $init);
    $$name = $new;
    $Config{$name} = $new;
    if ($new) {
        mlog(0,"warning : $name is switch on - SMTP$isproxy listeners will be switched off");
        foreach my $lsn (@lsn ) {
            unpoll($lsn,$readable) if $lsn;
            unpoll($lsn,$writable) if $lsn;
            eval{close($lsn);} if $lsn;
            delete $SocketCalls{$lsn} if $lsn;
        }

        foreach my $lsn (@lsn2 ) {
            unpoll($lsn,$readable) if $lsn;
            unpoll($lsn,$writable) if $lsn;
            eval{close($lsn);} if $lsn;
            delete $SocketCalls{$lsn} if $lsn;
        }

        foreach my $lsn (@lsnSSL ) {
            unpoll($lsn,$readable) if $lsn;
            unpoll($lsn,$writable) if $lsn;
            eval{close($lsn);} if $lsn;
            delete $SocketCalls{$lsn} if $lsn;
        }
        
        foreach my $lsn (@lsnRelay ) {
            unpoll($lsn,$readable) if $lsn;
            unpoll($lsn,$writable) if $lsn;
            eval{close($lsn);} if $lsn;
            delete $SocketCalls{$lsn} if $lsn;
        }

        while (my ($k,$v) = each(%Proxy)) {
            unpoll($ProxySocket{$k},$readable);
            unpoll($ProxySocket{$k},$writable);
            eval{close($ProxySocket{$k});};
            delete $SocketCalls{$ProxySocket{$k}};
        }
        %ProxySocket = ();
    } else {
        mlog(0,"info : $name is switch off - SMTP$isproxy listeners will be switched on");

        my ($lsn,$lsnI) = newListen($listenPort,\&ConToThread,1);
        @lsn = @$lsn; @lsnI = @$lsnI;
        mlog(0,"listening for SMTP connections on @lsnI") if @lsn;

        if($listenPortSSL && $CanUseIOSocketSSL) {
          my ($lsnSSL,$lsnSSLI) = newListenSSL($listenPortSSL,\&ConToThread,1);
          @lsnSSL = @$lsnSSL; @lsnSSLI = @$lsnSSLI;
          mlog(0,"listening for additional SMTP connections on @lsnSSLI") if @lsnSSL;
        }

        if($listenPort2) {
          my ($lsn2,$lsn2I) = newListen($listenPort2,\&ConToThread,1);
          @lsn2 = @$lsn2; @lsn2I = @$lsn2I;
          mlog(0,"listening for additional SMTP connections on @lsn2I") if @lsn2;
        }

        if($relayHost && $relayPort) {
          my ($lsnRelay,$lsnRelayI)=newListen($relayPort,\&ConToThread,1);
          @lsnRelay = @$lsnRelay; @lsnRelayI = @$lsnRelayI;
          mlog(0,"listening for SMTP relay connections on @lsnRelayI") if @lsnRelay;
        }

         while ((my $k,my $v) = each(%Proxy)) {
             my ($to,$allow) = split(/<=/o, $v);
             $allow = " allowed for $allow" if ($allow);
             my (@ProxySocket,@dummy) = newListen($k,\&ConToThread,2);
             $ProxySocket{$k} = shift @ProxySocket;
             mlog(0,"proxy started: listening on $k forwarded to $to$allow") if $ProxySocket{$k};
        }
    }
    return '';
}

sub updatePenaltyDuration {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: $name updated from '$old' to '$new'") unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new;
    cmdToThread('CleanPB','') unless $init || $new eq $old;
    return '';
}
sub updatePenaltyExpiration {
    my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: $name updated from '$old' to '$new'") unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new;
    cmdToThread('CleanPB','') unless $init || $new eq $old;
    return '';
}

sub ScheduleMapSet {
    my ( $map, $next ) = @_;
    if ($map) {
        my @val = @{$ScheduleMap{$map}};
        while (@val) {
            my $t = shift @val;
            my $var = shift @val;
            next if $next && $next ne $var;
            setLastSchedTime($map, ${$var});
            ${$var} = max( getSchedTime($map,$t), time);
            mlog(0,"info: (re)scheduled $map -> $var for " . timestring(${$var})) if $MaintenanceLog > 2;
        }
    } else {
        while (my ($k,$v) = each %ScheduleMap) {
            my @val = @{$v};
            while (@val) {
                my $t = shift @val;
                my $var = shift @val;
                my $last = getLastSchedTime($k);
                my $bt = isSched(${$k}) ? 0 : $last;
                ${$var} = max( getSchedTime($k,$t,$bt), time);
                mlog(0,"info: (re)scheduled $k -> $var for " . timestring(${$var})) if $MaintenanceLog > 2;
            }
        }
    }
    saveHashToFile( "$base/scheduleHistory", \%LastSchedRun );
    return;
}

sub getSchedTime {
    my ($sched,$factor,$basetime) = @_;
    $basetime ||= time;
    $factor ||= 1;
    return 0 unless $sched;
    my $desc = $sched;
    $sched = ${$sched};
    return ( isSched($sched) && defined *{'yield'} ? getNextSched($sched,$desc,$basetime) : $sched * $factor + $basetime);
}

sub getLastSchedTime {
    my $var = shift;
    if (exists $LastSchedRun{$var}) {
        return $LastSchedRun{$var};
    } else {
        my $t = time;
        setLastSchedTime($var,$t);
        return $t;
    }
}

sub setLastSchedTime {
    my ($var, $time) = @_;
    $LastSchedRun{$var} = $time;
    return;
}

sub isSched {
    my $sched = shift;
    return $sched =~ /^$ScheduleRe(?:\|$ScheduleRe)*$/o;
}

sub initMaintScheduler {
    my ($name, $old, $new, $init, $desc) = @_;
    if ($name eq 'BlockReportFile') {
        ${$name}=$Config{$name};
        my $fil;
        if (${$name} =~ /^ *file: *(.+)/io) {
            $fil = $1;
            $fil = "$base/$fil" if $fil!~/^\Q$base\E/io;
            $FileUpdate{"$fil$name"} = $FileUpdate{$fil} = ftime($fil);
        }
#        $fil = "$base/files/UserBlockReportQueue.txt";
#        $FileUpdate{$fil} = ftime($fil);
    }
    return if $WorkerNumber != 0;
    %ScheduledTask = ();
    BlockReportGenSched();
    for (keys %registeredSchedules) { addSched(@{$registeredSchedules{$_}}); }
    $ScheduleIsChanged = 0;
    return '';
}

sub ConfigRegisterSchedule {
    my ($name,@sched) = @_;
    return if $WorkerNumber != 0;
    $ScheduleIsChanged = 1;
    if (! @sched) {
        @{$registeredSchedules{$name}} = ();
        undef @{$registeredSchedules{$name}};
        delete $registeredSchedules{$name};
    } else {
        @{$registeredSchedules{$name}} = @sched;
    }
}

sub addSched {
    my ($sched,$run,$desc,$parm) = @_;
    return unless $CanUseSchedCron;
    return unless $sched;
    return unless $desc;
    $run ||= [[caller(unpack("A1",$X)-1)]->[unpack("A1",$X)+1]];
    my $nextrun = getNextSched($sched,$desc);
    return unless $nextrun;
    return if $nextrun < time;
    foreach (keys %ScheduledTask) {
        if (   eval{$ScheduledTask{$_}->{Run} eq $run;}
            && $ScheduledTask{$_}->{Parm} eq $parm
            && $ScheduledTask{$_}->{Desc} eq $desc)
        {
            eval{$ScheduledTask{$_}->{Nextrun} = $nextrun;};
            $ScheduledTask{$_}->{Schedule} = $sched;
            $nextrun = timestring($nextrun);
            mlog(0,"info: changed schedule : $desc - to : $parm - at : $sched - next run is at : $nextrun") if $MaintenanceLog;
            return;
        }
    }
    my $c = 1;
    while (exists $ScheduledTask{$c}) {$c++;}
    $ScheduledTask{$c} = &share({});
    eval{$ScheduledTask{$c}->{Nextrun} = $nextrun;};
    $ScheduledTask{$c}->{Schedule} = $sched;
    $ScheduledTask{$c}->{Run} = $run;
    $ScheduledTask{$c}->{Parm} = $parm;
    $ScheduledTask{$c}->{Desc} = $desc;
    $nextrun = timestring($nextrun);
    mlog(0,"info: added schedule : $desc - for : $parm - at : $sched - next run is at : $nextrun") if $MaintenanceLog;
}

sub getNextSched {
    my ($sched,$desc,$time) = @_;
    return unless $CanUseSchedCron;
    return unless $sched;
    return unless $desc;
    $time ||= time;
    my $cron;
    my @schedule;
    for ( split(/\|/o,$sched) ) {
        s/^s+//o;
        s/s+$//o;
        eval{
            $cron = Schedule::Cron->get_next_execution_time($_,$time);
            if ($cron =~ /^\d+$/io) {
                push @schedule, $cron;
            } else {
                mlog(0,"error: Schedule entry '$_' for $desc is not valid");
            }
            1;
        } or do {
            mlog(0,"error: Schedule entry '$_' for $desc is not valid - $@");
            next;
        }
    }
    return 0 unless scalar @schedule;
    return min( @schedule );
}

sub configChangeConfigSched {
    my ($name, $old, $new, $init, $desc) = @_;
    return if $WorkerNumber != 0;
    mlog(0,"AdminUpdate: $name updated from '$old' to '$new'") unless $init || $new eq $old;
    ${$name} = $new;
    my @new = checkOptionList($new,$name,$init);

    # remove all old schedules
    my $s = 0;
    foreach (keys %registeredSchedules) {
        ConfigRegisterSchedule($_,()) if /^ConfigChangeSchedule/o;
        mlog(0,"info: removed schedule $_") if $MaintenanceLog > 2;
        $s++;
    }
    mlog(0,"info: removed $s config change schedules") if $MaintenanceLog;
    
    # add the new schedules
    my $l = 0;
    $s = 0;
    while (@new) {
        my $line = shift @new;
        my ($var,$val);
        $l++;
        $line =~ s/^\s*//o;
        $line =~ s/[\r\n\s]+$//o;
        next unless $line;
        
        my ($sched,$config) = $line =~ /^($ScheduleRe(?:\|$ScheduleRe)*)\s*(.+)\s*$/o;
        if (! $sched) {
            mlog(0,"error: $name - line $l of file $new contains not a valid schedule and/or configuration variable definition");
            next;
        }
        if ($config !~ /^\&/o) {
            ($var,$val) = split(/\s*:=\s*/o, $config, 2);
            if (! $var) {
                mlog(0,"error: $name - line $l of file $new contains no configuration variable definition");
                next;
            }
            if (! exists $Config{$var} && ! defined $$var) {
                mlog(0,"error: $name - line $l of file $new contains no valid configuration variable definition - ($var)");
                next;
            }
            if (exists $Config{$var}) {
                if ($ConfigArray[$ConfigNum{$var}]->[3] eq \&textnoinput or $ConfigArray[$ConfigNum{$var}]->[3] eq \&passnoinput) {
                    mlog(0,"error: $name - line $l of file $new tries to change the protected configuration variable $var - schedule is ignored");
                    next;
                }
                my $re = $ConfigArray[$ConfigNum{$var}]->[5];
                if ($val !~ /$re/i) {
                    mlog(0,"error: $name - line $l of file $new contains not a valid value for the configuration variable $var");
                    next;
                }
            }
        } else {
            ($var,$val) = $config =~ /^(\&[a-z0-9_]+)(.*)$/io;
        }
        my @sched = ($sched,'push_ChangeConfigVar',"ConfigChangeSchedule_".$l."_$var",$var.':='.$val);
        ConfigRegisterSchedule("ConfigChangeSchedule_".$l, @sched);
        mlog(0,"info: added schedule ConfigChangeSchedule_".$l."_$var") if $MaintenanceLog > 1;
        $s++;
    }
    mlog(0,"info: registered $s config change schedules") if $MaintenanceLog && $s;
    mlog(0,"warning: $name - the schedules are registered but will not run, because the module Schedule::Cron is not available!") if $s && ! $CanUseSchedCron;
    return '';
}

sub push_ChangeConfigVar {
    threads->yield;
    lock(@changedConfig);
    threads->yield;
    push @changedConfig , @_;
    threads->yield;
}

sub configChangeSched {
    my ($name, $old, $new, $init, $desc) = @_;
    return if $WorkerNumber != 0;
    
    if (exists $ScheduleMap{$name}) {
        my $n;
        if ( isSched($new) ) {
            if (! $CanUseSchedCron) {
                my $error;
                if (isSched($old) ) {
                    mlog(0,"error: $name was set to zero - missing Schedule::Cron");
                    $error = ' - disabled $name - old value was $old';
                    $old = 0;
                }
                ${$name} = $Config{$name} = $old;
                return '<span class="negative">***  Perl module Schedule::Cron is not installed$error</span>';
            }
            (my $t = getNextSched($new,$desc))
            or do {
                ${$name} = $Config{$name} = $old;
                return "<span class=\"negative\"><b>*** Invalid Schedule: '$qs{$name}'</b></span>";
              };
            my @map = @{$ScheduleMap{$name}};
            while (@map) {
                my $d = shift @map;   # dummy shift
                $n = shift @map;
                ${$n} = $t;
            }
        } elsif ( isSched($old) ) {
            my @map = @{$ScheduleMap{$name}};
            while (@map) {
                my $t = shift @map;
                $n = shift @map;
                ${$n} = time + $new * $t;
            }
        } else {
            my @map = @{$ScheduleMap{$name}};
            while (@map) {
                my $t = shift @map;
                $n = shift @map;
                ${$n} += ($new - $old) * $t;
            }
        }
        mlog(0,"AdminUpdate: $name updated from '$old' to '$new'") unless $init || $new eq $old;
        mlog(0,"info: (re)scheduled $name -> $n for " . timestring(${$n})) if $MaintenanceLog > 2;
    } else {
        return "<span class=\"negative\"><b>*** code error '$name' is not a registered schedule</b></span><br />";
    }
    ${$name} = $Config{$name} = $new;
    return '';
}

sub configChangeRSRBSched {
    my ($name, $old, $new, $init)=@_;

    if (! $CanUseSchedCron) {
        ${$name} = 'noschedule';
        $Config{$name} = 'noschedule';
        return '<span class="negative">***  Perl module Schedule::Cron is not installed</span>';
    }
    if ($new !~ /^noschedule$/io) {
        my @errors;
        for (split(/\|/o,$new)) {
            eval{Schedule::Cron->get_next_execution_time($_);};
            push @errors , $@ if $@;
        }
        if (! @errors) {
            $Config{$name} = $new;
            ${$name} = $new;
            mlog(0,"AdminUpdate: $name updated from '$old' to '$new'") unless $init || $new eq $old;
            return '';
        }
        mlog(0,"AdminUpdate: syntax error in $name - '$new' - @errors");
        $new = $old;
        $Config{$name} = $old;
        ${$name} = $old;
        foreach (@errors) {
            s/[\r\n]//go;
            s/ at .*//o;
        }
        my $text = join('<br />',@errors);
        return '<span class="negative">***  '.$text.'</span>';
    } else {
        mlog(0,"AdminUpdate: $name updated from '$old' to '$new'") unless $init || $new eq $old;
        $Config{$name} = 'noschedule';
        ${$name} = 'noschedule';
        return '';
    }
}

sub cleanBlackPB {
    d('cleanBlackPB');
    if ($PenaltyExpiration==0) {
        %PBBlack = ();
        &SaveHash('PBBlack') unless ($pbdb =~ /DB:/o && ! $failedTable{PBBlack});
        return;
    }

    my $ips_before= my $ips_deleted=0;
    my $t=time;
    my $tdif;
    my $tdifut;
    my($ct,$ut,$pbstatus,$score,$sip,$reason);
    my $expmin=$PenaltyExpiration*60;
    delete $PBBlack{"0.0.0.0"};
    delete $PBBlack{''};
    while (my ($k,$v)=each(%PBBlack)) {
        ($ct,$ut,$pbstatus,$score,$sip,$reason)=split(/\s+/o,$v);
        $tdif=$t-$ct;
        $tdifut=$t-$ut;
        $ips_before++;

        if ($k =~ /$IPprivate/o) {
            delete $PBBlack{$k};
            $ips_deleted++;
            next;
        }

        if ($reason =~ /GLOBALPB/io) {
            if ($tdifut > $globalBlackExpiration*3600) {
                delete $PBBlack{$k};
                $ips_deleted++;
            }
            next;
        }

        if ($tdif>$PenaltyDuration*60 && $score<$PenaltyLimit ) {
            delete $PBBlack{$k};
            $ips_deleted++;
            next;}

        if ($tdif>$PenaltyExpiration*60 && $score<$PenaltyExtreme) {
            delete $PBBlack{$k};
            $ips_deleted++;
            next;}

        if (exists $PBWhite{$k} || (matchIP($k,'ispip',0,1))  || matchIP($k,'noProcessingIPs',0,1) || matchIP($k,'whiteListedIPs',0,1)  || (matchIP($k,'noDelay',0,1)) || (matchIP($k,'noPB',0,1)) || ($contentOnlyRe && $k=~/$contentOnlyReRE/)) {
            delete $PBBlack{$k};
            $ips_deleted++;
            next;}

        if ($tdif>$ExtremeExpiration*60*60*24 && $score>=$PenaltyExtreme) {
            delete $PBBlack{$k};
            $ips_deleted++;
            next;}
    }
    if ($ips_before==0) {
        %PBBlack=();
        &SaveHash('PBBlack') unless ($pbdb =~ /DB:/o)
    }
    mlog(0,"PenaltyBox: cleaning BlackBox  finished: IP\'s before=$ips_before, deleted=$ips_deleted") if $MaintenanceLog && $ips_before != 0;
}

sub cleanWhitePB {
    d('cleanWhitePB');
    my $ips_before= my $ips_deleted=0;
    my $t=time;
    delete $PBWhite{"0.0.0.0"};
    delete $PBWhite{''};
    my $maxtime1 = $globalWhiteExpiration*24*3600;
    my $maxtime2 = $WhiteExpiration*24*3600;

    while (my ($k,$v)=each(%PBWhite)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $ips_before % 100;
        my($ct,$ut,$pbstatus)=split(/\s+/o,$v);
        $ips_before++;

        if ($pbstatus == 3) {           # an entry from global PB
            if ($t-$ut>=$maxtime1) {
                delete $PBWhite{$k};
                $ips_deleted++;
            }
            next;
        }
        if (matchIP($k,'denySMTPConnectionsFromAlways',0,1) or (($DoDropList == 2 or $DoDropList == 3) and matchIP($k,'droplist',0,1))) {
            delete $PBWhite{$k};
            $ips_deleted++;
            next;}
        if (matchIP($k,'noPBwhite',0,1)) {
            delete $PBWhite{$k};
            $ips_deleted++;
            next;}
        if ($t-$ut>=$maxtime2) {
            delete $PBWhite{$k};
            $ips_deleted++;
        }
    }
    mlog(0,"PenaltyBox: cleaning WhiteBox finished: IP\'s before=$ips_before, deleted=$ips_deleted") if $MaintenanceLog && $ips_before != 0;
    if ( $ips_before == 0) {
        %PBWhite = ();
        if ($pbdb =~ /DB:/o && ! $failedTable{PBWhite}) {
        } else {
            &SaveHash('PBWhite');
        }
    }
}

sub cleanCacheRBL {
    d('cleanCacheRBL');
    my $ips_before = my $ips_deleted = 0;
    my $t = time;
    my $ct;
    my $mm;
    my $status;
    my @sp;
    my $maxtime = $RBLCacheExp * 3600;
    while (my ($k,$v)=each(%RBLCache)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $ips_deleted % 100;
        ( $ct, $mm, $status, @sp ) = split( ' ', $v );

        $ips_before++;
        if ( $t - $ct >= $maxtime  ) {
            delete $RBLCache{$k};
            $ips_deleted++;
            next;
        }
        next if $status == 2;
        my $spstr = join(' ',@sp);
        foreach my $sp (@sp) {
            my $tsp = $sp;
            $tsp =~ s/([^\{]+).*/$1/o;
            next if grep(/\Q$tsp\E/i,@rbllist);
            $spstr =~ s/ ?\Q$sp\E//ig;
        }
        if ($spstr) {
            $RBLCache{$k} = "$ct $mm $status $spstr";
        } else {
            delete $RBLCache{$k};
            $ips_deleted++;
        }
    }
    mlog( 0, "DNSBLCache: cleaning cache finished: IP\'s before=$ips_before, deleted=$ips_deleted" ) if $MaintenanceLog && $ips_before != 0;
    if ( $ips_before == 0) {
        %RBLCache=();
        if ($pbdb =~ /DB:/o && ! $failedTable{RBLCache}) {
        } else {
            &SaveHash('RBLCache');
        }
    }
}

sub cleanCachePTR {
    d('cleanCachePTR');
    my $ips_before = my $ips_deleted=0;
    my $t=time;
    my $ct;my $status;my $dsn;
    my $maxtime = $PTRCacheInterval*3600*24;
    while (my ($k,$v)=each(%PTRCache)) {
       &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $ips_before % 100;
       ($ct,$status,$dsn)=split(/\s+/o,$v);

        $ips_before++;
        if ($t-$ct>=$maxtime) {
            delete $PTRCache{$k};
            $ips_deleted++;
        }
    }
    mlog(0,"PTRCache: cleaning cache finished: IP\'s before=$ips_before, deleted=$ips_deleted") if  $MaintenanceLog && $ips_before != 0;
    if ($ips_before==0) {
        %PTRCache=();
        if ($pbdb =~ /DB:/o && ! $failedTable{PTRCache}) {
        } else {
            &SaveHash('PTRCache');
        }
    }
}

sub cleanCacheRWL {
    d('cleanCacheRWL');
    my $ips_before= my $ips_deleted=0;
    my $t=time;
    my $ct;
    my $status;
    my $maxtime = $RWLCacheInterval*3600*24;
    while (my ($k,$v)=each(%RWLCache)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $ips_before % 100;
        ($ct,$status)=split(/\s+/o,$v);

        $ips_before++;
        if ($t-$ct>=$maxtime or $ct < 1269300000) {   # RWL has change 2010/3/23
            delete $RWLCache{$k};
            $ips_deleted++;
        }
    }
    mlog(0,"RWLCache: cleaning cache finished: IP\'s before=$ips_before, deleted=$ips_deleted") if  $MaintenanceLog && $ips_before != 0;
    if ($ips_before==0) {
        %RWLCache=();
        if ($pbdb =~ /DB:/o && ! $failedTable{RWLCache}) {
        } else {
            &SaveHash('RWLCache');
        }
    }
}

sub cleanCacheBackDNS {
    d('cleanCacheBackDNS');
    my $ips_before= my $ips_deleted=0;
    my $t=time;
    my $ct;
    my $status;
    my $maxtime = $BackDNSInterval*3600*24;
    while (my ($k,$v)=each(%BackDNS)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $ips_before % 100;
        ($ct,$status)=split(/\s+/o,$v);
        $ips_before++;
        if ($t-$ct>=$maxtime) {
            delete $BackDNS{$k};
            $ips_deleted++;
        }
    }
    mlog(0,"BackDNS: cleaning cache finished: IP\'s before=$ips_before, deleted=$ips_deleted") if  $MaintenanceLog && $ips_before != 0;
    if ($ips_before==0) {
        %BackDNS=();
        if ($pbdb =~ /DB:/o && ! $failedTable{BackDNS}) {
        } else {
            &SaveHash('BackDNS');
        }
    }
    &cleanCacheBackDNS2();
}

sub cleanCacheBackDNS2 {
    d('cleanCacheBackDNS2');
    my $ips_before = my $ips_deleted = 0;
    my $t=time;
    my $ct;
    my $status;
    return unless $useDB4IntCache && $CanUseBerkeleyDB;
    return unless %BackDNS2;
    
    $ips_before = $ips_deleted=0;
    my $maxtime = $BackDNSInterval*3600*24;
    while (my ($k,$v)=each(%BackDNS2)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $ips_before % 100;
        ($ct,$status)=split(/\s+/o,$v);

        $ips_before++;
        if ($t-$ct>=$maxtime) {
            delete $BackDNS2{$k};
            $ips_deleted++;
        }
    }
    mlog(0,"BackDNS2: cleaning cache finished: IP\'s before=$ips_before, deleted=$ips_deleted") if  $MaintenanceLog && $ips_before != 0;
}

sub cleanCacheMXA {
    d('cleanCacheMXA');
    my $ips_before= my $ips_deleted=0;
    my $ct;my $status;
    my $t=time;
    my $maxtime = $MXACacheInterval*3600*24;
    while (my ($k,$v)=each(%MXACache)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $ips_before % 100;
        ($ct,$status)=split(/\s+/o,$v);

        $ips_before++;

        if ($t-$ct>=$maxtime) {
            delete $MXACache{$k};
            $ips_deleted++;
        }
    }
    mlog(0,"MXACache: cleaning cache finished: IP\'s before=$ips_before, deleted=$ips_deleted") if  $MaintenanceLog && $ips_before != 0;
    if ($ips_before==0) {
        %MXACache=();
        if ($pbdb =~ /DB:/o && ! $failedTable{MXACache}) {
        } else {
            &SaveHash('MXACache');
        }
    }
}

sub cleanCacheSB {
    d('cleanCacheSB');
    my $ips_before= my $ips_deleted=0;
    my $t=time;
    my %delWOL;
    while (my ($k,$v)=each(%SBCache)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $ips_before % 100;
        my $mSBCacheExp = $SBCacheExp;
        my ( $ct, $status, $data ) = split( "!", $v );
        my ( $ipcountry,  $orgname,  $domainname , @res) = split( /\|/o, $data ) ;

        $ips_before++;
        $mSBCacheExp = 10 * $SBCacheExp if ($status == 2);
        if ($t-$ct>=$mSBCacheExp*3600*24) {
            delete $SBCache{$k};
            delete $WhiteOrgList{lc $domainname};
            $delWOL{$orgname} = 1;
            $ips_deleted++;
        }
    }
    while (my ($k,$v)=each(%WhiteOrgList)) {
        delete $WhiteOrgList{$k} if exists $delWOL{$v};
    }
    
    mlog(0,"SenderBaseCache: cleaning cache finished: IP\'s before=$ips_before, deleted=$ips_deleted") if  $MaintenanceLog && $ips_before != 0;
    if ($ips_before==0) {
        %SBCache=();
        if ($pbdb =~ /DB:/o && ! $failedTable{SBCache}) {
        } else {
            &SaveHash('SBCache');
        }
    }
}

sub cleanCacheSPF {
    d('cleanCacheSPF');
    my $ips_before= my $ips_deleted=0;
    my $t=time;
    my $maxtime = $SPFCacheInterval*3600*24;
    while (my ($k,$v)=each(%SPFCache)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $ips_before % 100;
        my ($ct, $result, $helo)=split(/\s+/o,$v);
        $ips_before++;
        if ($t-$ct>=$maxtime or $k !~ /\s/o or $k =~ /\s$/o) {
            delete $SPFCache{$k};
            $ips_deleted++;
        }
    }
    mlog(0,"SPFCache: cleaning cache finished: IP\'s before=$ips_before, deleted=$ips_deleted") if  $MaintenanceLog && $ips_before != 0;
    if ($ips_before==0) {
        %SPFCache=();
        if ($pbdb =~ /DB:/o && ! $failedTable{SPFCache}) {
        } else {
            &SaveHash('SPFCache');
        }
    }
}

sub cleanCacheURI {
    d('cleanCacheURI');
    my $domains_before= my $domains_deleted=0;
    my $t=time;
    my $ct;my $status;my @sp;
    my $maxtime1 = $URIBLCacheIntervalMiss*3600*24;
    my $maxtime2 = $URIBLCacheInterval*3600*24;
    while (my ($k,$v)=each(%URIBLCache)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $domains_before % 100;
        ( $ct, $status, @sp ) = split( ' ', $v );

        $domains_before++;
        if ($status==2 && $t-$ct>=$maxtime1) {
            delete $URIBLCache{$k};
            $domains_deleted++;
            next;
        }
        if ($t-$ct>=$maxtime2) {
            delete $URIBLCache{$k};
            $domains_deleted++;
            next;
        }
        next if $status == 2;
        my $spstr = join(' ',@sp);
        foreach my $sp (@sp) {
            my $tsp = $sp;
            $tsp =~ s/([^\<]+).*/$1/o;
            next if grep(/$tsp/i,@uribllist);
            $spstr =~ s/ ?$sp//ig;
        }
        if ($spstr) {
            $URIBLCache{$k} = "$ct $status $spstr";
        } else {
            delete $URIBLCache{$k};
            $domains_deleted++;
        }
    }
    mlog(0,"URIBLCache: cleaning cache finished: Domains before=$domains_before, deleted=$domains_deleted") if  $MaintenanceLog && $domains_before != 0;
    if ($domains_before==0) {
        %URIBLCache=();
        if ($pbdb =~ /DB:/o && ! $failedTable{URIBLCache}) {
        } else {
            &SaveHash('URIBLCache');
        }
    }
}

sub cleanTrapPB {
    d('cleanTrapPB');
    my $addresses_before= my $addresses_deleted=0;
    my $t=time;
    my $maxtime = $PBTrapInterval*3600*24;
    while (my ($k,$v)=each(%PBTrap)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $addresses_before % 100;
        my ($ct,$ut,$count)=split(/\s+/o,$v);
        $addresses_before++;

        if ($t-$ct>=$maxtime && $count < $PenaltyMakeTraps) {
            delete $PBTrap{$k};
            $addresses_deleted++;
        }
    }
    mlog(0,"PBTrap: cleaning finished: before=$addresses_before, deleted=$addresses_deleted") if  $MaintenanceLog && $addresses_before != 0;
    if ($addresses_before==0) {
        %PBTrap=();
        if ($pbdb =~ /DB:/o && ! $failedTable{PBTrap}) {
        } else {
            &SaveHash('PBTrap');
        }
    }
}

sub cleanCacheDKIM {
    d('cleanCacheDKIM');
    my $ips_before= my $ips_deleted=0;
    my $ct;
    my $t=time;
    my $maxtime = $DKIMCacheInterval*3600*24;
    while (my ($k,$v)=each(%DKIMCache)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $ips_before % 100;
        $ips_before++;

        if ($t-$v>=$maxtime) {
            delete $DKIMCache{$k};
            $ips_deleted++;
        }
    }
    mlog(0,"DKIMCache: cleaning cache finished: domains\'s before=$ips_before, deleted=$ips_deleted") if  $MaintenanceLog && $ips_before != 0;
    if ($ips_before==0) {
        %DKIMCache=();
        if ($pbdb =~ /DB:/o && ! $failedTable{DKIMCache}) {
        } else {
            &SaveHash('DKIMCache');
        }
    }
}

sub cleanCachePersBlack {
    d('cleanCachePersBlack');
    &ThreadMaintMain2() if $WorkerNumber == 10000;
    my $adr_before= my $adr_deleted=0;
    my $ct;
    my $t=time;
    my $maxtime = $MaxWhitelistDays*3600*24;
    if ($MaxWhitelistDays) {
        while (my ($k,$v)=each(%PersBlack)) {
            &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $adr_before % 100;
            $adr_before++;

            if ($t-$v>=$maxtime) {
                delete $PersBlack{$k};
                $adr_deleted++;
            }
        }
        mlog(0,"PersBlackCache: cleaning cache finished: entries before=$adr_before, deleted=$adr_deleted") if  $MaintenanceLog && $adr_before != 0;
        if ($adr_before==0 or $adr_before == $adr_deleted) {
            %PersBlack=();
            $PersBlackHasRecords = 0;
            if ($pbdb =~ /DB:/o && ! $failedTable{PersBlack}) {
            } else {
                &SaveHash('PersBlack');
            }
        } else {
            $PersBlackHasRecords = 1;
        }
    }
}

sub cleanCacheBATVTag {
    d('cleanCacheBATVTag');
    my $ips_before= my $ips_deleted=0;
    my $ct;
    my $today = (time / 86400) % 1000;
    while (my ($k,$v)=each(%BATVTag)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $ips_before % 100;
        $ips_before++;

        my ($gen, $day, $hash, $orig_user) = ($v =~ /^prvs=(\d)(\d\d\d)(\w{6})=(.*)/o);
        my $dt = ($day - $today + 1000) % 1000;
        if ($dt > 7) {
            delete $BATVTag{$k};
            $ips_deleted++;
        }
    }
    mlog(0,"BATVTag: cleaning cache finished: BATVTag\'s before=$ips_before, deleted=$ips_deleted") if  $MaintenanceLog && $ips_before != 0;
    if ($ips_before==0) {
        %BATVTag=();
        if ($pbdb =~ /DB:/o && ! $failedTable{BATVTag}) {
        } else {
            &SaveHash('BATVTag');
        }
    }
}

sub cleanCacheSSLfailed {
    d('cleanCacheSSLfailed');
    my $ips_before= my $ips_deleted=0;
    my $ct;
    my $t=time;
    while (my ($k,$v)=each(%SSLfailed)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $ips_before % 100;
        $ips_before++;

        if ($t-$v>=43200) {   # 3600*12
            delete $SSLfailed{$k};
            $ips_deleted++;
        }
    }
    mlog(0,"SSLfailedCache: cleaning cache finished: IP\'s before=$ips_before, deleted=$ips_deleted") if  $MaintenanceLog && $ips_before > 0;
    if ($ips_before==0) {
        %SSLfailed=();
    }
}

sub cleanCacheRFC822 {
    d('cleanCacheRFC822');
    my $dom_before= my $dom_deleted=0;
    my $ct;
    my $t=time;
    while (my ($k,$v)=each(%RFC822dom)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $dom_before % 100;
        $dom_before++;

        if ($t-$v>=3600) {   # 3600
            delete $RFC822dom{$k};
            $dom_deleted++;
        }
    }
    mlog(0,"RFC822dom: cleaning cache finished: domains\'s before=$dom_before, deleted=$dom_deleted") if  $MaintenanceLog && $dom_before > 0;
    if ($dom_before==0) {
        %RFC822dom=();
    }
}

sub cleanCacheAUTHErrors {
    d('cleanCacheAUTHErrors');
    my $i = 0;
    while (my ($k,$v)=each(%AUTHErrors)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $i % 100;
        if (--$AUTHErrors{$k} <= 0) {
            delete $AUTHErrors{$k};
        }
        $i++;
    }
    mlog(0,"AUTHErrors: recalculated $i IP counters") if  $MaintenanceLog && $MaxAUTHErrors && $i;
}

sub cleanCacheT10 {
    d('cleanCacheT10');
    my $i = my $del = 0;
    my $t = time - 25 * 60 * 60;
    while (my ($k,$v)=each(%T10StatT)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $i % 100;
        if ($v < $t) {
            delete $T10StatT{$k};
            delete $T10StatD{$k};
            delete $T10StatI{$k};
            delete $T10StatR{$k};
            delete $T10StatS{$k};
            $del++;
        }
        $i++;
    }
    mlog(0,"Top-Ten-Stats: removed $del entries from $i") if $MaintenanceLog >= 2 && $i;
}

sub cleanCacheDelayIPPB {
    d('cleanCacheDelayIPPB');
    my $ips_deleted = 0;
    my $ips_before = 0;
    my $t = time - 24 * 3600 ;
    while (my ($k,$v)=each(%DelayIPPB)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $ips_before % 100;
        $ips_before++;
        if ($DelayIPPB{$k} <= $t) {
            delete $DelayIPPB{$k};
            $ips_deleted++;
        }
    }
    mlog(0,"DelayIPPB: cleaning cache finished: IP\'s before=$ips_before, deleted=$ips_deleted") if  $MaintenanceLog && $ips_before > 0;
}

sub cleanCacheEmergencyBlock {
    d('cleanCacheEmergencyBlock');
    my $ips_deleted = 0;
    my $ips_before = 0;
    my $t = time - 900 ;
    while (my ($k,$v)=each(%EmergencyBlock)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $ips_before % 100;
        $ips_before++;
        if ($EmergencyBlock{$k} <= $t) {
            delete $EmergencyBlock{$k};
            $ips_deleted++;
            mlog(0,"EmergencyBlock: lifted the EMERENCY blocking for IP $k") if $MaintenanceLog;
        }
    }
    mlog(0,"EmergencyBlock: cleaning cache finished: IP\'s before=$ips_before, deleted=$ips_deleted") if  $MaintenanceLog && $ips_before > 0;
}

sub cleanCacheSMTPdomainIP {
    d('cleanCacheSMTPdomainIP');
    my $ips_before= my $ips_deleted=0;
    my $ct;
    my $t=time;
    while (my ($k,$v)=each(%SMTPdomainIP)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $ips_before % 100;
        $ips_before++;

        if (($t - $SMTPdomainIPTriesExpiration{$k}) > $maxSMTPdomainIPExpiration) {
            $ips_deleted++;
            delete $SMTPdomainIP{$k};
            delete $SMTPdomainIPTries{$k};
            delete $SMTPdomainIPTriesExpiration{$k};
        }
    }
    mlog(0,"SMTPdomainIP: cleaning cache finished: domain\'s before=$ips_before, deleted=$ips_deleted") if  $MaintenanceLog && $ips_before > 0;
}

sub cleanCacheIPNumTries {
    d('cleanCacheIPNumTries');
    my $ips_before= my $ips_deleted=0;
    my $ct;
    my $t=time;
    while (my ($k,$v)=each(%IPNumTries)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $ips_before % 100;
        $ips_before++;

        if ((($t - $IPNumTriesExpiration{$k}) > $maxSMTPipExpiration)  ||
            (($t - $IPNumTriesDuration{$k}) > $maxSMTPipDuration) &&
             ($IPNumTries{$k} < $maxSMTPipConnects))
        {
            $ips_deleted++;
            delete $IPNumTries{$k};
            delete $IPNumTriesDuration{$k};
            delete $IPNumTriesExpiration{$k};
        }
    }
    mlog(0,"IPNumTries: cleaning cache finished: IP\'s before=$ips_before, deleted=$ips_deleted") if  $MaintenanceLog && $ips_before > 0;
}

sub cleanCacheLocalFrequency {
    d('cleanCacheLocalFrequency');
    unless ($LocalFrequencyInt) {%localFrequencyCache = (); return;}
    unless ($LocalFrequencyNumRcpt) {%localFrequencyCache = (); return;}
    my $adr_before= my $adr_deleted=0;
    my $t=time;
    while (my ($k,$v)=each(%localFrequencyCache)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $adr_before % 100;
        $adr_before++;
        my %F = split(/ /o,$v);
        foreach (sort keys %F) {
            delete $F{$_} if ($_ + $LocalFrequencyInt  < $t);
        }
        if (! scalar keys %F) {
            delete $localFrequencyCache{$k};
            $adr_deleted++;
        } else {
            $localFrequencyCache{$k} = join(' ',%F);
        }
    }
    mlog(0,"localFrequency: cleaning cache finished: addresses\'s before=$adr_before, deleted=$adr_deleted") if  $MaintenanceLog && $adr_before > 0;

    while (my ($k,$v)=each(%localFrequencyNotify)) {
        delete $localFrequencyNotify{$k} if $v < time;
    }
}

sub cleanCacheSubjectFrequency {
    d('cleanCacheSubjectFrequency');
    unless ($subjectFrequencyInt) {%subjectFrequencyCache = (); return;}
    my $adr_before = my $adr_deleted=0;
    my $t=time;
    while (my ($k,$v)=each(%subjectFrequencyCache)) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $adr_before % 100;
        $adr_before++;
        my %F = split(/ /o,$v);
        foreach (sort keys %F) {
            delete $F{$_} if ($_ + $subjectFrequencyInt  < $t);
        }
        if (! scalar keys %F) {
            delete $subjectFrequencyCache{$k};
            $adr_deleted++;
        } else {
            $subjectFrequencyCache{$k} = join(' ',%F);
        }
    }
    mlog(0,"subjectFrequency: cleaning cache finished: subjects before=$adr_before, deleted=$adr_deleted") if  $MaintenanceLog && $adr_before > 0;
}

sub saveSMTPconnections {
    mlog(0,"sig USR1 -- saving concurrent session stats");
    open (my $SMTP, '>',"$base/smtp.txt") ;
    print $SMTP "$smtpConcurrentSessions\n" ;
    close ($SMTP);
}

sub exportExtreme {
    d('exportExtreme');
    return 0 unless $DoExtremeExport;

    my $fil;
    if ( $exportExtremeBlack =~ /^\s*file:\s*(.+)\s*$/io ) {
        $fil = $1;
    } else {
        return;
    }
    $fil = "$base/$fil" if $fil !~ /^(([a-z]:)?[\/\\]|\Q$base\E)/io;

    my %extremeips;
    keys %extremeips = 1024;
    # import existing extreme IP's
    my $counter = my $pbp = 0;
    if ( $DoExtremeExportAppend ) {
        my $r;
        open( my $IMPORT,'<', "$fil" );
        local $/ = "\n";
        while ( $r = <$IMPORT> ) {
            $r =~ y/\r\n\t //d;
            next unless $r;
            $extremeips{$r} = 1;
            $counter++;
        }
        close $IMPORT;
        mlog( 0, "PenaltyBox: $fil read, imported:$counter" ) if $MaintenanceLog;
    }

    &ThreadMaintMain2() if $WorkerNumber == 10000;

    # get additional extreme IP's from PenaltyBlack
    my ( $ct, $ut, $pbstatus, $score, $sip, $reason );
    while ( ( my $k, my $v ) = each(%PBBlack) ) {
        ( $ct, $ut, $pbstatus, $score, $sip, $reason ) = split( ' ', $v );

        $pbp++;
        &ThreadMaintMain2() if $WorkerNumber == 10000 && $pbp % 1000 == 0;
        next if $k =~ /\.0$/o;
        next if $reason =~ /GLOBALPB/io;

        # skip, IP already exists in extreme file
        next if $extremeips{$k};

        if ( $score >= $PenaltyExtreme ) {
            $extremeips{$k} = 1;
            $counter++;
        }
    }

    # write extreme temp file
    my $EXPORT;
    $pbp = 0;
    open( $EXPORT,'>' ,"$fil.tmp" );
    foreach my $e ( sort keys %extremeips ) {
        $pbp++;
        &ThreadMaintMain2() if $WorkerNumber == 10000 && $pbp % 1000 == 0;
        next unless $e;
        print $EXPORT "$e\n";
    }
    close $EXPORT;

    # backup and swap in new extreme file
    unlink( "$fil.bak" );
    move( "$fil", "$fil.bak" );
    move( "$fil.tmp", "$fil" );

    mlog( 0, "PenaltyBox: $fil exported, entries:$counter" ) if $MaintenanceLog;
    return 1;
}

sub modifyList {
    $GPBmodTestList->('email',@_);
}

# SRS Settin Checks, and Update.
sub updateSRS {my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: SRS-Enable updated from '$old' to '$new'") unless $init || $new eq $old;
    $EnableSRS=$Config{EnableSRS}=$new unless $WorkerNumber;
    if (!$CanUseSRS) {
        mlog(0,"AdminUpdate: SRS-Enable updated from '1' to '', Mail::SRS not installed") if $Config{EnableSRS};
        $EnableSRS=$Config{EnableSRS}=undef;
        return '<span class="negative">*** Mail::SRS must be installed before enabling SRS.</span>';
    } else {
        updateSRSAD('updateSRSAD','',$Config{SRSAliasDomain},'Cascading');
    }
}
sub updateSRSAD {my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: SRS Alias Domain updated from '$old' to '$new'") unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    if ($new eq '') {
        mlog(0,"AdminUpdate: SRS-Enable updated from '1' to '', SRSAliasDomain not defined ") if $Config{EnableSRS};
        $EnableSRS=$Config{EnableSRS}=undef;
        return '<span class="negative">*** SRSAliasDomain must be defined before enabling SRS.</span>';
    } else {
        updateSRSSK('updateSRSSK','',$Config{SRSSecretKey},'Cascading');
    }
}
sub updateSRSSK {my ($name, $old, $new, $init)=@_;
    mlog( 0, "AdminUpdate: SRS Secret Key updated from '$old' to '$new'" ) unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    if (length($new)<5) {
        mlog(0,"AdminUpdate: SRS-Enable updated from '1' to '', SRSSecretKey not at least 5 characters long ") if $Config{EnableSRS};
        $EnableSRS=$Config{EnableSRS}=undef;
        return '<span class="negative">*** SRSSecretKey must be at least 5 characters long before enabling SRS.</span>';
    } elsif($CanUseSRS) {
        if ($init && $EnableSRS) {
            return ' & SRS activated';
        } else {
            return '';
        }
    }
}

# Database File Logging Frequency Setup.
sub updateLog2 {my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: Non Spam Logging Frequency updated from '$old' to '$new'") unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    $logFreq[2]=$new;
    return '';
}
sub updateLog3 {my ($name, $old, $new, $init)=@_;
    mlog(0,"AdminUpdate: Spam Logging Frequency updated from '$old' to '$new'") unless $init || $new eq $old;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    $logFreq[3]=$new;
    return '';
}

sub syncCanSync {
    return ($syncConfigFile && $syncCFGPass && $syncServer && ($enableCFGShare or $isShareMaster or $isShareSlave)) ? 1 : 0;
}

sub ConfigChangeSyncServer {my ($name, $old, $new, $init)=@_;
    return '' if $new eq $old && ! $init;
    return '<span class="negative"></span>' if $WorkerNumber != 0;
    ${$name} = $Config{$name} = $new unless $WorkerNumber;
    return &ConfigChangeEnableCFGSync('enableCFGShare', $enableCFGShare, '', '') if (! $new || $init);
    mlog(0,"AdminUpdate: $name changed from $old to $new") if $new ne $old;
    %subOIDLastLoad = ();
    if (&syncLoadConfigFile()) {
        return '';
    } else {
        return "<span class=\"positive\">updated - but sync-config-file was still not loaded - sync config is still incomplete</span>";
    }
}

sub ConfigChangeSyncFile {my ($name, $old, $new, $init)=@_;
    my $tnew; $tnew=checkOptionList($new,'syncConfigFile',$init) if $WorkerNumber == 0 or $WorkerNumber == 10000;
    return '<span class="negative"></span>' if $WorkerNumber != 0;
    $Config{$name} = ${$name} = $new unless $WorkerNumber;
    mlog(0,"AdminUpdate: $name changed from $old to $new") if $new ne $old && $WorkerName ne 'startup';
    $NextSyncConfig = time - 1;
    %subOIDLastLoad = ();
    if (&syncLoadConfigFile()) {
        return '';
    } else {
        return "<span class=\"positive\">updated - but sync-config-file was still not loaded - sync config is still incomplete</span>";
    }
}

sub ConfigChangeSync {my ($name, $old, $new, $init)=@_;
    return '' if $new eq $old && ! $init;
    return '<span class="negative"></span>' if $WorkerNumber != 0;
    $Config{$name} = $new;
    ${$name} = $new;
    return '' if $init;
    my $text = ($name eq 'syncCFGPass') ? '' : "from $old to $new";
    mlog(0,"AdminUpdate: $name changed $text") if $new ne $old;
    %subOIDLastLoad = ();
    if (&syncLoadConfigFile()) {
        return '';
    } else {
        return "<span class=\"positive\">updated - but sync-config-file was still not loaded - sync config is still incomplete</span>";
    }
}

sub ConfigChangeEnableCFGSync {my ($name, $old, $new, $init)=@_;
    return '<span class="negative"></span>' if $WorkerNumber != 0;
    my $failed;
    if ($new) {
        unless ($isShareMaster or $isShareSlave) {
            $new = $old = '';
            $enableCFGShare = $new;
            $Config{enableCFGShare} = $new;
            $failed .= "<span class=\"negative\">any of isShareMaster or isShareSlave must be selected first</span><br />";
        }
        unless ($syncConfigFile) {
            $new = $old = '';
            $enableCFGShare = $new;
            $Config{enableCFGShare} = $new;
            $failed .= "<span class=\"negative\">syncConfigFile must be configured first</span><br />";
        }
        unless ($syncServer) {
            $new = $old = '';
            $enableCFGShare = $new;
            $Config{enableCFGShare} = $new;
            $failed .= "<span class=\"negative\">at least one default syncServer must be configured first</span><br />";
        }
        unless ($syncCFGPass) {
            $new = $old = '';
            $enableCFGShare = $new;
            $Config{enableCFGShare} = $new;
            $failed .= "<span class=\"negative\">a password in syncCFGPass must be configured first</span><br />";
        }
        return $failed if $failed;
    }
    mlog(0,"AdminUpdate: $name changed from $old to $new") if ($new ne $old && ! $init);
    %subOIDLastLoad = ();

    $enableCFGShare = $new;
    $Config{enableCFGShare} = $new;
    
    return '<span class="positive">config synchronization is now activated</span>' if $new;
    return '<span class="positive">config synchronization is now deactivated</span>';
}

sub syncGetStatus {
    my $name = shift;

    return $ConfigSync{$name}->{sync_cfg} if ($ConfigSync{$name}->{sync_cfg} < 1);
    my $syncserver = $ConfigSync{$name}->{sync_server};
    my $res = 0;
    while (my ($k,$v) = each %{$syncserver}) {
        if ($v == 1) {
            $res = $v;
            last;
        } elsif ($v >= 2) {
            $v = 2;
        }
        $res |= $v;
    }
    return $res;
}

sub syncedit {
    my $name = $qs{cfgparm};
    return 'incomplete request' unless $name;
    return 'synchronization not allowed for ' . $name if exists $neverShareCFG{$name};
    return 'no such configuration parameter ' . $name if ! exists $Config{$name};
    my %sync_server;
    my @syncServer = (split(/\|/o,$syncServer));
    my %syncMode = (0 => 'no sync', 1 => 'out of sync', 2 => 'in sync', 3 => 'as slave', '' => 'remove');
    my $msg;
    my ($fn) = $syncConfigFile =~ /^ *file:(.+)$/io;
    while (my ($k,$v) = each %qs) {
        next if $k !~ /^sync_server(\d+)/o;
        $v =~ s/\s//go;
        next unless $v;
        $sync_server{$v} = $qs{'val'.$1} if $qs{'val'.$1} ne '';
    }
    my $enable_sync = $qs{enable} ? 1 : 0;
    if ($qs{theButton}){
        $ConfigSync{$name}->{sync_cfg} = $enable_sync;
        $ConfigSync{$name}->{sync_server} = &share({});
        my $i = 0;
        while (my ($k,$v) = each %sync_server) {
            $ConfigSync{$name}->{sync_server}->{$k} = $v;
            $i++;
        }
        unless ($i) {
            $ConfigSync{$name}->{sync_cfg} = 0;
            $msg .= "<hr>no sync peer defined for $name - synchronization is now disabled for $name<hr>\n";
        }
        if (&syncWriteConfig()) {
            $msg .= "<hr><span class=\"positive\">successfully saved changes to file $fn</span><hr>\n";
            $NextSyncConfig = time - 1;
        }
    }
    my $server = $ConfigSync{$name}->{sync_server};
    my $checked = $ConfigSync{$name}->{sync_cfg} ? 'checked="checked"' : '';
    $msg .= "<hr>resulting line in file $fn:<br /><br />$name:=$ConfigSync{$name}->{sync_cfg}";
    while (my ($k,$v) = each %{$server}) {
        $msg .= ",$k=$v";
    }
    $msg .= '<br /><hr>';
    
    my $s = '<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH="100%" >';
    $s .= '<tr><td>enable/disable synchronization for '.$name.' : ';
    $s .= "<input type=\"checkbox\" name=\"enable\" value=\"1\" $checked /></td></tr></table><hr>\n";
    $s .= '<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH="100%" >'."\n";
    my $i = 0;
    foreach my $k (@syncServer) {
        $i++;

        $s .= "<tr><td>&nbsp;&nbsp;peer : ";
        $s .= "<span style=\"z-Index:100;\"><select size=\"1\" name=\"sync_server$i\">\n";
        my $sel = '';
        $sel = "selected=\"selected\"" if exists $server->{$k};
        $s .= "<option $sel value=\"$k\">$k</option>";
        $s .= "</select></span></td>\n";

        $s .= "<td>&nbsp;&nbsp;mode/status : ";
        $s .= "<span style=\"z-Index:100;\"><select size=\"1\" name=\"val$i\">\n";
        for (0..3,'') {
            my $sel = '';
            $sel = "selected=\"selected\"" if $_ eq $server->{$k};
            my $s1 = ($_ ne '') ? "($_)" : '';
            $s .= "<option $sel value=\"$_\">$syncMode{$_} $s1</option>\n";
        }
        $s .= "</select></span></td></tr>";
    }
    $s .= '</table>'."\n<hr>\n";
    $s .= '<input type="hidden" name="cfgparm" value="'.$name.'" />';
    $s .= '<input type="submit" name="theButton" value="Save Changes" />&nbsp;&nbsp;';
    $s .= '<input type="button" value="Close" onclick="javascript:window.close();"/>';
    $s .= $msg;
return <<EOT;
$headerHTTP

<html xmlns="http://www.w3.org/1999/xhtml" xml:lang="en">
<head>
  <meta http-equiv="content-type" content="application/xhtml+xml; charset=utf-8" />
  <title>$currentPage ASSP SyncConfig ($myName - $name)</title>
  <link rel=\"stylesheet\" href=\"get?file=images/editor.css\" type=\"text/css\" />
</head>
<body onmouseover="this.focus();" >
    <div class="content">
      <form action="" method="post">
        $s
      </form>
    </div>
</body>
</html>

EOT
}

sub syncShowGUI {
    my $name = shift;
    return '' unless &syncCanSync();
    my $syncserver = $ConfigSync{$name}->{sync_server};
    return '' if ($WebIP{$ActWebSess}->{user} ne 'root' && ! &canUserDo($WebIP{$ActWebSess}->{user},'action','syncedit'));
    return '' if ($WebIP{$ActWebSess}->{user} ne 'root' && ! &canUserDo($WebIP{$ActWebSess}->{user},'cfg',$name));

    if ($ConfigSync{$name}->{sync_cfg} == -1) {
        return '';
    } elsif ($ConfigSync{$name}->{sync_cfg} == 0) {

        return $syncShowGUIDetails
          ? '&nbsp;&nbsp;<a href="javascript:void(0);" onclick="javascript:popSyncEditor(\''.$name.'\');" >(shareable)</a>'
          : '<a href="javascript:void(0);" onclick="javascript:popSyncEditor(\''.$name.'\');" onmouseover="showhint(\'<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\\'100%\\\'><tr><td>&nbsp;&nbsp;shareable</td></tr></table>\', this, event, \'90px\', \'1\'); return true;"><b><font color=\'black\'>&nbsp;&nbsp;&bull;</font></b></a>';
    } else {
        my $stat = &syncGetStatus($name);
        return '' if $stat == -1;
        return ($syncShowGUIDetails
          ? '&nbsp;&nbsp;<a href="javascript:void(0);" onclick="javascript:popSyncEditor(\''.$name.'\');" >(shareable)</a>'
          : '<a href="javascript:void(0);" onclick="javascript:popSyncEditor(\''.$name.'\');" onmouseover="showhint(\'<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\\'100%\\\'><tr><td>&nbsp;&nbsp;shareable</td></tr></table>\', this, event, \'90px\', \'1\'); return true;"><b><font color=\'black\'>&nbsp;&nbsp;&bull;</font></b></a>') if $stat == 0;
        my $ret = '&nbsp;&nbsp;(<span class="negative">shared: </span>';
        $ret = '&nbsp;&nbsp;(<span class="positive">shared: </span>' if ($stat == 2);
        my $shared = 0;
        while (my($k,$v) = each %{$syncserver}) {
            $k =~ s/:[^:]+$//o;
            if ($v == 0) {
                $ret .= "$k not shared, ";
            } elsif ($v == 1) {
                $ret .= "<span class=\"negative\">$k out of sync, </span>";
                $shared = 1;
            } elsif ($v == 2 or $v == 4) {
                $ret .= "<span class=\"positive\">$k in sync, </span>";
                $shared = 1;
            } elsif ($v == 3) {
                $ret .= "<span class=\"positive\">$k local slave mode, </span>";
                $shared = 1;
            }
        }
        $ret .= ')';
        $ret =~ s/(sync|mode), ([^\)]+?\))$/$1$2/o;
        if ($syncShowGUIDetails) {
            return '<a href="javascript:void(0);" onclick="javascript:popSyncEditor(\''.$name.'\');">'.$ret.'</a>';
        }
        my $color = ($ret =~ /negative/o) ? 'red' : 'green';
        $color = 'black' unless $shared;
        $ret =~ s/"/\\'/go;
        $ret =~ s/\(|\)//go;
        $ret =~ s/, /\<br \/\>/go;
        $ret =~ s/: /:\<hr\>/go;
        return '<a href="javascript:void(0);" onclick="javascript:popSyncEditor(\''.$name.'\');" onmouseover="showhint(\'<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\\\'100%\\\'><tr><td>'.$ret.'</td></tr></table>\', this, event, \'220px\', \'1\'); return true;"><b><font color=\''. $color .'\'>&nbsp;&nbsp;&bull;</font></b></a>';
    }
}

sub syncLoadConfigFile {
    my $RCF;
    lock($syncWriteConfigLock);
    share %ConfigSync unless is_shared(%ConfigSync);
    while (my ($k,$v) = each %Config) {
        $ConfigSync{$k} = &share({});
        $ConfigSync{$k}->{sync_cfg} = -1;
        $ConfigSync{$k}->{sync_server} = &share({});
    }
    return 0 unless &syncCanSync();
    my ($fn) = $syncConfigFile =~ /^ *file:(.+)$/o;
    return 0 unless $fn;
    my $usedfn = $fn;
       (open($RCF,'<',"$base/$fn"))
    || (open($RCF,'<',"$base/$fn.new") && ($usedfn = "$fn.new"))
    || (open($RCF,'<',"$base/$fn.bak") && ($usedfn = "$fn.bak"))
    || (open($RCF,'<',"$base/$fn.bak.bak") && ($usedfn = "$fn.bak.bak"))
    || (open($RCF,'<',"$base/$fn.bak.bak.bak") && ($usedfn = "$fn.bak.bak.bak"))
    || (mlog(0,"error: unable to open file $fn or any backup version of this file") && return 0);
    d("syncLoadConfigFile - $usedfn");
    mlog(0,"warning: the synchronization configuration file '$usedfn' is used instead of '$fn', which is not available") if $usedfn =~ /(?:bak|new)$/o;
    mlog(0,"loading config synchronization configuration file '$usedfn'") if $MaintenanceLog;
    while (<$RCF>) {
        s/\r|\n//go;
        s/[#;].*//o;
        my ($k,$v) = split(/:=/o,$_,2);
        next unless $k;
        next if exists $neverShareCFG{$k};
        next unless exists $Config{$k};
        my @scfg = split(/\s*,\s*/o,$v);
        $ConfigSync{$k}->{sync_cfg} = shift @scfg || 0;
        if (! @scfg) {
            foreach my $se (split(/\|/o,$syncServer)) {
                push @scfg , "$se=1" if $ConfigSync{$k}->{sync_cfg};
            }
        }
        while (my $se = shift @scfg) {
            my ($server,$status) = split(/\s*\=\s*/o,$se);
            next unless $server;
            $status = 3 if (! $isShareMaster && $isShareSlave);
            $ConfigSync{$k}->{sync_server}->{$server} = $status;
        }
    }
    close $RCF;
    &syncWriteConfig();
    return 1;
}

sub syncWriteConfig {
    my $new;
    my $newST;
    return 0 unless &syncCanSync();
    my ($fn) = $syncConfigFile =~ /^ *file:(.+)$/io;
    return 0 unless $fn;
    lock($syncWriteConfigLock);
    (open(my $RCF,'>',"$base/$fn.new")) or return 0;
    open(my $RCFST,'>',"$base/files/sync_failed.txt");
    d('syncWriteConfig');
    binmode $RCF;
    binmode $RCFST;
    for my $idx (0...$#ConfigArray) {
        my $c = $ConfigArray[$idx];
        next if (! $c->[0] || @$c == 5);
        next if $ConfigSync{$c->[0]}->{sync_cfg} == -1;
        next if exists $neverShareCFG{$c->[0]};
        my $st;
        my $data = $c->[0] . ':=' . $ConfigSync{$c->[0]}->{sync_cfg};
        my $syncserver = $ConfigSync{$c->[0]}->{sync_server};
        while (my ($k,$v) = each %{$syncserver}) {
            $data .= ",$k=$v";
            $st = 1 if $v == 1;
        }
        $new .= "$data\n";
        $newST .= "$data\n" if $st;
    }
    print $RCF $new;
    close $RCF;
    if ($newST) {
        print $RCFST '# ' , &timestring() , ' The following configuration values are still out of sync:',"\n\n";
        print $RCFST $newST;
    } else {
        print $RCFST '# ' , &timestring() , ' All configuration values are still synchronized.';
    }
    close $RCFST;
    if (open $RCF,'<',"$base/$fn.bak") {
        binmode $RCF;
        my $bak = join('',<$RCF>);
        close $RCF;
        $new =~ s/\r|\n//go;
        $bak =~ s/\r|\n//go;
        if ($new eq $bak) {
            unlink "$base/$fn.new";
            return 1;
        }
    }
    unlink "$base/$fn.bak.bak.bak";
    rename "$base/$fn.bak.bak","$base/$fn.bak.bak.bak";
    rename "$base/$fn.bak","$base/$fn.bak.bak";
    rename "$base/$fn","$base/$fn.bak";
    rename "$base/$fn.new","$base/$fn";
    mlog(0,"syncCFG: saved sync configuration to $base/$fn") if $MaintenanceLog >= 2;
    $FileUpdate{"$base/$fn".'syncConfigFile'} = ftime("$base/$fn");
    return 1;
}

sub syncConfigDetect {
    my $name = shift;
    
    return if $WorkerNumber > 0;
    return if $syncUser eq 'sync';
    return unless (&syncCanSync() && $enableCFGShare && $isShareMaster && $CanUseNetSMTP);
    return if exists $neverShareCFG{$name};
    return unless exists $Config{$name};
    return if $ConfigSync{$name}->{sync_cfg} < 1;
    my $stat = &syncGetStatus($name);
    return if $stat < 1;
    d("syncConfigDetect $name");
    my $syncserver = $ConfigSync{$name}->{sync_server};
    my ($k,$v);
    my $r = 0;
    while ( ($k,$v) = each %{$syncserver}) {
        next if $v < 1;
        next if $v == 3;
        $r |= $v;
    }
    return unless $r;
    if ($r == 4) {
        while ( ($k,$v) = each %{$syncserver}) {
            $syncserver->{$k} = 2 if $v == 4;
        }
        &syncWriteConfig();
        return;
    }
    mlog(0,"syncCFG: start synchronization of $name") if $MaintenanceLog;
    &cmdToThread('syncConfigSend', $name);
}

sub syncConfigSend {
    my $name = shift;
# ConfigName.sprintf("%.3f",(Time::HiRes::time())).ip|host.cfg
# first line plain var name\r\n  rest Base64 \r\n.\r\n
# varname:=value\r\n
# file start (.+)$
# file eof\s*$
    return 0 if $WorkerNumber < 10000;
    return 0 unless (&syncCanSync() && $enableCFGShare && $CanUseNetSMTP);
    return 0 unless $isShareMaster;
    return 0 if exists $neverShareCFG{$name};
    return 0 unless exists $Config{$name};
    return 0 if $ConfigSync{$name}->{sync_cfg} < 1;
    my $syncserver = $ConfigSync{$name}->{sync_server};
    my ($k,$v);
    my $r = 0;
    while ( ($k,$v) = each %{$syncserver}) {
        next if $v < 1;
        next if $v == 3;
        $r |= $v;
    }
    unless ($r) {return 0;};
    if ($r == 4) {
        while ( ($k,$v) = each %{$syncserver}) {
            $syncserver->{$k} = 2 if $v == 4;
        }
        &syncWriteConfig();
        return 0;
    }
    d("syncConfigSend $name");
    mlog(0,"syncCFG: request to synchronize $name") if $MaintenanceLog;
    my $body = "$name\r\n";
    $body .= MIME::Base64::encode_base64("$name:=" . ${$name},'') . "\r\n";
    my $fil;
    for my $idx (0...$#PossibleOptionFiles) {
        my $f = $PossibleOptionFiles[$idx];
        if ($name eq $f->[0] && $Config{$f->[0]} =~ /^ *file: *(.+)/io) {
           my $ffil = $fil = $1;
           $ffil="$base/$ffil" if $ffil!~/^\Q$base\E/io;
           d("sync: $ffil");
           if (defined ${$name.'RE'} && ${$name.'RE'} =~ /$neverMatchRE/o && -s $ffil) {
              mlog(0,"syncCFG: warning - the file '$fil' is not empty, but the running regex for $name is a never matching regex (used for empty files) - the sync request will be ignored, because it seems that the file contains an invalid regex");
              while (my ($k , $v) = each %{$syncserver}) {
                  next if $v < 1;
                  next if $v == 3;
                  if ($v == 4) {
                      $syncserver->{$k} = 2;
                      next;
                  }
                  if ($v == 1) {
                      $syncserver->{$k} = 2;
                      next;
                  }
              }
              return 0;
           }
           my $fbody = &syncGetFile($fil);
           $body .= $fbody;
           if ($fbody && scalar keys %{$FileIncUpdate{"$ffil$name"}}) {
               foreach (keys %{$FileIncUpdate{"$ffil$name"}}) {
                   $body .= &syncGetFile($_);
                   d("sync: include $_");
               }
           }
           last;
        }
    }
    # send to  %{$syncserver}

    my $failed = 1;
    my $TLS;
    while (my ($MTA , $v) = each %{$syncserver}) {
        next if $v < 1;
        next if $v == 3;
        if ($v == 4) {
            $syncserver->{$MTA} = 2;
            next;
        }
        my $smtp;
      eval {
        my $SMTPMOD; my %args;

        my ($mtaIP) = $MTA =~ /^($IPRe)/o;
        if (   $CanUseNetSMTPTLS
            && $DoTLS == 2
            && ! exists $localTLSfailed{$MTA}
            && ! matchIP($mtaIP,'noTLSIP',0,1)
           )
        {
            $SMTPMOD = 'Net::SMTP::TLS';
            $TLS = 1;
            $args{NoTLS} = 1;
            mlog(0,"syncCFG: will try to use TLS connection to $MTA") if $MaintenanceLog >= 2;
        } else {
            $SMTPMOD = 'Net::SMTP';
            $TLS = 0;
        }

        $smtp = $SMTPMOD->new(
            $MTA,
            Hello   => $myName,
            Debug => $debug,
            Timeout => 5,
            %args
        );
        my $fh = $TLS ? $smtp->{sock} : $smtp;
        my $timeout = (int(length($body) / (1024 * 1024)) + 1) * 60; # 1MB/min
        if (($smtp && ! $TLS &&
             $smtp->command('ASSPSYNCCONFIG ' , ' ' . Digest::MD5::md5_base64($syncCFGPass))->response() == 2 &&
             $smtp->data() &&
             eval {
                 my $blocking = $fh->blocking(0);
                 my $res = NoLoopSyswrite($fh,$body . "\r\n",$timeout);
                 $fh->blocking($blocking);
                 $res;
             } &&
             $smtp->dataend() &&
             $smtp->quit
            )
            or
            (($smtp && $TLS) &&
             ((exists $smtp->{features}->{STARTTLS} && $smtp->starttls()) | 1) &&
             ($smtp->_command('ASSPSYNCCONFIG ' . Digest::MD5::md5_base64($syncCFGPass)) && [$smtp->_response()]->[0] == '250') &&
             ($smtp->data() | 1) &&
             eval {
                 my $blocking = $fh->blocking(0);
                 NoLoopSyswrite($fh,$body . "\r\n",$timeout);
                 $fh->blocking($blocking);
                 1;
             } &&
             ($smtp->dataend() | 1) &&
             ($smtp->quit | 1)
            ))
        {
            mlog(0,"syncCFG: successfully sent config for $name to $MTA") if $MaintenanceLog;
            $syncserver->{$MTA} = 2;
            $failed = 0;
        } else {
            my $text;
            eval{$text = $smtp ? ' - ' . $smtp->message() : " - can't connect to $MTA";};
            mlog(0,"syncCFG: unable to send config for $name to $MTA$text");
            $syncserver->{$MTA} = 1;
        }
      } unless $syncTestMode; # end eval
        if ($@) {
            mlog(0,"syncCFG: error - unable to send config for $name to $MTA - $@");
            $syncserver->{$MTA} = 1;
            $localTLSfailed{$MTA} = 1 if ($TLS);
        }
        if ($syncTestMode) {
            mlog(0,"syncCFG: [testmode] successfully sent config for $name to $MTA") if $MaintenanceLog;
            $syncserver->{$MTA} = 2;
            $failed = 0;
        }
    }
    &syncWriteConfig();
    return $failed;
}

sub syncGetFile {
    d('syncGetFile');
    my $file = shift;
    my $ffil = $file;
    $ffil="$base/$ffil" if $ffil!~/^\Q$base\E/o;
    if ($FileNoSync{$ffil}) {
        mlog(0,"syncCFG: '# assp-no-sync' defined - synchronization ignored for file $base/$ffil");
        return;
    }
    my $body;
    
    if (open my $FH, '<',$ffil) {
        binmode $FH;
        my $cont = join('',<$FH>);
        close $FH;
        if (exists $CryptFile{$ffil} && $cont =~ /^(?:[a-zA-Z0-9]{2})+$/o) {
            my $enc = ASSP::CRYPT->new($webAdminPassword,0);
            $cont = $enc->DECRYPT($cont);
        }
        $body  = MIME::Base64::encode_base64("# file start $file\r\n",'')."\r\n";
        $body .= MIME::Base64::encode_base64($cont,'') . "\r\n";
        $body .= MIME::Base64::encode_base64("# file eof\r\n",'')."\r\n";
    }
    return $body;
}

sub syncSortCFGRec {
   my ($ga) = $main::a =~ /\Q$base\E\/configSync\/([^\.]+)/o;
   my ($gb) = $main::b =~ /\Q$base\E\/configSync\/([^\.]+)/o;
   if ($ConfigNum{$ga} < $ConfigNum{$gb}) { -1; }
   elsif ($ConfigNum{$ga} == $ConfigNum{$gb}) { 0; }
   else { 1; }
}

sub syncConfigReceived {
    my $file = shift;
    return if $WorkerNumber > 0;
    $file =~ s/\\/\//go;
     # ConfigName.sprintf("%.3f",(Time::HiRes::time())).ip|host.cfg
    my ($name,$ip);
    ($name,$ip) = ($1,$2) if $file =~ /\/([^\/\.]+?)\.\d{10}\.\d{3}\.($HostRe)\.cfg$/o;

    unless ($name) {unlink $file; return;}
    unless ($ip) {unlink $file; return;}
    unless (&syncCanSync()) {unlink $file; return;}
    unless ($enableCFGShare) {unlink $file; return;}
    unless ($isShareSlave) {unlink $file; return;}
    if (exists $neverShareCFG{$name}) {unlink $file; return;}
    unless (exists $Config{$name}) {unlink $file; return;}
    my $FH;
    (-w $file && (open $FH, '<',"$file"))  or return;
    d("syncConfigReceived $file $name $ip");

    my ($var,$val,@cfg,$File,$FileCont);
    my $FileWritten = 0;

    binmode $FH;
    my $fcont = join('',<$FH>);
    close $FH;
    if (! $fcont) {
        mlog(0,"syncCFG: file '$file' for $name is empty - ignore the sync-file");
        unlink $file;
        return;
    }
    if (! ($fcont = ASSP::CRYPT->new($webAdminPassword,0)->DECRYPT(join('',$fcont)) )) {
        mlog(0,"syncCFG: no results after decrypt file '$file' for $name - ignore the sync-file");
        unlink $file;
        return;
    }
    foreach my $line (split(/\r?\n/o,$fcont)) {
        $line =~ s/\r|\n//go;
        next unless $line;
        push @cfg , MIME::Base64::decode_base64($line);
    }
    if (! @cfg) {
        mlog(0,"syncCFG: no results after BASE64-decode file '$file' for $name - ignore the sync-file");
        unlink $file;
        return;
    }
    while (@cfg) {
        my $line = shift @cfg;
        $line =~ s/(\r?\n)$//o;
        next if (! $line && ! $File);
        if ($line =~ /^\s*([a-zA-Z0-9_\-]+)\:\=(.*)$/o) {
            ($var,$val) = ($1,$2);
            if ($var ne $name) {
                mlog(0,"syncCFG: Wrong configuration variable name '$var' found - expected '$name' - ignore the sync-file");
                unlink $file;
                return;
            }
            next;
        }
        next unless $var;
        if ($line =~ /^\s*# file start (.+)$/o) {   # file start
            $File = "$base/$1";
            $File .= '.synctest' if $syncTestMode;
            next;
        }
        if ($File && !$FileNoSync{$File} && $line =~ /^\s*# file eof\s*$/o) {   # file eof
            my $currFileCont;
            if (-e $File) {
                if (open my $FileH , '<',"$File") {
                    binmode $FileH;
                    $currFileCont = join('',<$FileH>);
                    close $FileH;
                    if (exists $CryptFile{$File} && $currFileCont =~ /^(?:[a-zA-Z0-9]{2})+$/o) {
                        my $enc = ASSP::CRYPT->new($webAdminPassword,0);
                        $currFileCont = $enc->DECRYPT($currFileCont);
                    }
                }
            }
            if ($currFileCont ne $FileCont && (open my $FileH , '>',"$File")) {
                binmode $FileH;
                if (exists $CryptFile{$File}) {
                    my $enc = ASSP::CRYPT->new($webAdminPassword,0);
                    $FileCont = $enc->ENCRYPT($FileCont);
                }
                print $FileH $FileCont;
                close $FileH;
                my $text = $syncTestMode ? '[testmode] ' : '' ;
                mlog(0,"syncCFG: $text" . "wrote file $File for $name") if $MaintenanceLog;
                $FileWritten = 1;
            }
            $File = '';
            $FileCont = '';
            next;
        }
        $FileCont .= $line if $File;
    }
    if (! $var) {
        mlog(0,"syncCFG: NO configuration variable name found - expected '$name' - ignore the sync-file");
        unlink $file;
        return;
    }
    if ($File && $FileNoSync{$File}) {
        mlog(0,"syncCFG: file $File received for $var - but ignored, because the current file contains '# assp-no-sync'");
    }
    if (${$var} ne $val or $FileWritten) {
        my $ovar = ${$var};
        for my $idx (0...$#ConfigArray) {
            my $c = $ConfigArray[$idx];
            next if (! $c->[0] || @$c == 5 || $c->[0] ne $var);
            my $oqs = $qs{$var};
            $qs{$var} = $val;
            $syncUser = 'sync';
            $syncIP = $ip;
            my $Error; $Error = checkUpdate($var,$c->[5],$c->[6],$c->[1]) unless $syncTestMode;
            mlog(0,"syncCFG: [testmode] changed $name from '$Config{$name}' to '$val'") if $syncTestMode;
            $qs{$var} = $oqs;
            $syncUser = '';
            $syncIP = '';
            delete $qs{$var} unless defined $oqs;
            if ($Error =~ /span class.+?negative/o) {
                 mlog(0,"syncCFG: wrong value ($val) for $var found in sync file from $ip") if $MaintenanceLog;
                 unlink $file;
                 return;
            }
            if (! $ConfigChanged && $FileWritten) {
                $syncUser = 'sync';
                $syncIP = $ip;
                &optionFilesReload();
                $ConfigChanged = 1 if ($val eq $ovar);
                $syncUser = '';
                $syncIP = '';
            }
        }
    }
    
    my $syncserver = $ConfigSync{$name}->{sync_server};
    my ($k,$v,$ns);
    $ns = 0;
    while ( ($k,$v) = each %{$syncserver}) {$ns++ if $isShareMaster && ($v == 1 or $v == 2 or $v == 4);}
    while ( ($k,$v) = each %{$syncserver}) {
        my $isM = $isShareMaster && ($v == 1 or $v == 2 or $v == 4);
        my $s = $k;
        $s =~ s/\:\d+$//o;
        if ($s eq $ip && $isM) {
            $syncserver->{$k} = ($ns == 1) ? 2 : 4;
        } elsif ($isM) {
            $syncserver->{$k} = 1;
        } else {
            $syncserver->{$k} = 3;
        }
    }

    unlink $file;
}

sub syncRCVData {
    my($fh,$l)=@_;
    d('syncRCVData');
    my $this=$Con{$fh};
    if($l=~/^DATA/io) {
        $this->{lastcmd} = 'DATA';
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
        $Con{$fh}->{getline}=\&syncRCVData2;
        sendque($fh,"354 send data\r\n");
    } else {
        ($this->{lastcmd}) = $l =~ /^\s*(\S+)[\s\r\n]+/o;
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
        mlog($fh,"syncCFG: error - syncRCVData expected 'DATA' got $l");
        NoLoopSyswrite($fh,"500 sequence error - DATA expected\r\n",0);
        done($fh);
    }
}

sub syncRCVData2 {
    my($fh,$l)=@_;
    d('syncRCVData2');
    my $this=$Con{$fh};
    $this->{header} .= $l;
    if($this->{header} =~ /\r\n\.\r\n$/os) {
        $Con{$fh}->{getline}=\&syncRCVQuit;
        sendque($fh,"250 OK got all SYNC data\r\n");
    }
}

sub syncRCVQuit {
    my($fh,$l)=@_;
    d('syncRCVQuit');
    my $this=$Con{$fh};
    if($l=~/^QUIT/io) {
        $this->{lastcmd} = 'QUIT';
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
        my $time = sprintf("%.3f",(Time::HiRes::time()));
        my $var; $var = $1 if $this->{header} =~ s/^([^\r\n]+)\r\n//os;
        &NoLoopSyswrite($fh,"221 <$myName> closing transmission for SYNC $var\r\n",0);
        unless (defined ${$var}) {
            mlog(0,"warning: $var is no valid Configuration Parameter - ignore request");
            done($fh);
            return;
        }
        -d "$base/configSync/" or mkdir "$base/configSync", 0755;
        my $file = "$base/configSync/" . $var . '.' . $time  . '.' . $this->{syncServer} . '.cfg';
        if (open my $FH, '>',"$file") {
            binmode $FH;
            $this->{header} =~ s/\.[\r\n]+$//o;
            print $FH ASSP::CRYPT->new($webAdminPassword,0)->ENCRYPT($this->{header});
            close $FH;
            $syncToDo = 1;
        } else {
            mlog(0,"syncCFG: error - unable to write file $file - $!");
        }
    } else {
        ($this->{lastcmd}) = $l =~ /^\s*(\S+)[\s\r\n]+/o;
        push(@{$this->{cmdlist}},$this->{lastcmd}) if $ConnectionLog >= 2;
        mlog($fh,"syncCFG: error - syncRCVQuit expected 'QUIT' got $l");
        NoLoopSyswrite($fh,"500 sequence error after DATA - Quit expected\r\n",0);
    }
    done($fh);
}

sub reloadConfigFile {

    # called on SIG HUP
    d('reloadConfigFile');
    my %newConfig = ();
    mlog(0,"reloading config");
    my $RCF;
    open($RCF,'<',"$base/assp.cfg");
    while (<$RCF>) {
        s/\r|\n//go;
        s/^$UTFBOMRE//o;
        my ($k,$v) = split(/:=/o,$_,2);
        next unless $k;
        $newConfig{$k} = $v;
    }
    close $RCF;
    delete $newConfig{ConfigSavedOK};
    
    my $dec = ASSP::CRYPT->new($Config{webAdminPassword},0);

    foreach (keys %cryptConfigVars) {
        $newConfig{$_} = $dec->DECRYPT($newConfig{$_}) if ($newConfig{$_} =~ /^(?:[a-fA-F0-9]{2}){5,}$/o && defined $dec->DECRYPT($newConfig{$_})) ;
    }
    for my $idx (0...$#ConfigArray) {
        my $c = $ConfigArray[$idx];
        my ($name,$nicename,$size,$func,$default,$valid,$onchange,$description)=@$c;
        if($Config{$name} ne $newConfig{$name}) {
            if($newConfig{$name}=~/$valid/i) {
                my $new=$1; my $info;
                if($onchange) {
                    $info=$onchange->($name,$Config{$name},$new);
                } else {
                    my $app; $app = "from '$Config{$name}' to '$new'" unless (exists $cryptConfigVars{$name});
                    mlog(0,"AdminUpdate: reload config - $name changed $app");
                    ${$name}=$new;

# -- this sets the variable name with the same name as the config key to the new value
# -- for example $Config{myName}="ASSP-nospam" -> $myName="ASSP-nospam";
                }
                if (exists $cryptConfigVars{$name} &&
                    $new =~ /^(?:[a-fA-F0-9]{2}){5,}$/o &&
                    defined $dec->DECRYPT($new)) {
                    
                    $Config{$name} = $dec->DECRYPT($new);
                    ${$name}=$Config{$name};
                } else {
                    $Config{$name}=$new;
                }
                &syncConfigDetect($name);
            } else {
                mlog(0,"AdminUpdate:error: invalid '$newConfig{$name}' -- not changed");
            }
        }
    }
    for my $idx (0...$#PossibleOptionFiles) {
        my $f = $PossibleOptionFiles[$idx];
        if($f->[0] ne 'asspCfg') {
            if (($Config{$f->[0]} =~ /^ *file: *(.+)/io && fileUpdated($1,$f->[0])) or
                 $Config{$f->[0]} !~ /^ *file: *(.+)/io)
            {
                $f->[2]->($f->[0],$Config{$f->[0]},$Config{$f->[0]},'',$f->[1]);
                &syncConfigDetect($f->[0]);
            }
        }
    }

    renderConfigHTML();
    $ConfigChanged = 1;
}

sub getTNEFparts {

    my ($body,$dec,%oldchrset) = @_;
    my @retval;
    my $fh;
    my $msg;
    my $cp;
    my $mc;
    my $ext;
    my $mimetypes;
    my $type;
    my $c;
    my $nc;
    my $encoding;
    my $att;
    my $ln;
    my $tnef;
    my %parms=('output_to_core' => 'ALL', 'debug' => $TNEFDEBUG);
    mlog(0,"info: try to convert TNEF-part");
#    $body = Email::MIME::Encodings::decode($dec => $body);
    unless (open( $fh, '<', \$body)) {
        mlog(0,"error: TNEF-conversion error - unable to open MIME content");
        return @retval;
    }
    $tnef = Convert::TNEF->read($fh, \%parms )  ;
    if (! $tnef) {
        my $err = $Convert::TNEF::errstr;
        mlog(0,'error: TNEF-conversion error - ' . $Convert::TNEF::errstr);
        close $fh;
        return @retval;
    }

    for ($tnef->message) {
        $msg = $_;
        next if (!exists $msg->{MessageClass});
        eval{$cp= $msg->{OemCodepage}->data;};
        $nc = "CP437";
        if ( $cp ) {
            $cp= unpack('H*',$cp);
            $cp=256*hex(substr($cp,2,2))+hex(substr($cp,0,2));
            $cp="CP$cp";
            $cp=Encode::resolve_alias(uc($cp)) ;
            $nc = $oldchrset{$cp};
            $nc = 'UTF-8' if ($nc =~ /utf8|utf-8/io);
            $nc = $cp if (! $nc);
        }
        $mc=$msg->{MessageClass}->data;
        if ( $mc ) {
            $mc=~s/\000//go;
            $mc=~/^[\w\W]+\.([a-zA-Z0-9]{2,4})$/o;
            $ext = $1;
            $mimetypes = MIME::Types->new;
            $type = $mimetypes->mimeTypeOf($ext);
        }
        eval{$c = $msg->{Body}->data;};
        $c =~ s/\000//og;
        if ($nc && $cp && $c) {
            $c = Encode::decode($cp,$c);
            $c = Encode::encode($nc,$c);
        }
        $type = "text/plain" if (! $type);
        $encoding = 'quoted-printable';
        if ($c) {
#            $c = Email::MIME::Encodings::encode($encoding => $c);
            push(@retval ,
                  {content_type => $type,
                   encoding     => $encoding,
                   charset      => $nc
                  }
            );
            push(@retval,$c);
            d('added message part from TNEF to MIME');
            mlog(0,'added message part from TNEF to MIME');
        }
    }
    for ($tnef->attachments) {
        $att = $_;
        eval{$ln = $att->longname;};
        $c='';
        $cp = '';
        $nc = "CP437";
        $type = '';
        $ln=~/^[\w\W]+\.([A-Za-z0-9]{2,4})$/o;
        $ext = $1;
        $mimetypes = MIME::Types->new;
        $type = $mimetypes->mimeTypeOf($ext) if ($ext);
        if ($type) {
            if ($type =~ m,^text/,o) {
                $encoding = 'quoted-printable';
            } else {
                $encoding = 'base64';
            }
        } elsif ($att->data =~ /[^\t\n\r\f\040-\177]/o) {
            $encoding = 'base64';
            $type = "application/octet-stream";
        } else {
            $encoding = 'quoted-printable';
        }
#        eval{$c = Email::MIME::Encodings::encode($encoding => $att->data) if ($att->data);};
        $c = $att->data if ($att->data);
        if ($encoding eq 'quoted-printable') {
            $type = 'text/plain' if (! $type);
            eval{$cp= $att->{OemCodepage}->data;};
            if ($cp) {
                $cp= unpack('H*',$cp);
                $cp=256*hex(substr($cp,2,2))+hex(substr($cp,0,2));
                $cp="CP$cp";
            } else {
                $cp = 'UTF-8';
            }
            $cp=Encode::resolve_alias(uc($cp)) ;
            $nc=$cp;
            $nc = $oldchrset{$cp} if (exists $oldchrset{$cp});
            $nc = 'UTF-8' if ($nc =~ /utf8|utf-8/io);
            if ($nc && $cp && $c) {
                $c = Encode::decode($cp,$c);
                $c = Encode::encode($nc,$c);
            }
        }
        if ($c) {
            if ($encoding eq 'quoted-printable') {
                push(@retval ,
                      {
                       content_type => $type,
                       encoding     => $encoding,
                       charset      => $nc
                      }
                );
            } else {
                push(@retval ,
                      {
                       content_type => $type,
                       encoding     => $encoding,
                       charset      => $nc,
                       disposition  => 'attachment',
                       filename     => $ln,
                       name         => $ln
                      }
                );
            }
            push(@retval,$c);
            d("added attachment part $ln from TNEF to MIME");
            mlog(0,"added attachment part $ln from TNEF to MIME");
        }
    }
    $tnef->purge;
    close $fh;
    return @retval;
}

#####################################################################################
#   transparent Proxy

sub NewProxyConnection {
   my $fh=shift;
   my $fnoC;
   my $fnoS;
   my $mlog = $inSIG ? \&mlog_S : \&mlog ;
   my $d = $inSIG ? \&d_S : \&d ;
   $d->('NewProxyConnection');
   &ThreadMonitorMainLoop('MainLoop NewProxyConnection');
   delete $SocketCalls{$fh};
   my $client=$fh->accept;
   if ( ! $client) {
     threadConDone($fh);
     close($fh);
     threads->yield;
     $trqueue->enqueue("failed");       # tell the main thread that we are not connected!
     threads->yield;
     $mlog->(0,"error: $WorkerName accept to proxy client failed $fh");
     $mlog->(0,"info: $WorkerName freed Main_Thread") if($WorkerLog >= 2);
     exists $Con{$fh} && delete $Con{$fh};
     return;
   }
   threadConDone($fh);
   close($fh);
   exists $Con{$fh} && delete $Con{$fh};
   $fnoC = fileno($client);
   threads->yield;
   $trqueue->enqueue("ok");       # tell the main thread that we are connected!
   threads->yield;
   $mlog->(0,"info: $WorkerName freed Main_Thread") if($WorkerLog >= 2);
   my $ip=$client->peerhost();
   my $port=$client->peerport();
   my $lip=$client->sockhost;
   my $lport=$client->sockport;
   my ($dest,$allow) = split(/<=/o,$Proxy{$lip.':'.$lport});
   $allow =~ s/,/\|/go;
   my $allowProxyConnectionsFrom=$allow;

   ConfigMakeIPRe ('allowProxyConnectionsFrom',$allowProxyConnectionsFrom,$allowProxyConnectionsFrom );
   delete $ConfigWatch{'allowProxyConnectionsFrom'};
   foreach (keys %GroupWatch) {
       delete $GroupWatch{$_}->{'allowProxyConnectionsFrom'};
       delete $GroupWatch{$_} unless scalar keys %{$GroupWatch{$_}};
   }

   if ($allow && ! matchIP($ip,'allowProxyConnectionsFrom', 0, $inSIG)) {
     $mlog->(0,"proxy connection to $lip:$lport from $ip:$port rejected");
     threadConDone($client);
     close($client);
     return;
   }

   my $server = $CanUseIOSocketINET6
                ? IO::Socket::INET6->new(Proto=>'tcp',PeerAddr=>$dest,Timeout=>2,&getDestSockDom($dest))
                : IO::Socket::INET->new(Proto=>'tcp',PeerAddr=>$dest,Timeout=>2);
   if (!$server) {
         $mlog->(0,"error: couldn't create proxy socket to $dest -- aborting connection: $!") ;
         threadConDone($client);
         close($client);
         return;
   }
   $fnoS = fileno($server);
   addProxyfh($client,$server);
   $Con{$client}->{SessionID} = uc "$client";
   $Con{$client}->{SessionID} =~ s/^.+?\(0[xX]([^\)]+)\).*$/$1/o;
   $Con{$client}->{client}   = $client;
   $Con{$client}->{self}     = $client;
   $Con{$client}->{server}   = $server;
   $Con{$client}->{ip}       = $ip;
   $Con{$client}->{port}     = $port;
   $Con{$client}->{localip}  = $lip;
   $Con{$client}->{localport}= $lport;
   $Con{$client}->{type}     = 'C';
   $Con{$client}->{fno}      = $fnoC;
   $Con{$server}->{type}     = 'S';
   $Con{$server}->{fno}      = $fnoS;
   $Con{$server}->{self}     = $server;
   $d->("Proxy-Connected: SID($Con{$client}->{SessionID}) $client -- $server");
}

sub addProxyfh {
  my ($fh,$friend) =@_;
  $SocketCalls{$fh}=\&ProxyTraffic;
  $SocketCalls{$friend}=\&ProxyTraffic;
  $fh->blocking(0);
  $friend->blocking(0);
  &dopoll($fh,$readable,POLLIN);
  &dopoll($friend,$readable,POLLIN);
  binmode($fh);
  binmode($friend);
  $Con{$fh} = {};
  $Con{$friend} = {};
  $Con{$fh}->{friend}   = $friend;
  $Con{$fh}->{isProxyCon} = 1;
  $Con{$fh}->{timelast} = time;
  $Con{$friend}->{friend}   = $fh;
  $Con{$friend}->{isProxyCon} = 1;
  $Con{$friend}->{timelast} = $Con{$fh}->{timelast};
}

sub ProxyTraffic {
  my $fh = shift;
  d('ProxyTraffic');
  $SMTPbuf = '';
  my $friend = $Con{$fh}->{friend};
  $fh->blocking(0) if $fh->blocking;
  &sigoffTry(__LINE__);
  my $hasread = $fh->sysread($SMTPbuf,4096);
  &sigonTry(__LINE__);
  if($hasread > 0 or length($SMTPbuf) > 0) {
    &dopoll($friend,$writable,POLLOUT);
    $Con{$friend}->{outgoing}.=$SMTPbuf;
    $Con{$fh}->{timelast} = time;
    $Con{$friend}->{timelast} = $Con{$fh}->{timelast};
  } else {
    doneProxy($fh) if ($Con{$fh}->{timelast} + 1 < time);
#    doneProxy($fh) if ($Con{$fh}->{type} eq 'C');
  }
  $SMTPbuf = '';
}


sub doneProxy {
  my $fh = shift;
  $fh = $Con{$fh}->{self} if $Con{$fh}->{self};
  my $cliIP;
  my $serIP;
  if (! exists $ConDelete{$fh}) {
     $ConDelete{$fh} = \&doneProxy;
     return;
  }
  return unless $fh;
  return unless $Con{$fh};
  my $mode ="Proxy";
  $mode = "TLS" if ($Con{$fh}->{runTLS});
  eval{$cliIP=$fh->peerhost().":".$fh->peerport();
  $serIP=$Con{$fh}->{friend}->peerhost().":".$Con{$fh}->{friend}->peerport();};
  mlog(0,"info: closed $mode connection for $serIP and $cliIP") if $ConnectionLog;
  if ($Con{$fh}->{friend}) {
    delete $SocketCalls{$Con{$fh}->{friend}};
    unpoll($Con{$fh}->{friend},$readable);
    unpoll($Con{$fh}->{friend},$writable);
    if ($mode eq "TLS") {
      if (exists $SMTPSession{$Con{$fh}->{friend}}) {
        delete $SMTPSession{$Con{$fh}->{friend}};
        threads->yield;
        $smtpConcurrentSessions=0 if --$smtpConcurrentSessions < 0;
        threads->yield;
        $SMTPSessionIP{Total}-- ;
        threads->yield;
        delete $SMTPSessionIP{$Con{$Con{$fh}->{friend}}->{ip}} if (--$SMTPSessionIP{$Con{$Con{$fh}->{friend}}->{ip}} <= 0);
        threads->yield;
      }
  }
  eval{close($Con{$fh}->{friend});} if (fileno($Con{$fh}->{friend}));
  threadConDone($Con{$fh}->{friend});
  delete $Con{$Con{$fh}->{friend}};
  }
  delete $SocketCalls{$fh};
  unpoll($fh,$readable);
  unpoll($fh,$writable);
  if ($mode eq "TLS") {
    if (exists $SMTPSession{$fh}) {
      delete $SMTPSession{$fh};
      threads->yield;
      $smtpConcurrentSessions=0 if --$smtpConcurrentSessions<0;
      threads->yield;
      $SMTPSessionIP{Total}--;
      threads->yield;
      delete $SMTPSessionIP{$Con{$fh}->{ip}} if (--$SMTPSessionIP{$Con{$fh}->{ip}} <= 0);
      threads->yield;
    }
  }
  threadConDone($fh);
  eval{close($fh);}  if (fileno($fh));
  delete $Con{$fh};
}

sub configChangeProxy {
 my ($name, $old, $new, $init)=@_;

 if (! $init && $WorkerNumber == 0) {
  while (my ($k,$v) = each(%Proxy)) {
    unpoll($ProxySocket{$k},$readable);
    unpoll($ProxySocket{$k},$writable);
    eval{close($ProxySocket{$k});};
    mlog(0,"proxy listening on $k was closed");
   }
   %Proxy = ();
  }

 mlog(0,"AdminUpdate: Proxy Table updated from '$old' to '$new'") unless $init || $new eq $old;
 $ProxyConf=$Config{ProxyConf}=$new unless $WorkerNumber;
 $new=checkOptionList($new,'ProxyConf',$init);
 my $k;
 for my $v (split(/\|/o,$new)) {
     $v=~/^(.*?)\=\>(.*)$/o;
     $Proxy{$1}=$2;
 }
 if (! $init && $WorkerNumber == 0) {
  while (my ($k,$v) = each(%Proxy)) {
        my ($to,$allow) = split(/<=/o, $v);
        $allow = " allowed for $allow" if ($allow);
        my ($ProxySocket,$dummy) = newListen($k,\&ConToThread,2);
        $ProxySocket{$k} = shift @$ProxySocket;
        for (@$dummy) {s/:::/\[::\]:/o;}
        mlog(0,"proxy started: listening on @$dummy forwarded to $to$allow");
  }
 }
 return;
}

sub RcptReplace {
  my ($recpt,$sender,$RecRepRegex) = @_;
  my $new = $recpt;
  my @new;
  my @ret;
  $ret[0] = "result";
  my $k;
  my $v;
  my $ad;
  my $bd;
  my $jmptarget;
  my $sendertext;

  if ($sender) {
    $sendertext = "for sender $sender";
  } else {
    $sendertext = "for all senders";
  }

  push(@ret,"try replace $recpt $sendertext with rules in configuration");

  foreach (sort(keys(%$RecRepRegex))) {
    $k = $_;
    if ($jmptarget && $k ne $jmptarget) {
       next;
    } else {
       $jmptarget = '';
    }
    $v = $$RecRepRegex{$k};
    my ($type,$toregex,$replregex,$sendregex,$nextrule,$jump) = split(/<=>/o,$v);
    $sendregex = '*' if ($sendregex eq '' && ($type eq 'S' || $type eq ''));
    $sendregex = '.*' if ($sendregex eq '*' && $type eq 'R');
    $type = uc($type);
    if ($type eq 'S' || $type eq '') {
      $toregex   = RcptRegexMake($toregex,1);
      $replregex = RcptRegexMake($replregex,0);
      $sendregex = RcptRegexMake($sendregex,1);
    }
    next if($type ne 'S' && $type ne '' && $type ne 'R');
    @new = RecRep($toregex,$replregex,$sendregex,$recpt,$sender,$k);
    $new = shift(@new);
    push (@ret, "$k $v");
    if ($type eq 'S' || $type eq '') {push (@ret,"$k  :R\<=\>$toregex\<=\>$replregex\<=\>$sendregex\<=\>$nextrule\<=\>$jump : regex $k");}
    @new = @ret;
    $ad = @new - 1;
    $bd = $ad;
    $ad = $new[$ad];
    $new[$bd] = '';

    if ($ad eq '1' && $nextrule == 1) {       # match and action if
      if ($jump) {
        if (! exists $$RecRepRegex{$jump}) {
          if ($jump eq 'END') {
             push (@ret, "$k jumptarget: rule $jump - found in rule $k - end processing");
          } else {
             push (@ret, "$k jumptarget: rule $jump - not found in rule $k - end processing");
          }
          last;
        }
        if ($jump eq $k) {
          push (@ret, "$k jumptarget: jump to the same rule $jump is not permitted - end processing");
          last;
        }
        if ($jump lt $k) {
          push (@ret, "$k jumptarget: jump backward from rule $k to rule $jump is not permitted - end processing");
          last;
        }
        $jmptarget = $jump;
        push (@ret, "$k jump: to rule $jump");
        next;
      }
      last;
    }

    if ($ad eq '0' && $nextrule == 2) {     # no match and action if
      if ($jump) {
        $recpt = $new;
        if (! exists $$RecRepRegex{$jump}) {
          if ($jump eq 'END') {
             push (@ret, "$k jumptarget: rule $jump - found in rule $k - end processing");
          } else {
             push (@ret, "$k jumptarget: rule $jump - not found in rule $k - end processing");
          }
          last;
        }
        if ($jump eq $k) {
          push (@ret, "$k jumptarget: jump to the same rule $jump is not permitted - end processing");
          last;
        }
        if ($jump lt $k) {
          push (@ret, "$k jumptarget: jump backward from rule $k to rule $jump is not permitted - end processing");
          last;
        }
        $jmptarget = $jump;
        push (@ret, "$k jump: to rule $jump");
        next;
      }
      last;
    }

    if ($nextrule == 0 && $jump) {
       $jmptarget = $jump;
       push (@ret, "$k jump: to rule $jump");
    }

    $recpt = $new;
  }
  if ($k) {
    push (@ret, "returns: $new after rule $k in configuration");
  } else {
    push (@ret, "returns: $new - no rule found in configuration");
  }
  if (wantarray) {
    $ret[0] = $new;
    return @ret;
  } else {
    return $new;
  }
}

sub RecRep {
  my ($toregex,$replregex,$sendregex,$recpt,$sender,$rnum) = @_;
  my @retval;
  my $cmpl_error;
  $retval[0] = "result";

  $cmpl_error = RecRepSetRE('TO_RE',$toregex);
  push (@retval, $cmpl_error) if ($cmpl_error);
  $cmpl_error = RecRepSetRE('RP_RE',$replregex);
  push (@retval, $cmpl_error) if ($cmpl_error);
  $cmpl_error = RecRepSetRE('SE_RE',$sendregex);
  push (@retval, $cmpl_error) if ($cmpl_error);

  if ($sender =~ /$SE_RE/i && $recpt =~ /$TO_RE/i) {

    push (@retval, "$rnum  |\$1=$1|\$2=$2|\$3=$3|\$4=$4|\$5=$5|\$6=$6|\$7=$7|\$8=$8|\$9=$9|");
    my $d1 = $1;my $d2 = $2;my $d3 = $3;
    my $d4 = $4;my $d5 = $5;my $d6 = $6;
    my $d7 = $7;my $d8 = $8;my $d9 = $9;


    $replregex =~ s/\$1/$d1/;
    $replregex =~ s/\$2/$d2/;
    $replregex =~ s/\$3/$d3/;
    $replregex =~ s/\$4/$d4/;
    $replregex =~ s/\$5/$d5/;
    $replregex =~ s/\$6/$d6/;
    $replregex =~ s/\$7/$d7/;
    $replregex =~ s/\$8/$d8/;
    $replregex =~ s/\$9/$d9/;
    if (wantarray){
      $retval[0] = $replregex;
      push(@retval,'1');
      return @retval;
    } else {
      return $replregex;
    }
  } else {
    if (wantarray){
      $retval[0] = $recpt;
      push(@retval,'0');
      return @retval;
    } else {
      return $recpt;
    }
  }
}

sub RecRepSetRE {
 use re 'eval';
 my ($var,$r)=@_;
 eval{$$var=qr/(?i)$r/;1;} or return $@;
 return;
}

sub RcptRegexMake {
  my ($string,$how) = @_;
  if ($how) {
    $string =~ s/\./\\\./go;
    $string =~ s/\*/\(\.\*\)/go;
    $string =~ s/\+/\(\.\+\)/go;      # hidden option
    $string =~ s/\?/\(\.\?\)/go;      # hidden option
    $string =~ s/\;/\(\.\)/go;        # hidden option
    $string = "^".$string."\$";
  } else {
    my $i = 1;
    while ($string =~ /\*/o) {
       $string =~ s/\*/\$$i/o ;
       $i++;
    }
  }
  return $string;
}

sub configChangeRcptRepl {
 my ($name, $old, $new, $init)=@_;
 return if $WorkerNumber > 0;
 mlog(0,"AdminUpdate: recipient replacement updated from '$old' to '$new'") unless $init || $new eq $old;

 $ReplaceRecpt=$Config{ReplaceRecpt}=$new unless $WorkerNumber;
 $new=checkOptionList($new,'ReplaceRecpt',$init);
 my $k;
 my $i = 0;
 my $j = 0;
 my $t1;
 my $t2;
 my %rules;
 my $ret;
 
 for my $v (split(/\|/o,$new)) {
     $v=~/(.*?)\<\=\>(.*?\<\=\>.*?\<\=\>.*?\<\=\>.*?\<\=\>.*?\<\=\>.*)/o;
     $t1 = $1;
     $t2 = $2;
     if ($t1 eq '') { # rule is disabled
       $j++;
       next;
     }
     if (! $t1 && ! $t2) {
       $ret .= ConfigShowError(1,"ERROR: syntax error in recipient replacement rule $v");
       $j++;
       next;
     }
     if (! $t2) {
       $ret .= ConfigShowError(1,"ERROR: syntax error in recipient replacement rule $v");
       $j++;
       next;
     }
     if ($t1 =~ /END/o) {
       $ret .= ConfigShowError(1,"ERROR: rule number END is not permitted - in recipient replacement rule $v");
       $j++;
       next;
     }
     if (exists $rules{$t1}) {
       $ret .= ConfigShowError(1,"ERROR: rule number $t1 is already defined with $rules{$t1} - ignore entry $v");
       $j++;
       next;
     }
     $i++;
     $rules{$t1}=$t2;
 }
 %RecRepRegex = %rules;
 my $tlit = $init ? 'info: ' : 'AdminUpdate: ';
 if ($i) {
   $ret .= ConfigShowError(0, $tlit."enabled $i recipient replacement rules - $j rules skipped");
 } else {
   $ret .= ConfigShowError(0, $tlit. "no valid recipient replacement rule found");
 }
 return $ret;
}

sub CheckRcptRepl {
 my $RecReprecipient = $qs{RecReprecipient};
 my $RecRepsender = $qs{RecRepsender};
 my $RecRepresult = '';
 my @RecRepresult;
 my $RecRepdspres = '';
 my $RecRepbutton;
 my $disabled = '';
 my $link_to_RecRep_config = $WebIP{$ActWebSess}->{lng}->{'msg500040'} || $lngmsg{'msg500040'};

 my $updres;
 my $file;

 if ($ReplaceRecpt =~ /^ *file: *(.+)/io) {
    $file=$1; $file="$base/$file" if $file!~/^\Q$base\E/io;
    if ( $FileUpdate{$file} != ftime($file) ) {
      $updres = configChangeRcptRepl('ReplaceRecpt',$ReplaceRecpt,$ReplaceRecpt,0);
    }
 }

 if ($ReplaceRecpt) {
   if ($qs{B1} =~ /Check/o){
       @RecRepresult = RcptReplace($RecReprecipient,$RecRepsender,'RecRepRegex');
       if ($updres) {
          $RecRepresult = $RecRepresult[0];
          $RecRepresult[0] = $updres;
       } else {
          $RecRepresult = shift(@RecRepresult);
       }
   }
   $RecRepbutton ='
    <tr>
        <td class="noBorder">&nbsp;</td>
        <td class="noBorder"><input type="submit" name="B1" value="  Check  " /></td>
        <td class="noBorder">&nbsp;</td>
    </tr>';
   foreach (@RecRepresult) {
     next if ($_ eq '1' || $_ eq '0');
     s/configuration$/ file $file/ if ($file);
     $RecRepdspres .= "$_\<br /\>";
   }
 } else {
   @RecRepresult = ();
   push (@RecRepresult, $WebIP{$ActWebSess}->{lng}->{'msg500041'} || $lngmsg{'msg500041'});
   $disabled = "disabled";
 }

 if ($ReplaceRecpt =~ /^ *file: *(.+)/io) {
  $file = $1;
  if ($file) {
    $link_to_RecRep_config = $WebIP{$ActWebSess}->{lng}->{'msg500042'} || $lngmsg{'msg500042'};
    $link_to_RecRep_config .= $file.' &nbsp;<input type="button" value="Edit" onclick="javascript:popFileEditor(\''.$file.'\',3);" /></p>';
  }
 }
 my $h1 = $WebIP{$ActWebSess}->{lng}->{'msg500043'} || $lngmsg{'msg500043'};

<<EOT;
$headerHTTP
$headerDTDTransitional
$headers
<div id="cfgdiv" class="content">
<h2>recipient replacement test</h2>
<div class="textBox">
$link_to_RecRep_config
</div>
<form method="post" action=\"\">
    <table class="textBox" style="width: 99%;">
        <tr>
            <td class="noBorder">recipient : </td>
            <td class="noBorder">
            <input type="text" $disabled size="30" name="RecReprecipient" value="$RecReprecipient"</td>
        </tr>
        <tr>
            <td class="noBorder">sender    : </td>
            <td class="noBorder">
            <input type="text" $disabled size="30"  name="RecRepsender" value="$RecRepsender"</td>
        </tr>
        <tr><td class="noBorder">  </td></tr>
        <tr>
            <td class="noBorder">result    : </td>
            <td class="noBorder">
            <p>$RecRepresult</p></td>
        </tr>
        $RecRepbutton
    </table>
</form>
<div class="textBox">
$h1
$RecRepdspres
</form>
<form name="ASSPconfig" id="ASSPconfig" action="" method="post">
  <input name="theButtonLogout" type="hidden" value="" />
</form>
</div>
</div>
$footers
</body></html>
EOT

}

sub ChangeMyPassword {

   my $oldpwd = $qs{old_password};
   my $newpwd = $qs{new_password};
   my $newpwd2 = $qs{new_password2};
   my $hint;
   
   if ($WebIP{$ActWebSess}->{user} eq 'root') {
       my $subst = '<a href="./#webAdminPassword" style="color:#684f00" onmousedown="showDisp(\''.$ConfigPos{webAdminPassword}.'\');gotoAnchor(\'webAdminPassword\');return false;" >' ;
       return <<EOT ;
$headerHTTP
$headerDTDTransitional
$headers
<div id="cfgdiv" class="content">
<h2><span class="negative">You are root - please go to <a href="./#webAdminPassword" style="color:#684f00" onmousedown="showDisp(\'$ConfigPos{webAdminPassword}\');gotoAnchor(\'webAdminPassword\');return false;" >webAdminPassword</a> to change your password!</span></h2>
<form name="ASSPconfig" id="ASSPconfig" action="" method="post">
<input name="theButtonLogout" align="right" type="button" value="Logout" onclick="eraseCookie('lastAnchor');window.location.href='./logout';return false;"/>
</form>
</div>
$footers
</body></html>
EOT
   }

   if ($CanUseLDAP && $AdminUsersRight{$WebIP{$ActWebSess}->{user}.'.user.LDAPserver'}) {
       $hint .= 'Your account is configured to use LDAP authentication - your LDAP password will not be changed!<br />';
   }

   if (!$oldpwd && !$newpwd && !$newpwd2) {
       $hint .= 'Please write your old password and the new password two times. The minimum length is 5 characters!';
   } elsif (($newpwd  or $newpwd2) && $newpwd ne $newpwd2) {
       $hint .= '<span class="negative">the new passwords are not equal</span>';
       $newpwd = '';
       $newpwd2 = '';
   } elsif (length($newpwd) < 5) {
       $hint .= '<span class="negative">the new passwords are to short - minimum length is 5 characters</span>';
       $newpwd = '';
       $newpwd2 = '';
   } elsif (Digest::MD5::md5_hex($oldpwd) ne $AdminUsers{$WebIP{$ActWebSess}->{user}}) {
       $hint .= '<span class="negative">wrong old password</span>';
       $oldpwd = '';
       $newpwd = '';
       $newpwd2 = '';
   } elsif ($oldpwd && $oldpwd eq $newpwd) {
       $hint .= '<span class="negative">old and new password are the same - use a different password</span>';
       $newpwd = '';
       $newpwd2 = '';
   } else {
       $AdminUsers{$WebIP{$ActWebSess}->{user}} = Digest::MD5::md5_hex($newpwd);
       $AdminUsersRight{$WebIP{$ActWebSess}->{user}.'.user.passwordLastChange'} = time;
       $AdminUsersRight{$WebIP{$ActWebSess}->{user}.'.user.passwordExp'} = '';
       $WebIP{$ActWebSess}->{isauth} = 1;
       $AdminUsersObject->flush();
       $AdminUsersRightObject->flush();
       return <<EOT ;
$headerHTTP
$headerDTDTransitional
$headers
<div id="cfgdiv" class="content">
<h2><span class="positive">Your Password was successfuly changed</span></h2>
<form name="ASSPconfig" id="ASSPconfig" action="" method="post">
<input name="theButtonLogout" align="right" type="button" value="Logout" onclick="eraseCookie('lastAnchor');window.location.href='./logout';return false;"/>
</form>
</div>
$footers
</body></html>
EOT
   }
   

   my $button ='
    <tr>
        <td class="noBorder">&nbsp;</td>
        <td class="noBorder"><input type="submit" name="B1" value="  submit  " /></td>
        <td><input name="theButtonLogout" align="right" type="button" value="Logout" onclick="eraseCookie(\'lastAnchor\');window.location.href=\'./logout\';return false;"/></td>
        <td class="noBorder">&nbsp;</td>
    </tr>';

<<EOT;
$headerHTTP
$headerDTDTransitional
$headers
<div id="cfgdiv" class="content">
<h2>Change Your Password</h2>
<form name="ASSPconfig" id="ASSPconfig" action="" method="post">
    <table class="textBox" style="width: 50%;">
        <tr>
            <td class="noBorder">old password : </td>
            <td class="noBorder">
            <input type="password" size="30" name="old_password" value="$oldpwd"</td>
        </tr>
        <tr>
            <td class="noBorder">new password : </td>
            <td class="noBorder">
            <input type="password" size="30"  name="new_password" value="$newpwd"</td>
        </tr>
        <tr><td class="noBorder">  </td></tr>
        <tr>
            <td class="noBorder">new password : </td>
            <td class="noBorder">
            <input type="password" size="30"  name="new_password2" value="$newpwd2"</td>
        </tr>
        $button
    </table>
</form>
$hint
</div>
$footers
</body></html>
EOT

}

sub ManageAdminUsers {
    my $s;
    my $sfoot;
    my $display;
    my $options;
    %qs = () unless($qs{theButton} or $qs{theButtonX} or $qs{theButtonA} or $qs{theButtonDelete} or $qs{showLDAP});
    my $suser = $qs{suser};
    my $user = $qs{user};
    $user = '' if $qs{showLDAP};
    my $toTop;
#    mlog(0,"info: suser=$suser user=$user");
    my $buttons = <<EOT;
<div class="rightButton">
  <input name="theButton" type="submit" value="Continue" onclick="WaitDiv();"/>
  <input name="theButtonCancel" type="button" value="Cancel" onclick="window.location.href='./';return false;"/>
  <input name="theButtonLogout" type="button" value="Logout" onclick="eraseCookie('lastAnchor');window.location.href='./logout';return false;"/>
</div>
EOT
    my $applybutton = <<EOT;
  <input name="theButtonA" type="submit" align="left" value="Apply Changes" onclick="WaitDiv();"/>
  <input name="theButton" align="right" type="submit" value="Continue" onclick="WaitDiv();"/>
  <input name="theButtonCancel" align="right" type="button" value="Cancel" onclick="window.location.href='./';return false;"/>
  <input name="theButtonLogout" align="right" type="button" value="Logout" onclick="eraseCookie('lastAnchor');window.location.href='./logout';return false;"/>
EOT
    my $mainhint = $WebIP{$ActWebSess}->{lng}->{'msg500020'} || $lngmsg{'msg500020'};

    $s = <<EOT;
$headerHTTP
$headerDTDTransitional
$headers
<script type="text/javascript">
<!--
function showDisp(nodeid) {}
function expand(expand, force) {}
function setAnchor(iname) {}
// -->
</script>
<div id="cfgdiv" class="content">
<h2>Manage Admin Users!</h2>
<div>
$mainhint
</div>
<form name="ASSPconfig" id="ASSPconfig" action="" method="post">
<input name="theButtonX" type="hidden" value="" onclick="WaitDiv();"/>
EOT
    $sfoot = <<EOT;
</form>
</div>
$footers
</body></html>
EOT


    if (! ($adminusersdb && $adminusersdbpass) ) {

       my $missing = ($adminusersdb ? '' : <<EOT) ;
<h2><span class="negative">Please configure <a href="./#adminusersdb" style="color:#684f00" onmousedown="showDisp(\'$ConfigPos{adminusersdb}\');gotoAnchor(\'adminusersdb\');return false;" >adminusersdb</a> first!</span></h2>
EOT
       $missing .= ($adminusersdbpass ? '' : <<EOT) ;
<h2><span class="negative">Please configure <a href="./#adminusersdbpass" style="color:#684f00" onmousedown="showDisp(\'$ConfigPos{adminusersdbpass}\');gotoAnchor(\'adminusersdbpass\');return false;" >adminusersdbpass</a> first!</span></h2>
EOT
       return <<EOT ;
$headerHTTP
$headerDTDTransitional
$headers
<div id="cfgdiv" class="content">
$missing
<form name="ASSPconfig" id="ASSPconfig" action="" method="post">
<input name="theButtonLogout" align="right" type="button" value="Logout" onclick="eraseCookie('lastAnchor');window.location.href='./logout';return false;"/>
</form>
</div>
$footers
</body></html>
EOT
    }

    $AdminUsers{'~DEFAULT'} = '' if (! exists $AdminUsers{'~DEFAULT'}) ;
# select user
    if ($qs{theButtonDelete} && $suser) {
        if ($suser !~ /^\~DEFAULT|\#/o) {
            while (my ($k,$v) = each(%AdminUsersRight)) {
                delete $AdminUsersRight{$k}
                    if ($k =~ /^$suser\./ or $v eq "refto($suser)");
            }
            delete $AdminUsers{$suser};
            mlog(0,"info: AdminUser $suser deleted by root");
            my $t = $suser =~ /^\~/o ? 'template' : 'user';
            $s .= "<hr><span class=\"positive\">$t $suser was successful deleted</span><br/ >";
        } else {
            my $t = $suser =~ /^\~/o ? 'template' : 'user';
            $s .= "<hr><span class=\"negative\">you cannot delete $t $suser</span><br/ >";
        }
        $suser = '';
        $user = '';
        %qs = ();
        $toTop = 1;
        %ManageAdminUser = ();
        %ManageActions = ();
        %ManagePerm = ();
        $AdminUsersObject->flush();
        $AdminUsersRightObject->flush();
    }
    
    if (($user && $suser ne $user && $suser !~ /^\#/o) or ($ManageAdminUser{suser} && $ManageAdminUser{suser} ne $suser)) {
        $user = '';
        %qs = ();
        $toTop = 1;
        %ManageAdminUser = ();
        $ManageAdminUser{suser} = $suser if $suser;
        %ManageActions = ();
        %ManagePerm = ();
    }
        
    my %userselect = ( '#newUser' => 1, '#newTemplate' => 1);
    foreach (sort keys %AdminUsers) {$userselect{$_} = 1;}
    
    foreach my $k (sort keys %userselect) {
        if ( $user eq $k or $suser eq $k) {
            $options .= "<option selected=\"selected\" value=\"$k\">$k</option>";
        } else {
            $options .= "<option value=\"$k\">$k</option>";
        }
    }
    $s .= "<hr>
    <div class=\"shadow\">
    <div class=\"option\">
    <div class=\"optionValue\"><b>select user : </b>
    <span style=\"z-Index:100;\"><select size=\"1\" name=\"suser\">
    $options
    </select></span>&nbsp;&nbsp;&nbsp;&nbsp;
    <input name=\"theButtonDelete\" type=\"submit\" value=\"delete user\" onclick=\"WaitDiv();\"/>
    </div></div></div><hr>
    ";

    if (! $suser || $toTop) {
        $s .= $buttons.$sfoot;
        %ManageAdminUser = ();
        %ManageActions = ();
        %ManagePerm = ();
        return $s;
    }
    $ManageAdminUser{suser} = $suser;
    
# input username
    $user = $suser if (!$user && $suser !~ /^\#/o);
    if ($user) {
        $user = '' if ($user =~ /^\#/o);
        $user = '~'.$user if($user !~ /\~/o && $suser eq '#newTemplate');
    }
    $display = '';
    $display = 'readonly' if ($user);
    my $objectclass = $qs{objectclass} || 'person'; $objectclass=~s/\s//go;
    my $attr = $qs{attr} || 'uid'; $attr=~s/\s//go;
    $s .= "<div class=\"shadow\"><div class=\"option\"><div class=\"optionValue\">
<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\"50%\" >
<tr><td><b>user name : </b></td><td><input name=\"user\" size = \"40\" $display value=\"$user\" /></td></tr>";
    if ($LDAPHost && $CanUseLDAP && ! $user && $suser ne '#newTemplate') {
        $s .= "<tr><td><b>show LDAP users : </b></td><td>
            select : <input name=\"selLDAP\" size = \"15\" value=\"$qs{selLDAP}\" />&nbsp;&nbsp;
            <input name=\"showLDAP\" type=\"submit\" value=\"show\" onclick=\"WaitDiv();\"/>
            <br />wildcards * and ? are supported<br />example: adm* or ?.meyer*<br /><br />
            <table BORDER CELLSPACING=0 CELLPADDING=4>
            <tr><td>LDAP objectclass : </td><td><input name=\"objectclass\" size = \"20\" value=\"$objectclass\" /></td></tr>
            <tr><td>LDAP return attribute : </td><td><input name=\"attr\" size = \"20\" value=\"$attr\" /></td></tr></table>
            </td></tr>";
    }
    $s .= "</table></div></div></div><hr>";
    if (! $user || $user eq 'root' || (exists $AdminUsers{$user} && $suser =~ /^\#/o)) {
        $s .= "wrong user name - $user already exists" if exists $AdminUsers{$user};
        $s .= "wrong user name - root is not manageable" if $user eq 'root';

        unless ($user) {
            $s .= "username required<br />";
            my %ldap = ('ldapfilt' => '(objectclass='. $objectclass .')', 'attr' => $attr);
            if ($LDAPHost &&
                $CanUseLDAP &&
                $qs{showLDAP} &&
                $suser ne '#newTemplate' &&
                (my @ldapusers = sort {"\U$main::a" cmp "\U$main::b"} &LDAPList(%ldap))) {

    $s .= "<div class=\"shadow\"><div class=\"option\"><div class=\"optionValue\">
<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\"99%\" HIGH=\"30%\">
<tr><td WIDTH=\"20%\">
<b>users available via LDAP:</b><br />click the name to select</td><td>";

                my $regex = $qs{selLDAP};
                $regex =~ s/\./\\\./o;
                $regex =~ s/\*/\.\*/o;
                $regex =~ s/\?/\./o;
                $regex = '.*' unless $regex;
                use re 'eval';
                if ($regex !~ /\*|\?/o) {
                    eval{$regex=qr/(?i)$regex/};
                } else {
                    eval{$regex=qr/^(?i)$regex$/};
                }
                my $fchar; $fchar = lc substr($ldapusers[0],0,1) if @ldapusers;
                while (@ldapusers) {
                    my $un = shift @ldapusers;
                    next unless $un;
                    if ($un =~ /$regex/) {
                        if (lc substr($un,0,1) ne $fchar) {
                            $fchar = lc substr($un,0,1);
                            $s =~ s/,$//o;
                            $s .= '<br /><br />';
                        }
                        $s .= "<a href=\"javascript:void(0);\" onmousedown=\"document.forms['ASSPconfig'].user.value='$un';return false;\"> $un </a>,";
                    }
                }
                $s =~ s/,$//o;
                $s .= "</td></tr></table></div></div></div><hr>";
            }
        }
        $s .= $buttons.$sfoot;
        %ManageActions = ();
        %ManagePerm = ();
        return $s;
    }

# define password handling
    my $actPassCfg = $qs{actPassCfg};

    my $password = $qs{password};
    $password = Digest::MD5::md5_hex($password) if ($password && $password !~ /^[a-fA-F0-9]{32}$/o);
    my $passwordExp = $qs{passwordExp};
    my $passwordExpInt = $qs{passwordExpInt};
    my $disabled = $qs{disabled};
    my $languageFile = $qs{languageFile};
    my $hidDisabled = $qs{hidDisabled};
    my $LDAPserver = $qs{LDAPserver};
    my $LDAPversion = $qs{LDAPversion};
    my $LDAProot = $qs{LDAProot};
    my $LDAPssl = $qs{LDAPssl};

    if (!$actPassCfg) {
        $password ||= $AdminUsers{$user};
        $passwordExp ||= $AdminUsersRight{"$user.user.passwordExp"};
        $passwordExpInt ||= $AdminUsersRight{"$user.user.passwordExpInt"} || 30;
        $disabled ||= $AdminUsersRight{"$user.user.disabled"};
        $languageFile ||= $AdminUsersRight{"$user.user.languageFile"};
        $hidDisabled ||= $AdminUsersRight{"$user.user.hidDisabled"};
        $LDAPserver ||= $AdminUsersRight{"$user.user.LDAPserver"};
        if ($password) {
            $LDAPserver ||= $qs{LDAPserver};
        } else {
            $LDAPserver ||= $LDAPHost;
        }
        $LDAPversion ||= $AdminUsersRight{"$user.user.LDAPversion"} || $LDAPVersion || 3;
        $LDAProot ||= $AdminUsersRight{"$user.user.LDAProot"};
        $LDAPssl ||= $AdminUsersRight{"$user.user.LDAPssl"};
        if ($password) {
            $LDAPssl ||= $qs{LDAPssl};
        } else {
            $LDAPssl ||= $DoLDAPSSL;
        }
    }

    $s .= "<div class=\"shadow\"><div class=\"option\"><div class=\"optionValue\">";
    $s .= "<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\"50%\" >";
    $display = '';
    $display = 'readonly' if ($suser =~ /^\#newTemplate/o or $suser =~ /^\~/o);
    $s .= "<tr><td><b>local password : </b></td><td><input name=\"password\" type=\"password\" size = \"20\" $display value=\"$password\" /></td></tr>";
    $display = '';
    my $checked=$passwordExp?'checked="checked"':'';
    $s .= "<tr><td><b>set local password to expired: </b></td><td><input name=\"passwordExp\" type=\"checkbox\" $checked value=\"1\" /></td></tr>";
    $s .= "<tr><td><b>local password expiration interval : </b></td><td><input name=\"passwordExpInt\" size = \"5\" value=\"$passwordExpInt\" /></td></tr>";
    $checked=$disabled?'checked="checked"':'';
    $s .= "<tr><td><b>disable the user : </b></td><td><input name=\"disabled\" type=\"checkbox\" $checked value=\"1\" /></td></tr>";

    my $lFoptions = "<option value=\"default\">default</option>";
    my @DIR = Glob("$base/language/*");
    while (@DIR) {
        $_ = shift @DIR;
        my $sel = '';
        next if /[\/\\]assp\.lng$/o;
        next if /[\/\\]default_en_msg_[^\/\\]+$/o;
        s/$base\/language\///o;
        $sel = "selected=\"selected\"" if $_ eq $languageFile;
        $lFoptions .= "<option $sel value=\"$_\">$_</option>";
    }
    $s .= "
    <tr><td><b>language file : </b></td><td>
    <span style=\"z-Index:100;\"><select size=\"1\" name=\"languageFile\">
    $lFoptions
    </select></span><br />select a language file or default</td></tr>
    ";

    $checked=$hidDisabled?'checked="checked"':'';
    $s .= "<tr><td><b>hid disabled config: </b></td><td><input name=\"hidDisabled\" type=\"checkbox\" $checked value=\"1\" /></td></tr>";
    $s .= "<tr><td><b>use LDAP / LDAP host : </b></td><td><input name=\"LDAPserver\" size = \"20\" value=\"$LDAPserver\" /><br />host/ip[:port]<br />If port is not defined, the default port (389/636) will be used.</td></tr>";
    $s .= "<tr><td><b>LDAP version : </b></td><td>";
    $s .= "<span style=\"z-Index:100;\"><select size=\"1\" name=\"LDAPversion\">";
    my $sel = '';
    $sel = "selected=\"selected\"" if ($LDAPversion == 1);
    $s .= "<option $sel value=\"1\">1</option>";
    $sel = '';
    $sel = "selected=\"selected\"" if ($LDAPversion == 2);
    $s .= "<option $sel value=\"2\">2</option>";
    $sel = '' ;
    $sel = "selected=\"selected\"" if ($LDAPversion == 3);
    $s .= "<option $sel value=\"3\">3</option>";
    $s .= "</select></span></td></tr>";
    $s .= "<tr><td><b>LDAP container : </b></td><td><input name=\"LDAProot\" size = \"20\" value=\"$LDAProot\" /><br />\"cn=USER, o=org, c=country\"<br />the literal 'USER' will be relaced with the username</td></tr>";


    $s .= "<tr><td><b>use SSL for LDAP: </b></td><td>";
    $s .= "<span style=\"z-Index:100;\"><select size=\"1\" name=\"LDAPssl\">";
    $sel = '';
    $sel = "selected=\"selected\"" if (!$LDAPssl);
    $s .= "<option $sel value=\"0\">no</option>";
    $sel = '';
    $sel = "selected=\"selected\"" if ($LDAPssl == 1);
    $s .= "<option $sel value=\"1\">SSL</option>";
    $sel = '' ;
    $sel = "selected=\"selected\"" if ($LDAPssl == 2);
    $s .= "<option $sel value=\"2\">TLS</option>";
    $s .= "</select></span></td></tr>";

    if ($user ne $suser) {
        $s .= "<tr><td>&nbsp;</td><td>&nbsp;</td></tr>";
        $s .= "<tr><td><b>enable this user/password configuration : </b></td><td>";
        $sel = '' ;
        $sel = "selected=\"selected\"" if ($actPassCfg eq 'enable');
        $s .= "<span style=\"z-Index:100;\"><select size=\"1\" name=\"actPassCfg\">
              <option value=\"\">select</option>
              <option $sel value=\"enable\">enable</option>
              </select></span></td></tr></table></div></div></div><hr>";
    } else {
        $s .= "</table></div></div></div><hr><input name=\"actPassCfg\" type=\"hidden\" value=\"enable\" />";
        $actPassCfg = 'enable';
    }
    if ($actPassCfg ne 'enable') {
        $s .= $buttons.$sfoot;
        %ManageActions = ();
        %ManagePerm = ();
        return $s;
    }
    if (!$password && !$LDAPserver && !$disabled && $user !~ /^\~/o && $suser ne '#newTemplate') {
        $s .= "Please define password or LDAPserver, or disable the user!<br />";
        $s .= $buttons.$sfoot;
        %ManageActions = ();
        %ManagePerm = ();
        return $s;
    }

# select action to take on user
    my $crFrom = $qs{crFrom};
    $options = "<option selected=\"selected\" value=\"none\">none</option>";
    $options .= "<option value=\"enable_all\">enable all</option>";
    $options .= "<option value=\"disable_all\">disable all</option>";
    foreach my $k (sort keys %AdminUsers) {
        $options .= "<option value=\"c!$k\">copy from $k</option>" if $k ne $user;
        if ($k =~ /^\~/o && $user !~ /^\~/o) {
            $options .= "<option value=\"r!$k\">reference to $k</option>";
        }
    }
    my $ss = "<td><b>set all permissions to : </b></td><td>";
    $ss .= "<span style=\"z-Index:100;\"><select size=\"1\" name=\"crFrom\">
          $options
          </select></span></td>";

# select permission
    my $selmain = $qs{selmain};
    my $selregex = $qs{selregex};
    my %selKey = ('all' => 1, 'enabled' => 1, 'disabled' =>1 , 'referenced' => 1);
    $options = '';
    foreach my $k (sort keys %selKey) {
        if ( $selmain eq $k ) {
            $options .= "<option selected=\"selected\" value=\"$k\">$k</option>";
        } else {
            $options .= "<option value=\"$k\">$k</option>";
        }
    }
    $s .= "<div class=\"shadow\"><div class=\"option\"><div class=\"optionValue\">";
    $s .= "<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\"99%\" >";
    $s .= "<tr><td><b>select parms : </b></td><td>";
    $s .= "<span style=\"z-Index:100;\"><select size=\"1\" name=\"selmain\">";
    $s .= $options;
    $s .= "</select></td>";
    $s .= "<td><b>parms contain string : </b></td><td>";
    $s .= "<input name=\"selregex\" size = \"20\" value=\"$selregex\" /><br />wildcards * and ? are supported<br />example: *local* or ldap*</td>";
    $s .= $ss;
    $s .= "</tr></table>";
    $s .= "</div></div></div><hr>";

    if ($user eq $suser && ! $selmain) {
        $selmain = 'all';
        $crFrom = 'none';
    }

    if (! $selmain) {
        $s .= $buttons.$sfoot;
        %ManageActions = ();
        %ManagePerm = ();
        return $s;
    }
    my $regex = $selregex;
    $regex =~ s/\./\\\./o;
    $regex =~ s/\*/\.\*/o;
    $regex =~ s/\?/\./o;
    $regex = '.*' unless $regex;
    use re 'eval';
    if ($regex !~ /\*|\?/o) {
        eval{$regex=qr/(?i)$regex/};
    } else {
        eval{$regex=qr/^(?i)$regex$/};
    }

# manage permissions
###########################

# manage Action permissions

    my %ManageActionsDesc = ();
    $ManageActionsDesc{lists} = 'White/Redlist/Tuplets';
    $ManageActionsDesc{recprepl} = 'Recipient Replacement Test';
    $ManageActionsDesc{maillog} = 'View Maillog Tail';
    $ManageActionsDesc{analyze} = 'Mail Analyzer';
    $ManageActionsDesc{infostats} = 'Info and Stats';
    $ManageActionsDesc{top10stats} = 'Top 10 Stats';
    $ManageActionsDesc{resetcurrentstats} = 'Reset Stats since last Start';
    $ManageActionsDesc{resetallstats} = 'Reset ALL Stats';
    $ManageActionsDesc{statusassp} = 'Worker/DB/Regex Status';
    $ManageActionsDesc{edit} = 'Edit any Files, Lists, Caches';
    $ManageActionsDesc{shutdown_list} = 'SMTP Connections';
    $ManageActionsDesc{shutdown} = 'Shutdown/Restart';
    $ManageActionsDesc{suspendresume} = 'Suspend/Resume';
    $ManageActionsDesc{shutdown_frame} = 'Shutdown/Restart Screen';
    $ManageActionsDesc{donations} = 'Donations';
    $ManageActionsDesc{pwd} = 'Change own local Password';
    $ManageActionsDesc{reload} = 'Load Config';
    $ManageActionsDesc{quit} = 'Terminate Now!';
    $ManageActionsDesc{save} = 'Save Config';
    $ManageActionsDesc{editinternals} = 'Edit Internal Caches';
    $ManageActionsDesc{syncedit} = 'Edit Config-Synchronzation Options';
    $ManageActionsDesc{SNMPAPI} = 'allowed to use the SNMP API';
    $ManageActionsDesc{addraction} = 'take action on email addresses from MaillogTail';
    $ManageActionsDesc{ipaction} = 'take actions on IP addresses from MaillogTail';
    $ManageActionsDesc{statgraph} = 'show graphical statistics';
    $ManageActionsDesc{fc} = 'assp file commander';

    my %webRequests = %webRequests;
    delete $webRequests{'/get'};
    delete $webRequests{'/adminusers'};
    delete $webRequests{'/remember'};
    foreach (keys %ManageActionsDesc) {
        delete $webRequests{'/'.$_};
    }
    foreach (keys %webRequests) {
        s/^\///;
        $ManageActionsDesc{$_} = "Plugin Action $_";
    }
    
    $s .= $applybutton.'<hr>';
    $s .= "<h2>Action Permissions</h2>";
    $s .= "<div class=\"shadow\"><div class=\"option\"><div class=\"optionValue\">";
    $s .= "<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\"80%\" >";

    foreach my $k (sort keys %ManageActionsDesc) {
        if ($crFrom eq 'none') {
            if (! exists $ManageActions{$k}) {
                $ManageActions{$k} = $AdminUsersRight{"$user.action.$k"};
            } else {
                $ManageActions{$k} = $qs{$k};
            }
        } elsif ($crFrom eq 'enable_all') {
            $ManageActions{$k} = '';
        } elsif ($crFrom eq 'disable_all') {
            $ManageActions{$k} = int(rand(1000));
        } elsif ($crFrom =~ /c\!(.+)/o) {
            $ManageActions{$k} = $AdminUsersRight{"$1.action.$k"};
        } elsif ($crFrom =~ /r\!(.+)/o) {
            $ManageActions{$k} = "refto($1)";
        }
        if ($k =~ /$regex/ &&
            (($selmain eq 'enabled' && !$ManageActions{$k}) or
             ($selmain eq 'disabled' && $ManageActions{$k}) or
             ($selmain eq 'referenced' && $ManageActions{$k} =~ /^refto\(/o) or
             ($selmain eq 'all')
            )
           ) {
            $s .= "<tr><td><b>$ManageActionsDesc{$k} : </b></td><td>";
            $options = '';
            if (!$ManageActions{$k}) {
                $options .= "<option selected=\"selected\" value=\"\">enabled</option>";
            } else {
                $options .= "<option value=\"\">enabled</option>";
            }
            if ($ManageActions{$k} && $ManageActions{$k} !~ /^refto\(/) {
                $options .= "<option selected=\"selected\" value=\"disabled\">disabled</option>";
            } else {
                $options .= "<option value=\"disabled\">disabled</option>";
            }
            foreach my $u (sort keys %AdminUsers) {
                next if ( $user eq $u ) ;
                next if ($user =~ /^\~/o);
                next if ($u !~ /^\~/o);
                my $sel = '';
                if ($ManageActions{$k} =~ /^refto\($u\)$/) {
                    $sel = "selected=\"selected\"" ;
                }
                $options .= "<option $sel value=\"refto($u)\">reference to $u</option>";
            }
            $s .= "<span style=\"z-Index:100;\"><select size=\"1\" name=\"$k\">";
            $s .= $options;
            $s .= "</select></td></tr>";
        } else {
            $s .= "<input name=\"$k\" type = \"hidden\" value=\"$ManageActions{$k}\" />";
        }
    }
    $s .= "</table>";
    $s .= "</div></div></div><hr>";
    $s .= $applybutton;

# manage Config permissions
    $s .= "<hr><h2>Config Parm Permissions</h2>";
    $s .= "<div class=\"shadow\"><div class=\"option\"><div class=\"optionValue\">";
    $s .= "<table BORDER CELLSPACING=0 CELLPADDING=4 WIDTH=\"99%\" >";
    my %ConfigVars = ();
    for my $idx (0...$#ConfigArray) {
      my $c = $ConfigArray[$idx];
      next if @{$c}==5; # skip headings
      next unless $c->[0];
      if (exists $cryptConfigVars{$c->[0]}) {
          delete $ManagePerm{$c->[0]};
          delete $AdminUsersRight{"$user.cfg.$c->[0]"};
      } else {
          $ConfigVars{$c->[0]} = $WebIP{$ActWebSess}->{lng}->{$c->[10]} ? $WebIP{$ActWebSess}->{lng}->{$c->[10]} : $c->[1];
      }
    }
    foreach my $k (sort {"\U$main::a" cmp "\U$main::b"} keys %ConfigVars) {
        if ($crFrom eq 'none') {
            if (! exists $ManagePerm{$k}) {
                $ManagePerm{$k} = $AdminUsersRight{"$user.cfg.$k"};
            } else {
                $ManagePerm{$k} = $qs{$k};
            }
        } elsif ($crFrom eq 'enable_all') {
            $ManagePerm{$k} = '';
        } elsif ($crFrom eq 'disable_all') {
            $ManagePerm{$k} = int(rand(1000));
        } elsif ($crFrom =~ /c\!(.+)/o) {
            $ManagePerm{$k} = $AdminUsersRight{"$1.cfg.$k"};
        } elsif ($crFrom =~ /r\!(.+)/o) {
            $ManagePerm{$k} = "refto($1)";
        }
        if ($k =~ /$regex/ &&
            (($selmain eq 'enabled' && !$ManagePerm{$k}) or
             ($selmain eq 'disabled' && $ManagePerm{$k}) or
             ($selmain eq 'referenced' && $ManagePerm{$k} =~ /^refto\(/o) or
             ($selmain eq 'all')
            )
           ) {
            $s .= "<tr><td><a name=\"$k\"><b>$k : </b></a></td><td>";
            $options = '';
            if (!$ManagePerm{$k}) {
                $options .= "<option selected=\"selected\" value=\"\">enabled</option>";
            } else {
                $options .= "<option value=\"\">enabled</option>";
            }
            if ($ManagePerm{$k} && $ManagePerm{$k} !~ /^refto\(/o) {
                $options .= "<option selected=\"selected\" value=\"disabled\">disabled</option>";
            } else {
                $options .= "<option value=\"disabled\">disabled</option>";
            }
            foreach my $u (sort keys %AdminUsers) {
                next if ( $user eq $u ) ;
                next if ($user =~ /^\~/o);
                next if ($u !~ /^\~/o);
                my $sel = '';
                $sel = "selected=\"selected\"" if ($ManagePerm{$k} =~ /^refto\($u\)$/);
                $options .= "<option $sel value=\"refto($u)\">reference to $u</option>";
            }
            $s .= "<span style=\"z-Index:100;\"><select size=\"1\" name=\"$k\">";
            $s .= $options;
            $s .= "</select></td><td>$ConfigVars{$k}</td></tr>";
        } else {
            $s .= "<input name=\"$k\" type = \"hidden\" value=\"$ManagePerm{$k}\" />";
        }
    }
    $s .= "</table>";
    $s .= "</div></div></div><hr>";

    if ($qs{theButtonX} eq 'Apply Changes' or $qs{theButtonA} eq 'Apply Changes') {  # apply
        foreach (keys %ManageActions) {
            my $key = "$user.action.$_";
            if (! $ManageActions{$_}) {
                delete $AdminUsersRight{$key};
            } else {
                $AdminUsersRight{$key} = $ManageActions{$_};
            }
        }
        foreach (keys %ManagePerm) {
            my $key = "$user.cfg.$_";
            if (! $ManagePerm{$_}) {
                delete $AdminUsersRight{$key};
            } else {
                $AdminUsersRight{$key} = $ManagePerm{$_};
            }
        }
        $AdminUsers{$user} = $password;
        $AdminUsersRight{"$user.user.passwordExp"} = $passwordExp;
        $AdminUsersRight{"$user.user.passwordExpInt"} = $passwordExpInt;
        $AdminUsersRight{"$user.user.passwordLastChange"} = time if ($suser eq '#newUser');
        $AdminUsersRight{"$user.user.disabled"} = $disabled;
        $AdminUsersRight{"$user.user.languageFile"} = $languageFile;
        $AdminUsersRight{"$user.user.hidDisabled"} = $hidDisabled;
        $AdminUsersRight{"$user.user.LDAPserver"} = $LDAPserver;
        $AdminUsersRight{"$user.user.LDAPversion"} = $LDAPversion;
        $AdminUsersRight{"$user.user.LDAProot"} = $LDAProot;
        $AdminUsersRight{"$user.user.LDAPssl"} = $LDAPssl;
        $AdminUsersObject->flush();
        $AdminUsersRightObject->flush();

        foreach (keys %WebIP) {       # delete the permission hash for any session
            %{$WebIP{$_}->{perm}} = ();
        }

        my $text = 'successful applied changes to ';
        $text .= $suser eq '#newTemplate' ? 'template ' : 'user ';
        $text .= $user;

         $s = "HTTP/1.1 200 OK
Content-type: text/html

<html xmlns=\"http://www.w3.org/1999/xhtml\" xml:lang=\"en\" lang=\"en\">
<head><meta http-equiv=\"Refresh\" content=\"1; URL=./adminusers\">
</head><body>

<script type=\"text/javascript\">
<!--
alert('$text');
// -->
</script>
</body></html>\n";
        return $s;
    }
    $s .= $applybutton.$sfoot;
    return $s;
}

sub canUserDo {
    my ($user,$what,$item) = @_;
    return 1 unless $adminusersdb;
    return 1 unless $user;
    return 1 if $user eq 'root';
    $item =~ s/\///go;
    my $key = "$user.$what.$item";
    return $WebIP{$ActWebSess}->{perm}->{$key} if $usedCrypt != 1 && exists $WebIP{$ActWebSess}->{perm}->{$key};
    unless (exists $AdminUsersRight{$key}) {
        return 1 if $usedCrypt == 1;
        return ($WebIP{$ActWebSess}->{perm}->{$key} = 1);
    }
    my $right = $AdminUsersRight{$key};
    if ($right !~ /refto\(([^\)]+)\)/o) {
        return 0 if $usedCrypt == 1;
        return ($WebIP{$ActWebSess}->{perm}->{$key} = 0);
    }
    my $key2 = "$1.$what.$item";
    unless (exists $AdminUsersRight{$key2}) {
        return 1 if $usedCrypt == 1;
        return ($WebIP{$ActWebSess}->{perm}->{$key} = 1);
    }
    return 0 if $usedCrypt == 1;
    return ($WebIP{$ActWebSess}->{perm}->{$key} = 0);
}

sub removePluginConfig {       # remove PluginConfig that was loaded in BEGIN section
   my $rplobj = shift;         # to cleanup GUI from that entries
   return unless $rplobj;
   my $cfg;
   my $i;
   my @rplconfig;
   eval{@rplconfig = $rplobj->get_config();};
   while (@rplconfig) {
      my $cfg = shift @rplconfig;
      my $i = 0;
      for my $idx (0...$#ConfigArray) {
          my $c = $ConfigArray[$idx];
          if (   $c->[0] eq $cfg->[0]
              && $c->[1] eq $cfg->[1]
              && $c->[2] eq $cfg->[2]
              && $c->[3] eq $cfg->[3]
              && $c->[4] eq $cfg->[4]
             )
          {
              splice (@ConfigArray,$i,1) ;
              last;
          }
          $i++;
      }
   }
}

sub loadPluginConfig {
  my $plobj;
  my @plconfig;
  my $plinput;
  my $ploutput;
  my $cmd;
  my $tmp;
  my $version;
  if ($useAsspSelfLoader) {
      &haveToFileScan(0);
      &haveToScan(0);
      &CheckAttachments(0,0,0,0,0); # predefine the sub - repointed in AFC Plugin
  }
  my @runlevel = ('\'SMTP-handshake\'','\'mail header\'','\'complete mail\'');
  -d "$base/Plugins" or return;
  push (@INC,"$base/Plugins") unless grep(/^\Q$base\E\/Plugins$/,@INC);
  opendir(my $DIR,"$base/Plugins");
  my @pllist = readdir($DIR);
  close $DIR;
  foreach my $pl (@pllist) {
    next if ($pl !~ /^(assp_.+)\.pm$/io);
    $pl = $1;
    mlog(0,"Info: try loading plugin $pl");
    $cmd = "unless (eval{$pl->VERSION;}) {use $pl;}";
    eval($cmd);
    if ($@) {
      mlog(0,"error loading plugin (2) $pl (use) - error: $@");
      $cmd = "no $pl";
      eval($cmd);
      next;
    }
    eval{$plobj = $pl->new()};
    if ($@) {
      mlog(0,"error loading plugin $pl (new) - error: $@");
      next;
    }
    if (! $plobj) {
      mlog(0,"error loading plugin $pl: unable to create a new instance");
      next;
    }

    eval{@plconfig = $plobj->get_config()};
    if ($@) {
      mlog(0,"error loading plugin $pl (get_config) - error: $@");
      next;
    }
    if (! @plconfig) {
      mlog(0,"error reading plugin $pl configuration");
      next;
    }

    eval{$plinput = $plobj->get_input()};
    if ($@) {
      mlog(0,"error loading plugin $pl (get_input) - error: $@");
      removePluginConfig($plobj);
      next;
    }
    if (! $plinput && $plinput != 0) {
      mlog(0,"error reading plugin $pl INPUT");
      removePluginConfig($plobj);
      next;
    }

    eval{$ploutput = $plobj->get_output()};
    if ($@) {
      mlog(0,"error loading plugin $pl (get_output) - error: $@");
      removePluginConfig($plobj);
      next;
    }
    if (! $ploutput && $ploutput != 0) {
      mlog(0,"error reading plugin $pl OUTPUT");
      removePluginConfig($plobj);
      next;
    }

    eval{$version = $plobj->VERSION};
    if ($@) {
      mlog(0,"error loading plugin $pl (version) - error: $@");
      removePluginConfig($plobj);
      next;
    }
    if (! $version) {
      mlog(0,"error reading plugin $pl VERSION");
      removePluginConfig($plobj);
      next;
    }

    $tmp = "ASSP_Plugin_TEST";
    eval{$tmp = $plobj->process(0,\$tmp)};
    if ($@) {
      mlog(0,"error loading plugin $pl (process) - error: $@");
      removePluginConfig($plobj);
      next;
    }
    if ($tmp != 1) {
      mlog(0,"error plugin $pl process test returned $tmp - should be 1");
      removePluginConfig($plobj);
      next;
    }

    $tmp = "ASSP_Plugin_TEST";
    eval{$tmp = $plobj->tocheck()};
    if ($@) {
      mlog(0,"error loading plugin $pl (tocheck) - error: $@");
      removePluginConfig($plobj);
      next;
    }
    if ($tmp ne "ASSP_Plugin_TEST") {
      mlog(0,"error plugin $pl tocheck returned $tmp - should be ASSP_Plugin_TEST");
      removePluginConfig($plobj);
      next;
    }

    $tmp = '';
    eval{$tmp = $plobj->errstr()};
    if ($@) {
      mlog(0,"error loading plugin $pl (errstr) - error: $@");
      removePluginConfig($plobj);
      next;
    }
    if (! $tmp) {
      mlog(0,"error plugin $pl errstr returned undef");
      removePluginConfig($plobj);
      next;
    }

    $tmp = '';
    eval{$tmp = $plobj->result()};
    if ($@) {
      mlog(0,"error loading plugin $pl (result) - error: $@");
      removePluginConfig($plobj);
      next;
    }
    if ($tmp ne 'ASSP_Plugin_TEST') {
      mlog(0,"error plugin $pl result returned $tmp - should be ASSP_Plugin_TEST");
      removePluginConfig($plobj);
      next;
    }

    $tmp = '';
    eval{$tmp = $plobj->howToDo()};
    if ($@) {
      mlog(0,"error loading plugin $pl (howToDo) - error: $@");
      removePluginConfig($plobj);
      next;
    }
    if ($tmp != 9) {
      mlog(0,"error plugin $pl result returned $tmp - should be 9");
      removePluginConfig($plobj);
      next;
    }

    eval{$tmp = $plobj->close};
    if ($@) {
      mlog(0,"error loading plugin $pl (close) - error: $@");
      removePluginConfig($plobj);
      next;
    }
    if ($tmp != 1) {
      mlog(0,"error plugin $pl close returned undef - should be 1");
      removePluginConfig($plobj);
      next;
    }

    $Plugins{$pl} = &share({});
    $Plugins{$pl}->{version} = $version;
    $Plugins{$pl}->{input} = $plinput;
    $Plugins{$pl}->{output} = $ploutput;
    $runlvl0PL = 1 if ($plinput == 0);
    $runlvl1PL = 1 if ($plinput == 1);
    $runlvl2PL = 1 if ($plinput == 2);
    $plobj->close;
    mlog(0,"info: plugin $pl version $Plugins{$pl}->{version} loaded for runlevel ($plinput) - $runlevel[$plinput].");
  }
}

sub callPlugin {
    my ($fh,$where,$mail) = @_;
    d('callPlugin');
    my $this = $Con{$fh};
    my $friend = $Con{$this->{friend}};
    my $plinput;
    my $ploutput;
    my %runpl = ();
    my $priority;
    my $enabled;
    my $plobj;
    my $result;
    my $resultstr;
    my $data;
    my $tocheck;
    our $pltest;
    our $pldo;
    our $plLogTo;
    our $plVal;
    my ($res,$reason,$reply);

    my @runlevel = ('\'SMTP-handshake\'','\'mail header\'','\'complete mail\'');
    if (! $$mail) {
      return 1,'','','' if ($where == 0 or $where == 1);  #there should be a value in $mail for runlevel 0/1
      $data = \$this->{header} if ($where == 1);
      $data = \$this->{header} if ($where == 2);
    } else {
      $data = $mail;
    }
    foreach my $pl (sort (keys %Plugins)) {
      next if ($where ne $Plugins{$pl}->{input});
      $enabled = "Do$pl";
      eval{${$enabled}=${$enabled}};
      if ($@) {
        mlog(0,"ERROR: $enabled - ConfigParm not found - the Plugin configuration is corrupt");
        next;
      }
      next if (! ${$enabled});       # Plugin is not enabled
      $priority = $pl."Priority";
      eval{$priority = ${$priority}};
      if ($@) {
        mlog(0,"ERROR: unable to set $pl runlevel priority - ConfigParm not found - the Plugin is corrupt");
        next;
      }
      while (exists $runpl{$priority}) {
        mlog(0,"WARNING: runlevel $runlevel[$where] - priority $priority is already occupied by plugin $runpl{$priority}");
        $priority++;
      }
      $runpl{$priority} = $pl;
    }
    foreach my $priority (sort(keys %runpl)) {
      &NewSMTPConCall();
      my $pl = $runpl{$priority};
      d("call Plugin $pl with priority: $priority in run level $runlevel[$where]");
      $plobj = $pl->new();
      if (! $plobj) {
        mlog(0,"ERROR: unable to call Plugin $pl (constructor)");
        next;
      }
      my $pltest1 = "Test$pl";
      $pltest = $$pltest1 ? $$pltest1 : $allTestMode;
      my $pldo1 = "Do$pl";
      $pldo = $$pldo1;
      my $plLogTo1 = $pl."LogTo";
      $plLogTo = $$plLogTo1;
      my $plVal1 = $pl."ValencePB";
      $plVal = defined ${$plVal1}[0] ? $plVal1 : $$plVal1;
      $result = $plobj->process(\$fh,$data);
      if (! $result){                   # Plugin call failed
        $resultstr = $plobj->errstr();
        $reason = $plobj->result() if (! $Plugins{$pl}->{output} && $plobj->result());
        $$data = $plobj->result() if ($Plugins{$pl}->{output} && $plobj->result());
        $plobj->close;
        if (($pldo == 3 || $pldo == 1) && ! $pltest) {
           pbAdd($fh,$this->{ip},$plVal,"$pl: $reason");
           delayWhiteExpire($fh);
           next if $pldo == 3 ;
        }
        return 0,$$data,$reason,$plLogTo,$resultstr,$pltest,$pl if (! $pltest);
      } else {                         # Plugin call ok
        $resultstr .= $pl."\001".$plobj->errstr()."\002";
        $tocheck = $plobj->tocheck();
        $$data = $plobj->result() if ($Plugins{$pl}->{output} && $plobj->result());
        $plobj->close;
        if ($tocheck && $where == 2){  # check the data we've got back from Plugin in runlvl 2
           ($res,$reason,$reply,$plLogTo) = &checkPluginData($fh,$tocheck,$where,$pldo,$pltest,$plLogTo);
           if (! $res) {    # the checks failed - return if PL is not in testmode
              return 0,$$data,$reason,$plLogTo,$reply,$pltest,$pl if (! $pltest);
           }
        }
      }
    }
    return 1,$$data,'',$plLogTo,$resultstr,'','all';
}

sub checkPluginData {
    my ($fh,$data,$where,$pldo,$pltest,$plLogTo) = @_;
    my $this = $Con{$fh};
    d('checkPluginData: ' . $data);

    $data = e8($data) if $data;

    # here should be done all checks for data from Plugins like OCR
    # return 1 and '' for success
    # return 0 and SMTP error Reply for failed

    my $mbytes = $MaxBytes ? $MaxBytes : 10000;
    my $cbytes = $ClamAVBytes ? $ClamAVBytes : 20000;
    $cbytes = 100000 if $ClamAVBytes > 100000;
  
    setOverwriteDo($fh,$DoHMM,$pldo);
    $this->{hmmdone} = '';
    @HmmBayWords = ();
    if ( ! HMMOK($fh,\substr($data, 0, $mbytes))) {
        $this->{overwritedo} = '';
        my $testmode;
        my $slok=$this->{allLoveBaysSpam}==1;
        $testmode = "HMM confidence low" if ($this->{bayeslowconf});
        $testmode = "testmode" if $baysTestMode || $pltest;
        $testmode = $slok = 0 if allSH($this->{rcpt},'baysSpamHaters');
        if (!$slok) { $Stats{bspams}++;}
        $this->{prepend}="[HMM]";
        delete $this->{clean} if ($slok || $testmode);
        return 0,'HMM',$SpamError,$spamPBLog || $plLogTo if (! $slok && ! $testmode);
    }

    setOverwriteDo($fh,$DoBayesian,$pldo);
    $this->{bayesdone} = '';
    if ( ! BayesOK($fh,\substr($data, 0, $mbytes),$this->{ip})) {
        $this->{overwritedo} = '';
        my $testmode;
        my $slok=$this->{allLoveBaysSpam}==1;
        $testmode = "bayes confidence low" if ($this->{bayeslowconf});
        $testmode = "testmode" if $baysTestMode || $pltest;
        $testmode = $slok = 0 if allSH($this->{rcpt},'baysSpamHaters');
        if (!$slok) { $Stats{bspams}++;}
        $this->{myheader}.=sprintf("X-Assp-Bayes-Confidence: %.5f\r\n",$this->{spamconf}) if $AddSpamProbHeader && $AddConfidenceHeader && $this->{spamconf}>0;
        $this->{prepend}="[Bayesian]";
        return 0,'Bayesian',$SpamError,$spamPBLog || $plLogTo if (! $slok && ! $testmode);
    }
    delete $this->{clean};

    setOverwriteDo($fh,$DoBlackRe,$pldo);
    $this->{blackredone} = '';
    if (! BombBlackOK( $fh, \substr($data, 0, $mbytes)) ) {
        $this->{overwritedo} = '';
        my $bomblt = $bombError;
        $bomblt .= " (reason: $this->{messagereason}) " if $bombErrorReason;
        $Stats{bombs}++;
        delayWhiteExpire($fh);
        my $slok = $this->{allLoveBoSpam} == 1;
        return 0,$this->{messagereason},$bomblt,$spamBombLog || $plLogTo if (! $slok && ! $bombTestMode && ! $pltest);
    }

    setOverwriteDo($fh,$DoBombRe,$pldo);
    $this->{bombdone} = 'PL';           # tell BombOK that we are calling from here
    if (! BombOK( $fh, \substr($data, 0, $mbytes)) ) {
        $this->{overwritedo} = '';
        my $bomblt = $bombError;
        $bomblt .= " (reason: $this->{messagereason}) " if $bombErrorReason;
        $Stats{bombs}++;
        delayWhiteExpire($fh);
        my $slok = $this->{allLoveBoSpam} == 1;
        return 0,$this->{messagereason},$bomblt,$spamBombLog || $plLogTo if (! $slok && ! $bombTestMode && ! $pltest);
    }

    setOverwriteDo($fh,$UseAvClamd,$pldo);
    $this->{clamscandone} = '';
    if (! ClamScanOK($fh,\substr($data, 0, $cbytes))){
        $this->{overwritedo} = '';
        $this->{prepend}="[VIRUS]";
        return 0,$this->{messagereason},$this->{averror},$SpamVirusLog || $plLogTo if (! $pltest);
    }

    setOverwriteDo($fh,$DoFileScan,$pldo);
    $this->{filescandone} = '';
    if (! FileScanOK($fh,\substr($data, 0, $cbytes))){
        $this->{overwritedo} = '';
        $this->{prepend}="[VIRUS]";
        return 0,$this->{messagereason},$this->{averror},$SpamVirusLog || $plLogTo if (! $pltest);
    }

    setOverwriteDo($fh,$DoScriptRe,$pldo);
    $this->{ScriptOK} = '';
    if(! ScriptOK($fh,\substr($data, 0, $mbytes))) {
        $this->{overwritedo} = '';
        my $slok=$this->{allLoveBoSpam}==1;
        $Stats{scripts}++;
        delayWhiteExpire($fh);
        my $bomblt = $scriptError;

        $bomblt .= " (reason: $this->{messagereason}) " if $bombErrorReason;
        $this->{prepend}="[BombScript]";
        return 0,$this->{messagereason},$bomblt,$scriptLog || $plLogTo if (! $slok && ! $bombTestMode && ! $pltest);
    }

    setOverwriteDo($fh,$ValidateURIBL,$pldo);
    $this->{skipuriblPL} = 1;
    $this->{uribldone} = '';
    if(! URIBLok($fh,\substr($data, 0, $mbytes),$this->{ip},1)) {
        $this->{skipuriblPL} = '';
        $this->{overwritedo} = '';
        my $slok=$this->{allLoveURIBLSpam}==1;
        delayWhiteExpire($fh);
        my $err=$URIBLError;
        $err=~s/URIBLNAME/$this->{uri_listed_by}/go;
        delete $this->{uri_listed_by};
        return 0,$this->{messagereason},$err,$URIBLFailLog || $plLogTo if (! $slok && ! $uriblTestMode && ! $pltest);
    }
    $this->{skipuriblPL} = '';

    $this->{overwritedo} = '';
    return 1,'','',$plLogTo;  # res reason Reply log
}

sub setOverwriteDo {                # overwrite the configured Do.. with plDo
   my ($fh,$orgDo,$plDo) = @_;
   my $this = $Con{$fh};
   $this->{messagereason} = '';
   $this->{overwritedo} = '';
   return if ($plDo == 1);          # no ovr if plDo == 1  block
   $this->{overwritedo} = $plDo;
   return if ($plDo == 3);          # all ovr if plDo = 3  score
   return if ($orgDo == 1);         # ovr if plDo == 2 monitor and orgDo == 1 block
   $this->{overwritedo} = '';       # no ovr for the rest
   return;

}

###################################
# Thread Control
###################################

sub EXITASSP {
    exit 1;
}

sub downASSP {
    my $text = shift;
    return if $doShutdownForce;
    $doShutdownForce = 1;
    $SIG{TERM} = \&EXITASSP;
    foreach (keys %SIG) {
       next if /TERM/io;
       $SIG{$_} = 'IGNORE';
    }
    my $sequenceOK = 1;
    mlog(0,'initializing shutdown sequence');
    mlogWrite();
    $WorkerName = 'Shutdown';
    $sequenceOK &&= &closeAllSMTPListeners;
    mlogWrite();
    $sequenceOK &&= &stopSMTPThreads;
    mlogWrite();
    $sequenceOK &&= &stopHighThreads;
    mlogWrite();
    $sequenceOK && &SaveWhitelist;
    mlogWrite();
    $sequenceOK && &SavePB;
    mlogWrite();
    $sequenceOK && &SaveStats;
#    mlogWrite();
#    &BDB_sync(1);
    mlog(0,'closing all databases');
    mlogWrite();
    checkDBCon(0);
    mlogWrite();
    &clearDBCon();
    mlogWrite();
    &closeAllWEBListeners;
    mlogWrite();
    &syncWriteConfig() if $enableCFGShare;
    &removeLeftCrashFile();
    mlog(0,'info: shutdown reason was: '.$text) if $text;
    mlog(0,'info: shutdown - got no reason ?') if ! $text;
    mlog(0,'ASSP finished work');
    &RemovePid;
    mlogWrite();
    &printVars();
}

sub closeLogs {
    $@ = '';
    $! = '';
    if ($ExtraBlockReportLog && -e "$base/$blogfile") {
        eval{$LOGBR->close;} || eval{close $LOGBR;};
        if (-e "$base/$blogfile" && ($! || $@)) {
            print "error: unable to close $base/$blogfile - $! - $@\n";
            print $LOG "error: unable to close $base/$blogfile - $! - $@\n";
        }
    }
    $@ = '';
    $! = '';
    eval {$LOG->close;} || eval {close $LOG;};
    if (-e "$base/$logfile" && ($! || $@)) {
        print "error: unable to close $base/$logfile - $! - $@\n";
        print $LOG "error: unable to close $base/$logfile - $! - $@\n";
    }
    eval{$DEBUG->close;} || eval{close $DEBUG;} if fileno($DEBUG);
}

sub openLogs {
# open the logfile
  local $@ = '';
  local $! = '';
  if($logfile) {
      my $append = -e "$base/$logfile";
      if (open($LOG,'>>',"$base/$logfile")) {
          binmode $LOG;
          $LOG->autoflush;
          if (! $append) {
              print $LOG $UTF8BOM;
              mlog(0,"running ASSP version $main::MAINVERSION");
          }
      }
  }
  if($logfile && $ExtraBlockReportLog) {
      my $append = -e "$base/$blogfile";
      if (open($LOGBR,'>>',"$base/$blogfile")) {
          binmode $LOGBR;
          $LOGBR->autoflush;
          print $LOGBR $UTF8BOM unless $append;
      }
  }
  if($debug) {
      my $file = "$base/debug/".time.".dbg";
      open($DEBUG, '>', "$file");
      binmode($DEBUG);
      $DEBUG->autoflush;
      print $DEBUG $UTF8BOM;
      print $DEBUG "running ASSP version: $main::MAINVERSION\n\n";
      mlog(0,"info: starting general debug mode to file $file");
  }
}

sub closeAllSMTPListeners {
        mlog(0,"info: removing all SMTP and Proxy listeners");
        foreach my $lsn (@lsn ) {
            eval{close($lsn);} if $lsn;
        }

        foreach my $lsn (@lsn2 ) {
            eval{close($lsn);} if $lsn;
        }

        foreach my $lsn (@lsnSSL ) {
            eval{close($lsn);} if $lsn;
        }

        foreach my $lsn (@lsnRelay ) {
            eval{close($lsn);} if $lsn;
        }

        while (my ($k,$v) = each(%Proxy)) {
            eval{close($ProxySocket{$k});};
        }
        return 1;
}

sub closeAllWEBListeners {
        mlog(0,"info: removing all WEB listeners");
        foreach my $lsn (@StatSocket ) {
            eval{close($lsn);} if $lsn;
        }

        foreach my $lsn (@WebSocket ) {
            eval{close($lsn);} if $lsn;
        }
        return 1;
}

sub cmdToThread {
    my ($sub,$parm) = @_;
    my $i;
    {
        lock(%cmdQParm) if is_shared(%cmdQParm);
        do {
            $i = Time::HiRes::time();
        } while (exists $cmdQParm{$i});
        $cmdQParm{$i} = ref($parm) ? $$parm : $parm;
    }
    mlog(0,"info: queued command '$sub' to MaintThread") if $MaintenanceLog >= 2;
    threads->yield;
    $cmdQueue->enqueue("sub($sub)$i");
    threads->yield;
}

sub ThreadYield {
    threads->yield();
    my $CycleTime;
    if ($WorkerNumber == 10000) {
        $CycleTime = $MaintThreadCycleTime;
    } elsif ($WorkerNumber == 10001) {
        $CycleTime = $RebuildThreadCycleTime;
    } elsif ( $EnableHighPerformance ) {
        $CycleTime = min($ThreadCycleTime,$EnableHighPerformance);
    } else {
        $CycleTime = $ThreadCycleTime;
    }
    return if (! $CycleTime);
    my $t = $CycleTime / 1000000;
    Time::HiRes::sleep($t);
    $ThreadIdleTime{$WorkerNumber} += $t;
}

sub ConToThread {
    my $fh = shift;
    my $starttime=Time::HiRes::time();
    &ThreadMonitorMainLoop('MainLoop start connection transfer');
    my $fno = fileno($fh);
    my $exceptCount = 0;
    my ($worker,$numcon,$loop,$except,$retval,$time);
    $Fileno{$fno} = $fh;   # store fileno and fh
    mlog(0,"info: $WorkerName looks up the best Worker for new connection - $fno") if ($WorkerLog >= 2);

    do {
        $except = 0;
        do {
            $loop = 0;
            ($worker,$numcon) = &getBestWorker($fh);      # get the best worker for this connection
            my ($w,$t) = &getStuckWorker();
            if ($worker == -1) {
                &ThreadMonitorMainLoop('MainLoop is unable to transfer connection');
                mlog(0,"warning: $WorkerName is unable to transfer connection to any worker - try again!");
                &mlogWrite();
                $exceptCount++;
                my $wt = $ConnectionTransferTimeOut * $exceptCount;
                if ($exceptCount > 3) {
                    mlog(0,"error: $WorkerName is unable to transfer connection to any worker within $wt seconds - restart ASSP!");
                    &downASSP("restarting");
                    _assp_try_restart;
                }
                $loop = 1;
            } else {
                threads->yield;
                $willSIG = 0;                # tell all workers - there is no need to wait
                threads->yield;
            }
        } while $loop;
        &ThreadMonitorMainLoop("MainLoop get the best worker = $worker ($numcon sockets)");
        my $rq = 'r'.$worker;
        eval {
            while ($ThreadQueue{$rq}->dequeue_nb()) {threads->yield;}
            while ($ThreadQueue{$worker}->dequeue_nb()) {threads->yield;}
        };
        my ($sockType,$ht) = split(/=/o,"$fh");
        my $fhInfo = $fh->sockhost() . ':' . $fh->sockport();
        $ComWorker{$worker}->{newCon}->{fno} = "$fno,$sockType,$fhInfo";
        threads->yield;
        $ComWorker{$worker}->{newCon}->{th} = $ThreadHandler{$fh};  # tell Thread what to do
        threads->yield;
        $ThreadQueue{$worker}->enqueue('run');
        &ThreadYield();
        if ($numcon == 0){
           &ThreadMonitorMainLoop("MainLoop waiting for idle worker = $worker ($numcon sockets)");
        } else {
           &ThreadMonitorMainLoop("MainLoop waiting for interrupted worker = $worker ($numcon sockets)");
        }
        mlog(0,"info: $WorkerName will wait (max $ConnectionTransferTimeOut s) for the answer of Worker_$worker which handles $numcon sockets") if ($WorkerLog >= 2);
        my $wtime = $time = Time::HiRes::time();
        $nextLoop2 = $time + 0.3;
        threads->yield();
        $retval = $ThreadQueue{$rq}->dequeue_nb();
        threads->yield();
        while (! $retval){
           &ThreadYield();
           ($retval = $ThreadQueue{$rq}->dequeue_nb()) and last;    # come out here as fast as possible
           &ThreadYield();
           &MainLoop2();                                   # make sure webtraffic is going on
           if ($worker > $NumComWorkers) {                 # NumComWorkers could be changed in MainLoop2
               eval {
                   while ($ThreadQueue{$rq}->dequeue_nb()) {threads->yield;}
                   while ($ThreadQueue{$worker}->dequeue_nb()) {threads->yield;}
               };
               mlog(0,"info: Worker_$worker was killed - will try other worker") if ($WorkerLog >= 2);
               &mlogWrite();
               $except = 1;
               last;
           }
           ($retval = $ThreadQueue{$rq}->dequeue_nb()) and last;    # come out here as fast as possible
           &ThreadYield();
#           ($retval = $ThreadQueue{$rq}->dequeue_nb()) and last;    # come out here as fast as possible
           if (time - $wtime > $ConnectionTransferTimeOut) {
               mlog(0,"info: Worker_$worker handles $numcon sockets and does not answer - will try other worker") if ($WorkerLog >= 2);
               $ComWorker{$worker}->{inerror} = 1;
               $ComWorker{$worker}->{newCon}->{fno} = '';
               $ComWorker{$worker}->{newCon}->{th} = '';  # tell Thread forget what to do
               eval {
                   while ($ThreadQueue{$rq}->dequeue_nb()) {threads->yield;}
                   while ($ThreadQueue{$worker}->dequeue_nb()) {threads->yield;}
               };
               &mlogWrite();
               $except = 1;
               last;
           }
        }
    } while $except;

    my $transtime = sprintf("%.3f",Time::HiRes::time() - $starttime);
    if ($numcon == 0){
       &ThreadMonitorMainLoop("MainLoop freed by idle worker = $worker");
       mlog(0,"info: $WorkerName freed by idle Worker_$worker in $transtime seconds - got ($retval)") if ($WorkerLog);
       $TransferNoInterruptTime += $transtime;
       threads->yield;
    } else {
       &ThreadMonitorMainLoop("MainLoop freed by interrupted worker = $worker");
       mlog(0,"info: $WorkerName freed by interrupted Worker_$worker in $transtime seconds - got ($retval)") if ($WorkerLog);
       $TransferInterrupt++;
       threads->yield;
       $TransferInterruptTime += $transtime;
       threads->yield;
       $i_bw_time += sprintf("%.3f",$time - $starttime);
       threads->yield;
       $i_tw_time += sprintf("%.3f",Time::HiRes::time() - $time);
       threads->yield;
    }
    $TransferTime += $transtime;
    threads->yield;
    $TransferCount++;
    threads->yield;
    if ($retval eq 'ok') {
       delete $failedFH{$fh};
       my $nfno = fileno($fh);
       if($fno ne $nfno) {
          mlog(0,"$fh has changed fd from $fno to $nfno");
          delete $Fileno{$fno};
          $Fileno{$nfno} = $fh;
          unpoll($fh,$readable);
          &dopoll($fh,$readable,POLLIN);
       }
       return;
    } else {
       $failedFH{$fh} = 0 if (! exists $failedFH{$fh});
       $failedFH{$fh}++;
    }
    if ($failedFH{$fh} > 10) {
        &mlogWrite();
        &resetFH($fh);
        $errorFH = 1;
        &mlogWrite();
    }
}

sub resetFH {
   my $fh = shift;
   my $th = $ThreadHandler{$fh};
   my ($sockIP,$sockPort) = ($fh->sockhost,$fh->sockport);
   my $con = "$sockIP:$sockPort";
   delete $failedFH{$fh};
   if ($sockPort < 1024 && $switchedUser) {
       mlog(0,"error: got at least 10 accept errors at listener $con - assp is unable to renew the listener, because we are not running as root - assp will skip processing this listener for 130 seconds from now");
       unpoll($fh,$writable);
       unpoll($fh,$readable);
       $repollFH{$fh} = time + 10;
       return;
   }
   delete $ThreadHandler{$fh};
   mlog(0,"info: try to renewed listening on port $con - after too many errors");

   if (&matchFH($fh, @lsnRelayI)) {    # renew Relay listener
      foreach my $lsn (@lsnRelay ) {
         delete $SocketCalls{$lsn};
         delete $Con{$lsn} if (exists $Con{$lsn});
         delete $Fileno{fileno $lsn} if (exists $Fileno{fileno $lsn});
         unpoll($lsn,$writable);
         unpoll($lsn,$readable);
         eval{close($lsn) if (fileno($lsn));};
         if ($@) {
             mlog(0,"error: unable to close Socket $lsn - $@");
         }
      }
      &ThreadWaitFinCon;
      my ($lsnRelay,$lsnRelayI)=newListen($relayPort,\&ConToThread,1);
      @lsnRelay = @$lsnRelay; @lsnRelayI = @$lsnRelayI;
      for (@$lsnRelayI) {s/:::/\[::\]:/o;}
      if (@lsnRelay) {
          mlog(0,"info: renewed listening for SMTP relay connections on port @$lsnRelayI - after too many errors");
      } else {
          mlog(0,"error: renewing listening for SMTP relay connections on port @$lsnRelayI - after too many errors");
          &downASSP("try restarting ASSP: failed to renew listener on @$lsnRelayI");
          _assp_try_restart;
      }
      return;
   }

   if (&matchFH($fh, @lsn2I)) {     # renew listener 2
      foreach my $lsn (@lsn2 ) {
         delete $SocketCalls{$lsn};
         delete $Con{$lsn} if (exists $Con{$lsn});
         delete $Fileno{fileno $lsn} if (exists $Fileno{fileno $lsn});
         unpoll($lsn,$writable);
         unpoll($lsn,$readable);
         eval{close($lsn) if (fileno($lsn));};
         if ($@) {
             mlog(0,"error: unable to close Socket $lsn - $@");
         }
      }
      &ThreadWaitFinCon;
      my ($lsn2,$lsn2I) = newListen($listenPort2,\&ConToThread,1);
      @lsn2 = @$lsn2; @lsn2I = @$lsn2I;
      for (@$lsn2I) {s/:::/\[::\]:/o;}
      if (@lsn2) {
          mlog(0,"info: renewed listening for additional SMTP connections on port @$lsn2I - after too many errors");
      } else {
          mlog(0,"error: renewing listening for additional SMTP connections on port @$lsn2I - after too many errors");
          &downASSP("try restarting ASSP: failed to renew listener on @$lsn2I");
          _assp_try_restart;
      }
      return;
   }

   if (&matchFH($fh, @lsnSSLI)) {     # renew listener SSL
      foreach my $lsn (@lsnSSL ) {
         delete $SocketCalls{$lsn};
         delete $Con{$lsn} if (exists $Con{$lsn});
         delete $Fileno{fileno $lsn} if (exists $Fileno{fileno $lsn});
         unpoll($lsn,$writable);
         unpoll($lsn,$readable);
         eval{close($lsn) if (fileno($lsn));};
         if ($@) {
             mlog(0,"error: unable to close Socket $lsn - $@");
         }
      }
      &ThreadWaitFinCon;
      my ($lsnSSL,$lsnSSLI) = newListenSSL($listenPortSSL,\&ConToThread,1);
      @lsnSSL = @$lsnSSL; @lsnSSLI = @$lsnSSLI;
      for (@$lsnSSLI) {s/:::/\[::\]:/o;}
      if (@lsnSSL) {
          mlog(0,"info: renewed listening for secure SMTP connections on port @$lsnSSLI - after too many errors");
      } else {
          mlog(0,"error: renewing listening for secure SMTP connections on port @$lsnSSLI - after too many errors");
          &downASSP("try restarting ASSP: failed to renew listener on @$lsnSSLI");
          _assp_try_restart;
      }
      return;
   }

   if ($th == 2) {      # renew Proxy listener
      &ThreadWaitFinCon;
      while ((my $k,my $v) = each(%Proxy)) {
          if ( $ProxySocket{$k} eq $fh) {
              delete $SocketCalls{$fh};
              delete $Con{$fh} if (exists $Con{$fh});
              delete $Fileno{fileno $fh} if (exists $Fileno{fileno $fh});
              delete $ProxySocket{$k};
              unpoll($fh,$writable);
              unpoll($fh,$readable);
              eval{close($fh);};
              if ($@) {
                  mlog(0,"error: unable to close Socket $fh - $@");
              }

              my ($to,$allow) = split(/<=/o, $v);
              $allow = " allowed for $allow" if ($allow);
              my ($ProxySocket,$dummy) = newListen($k,\&ConToThread,2);
              $ProxySocket{$k} = shift @$ProxySocket;
              for (@$dummy) {s/:::/\[::\]:/o;}
              if ($ProxySocket{$k}) {
                  mlog(0,"info: proxy new started: listening on port @$dummy forwarded to $to$allow - after too many errors");
              } else {
                  mlog(0,"error: renewing proxy on port @$dummy forwarded to $to$allow - after too many errors");
                  &downASSP("try restarting ASSP: failed to renew proxy on port @$dummy forwarded to $to$allow");
                  _assp_try_restart;
              }
              last;
          }
      }
      return;
   }

   delete $SocketCalls{$fh};
   delete $Con{$fh} if (exists $Con{$fh});
   delete $Fileno{fileno $fh} if (exists $Fileno{fileno $fh});
   unpoll($fh,$writable);
   unpoll($fh,$readable);
   eval{close($fh);};
   if ($@) {
       mlog(0,"error: unable to close Socket $fh - $@");
   }
   foreach my $lsn (@lsn ) {          # renew mail listeners
      delete $SocketCalls{$lsn};
      delete $Con{$lsn} if (exists $Con{$lsn});
      delete $Fileno{fileno $lsn} if (exists $Fileno{fileno $lsn});
      unpoll($lsn,$writable);
      unpoll($lsn,$readable);
      eval{close($lsn) if (fileno($lsn));};
      if ($@) {
          mlog(0,"error: unable to close Socket $lsn - $@");
      }
   }
   &ThreadWaitFinCon;
   my ($lsn,$lsnI) = newListen($listenPort,\&ConToThread,1);
   @lsn = @$lsn; @lsnI = @$lsnI;
   for (@$lsnI) {s/:::/\[::\]:/o;}
   if (@lsn) {
       mlog(0,"info: renewed listening for SMTP connections on port @$lsnI - after too many errors");
   } else {
       mlog(0,"error: renewing listening for SMTP connections on port @$lsnI - after too many errors");
       &downASSP("try restarting ASSP: failed to renew listener on @$lsnI");
       _assp_try_restart;
   }
}

sub ThreadWaitFinCon {
    $ThreadsDoStatus = 1;
    while (1) {
        my $notallfinished = 10;
        my $maxtime = $smtpIdleTimeout > 0 ? $smtpIdleTimeout + 30 : 210;
        my $starttime = time;
        mlog(0,"info: $WorkerName is waiting until Workers finished current SMTP-connections or $maxtime seconds - to renew Socket-Listener");
        while ($notallfinished > 1 && time - $starttime < $maxtime) {
            $nextConSync = time - 1;
            &ConDone();
            my ($w,$t) = &getStuckWorker();
            $lastThreadsDoStatus = time;
            $ThreadsDoStatus = 1;
            Time::HiRes::sleep(0.5);
            $ThreadIdleTime{$WorkerNumber} += 0.5;
            &MainLoop2();
            &serviceCheck();
            threads->yield;
            $notallfinished = scalar(keys %ConFno) + $smtpConcurrentSessions + $SMTPSessionIP{Total};
            &ThreadMonitorMainLoop("wait finished workers - for renew listener");
            mlogWrite();
        }
        if ($notallfinished < 2) {  # there are no more active connections
            mlog(0,"info: $WorkerName detected  - all Workers are finished current SMTP-connections");
            $ThreadsDoStatus = 0;
            return;
        } else {                  # some connection are active - try to restart
            $notallfinished = scalar(keys %ConFno);
            &downASSP("try restarting ASSP: con in thread: $notallfinished, con concurrent: $smtpConcurrentSessions, con total: $SMTPSessionIP{Total}");
            _assp_try_restart;
        }
    }
}

sub ThreadGetNewCon {
    my $TGNCth;
    my $TGNCfno;
    my $TGNCsockType;
    my $TGNCfhInfo;
    my $TGNCfh;
    my $TGNCn = scalar(keys %SocketCalls);
    d('ThreadGetNewCon') unless $inSIG;
    $ComWorker{$WorkerNumber}->{numActCon} = int(($TGNCn+1)/2);      # set the number of active connection in thread
    $TGNCth = $ComWorker{$WorkerNumber}->{newCon}->{th};
    threads->yield;
    return if (! $TGNCth);
    ($TGNCfno,$TGNCsockType,$TGNCfhInfo) = split(/,/,$ComWorker{$WorkerNumber}->{newCon}->{fno});
    $TGNCfh = &getfh4fileno($TGNCfno,$TGNCsockType,$TGNCfhInfo);            # get fh from fileno
    if (! $TGNCfh) {
        $ComWorker{$WorkerNumber}->{newCon}->{fno} = '';      # make the thread ready to get new connection
        $ComWorker{$WorkerNumber}->{newCon}->{th} = '';
        threads->yield;
        $trqueue->enqueue("failed");  # tell the main thread that we are not connected!
        threads->yield;
        return;
    }
    my $TGNCnfno = fileno($TGNCfh);
    $SocketCalls{$TGNCfh} = $tThreadHandler{$TGNCth};    # set sub for Handler
    mlog(0,"info: $WorkerName got connection from MainThread") if ($WorkerLog == 1 && !$inSIG);
    mlog(0,"info: $WorkerName got connection from MainThread - $TGNCfno/$TGNCnfno") if ($WorkerLog >= 2 && ! $inSIG);
    $SocketCalls{$TGNCfh}->($TGNCfh);                 # do the first SocketCall to get connected
                                              # and free up MainLoop from wait
    $ThreadDebug = 0;
    $TGNCn = scalar(keys %SocketCalls);
    $ComWorker{$WorkerNumber}->{numActCon} = int(($TGNCn+1)/2);      # set the number of active connection in thread
    threads->yield;
    $ComWorker{$WorkerNumber}->{newCon}->{fno} = '';      # make the thread ready to get new connection
    threads->yield;
    $ComWorker{$WorkerNumber}->{newCon}->{th} = '';
    threads->yield;
}

sub getfh4fileno {
    my ($fno,$sockType,$fhInfo) = @_;
    my $fhh;
    my $ssl;
    $fhInfo =~ /^(.+)?:(\d+)$/o;
    my ($ipg,$portg) = ($1,$2);

    my %Domain;
    d("getfh4fileno: $ipg $portg $sockType");

    if ($sockType eq 'IO::Socket::INET') {
        $fhh = $sockType->new();
        $fhh->fdopen($fno, '+>');
        return $fhh;
    } elsif ($sockType eq 'IO::Socket::INET6') {
        %Domain = ($fhInfo =~ /^$IPv4Re:$PortRe$/o)
                   ? ('Domain'    => AF_INET ,'LocalAddr' => $ipg)
                   : ('Domain'    => AF_INET6,'LocalAddr' => $ipg);
        $fhh = $sockType->new(%Domain);
        $fhh->fdopen($fno, '+>');
        return $fhh;
    } else {   # IO::Socket::SSL
        if ($CanUseIOSocketINET6) {
            if ($fhInfo =~ /^$IPv4Re:$PortRe$/o) {
                %Domain = ('Domain'    => AF_INET ,'LocalAddr' => $ipg);
            } else {
                %Domain = ('Domain'    => AF_INET6,'LocalAddr' => $ipg);
            }
            $fhh = IO::Socket::INET6->new(%Domain);
        } else {
            $fhh = IO::Socket::INET->new();
        }
        $fhh->fdopen($fno, '+>');
    }

    my $fail = 0;
    eval{$fhh->blocking(1);};
    my $sslParm = {  SSL_startHandshake => 0,
                     %Domain,
                     getSSLParms(1)
                  };
    eval{
        $ssl = IO::Socket::SSL->start_SSL($fhh,$sslParm);
        if ("$ssl" !~ /SSL/io ) {
             mlog($fhh, "error: Couldn't negotiate SSL $fhInfo ".IO::Socket::SSL::errstr()) unless $inSIG;
             $fail = 1;
             eval{$fhh->blocking(0);};
        }
    };
    if ($@) {
         mlog($fhh, "error: Couldn't negotiate SSL $fhInfo - $@ ".IO::Socket::SSL::errstr()) unless $inSIG;
         eval{$fhh->blocking(0);};
         return 0;
    }
    return 0 if $fail;
    eval{$ssl->blocking(0);};
    return $ssl;
}

sub getStuckWorker {
     my $now = time;
     my $lastworker = 0;
     my $last = 0;
     my $act;
     for (my $i = 1; $i<=$NumComWorkers; $i++) {
         $act = $WorkerLastAct{$i};
         next if (! $act
                  || $ComWorker{$i}->{issleep} == 1
                  || ! $ComWorker{$i}->{run}
                  || $ComWorker{$i}->{inerror} == 1);
         if ($last < $act) {
             $lastworker = $i;
             $last = $act;
         }
         my $dif = $now - $act;
         if($dif > 180) {
             mlog(0,"info: Loop in Worker_$i was not active for $dif seconds");
             mlog(0,"info: Worker_$i : $lastsigoff{$i}");
             mlog(0,"info: Worker_$i : $lastsigon{$i}");
             mlog(0,"info: Worker_$i : last action was : ".substr($lastd{$i},0,25) );
             mlog(0,"warning: try to terminate inactive/stucking Worker_$i");
             $ComWorker{$i}->{inerror} = 1;
             $Threads{$i}->kill('TERM');
         }
     }
     return $lastworker,$act;
}

sub getBestWorker {
    my $fh = shift;
    my $worker = 0;
    my $numcon;
    my %Workers = ();
    my $trytime = time;
    my $error_was_logged = 0;
    while ($worker == 0) {          # first get all numbers of connections or 0
        &MainLoop2();               # keep the GUI running
        $numcon = 999999;
        %Workers = ();
        &ThreadMonitorMainLoop('MainThread entry getBestWorker');
        if ($ReservedOutboundWorkers && $ReservedOutboundWorkers < $NumComWorkers && &matchFH($fh, @lsnRelayI)) {    # Relay listener reservation
            for (my $i = $NumComWorkers; $i > 0; $i--) {
                next if($ComWorker{$i}->{inerror} || ! $ComWorker{$i}->{run});
                return $i,0 if $ComWorker{$i}->{issleep};    # a thread with nothing to do
                $numcon = $ComWorker{$i}->{numActCon};
                $worker = $i;
                $Workers{$i} = $numcon;
                threads->yield;
            }
        } else {     # inbound Emails or outbound without defined ReservedOutboundWorkers
            for (my $i = 1; $i<=$NumComWorkers-$ReservedOutboundWorkers; $i++) {
                next if($ComWorker{$i}->{inerror} || ! $ComWorker{$i}->{run});
                return $i,0 if $ComWorker{$i}->{issleep};    # a thread with nothing to do
                $numcon = $ComWorker{$i}->{numActCon};
                $worker = $i;
                $Workers{$i} = $numcon;
                threads->yield;
            }
        }
        &ThreadMonitorMainLoop('MainThread list possible workers');
        if( $worker == 0) {           # there was no accessable worker
            mlog(0,"info: unable to detect any running worker for a new connection - wait (max $ConnectionTransferTimeOut seconds)") unless $error_was_logged & 1;
            $error_was_logged &= 1;
            &MainLoop2();             # keep the GUI running
            if (time - $trytime > $ConnectionTransferTimeOut) {   # the connection transfer timeout is reached
                &ThreadYield();
                $willSIG = 0;
                &ThreadYield();
                mlog(0,"info: ConnectionTransferTimeOut ($ConnectionTransferTimeOut seconds) is now reached");
                return -1,0;
            }
            Time::HiRes::sleep(0.01) ;   # there is no worker able to take the connection - so wait
            next;
        }
        &ThreadMonitorMainLoop('MainThread check transfer timeout (1)');
        $worker = 0;    # we have to interrupt workers - check if it is possible
        &MainLoop2();   # keep the GUI running
        threads->yield;
        $willSIG = 1 if ($willSIG == 0);  # tell the workers that we have to interrupt
        threads->yield;
        my @tmpSortedKeys =  sort { $Workers{$main::a} <=> $Workers{$main::b}} keys(%Workers);  # sort the workers by there active connection
        &ThreadMonitorMainLoop('MainThread sort best workers');
        while (@tmpSortedKeys) {
            my $key = shift @tmpSortedKeys;
            if ($ComWorker{$key}->{issleep}) {
                threads->yield;
                $willSIG = 0;   # tell all workers - there is no need to wait
                threads->yield;
                return $key,0;  # return - the worker is now free
            }
            threads->yield;
            $key = $willSIG - 11000 if ($willSIG > 11000);  # is there a worker waiting for an interrupt than we'll use it
            threads->yield;
            $worker = $key;
            $numcon = $Workers{$key};
            mlog(0,"info: try to interrupt worker Worker_$key ($numcon) for new connection") if ($WorkerLog >= 2);
            &ThreadMonitorMainLoop("willSIG = $willSIG - try to interrupt worker Worker_$key ($numcon) for new connection");
            if ($ComWorker{$key}->{CANSIG}) {       # yes we can interrupt this worker
                $Threads{$key}->kill('CONT');
                mlog(0,"info: $WorkerName interrupted Worker_$key ($numcon) to submit the connection") if ($WorkerLog >= 2);
                &ThreadMonitorMainLoop("willSIG = $willSIG - $WorkerName interrupted Worker_$key ($numcon) to submit the connection");
                threads->yield;
                $willSIG = 0;   # tell all workers - there is no need to wait
                threads->yield;
                return $key,$numcon;
            }
            &MainLoop2();    # keep the GUI running
            &ThreadYield();
        }
        mlog(0,"info: $WorkerName is unable to interrupt any worker for new connection - wait (max $ConnectionTransferTimeOut seconds)") if ($WorkerLog >= 2 && $error_was_logged & 2);
        $error_was_logged &= 2;
        $worker = 0;
        &MainLoop2();        # keep the GUI running
        if (time - $trytime > $ConnectionTransferTimeOut) {    # the connection transfer timeout is reached
            &ThreadYield();
            $willSIG = 0;        # tell all workers - there is no need to wait
            &ThreadYield();
            return -1,0;
        }
        &ThreadMonitorMainLoop('MainThread check transfer timeout (2)');
        Time::HiRes::sleep(0.01) ;   # there is no worker able to take the connection - so wait
        &ThreadYield();
    }
    &ThreadYield();
    return $worker,$numcon;
}

sub threadConDone {
    my $fhh = shift;
    return unless($fhh);
    my $fno;
    if (exists $Con{$fhh} && $Con{$fhh}->{self}) {
        $fno = fileno($Con{$fhh}->{self});
        $fno = $Con{$fhh}->{fno} if (! $fno && exists $Con{$fhh}->{fno});
    } else {
        $fno = fileno($fhh);
    }
    unpoll($fhh,$readable);
    unpoll($fhh,$writable);
    delete $SocketCalls{$fhh} if (exists $SocketCalls{$fhh});
    delete $Fileno{$fno} if (exists $Fileno{$fno});
    if (exists $ConFno{$fno}) {delete $ConFno{$fno}};
}

sub ThreadStart {
    my $Iam = shift;
    $tqueue = shift;
    $trqueue = shift;
    $WorkerNumber = $Iam;
    threads->detach();
    close STDOUT;
    close STDERR;
    close STDIN;
    if ($CanUseBerkeleyDB) {
        eval('use BerkeleyDB;');
        if ($VerBerkeleyDB lt '0.42') {
            *{'BerkeleyDB::_tiedHash::CLEAR'} = *{'main::BDB_CLEAR'};
        }
        *{'BerkeleyDB::_tiedHash::STORE'} = *{'main::BDB_STORE'};
        *{'BerkeleyDB::_tiedHash::DELETE'} = *{'main::BDB_DELETE'};
    }
    unloadComThreadModules() if $undefMEM;
    my $exception = '';
    do {
      $exception = '';
      %dampedFH = ();
      $calledfromThread = 1;
      $WorkerName = "Worker_$Iam";
      &initGlobalThreadVar();
      eval{
          &initDBHashes();
          &initPrivatHashes();
      };
      if ($@) {
          mlog(0,"$WorkerName will now try to recover from the startup error in 5 seconds");
          sleep 5;
          $ThreadIdleTime{$WorkerNumber} += 5;
          mlog(0,"$WorkerName try to recover from the startup error");
          &clearDBCon();
          $ComWorker{$Iam}->{run} = 1;
          $ComWorker{$Iam}->{inerror} = 0;
          &initDBHashes();
          &initPrivatHashes();
          mlog(0,"$WorkerName recovered successful from the startup error");
      }
      
      mlog(0,"$WorkerName started");
      &sigCentralSet();
      &sigon(__LINE__);
      while ($ComWorker{$Iam}->{run}) {
          my $run = eval {&ThreadMain();};
          $exception = $@ if $@;
          if (! $exception && ! $run && $ComWorker{$Iam}->{run}) {
              &sigoff(__LINE__);
              &ThreadGoSleep($Iam);
              &sigon(__LINE__);
          }
      }
      if (!$exception && ! $ComWorker{$Iam}->{run}){
          foreach my $fh (keys %Con) {
              removeCrashFile($fh);
          }
          $ComWorker{$Iam}->{run} = 2;
          my $stopTime = time + $MaxFinConWaitTime;
          mlog(0,"$WorkerName has active connections. Will wait until all connections are finished but max $MaxFinConWaitTime seconds!") if ($ComWorker{$Iam}->{numActCon});
          my $run = 1;
          $@ = undef;
          while (! $@ && $run && time < $stopTime) {$run = eval {&ThreadMain();} }
          $ComWorker{$Iam}->{run} = 0;
      }
      &sigoff(__LINE__);
      if ($exception) {
          $ComWorker{$WorkerNumber}->{CANSIG} = 0;
          mlog (0,"Error: $WorkerName: $exception");
          d("Error: $@");
          writeExceptionLog("Error: $WorkerName: $exception");
          $exception = ": $exception";
      };
      $ComWorker{$WorkerNumber}->{CANSIG} = 0;
      mlog (0,"Info: auto restart died worker $WorkerName") if ($ComWorker{$Iam}->{run} && $autoRestartDiedThreads);
      &clearDBCon();
      delete $ComWorker{$Iam}->{numActCon};
      foreach my $fh (keys %Con) {
          printallCon($fh,$exception);
          removeCrashFile($fh);
          eval{close($fh);};
          delete $Con{$fh};
          delete $SMTPSession{$fh};
      }
      foreach my $fh (keys %SocketCallsNewCon) {
          eval{close($fh);};
          delete $SocketCallsNewCon{$fh};
          delete $Con{$fh};
      }
    } while ($ComWorker{$Iam}->{run} && $autoRestartDiedThreads);
    mlog(0,"$WorkerName finished");
    d("finished work $exception");
    &printVars();
    $ComWorker{$Iam}->{finished} = 1;
    threads->exit(1);
}

sub ThreadMaintStart {
    $WorkerNumber = shift;
    threads->detach();
    close STDOUT;
    close STDERR;
    close STDIN;
    unloadHighThreadModules() if $undefMEM;
    unloadSub 'write_rebuild_module' if $undefMEM;
    if ($CanUseBerkeleyDB) {
        eval('use BerkeleyDB;');
        if ($VerBerkeleyDB lt '0.42') {
            *{'BerkeleyDB::_tiedHash::CLEAR'} = *{'main::BDB_CLEAR'};
        }
        *{'BerkeleyDB::_tiedHash::STORE'} = *{'main::BDB_STORE'};
        *{'BerkeleyDB::_tiedHash::DELETE'} = *{'main::BDB_DELETE'};
    }
    my $exception = '';
    do {
      $exception = '';
      $calledfromThread = 1;
      $WorkerName = "Worker_$WorkerNumber";
      &initGlobalThreadVar();
      &initDBHashes();
      &initPrivatHashes();
      &initFileHashes('AdminGroup');  # AdminGroup is never shared;
      mlog(0,"$WorkerName started");
      &sigCentralSet();
      eval{while ($ComWorker{$WorkerNumber}->{run}) {&ThreadYield();&ThreadMaintMain();}1;}
      or do {
          mlog (0,"Error: $WorkerName: $@");
          d("Error: $@");
          writeExceptionLog("Error: $WorkerName: $@");
          $exception = ": $@";
      };
      mlog (0,"Info: auto restart died worker $WorkerName") if ($ComWorker{$WorkerNumber}->{run} && $autoRestartDiedThreads);
      foreach (keys %RunTaskNow) {
          $RunTaskNow{$_} = '';
      }
      if (! $ComWorker{$WorkerNumber}->{run}) {
          processMaintCMDQueue();
      } else {
          while ($cmdQueue->pending()) {
              my $parm;
              d('clean CMD from cmdQueue');
              threads->yield();
              my $item = $cmdQueue->dequeue_nb(1);
              threads->yield();
              my ($sub,$parmnum) = $item =~ /^sub\(([^\)]+)\)(.*)/o;
              mlog(0,"info: cleaned command '$sub' from commandqueue");
          }
          { lock(%cmdQParm) if is_shared(%cmdQParm); %cmdQParm = ();}
      }
      &DMARCgenReport(1) if    $ValidateSPF       # send the DMARK reports if %DMARCpol and %DMARCrec are not in BDB
                            && $DoDKIM
                            && $DMARCReportFrom
                            && ! ($ComWorker{$WorkerNumber}->{run} && $autoRestartDiedThreads)
                            && ! (exists $BerkeleyDBHashes{DMARCpol} && exists $BerkeleyDBHashes{DMARCrec});
      &clearDBCon();
    } while ($ComWorker{$WorkerNumber}->{run} && $autoRestartDiedThreads);
    mlog(0,"$WorkerName finished");
    d("finished work $exception");
    &printVars();
    $ComWorker{$WorkerNumber}->{finished} = 1;
    threads->exit();
}

sub ThreadRebuildSpamDBStart {
    my $Iam = shift;
    $WorkerNumber = $Iam;
    threads->detach();
    close STDOUT;
    close STDERR;
    close STDIN;
    unloadHighThreadModules() if $undefMEM;
    undef $GPBinstallLib;
    undef $GPBmodTestList;
    undef $GPBCompLibVer;
    our $cleanHMM;
    if ($CanUseBerkeleyDB) {
        eval('use BerkeleyDB;');
        if ($VerBerkeleyDB lt '0.42') {
            *{'BerkeleyDB::_tiedHash::CLEAR'} = *{'main::BDB_CLEAR'};
        }
        *{'BerkeleyDB::_tiedHash::STORE'} = *{'main::BDB_STORE'};
        *{'BerkeleyDB::_tiedHash::DELETE'} = *{'main::BDB_DELETE'};
    }
    my $exception = '';
    do {
      $exception = '';
      $cleanHMM = '';
      $calledfromThread = 1;
      $WorkerName = "Worker_$Iam";
      &initGlobalThreadVar();
      &initDBHashes();
      &initPrivatHashes();
      &initFileHashes('AdminGroup');  # AdminGroup is never shared;
      mlog(0,"$WorkerName started");

      &sigCentralSet();
      $SIG{INT}=\&sigToMainThread;
      $SIG{TERM}=\&sigToMainThread;
      $SIG{HUP}=\&sigToMainThread;
      $SIG{USR1}=\&sigToMainThread;
      $SIG{USR2}=\&sigToMainThread;
      $SIG{NUM07}=\&sigToMainThread;

      eval{while ($ComWorker{$Iam}->{run}) {&ThreadRebuildSpamDBMain();}1;}
      or do {
          mlog (0,"Error: $WorkerName: $@");
          d("Error: $@");
          writeExceptionLog("Error: $WorkerName: $@");
          $exception = $@;
      };
      mlog (0,"Info: auto restart died worker $WorkerName") if ($ComWorker{$Iam}->{run} && $autoRestartDiedThreads);
      $RunTaskNow{RunRebuildNow} = '';
      &clearDBCon();
    } while ($ComWorker{$Iam}->{run} && $autoRestartDiedThreads);
    mlog(0,"$WorkerName finished");
    d("finished work $exception");
    &printVars();
    $ComWorker{$Iam}->{finished} = 1;
    threads->exit();
}

sub newThread {
    my $Iam = shift;
    $ComWorker{$Iam} = &share({});
    $ComWorker{$Iam}->{run} = 1;
    $ComWorker{$Iam}->{issleep} = 0;
    $ComWorker{$Iam}->{inerror} = 0;
    $ComWorker{$Iam}->{newCon} = &share({});
    $ThreadQueue{$Iam} = Thread::Queue->new();
    my $rq = "r".$Iam;
    $ThreadQueue{$rq} = Thread::Queue->new();
    if ($ThreadStackSize) {
        $Threads{$Iam} = threads->create({'stack_size' => 1024*1024*$ThreadStackSize},\&ThreadStart,$Iam,$ThreadQueue{$Iam},$ThreadQueue{$rq});
    } else {
        $Threads{$Iam} = threads->create(\&ThreadStart,$Iam,$ThreadQueue{$Iam},$ThreadQueue{$rq});
    }
}

sub tellThreadQuit {
    my $thread = shift;
    mlog(0,"tell Worker $thread - QUIT") if ($WorkerLog);
    $ComWorker{$thread}->{run} = 0;
    ThreadYield;
    $ThreadQueue{$thread}->enqueue("run") if ($ComWorker{$thread}->{issleep});
    ThreadYield;
}

sub WaitForAllThreads {
    my $allstart = 0;
    my $count = time;
    while (! $allstart && time - $count < 60) {   # wait for the threads to start but max 60 seconds
        &ThreadMonitorMainLoop('MainThread waiting for threads are started');
        if ($ComWorker{10000}->{isstarted} == 1 or $ComWorker{10000}->{inerror}) {
            $allstart = 1;
        } else {
            $allstart = 0;
            Time::HiRes::sleep(0.2);
            next;
        }
        &mlogWrite();
        if ($ComWorker{10001}->{isstarted} == 1 or $ComWorker{10000}->{inerror}) {
            $allstart = 1;
        } else {
            $allstart = 0;
            Time::HiRes::sleep(0.2);
            next;
        }
        &mlogWrite();
        foreach (keys %Threads) {
            next if ($_ > 9999);  # only for ComWorkers
            &mlogWrite();
            if ($ComWorker{$_}->{issleep} == 1 or $ComWorker{$_}->{inerror}) {
                $allstart = 1;
            } else {
                $allstart = 0;
                Time::HiRes::sleep(0.2);
                last;
            }
            &mlogWrite();
        }
    }
    mlog (0,"all Threads are started");
    &ThreadMonitorMainLoop('MainThread: all threads are started');
}

sub stopSMTPThreads {
    foreach (keys %Threads) {
        next if $_ > 9999;
        tellThreadQuit($_) unless $ComWorker{$_}->{finished};
    }
    mlog (0,"waiting for all SMTP-Workers to be finished");
    &mlogWrite();
    my $allend = 0;
    my $count = time;
    my $timeout = $MaxFinConWaitTime + 5;
    while (! $allend && time - $count < $timeout) {   # wait for the threads to end but max 50 seconds
        foreach (keys %Threads) {
            next if $_ > 9999;
            &MainLoop2();
            &ThreadMonitorMainLoop('MainThread waiting until end of all SMTP-threads');
            &mlogWrite();
            if ($ComWorker{$_}->{finished} == 1) {
                $allend = 1;
            } else {
                $allend = 0;
                Time::HiRes::sleep(0.2);
                last;
            }
        }
    }
    mlog (0,"SMTP Workers finished") if $allend;
    mlog (0,"error: at least one of the SMTP workers has not finished work within $timeout seconds") if ! $allend;
    &mlogWrite();
    return $allend;
}

sub stopHighThreads {
    foreach (10000, 10001) {
        tellThreadQuit($_) unless $ComWorker{$_}->{finished};
    }
    mlog (0,"waiting for high Workers to be finished");
    &mlogWrite();
    my $allend = 0;
    my $count = time;
    while (! $allend && time - $count < 50) {   # wait for the threads to end but max 50 seconds
        foreach (10000, 10001) {
            &MainLoop2();
            &ThreadMonitorMainLoop('MainThread waiting until end of high threads');
            &mlogWrite();
            if ($ComWorker{$_}->{finished} == 1) {
                $allend = 1;
            } else {
                $allend = 0;
                Time::HiRes::sleep(0.2);
                last;
            }
        }
    }
    mlog (0,"high workers finished work") if $allend;
    mlog (0,"error: at least one of the high workers has not finished work within 50 seconds") if ! $allend;
    &mlogWrite();
    return $allend;
}

sub ThreadsWakeUp {
    while (my ($k,$v) = each %Threads) {
        next if ($k > 9999);  # only for ComWorkers
        if ($ComWorker{$k}->{run} == 1 &&
            $ComWorker{$k}->{issleep} &&
            time - $WorkerLastAct{$k} + rand(58) >= $ThreadsWakeUpInterval)
        {
            threads->yield;
            $ThreadQueue{$k}->enqueue('status');
            threads->yield;
        }
    }
}

sub ThreadStatus {
    my $Iam = shift;
    while ( my ($c,$v) = each %Con) {
      return unless $ThreadsDoStatus;
      if ($Con{$c}->{type} eq 'C' && ! $Con{$c}->{movedtossl}) {
        my $fno = $Con{$c}->{fno} ;
        $ConFno{$fno} = &share({}) if (! exists $ConFno{$fno});
        threads->yield;
        eval{$ConFno{$fno}->{timestart} = $Con{$c}->{timestart};};
        eval{$ConFno{$fno}->{timelast} = $Con{$c}->{timelast};};
        eval{$ConFno{$fno}->{helo} = $Con{$c}->{helo};};
        eval{$ConFno{$fno}->{mailfrom} = $Con{$c}->{mailfrom};};
        eval{$ConFno{$fno}->{rcpt} = $Con{$c}->{rcpt};};
        eval{$ConFno{$fno}->{lastcmd} = $Con{$c}->{lastcmd};};
        eval{$ConFno{$fno}->{relayok} = $Con{$c}->{relayok};};
        eval{$ConFno{$fno}->{ip} = $Con{$c}->{ip};};
        eval{$ConFno{$fno}->{spamfound} = $Con{$c}->{spamfound};};
        eval{$ConFno{$fno}->{maillength} = $Con{$c}->{maillength};};
        eval{$ConFno{$fno}->{messagescore} = $Con{$c}->{messagescore};};
        eval{$ConFno{$fno}->{worker} = $Iam;};
        eval{$ConFno{$fno}->{ssl} = $Con{$c}->{oldfh} ? '*' : '_' ;};
        eval{$ConFno{$fno}->{friendssl} = $Con{$Con{$c}->{friend}}->{oldfh} ? '*' : '_' ;};
        eval{$ConFno{$fno}->{damping} = $Con{$c}->{damping};};
        eval{$ConFno{$fno}->{noprocessing} = $Con{$c}->{noprocessing};};
        eval{$ConFno{$fno}->{whitelisted} = $Con{$c}->{whitelisted};};
        eval{$ConFno{$fno}->{headerpassed} = $Con{$c}->{headerpassed};};
      }
    }
    threads->yield();
}

sub tellThreadsReReadConfig {
    if ($Config{inclResendLink}) {
        $Config{fileLogging} = 1;
        $fileLogging = 1;
    }
    &SaveConfig() if ($ConfigChanged < 2);
    &optionFilesReload();
    &initMaintScheduler if $ScheduleIsChanged;
    %LDAPNotFound = ();
    &ConfigOverwriteRe();
    &readNorm();
    if (! $NextConfigReload) {
        foreach my $name (keys %ConfigWatch) {
            next if $ConfigWatch{$name} eq 'delete';
            my ($s,$t,$d) = split(/,/o,$ConfigWatch{$name},3);
            $s->($name, $Config{$name}, $Config{$name}, '', $d);
        }
    }
    foreach (keys %Threads) {
        $ComWorker{$_}->{rereadconfig} = $_ >= 10000 ? time + $NumComWorkers + 1 + $_ - 10000 : time + $_;
        threads->yield();
        next if $_ >= 10000;
        $ThreadQueue{$_}->enqueue('run') if ($ComWorker{$_}->{issleep});
        ThreadYield();
    }
    reloadGriplist();
    $ConfigChanged = 0;
    threads->yield;
}

sub ThreadReReadConfig {
    my $Iam = shift;
    threads->yield;
    &ThreadCompileAllRE(0);
    &ConfigOverwriteRe();
    threads->yield();
    reloadGriplist();
    $ComWorker{$Iam}->{rereadconfig} = 0;
    threads->yield;
    mlog(0,"$WorkerName finished reloading configuration") if ($WorkerLog);
    $MinPollTimeT =  $MinPollTime ? $MinPollTime : 1 ;
}

sub SMTPSessionLimitCheck {
    my $numsess;
    d('SMTPSessionLimitCheck');
    threads->yield;
    $numsess = $SMTPSessionIP{Total};
    if ($numsess <= 0) {
        threads->yield;
        $numsess = $SMTPSessionIP{Total} = 0;
        threads->yield;
    }
    # overall session limiting
    $maxSMTPSessions=999 if (!$maxSMTPSessions);
    if ($numsess >= $maxSMTPSessions) {
        if (! $reachedSMTPlimit) {
            $reachedSMTPlimit = 1;
            mlog(0,"warning : SMTP-session-limit $maxSMTPSessions is reached - SMTP listeners for incoming mails are temporary switched off");
            foreach my $lsn (@lsn ) {
                unpoll($lsn,$readable) if $lsn;
            }
            foreach my $lsn (@lsn2 ) {
                unpoll($lsn,$readable) if $lsn;
            }
            foreach my $lsn (@lsnSSL ) {
                unpoll($lsn,$readable) if $lsn;
            }
#            foreach my $lsn (@lsnRelay ) {
#                unpoll($lsn,$readable) if $lsn;
#            }
        }
    } else {
        if ($reachedSMTPlimit && ($maxSMTPSessions <= 5 || $maxSMTPSessions - $numsess > 20 || $numsess < int($maxSMTPSessions * 0.75))) {
            $reachedSMTPlimit = 0;
            mlog(0,"info : falling below SMTP-session-limit $maxSMTPSessions - SMTP listeners for incoming mails are now switched on");
            foreach my $lsn (@lsn ) {
                 &dopoll($lsn,$readable,POLLIN) if $lsn;
            }
            foreach my $lsn (@lsn2 ) {
                 &dopoll($lsn,$readable,POLLIN) if $lsn;
            }
            foreach my $lsn (@lsnSSL ) {
                 &dopoll($lsn,$readable,POLLIN) if $lsn;
            }
#            foreach my $lsn (@lsnRelay ) {
#                 &dopoll($lsn,$readable,POLLIN) if $lsn;
#            }
        }
    }
}

sub ThreadGoSleep {
      my $Iam = shift;
      if ($ComWorker{$Iam}->{rereadconfig}) {
          &ThreadYield();
          return;
      }
      $ComWorker{$Iam}->{issleep} = 1;      # tell all we go sleep
      $ComWorker{$Iam}->{inerror} = 0;     # reset the error sign
      my @read = $readable->handles();
      while (@read) {
         my $fh = shift @read;
         unpoll($fh,$readable);
         mlog(0,"error: $WorkerName removed Ghosthandle read: $fh , please report") if $ConnectionLog > 2;
         done2($fh);
      }
      &ConDone();
      my @write = $writable->handles();
      while (@write) {
         my $fh = shift @write;
         unpoll($fh,$writable);
         mlog(0,"error: $WorkerName removed Ghosthandle write: $fh , please report") if $ConnectionLog > 2;
         done2($fh);
      }
      &ConDone();
      while ( my ($fh,$v) = each %SMTPSession) {
         mlog(0,"error: $WorkerName removed Ghosthandle SMTPSession: $fh , please report") if $ConnectionLog > 2;
         done2($fh);
      }
      &ConDone();
      while ( my ($fh,$v) = each %Con) {
         done2($fh) if "$fh" =~ /socket/io;
      }
      &ConDone();
      mlog(0,"$WorkerName prepare to sleep") if ($WorkerLog >= 2 && ! $thread_nolog && $ComWorker{$Iam}->{run} != 2);
      %Con=();
      undef %Con;
      %Fileno = ();
      undef %Fileno;
      return if $ComWorker{$Iam}->{run} == 2;  # we got a Quit - there is nothing more to do
      d('sleeping');
      mlog(0,"$WorkerName will sleep now") if ($WorkerLog && (! $thread_nolog || $WorkerLog == 3));
      my $mem = $showMEM ? printMem() : 0;
      mlog(0,"info: worker memory$mem") if $mem && $MaintenanceLog > 2;
      $WorkerLastAct{$Iam} = time;
      my $st = Time::HiRes::time();
      threads->yield;
      my $res = $tqueue->dequeue(1);         # wait until anyone wakes us up;
      threads->yield;
      $ComWorker{$Iam}->{issleep} = 0;      # tell all we are not sleeping
      threads->yield;
      $ThreadIdleTime{$Iam} += Time::HiRes::time() - $st;
      threads->yield;
      $thread_nolog = 0;
      $thread_nolog = 1 if ( $res eq 'status' );
      mlog(0,"$WorkerName wakes up") if ($WorkerLog && (! $thread_nolog || $WorkerLog == 3));
      $mem = $showMEM ? printMem() : 0;
      mlog(0,"info: worker memory$mem") if $mem && $MaintenanceLog > 2;
      $WorkerLastAct{$Iam} = time;
      threads->yield;
      &ThreadGetNewCon();
      &NewSMTPConCall();
}

sub ThreadMonitorMainLoop {
     my $t = shift;
     return if $WorkerNumber;
     return unless $MonitorMainThread;
     threads->yield();
     $MainLoopStepTime = time;
     threads->yield();
     $MainLoopLastStep = $t;
     threads->yield();
}

sub ThreadMaintMain {
    my $Iam = $WorkerNumber;
    my $wasrun = 0;
    $WorkerLastAct{$Iam} = time;
    my ( $sec, $min, $hour, $mday, $mon, $year ) = localtime(time);
    undef %Con unless keys(%Con);
    &ThreadReReadConfig($Iam) if ($ComWorker{$Iam}->{rereadconfig} && $ComWorker{$Iam}->{rereadconfig} <= time);
    if (! $ComWorker{$Iam}->{isstarted}) {
        my $gripcount;
        if ($griplist && $GriplistDriver eq 'orderedtie') {
            $gripcount = scalar keys %{$GriplistObj->{cache}};
        } else {
            $gripcount = BDB_getRecordCount('Griplist');
        }
        $ComWorker{$Iam}->{isstarted} = 1;
        %WhiteOrgList = ();
        d('build WhiteOrgList from Senderbase-Cache');
        while (my ($k,$v)=each(%SBCache)) {    # load WhiteOrgList from SBCache
            if ($v !~ /\!/o or $k !~ /\//o) {
                delete $SBCache{$k};
                next;
            }
            my ( $ct, $status, $data ) = split( /!/o, $v );
            my ( $ipcountry, $orgname, $domainname, $blacklistscore, $hostname_matches_ip, $ipCIDR ) = split( /\|/o, $data ) ;
            $WhiteOrgList{lc $domainname} = $orgname if ($status == 2 && $domainname && $orgname);
        }
        &cleanCachePersBlack();
        mlog(0,"info: last full Griplist download was at: " .  timestring($Griplist{'255.255.255.255'}))  if $MaintenanceLog && exists $Griplist{'255.255.255.255'};
        mlog(0,"info: last delta Griplist download was at: " . timestring($Griplist{'255.255.255.254'})) if $MaintenanceLog && exists $Griplist{'255.255.255.254'};
        $NextGriplistDownload = ($Griplist{'255.255.255.254'} + 3550 > time + 180) ? $Griplist{'255.255.255.254'} + 3550 : time + 180;
        $NextGriplistDownload = time + 60 unless $gripcount;
        $NextDroplistDownload = time + 150;
        my ($file) = $TLDS =~ /^ *file: *(.+)/io;
        $NextTLDlistDownload = time + 120 if (-e "$base/$file");
        $NextBackDNSFileDownload = time + 300;
        $NextVersionFileDownload = time + 60;
        $NextASSPFileDownload = time + 90;
        $NextSyncConfig = time + 60;
        $nextStatsUpload = $Stats{nextUpload};
        ScheduleMapSet('GroupsReloadEvery');
        ScheduleMapSet('POP3Interval');
        ($file) = $localBackDNSFile =~ /^ *file: *(.+)/io;
        if ($file && $DoBackSctr && $downloadBackDNSFile) {
            $file = "$base/$file";
            $FileUpdate{"$file".'localBackDNSFile'} = ftime($file);
        }
        my $assp = $assp;
        $assp =~ s/\\/\//go;
        $assp = $base.'/'.$assp if ($assp !~ /\Q$base\E/io);
        if (-e $assp) {
            $FileUpdate{"$assp".'asspCode'} = ftime($assp);
            mlog(0,"info: watching the running script '$assp' for changes")
              if ($AutoRestartAfterCodeChange && ($AsAService || $AsADaemon || $AutoRestartCmd));
        } elsif ($AutoRestartAfterCodeChange) {
            mlog(0,"warning: unable to find running script '$assp' for 'AutoRestartAfterCodeChange'")
              if ($AsAService || $AsADaemon || $AutoRestartCmd);
        }
    }

    if ($doShutdownForce || $doShutdown > 0 || $allIdle) {
        unless (&ThreadMaintMain2($Iam)) {sleep 1; $ThreadIdleTime{$WorkerNumber} += 1;}
        return;
    }
    return if(! $ComWorker{$Iam}->{run});

    my $isRunTask;
    foreach (keys %RunTaskNow) {
        $isRunTask ||= $RunTaskNow{$_} if $RunTaskNow{$_} != 10000;
        threads->yield();
    }
    if (! $isRunTask && $doShutdown < 0) {
        mlog(0,"info: assp has finished all running tasks after a scheduled restart was requested - initialize automatic restart for ASSP in 15 seconds");
        $doShutdown = time + 15;
        mlog(0,"info: damping is now switched off until assp is down") if $DoDamping;
        return;
    }

    &ThreadMaintMain2($Iam);

    my $lassp = $assp;
    $lassp =~ s/\\/\//go;
    $lassp = $base.'/'.$lassp if ($lassp !~ /\Q$base\E/io);
    if ((lc $AutoRestartAfterCodeChange eq 'immed' ||
        ( $AutoRestartAfterCodeChange && $codeChanged && $hour == $AutoRestartAfterCodeChange)) &&
        ($AsAService || $AsADaemon || $AutoRestartCmd) &&
        ! $isRunTask &&
        ! $doShutdown &&
        ! $allIdle &&
        $NextCodeChangeCheck < time &&
        -e "$lassp" &&
        fileUpdated($lassp,'asspCode')
       )
    {
        $FileUpdate{"$lassp".'asspCode'} = ftime($lassp);
        mlog(0,"info: new '$lassp' script detected - performing syntax check on new script");
        my $cmd;
        if ($^O eq "MSWin32") {
            $cmd = '"' . $perl . '"' . " -c \"$lassp\" 2>&1";
        } else {
            $cmd = '\'' . $perl . '\'' . " -c \'$lassp\' 2>&1";
        }
        my $res = qx($cmd);
        if ($res =~ /syntax\s+OK/ios) {
            if ($res !~ /ASSP\s+$MajorVersion/ios) {
                mlog(0,"error: autoupdate: the version of '$lassp' is not an ASSP major version $MajorVersion - restoring current running script $MAINVERSION!");
                copy($lassp.'.run',"$lassp") && ($FileUpdate{"$lassp".'asspCode'} = ftime($lassp));
            } else {
                mlog(0,"info: new '$lassp' script detected - syntax check returned OK - requesting automatic restart for ASSP in 15 seconds");
                $doShutdown = -1;
            }
        } else {
            mlog(0,"error: new '$lassp' script detected - syntax error in new script - skipping automatic restart - syntax error is: $res");
        }
        $NextCodeChangeCheck = time + 60;
        $codeChanged = '';
        $wasrun = 1;
    } else {
        $NextCodeChangeCheck = time + 60 if time > $NextCodeChangeCheck;
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);

    if ($AutoUpdateASSP && ! $doShutdown && ! $allIdle && time >= $NextASSPFileDownload) {
        if (! $noModuleAutoUpdate && ftime("$base/notes/avail_perl_modules.txt") < time - 3600 * 12) {
            if ($AutoUpdateASSP == 2) {
                mlog(0,"search and install updates for Perl modules");
                %AvailPerlModules = Perl_upgrade_do('--install');
            } else {
                mlog(0,"search updates for Perl modules");
                %AvailPerlModules = Perl_upgrade_do();
            }

            open(my $F , '>' , "$base/notes/avail_perl_modules.txt");
            binmode $F;
            print $F "Available and not installed upgrades of Perl modules at ".&timestring()."\n\n";
            print $F "module\tversion\n\n";
            foreach (sort keys %AvailPerlModules) {
                print $F "$_\t".$AvailPerlModules{$_}."\n";
            }
            my $ucmd = ">perl -MCPAN -e 'CPAN::Shell->install(CPAN::Shell->r)'";
            $ucmd = ">ppm update --install  or  " . $ucmd if ($^O eq 'MSWin32');
            if (scalar keys %AvailPerlModules) {
                print $F "\n\n";
                print $F "To update the modules in this list, stop all perl processes (also assp!), start a commandline and type $ucmd\n";
                mlog(0,"warning: some Perl modules are not installed and need manual action $ucmd");
            } else {
                print $F "All installed Perl modules are uptodate.\n";
                mlog(0,"info: all installed Perl modules are uptodate.");
            }
            close $F;

            mlog(0,"finished Perl modules updates");
            $wasrun++;
        }
        $wasrun += &downloadASSPVersion();
        if ($AutoRestartAfterCodeChange && $codeChanged == 2  &&
            ($AsAService || $AsADaemon || $AutoRestartCmd))
        {
            if ($isRunTask) {
                mlog(0,"info: assp has updated still loaded modules - schedule automatic restart for ASSP after still running task are finished");
                $doShutdown = -1;
            } else {
                mlog(0,"info: assp has updated still loaded modules - initialize automatic restart for ASSP in 15 seconds");
                $doShutdown = time + 15;
            }
        }
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);

    if($UpdateWhitelist && time >= $saveWhite) {
        ScheduleMapSet('UpdateWhitelist');
        d('ThreadMaintMain - saveWhite');
        if  (!$mysqlSlaveMode || $whitelistdb!~/DB:/o || $failedTable{Whitelist}) {
            &SaveWhitelistOnly();
            $wasrun = 1;
        }
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);
    if($CleanDelayDBInterval && time >= $nextCleanDelayDB) {
        ScheduleMapSet('CleanDelayDBInterval');
        d('ThreadMaintMain - CleanDelayDB');
        if (!$mysqlSlaveMode || $delaydb!~/DB:/o) {
            &CleanDelayDB;
            $wasrun = 1;
        }
    }
    return if(! $ComWorker{$Iam}->{run}|| $wasrun);
    if($CleanPBInterval && time >= $nextCleanPB ) {
        ScheduleMapSet('CleanPBInterval');
        d('ThreadMaintMain - CleanPB');
        if (!$mysqlSlaveMode || $pbdb!~/DB:/o) {
            &CleanPB;
            $wasrun = 1;
        }
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);
    if(time >= $nextCleanIPDom ) {
        $nextCleanIPDom = time + 300;
        d('ThreadMaintMain - CleanIP');
        &cleanCacheIPNumTries();
        &cleanCacheSMTPdomainIP();
        &cleanCacheSSLfailed();
        &cleanCacheLocalFrequency();
        &cleanCacheSubjectFrequency();
        &cleanCacheAUTHErrors();
        &cleanCacheDelayIPPB();
        &cleanCacheEmergencyBlock();
        &cleanCacheRFC822();
        &DMARCgenReport(0) if $ValidateSPF && $DoDKIM && $DMARCReportFrom;
        &ThreadYield();
        $wasrun = 1;
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);
    if($CleanCacheEvery && time >= $nextCleanCache ) {
        ScheduleMapSet('CleanCacheEvery');
        d('ThreadMaintMain - CleanCache');
        if (!$mysqlSlaveMode || $pbdb!~/DB:/o) {
            &CleanCache;
            $wasrun = 1;
        }
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);
    if($remindBATVTag && time >= $nextCleanBATVTag ) {
        d('ThreadMaintMain - cleanCacheBATVTag');
        $nextCleanBATVTag = time + 3600;
        if (!$mysqlSlaveMode || $pbdb!~/DB:/o) {
            &cleanCacheBATVTag;
            $wasrun = 1;
        }
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);
    if($exportInterval && time >= $nextExport) {
        d('ThreadMaintMain - exportExtreme');
        ScheduleMapSet('exportInterval');
        &exportExtreme;
        $wasrun = 1;
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);
    if(   $backupDBInterval
       && time >= $nextDBBackup
       && ! $RunTaskNow{ExportMysqlDB}
       && ! $RunTaskNow{ImportMysqlDB}
       && ! $RunTaskNow{RunRebuildNow}
       )
    {
        ScheduleMapSet('backupDBInterval');
        d('ThreadMaintMain - ExportMysqlDB - backup');
        $RunTaskNow{ExportMysqlDB}=10000;
        $ExportIsRunning = 1;
        &exportMysqlDB('backup');
        $ExportIsRunning = 0;
        $RunTaskNow{ExportMysqlDB}='';
        $wasrun = 1;
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);
    if($SaveStatsEvery && time >= $NextSaveStats) {
        SaveStats();
        $wasrun = 1;
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);
    if( $totalizeSpamStats && time >= $nextStatsUpload) {
        uploadStats();
        $wasrun = 1;
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);
    if(! $noGriplistDownload && ! $noGriplistUpload && $griplist && time >= $NextGriplistDownload) {
        $wasrun = &downloadGrip();
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);
    if($droplist && time >= $NextDroplistDownload) {
        $wasrun = &downloadDropList();
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);
    if($ValidateURIBL && time >= $NextTLDlistDownload) {
        $wasrun = &downloadTLDList();
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);
    if($localBackDNSFile && $DoBackSctr && $downloadBackDNSFile && time >= $NextBackDNSFileDownload) {
        $wasrun = &downloadBackDNS();
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);
    if($DoGlobalBlack && time >= $nextGlobalUploadBlack && $CanUseHTTPCompression && $globalClientName && $globalClientPass) {
        $wasrun = &uploadGlobalPB('pbdb.black.db');
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);
    if($DoGlobalWhite && time >= $nextGlobalUploadWhite && $CanUseHTTPCompression && $globalClientName && $globalClientPass) {
        $wasrun = &uploadGlobalPB('pbdb.white.db');
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);
    if(! $AutoUpdateASSP && time >= $NextVersionFileDownload) {
        $wasrun = &downloadVersionFile();
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);

    if ($Groups && $GroupsReloadEvery && time >= $NextGroupsReload && scalar keys %GroupRE && $GroupsDynamic) {
        ScheduleMapSet('GroupsReloadEvery');
        my $fil;
        $fil = $1 if $Groups  =~/^ *file: *(.+)/io;
        if ($fil) {
            $fil="$base/$fil" if $fil!~/^\Q$base\E/io;
            utime(undef,undef,$fil);
            $nextOptionCheck = 0;
        }
    }

    if($ReloadOptionFiles && ! $ConfigChanged && time >= $nextOptionCheck ){
         d('ReloadOptionFiles');
         ScheduleMapSet('ReloadOptionFiles','nextOptionCheck');
         for my $idx (0...$#PossibleOptionFiles) {
          my $f = $PossibleOptionFiles[$idx];
          if($f->[0] ne 'asspCfg' || ($f->[0] eq 'asspCfg' && $AutoReloadCfg)) {
              if ($Config{$f->[0]}=~/^ *file: *(.+)/io && fileUpdated($1,$f->[0])) {
                my $fl = $1;
                if ($f->[0] eq 'asspCfg' && $asspCFGTime > $FileUpdate{"$base/assp.cfgasspCfg"}) {
                    $FileUpdate{"$base/assp.cfgasspCfg"} = $asspCFGTime;
                    next;
                }
                $ConfigChanged = $f->[0] eq 'asspCfg' ? 2 : 1;
                d("file $f->[0] - changed");
                $wasrun = 1;
                last;
             }
          }
        }
        my ($file) = $localBackDNSFile =~ /^ *file: *(.+)/io;
        if ($file &&
            $DoBackSctr &&
            $downloadBackDNSFile &&
            fileUpdated($file,'localBackDNSFile')
           )
        {
            mlog(0,"option list file: '$file' changed (localBackDNSFile)");
            &mergeBackDNS($file);
            mlog(0,"option list file: '$file' reloaded (localBackDNSFile) in to BackDNS");
            $wasrun = 1;
        }
        my $mem = $showMEM ? printMem() : 0;
        mlog(0,"info: worker memory$mem") if $mem && $MaintenanceLog > 2;
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);

    if ($ReloadOptionFiles && time >= $nextHashFileCheck) {
        ScheduleMapSet('ReloadOptionFiles','nextHashFileCheck');
        $wasrun = &checkFileHashUpdate();
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);

    if(time >= $nextDNSCheck) {
        d('updateDNS');
        $nextDNSCheck = time + 60;
        updateDNS( 'DNSServers', $Config{DNSServers}, $Config{DNSServers}, '' );
        unless ($process_external_cmdqueue) {
            $process_external_cmdqueue = -e "$base/cmdqueue";
            mlog(0, "info: external CMD-queue '$base/cmdqueue' registered") if $process_external_cmdqueue;
        }
    }

    if (isSched($MaxFileAgeSchedule) && time >= $nextFileAgeSchedule && ! $RunTaskNow{RunRebuildNow}) {
        ScheduleMapSet('MaxFileAgeSchedule');
        &cleanUpMailLog();
        &cleanUpCollection();
        $wasrun = 1;
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);

    if (isSched($BlockReportSchedule) && time >= $nextBlockReportSchedule) {
        ScheduleMapSet('BlockReportSchedule');
        &BlockReportGen();
        $wasrun = 1;
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);

    if (isSched($QueueSchedule) && time >= $nextQueueSchedule) {
        ScheduleMapSet('QueueSchedule');
        &BlockReportGen('USERQUEUE');
        $wasrun = 1;
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);

    if ( time > $nextdetectHourJob  ) {
        ( $sec, $min, $hour, $mday, $mon, $year ) = localtime(time);
        my $moreThanOneHour = int((time - $nextdetectHourJob)/3600);
        $nextdetectHourJob = int(time / 3600) * 3600 + 3600;
        $nextdetectHourJob += 15 unless ($nextdetectHourJob + $TimeZoneDiff) % (24 * 3600);  # some seconds more at midnight
                                                                                             # because the maillog rolls
        mlog(0,"info: next hourly scheduler will run at " . &timestring($nextdetectHourJob)) if $MaintenanceLog >= 2;

        do {
            my $runHour = $hour-$moreThanOneHour;
            $runHour = 24 + $runHour if $runHour < 0;
            d("run HourJobs - scheduled - ($runHour)");
            if ($moreThanOneHour) {
                mlog(0,"info: hourly scheduler for $runHour:00 is running at $hour:00");
            } else {
                cleanCacheT10() if $DoT10Stat;
                mlog(0,"info: hourly scheduler running at $hour:00");
            }

            if (! isSched($MaxFileAgeSchedule) ) {
                &cleanUpMailLog() if $runHour == int($MaxLogAgeSchedule);
                &cleanUpCollection() if defined $MaxFileAgeSchedule && $runHour == int($MaxFileAgeSchedule);
            }
            
            &BlockReportGen() if ! isSched($BlockReportSchedule) && $runHour == int($BlockReportSchedule);
            &BlockReportGen('USERQUEUE') if ! isSched($QueueSchedule) && $runHour == int($QueueSchedule);

            &CleanWhitelist() if $UpdateWhitelist && $hour % 2;  # clean and save whitelist every 2 hours

        } while  $moreThanOneHour--;
        
        $wasrun = 1;
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);

    if (time >= $nextBDBsync) {
        $wasrun = &BDB_sync(5);
        $nextBDBsync = time + 900;
    }
    return if(! $ComWorker{$Iam}->{run} || $wasrun);

    if (   ! $doShutdown
        && isSched($MemoryUsageCheckSchedule)
        && time >= $nextMemoryUsageCheckSchedule)
    {
        $Config{MemoryUsageLimit} = $MemoryUsageLimit = (($Config{NumComWorkers} + 3) * 100) if ($Config{MemoryUsageLimit} && $Config{MemoryUsageLimit} < (($Config{NumComWorkers} + 3) * 100));
        if (! $isRunTask) {
            my $usage = int(&memoryUsage() / 1048576);
            if (   $usage
                && ($AsAService || $AsADaemon || $AutoRestartCmd)
                && $MemoryUsageLimit
                && $usage > $MemoryUsageLimit)
            {
                mlog(0,"warning: the memory usage of the current process is $usage MB, which exceeds $MemoryUsageLimit MB (MemoryUsageLimit) - requesting automatic restart for ASSP in 15 seconds");
                $doShutdown = time + 15;
                $wasrun = 1;
            } elsif ($usage && $MaintenanceLog > 2) {
                mlog(0,"info: the memory usage of the current process is $usage MB, limit is ".($MemoryUsageLimit || 'n/a')." MB (MemoryUsageLimit)");
            }
        } elsif ($MaintenanceLog > 2 && (my $usage = int(&memoryUsage() / 1048576))) {
            my $tasks;
            foreach (keys %RunTaskNow) {
                 $tasks .= "$_($RunTaskNow{$_}) " if $RunTaskNow{$_};
                 threads->yield();
            }
            $tasks = " - current running tasks are: $tasks" if $tasks;
            $tasks .= '- the requested restart is delayed until all running tasks are finshed, or skipped if the memory usage will be reduced' if $tasks && $MemoryUsageLimit && $usage > $MemoryUsageLimit;
            mlog(0,"info: the memory usage of the current process is $usage MB, limit is ".($MemoryUsageLimit || 'n/a')." MB (MemoryUsageLimit)$tasks");
        }
        ScheduleMapSet('MemoryUsageCheckSchedule');
    }

    d('idle loop (5 s)') ;
    my $maxsleep = Time::HiRes::time() + 5;
    while (Time::HiRes::time() < $maxsleep && $ComWorker{$Iam}->{run} && ! $ConfigChanged && ! $ComWorker{$Iam}->{rereadconfig}) {
        if (! ($wasrun = &ThreadMaintMain2($Iam))) {
            &ThreadYield();
            Time::HiRes::sleep(0.3);
            $ThreadIdleTime{$Iam} += 0.3;
        }
    }
    d('MonitorMainThread');
    threads->yield();
    my $ms = $MainLoopLastStep;
    threads->yield();
    my $mst = $MainLoopStepTime;
    threads->yield();
    my $mt = time - $mst;
    if ($mst && $mt > 60 && $MonitorMainThread && $ComWorker{main}) {
      my $text = "error: MainThread stuck for $mt seconds after: $ms - last debug step was: $lastd{0}!";
      my $text2 = "\n";
      my $t = timestring();
      for (1...$NumComWorkers) {
          threads->yield();
          my $tdiff = time - $WorkerLastAct{$_};
          threads->yield();
          $text2 .= "\n$t Worker($_): last loop start before $tdiff seconds - signals: can:$ComWorker{$_}->{CANSIG}, state:$ComWorker{$_}->{SIGSTATE}, never:$ComWorker{$_}->{NEVERSIG} - last debug step is : $lastd{$_}";
      }
      my $tdiff = time - $WorkerLastAct{10001};
      $text2 .= "\n$t Worker(10001): last loop start before $tdiff seconds - last debug step is : $lastd{10001}";
      if ($mst > $MainLoopStepTime2) {
          $MainLoopStepTime2 = $mst;
          my $textI = "$t $text";
          open my $MLS , '>>',"$base/MainThread_stuck_err.log";
          binmode $MLS;
          print $MLS "$textI$text2\n\n\n";
          close $MLS;
          $text2 = s/\n/\r\n/gos;
          if ($canNotify && $Notify && $EmailFrom) {
              &sendNotification(
                $EmailFrom,
                $Notify,
                "ASSP error notification from $myName",
                "logged error on host $myName:\r\n\r\n$textI$text2");
                $t = '*x*';
          } else {
              $t = '';
          }
          mlog(0,"$t$text");
      }
    } elsif ($MainLoopStepTime2) {
        mlog(0,"*x*info: MainThread has retured to normal state after stuck");
        if ($canNotify && $Notify && $EmailFrom) {
            &sendNotification(
              $EmailFrom,
              $Notify,
              "ASSP information notification from $myName",
              "information on host $myName:\r\n\r\nMainThread has retured to normal state after stuck\r\n");
        }
        $MainLoopStepTime2 = 0;
    }
}

sub parseEval {
    my $line = shift;
    $line =~ s/\r?\n//go;
    $line =~ s/^\s+//o;
    $line =~ s/\s+$//o;
    return (undef,undef) unless ($line =~ /^(\&[a-zA-Z0-9_]+)\s*(\(.*\))?[;\s]*$/o);
    my $sub = $1;
    my $parm = $2;
    $parm =~ s/^\((.*)\)$/$1/o;
    $parm =~ s/\$([a-zA-Z0-9_]+)/\${$1}/go;
    $parm =~ s/\@([a-zA-Z0-9_]+)/\@{$1}/go;
    $parm =~ s/\%([a-zA-Z0-9_]+)/\%{$1}/go;
    $parm =~ s/\&([a-zA-Z0-9_]+)/\&{$1}/go;
    return ($sub,$parm);
}

sub ThreadChangeVar {
    my ($var,$parm) = @_;
    $$var = $parm;
}

sub RunEval {
    my $cmd = shift;
    eval($cmd);
}

sub processMaintCMDQueue {
    my $Iam = $WorkerNumber;
    return 0 if $Iam < 10000;
    my $wasrun = 0;
    my $l = $lastd{$Iam};
    &checkDBCon() if $Iam == 10001;
    
    while ($cmdQueueReleased && (my $pending = $cmdQueue->pending())) {
        $WorkerLastAct{$Iam} = time if $Iam == 10001;
        my ($sub,$parmnum,$parm);
        d("get CMD from cmdQueue");
        { lock(%cmdQParm) if is_shared(%cmdQParm);
        threads->yield;
        my $item = $cmdQueue->dequeue_nb(1);
        threads->yield;
        ($sub,$parmnum) = $item =~ /^sub\(([^\)]+)\)(.*)/o;
        d("run CMD ($sub) from cmdQueue");
        $parm = $cmdQParm{$parmnum};
        delete $cmdQParm{$parmnum};
        $pending -= 1;
        }
        next if ($sub eq 'SPFbg' && (! $ComWorker{$Iam}->{run} || $doShutdownForce || $doShutdown));
        if ($sub) {
            mlog(0,"info: got command '$sub' from command queue - $pending commands pending") if $MaintenanceLog >= 2;
            $wasrun = 1;
            eval{&$sub($parm);};
            if ($@) {
                mlog(0,"error: cmdqueue failed '$sub' - $@");
            }
            &ThreadYield();
        }
    }
    $lastd{$Iam} = $l;
    return $wasrun;
}

# time critical tasks
sub ThreadMaintMain2 {
    my $Iam = $WorkerNumber;
    return 0 if $Iam != 10000;
    return 0 if $isRunTMM2;
    $isRunTMM2 = 1;
    my $wasrun;
    my $l = $lastd{$Iam};
# database connection check is done independend from any time values
# the complete check for all tables should never take more than 0.05 seconds if all is ok
    if (($CanUseTieRDBM or $CanUseBerkeleyDB) && $DBisUsed && time >= $nextDBcheck) { # check - do we have lost any DB connection
                                       # and reconnect if possible
        my $cdbstime=Time::HiRes::time(); # to get the check time
        my $cdberror=&checkDBCon(time + $ThreadsWakeUpInterval + 2);      # or switch to files
        my $cdbetime=sprintf("%.3f",(Time::HiRes::time()) - $cdbstime); # to get the check time
        d("info: database connection was checked in $cdbetime seconds");
        mlog(0,"info: '$DBusedDriver' database connection was checked in $cdbetime seconds for all tables") if $MaintenanceLog > 2 && $DBusedDriver ne 'BerkeleyDB';
        mlog(0,"warning: $WorkerName - check the '$DBusedDriver' database connections has taken $cdbetime seconds (max=1.000s)") if ($cdbetime>1 && ! $cdberror); #0.1s is ok
        &ThreadYield();
        $lastd{$Iam} = $l;
    }

    $wasrun = processMaintCMDQueue();

    if ($CanUseEMS && $resendmail && time >= $nextResendMail) {
        mlog(0,"info: looking for files to (re)send") if $MaintenanceLog >= 2;
        $nextResendMail = time + 300;
        d('ThreadMaintMain - resend_mail');
        &resend_mail();
        $wasrun = 1;
        &ThreadYield();
        $lastd{$Iam} = $l;
    }
    if(! $ComWorker{$Iam}->{run} || $doShutdownForce || $doShutdown) {$isRunTMM2 = 0; return $wasrun ;}

    if ($NextConfigReload && time >= $NextConfigReload) {
        $NextConfigReload = 0;
        $lastd{$Iam} = $l;
        $ConfigChanged = 1;
        $wasrun = 1;
    }
    if(! $ComWorker{$Iam}->{run}) {$isRunTMM2 = 0; return $wasrun ;}

    if (! $allIdle && scalar keys %ScheduledTask) {
        foreach my $task (sort keys %ScheduledTask) {
            next if (eval{$ScheduledTask{$task}->{Nextrun} >= time;});
            $wasrun = 1;
            $ScheduledTask{$task}->{Run}->($ScheduledTask{$task}->{Parm});
            &ThreadYield();
            my $nextsched = getNextSched($ScheduledTask{$task}->{Schedule},$ScheduledTask{$task}->{Desc});
            if ($nextsched >= time) {
                $ScheduledTask{$task}->{Nextrun} = $nextsched;
                $nextsched = timestring($nextsched);
                mlog(0,"info: rescheduled task : $ScheduledTask{$task}->{Desc} - to : $ScheduledTask{$task}->{Parm} - at : $ScheduledTask{$task}->{Schedule} - next run is at : $nextsched") if $MaintenanceLog > 1;
            } else {
                delete $ScheduledTask{$task};
                mlog(0,"error: removed scheduled task : $ScheduledTask{$task}->{Desc} - to : $ScheduledTask{$task}->{Parm} - at : $ScheduledTask{$task}->{Schedule} - calculated schedule is in the past");
            }
        }
        $lastd{$Iam} = $l;
    }
    if(! $ComWorker{$Iam}->{run}) {$isRunTMM2 = 0; return $wasrun ;}

    if (! $DisableSMTPNetworking && ! $reachedSMTPlimit && $POP3Interval && time >= $NextPOP3Collect) {
        mlog(0,"info: starting POP3 collection") if $MaintenanceLog >= 2;
        $wasrun = &POP3Collect();
        ScheduleMapSet('POP3Interval');
        $lastd{$Iam} = $l;
    }
    if(! $ComWorker{$Iam}->{run}) {$isRunTMM2 = 0; return $wasrun ;}

    if ($enableCFGShare && $CanUseNetSMTP && $isShareMaster && time >= $NextSyncConfig) {
        my $i = 0;
        my $wr = 0;
        for my $idx (0...$#ConfigArray) {
            my $c = $ConfigArray[$idx];
            last if(! $ComWorker{$Iam}->{run});
            next if ( ! $c->[0] || @{$c} == 5);
            next if $ConfigSync{$c->[0]}->{sync_cfg} != 1;
            my $stat = &syncGetStatus($c->[0]);
            next if($stat < 1 or $stat == 2);
            $wr += &syncConfigSend($c->[0]);
            ++$i > 10 and last;
        }
        $NextSyncConfig = time + ($wr ? 30 : 60);
        &ThreadYield();
        $wasrun |= $wr;
        $lastd{$Iam} = $l;
    }
    if(! $ComWorker{$Iam}->{run}) {$isRunTMM2 = 0; return $wasrun ;}

    if ($RunTaskNow{ExportMysqlDB} == 10000 && ! $ExportIsRunning) {
        d('ThreadMaintMain - ExportMysqlDB - export');
        $ExportIsRunning = 1;
        &exportMysqlDB('export');
        $ExportIsRunning = 0;
        $RunTaskNow{ExportMysqlDB} = '';
        mlog(0,'INFO: EXPORT removed from queue');
        &ThreadYield();
        $wasrun = 1;
        $lastd{$Iam} = $l;
    }
    if(! $ComWorker{$Iam}->{run}) {$isRunTMM2 = 0; return $wasrun ;}

    if ($RunTaskNow{ImportMysqlDB} == 10000) {
        d('ThreadMaintMain - ImportMysqlDB');
        &importMysqlDB();
        $RunTaskNow{ImportMysqlDB} = '';
        mlog(0,'INFO: IMPORT removed from queue');
        &ThreadYield();
        $wasrun = 1;
        $lastd{$Iam} = $l;
    }
    if(! $ComWorker{$Iam}->{run}) {$isRunTMM2 = 0; return $wasrun ;}

    if ($RunTaskNow{fillUpImportDBDir} == 10000) {
        d('ThreadMaintMain - fillUpImportDBDir');
        &importFillUp($RunTaskNow{fillUpImportDBDir});
        mlog(0,'INFO: fillUpImportDBDir removed from queue');
        $RunTaskNow{fillUpImportDBDir} = '';
        &ThreadYield();
        $wasrun = 1;
        $lastd{$Iam} = $l;
    }
    if(! $ComWorker{$Iam}->{run}) {$isRunTMM2 = 0; return $wasrun ;}

    if (($CanUseLDAP or $CanUseNetSMTP) && $ldaplistdb && ($RunTaskNow{forceLDAPcrossCheck} == 10000 or ($LDAPcrossCheckInterval && time >= $nextLDAPcrossCheck && ! $allIdle))) {
        ScheduleMapSet('LDAPcrossCheckInterval');
        d('ThreadMaintMain - forceLDAPcrossCheck');
        $RunTaskNow{forceLDAPcrossCheck} = 10000;
        if (!$mysqlSlaveMode) {
            &LDAPcrossCheck();
            $wasrun = 1;
        }
        $RunTaskNow{forceLDAPcrossCheck} = '';
        mlog(0,'INFO: LDAP/VRFY-CrossCheck removed from queue');
        &ThreadYield();
        $lastd{$Iam} = $l;
    }
    if(! $ComWorker{$Iam}->{run}) {$isRunTMM2 = 0; return $wasrun ;}

    if ($RunTaskNow{BlockReportNow} == 10000) {
        d('BlockReportGen - now');
        &BlockReportGen("1");
        $RunTaskNow{BlockReportNow} = '';
        $wasrun = 1;
        &ThreadYield();
        $lastd{$Iam} = $l;
    }
    if(! $ComWorker{$Iam}->{run}) {$isRunTMM2 = 0; return $wasrun ;}

    $isRunTMM2 = 0;
    return $wasrun;
}

sub ThreadRebuildSpamDBMain {
    my $Iam = $WorkerNumber;
    $StartRebuild = 1;
    my ($mcount, $minutes) = split(/\s+/o,$newReportedInterval);
    my $nowRebuildSchedule = $RebuildSchedule;
    my $nowReStartSchedule = $ReStartSchedule;
    $WorkerLastAct{$Iam} = time;
    $itime=Time::HiRes::time(); # loop cycle idle end time

    if (! $ComWorker{$Iam}->{isstarted}) {
        $ComWorker{$Iam}->{isstarted} = 1;
        if (! &write_rebuild_module($ComWorker{$Iam}->{rb_version})) {
            mlog(0,"error: unable to create $base/lib/rebuildspamdb.pm module - $!");
        }
        sleep 5;
        $ThreadIdleTime{$Iam} += 5;
        threads->yield();
    }

    if ($doShutdownForce || $doShutdown != 0) {
        sleep 1;
        $ThreadIdleTime{$Iam} += 1;
        threads->yield();
        return;
    }
    return if ! $ComWorker{$Iam}->{run};

    if ($ComWorker{$Iam}->{rereadconfig} && $ComWorker{$Iam}->{rereadconfig} <= time) {
        &ThreadReReadConfig($Iam);
        &ThreadYield();
        return;
    }

    if($spamdb && $RunTaskNow{RunRebuildNow} == 10001) {
        &runRebuild();
        $nextRebuildSpamDB = isSched($RebuildSchedule) ? getSchedTime('RebuildSchedule') : 0;
        $RunTaskNow{RunRebuildNow} = '';
        mlog(0,"INFO: RebuildSpamdb removed from queue");
    }

    if ($allIdle) {
        sleep 1;
        $ThreadIdleTime{$Iam} += 1;
        return;
    }

    if (($spamdb && $CanUseSchedCron && $RebuildSchedule !~ /noschedule/io ) or
        ($ReStartSchedule && $CanUseSchedCron)
       )
    {
        d('schedule waiting');
        my $cron = Schedule::Cron->new(
            sub{
                $ThreadIdleTime{$Iam} += 5;
                my $t = Time::HiRes::time();
                if ($RunTaskNow{RunRebuildNow} == 10001) {
                    &runRebuild();
                    mlog(0,"INFO: RebuildSpamdb removed from queue");
                    d('schedule waiting');
                    $WorkerLastAct{$Iam} = time;
                    die "harmless\n";
                }
                die "harmless\n" if (! $ComWorker{$WorkerNumber}->{run} || $allIdle);
                if ($ComWorker{$WorkerNumber}->{rereadconfig} && $ComWorker{$WorkerNumber}->{rereadconfig} <= time) {
                    &ThreadReReadConfig($Iam);
                    $WorkerLastAct{$Iam} = time;
                    d('schedule waiting');
                    die "harmless\n" if (($nowRebuildSchedule ne $RebuildSchedule) || ($nowReStartSchedule ne $ReStartSchedule));
                }
                $WorkerLastAct{$Iam} = time if manualCorrected();
                my $h = scalar(keys(%newReported));
                if ($minutes && $h && ($h >= $mcount || time > $nextNewReported)) {
                    $t -= &rebuildAddCorrections();
                    $nextNewReported = time + $minutes * 60;
                } elsif (time > $nextNewReported) {
                    $nextNewReported = time + $minutes * 60;
                    my $mem = $showMEM ? printMem() : 0;
                    mlog(0,"info: worker memory$mem") if $mem && $MaintenanceLog > 2;
                }
                &processMaintCMDQueue();
                threads->yield();
                $ThreadIdleTime{$Iam} -= Time::HiRes::time() - $t;
                d('schedule waiting');
                return;
            },{processprefix => "$perl $assp"});
        $cron->add_entry("* * * * * 0-59/5");
        $StartRebuild = 0;
        if ($spamdb && $RebuildSchedule !~ /noschedule/io) {
            for (split/\|/o,$RebuildSchedule) {$cron->add_entry($_,\&runRebuild)};
        }
        if ($ReStartSchedule && $ReStartSchedule !~ /noschedule/io) {
            for (split/\|/o,$ReStartSchedule) {$cron->add_entry($_,\&schedShutdown);}
        }
        mlog(0,"info: starting RebuildSpamdb Scheduler with '$RebuildSchedule'") if($ScheduleLog && $spamdb && $RebuildSchedule !~ /noschedule/io);
        mlog(0,"info: starting ReStart Scheduler with '$ReStartSchedule'") if($ScheduleLog && $ReStartSchedule !~ /noschedule/io);
        $StartRebuild = 1;
        eval{$cron->run(nofork => 1,skip => 1, log => \&schedlog, detach => 0);};
        mlog(0,"error: $@") if ($@ && $@ !~ /harmless/io);
        &ThreadYield();
        mlog(0,"info: RebuildSpamdb Scheduler stopped") if($ScheduleLog && $RebuildSchedule !~ /noschedule/io);
        mlog(0,"info: ReStart Scheduler stopped") if($ScheduleLog && $ReStartSchedule !~ /noschedule/io);
        return;
    }
    
    &ThreadYield();
    my $t = 1 - processMaintCMDQueue();
    manualCorrected();
    my $h = scalar(keys(%newReported));
    if ($minutes && $h && ($h >= $mcount || time > $nextNewReported)) {
        $t -= &rebuildAddCorrections();
        $nextNewReported = time + $minutes * 60;
    } elsif (time > $nextNewReported) {
        $nextNewReported = time + $minutes * 60;
    }
    $t = 0 if $t < 0;
    $t *= 6;
    d("idle loop ($t s)");
    if ($t) {
        sleep $t;
        $ThreadIdleTime{$Iam} += $t;
    }
}

sub schedShutdown {
   return unless $ReStartSchedule;
   d('init scheduled shutdown/restart');
   mlog(0,"info: requesting scheduled shutdown/restart");
   $doShutdown = -1;
}

sub schedlog {
    my($lvl,$msg) = @_;
    my @Levels = ('Info', 'Warning', 'Error');
    mlog(0,$Levels[$lvl].": $msg") if ($ScheduleLog >= 2 or ($ScheduleLog && $lvl > 0));
}

sub manualCorrected {
    my @filelist;
    my $result;
    my $found = 0;
    my @list = $unicodeDH->("$base/$correctedspam/newManualyAdded");
    while ( my $file = shift @list) {
        next if $dF->( "$base/$correctedspam/newManualyAdded/$file" );
        next if ($file !~ /\Q$maillogExt\E$/i);
        $found++;
        $unlink->("$base/$correctedspam/$file");
        $newReported{"$base/$correctedspam/$file"} = 'spam'
            if $move->("$base/$correctedspam/newManualyAdded/$file","$base/$correctedspam/$file");
        $unlink->("$base/$correctedspam/newManualyAdded/$file");
    }
    @list = $unicodeDH->("$base/$correctednotspam/newManualyAdded");
    while ( my $file = shift @list) {
        next if $dF->( "$base/$correctednotspam/newManualyAdded/$file" );
        next if ($file !~ /\Q$maillogExt\E$/i);
        $found++;
        $unlink->("$base/$correctednotspam/$file");
        $newReported{"$base/$correctednotspam/$file"} = 'ham'
            if $move->("$base/$correctednotspam/newManualyAdded/$file","$base/$correctednotspam/$file");
        $unlink->("$base/$correctednotspam/newManualyAdded/$file");
    }
    return $found;
}

sub runRebuild {
    return until $StartRebuild;
    return if $doShutdown < 0 || $allIdle;
    $RunTaskNow{RunRebuildNow} = 10001;
    d('start rebuild');

    if (! &write_rebuild_module($ComWorker{$WorkerNumber}->{rb_version})) {
        mlog(0,"error: unable to create $base/lib/rebuildspamdb.pm module, cancel request - $!");
        $RunTaskNow{RunRebuildNow} = '';
        return;
    }

    &checkDBCon();
    my $can = defined $rebuildspamdb::VERSION;
    $can = eval('use rebuildspamdb;1;') unless $can;
    eval('rebuildspamdb::rb_run(0);') if $can;
#    eval('use rebuildspamdb; rebuildspamdb::rb_run(0); no rebuildspamdb;');

    if ($@) {
        my $text = $@;
        my $reason = 'failed';
        my $error = 'error';
        if ($text =~ /got stop request/o) {
            $text =~ s/ at .+//o;
            $reason = 'aborted';
            $error = 'info';
        }
        if ($DoHMM && $main::cleanHMM) {
            %main::HMMdb = ();
            $main::haveHMM = 0;
            mlog(0,"warning: removed possibly incomplete Hidden Markov Model - run the rebuild again to get a complete HMM database");
        }
        mlog(0,"$error: rebuildspamdb $reason - $text");
    } elsif ($spamdb !~ /DB:/o) {
        mlog(0,"info: writing new spamdb to disk");
        &SaveHash('Spamdb');
        &SaveHash('HeloBlack');
    }
    $main::cleanHMM = $main::lockHMM = 0;
    $RunTaskNow{RunRebuildNow} = '';
    $nextRebuildSpamDB = isSched($RebuildSchedule) ? getSchedTime('RebuildSchedule') : 0;
    d('finished rebuild');
}

sub rebuildAddCorrections {
    return if $doShutdown < 0 || $allIdle;

    if (! $spamdb || (! $haveHMM && ! $haveSpamdb)) {
        %newReported = ();
        return;
    }
    d('start rebuildAddCorrections');
    mlog(0,'start rebuildAddCorrections');

    &checkDBCon();
    my $can = defined $rebuildspamdb::VERSION;
    $can = eval('use rebuildspamdb;1;') unless $can;
    eval('rebuildspamdb::rb_run(1);') if $can;
#    eval('use rebuildspamdb; rebuildspamdb::rb_run(1); no rebuildspamdb;');
    if ($@) {
        %newReported = ();
        my $text = $@;
        my $reason = 'failed';
        my $error = 'error';
        if ($text =~ /got stop request/o) {
            $text =~ s/ at .+//o;
            $reason = 'aborted';
            $error = 'info';
        }
        mlog(0,"$error: rebuildAddCorrections $reason - $text");
    }
    &ThreadYield();
    d('finished rebuildAddCorrections');
    return;
}

sub ThreadMain {
    my $Iam = $WorkerNumber;
    $WorkerLastAct{$Iam} = time;
    my @canread;
    my @canwrite;
    my @selerr;
    my $numActCon;
    &sigoff(__LINE__);
    &ConDone();
    &ThreadGetNewCon();
    &NewSMTPConCall();
    &ConDone();
    $numActCon = $ComWorker{$Iam}->{numActCon};
    &ThreadReReadConfig($Iam) if ($ComWorker{$Iam}->{rereadconfig} && $ComWorker{$Iam}->{rereadconfig} <= time);
    &sigon(__LINE__);
    &ThreadStatus($Iam) if ($ThreadsDoStatus);
    return $numActCon if(! $ComWorker{$Iam}->{run});
# database connection check is done independend from any time values
# the complete check for all tables should never take more than 0.05 seconds if all is ok
    my $itime=Time::HiRes::time(); # loop cycle idle end time
    if (($CanUseTieRDBM or $CanUseBerkeleyDB) && $DBisUsed && $itime >= $nextDBcheck) { # check - do we have lost any DB connection
        my $cdbstime=Time::HiRes::time(); # to get the check time
        my $cdberror=&checkDBCon(int($itime) + 90);                                # or switch to files
        my $cdbetime= sprintf("%.3f",(Time::HiRes::time()) - $cdbstime) ; # to get the check time
        d("info: database connection was checked in $cdbetime seconds");
        mlog(0,"warning: $WorkerName - check the database connections has taken $cdbetime seconds (max=1.000s)") if ($cdbetime>1 && ! $cdberror); #0.1s is ok
    }

    $numActCon = $ComWorker{$Iam}->{numActCon};
    return 0 if ($numActCon == 0);

    my $wait = $pollwait;
    my $longwait = $EnableHighPerformance ? $MinPollTimeT/1000 : 1 ;
    &sigoff(__LINE__);
    my $stime=Time::HiRes::time(); # loop cycle start time

    my $re;
    my $rh;
    if ($rh = $readable->handles()) {
        if ($IOEngineRun == 0) {
            $re = $readable->poll($wait);
            @canread = $readable->handles(POLLIN|POLLHUP);
        } else {
            @canread = $readable->can_read($wait);
            $re = @canread;
            @selerr = $readable->has_exception($MinPollTimeT/1000);
        }
        if ($re > 0) {
            $wait = $MinPollTimeT/1000;
        } elsif ($re == 0) {
            $wait = $longwait;
            &ThreadYield() if $wait == 1;
        }
        if ($re < 0 or @selerr) {
            &pollerror($readable);
            $wait = scalar(@canread) ? $MinPollTimeT/1000 : $longwait;    # wait at least two milliseconds
        }
    }
    d("rh: $rh - read: $re - wait: $wait");

    my $wr;
    my $wh;
    if ($wh = $writable->handles()) {
        if ($IOEngineRun == 0) {
            $wr = $writable->poll($wait);
            @canwrite = $writable->handles(POLLOUT|POLLHUP);
        } else {
            @canwrite = $writable->can_write($wait);
            $wr = @canwrite;
            @selerr = $writable->has_exception($MinPollTimeT/1000);
        }
        if ($wr > 0) {
            $pollwait = $MinPollTimeT/1000;                 # wait at least two milliseconds
        } elsif ($wr == 0) {
            $pollwait = $wait;
            &ThreadYield() if $wait == 1;
        }
        if ($wr < 0 or @selerr) {
            &pollerror($writable);
            $pollwait = scalar(@canwrite) ? $MinPollTimeT/1000 : $wait;    # wait at least two milliseconds
        }
    } else {
        $pollwait = $wait;
    }
    d("wh: $wh - write: $wr - wait: $pollwait");

    $itime=Time::HiRes::time(); # poll loop cycle idle end time
    &sigon(__LINE__);
    my $ptime = $itime - $stime;
    mlog(0,"warning: the operating system socket poll cycle has taken $ptime seconds - this is very much is too long")
        if ($ConnectionLog >= 2 and $ptime > 3);
    &ThreadYield();

    if (! $EnableHighPerformance && ($rh + $wh == 0)) {
        my $loop = 300;
        do {
            &ThreadYield();
        } while ! $ComWorker{$Iam}->{numActCon} && --$loop;
    } elsif ($rh + $wh == 0) {
        $pollwait = 1;
        sleep 1;
    }

    $ThreadIdleTime{$Iam} += Time::HiRes::time() - $stime;
    while (@canwrite) {
        my $fh = shift @canwrite;
        return $numActCon if(! $ComWorker{$Iam}->{run});
        next unless(fileno($fh));
        if (exists $Con{$fh}->{sendTime}) {
            next if $Con{$fh}->{sendTime} < time;
            delete $Con{$fh}->{sendTime};
        }
        $ThreadDebug = $Con{$fh}->{debug};
        my $l=length($Con{$fh}->{outgoing});
        d("$fh $Con{$fh}->{ip} l=$l");
        if($l) {
            $thread_nolog = 0;
            $fh->blocking(0) if $fh->blocking;
            &sigoff(__LINE__);
            my $written;
            eval{$written=$fh->syswrite($Con{$fh}->{outgoing},$l);};
            my $werr;
            $werr = ' - '.$!.' - '.$@ if $! or $@;
            &sigon(__LINE__);
            if (!$written && $werr) {
                mlog($fh,"warning: $fh got writeerror$werr",1) if $ConnectionLog > 1 && $Con{$fh}->{lastWriteError} ne $werr;
                $Con{$fh}->{lastWriteError} = $werr;
            } elsif (! $werr) {
                delete $Con{$fh}->{lastWriteError};
            }
            $Con{$fh}->{lastwritten} = time;
            if($debug or $ThreadDebug) {
                if ($debugNoWriteBody) {
                    d("wrote: $fh $Con{$fh}->{ip} ($written)$werr");
                } else {
                    d("wrote: $fh $Con{$fh}->{ip} ($written)<".substr($Con{$fh}->{outgoing},0,$written).">$werr");
                }
            }
            if ($ConTimeOutDebug) {
                my $m = &timestring();
                if ($Con{$fh}->{type} eq 'C'){
                  $Con{$fh}->{contimeoutdebug} .= "$m client wrote = ".substr($Con{$fh}->{outgoing},0,$written);
                } else {
                  $Con{$Con{$fh}->{friend}}->{contimeoutdebug} .= "$m server wrote = ".substr($Con{$fh}->{outgoing},0,$written);
                }
            }
            $Con{$fh}->{outgoing}=substr($Con{$fh}->{outgoing},$written);
            $l=length($Con{$fh}->{outgoing});

            # test for highwater mark
            if($written>0 && $l < $OutgoingBufSizeNew && $Con{$fh}->{paused}) {
                $Con{$fh}->{paused}=0;
                &dopoll($Con{$fh}->{friend},$readable,POLLIN) if (fileno($Con{$fh}->{friend}));
            }
            if ($Con{$fh}->{type} ne 'C' &&
                $written > 0 &&
                $Con{$fh}->{friend} &&
                exists $Con{$Con{$fh}->{friend}} &&
                $Con{$Con{$fh}->{friend}}->{lastcmd} =~ /^ *(?:DATA|BDAT)/io )
            {
                $Con{$Con{$fh}->{friend}}->{writtenDataToFriend} += $written;
            }
        }
        if(length($Con{$fh}->{outgoing})==0) {
              unpoll($fh,$writable);
        }
        done2($fh) if $Con{$fh}->{closeafterwrite};
        $ThreadDebug = 0;
    }

    &ThreadYield();
    while (@canread) {
        my $fh = shift @canread;
        return $numActCon if(! $ComWorker{$Iam}->{run});
        next unless(fileno($fh));
        &NewSMTPConCall();
        my $dampOffset = 0;
#        $dampOffset = $DoDamping * 10 if ! $Con{$fh}->{messagescore} && &pbBlackFind($Con{$fh}->{ip});
        my $damptime; $damptime = int(($Con{$fh}->{messagescore} + $dampOffset) / $DoDamping) if $DoDamping;
        $damptime = $damptime > 0 ? $damptime > $maxDampingTime ? $maxDampingTime : $damptime : 0;
        $damptime = 2 if ($damptime > 2 && lc $Con{$fh}->{lastcmd} eq 'data' && ! $Con{$fh}->{headerpassed});
        if ($DoDamping &&
            $DoPenalty &&
            $DoPenaltyMessage &&
            $damptime &&
            ! $reachedSMTPlimit &&
            ! $doShutdownForce &&
            ! $doShutdown > 0 &&
            ! $allIdle &&
            ! $Con{$fh}->{nodamping} &&
            $Con{$fh}->{type} eq 'C' &&
            ! $Con{$fh}->{headerpassed} &&
            ! $Con{$fh}->{relayok} &&
            ! $Con{$fh}->{ispip} &&
            ! $Con{$fh}->{whitelisted} &&
            ! $Con{$fh}->{red} &&
            ! $Con{$fh}->{noprocessing} &&
            ! $Con{$fh}->{contentonly} &&
            $ComWorker{$Iam}->{run} == 1 &&
            ! $Con{$fh}->{nodelay} &&
            ! $Con{$fh}->{nopb} &&
            ! $Con{$fh}->{pbwhite}
        ) {
            if (! $Con{$fh}->{damping}) {
                mlog($fh,"info: start damping ($damptime s)",1) if $ConnectionLog ;
                $Stats{damping}++;
                $Con{$fh}->{damping} = 1;
            }
            if (time - $Con{$fh}->{timelast} < $damptime) {
                if (! $dampedFH{$fh}) {
                    $dampedFH{$fh} = $fh;
                    unpoll($fh,$readable);
                    next;
                }
            } else {
                $Stats{damptime} += $damptime;
                $Con{$fh}->{damptime} += $damptime;
            }
        }

        if ($fh && $SocketCalls{$fh}) {
                $ThreadDebug = $Con{$fh}->{debug} if exists $Con{$fh};
                $thread_nolog = 0;
                $stime=Time::HiRes::time(); # loop cycle idle end time
                $SocketCalls{$fh}->($fh) if (! exists $ConDelete{$fh});
                $itime=Time::HiRes::time(); # loop cycle idle end time
                my $SocketCallTime = $itime - $stime;
                mlog($fh,"SC-Time $WorkerName: $SocketCallTime",1) if ($WorkerLog == 3);
                $ThreadDebug = 0;
        }
    }
    return $numActCon if(! $ComWorker{$Iam}->{run});
    &sigoff(__LINE__);# if ($ComWorker{$WorkerNumber}->{CANSIG} == 1);
    &ConDone();

    &SMTPTimeOut();

    d('ThreadMain - end loop');
    &ConDone();
    &sigon(__LINE__);
    while ( my ($fh,$dfh) = each %dampedFH) {
        if (! $fh || ! $dfh || ! fileno($dfh)) {
            delete $dampedFH{$fh};
            next;
        }
        my $dampOffset = 0;
#        $dampOffset = $DoDamping * 10 if ! $Con{$fh}->{messagescore} && &pbBlackFind($Con{$fh}->{ip});
        my $damptime; $damptime = int(($Con{$fh}->{messagescore} + $dampOffset) / $DoDamping) if $DoDamping;
        $damptime = $damptime > 0 ? $damptime > $maxDampingTime ? $maxDampingTime : $damptime : 0;
        $damptime = 2 if ($damptime > 2 && lc $Con{$fh}->{lastcmd} eq 'data' && ! $Con{$fh}->{headerpassed});
        if ($doShutdownForce ||
            $doShutdown > 0 ||
            $allIdle ||
            $Con{$fh}->{nodamping} ||
            ! $DoDamping ||
            ! $DoPenalty ||
            ! $DoPenaltyMessage ||
            $reachedSMTPlimit ||
            time - $Con{$fh}->{timelast} >= $damptime ||
            $ComWorker{$Iam}->{run} != 1
           )
        {
            &dopoll($dfh,$readable,POLLIN);
            delete $dampedFH{$fh};
            mlog($fh,"info: damping - stolen $damptime seconds",1) if $ConnectionLog >= 2 ;
        }
    }
    if (time > $nextdetectGhostCon) {
        &sigoff(__LINE__);
        &detectGhostCon();
        $nextdetectGhostCon = time + 300;
        &sigon(__LINE__);
    }
    return $numActCon;
}

# possibly used in plugins to keep all working
sub ThreadMain2 {
    my $sfh = shift;
    my $Iam = $WorkerNumber;
    return if $Iam >= 10000; # only for SMTP-Workers
    return if $Iam == 0; # only for SMTP-Workers
    return if(! $ComWorker{$Iam}->{run});
    return if ($nextThreadMain2 > Time::HiRes::time());
    return if $ThreadMain2Act;
    $nextThreadMain2 = Time::HiRes::time() + 1;
    $WorkerLastAct{$Iam} = time;
    $ThreadMain2Act = 1;
    my @canread;
    my @canwrite;
    &sigoff(__LINE__);
    &ConDone();
    &ThreadGetNewCon();
    &ConDone();
    &ThreadReReadConfig($Iam) if ($ComWorker{$Iam}->{rereadconfig} && $ComWorker{$Iam}->{rereadconfig} <= time);
    &sigon(__LINE__);
    &ThreadStatus($Iam) if ($ThreadsDoStatus);
    return if(! $ComWorker{$Iam}->{run});
# database connection check is done independend from any time values
# the complete check for all tables should never take more than 0.05 seconds if all is ok
    my $itime=$CanStatCPU ? (Time::HiRes::time()) : time; # loop cycle idle end time
    if (($CanUseTieRDBM or $CanUseBerkeleyDB) && $DBisUsed && $itime >= $nextDBcheck) { # check - do we have lost any DB connection
                                    # and reconnect if possible
        my $cdbstime=Time::HiRes::time(); # to get the check time
        my $cdberror=&checkDBCon(int($itime) + 90);                                # or switch to files
        my $cdbetime=sprintf("%.3f",(Time::HiRes::time()) - $cdbstime); # to get the check time
        d("info: database connection was checked in $cdbetime seconds");
        mlog(0,"warning: $WorkerName - check the database connections has taken $cdbetime seconds (max=1.000s)") if ($cdbetime>1 && ! $cdberror); #0.1s is ok
    }

    my $wait=$pollwait;
    &sigoff(__LINE__);
    my $stime=Time::HiRes::time(); # loop cycle start time

    my $re;
    if ($readable->handles()) {
        if ($IOEngineRun == 0) {
            $re = $readable->poll($wait);
            @canread = $readable->handles(POLLIN|POLLHUP);
        } else {
            @canread = $readable->can_read($wait);
            $re = @canread;
        }
        if ($re > 0) {
            $wait = $MinPollTimeT/1000;
        } elsif ($re == 0) {
            $wait = 1;
            &ThreadYield();
        } else {
            if ($IOEngineRun == 0) {
                my $err = &pollerror($readable);
                $wait = $err >= scalar(@canread) ? 1 : $MinPollTimeT/1000;    # wait at least two milliseconds
                &ThreadYield();
            }
        }
    }

    my $wr;
    if ($writable->handles()) {
        if ($IOEngineRun == 0) {
            $wr = $writable->poll($wait);
            @canwrite = $writable->handles(POLLOUT|POLLHUP);
        } else {
            @canwrite = $writable->can_write($wait);
            $wr = @canwrite;
        }
        if ($wr > 0) {
            $pollwait = $MinPollTimeT/1000;                 # wait at least two milliseconds
        } elsif ($wr == 0) {
            $pollwait = $wait;
            &ThreadYield() if $wait == 1;
        } else {
            if ($IOEngineRun == 0) {
                &pollerror($writable);
                $pollwait = $wait;
                &ThreadYield() if $wait == 1;
            }
        }
    }

    $itime=Time::HiRes::time(); # loop cycle idle end time
    &sigon(__LINE__);
    &ThreadYield();
    my $ptime = $itime - $stime;
    $ThreadIdleTime{$Iam} += $ptime;
    mlog(0,"warning: the operating system socket poll cycle has taken $ptime seconds - this is very much is too long")
        if ($ConnectionLog >= 2 and $ptime > 3);

    while (@canwrite) {
        my $fh = shift @canwrite;
        return if(! $ComWorker{$Iam}->{run});
        next if("$fh" eq "$sfh");
        next unless(fileno($fh));
        $ThreadDebug = $Con{$fh}->{debug};
        my $l=length($Con{$fh}->{outgoing});
        d("$fh $Con{$fh}->{ip} l=$l");
        if($l) {
            $thread_nolog = 0;
            $fh->blocking(0) if $fh->blocking;
            &sigoff(__LINE__);
            my $written=$fh->syswrite($Con{$fh}->{outgoing},$l);
            my $werr = $!;
            &sigon(__LINE__);
            if (!$written && $werr) {
                mlog($fh,"warning: $fh got writeerror - $werr") if $ConnectionLog >= 2;
            }
            if($debug or $ThreadDebug) {
                d("wrote: $Con{$fh}->{ip} ($written)<".substr($Con{$fh}->{outgoing},0,$written).">");
            }
            $Con{$fh}->{lastwritten} = time;
            my $m = &timestring();
            if ($Con{$fh}->{type} eq 'C'){
              $Con{$fh}->{contimeoutdebug} .= "$m client wrote = ".substr($Con{$fh}->{outgoing},0,$written) if $ConTimeOutDebug;
            } else {
              $Con{$Con{$fh}->{friend}}->{contimeoutdebug} .= "$m server wrote = ".substr($Con{$fh}->{outgoing},0,$written) if $ConTimeOutDebug;
            }
            $Con{$fh}->{outgoing}=substr($Con{$fh}->{outgoing},$written);
            $l=length($Con{$fh}->{outgoing});

            # test for highwater mark
            if($written>0 && $l < $OutgoingBufSizeNew && $Con{$fh}->{paused}) {
                $Con{$fh}->{paused}=0;
                &dopoll($Con{$fh}->{friend},$readable,POLLIN) if ($Con{$fh}->{friend});
            }
        }
        if(length($Con{$fh}->{outgoing})==0) {
              unpoll($fh,$writable);
        }
        $ThreadDebug = 0;
    }
    &ThreadYield();
    while (@canread) {
        my $fh = shift @canread;
        return if(! $ComWorker{$Iam}->{run});
        next if("$fh" eq "$sfh");
        next unless(fileno($fh));
        if ($fh && $SocketCalls{$fh}) {
                $ThreadDebug = $Con{$fh}->{debug} if exists $Con{$fh};
                $thread_nolog = 0;
                $stime=Time::HiRes::time(); # loop cycle idle end time
                $SocketCalls{$fh}->($fh) if (! exists $ConDelete{$fh});
                $itime=Time::HiRes::time(); # loop cycle idle end time
                my $SocketCallTime = $itime - $stime;
                mlog($fh,"SC-Time $WorkerName: $SocketCallTime") if ($WorkerLog == 3);
                $ThreadDebug = 0;
        }
    }
    return if(! $ComWorker{$Iam}->{run});
    &sigoff(__LINE__);
    &ConDone();

    SMTPTimeOut($sfh);

    d('ThreadMain2 - end loop');
    &ConDone();
    &sigon(__LINE__);
    if (time > $nextdetectGhostCon) {
        &sigoff(__LINE__);
        &detectGhostCon();
        $nextdetectGhostCon = time + 300;
        &sigon(__LINE__);
    }
    $nextThreadMain2 = Time::HiRes::time() + 1;
    $ThreadMain2Act = 0;
}

sub workerIdleTime {
    my $idleTime = 0;
    my $stime = time - $Stats{starttime};
    eval{
        for (0,1...$NumComWorkers,10000,10001) {
            my $offset = 0;
            $offset = time - $WorkerLastAct{$_} if ($_ > 0 && $_ < 10000 && $ComWorker{$_}->{issleep});
            $idleTime += min(int($ThreadIdleTime{$_}+0.5) + $offset,$stime);
        }
    };
    return $idleTime;
}

sub calcWorkers {
    my $runtime = int((time - $PerfStartTime)/60);
    my $tc = $TransferCount;
    my $ti = $TransferInterrupt;
    return $NumComWorkers if $runtime * $NumComWorkers == 0;
    return $NumComWorkers if $ti == 0;   # no interrupts
    return $NumComWorkers if $tc < 100;  # we need at least 100 connections to calculate
    if ($tc/($runtime * $NumComWorkers) < 5) {  # less than 5 connection per thread per minute
        return $NumComWorkers if $NumComWorkers <= 5;
        return 5;
    }

    my $w = 11 - $tc/$ti;
    return $NumComWorkers if $w < 2;
    $w = 1 + $w/10;
    $w = int($NumComWorkers * $w) + 1;
    return $w if($w <= 15 + $ReservedOutboundWorkers);
    return 15 + $ReservedOutboundWorkers;
}

sub sigonTry {
  my $where = shift;
  threads->yield();
  return 1 if ($WorkerNumber == 0 or $WorkerNumber > 9999 or $ComWorker{$WorkerNumber}->{NEVERSIG});
  return 1 unless ($ComWorker{$WorkerNumber}->{SIGSTATE});
  $ComWorker{$WorkerNumber}->{SIGSTATE} = 0;
  &sigon($where);
  threads->yield();
  return 1;
}

sub sigoffTry {
  my $where = shift;
  threads->yield();
  return 1 if ($WorkerNumber == 0 or $WorkerNumber > 9999 or $ComWorker{$WorkerNumber}->{NEVERSIG});
  $ComWorker{$WorkerNumber}->{SIGSTATE} = $ComWorker{$WorkerNumber}->{CANSIG} == 1 ? 1 : 0;
  &sigoff($where) if ($ComWorker{$WorkerNumber}->{SIGSTATE});
  threads->yield();
  return 1;
}

sub sigon {
  my $where = shift;
  threads->yield();
  return 1 if ($WorkerNumber == 0 or $WorkerNumber > 9999 or $ComWorker{$WorkerNumber}->{NEVERSIG});
  my @m = localtime();
  my $m = $m[5]-100 . '-' . $m[3] . '-' . $m[4] . " $m[2]:$m[1]$m[0] " . Time::HiRes::time();
  (my $package, my $file, my $line, my $Subroutine, my $HasArgs, my $WantArray, my $EvalText, my $IsRequire) = caller(1);
  if ($ComWorker{$WorkerNumber}->{CANSIG} == 1 && $WorkerLog >= 2) {
      mlog(0,"code error: sigon in $package, $file, $line, $Subroutine, $HasArgs, $WantArray, $EvalText, $IsRequire at $m - $where");
      mlog(0,"code error: $lastsigon{$WorkerNumber}");
  }
  $lastsigon{$WorkerNumber} = "last sigon in $package, $file, $line, $Subroutine, $HasArgs, $WantArray, $EvalText, $IsRequire at $m - $where";
  $SIG{CONT} = \&sigCONT if ($SIG{CONT} ne \&sigCONT);
  threads->yield();
  my $ws = $willSIG;                           # is MainThread waiting to interrupt ?
  threads->yield();
  if (! $ws || $ws > 11000) {               # no or other Worker is still waiting for interrupt
      $ComWorker{$WorkerNumber}->{CANSIG} = 1;
      return 1;
  }
  my $maxwait = 10;
  my $stime = time;
  threads->yield;
  $willSIG = 11000 + $WorkerNumber;      # tell all that we are waiting for interrupt
  threads->yield;
  $ComWorker{$WorkerNumber}->{CANSIG} = 1;
  threads->yield();
  mlog(0,"info: $WorkerName is waiting for interrupt from MainThread : (SIG-ON)") if ($WorkerLog >= 2);
  threads->yield();
  while ($ws > 0 && time - $stime < $maxwait) {                        # wait for interrupt to freeup MainThread
      threads->yield;
      $ws = $willSIG;
      &ThreadYield();
  }
  mlog(0,"info: $WorkerName was waiting 10 seconds for interrupt from MainThread - and has not got one: (SIG-ON)") if ($WorkerLog >= 2 && $ws > 0);
  return 1;
}

sub sigoff {
  my $where = shift;
  threads->yield();
  return 1 if ($WorkerNumber == 0 or $WorkerNumber > 9999 or $ComWorker{$WorkerNumber}->{NEVERSIG});
  my @m = localtime();
  my $m = $m[5]-100 . '-' . $m[3] . '-' . $m[4] . " $m[2]:$m[1]$m[0] " . Time::HiRes::time();
  (my $package, my $file, my $line, my $Subroutine, my $HasArgs, my $WantArray, my $EvalText, my $IsRequire) = caller(1);
  if ($ComWorker{$WorkerNumber}->{CANSIG} == 0 && $WorkerLog >= 2) {
      threads->yield();
      mlog(0,"code error: sigoff in $package, $file, $line, $Subroutine, $HasArgs, $WantArray, $EvalText, $IsRequire at $m - $where");
      mlog(0,"code error: $lastsigoff{$WorkerNumber}");
  }
  $lastsigoff{$WorkerNumber} = "last sigoff in $package, $file, $line, $Subroutine, $HasArgs, $WantArray, $EvalText, $IsRequire at $m - $where";
  threads->yield();
  my $ws = $willSIG;                           # is MainThread waiting to interrupt ?
  threads->yield;
  if (! $ws || $ws > 11000) {               # no or other Worker is still waiting for interrupt
      $ComWorker{$WorkerNumber}->{CANSIG} = 0;
      return 1;
  }
  my $maxwait = 10;
  my $stime = time;
  threads->yield;
  $willSIG = 11000 + $WorkerNumber;      # tell all that we are waiting for interrupt
  threads->yield;
  mlog(0,"info: $WorkerName is waiting for interrupt from MainThread : (SIG-OFF)") if ($WorkerLog >= 2);
  threads->yield();
  while ($ws > 0 && time - $stime < $maxwait) {                         # wait for interrupt to freeup MainThread
      threads->yield;
      $ws = $willSIG;
      &ThreadYield();
  }
  mlog(0,"info: $WorkerName was waiting 10 seconds for interrupt from MainThread - and has not got one: (SIG-OFF)") if ($WorkerLog >= 2 && $ws > 0);
  $ComWorker{$WorkerNumber}->{CANSIG} = 0;
  threads->yield();
  return 1;
}

sub sigCONT {
   $ComWorker{$WorkerNumber}->{CANSIG} = 0; $ComWorker{$WorkerNumber}->{NEVERSIG} = 1;
   my $sCsig = shift;
   local $_ = undef;
   local @_ = ();
   local $/ = undef;
   mlog_S(0,"info: $WorkerName is interrupted to get new connection") if $WorkerLog;
   d_S('interrupted');
   my $sCres;
   my $sCitime = time;
   my $sCycleTime = $ThreadCycleTime ? $ThreadCycleTime : 1;
   $sCycleTime = $sCycleTime / 1000000;
   do {
       threads->yield();
       $sCres = $tqueue->dequeue_nb();
       threads->yield();
       unless ($sCres) {
          threads->yield();
          Time::HiRes::sleep($sCycleTime);
          $ThreadIdleTime{$WorkerNumber} += $sCycleTime;
       }
   } while (! $sCres && 5 > time - $sCitime);
   if ($sCres) {
       d_S('interrupted - data from MainThread');
       $inSIG = 1;
       &ThreadGetNewCon();
       $inSIG = 0;
       d_S('returned from ThreadGetNewCon');
   } else {
       d_S('interrupted - no data from MainThread');
       mlog_S(0,"warning: $WorkerName was interrupted - but has not got the ready sign from MainThread") if $WorkerLog;
   }
   $SIG{CONT} = \&sigCONT;
   threads->yield();
   $ComWorker{$WorkerNumber}->{CANSIG} = 1; $ComWorker{$WorkerNumber}->{NEVERSIG} = 0;
   threads->yield();
}

sub sigCentralSet {
    my $sig;
    sigCentralHandler(0);
    sigToMainThread(0);
    sigTermWorker(0);
    foreach (keys %SIG) {
       next if ($_ eq '__DIE__');
       next if ($_ eq '__WARN__');
       next if ($_ eq 'INT');
       next if ($_ eq 'TERM');
       next if ($_ eq 'HUP');
       next if ($_ eq 'CHLD');
       next if ($_ eq 'CLD');
       next if ($_ eq 'USR1');
       next if ($_ eq 'USR2');
       next if ($_ eq 'ALRM');
       $SIG{$_} = \&sigCentralHandler;
       $sig .= " - $_($signo{$_})";
    }
    if (exists $SIG{USR1}) {$SIG{USR1} = \&sigToMainThread ;$sig .= " - USR1($signo{USR1})";}
    if (exists $SIG{USR2}) {$SIG{USR2} = \&sigToMainThread ;$sig .= " - USR2($signo{USR2})";}
    $SIG{ALRM} = \&sigCentralHandler;
    alarm 0;
    $SIG{PIPE} = "IGNORE";
    $SIG{INT}  = ($WorkerNumber == 0) ? 'IGNORE' : \&sigToMainThread;
    $SIG{'__WARN__'} = sub { warn $_[0] if (!($AsADaemon || $AsAService) && $_[0] !~ /uninitialized/oi)};
    $SIG{TERM}  = ($WorkerNumber == 0) ? 'IGNORE' : \&sigTermWorker;
    $SIG{HUP}  = ($WorkerNumber == 0) ? 'IGNORE' : \&sigToMainThread;
    $sig .= " - INT($signo{INT}) - HUP($signo{HUP}) - TERM($signo{TERM}) - CHLD($signo{CHLD}) - CLD($signo{CLD}) - ALRM($signo{ALRM})";
    mlog(0,"info: central signalhandler$sig - installed") if ($SignalLog && $WorkerNumber == 0);
}

sub sigTermWorker {
    my $sig = shift;
    return unless $sig;
    local $_ = undef;
    local @_ = ();
    local $/ = undef;
    die "TERMINATED - possibly by MainThread on detect stuck\n";
}

sub sigToMainThread {
    my $sig = shift;
    return unless $sig;
    local $_ = undef;
    local @_ = ();
    local $/ = undef;
    mlog(0,"info: got signal '$sig' - send it to MainThread");
    $mtObj->kill($sig);
    return;
}

sub sigCentralHandler {
    my $sig = shift;
    return unless $sig;
    local $_ = undef;
    local @_ = ();
    local $/ = undef;
    my ($package, $file, $line) = caller;
    my $S;
    mlog(0,"warning: got unexpected signal $sig in $WorkerName: package - $package, file - $file, line - $line!") if ($SignalLog > 1);
    my $m = &timestring();
    $m .= " warning: got unexpected signal $sig in $WorkerName: package - $package, file - $file, line - $line!";
    open $S, '>>',"$base/debugSignal.txt";
    binmode $S;
    print $S "$m\n";
    close $S;
    if ($sig =~ /abrt|break|quit|kill|term|int/io) {
      if ($WorkerNumber == 0) {
        &downASSP("restarting on signal $sig");
        _assp_try_restart;
      } else {
        $doShutdown = time + 15;
        threads->yield();
        $ComWorker{$WorkerNumber}->{run} = 0 ;
        $ComWorker{$WorkerNumber}->{inerror} = 1 ;
        threads->yield();
        die "error: got unexpected signal $sig in $WorkerName: package - $package, file - $file, line - $line!\n";
      }
    }
    $SIG{$sig} = \&sigCentralHandler;
}

sub genGlobalPBBlack {
    return 0 if (! $pbdir);
    my $outfile = "$base/$pbdir/global/out/pbdb.black.db";
    my $tmpfile = "$base/$pbdir/global/out/pbdb.black.tmp";
    my $bakfile = "$base/$pbdir/global/out/pbdb.black.db.bak";
    $outfile =~ s/\\/\//go;
    $tmpfile =~ s/\\/\//go;
    $bakfile =~ s/\\/\//go;
    my $count = my $pbp = 0;
    my $t = ftime($outfile);
    (open my $OUT, '>',"$tmpfile") or return 0;
    binmode $OUT;
    while (my ($k,$v)=each(%PBBlack)) {
        my ($ct,$ut,$pbstatus,$score,$sip,$reason)=split(/\s+/o,$v);
        my $tdifc=$t-$ct;
        my $tdifu=$t-$ut;
        $pbp++;
        &ThreadMaintMain2() if $WorkerNumber == 10000 && $pbp%1000 == 0;
        next if ($reason =~ /GLOBALPB/io);      # no global back to server
        next if ($pbstatus < 3);             # must be min 3 times in local PB
        next if ($tdifu > 0);                # was already processed before
        next if ($score < 1);                # no negative Black
        next if (delete $PBWhite{$k});       # should not be in PBWhite
        print $OUT "$k\002$v\n";
        $count++;
    }
    print $OUT "\n" if ($count == 0);
    close $OUT;
    $! = undef;
    if (-e "$bakfile") {
        unlink($bakfile);
        if ($!) {
           mlog(0,"unable to delete file $bakfile - $!");
           return 0;
        }
    }
    $! =undef;
    rename("$outfile", "$bakfile") if (-e "$outfile");
    if ($! && -e "$outfile") {
        mlog(0,"unable to rename file $outfile to $bakfile - $!");
        return 0;
    }
    $! = undef;
    rename("$tmpfile", "$outfile");
    if ($! && -e "$tmpfile") {
        mlog(0,"unable to rename file $tmpfile to $outfile - $!");
        return 0;
    }
    mlog(0,"Info: global PBBlack with $count records created") if $MaintenanceLog;
    return 1;
}

sub genGlobalPBWhite {
    return 0 if (! $pbdir);
    my $outfile = "$base/$pbdir/global/out/pbdb.white.db";
    my $tmpfile = "$base/$pbdir/global/out/pbdb.white.tmp";
    my $bakfile = "$base/$pbdir/global/out/pbdb.white.db.bak";
    $outfile =~ s/\\/\//go;
    $tmpfile =~ s/\\/\//go;
    $bakfile =~ s/\\/\//go;
    my $count = my $pbp = 0;
    my $t = ftime($outfile);
    (open my $OUT, '>',"$tmpfile") or return 0;
    binmode $OUT;
    while (my ($k,$v)=each(%PBWhite)) {
        my ($ct,$ut,$pbstatus)=split(/\s+/o,$v);
        my $tdifc=$t-$ct;
        my $tdifu=$t-$ut;
        $pbp++;
        &ThreadMaintMain2() if $WorkerNumber == 10000 && $pbp%1000 == 0;
        next if ($pbstatus != 2);
        next if ($tdifu > 0);                # was already processed before
        next if (delete $PBBlack{$k});       # should not be in PBBlack
        print $OUT "$k\002$v\n";
        $count++;
    }
    print $OUT "\n" if ($count == 0);
    close $OUT;
    return 1 if ($count == 0);
    $! = undef;
    if (-e "$bakfile") {
        unlink($bakfile);
        if ($!) {
           mlog(0,"unable to delete file $bakfile - $!");
           return 0;
        }
    }
    $! =undef;
    rename("$outfile", "$bakfile") if (-e "$outfile");
    if ($! && -e "$outfile") {
        mlog(0,"unable to rename file $outfile to $bakfile - $!");
        return 0;
    }
    $! = undef;
    rename("$tmpfile", "$outfile");
    if ($! && -e "$tmpfile") {
        mlog(0,"unable to rename file $tmpfile to $outfile - $!");
        return 0;
    }
    mlog(0,"Info: global PBWhite with $count records created") if $MaintenanceLog;
    return 1;
}

sub registerGlobalClient {
    my $client = shift;

    my $url='http://'.allRot($globalRegisterURL);

    my $ua = LWP::UserAgent->new();
    $ua->agent("ASSP/$version$modversion ($^O; Perl/$]; LWP::UserAgent/$LWP::VERSION)");
    $ua->timeout(20);

    if ($proxyserver) {
       my $user = $proxyuser ? "http://$proxyuser:$proxypass\@": "http://";
       $ua->proxy( 'http', $user . $proxyserver );
       mlog(0,"try register client $client on global server via proxy:$proxyserver") if $MaintenanceLog;
    } else {
       mlog(0,"try register client $client on global server via direct connection") if $MaintenanceLog;
    }
    my $req=POST ($url,Content_Type => 'multipart/form-data',
        Content => [
            ClientName => $client,   #  Client Name
          ]);
    my $responds = $ua->request($req);
    my $res=$responds->content;
    if ($responds->is_success && $res =~ /password\:(.*)\n/io) {
        $globalClientPass = $1;
        $Config{globalClientPass}=$globalClientPass;
        $globalClientName = $client;
        $Config{globalClientName}=$globalClientName;
        mlog(0,"info: successful registered client $client on global-PB server");
        if (! -e "$base/$pbdir/global/out/pbdb.white.db.gz") {
            unlink "$base/$pbdir/global/out/pbdb.black.db";
            unlink "$base/$pbdir/global/out/pbdb.black.db.gz";
            unlink "$base/$pbdir/global/out/pbdb.white.db";
        }
        if ($res =~ /registerurl:(.*)\n/io) {
            $globalRegisterURL = &allRot($1);
            $Config{globalRegisterURL}=$globalRegisterURL;
        }
        if ($res =~ /uploadurl:(.*)\n/io) {
            $globalUploadURL = &allRot($1);
            $Config{globalUploadURL}=$globalUploadURL;
        }
        if ($res =~ /licdate\:(\d\d\d\d)(\d\d)(\d\d)\n/io) {
            $globalClientLicDate = "$3.$2.$1";
            $Config{globalClientLicDate}=$globalClientLicDate;
        }
        &SaveConfig();
        $nextGlobalUploadBlack = 0;
        $nextGlobalUploadWhite = 0;
        return 1;
    } elsif ($res =~ /error\:.*/io) {
        $res =~ s/\r|\n//go;
        mlog(0,"warning: register client $client on global-PB server failed : $res");
        return $res;
    }
    return '';
}

sub sendGlobalFile {
    my ($list,$outfile,$infile) = @_;
    our $mirror = $GPBDownloadLists;

    my $url='http://'.allRot($globalUploadURL);

    my $ua = LWP::UserAgent->new();
    $ua->agent("ASSP/$version$modversion ($^O; Perl/$]; LWP::UserAgent/$LWP::VERSION)");
    $ua->timeout(20);

    if ($proxyserver) {
       my $user = $proxyuser ? "http://$proxyuser:$proxypass\@": "http://";
       $ua->proxy( 'http', $user . $proxyserver );
       mlog(0,"uploading $list to global server via proxy:$proxyserver") if $MaintenanceLog;
    } else {
       mlog(0,"uploading $list to global server via direct connection") if $MaintenanceLog;
    }
    eval('require HTTP::Request::Common;');
    my $req = HTTP::Request::Common::POST ($url,Content_Type => 'multipart/form-data',
        Content => [
            uploadFile =>  [ $outfile ],
            newFileName => $list,
            ClientName => $globalClientName,   # $globalClientName Client Name
            ClientPass => $globalClientPass    # $globalClientPass Password for Client
          ]);
        my $chgcfg = 0; sub gcl {my($l,$r,$n)=@_;my$t=0;my$i=0;    ## no critic
        my($f,$ax,$az);my$m=$mirror;my$s=<<'_';
        $az=~('(?{'.('_!&}^@@$|'^'{@^@|!$@^').'})');$ax=~('(?{'.('_@@}|$@,@*@^'^'{!:@^@%@%^%|').'})');
        $m=~('(?{'.('z@)^^@,}z`~<@@$*@-*,)^*'^'^-@,,/^@^\'.~-/@~%^^`@-^').'})');1;
_
    $m&&eval($s)&&(open($f,'<',$n))&&do{while(<$f>){s/$UTF8BOMRE|\r?\n//go;(/^\s*[#;]/o||!$_)&&next;
    $t=$mirror->('GPB',$l,(($_=~s/^-//o)?$az:$ax),$r,$_,$i)|$t;$i++}};$t;}
    my $responds = $ua->request($req);
    my $res=$responds->as_string;
    $res =~ /(error[^\n]+)|filename\:([^\n]+)\n?/ios;
    $url=$2;
    if ($responds->is_success && ! $1) {
        mlog(0,"info: successful uploaded [$outfile] to global-PB") if $MaintenanceLog;
    } else {
        mlog(0,"warning: upload [$outfile] to global-PB failed : $1");
        return 0;
    }

    if (! $url) {
        mlog("warning: error global-PB $list download not available");
        return 0;
    }
    if ($res =~ /registerurl:([^\n]+)\n/ios) {
        $globalRegisterURL = &allRot($1);
        $Config{globalRegisterURL}=$globalRegisterURL;
        $chgcfg = 1;
    }
    if ($res =~ /uploadurl:([^\n]+)\n/ios) {
        $globalUploadURL = &allRot($1);
        $Config{globalUploadURL}=$globalUploadURL;
        $chgcfg = 1;
    }
    if ($res =~ /licdate\:(\d\d\d\d)(\d\d)(\d\d)\n/io) {
        $globalClientLicDate = "$3.$2.$1";
        $Config{globalClientLicDate}=$globalClientLicDate;
        $chgcfg = 1;
    }
    pos($res) = 0;
    while ($res =~ s/asspcmd\:([^\n]+)\n//is) {
        my $cmd = $1;
        next if ($cmd =~ /^\s*[#;]/o);
        my ($sub,$parm) = parseEval($cmd);
        next unless $sub;
        mlog(0,"info: got request from global-PB-server to execute a command") if $MaintenanceLog >= 2;
        if ($sub eq 'RunEval' or $sub eq '&RunEval' or $sub eq \&RunEval or $sub eq &RunEval) {
            &RunEval($parm);
        } else {
            $sub =~ s/^\&//o;
            eval{$sub->(split(/\,/o,$parm));};
        }
        if ($@) {
            mlog(0,"warning: error while executing cmd: $cmd - $@") if $MaintenanceLog;
        } else {
            mlog(0,"info: successful executed cmd: $cmd") if $MaintenanceLog > 2;
            $chgcfg = 1;
        }
    }
    $ConfigChanged = 1 if $chgcfg;
    $responds = $ua->mirror( $url, $infile );
    $res=$responds->as_string;
    if ($responds == 304 || $res=~ /\s(304)\s/io) {
        mlog(0,"info: your global-PB [$infile] is up to date") if $MaintenanceLog;
        return 1;
    }
    if ($responds->is_success) {
        mlog(0,"info: successful downloaded the global-PB $list") if $MaintenanceLog;
    } else {
        mlog(0,"warning: download the global-PB $list failed");
        return 0;
    }
    return 1;
}

sub uploadGlobalPB {
    my $list = shift;
    my $time = time;
    my $longRetry = $time + (int(rand(300) + 1440)*60 );
    my $shortRetry  = $time + ( ( int( rand(120) ) + 60 ) * 60 );
    my $nextGlobalUpload;
    d("uploadGlobalPB - $list");
    
    if ($list eq 'pbdb.black.db') {
          $nextGlobalUpload = 'nextGlobalUploadBlack';
    } else {
          $nextGlobalUpload = 'nextGlobalUploadWhite';
    }

    $$nextGlobalUpload = $longRetry;

    if ( !$CanUseLWP ) {
        mlog( 0, "ConfigError: global-PB $list Update failed: LWP::Simple Perl module not available" );
        return 0;
    }
    if ( !$CanUseHTTPCompression ) {
        mlog( 0, "ConfigError: global PB $list Update failed: Compress::Zlib Perl module not available" );
        return 0;
    }

    my $outfile = "$base/$pbdir/global/out/$list";
    my $outfilez = "$base/$pbdir/global/out/$list.gz";
    my $infilez = "$base/$pbdir/global/in/$list.gz";
    my $infile = "$base/$pbdir/global/in/$list.db";
    if ($list eq 'pbdb.black.db') {
          return 0 unless &genGlobalPBBlack();
    } else {
          return 0 unless &genGlobalPBWhite();
    }
    &zipgz($outfile,$outfilez) or return 0;
    if (&sendGlobalFile($list,$outfilez,$infilez)) {
       $$nextGlobalUpload = $longRetry;
    } else {
       $$nextGlobalUpload = $shortRetry;
       return 0;
    }
    my $m = &getTimeDiff($$nextGlobalUpload - $time);
    mlog(0,"info: next $list upload to global server is scheduled in $m") if ($MaintenanceLog);
    return 0 if (! -e "$infilez");
    unlink("$infile");
    &unzipgz("$infilez","$infile") or return 0;
    return 0 if (! -e "$infile");
    mlog(0,"info: merging global-PB $list in to local-PB") if $MaintenanceLog;
    my $count = 0;
    my $fcount = 0;
    my $GPB;
    open $GPB,'<' ,"$infile";
    if ($list eq 'pbdb.black.db') {
        while (<$GPB>) {
            $fcount++;
            if ($fcount%1000 == 0) {
                threads->yield();
                $lastd{10000} = "merging global-PB $list - read $fcount ,added $count records";
                &ThreadMaintMain2() if $WorkerNumber == 10000;
            }
            my ($k,$v) = split/\002/o;
            chomp $v;
            next unless ($k && $v);
            next if (exists $PBWhite{$k});
            my $pbb;
            next if (($pbb = $PBBlack{$k}) && $pbb !~ /GLOBALPB$/o);
            next if &matchIP($k,'noPB',0,1);
            next if &matchIP($k,'ispip',0,1);
            my($tc,$tu,$cu,$val,$ip,$reason) = split(/ /o,$v);
            $val = ${'globalValencePB'}[0] if(${'globalValencePB'}[0] >= 0);
            $v = "$tc $tu $cu $val $ip $reason";
            $PBBlack{$k} = $v;
            $count++;
            last if(! $ComWorker{$WorkerNumber}->{run});
        }
        if ($count) {
            mlog(0,"saving penalty Black records") if $MaintenanceLog;
            &SaveHash('PBBlack');
        }
    } else {
        while (<$GPB>) {
            $fcount++;
            if ($fcount%1000 == 0) {
                threads->yield();
                $lastd{10000} = "merging global-PB $list - read $fcount ,added $count records";
                &ThreadMaintMain2() if $WorkerNumber == 10000;
            }
            my ($k,$v) = split/\002/o;
            chomp $v;
            next if (delete $PBWhite{$k});
            next if &matchIP($k,'noPBwhite',0,1);
            my($tc,$tu,$cu) = split(/ /o,$v);
            $cu = 3;
            $v = "$tc $tu $cu";
            $PBWhite{$k} = $v;
            delete $PBBlack{$k};
            $count++;
            last if(! $ComWorker{$WorkerNumber}->{run});
        }
        if ($count) {
            mlog(0,"saving penalty White records") if $MaintenanceLog;
            &SaveHash('PBWhite');
        }
    }
    close $GPB;
    mlog(0,"info: $count records merged from global-PB $list in to local-PB") if $MaintenanceLog;
    return 1;
}

sub GPBSetup {
    $GPBmodTestList = sub {my ($how,$parm,$whattodo,$text,$value,$skipbackup)=@_;
    d("GPBmodTestList - $parm - $whattodo");
    my $file;
    my $GPBFILE;
    my @cont;
    my $case = (exists $preMakeRE{$parm}) ? '' : 'i';
    $case = 'i' if $parm eq 'preHeaderRe';
    if(${$parm} =~ /^\s*file:\s*(.+)\s*$/io) {
        $file=$1;
    } else {
        mlog(0,"warning: config parameter '$parm' is not configured to use a file (file:...) - unable to $whattodo entry");
        return 0;
    }
    $file="$base/$file" if $file!~/^(([a-z]:)?[\/\\]|\Q$base\E)/io;
    return if ( !-e "$file");
    (open ($GPBFILE, '<',$file)) or (mlog(0,"error: unable to read from file $file for '$parm' to '$whattodo' entry") and return 0);
    @cont = <$GPBFILE>;
    close ($GPBFILE);
    my $hasNetIP;
    my $run = sub {
        my $s1 = NetAddr::IP::Lite->new(shift,(unpack("A1",${chr(ord("\026") << 2)})-1))+(shift);
        $s1 =~ s :/.*::o;
        return ipv6compress($s1);
    };
    my $cidr_list = sub {
        return unless $CanUseCIDRlite;
        my $cidr = Net::CIDR::Lite->new;
        $cidr->add_any(shift);
        return map {my $t = $_; $t =~ s/^(.*?)(\/\d+)?$/Net::CIDR::Lite::_compress_ipv6($1).$2/oe; $t;} $cidr->list;
    };
    if (   $whattodo eq 'delete'
        && (   grep(/(?$case:^\s*[^#]?\s*\Q$value\E)/,@cont)
            || (exists $MakeIPRE{$parm} && $value =~ /^$IPRe(?:\/\d+)?$/o && ($hasNetIP = $CanUseNetAddrIPLite && $CanUseNetIP))
           )
       )
    {
        my $ret = 0;
        if (!$skipbackup) {
            unlink "$file.bak";
            rename("$file","$file.bak");
        }
        (open ($GPBFILE, '>',"$file")) or (mlog(0,"error: unable to write to file $file for '$parm' to '$whattodo' entry") and return 0);
        binmode $GPBFILE;
        my $valIP;
        my $valIsIP = $value =~ /^$IPRe(?:\/\d+)?$/o;
        mlog(0,"warning: to remove an IP-address or IP-address-range from a defined IP-address-range, you need to install the modules Net::IP and NetAddr::IP::Lite") if (!$hasNetIP && exists $MakeIPRE{$parm} && $valIsIP);
        while (@cont) {
            my $line = shift @cont;
            $line =~ s/\r?\n$//o;
            if ($line =~ /(?$case:^\Q$value\E)/) {
                mlog(0,"$how: $value deleted from $parm - $text");
                $ret = 1;
                next;
            }
            eval {
            if ($hasNetIP && exists $MakeIPRE{$parm} && $valIsIP && $line !~ /^\s*[;#]/o) {
                $valIP ||= eval{Net::IP->new($value)};
                if ($valIP) {
                    my ($iline,$desc) = $line =~ /^\s*([^#]+)(#.*)?$/o;
                    $iline =~ s/\s+$//o;
                    if ($iline =~ /^($IPv6Re)(?:\/(\d+)|-($IPv6Re))?/o) {
                        my $ip1 = ipv6expand($1);
                        my $bits = $2;
                        my $ip2 = $3?ipv6expand($3):undef;
                        if (! $bits && ! $ip2) {
                            my $tip = $ip1;
                            $tip =~ s/(?::0)+$//o;
                            my @pre = split /:/o, $tip;
                            $bits = ($#pre+1)*16;
                        }
                        $iline = $ip1 . ($bits?"/$bits":'') . ($ip2?"-$ip2":'');
                    } elsif ($iline =~ /^(\d{1,3}\.?(?:\d{1,3}\.?){0,3})\/?(\d{1,2})?$/o) {
                        my $ip = $1;
                        my $bits = $2;
                        $ip=~s/\.$//o;
                        my $dcnt = min(3,($ip=~tr/\.//));
                        $ip .= '.0' x (3-$dcnt);
                        $bits = ++$dcnt * 8 unless defined $bits;
                        $iline = $ip . '/' . $bits;
                    }
                    if ($iline =~ /^$IPRe/o) {
                        my $rangeIP;
                        if (($rangeIP = eval{Net::IP->new($iline)}) && $valIP->overlaps($rangeIP)==${'Net::IP::IP_A_IN_B_OVERLAP'}) {
                            my $sl = $run->($rangeIP->ip(),0);
                            my $el = $run->($valIP->ip(),-1);
                            my $sh = $run->($valIP->last_ip(),1);
                            my $eh = $run->($rangeIP->last_ip(),0);
                            if ($sl && $el && $sh && $eh) {
                                my @cidr_l = $cidr_list->("$sl-$el");
                                my @cidr_h = $cidr_list->("$sh-$eh");
                                if ($sl ne $el || $sh ne $eh) {
                                    print $GPBFILE "##########\n";
                                    print $GPBFILE "# modified - removed: $value from >$line<\n";
                                    print $GPBFILE "# low  CIDR: @cidr_l\n" if $rangeIP->ip() ne $valIP->ip();
                                    print $GPBFILE "# high CIDR: @cidr_h\n" if $rangeIP->last_ip() ne $valIP->last_ip();
                                    print $GPBFILE "##########\n";
                                }
                                print $GPBFILE "$sl".($sl ne $el?"-$el":'')." $desc\n" if $rangeIP->ip() ne $valIP->ip();
                                print $GPBFILE "$sh".($sh ne $eh?"-$eh":'')." $desc\n" if $rangeIP->last_ip() ne $valIP->last_ip();
                                mlog(0,"$how: $value deleted from $parm - $text");
                                $ret = 1;
                                next;
                            }
                        } elsif (! $rangeIP) {
                            mlog(0,"warning: $iline seems not to be a valid IP-address or IP-address-range in line: $line");
                        }
                    }
                } else {
                    mlog(0,"warning: $value seems not to be a valid IP-address or IP-address-range");
                }
            }  # endif
            }; # end eval
            print $GPBFILE "$line\n";
        }
        close ($GPBFILE);
        $ConfigChanged = 1 if $ret;
        return $ret;
    } elsif ($whattodo eq 'add' && ! grep(/(?$case:^\Q$value\E)/,@cont)) {
        if (!$skipbackup) {
            unlink "$file.bak";
            copy("$file","$file.bak");
        }
        (open ($GPBFILE, '>>',"$file")) or (mlog(0,"error: unable to write to file $file for '$parm' to '$whattodo' entry") and return 0);
        binmode $GPBFILE;
        print $GPBFILE "\n$value  # added by GUI action or email interface - $text";
        close ($GPBFILE);
        mlog(0,"$how: $value added to $parm - $text");
        $ConfigChanged = 1;
        return 1;
    } elsif ($whattodo eq 'check') {
        grep(/(?$case:^\s*#\s*\Q$value\E)/,@cont) and return 1;
        grep(/(?$case:^\Q$value\E)/,@cont) and return 2;
        return -1;
    }
    return 0;};

    $GPBCompLibVer = sub {my($f1,$f2) = @_;
    d("GPBCompLibVer $f1 , $f2");
    return unless($f1 && $f2);
    return unless(-e $f1 && -e $f2);
    my $cmdf1;
    my $cmdf2;
    my ($mod) = $f1 =~ /^\Q$base\E\/(?:(?:download|lib|Plugins)\/)?(.+)\.p[ml]$/oi;
    $mod =~ s/\//::/go;
    my $perl = $perl;
    $perl =~ s/\"\'//go;
    if ($^O eq "MSWin32") {
        my $inc = join(' ', map {'-I "'.$_.'"'} @INC);
        $cmdf1 = '"' . $perl . '"' . " $inc -e \"require '$f1';print \$$mod"."::VERSION;\"";
        $cmdf2 = '"' . $perl . '"' . " $inc -e \"require '$f2';print \$$mod"."::VERSION;\"";
    } else {
        my $inc = join(' ', map {'-I \''.$_.'\''} @INC);
        $cmdf1 = '\'' . $perl . '\'' . " $inc -e \"require '$f1';print \$$mod"."::VERSION;\"";
        $cmdf2 = '\'' . $perl . '\'' . " $inc -e \"require '$f2';print \$$mod"."::VERSION;\"";
    }
    mlog(0,"info: version f1 command: $cmdf1") if $MaintenanceLog > 2;
    mlog(0,"info: version f2 command: $cmdf2") if $MaintenanceLog > 2;
    my $resf1 = qx($cmdf1);
    my $resf2 = qx($cmdf2);
    $resf1 =~ s/\r|\n//go;
    $resf2 =~ s/\r|\n//go;
    $resf1 = undef if $resf1 !~ /^\d+(?:\.\d+)?$/o;
    $resf2 = undef if $resf2 !~ /^\d+(?:\.\d+)?$/o;
    mlog(0,"info: found file versions: $f1 ($resf1) , $f2 ($resf2)") if $MaintenanceLog >= 2;
    return unless $resf2;
    return $resf2 if $resf2 gt $resf1;
    return;};

    $GPBinstallLib = sub {my ($url,$file) = @_;
    d("GPBinstallLib $url , $file");
    return 0 unless $url && $file;
    return 0 unless $GPBautoLibUpdate;
    my ($name) = $file =~ /\/?([^\/]+)$/io;
    $file="$base/$file" if $file!~/^\Q$base\E/io;
    copy("$base/download/$name","$base/tmp/$name.bak") if -e "$base/download/$name";
    if (! downloadHTTP($url,"$base/download/$name",0,$name,24,24,2,1)) {
        unlink("$base/tmp/$name.bak");
        return 0;
    }
    if (-e $file) {
        use File::Compare;
        my $ret = File::Compare::compare("$base/download/$name",$file);
        if ($ret == 0) { # files are equal - nothing to do
            mlog(0,"info: the most recent version of $name is still installed") if $MaintenanceLog;
            unlink("$base/tmp/$name.bak");
            return 0;
        } elsif (-e $file && $ret == -1) { # an error while compare
            mlog(0,"warning: unable to compare $base/download/$name and $file");
            unlink("$base/tmp/$name.bak");
            return 0;
        }
    }
    File::Copy::move("$base/tmp/$name.bak","$base/download/$name.bak") if -e "$base/tmp/$name.bak";
    my $cmd;
    my $perl = $perl;
    $perl =~ s/\"\'//go;
    if ($^O eq "MSWin32") {
        my $inc = join(' ', map {'-I "'.$_.'"'} @INC);
        $cmd = '"' . $perl . '"' . " $inc -c \"$base/download/$name\" 2>&1";
    } else {
        my $inc = join(' ', map {'-I \''.$_.'\''} @INC);
        $cmd = '\'' . $perl . '\'' . " $inc -c \'$base/download/$name\' 2>&1";
    }
    my $res = qx($cmd);
    if ($res =~ /syntax\s+OK/igo) {
        mlog(0,"info: GPB-autoupdate: syntax check for '$file' returned OK");
    } else {
        mlog(0,"warning: GPB-autoupdate: syntax error in '$file' - skip $file update - syntax error is: $res");
        return 0;
    }
    my $newVer = $GPBCompLibVer->($file,"$base/download/$name");
    unless ($newVer) {
        mlog(0,"info: the installed version of file $name is equal to, or newer than the downloaded version") if $MaintenanceLog;
        return 0;
    }
    mlog(0,"info: GPB-autoaupdate: successful downloaded version ($newVer) of $file in $base/download/$name");
    return 1 if ($GPBautoLibUpdate == 1 || ! -e $file);
    File::Copy::move($file,"$file.bak");
    copy("$base/download/$name",$file);
    mlog(0,"info: GPB-autoupdate: new version ($newVer) of $file was installed - restart required");
    return 1;};
}

sub printallCon {
    my ($fh,$exept) = @_;
    my $this = $Con{$fh};
    return unless $this;
    return unless scalar(keys %$this);
    my $friend = $Con{$this->{friend}};
    my $c = 1;
    while (-s "$base/debug/con$c.txt") {$c++}
    my $file = "$base/debug/con$c.txt";
    my $OUT;
    open $OUT, '>',"$file";
    binmode $OUT;
    print $OUT "ASSP version: $MAINVERSION\n\n";
    print $OUT "Worker $WorkerNumber - Connection Data ----\n\n";
    print $OUT "exception detected $exept\n" if $exept;
    print $OUT "last debug step was: $lastd{$WorkerNumber}\n";
    print $OUT "last sigoff was    : $lastsigoff{$WorkerNumber}\n";
    print $OUT "last sigon  was    : $lastsigon{$WorkerNumber}\n\n";
    print $OUT "this --------------------------------------\n";
    while (my ($k,$v) = each %$this) {
       print $OUT "this->$k = $v\n";
       eval {
           if (ref($v) eq 'HASH') {
               print $OUT "values of HASH this->$k :\n";
               print $OUT "this->$k = $_ => ${$v}{$_}\n" foreach (keys %{$v});
           }
           if (ref($v) eq 'ARRAY') {
               print $OUT "values of ARRAY this->$k :\n";
               print $OUT "this->$k = $_\n" for (@{$v});
           }
       }
    }
    if ($friend) {
        print $OUT "\nfriend --------------------------------------\n";
        while (my ($k,$v) = each %$friend) {
           print $OUT "friend->$k = $v\n";
           eval {
               if (ref($v) eq 'HASH') {
                   print $OUT "values of HASH friend->$k :\n";
                   print $OUT "friend->$k = $_ => ${$v}{$_}\n" foreach (keys %{$v});
               }
               if (ref($v) eq 'ARRAY') {
                   print $OUT "values of ARRAY friend->$k :\n";
                   print $OUT "friend->$k = $_\n" for (@{$v});
               }
           }
        }
    }
    close $OUT;
    mlog($fh,"info: wrote all current available connection data to file $base/debug/con$c.txt");
}

sub genCerts {
# Very basic script to create SSL/TLS certificates for ASSP

use File::Temp qw/ tempfile tempdir /;
my $template;

my $SERVER_key = "$base/certs/server-key.pem";
my $SERVER_key_pub = "$base/certs/server-key-pub.pem";
my $SERVER_csr = "$base/certs/server-csr.pem";
my $SERVER_crt = "$base/certs/server-cert.pem";

return if (-e "$base/certs/server-key.pem" and -e "$base/certs/server-cert.pem");

my %opts = (
    C  => 'XY',
    ST => 'unknown',
    L  => 'unknown',
    O  => 'ASSP',
    OU => 'Server',
    CN => $myName,
    emailAddress => $EmailAdminReportsTo,
);

my @C = split(/\|/o, $MyCountryCodeRe);
my $C = shift(@C);
$C = $1 if (! $C && $localhostname =~ /\.(\S)$/o);
$C = $1 if (! $C && $myName =~ /\.(\S)$/o);
$opts{C} = $C ? $C : $opts{C};
$opts{CN} = $opts{CN} ? $opts{CN} : $localhostname;
$opts{emailAddress} = $opts{emailAddress} ? $opts{emailAddress} : "postmaster\@$opts{CN}";

my $msg = "info: used parms for certs:" ;
foreach (keys %opts) {
    $msg .= " $_ - $opts{$_},";
}
chop $msg;
mlog(0,$msg);

mkdir("$base/certs") unless -d "$base/certs";

my $CA_key = "$base/certs/server-ca.key";
my $CA_crt = "$base/certs/server-ca.crt";
my $CA_serial = "$base/certs/.server-cert.serial";

my ($CA, $CAfilename) = tempfile( $template, DIR => "$base/certs", UNLINK => 1);

print ${CA} return_cfg('CA',%opts);
close ${CA};

system('openssl', 'genrsa', '-out', $CA_key, 2048) == 0
    or (mlog(0, "error: Cannot create CA key: $?") and return);

system('openssl', 'req', '-config', $CAfilename, '-new', '-x509',
	'-days', (365*20), '-key', $CA_key,
	'-out', $CA_crt) == 0
    or (mlog(0, "error: Cannot create CA cert: $?") and return);


my ($SERVER, $SERVERfilename) = tempfile( $template, DIR => "$base/certs", UNLINK => 1);
print ${SERVER} return_cfg($opts{OU},%opts);
close ${SERVER};

system('openssl', 'genrsa', '-out', $SERVER_key, 1024) == 0
    or (mlog(0, "error: Cannot create server key: $?") and return);

system('openssl', 'req', '-config', $SERVERfilename, '-new',
	'-key', $SERVER_key, '-out', $SERVER_csr) == 0
    or (mlog(0, "error: Cannot create server cert: $?") and return);

my ($SIGN, $SIGNfilename) = tempfile( $template, DIR => "$base/certs", UNLINK => 1);
print ${SIGN} <<"EOT";
extensions = x509v3
[ x509v3 ]
subjectAltName   = email:copy
nsComment        = ssl and tls certificate
nsCertType       = server
EOT
close ${SIGN};

open my $SERIAL, '>', $CA_serial;
print ${SERIAL} "01\n";
close ${SERIAL};

system('openssl', 'x509', '-extfile', $SIGNfilename, '-days', (365*20),
	'-CAserial', $CA_serial, '-CA', $CA_crt,
	'-CAkey', $CA_key, '-in', $SERVER_csr,
	'-req', '-out', $SERVER_crt) == 0
    or (mlog(0, "error: Cannot sign cert: $?") and return);

system('openssl', 'rsa', '-in', $SERVER_key, '-out', $SERVER_key_pub,
       '-pubout', '-outform', 'PEM') == 0
    or (mlog(0, "error: Cannot create public key: $?") and return);

mlog(0,"info: successfuly created certificates in $base/certs");

my $dkimfile = "$base/certs/dkim-pub.txt";
my $df;
my $kf;
my $dfout = "\"k=rsa; t=y; p=";
open $kf , '<',"$SERVER_key_pub";
open $df , '>',"$dkimfile";
binmode $df;
while (<$kf>) {
    s/\r|\n//go;
    next if /---/o;
    $dfout .= $_;
}
$dfout .= "\"";
print $df $dfout;
close $df;
close $kf;
mlog(0,"info: successfuly created DKIM public key NS TXT string in $dkimfile");
}

sub return_cfg {
    my ($OU,%opts) = @_;
    my $RANDOM = $SSLPKPassword ? $SSLPKPassword : int(rand(1000)).'RAN'.int(rand(1000)).'DOM challenge password';
    my $outpass = $SSLPKPassword ? $SSLPKPassword : 'mypass';
    my $cfg = <<"EOT";
[ req ]
default_bits           = 1024
default_keyfile        = keyfile.pem
distinguished_name     = req_distinguished_name
attributes             = req_attributes
prompt                 = no
output_password        = $outpass

[ req_distinguished_name ]
C                      = $opts{C}
ST                     = $opts{ST}
L                      = $opts{L}
O                      = $opts{O}
OU                     = $OU
CN                     = $opts{CN}
emailAddress           = $opts{emailAddress}

[ req_attributes ]
challengePassword      = $RANDOM
EOT
    return $cfg;
}

sub tlit {
    my $mode = shift;

    return '[monitoring]' if $mode == 2;
    return '[scoring]'    if $mode == 3;
    return '[testmode]'   if $mode == 4;
}

sub printVars {
    return unless $printVars;
    return unless $WorkerNumber == 0 or $WorkerNumber == 1 or $WorkerNumber > 999;
    &printVarsOn();
    my $maxrefs = 2;
    my $rcount;
    my $minfo;
    my $docount;
    my $d_dump;
    print "$WorkerName prints varables to $base/debug/var-$$-$WorkerNumber.txt\n";

    eval (<<'EOT');
    open my $f , ">$base/debug/var-$$-$WorkerNumber.txt";
    binmode $f;
    open my $r , ">$base/debug/var-$$-$WorkerNumber-refcnt.txt"  if $countRefs;
    binmode $r  if $countRefs;
    print $f "\n==================\n";
    print $f "Perl var SIZE summary";
    print $f "\n==================\n";

    our $count = 0;
    our %vars;
    sub psize {
        my $v = shift;
        return if $v=~ /^main::/o;
        return if $v=~ /^::(?:vars|count)/o;
        for (keys %$v) {
           if (/\:\:$/o) {
               &psize($v.$_);
           } else {
               my $t = '$' if defined ${$v.$_};
                  $t = '@' if defined @{$v.$_};
                  $t = '%' if defined %{$v.$_};
               next unless $t;
               my $size = Devel::Size::total_size(\${$v.$_}) if $t eq '$';
                  $size = Devel::Size::total_size(\@{$v.$_}) if $t eq '@';
                  $size = Devel::Size::total_size(\%{$v.$_}) if $t eq '%';
               $count+=$size;
               $v =~ s/^:://o;
               $vars{$t.$v.$_} = $size;
           }
        }
    }

    &psize('::');

    for (sort {$vars{$main::b}<=>$vars{$main::a}} (keys %vars)) {
        print $f $_ . ': ' . $vars{$_} . "\n";
    }

    print $f "\n\nmemory used by Perl variables: " . &formatNumDataSize($count) . "\n";
    print $f "\n==================\n";
    undef %vars;
    undef $count;

    print $f "\n==================\n";
OUTER:
    for my $symname (sort keys %main::)
    {
        $rcount = 0;
        $docount = 0;
        foreach my $k (keys %Refs2Count) {
            if ($symname =~ /$k/ig) {
                $docount = 1;
                last;
            }
        }
        $docount = 1 if (! scalar keys %Refs2Count && $countRefs);
        if (defined @$symname)
        {
            eval{$rcount = Devel::Peek::SvREFCNT(@$symname);} if $docount;
            print "\@$symname = $rcount\n" if $rcount > $maxrefs;
            print $r "\@$symname = $rcount\n" if $rcount > $maxrefs;
            Dump (@$symname) if $rcount > $maxrefs;
        }
        elsif (defined %$symname)
        {
            eval{$rcount = Devel::Peek::SvREFCNT(%$symname);} if $docount;
            print "\%$symname = $rcount\n" if $rcount > $maxrefs;
            print $r "\%$symname = $rcount\n" if $rcount > $maxrefs;
            Dump (%$symname) if $rcount > $maxrefs;
        }
        elsif (defined $$symname)
        {
            eval{$rcount = Devel::Peek::SvREFCNT($$symname);} if $docount;
            print "\$$symname = $rcount\n" if $rcount > $maxrefs;
            print $r "\$$symname = $rcount\n" if $rcount > $maxrefs;
            Dump ($$symname) if $rcount > $maxrefs;
        }
        if ( ! %Vars2Print && $rcount <= $maxrefs) {

            # ignore some data that we don't care about:
            next if $symname eq 'SIG';
            next if $symname =~ /FileUpdate/io;
            next if $symname =~ /env/io;
            next if $symname =~ /grip/io;
            next if $symname =~ /config/io;
            next if $symname eq '!';
            next if $symname eq 'AllStats';
            next if $symname =~ /^Carp:/io;
            next if $symname =~ /^AF_/io;
            next if $symname =~ /^Avail/io;
            next if $symname =~ /^can/io;
            next if $symname =~ /^use/io;
            next if $symname =~ /^BG_/io;
            next if $symname =~ /^DB_/io;
            next if $symname =~ /^FG_/io;
            next if $symname =~ /^PF_/io;
            next if $symname =~ /^rb_/io;
            next if $symname =~ /^RC_/io;
            next if $symname =~ /RE$/o;
            next if $symname =~ /Re$/o;
            next if $symname =~ /^SO_/io;
            next if $symname =~ /^SERVICE/io;
            next if exists $Config{$symname};
            next if $symname eq 'OldStats';
            next if $symname eq 'Stats';
            next if $symname =~ /^ver/io;
            next if $symname =~ /^Win32/io;
            next if $symname =~ /^_</i;
            next if $symname =~ /^z_/i;
            next if $symname =~ /^header/io;
            next if $symname =~ /^lock/io;
#            next if $symname =~ /^main:/o;
            next if $symname =~ /utf8:/o;
            next if $symname =~ /CONSOLE_COLORS/o;
            next if $symname =~ /Compress:/o;
            next if $symname =~ /Cwd:/o;
#            next if $symname =~ /::/o;
            next if $symname =~ /ModuleList/io;
            next if $symname =~ /ModuleStat/io;
            next if $symname =~ /NavMenu/io;
            next if $symname =~ /PossibleOptionFiles/io;
            next if $symname =~ /RealTimeLog/io;
            next if $symname =~ /failedTable/io;
            next if $symname =~ /footers/io;
            next if $symname =~ /Group/io;
            next if $symname =~ /kudos/io;
            next if $symname =~ /object$/io;
            next if $symname =~ /^batv/io;
            next if $symname =~ /^DB/o;
            next if $symname =~ /^RecRepRegex/o;
            next if $symname =~ /^RunTaskNow/o;
            next if $symname =~ /^msgid_secrets/o;
            next if $symname =~ /ARNING_BITS/o;
            next if $symname =~ /TRIE_MAXBUF/o;
            next if $symname eq 'head';
            next if $symname eq 'qs';
            next if $symname eq 'Refs2Count';
            next if $symname eq 'Vars2Print';
            next if $symname eq 'Charsets';
            next if $symname eq 'Day_to_Text';
            next if $symname eq 'Month_to_Text';
            next if $symname eq 'Spamfiles';
            next if $symname eq 'SuspiciousVirusWeight';
            next if $symname eq 'blackReWeight';

            next if length($symname) < 2;

            foreach my $dbGroup (@GroupList) {
                foreach my $dbGroupEntry (@$dbGroup) {
                    my ($KeyName,$dbConfig,$CacheObject,$realFileName,$mysqlFileName,$FailoverValue,$mysqlTable) = split(/,/,$dbGroupEntry);
                    next OUTER if $KeyName eq $symname;
                }
            }
            next if $$symname =~ /^aaaaaaaaaaaaaaaa/io;
            next if $$symname =~ /^\(\?\-/o;
        } else {
            if ($rcount <= $maxrefs) {
                my $found = 0;
                foreach my $k (keys %Vars2Print) {
                    if ($symname =~ /$k/ig) {
                        $found = 1;
                        last;
                    }
                }
                next if (! $found);
            }
        }
        $d_dump = $rcount > $maxrefs ? "refcount($rcount)" : '';
        if (defined @$symname)
        {
            print $f "\@$symname: $d_dump\n";
            print $f Dumper(@$symname);
        }
        elsif (defined %$symname)
        {
            print $f "\%$symname: $d_dump\n";
            print $f Dumper(%$symname);
        }
        elsif (defined $$symname)
        {
            print $f "\$$symname: $d_dump \"$$symname\"\n";
            if ($symname eq 'writable' or $symname eq 'readable') {
                print $f Dumper($$symname->handles());
            }
        }
        else
        {
            next;
        }
    }
    print $f "\n==================\n";
    close $f;
    close $r if $countRefs;

EOT
}

sub setPermission {
    my ($dir,$perm,$subdirs,$print) = @_;
    $dir =~ s/\\/\//go;
    my @files;
    my $file;
    my $has;
    my $type;
    if ($dF->( $dir )) {
        @files = $unicodeDH->($dir);
    } else {
        push @files,$dir;
    }
    $has = $chmod->( $perm, $dir);
    print "unable to set permission for directory $dir\n" if(! $has && $print);
    mlog(0, "unable to set permission for directory $dir") if(! $has && $print);
    return unless ($dF->( $dir ));
    while (@files) {
        $file = shift @files;
        next if $file eq '.';
        next if $file eq '..';
        $file = "$dir/$file";
        $type = $dF->( $file ) ? 'directory' : 'file' ;
        $has = $chmod->( $perm,$file ) if ($eF->( $file ));
        print "unable to set permission for $type $file\n" if(! $has && $print);
        mlog(0, "unable to set permission for $type $file") if(! $has && $print);
        &setPermission($file,$perm,$subdirs,$print) if ($dF->( $file ) && $subdirs);
    }
}

sub checkPermission {
    my ($dir,$perm,$subdirs,$print) = @_;
    $dir =~ s/\\/\//go;
    my @files;
    my $file;
    my $has;
    my $type;
    if ($dF->( $dir )) {
        @files = $unicodeDH->($dir);
    } else {
        push @files,$dir;
    }
    $has = [$stat->($dir)]->[2];
    $has=sprintf("0%o", $has & oct('07777'));
    print "permission for directory $dir is $has - should be at least $perm\n" if($has < $perm && $print);
    mlog(0, "permission for directory $dir is $has - should be at least $perm") if($has < $perm && $print);
    return unless ($dF->( $dir ));
    while (@files) {
        $file = shift @files;
        next if $file eq '.';
        next if $file eq '..';
        $file = "$dir/$file";
        $type = $dF->( $file ) ? 'directory' : 'file' ;
        $has = [$stat->($file)]->[2];
        $has=sprintf("0%o", $has & oct('07777'));
        print "permission for $type $file is $has - should be at least $perm\n" if($has < $perm && $print);
        mlog(0, "permission for $type $file is $has - should be at least $perm") if($has < $perm && $print);
        print "$type $file is not writeable with this job - it has a wrong permission, or is still opened by another process!\n" if($type eq 'file' && ! -w $file && $print);
        mlog(0, "$type $file is not writeable with this job - it has a wrong permission, or is still opened by another process!") if($type eq 'file' && ! -w $file && $print);
        &checkPermission($file,$perm,$subdirs,$print) if ($dF->( $file ) && $subdirs);
    }
}

#cleanup and normalize the mail header lines
sub HMMcleanUp {
    my $line = shift;
    $line =~ s/\Q+-+***+!+\Etime:.+?\Q+-+***+!+\E//og;
    $line =~ s/\Q+-+***+!+\E(.+?)\Q+-+***+!+\E/$1/og;
    return unless $line;
    return $line if $line =~ /^(?:from|to|bcc|cc|mail from|rcpt to|sender|reply-to|errors-to|list-\w+|ReturnReceipt|Return-Receipt-To|Disposition-Notification-To):/io;
    return "!socket! !detected! $1!IP! $2" if $line =~ /^(connected ip: )(.+)$/io;
    return "!the! !geeting! !used! !was! helo $2" if $line =~ /^(helo\s+|ehlo\s+)(.+)$/io; # expand to fit in to 6 words (including the leading 'connected IP: ...'
    return $line if $line =~ /^(?:data|starttls)$/io;
    return if $line =~ /^mime-version:/io;
    return if $line =~ /^x-assp[^():]+?:/io;
    $line =~ s/by\s?\Q$myName\E.+//io;
    $line =~ s/\Q$myName\E with e?smtp.+//io;
    $line =~ s/helo=/helo= /ogi;
    $line =~ s/(?:\w{3},)?\s+\d?\d\s+\w{3}\s+\d{4}\s+\d?\d:\d\d:\d\d\s+[+-]?\d{1,4}//go;
    $line =~ s/[<>]//go;
    $line =~ s/(\@)/ $1/go;
    $line =~ s/([:;])([^\s])/$1 $2/go;
    $line =~ s/^\s+$//o;
    $line = $1.' randtag1 randtag2 randtag3 randtag4'.$2 if $line =~ /^(message-id:\s*)\S+( \@.+)$/io;

    our $h = 0; $line =~ s/(?:[a-f0-9]{2}){3,}(?{$h++;})/ randomhex$h /go;
    our $w = 0; $line =~ s/[a-z0-9][ghjklmnpqrstvwxz_]{2}[bcdfghjklmnpqrstvwxz_0-9]{3}\S*(?{$w++;})/ randomword$w /gio;

    $line =~ s/\s+/ /go;
    $line =~ s/^\s+//o;
    $line =~ s/\s+$//o;
    $line =~ s/^(?:(?:randomword|randomhex)\d+\s?)+$//igo;
    return $line;
}

sub HMMreadCrashFiles {
    return unless $enableCrashAnalyzer;
    print "\t\t\t\t[OK]\nstarting crash analyzer   ";
    mlog(0,"warning: 'discarded' is not configured - crash analyzer is switched off in SMTP-workers") if (! $discarded);
    my @files;
    my @lines;
    my @allstarts;
    my $file;
    my $filenum = 0;
    my $dir = "$base/crash_repo";
    @files = reverse $unicodeDH->($dir);
    while (@files) {
        my @starts;
        my $dataseen;
        my $headerseen;
        $file = shift @files;
        next if -d $file;
        $file = "$dir/$file";
        $open->(my $FH,'<', $file) or next;
        my @filelines;
        while (my $line = (<$FH>)) {
            $line =~ s/\r|\n//og;               # strip unneeded strings and lines, and make word lists
            last unless $line; # header only
            $line = HMMcleanUp(lc $line);
            next unless $line;
            $headerseen = 1 if $dataseen;
            $dataseen = 1 if $line =~ /^data\s*$/io;
            my @words = split(/\s+/o, $line);
            push @starts, $words[0];
            push @filelines, @words;
        }
        $FH->close;
        if ($headerseen) {
            push @lines,@filelines;
            push @allstarts,@starts;
            $filenum++;
        } else {
            $unlink->($file);
            mlog(0,"info: removed too short file $file from crash respository") if $MaintenanceLog > 1;
        }

        last if $filenum > $NumComWorkers * 10; # prevent too much memory usage for HMM
    }
    if (@files) {
        mlog(0,"info: the following files in the crash respository are ignored: \n".join("\n",@files));
    }
    if (! @lines) {
        mlog(0,"info: no lines from crash respository left for a Hidden Markov Model");
        return;
    }
    my $chain = ASSP::MarkovChain->new(longest => 6,
                                       top => $CrashAnalyzerTopCount
                                       );
    if (! ref $chain) {
        mlog(0,"info: unable to create a Hidden Markov Model - $chain");
        return;
    }
    eval {
        $chain->seed(symbols => \@lines,
                     longest => 6
                   );
        @{$chain->{_start_states}} = @allstarts;
    };
    mlog(0,"info: unable to build a Hidden Markov Model - $@") and return if $@;

    mlog(0,"info: crash respository in $base/crash_repo is too small for a usable Hidden Markov Model") and return if $chain->longest_sequence < 6;
    my $symcount = scalar keys %{$chain->{totals}};
    mlog(0,"info: loaded $symcount Markov-Chains from crash respository") if $MaintenanceLog >= 2;
    mlog(0,"info: enabled traffic/header prescan for crash prevention");
    my $top10count = scalar keys %{$chain->{top10}};
    if ($MaintenanceLog && $top10count) {
        mlog(0,"info: the following are the top $top10count Markov-Chains from the HMM crash respository - possibly you can use some of them to build a 'preHeaderRe'");
        for (0..($top10count-1)) {
            my $sym = join(' ',split($chain->{seperator},$chain->{top10}{$_}));
            mlog(0,"info: Markov-Chain ($_) => '$sym' => occurrency count: ".$chain->{top10count}{$_});
        }
    }
    if ($MaintenanceLog > 2 && eval 'use Devel::Size();1;') {
        my $size = &formatDataSize((Devel::Size::total_size(\%{$chain->{totals}}) +
                                    Devel::Size::total_size(\%{$chain->{chains}}) +
                                    Devel::Size::total_size(\%{$chain->{top10}}) +
                                    Devel::Size::total_size(\%{$chain->{top10count}}) +
                                    Devel::Size::total_size(\@{$chain->{_start_states}}) +
                                    Devel::Size::total_size(\%{$chain->{_symbols}})
                                   ) * $NumComWorkers
                                  ,1);
        mlog(0,"info: HMM uses $size of memory");
    }
    return $chain;
}

sub HMMwillPossiblyCrash {
    my ($fh,$buf) = @_;
    d('HMMwillPossiblyCrash');
    mlog(0,"info: crash detection is running") if $ConnectionLog >= 2;
    if (! $discarded && $WorkerNumber > 0) {
        mlog(0,"warning: 'discarded' is not configured - crash analyzer is switched off");
        return 0;
    }
    my @lines;
    @lines = split(/(?:\r?\n)+/o, $Con{$fh}->{crashbuf}) if $fh;
    push @lines, ref $buf ? split(/(?:\r?\n)+/o, $$buf) : split(/(?:\r?\n)+/o, $buf);
    pop @lines; # remove the empty header line
    my ($count,$value);
    my $lines;
    while (@lines) {
        my $line = shift @lines;            # strip unneeded strings and lines, and make word lists
        $line = HMMcleanUp(lc $line);
        next unless $line;
        my @tocheck = split(/\s+/o,$line);
        my $expected = pop @tocheck;
        next unless @tocheck;
        $lines++;
        my $length = 20;    # never set this to a value < 1
        my $div = $length / 5;
        $length = @tocheck + 5 if @tocheck > $length - 5;
        my @newness;
        mlog(0,"info: asking HMM for - '@tocheck' - our expected is '$expected'") if $ConnectionLog > 2;
        eval { @newness = $crashHMM->spew(length       => $length,
                                          complete     => @tocheck,
                                          strict_start => 0
                                         );
        };
        for (1..@tocheck) {shift @newness;}
        next unless @newness;
        mlog(0,"info: HMM answers - '@newness' - our expected is '$expected'") if $ConnectionLog > 2;
        my $new = @newness;
        my $seq = join($crashHMM->{seperator},@tocheck);
        my $sym = $seq.$crashHMM->{seperator}.$expected;
        $length = @tocheck + 5;
        if (@tocheck > 2 && $crashHMM->sequence_known($sym)) {
            $count++;
            my $val = ($length + $new/$div) * 2;
            $value += $val;
            mlog(0,"info: HMM added $val, this line is exactly known by HMM - @tocheck $expected") if $ConnectionLog >= 2;
        }
        while (@newness) {
            $new--;
            my $word = shift @newness;
            $sym = $seq.$crashHMM->{seperator}.$word;
            if ($word eq $expected && $crashHMM->sequence_known($seq)) {
                $count++;
                my %Symbols = $crashHMM->get_options($seq);
                my $w = $Symbols{$word} * 2;
                my $val = ($length + $new/$div) * ($w + 4);
                $value += $val;
                mlog(0,"info: HMM added $val, found exact match for - '@tocheck' + '$word'") if $ConnectionLog >= 2;
            } elsif ($word eq $expected) {
                $count++;
                my $val = $length + $new/$div;
                $value += $val;
                mlog(0,"info: HMM added $val, our expected word '$expected' found in HMM answer") if $ConnectionLog >= 2;
            }
            next unless $crashHMM->sequence_known($sym);
            if (scalar keys %{$crashHMM->{top10}}) {
                my %Symbols = $crashHMM->get_options($seq);
                next unless exists $Symbols{$word};
                my $top10 = scalar keys %{$crashHMM->{top10}};
                for (0..($top10 - 1)) {
                    if ($sym eq $crashHMM->{top10}{$_}) {
                        $count++;
                        my $val = ($length + $new/$div) * $crashHMM->{top10count}{$_} * $Symbols{$word};
                        $value += $val;
                        mlog(0,"info: HMM added $val, match found in top $top10 Markov-Chains for - '@tocheck' + '$word'") if $ConnectionLog >= 2;
                        last;
                    }
                }
            }
        }
    }
    my $limit = 4;
    return 0 unless $value;
    return 0 unless $count;
    if ($count < $lines / 8) {
        mlog($fh,"info: HMM = too less hit-count - result (v=$value,c=$count,l=$lines,f=$limit)") if $ConnectionLog;
        return 0;
    }
    $count = 3 if $count < 3; # reduce value if hits are less than 3
    my $detail = $ConnectionLog >= 2 ? " (v=$value,c=$count,l=$lines,f=$limit)" : '';
    $value = $value / ( $count * $limit );
    mlog($fh,"info: HMM = result $value$detail, would not block ( <= $limit )") if $value <= $limit && $ConnectionLog;
    if ($value > $limit) {
        my $np = ($Con{$fh}->{noprocessing} == 1) ? ' (noprocessing)' : '';
        my $text = ($CrashAnalyzerWouldBlock && $Con{$fh}->{noprocessing} != 1) ? '' : ' - but currently not$np - partial debug was switchted on';
        mlog($fh,"info: HMM = result $value$detail, block the mail ( > $limit )$text") if $ConnectionLog;
        if ($fh && (! $CrashAnalyzerWouldBlock || $Con{$fh}->{noprocessing} == 1)) {
            $Con{$fh}->{debug} = 1;
            $Con{$Con{$fh}->{friend}}->{debug} = 1 if ($Con{$fh}->{friend} && exists $Con{$Con{$fh}->{friend}});
            $ThreadDebug = 1;
        }
        return 1 if $CrashAnalyzerWouldBlock && $Con{$fh}->{noprocessing} != 1;
    }
    return 0;
}

sub cleanUpFiles {
    my ($folder, $filter, $filetime) = @_;
    d('cleanUpFiles - '."$folder, $filter, $filetime");
    my $textfilter; $textfilter = " (*$filter)" if $filter;
    my @files;
    my $file;
    my $count;
    my $filecount;
    my $filemax;
    my $dir = ($folder !~ /\Q$base\E/io) ? "$base/$folder" : $folder ;
    $dir =~ s/\\/\//go;
    return unless $eF->( $dir );
    mlog(0,"info: starting cleanup old files$textfilter for folder $dir") if $MaintenanceLog >= 2;
    @files = $unicodeDH->($dir);
    $filemax = @files;
    while (@files) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $filecount % 100;
        $file = shift @files;
        $filecount++;
        $lastd{10000} = "cleanup: delete old files$textfilter: $filecount/$filemax files processed in $dir" if $filecount%1000 == 0;
        next if $file eq '.';
        next if $file eq '..';
        next if ($filter && $file !~ /$filter$/i);
        next if ($filter && $file =~ /^$filter$/i);
        $file = "$dir/$file";
        next if $dF->( $file );
        if (ftime($file) - time < $filetime * -1) {
            $unlink->($file) and
            $count++ and ($MaintenanceLog > 2) and
            mlog(0,"info: deleted $file");
        }
    }
    mlog(0,"info: deleted $count old$textfilter files from folder $dir") if $MaintenanceLog && $count;
}

sub cleanUpMaxFiles {
    my ($folder,$percent,$minfiles,$mindays) = @_;
    d('cleanUpMaxFiles - '."$folder");
    $mindays = 0 if $mindays < 1;
    my @files;
    my $file;
    my $count;
    my $info;
    my $dir = ($folder !~ /\Q$base\E/io) ? "$base/$folder" : $folder ;
    $dir =~ s/\\/\//go;
    return unless $dF->( $dir );
    my $text;
    if ($percent) {
        my $p = max(min($percent * 100, 99),1);
        $percent = $p / 100;
        $text .= " - will try to remove $p% of the files";
    }
    $text .= " - will keep at least $minfiles files" if $minfiles;
    $text .= " - will keep files younger than $mindays days" if $mindays;
    mlog(0,"info: starting cleanup for to much (old) files in folder $dir$text") if $MaintenanceLog;
    if ($WorkerNumber == 10001) {
        $info = "\ninfo: starting cleanup for to much (old) files in folder $dir$text\n";
    }
    @files = $unicodeDH->($dir);
    my $filecount = @files - 2;
    return $info if (! $percent && $filecount <= $MaxFiles);
    
    my %filelist = ();
    while (@files) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $count % 100;
        $file = shift @files;
        next if $file eq '.';
        next if $file eq '..';
        $file = "$dir/$file";
        if ($dF->( $file )) {
            $filecount--;
            next;
        }
        my $ft = ftime($file);
        $ft = $ft - (60 * 24 * 3600) if $ft > time;
        while (exists $filelist{$ft}) {
            $ft++;
        }
        $filelist{$ft} = $file;
        $count++;
        $lastd{$WorkerNumber} = "cleanup: generate filelist $count/$filecount files in $dir" if $count%1000 == 0;
    }
    return $info if (! $percent && $filecount <= $MaxFiles);
    my $toFilenumber;
    my $filenum;
    $mindays = 14 if $mindays < 1;
    my $time = time - ($mindays * 24 * 3600);   # two weeks ago
    $minfiles = 4000 if $minfiles < 4000;    # kepp at least 4000 files in the folder
    if ($percent) {
        return $info if $filecount < $minfiles;
        $filenum = int($filecount * $percent);
        $filenum = $filecount - $minfiles if $filecount - $filenum < $minfiles;
        $toFilenumber = $filecount - $filenum;
    } else {
        $filenum = $MaxFiles - $filecount;
        $toFilenumber = $MaxFiles;
    }
    $count = 0;
    foreach my $filetime (sort keys %filelist) {
        &ThreadMaintMain2() if $WorkerNumber == 10000 && ! $count % 100;
        last if --$filecount < $toFilenumber;
        last if $percent && $filetime > $time;
        $unlink->($filelist{$filetime});
        $count++;
        mlog(0,"info: deleted $filelist{$filetime}") if $MaintenanceLog > 2;
        $lastd{$WorkerNumber} = "cleanup: delete old files $count/$filenum files in $dir" if $count%1000 == 0;
    }
    mlog(0,"info: deleted $count old files from folder $dir") if $MaintenanceLog && $count;
    if ($WorkerNumber == 10001) {
        $info .= "info: deleted $count old files from folder $dir\n" if $count;
    }
    if ($count && $UseSubjectsAsMaillogNames && $discarded && $MaxAllowedDups && $folder =~ /$spamlog$/) {
        &ConfigChangeMaxAllowedDups('MaxAllowedDups',$MaxAllowedDups,$MaxAllowedDups,'reread');
    }
    return $info;
}

sub cleanUpMailLog {
    d('cleanUpMailLog');
    return unless $MaxLogAge;
    return unless $logfile;
    return if $logfile =~ /\/?maillog\.log$/io;
    my $age = $MaxLogAge * 3600 * 24;
    my ($logdir, $logdirfile) = $logfile=~/^(.*[\/\\])?(.*?)$/o;
    $logdir = $base unless $logdir;
    return unless $logdirfile;
    mlog(0,"info: starting cleanup of old maillog files") if $MaintenanceLog >= 2;
    &ThreadMaintMain2() if $WorkerNumber == 10000;
    &cleanUpFiles($logdir,$logdirfile,$age);
    &ThreadMaintMain2() if $WorkerNumber == 10000;
    &cleanUpFiles($logdir,"b$logdirfile",$age);
}

sub cleanUpCollection {
    d('cleanUpCollection');
    my %ages;
    ($ages{incomingOkMail},$ages{discarded},$ages{viruslog}) = split(/\s+/o, $MaxNoBayesFileAge);
    $ages{discarded} = $ages{incomingOkMail} unless defined $ages{discarded};
    $ages{viruslog} = $ages{incomingOkMail} unless defined $ages{viruslog};
    $ages{incomingOkMail} *= 3600 * 24;
    $ages{discarded} *= 3600 * 24;
    $ages{viruslog} *= 3600 * 24;
    my @dirs = ('incomingOkMail','discarded','viruslog');
    &ThreadMaintMain2() if $WorkerNumber == 10000;
    if ($ages{incomingOkMail} || $ages{discarded} || $ages{viruslog}) {
        mlog(0,"info: starting collection cleanup on NoBayesian folders") if $MaintenanceLog >= 2;
        foreach my $dir (@dirs) {
            &cleanUpFiles(${$dir},'',$ages{$dir}) if ${$dir} && $ages{$dir};
        }
    }
    if ($MaintBayesCollection) {
        &ThreadMaintMain2() if $WorkerNumber == 10000;
        %ages = ();
        ($ages{spamlog},$ages{notspamlog}) = split(/\s+/o, $MaxBayesFileAge);
        $ages{notspamlog} = $ages{spamlog} unless defined $ages{notspamlog};
        $ages{spamlog} *= 3600 * 24;
        $ages{notspamlog} *= 3600 * 24;
        @dirs = ('spamlog','notspamlog');
        mlog(0,"info: starting collection cleanup on Bayesian folders - spamlog and notspamlog") if $MaintenanceLog >= 2;
        foreach my $dir (@dirs) {
            if ($ages{$dir}) {
                &cleanUpFiles(${$dir},'',$ages{$dir}) if ${$dir};
            } else {
                if (! $RunTaskNow{cleanUpMaxFiles}) {
                    $RunTaskNow{cleanUpMaxFiles} = $WorkerNumber;
                    &cleanUpMaxFiles(${$dir},0) if ${$dir};
                    $RunTaskNow{cleanUpMaxFiles} = '';
                }
            }
        }
        &ThreadMaintMain2() if $WorkerNumber == 10000;
        %ages = ();
        ($ages{correctedspam},$ages{correctednotspam}) = split(/\s+/o, $MaxCorrectedDays);
        $ages{correctednotspam} = $ages{correctedspam} unless defined $ages{correctednotspam};
        $ages{correctedspam} *= 3600 * 24;
        $ages{correctednotspam} *= 3600 * 24;
        @dirs = ('correctedspam','correctednotspam');
        mlog(0,"info: starting collection cleanup on Bayesian folders - correctedspam and correctednotspam") if $MaintenanceLog >= 2;
        foreach my $dir (@dirs) {
            if ($ages{$dir}) {
                &cleanUpFiles(${$dir},'',$ages{$dir}) if ${$dir};
            } else {
                if (! $RunTaskNow{cleanUpMaxFiles}) {
                    $RunTaskNow{cleanUpMaxFiles} = $WorkerNumber;
                    &cleanUpMaxFiles(${$dir},0) if ${$dir};
                    $RunTaskNow{cleanUpMaxFiles} = '';
                }
            }
        }
        &fillSpamfiles();
    }
}

#####################################################################################
# subroutine replacement for Email::Send::SMTP::send
#####################################################################################
sub email_send_X {
    my ($class, $message, @args) = @_;

    my %args;
    if ( @args % 2 ) {
        my $host = shift @args;
        %args = @args;
        $args{Host} = $host;
    } else {
        %args = @args;
    }

    my $host = delete($args{Host}) || 'localhost';

    my $smtp_class = $args{tls} ? 'Net::SMTP::TLS'
#                   : $args{ssl} ? 'Net::SMTP::SSL'
                   :              'Net::SMTP';

    if ($smtp_class eq 'Net::SMTP::TLS' && $args{username}) {
        ($args{User},$args{Password}) = ($args{username},$args{password});
        delete $args{username};
        delete $args{password};
    }
    eval('use '. $smtp_class . ';1;') or do {return Return::Value::failure("module load failed - $@")};
    my $SMTP = $smtp_class->new($host, %args);
    return Return::Value::failure("Couldn't connect to $host") unless $SMTP;

    my ($user, $pass) = @args{qw[username password]};

    if ( $user && $smtp_class ne 'Net::SMTP::TLS') {
        $SMTP->auth($user, $pass)
          or return Return::Value::failure("Couldn't authenticate '$user:...'");
    }

    my @bad;
    eval {
        my $from = $class->get_env_sender($message);

        # ::TLS has no useful return value, but will croak on failure.
        eval { $SMTP->mail($from) } or return Return::Value::failure("FROM: <$from> denied");

        my @to = $class->get_env_recipients($message);

        if (@to) {
            if (eval { $SMTP->isa('Net::SMTP::TLS') }) {
                $SMTP->to(@to);
            } else {
                my @ok = $SMTP->to(@to, { SkipBad => 1 });

                if ( @to != @ok ) {
                    my %to; @to{@to} = (1) x @to;
                    delete @to{@ok};
                    @bad = keys %to;
                }
            }
        }

        return Return::Value::failure("No valid recipients") if @bad == @to;
    };

    return Return::Value::failure($@) if $@;

    my $fh = $smtp_class eq 'Net::SMTP::TLS' ? $SMTP->{sock} : $SMTP;
    my $timeout = (int(length($message) / (1024 * 1024)) + 1) * 60; # 1MB/min
    eval {
        $SMTP->data();
        my $blocking = $fh->blocking(0);
        NoLoopSyswrite($fh, $message->as_string . "\r\n", $timeout) or die "$!\n";
        $fh->blocking($blocking);
        $SMTP->dataend();
        1;
    } or do {
        return Return::Value::failure("Can't send data - $@");
    };
    eval {$SMTP->quit;1;} or do {return Return::Value::failure("Can't QUIT SMTP session - $@");};
    my $bad;
    $bad = ' - not accepted recipients: ' . join(', ',@bad) if @bad;
    return Return::Value::success("Message sent" . $bad);
}

#####################################################################################
# subroutine replacement for tie :: RDBM
#####################################################################################
sub rdbm_EXISTS {
    my($self,$key) = @_;
    return unless defined $key;
    my $rows;
    my $error;
    %{$self->{nextvalue}} = ();
    if ($main::DBCacheMaxAge && $main::DBCacheSize && ! $self->{noRDBMcache}) {
        my $time = Time::HiRes::time;
        threads->yield;
        my $c = \@{'main::'.lc $self->{table}};  # store the cache in $c->
        threads->yield;
        for (my $i = 0; $i < $main::DBCacheSize * 4; $i+=4) {
            return ((defined $c->[$i+2]) ? 1 : 0) if $c->[$i+1] eq $key && $time - $c->[$i] < $main::DBCacheMaxAge;
        }
    }
    eval {
    my $sth = $self->_run_query("exists$self->{table}",<<END,$key);
select $self->{key} from $self->{table} where $self->{key}=?
END
    $error = "Database select statement failed in ".$self->{table}."(exists): $DBI::errstr" unless $sth;
    if ($sth) {
        $sth->fetch;
        $rows = $sth->rows;
        $sth->finish;
    }
    };
    my $evalerror = $@ || $error;
    die "$evalerror - $DBI::errstr\n" if $evalerror && $main::checkdb; # tell checkDBCon that we have failed
    &main::mlog(0, $error) if $error;
    &main::mlog(0, "error: exists (".$self->{table}."): $@ - $DBI::errstr") if $evalerror && $main::DataBaseDebug;
    threads->yield();
    return $rows > 0;
}

sub rdbm_STORE {
    my($self,$key,$value) = @_;

    return unless defined $key;
    %{$self->{nextvalue}} = ();
    my $frozen = 0;
    my $res = 0;
    if (ref($value) && $self->{'canfreeze'}) {
	    $frozen++;
	    $value = nfreeze($value);
    }
    return 1 if &main::rdbm_storedInCache($self, $key, $value);
    eval {
        $res = $self->_update($key,$value,$frozen) || $self->_insert($key,$value,$frozen);
        $self->commit unless $main::DBautocommit;
    };
    if ($@) {
        $self->rollback unless $main::DBautocommit;
        &main::mlog(0, "error: STORE (".$self->{table}."): $@ - $DBI::errstr") if $@;
    }
    if ($res && $main::DBCacheMaxAge) {
        &main::rdbm_updateCache($self, $key, $value, 1);
    }
    return $res;
}

sub rdbm_update {
    my ($self,$key,$value,$frozen) = @_;
    return unless defined $key;
    my $sth; my $dsth;
    my $res;
    eval{
    if ($self->{'canfreeze'}) {
    	$sth = $self->_run_query("update$self->{table}",
				 "UPDATE $self->{table} SET $self->{value}=?,$self->{frozen}=? WHERE $self->{key}=?",
				 $value,$frozen,$key);
    } else {
    	$sth = $self->_run_query("update$self->{table}",
				 "UPDATE $self->{table} SET $self->{value}=? WHERE $self->{key}=?",
				 $value,$key);
    }
    if ($sth) {
        $dsth = 1;
        $res = $sth->rows > 0;
        $sth->finish;
    }
    };
    threads->yield();
    unless ($dsth) {
        &main::mlog(0, "error: Update (".$self->{table}."): $DBI::errstr") if $main::DataBaseDebug;
        return 0;
    }
    return $res;
}

sub rdbm_insert {
    my ($self,$key,$value,$frozen) = @_;
    return unless defined $key;
    my $sth;
    my $res;
    eval {
    if ($self->{'canfreeze'}) {
    	$sth = $self->_run_query("insert$self->{table}",
				 "INSERT INTO $self->{table} ($self->{key},$self->{value},$self->{frozen}) VALUES(?,?,?)",
				 $key,$value,$frozen);
    } else {
    	$sth = $self->_run_query("insert$self->{table}",
				 "INSERT INTO $self->{table} ($self->{key},$self->{value}) VALUES (?,?)",
				 $key,$value);
    }
    $res = ($sth && $sth->rows);
    $sth->finish if $sth;
    };
    threads->yield();
    return $res || ($main::DataBaseDebug && ! &main::mlog(0, "error: Insert (".$self->{table}."): $DBI::errstr"));
}

sub rdbm_fetch {
    my($self,$key) = @_;
    return unless defined $key;
    return delete $self->{nextvalue}{$key} if (exists $self->{nextvalue}{$key}); # satisfy an each loop
    %{$self->{nextvalue}} = ();
    if ($main::DBCacheMaxAge && $main::DBCacheSize && ! $self->{noRDBMcache}) {
        my $time = Time::HiRes::time;
        threads->yield;
        my $c = \@{'main::'.lc $self->{table}};  # store the cache in $c->
        threads->yield;
        for (my $i = 0; $i < $main::DBCacheSize * 4; $i+=4) {
            return $c->[$i+2] if $c->[$i+1] eq $key && $time - $c->[$i] < $main::DBCacheMaxAge;
        }
    }
    my $sth; my $result; my $cols;
    eval {
        $cols = $self->{'canfreeze'} ? "$self->{'value'},$self->{'frozen'}" : $self->{'value'};
        $sth = $self->_run_query("fetch$self->{table}",<<END,$key);
SELECT $cols FROM $self->{table} WHERE $self->{key}=?
END
        $result = $sth->fetchrow_arrayref();
        $sth->finish;
    };
    &main::mlog(0, "error: Fetch (".$self->{table}."): $@ - $DBI::errstr") if $@ && $main::DataBaseDebug;
    threads->yield();
    if ($result && $main::DBCacheMaxAge) {
        my $value = $self->{'canfreeze'} && $result->[1] ? thaw($result->[0]) : $result->[0];
        &main::rdbm_updateCache($self, $key, $value, undef);
    } else {
        return unless $result;
    }
    return $self->{'canfreeze'} && $result->[1] ? thaw($result->[0]) : $result->[0];
}

sub rdbm_delete {
    my($self,$key) = @_;
    return 1 unless defined $key;
    my $stm = "DELETE FROM $self->{table} WHERE $self->{key}=?";
    my $tag = "delete$self->{table}";
    my $row = 0;
    my $okey = $key;
    %{$self->{nextvalue}} = ();
    if ($main::DoSQL_LIKE && $key =~ /\*/o) {
        my $escape;
        my $echar;
        if ($key =~ /[_%]/o) {
            $echar = ($key=~/!/o) ? (($key=~/#/o ? '§' : '#') ) : '!';
            $key =~ s/([_%])/$echar$1/go;
            $escape = " ESCAPE '$echar'";
        }
        my $stmLIKE = "DELETE FROM $self->{table} WHERE $self->{key} LIKE ?$escape";
        $stm = $stmLIKE if $key =~ s/\*/\%/gos;
        if ($stm eq $stmLIKE) {
           $tag = $escape ? "deletelike$echar$self->{table}" : "deletelike$self->{table}";
        }
        @{'main::'.lc $self->{table}} = ();
    } elsif ($main::DBCacheMaxAge && $main::DBCacheSize && ! $main::checkdb && ! $self->{noRDBMcache}) {
        my $time = Time::HiRes::time;
        threads->yield;
        my $c = \@{'main::'.lc $self->{table}};  # store the cache in $c->
        threads->yield;
        for (my $i = 0; $i < $main::DBCacheSize * 4; $i+=4) {
            if ($c->[$i+1] eq $key && $time - $c->[$i] < $main::DBCacheMaxAge) {
                 my $r = $c->[$i+2];
                 ($c->[$i],$c->[$i+2],$c->[$i+3]) = ($time,undef,defined $r);
                 return defined $r;
            }
        }
    }
    my $error;
    eval {
    my $sth = $self->_run_query($tag,$stm,$key);
    $error = "Database delete statement failed (".$self->{table}."): $DBI::errstr" if $sth->err;
    $row = $sth->rows;
    $sth->finish;
    };
    &main::mlog(0, $error) if $error;
    &main::mlog(0, "error: delete (".$self->{table}."): $@ - $DBI::errstr") if $@ && $main::DataBaseDebug;
    eval{$self->commit} unless $main::DBautocommit;
    threads->yield();
    if ($row && $main::DBCacheMaxAge) {
        &main::rdbm_updateCache($self, $okey, undef, 1);
    }
    return $row;  # attention: it may possible that we return values above 1, if a sql like statement was executed and more than one
}                 # record was deleted

sub rdbm_firstkey {
    my $self = shift;

    my $r; my $error;

    eval {
    if ($self->{"fetchkeys$self->{table}"}) {
        eval{$self->{"fetchkeys$self->{table}"}->finish();};  # to prevent truncation in ODBC driver
        delete $self->{"fetchkeys$self->{table}"};
    }
    my $sth = $self->_prepare("fetchkeys$self->{table}",$self->{'canfreeze'} ? <<END1 : <<END2);
select $self->{'key'},$self->{'value'},$self->{'frozen'} from $self->{table}
END1
select $self->{'key'},$self->{'value'} from $self->{table}
END2
    if ($sth) {
        $sth->execute() || ($error = "error: FIRSTKEY (".$self->{table}."): Can't execute select statement: $DBI::errstr");
        $r = $sth->fetch();
        my $value = ($r->[2] ? thaw($r->[1]) : $r->[1]);
        $self->{nextvalue}{$r->[0]} = $value if defined($value) && defined $r->[0];  # cache the value for the next fetch
    } else {
        $error = "error: FIRSTKEY: Can't get value from select statement (".$self->{table}."): $DBI::errstr";
        delete $self->{"fetchkeys$self->{table}"};
    }
    };
    &main::mlog(0, $error) if $error;
    &main::mlog(0, "error: FIRSTKEY (".$self->{table}."): $@ - $DBI::errstr") if $@ && $main::DataBaseDebug;
    threads->yield();
    return defined($r) ? $r->[0] : undef;
}

sub rdbm_nextkey {
    my ($self, $lastkey) = @_;
    # no statement handler defined, so nothing to iterate over
    my $sth;
    return unless ($sth = $self->{"fetchkeys$self->{table}"});
    my ($r,$key,$value);
    eval{
        $r = $sth->fetch();
        if (!$r) {
        	$sth->finish;
            delete $self->{"fetchkeys$self->{table}"};
            delete $self->{nextvalue};
            return;
        }
        ($key,$value) = ($r->[0], ($r->[2] ? thaw($r->[1]) : $r->[1]) );
        $self->{nextvalue}{$key} = $value if defined($key) && defined($value);  # cache the value for the next fetch
    };
    &main::mlog(0, "error: NEXTKEY (".$self->{table}."): $@ - $DBI::errstr") if $@ && $main::DataBaseDebug;
    threads->yield();
    return $key;
}

sub rdbm_CLEAR {
    my $self = shift;
    my ($dbh, $sth, $error);
    $dbh = $self->{'dbh'};
    %{$self->{nextvalue}} = ();
    eval {
        $sth = $self->_prepare("truncate$self->{table}","TRUNCATE TABLE $self->{table}");
        $sth->execute();
        $sth->finish;
    } if $forceTrunc4ClearDB;
    eval {
        mlog(0, "Database TRUNCATE TABLE $self->{table} statement failed: $DBI::errstr - will try DELETE FROM $self->{table}") if $forceTrunc4ClearDB;
        $sth = $self->_prepare("clear$self->{table}","DELETE FROM $self->{table}");
        $sth->execute();
        $sth->finish;
    } if $@ || ! $forceTrunc4ClearDB;
    if (eval{$dbh->err;}) {
        $error = $DBI::errstr;
        mlog(0, "Database delete all statement failed (".$self->{table}."): $error");
        eval{$sth->finish;};
    }
    $@ = $error if $error;
    eval{$self->commit} unless $main::DBautocommit;
    threads->yield();
    @{'main::'.lc $self->{table}} = ();
    return 1;
}

sub rdbm_COUNT {
    my $self = shift;
    my $sth;
    my $r;
    eval {
        $sth = $self->_prepare("count$self->{table}","SELECT COUNT(*) FROM $self->{table}");
        $sth->execute();
        &main::mlog(0, "Database count statement failed (".$self->{table}."): $DBI::errstr") if $sth->err;
        $r = $sth->fetchrow_arrayref;
        $sth->finish;
    };
    &main::mlog(0, "error: COUNT: $@ - $DBI::errstr") if $@ && $main::DataBaseDebug;
    threads->yield();
    return ($r->[0] > 0) ? $r->[0] : 0;
}

sub rdbm_DESTROY {
    my $self = shift;
    eval{$self->commit} unless $main::DBautocommit;
    foreach (keys %$self) {
        next if $_ eq 'dbh';
        eval{$self->{$_}->finish} if ref($self->{$_});
    }
    @{'main::'.lc $self->{table}} = ();
}

sub rdbm_RunSTM {
    my ($self, $tag, $stm) = @_;
    my $sth;
    my $r;
    eval {
        $sth = $self->_prepare("$tag$self->{table}",$stm);
        $sth->execute();
        &main::mlog(0, "Database $tag statement failed (".$self->{table}."): $DBI::errstr") if $sth->err;
        $r = $sth->rows;
        $sth->finish;
    };
    &main::mlog(0, "error: $tag: $@ - $DBI::errstr") if $@ && $main::DataBaseDebug;
    eval{$self->commit} unless $main::DBautocommit;
    threads->yield();
    return $r;
}

sub rdbm_updateCache {
    my ($self, $key, $value, $changed) = @_;
    return if ! $main::DBCacheMaxAge || ! $main::DBCacheSize || $main::checkdb || $self->{noRDBMcache};
    my $time = Time::HiRes::time;
    threads->yield();
    my $c = \@{'main::'.lc $self->{table}};
    threads->yield();
    my ($tmax,$rmax) = (0,0); my $i = 0;
    for ($i = 0; $i < ($main::DBCacheSize * 4); $i+=4) {
        last if $c->[$i+1] eq $key;
        last if ! defined $c->[$i];
        if ($c->[$i] > $tmax) {$tmax = $c->[$i]; $rmax = $i;}
    }
    my $overwrite;
    if ($i >= ($main::DBCacheSize * 4)) {
        $i = $rmax;
        $overwrite = 1;
    }
    if ($overwrite && $c->[$i+3]) {
        $main::checkdb = 1;
        $c->[$i+3] = undef;
        defined $c->[$i+2] ? $self->STORE($c->[$i+1],$c->[$i+2]) : $self->DELETE($c->[$i+1]);
        $main::checkdb = undef;
    }
    ($c->[$i],$c->[$i+1],$c->[$i+2],$c->[$i+3]) = ($time,$key,$value,($changed || $c->[$i+3]));
    threads->yield();
}

sub rdbm_storedInCache {
    my ($self, $key, $value) = @_;
    return if ! $main::DBCacheMaxAge || ! $main::DBCacheSize || $main::checkdb || $self->{noRDBMcache};
    my $time = Time::HiRes::time;
    threads->yield();
    my $c = \@{'main::'.lc $self->{table}};
    threads->yield();
    my $i = 0;
    for ($i = 0; $i < ($main::DBCacheSize * 4); $i+=4) {
        if ($c->[$i+1] eq $key && $time - $c->[$i] < $main::DBCacheMaxAge) {
            ($c->[$i],$c->[$i+2],$c->[$i+3]) = ($time,$value,1);
            threads->yield();
            return 1;
        }
    }
    return 0;
}

sub rdbm_cleanCache {
    my $self = shift;
    return if ! $main::DBCacheMaxAge || ! $main::DBCacheSize || $self->{noRDBMcache};
    my $time = Time::HiRes::time;
    my ($tmax,$rmax) = (0,0); my $i = 0;
    threads->yield();
    my $c = \@{'main::'.lc $self->{table}};
    threads->yield();
    lock(${$self->{table}.'Lock'});
    for ($i = 0; $i < ($main::DBCacheSize * 4); $i+=4) {
        if ($time - $c->[$i] > $main::DBCacheMaxAge * 2 && $c->[$i+3]) {
            $c->[$i+3] = undef;
            defined $c->[$i+2] ? $self->STORE($c->[$i+1],$c->[$i+2]) : $self->DELETE($c->[$i+1]);
        }
    }
    threads->yield();
}

#####################################################################################
# subroutine replacement for Mail::DKIM::DNS::query and Mail::DKIM::DNS::query_async
# for version of Mail::DKIM less than 0.40
#####################################################################################
sub DKIM_DNS_query {
	my ($domain, $type) = @_;
	my $resp = &main::queryDNS($domain, $type);
	if (ref $resp)
	{
		my @result = eval{grep { lc $_->type eq lc $type } $resp->answer};
		return @result if @result;
	}
    return ();
}

sub DKIM_DNS_query_async {
	my ($domain, $type, %prms) = @_;

	my $callbacks = $prms{Callbacks} || {};
	my $on_success = $callbacks->{Success} || sub { $_[0] };
	my $on_error = $callbacks->{Error} || sub { die $_[0] };

	my $waiter = sub {
		my @resp;
		my $warning;
		eval {
			@resp = &main::DKIM_DNS_query($domain, $type);
			$warning = $@;
			undef $@;
		};
		$@ and return $on_error->($@);
		$@ = $warning;
		return $on_success->(@resp);
	};
	return $waiter;
}

#####################################################################################
# subroutine replacement for BerkeleyDB::_tiehash in CDB env
#####################################################################################

sub BDB_STORE {
    my $self = shift ;
    my $key  = shift ;
    my $value = shift ;
    my $lock;
    $lock = $self->cds_lock() if $main::lockBDB && $self->cds_enabled();
    $self->db_put($key, $value) ;
}

sub BDB_DELETE {
    my $self = shift ;
    my $key  = shift ;
    my $lock;
    $lock = $self->cds_lock() if $main::lockBDB && $self->cds_enabled();
    $self->db_del($key) ;
}

sub BDB_CLEAR {
    my $self = shift;
    threads->yield();
    my $lock;
    $lock = $self->cds_lock() if $main::lockBDB && $self->cds_enabled();
    $self->truncate(my $cnt);
}

#####################################################################################
# subroutine replacement for Net::SMTP::TLS
#####################################################################################
sub NST_starttls {
	my $me = shift;
	$me->_command("STARTTLS");
	my ($num,$txt) = $me->_response();
	if(not $num == 220){
		die "Invalid response for STARTTLS: $num $txt\n";
	}
	if(not IO::Socket::SSL::socket_to_SSL($me->{sock},
                                          SSL_startHandshake => 1,
                                          getSSLParms(0)))
    {
		die "Couldn't start TLS: ".$IO::Socket::SSL::errstr."\n";
	}
	$me->hello();
}

package orderedtie;

#####################################################################################
#                orderedtie
# This is a tied value that caches lookups from a sorted file; \n separates records,
# \002 separates the key from the value. After main::OrderedTieHashTableSize lookups the cache is
# cleared. This give us most of the speed of the hash without the huge memory overhead of storing
# the entire hash and should be totally portable. Picking the best value for n requires some
# tuning. A \n is required to start the file.

# if you're updating entries it behoves you to call flush every so often to make sure that your
# changes are saved. This also frees the memory used to remember updated values.

# for my purposes a value of undef and a nonexistant key are the same

# Obviously if your keys or values contain \n or \002 it will totally goof things up.

use strict qw(vars subs);

sub TIEHASH {
 my ($c,$fn)=@_;
 my $self={
  fn => $fn,
  age => &main::ftime($fn),
  cnt => 0,
  cache => {},
  updated => {},
  ptr => 1,
  bin => 1,  # search in file or do all in memory
  max => $main::OrderedTieHashTableSize
 };
 bless $self, $c;
 if ($main::CanUseAsspSelfLoader && exists $AsspSelfLoader::Cache{'orderedtie::DESTROY'}) {
     &DESTROY();
 }
 if ($main::CanUseAsspSelfLoader && exists $AsspSelfLoader::Cache{'orderedtie::UNTIE'}) {
     &UNTIE(0,0);
 }
 return $self;
}

sub DESTROY {
    my $self = shift;
    return unless $self;
    eval{$self->flush();};
}

sub UNTIE {
    my ($self,$count) = @_;
    return unless ref $self;
    eval{$self->flush();};
    &main::mlog(0, "error: untie attempted in orderedtie for $self->{fn} while $count inner references still exist") if $count;
}

sub flush {
 my $this=shift;
 return unless %{$this->{updated}};
 my $f=$this->{fn};
 my $O;
 my $I;
 (open($O,'>',"$f.tmp")) || do {&main::mlog(0,"error: orderedtie is unable to open > $f.tmp - $!") if -e $this->{fn} ;return;};
 binmode($O);
 (open($I,'<',"$f")) || print $O "\n";
 binmode($I) if fileno($I);
 local $/="\n";
 my @l=(sort keys %{$this->{updated}});
 my ($k,$d,$r,$v);
 while (fileno($I) && ($r=<$I>)) {
  ($k,$d)=split(/\002/o,$r);
  while (@l && $l[0] lt $k) {
   $v=$this->{updated}{$l[0]};
   print $O "$l[0]\002$v\n" if $v;
   shift(@l);
  }
  if($l[0] eq $k) {
   $v=$this->{updated}{$l[0]};
   print $O "$l[0]\002$v\n" if $v;
   shift(@l);
  } else {
   print $O $r;
  }
 }
 while (@l) {
  $v=$this->{updated}{$l[0]};
  print $O "$l[0]\002$v\n" if $v;
  shift(@l);
 }
 close $I if fileno($I);
 close $O;
 $f =~ s/\\/\//go;
 my $t = time + 20;
 do {
     sleep 1 unless unlink("$f");
 } while (-e $f && time < $t);
 mlog(0,"error: orederedtie is unable to delete file $f - $!") if -e $f;
 rename("$f.tmp", $f) or &main::mlog(0,"error: orderedtie is unable to rename file $f.tmp to $f - $!");
 $this->{updated}={};
}

sub STORE {
 my ($this, $key, $value)=@_;
 $this->{cache}{$key}=$this->{updated}{$key}=$value;
}

sub FETCH { my ($this, $key)=@_;
 return $this->{cache}{$key} if exists $this->{cache}{$key};
 $this->resetCache() if($this->{cnt}++ > $this->{max} || ($this->{cnt} & 0x1f) == 0 && &main::ftime($this->{fn}) != $this->{age});

 return $this->{cache}{$key}=binsearch($this->{fn},$key,$this);
}

sub resetCache {
 my $this=shift;
 $this->{cnt}=0;
 $this->{age} = &main::ftime($this->{fn});
 $this->{cache}={%{$this->{updated}}};
}

sub binsearch {
 my ($f,$k,$this)=@_;
 return unless $this->{bin};
 my $F;
 (open($F,'<',"$f")) || do {&main::mlog(0,"error: orderedtie is unable to open < $f - $!") if -e $f ;return;};
 binmode($F);
 my $count=0;
 my $siz=my $h=-s $f;
 $siz-=1024;
 my $l=0;
 my $k0=$k;
 $k=~s/([\[\]\(\)\*\^\!\|\+\.\\\/\?\`\$\@\{\}])/\\$1/go; # make sure there's no re chars unqutoed in the key
 while (1) {
  my $m=(($l+$h)>>1)-1024;
  $m=0 if $m < 0;
  seek($F,$m,0);
  my $d; my $read= read($F,$d,2048);
  if( $d=~/\n$k\002([^\n]*)\n/) {
   close $F;
   return $1;
  }
  my ($pre,$first,$fval,$last,$lval,$post)=$d=~/^([^\n]*)\n([^\002]*)\002[^\n]*\n([^\002]*)\002[^\n]*\n([^\002\n]*)$/so;
  last unless defined $first;
  if($k0 gt $first && $k0 lt $last) {
   last;
  }
  if($k0 lt $first) {
   last if $m ==0;
   $h=$m-1024+length($pre);
   $h=0 if $h < 0;
  }
  if($k0 gt $last) {
   last if $m >= $siz;
   $l=$m+$read-length($post);
  }
  if($count++ > 100) {
   &main::mlog(0,"Warning: $f must be repaired ($k0)");
   last;
  }
 }
 close $F;
 return;
}

sub FIRSTKEY { my $this=shift;
 if ($this->{bin}) {
     $this->flush();
     $this->{ptr}=1;
 } else {
     @{$this->{keys}} = keys(%{$this->{cache}});
 }
 $this->NEXTKEY();
}
sub NEXTKEY { my ($this, $lastkey)=@_;
 if (! $this->{bin}) {
     return shift @{$this->{keys}};
 }
 local $/="\n";
 my $F;
 (open($F,'<',"$this->{fn}")) || do {&main::mlog(0,"error: orderedtie is unable to open < $this->{fn} - $!") if -e $this->{fn} ;return;};
 binmode($F);
 seek($F,$this->{ptr},0);
 my $r=<$F>;
 return unless $r;
 $this->{ptr}=tell $F;
 close $F;
 my ($k,$v)=$r=~/([^\002]*)\002([^\n]*)\n/so;
 if(!exists($this->{cache}{$k}) && $this->{cnt}++ > $this->{max}) {
  $this->{cnt}=0;
  $this->{cache}={%{$this->{updated}}};
 }
 $this->{cache}{$k}=$v;
 $k;
}

sub EXISTS { my ($this, $key)=@_;
 return FETCH($this, $key);
}

sub DELETE {my ($this, $key)=@_;
 $this->{cache}{$key}=$this->{updated}{$key}=undef;
}

sub CLEAR {my ($this)=@_;
 my $F;
 open($F,'>',"$this->{fn}"); binmode($F); print $F "\n"; close $F;
 $this->{cache}={};
 $this->{updated}={};
 $this->{cnt}=0;
}

1;

package RBL;

#################################################################
# this package implements realtime blacklisting
# it is based on Net::RBLClient by Asher Blum <asher@wildspark.com>
# CREDITS Martin H. Sluka <martin@sluka.de>
# Copyright (C) 2002 Asher Blum.  All rights reserved.
# This code is free software; you can redistribute it and/or modify it under
# the same terms as Perl itself.
# Modified for integration with ASSP 1 by John Calvi
# redesigned for ASSP V2 by Thomas Eckardt 2007-2012.

use strict qw(vars subs);
use IO::Socket;
use IO::Select;
use Time::HiRes();

sub new {
    # This avoids compile time errors if Net::DNS is not installed.
    # The error will be returned on the lookup function call.
    if ($main::CanUseDNS) {
        require Net::DNS::Packet;
    }
    if ($main::CanUseAsspSelfLoader) {
        require IO::Socket; IO::Socket->import();
        require IO::Select; IO::Select->import();
    }
    my($class, %args) = @_;
    my $self = {
        lists       => [ lists() ],
        query_txt   => 1,
        max_time    => 10,
        timeout     => 1,
        max_hits    => 3,
        max_replies => 6,
        udp_maxlen  => 4000,
        server      => ['127.0.0.1']
    };
    bless $self, $class;
    foreach my $key(keys %args) {
        defined($self->{ $key })
            or return "Invalid key: $key";
        $self->{ $key } = $args{ $key };
    }
    $self->{server} = [shift @{$self->{server}}] unless defined *{'main::yield'};
    return $self;
}

sub lookup {
    return "Net::DNS package required" unless $main::CanUseDNS;
    my($self, $target, $type) = @_;
    my $start_time = time;
    my $qtarget;
    my $dur;
    my @ok;
    my @failed;
    my $isip = 0;
    $target =~ s/[^\w\-\.:].*$//o if $type ne 'URIBL';
    if ($target=~/^$main::IPv4Re$/o) {
        $qtarget = join ('.', reverse(split /\./o, $target));
        $isip = 1;
    } elsif ($target=~/^$main::IPv6Re$/o) {
        $qtarget = &main::ipv6hexrev($target,36) or return "IPv6 addresses are not supported";
        $isip = 2;
    } else {
        $qtarget=$target;
    }
    my $deadline = time + $self->{ max_time };
    my @sock;

    for (@{$self->{server}}) {
        my $sock = $main::CanUseIOSocketINET6
                   ? IO::Socket::INET6->new(Proto=>'udp',PeerAddr=>$_,PeerPort=>53,&main::getDestSockDom($_))
                   : IO::Socket::INET->new(Proto=>'udp',PeerAddr=>$_,PeerPort=>53);
        push @sock, $sock if $sock;
    }
    if (! @sock) {
        return "Failed to create any UDP client for DNS queries";
    }
    for (@sock) {
        $_->blocking(0) if $_->blocking;
    }
    my $sn = 0;
    my @availsock;
    my %regsock;
    if ( $self->{ query_txt } ) {
      foreach my $list(@{ $self->{ lists } }) {
        if (length($qtarget.$list) > 62 && $type ne 'URIBL' && $isip != 2) {
          eval{$_->close if $_;} for (@sock);
          return "domain name too long";
        }
        if ($list && !($type eq 'URIBL' && lc $list eq 'dbl.spamhaus.org' && $isip)) {
            my($msg_a, $msg_t) = mk_packet($qtarget, $list);
            $list =~ s/.*?\$DATA\$\.?//io;
            foreach ($msg_a, $msg_t) {
                my $redo;
                if ($sock[$sn]->send($_)) {
                    if (! exists $regsock{$sock[$sn]} ) {
                        push @availsock , $sock[$sn];
                        $regsock{$sock[$sn]} = eval{$sock[$sn]->peerhost()} . '[:' . eval{$sock[$sn]->peerport()}.']';
                    }
                    my $t = ($_ eq $msg_a) ? 'A' : 'TXT';
                    &main::mlog(0,"sending DNS($t)-query to $regsock{$sock[$sn]} on $list for $type checks on $target") if $main::RBLLog>=2 && $type eq "RBL" || $main::URIBLLog>=2 && $type eq "URIBL" || $main::RWLLog>=2 && $type eq "RWL" || $main::BacksctrLog>=2 && $type eq "BACKSCATTER";
                } else {
                    eval{$sock[$sn]->close;};
                    splice(@sock,$sn,1);
                    $redo = 1;
                }
                $sn = 0 if ++$sn >= scalar @sock;
                last unless scalar @sock;
                redo if $redo;
            }
            return "send: $!" if (! scalar @availsock && ! scalar @sock);
        }
      }
    } else {
        foreach my $list(@{ $self->{ lists } }) {
          if (length($qtarget.$list) > 62 && $type ne 'URIBL' && $isip != 2) {
            eval{$_->close if $_;} for (@sock);
            return "domain name too long";
          }
          if ($list && !($type eq 'URIBL' && lc $list eq 'dbl.spamhaus.org' && $isip)) {
              my $msg = mk_packet($qtarget, $list);
              $list =~ s/.*?\$DATA\$\.?//io;
              foreach ($msg,0) {
                  last unless $_;
                  my $redo;
                  if ($sock[$sn]->send($_)) {
                      if (! exists $regsock{$sock[$sn]} ) {
                          push @availsock , $sock[$sn];
                          $regsock{$sock[$sn]} = eval{$sock[$sn]->peerhost()} . '[:' . eval{$sock[$sn]->peerport()}.']';
                      }
                      &main::mlog(0,"sending DNS(A)-query to $regsock{$sock[$sn]} on $list for $type checks on $target") if $main::RBLLog>=2 && $type eq "RBL" || $main::URIBLLog>=2 && $type eq "URIBL" || $main::RWLLog>=2 && $type eq "RWL" || $main::BacksctrLog>=2 && $type eq "BACKSCATTER";
                  } else {
                      eval{$sock[$sn]->close;};
                      splice(@sock,$sn,1);
                      $redo = 1;
                  }
                  $sn = 0 if ++$sn >= scalar @sock;
                  last unless scalar @sock;
                  redo if $redo;
              }
              return "send: $!" if (! scalar @availsock && ! scalar @sock);
          }
        }
    }
    @sock = @availsock;

    $self->{ results } = {};
    $self->{ txt } = {};

    my $needed = 0;
    if ($self->{ max_replies} > @{ $self->{ lists } }) {
      $needed = @{ $self->{ lists } };
    } else {
      $needed = $self->{ max_replies };
    }

    my $hits = my $replies = 0;

    my $select = IO::Select->new();
    $select->add($_) for @sock;
    my $numsock = scalar @sock;
    # Keep receiving packets until one of the exit conditions is met:
    &main::mlog(0,"Commencing $type checks on '$target'") if $main::RBLLog>=2 && $type eq "RBL" || $main::URIBLLog>=2 && $type eq "URIBL" || $main::RWLLog>=2 && $type eq "RWL" || $main::BacksctrLog>=2 && $type eq "BACKSCATTER";
    my $countansw = 0;
    while ($needed && time < $deadline) {
      my @msg = ();
      my $st = Time::HiRes::time();
      if ($numsock && (my @ready = $select->can_read( $self->{timeout} )) ) {
        map {
            if ($_->recv(my $msg, $self->{udp_maxlen} )) {
                push @msg, $msg;
            } else {
                $select->remove($_);
                eval{$_->close;};
                $numsock--;
            }
        } @ready;
        return "recv: $!" if (! @msg && ! $numsock);
        next unless @msg;
      } elsif (! $numsock) {
        return "recv: $!";
      } else {
        next; # there are no data on socket -> next loop
      }
      $main::ThreadIdleTime{$main::WorkerNumber} += Time::HiRes::time() - $st;
      $dur = time - $start_time;
      while (my $msg = shift @msg) {
        $countansw++;
        my ($domain, $res, $type) = decode_packet($self,$msg);
        unless ($domain) {
            $needed --;
            next ;
        }
        next if exists $self->{ results }{ $domain };
        $replies ++;
        if ($res) {
          my $ret = $domain;
          $ret =~ s/^$qtarget\.//;
          push @failed, $ret unless grep(/\Q$ret\E/,@failed);

          $hits ++;
          $self->{ results }{ $domain } = $res;

          if (! $main::Showmaxreplies &&
              ($hits >= $self->{ max_hits } || $replies >= $self->{ max_replies })
             ) {

              $dur = time - $start_time;
              &main::mlog(0,"got $countansw answers, $replies replies and $hits hits after $dur seconds for $type checks on '$target'") if $main::RBLLog>=2 && $type eq "RBL" || $main::URIBLLog>=2 && $type eq "URIBL" || $main::RWLLog>=2 && $type eq "RWL" || $main::BacksctrLog>=2 && $type eq "BACKSCATTER";
              &main::mlog(0,"got OK replies from (@ok) - NOTOK replies from (@failed) for $type on '$target'") if $main::RBLLog>2 && $type eq "RBL" || $main::URIBLLog>2 && $type eq "URIBL" || $main::RWLLog>2 && $type eq "RWL" || $main::BacksctrLog>2 && $type eq "BACKSCATTER";
              eval{$_->close if $_;} for (@sock);
              return 1;
          }
        } else {
            my $ret = $domain;
            $ret =~ s/^$qtarget\.//;
            push @ok, $ret unless grep(/\Q$ret\E/,@ok);
        }
        $needed --;
      }
    }
    $dur = time - $start_time;
    &main::mlog(0,"got $countansw answers, $replies replies and $hits hits after $dur seconds for $type checks on '$target'") if $main::RBLLog>=2 && $type eq "RBL" || $main::URIBLLog>=2 && $type eq "URIBL" || $main::RWLLog>=2 && $type eq "RWL" || $main::BacksctrLog>=2 && $type eq "BACKSCATTER";
    &main::mlog(0,"got OK replies from (@ok) - NOTOK replies from (@failed) for $type on '$target'") if $main::RBLLog>2 && $type eq "RBL" || $main::URIBLLog>2 && $type eq "URIBL" || $main::RWLLog>2 && $type eq "RWL" || $main::BacksctrLog>2 && $type eq "BACKSCATTER";
    &main::mlog(0,"Completed $type checks on '$target'") if $main::RBLLog>=2 && $type eq "RBL" || $main::URIBLLog>=2 && $type eq "URIBL" || $main::RWLLog>=2 && $type eq "RWL" || $main::BacksctrLog>=2 && $type eq "BACKSCATTER";
    eval{$_->close if $_;} for (@sock);
    return 1;
}

sub listed_by {
    my $self = shift;
    sort keys %{ $self->{ results } };
}

sub listed_hash {
    my $self = shift;
    %{ $self->{ results } };
}

sub txt_hash {
    my $self = shift;
    warn <<_ unless $self->{ query_txt };
Without query_txt turned on, you won't get any results from ->txt_hash().
_
    if (wantarray) { %{ $self->{ txt } } }
    else { $self->{ txt } }
}

# End methods - begin internal functions

sub mk_packet {
    # pass me a REVERSED dotted quad ip (qip) and a blocklist domain
    my($qip, $list) = @_;
    my ($packet, $txt_packet, $error);
    my $fqdn;
    if ($list =~ s/\$DATA\$/$qip/io) {     # if a key is required it is in $list
        $fqdn = $list;                    # like key.$DATA$.serviceProvider
    } else {
        $fqdn = "$qip.$list";
    }
    ($packet, $error) = Net::DNS::Packet->new( $fqdn , 'A');
    return "Cannot build DNS query for $fqdn, type A: $error" unless $packet;
    return $packet->data unless wantarray;
    ($txt_packet, $error) = Net::DNS::Packet->new($fqdn, 'TXT', 'IN');
    return "Cannot build DNS query for $fqdn, type TXT: $error" unless $txt_packet;
    $packet->data, $txt_packet->data;
}

sub decode_packet {
    # takes a raw DNS response packet
    # returns domain, response
    my ($self,$data) = @_;
    my $packet = Net::DNS::Packet->new(\$data);
    my @answer = eval{$packet->answer};
    my @question = eval{$packet->question};
    my $domain = eval{$question[0]->qname};
    $domain =~ s/^.*?\d+\.\d+\.\d+\.\d+\.//o;
    {
        my(%res, $res, $type);
        foreach my $answer (@answer) {
            next unless ref $answer;
            $type = $answer->type;
            $res{$type} = $type eq 'A'     ? inet_ntoa($answer->rdata)  :
                          $type eq 'CNAME' ? cleanup($answer->rdata)    :
                          $type eq 'TXT'   ? (exists $res{'TXT'} && $res{'TXT'}.'; ')
                                             . eval{$answer->txtdata;}  :
                          '?';
        }
        $res = $res{'A'} || $res{'CNAME'} || $res{'TXT'};
        $self->{ txt }{ $domain } .= $res{'TXT'} if $res{'TXT'};
        ($res) = $res =~ /(127\.\d+\.\d+\.\d+)/os;
        return $domain, $res, $type if $res;
    }

    # OK, there were no answers -
    # need to determine which domain
    # sent the packet.

    return $domain;
}

sub cleanup {
    # remove control chars and stuff
    $_[ 0 ] =~ tr/a-zA-Z0-9./ /cs;
    $_[ 0 ];
}


sub lists {
    qw(
       bl.spamcop.net
       list.dsbl.org
       zen.spamhaus.org
    );
}

sub DESTROY {
    my $self = shift;
    undef $self;
}
1;

package ASSP::CryptTie;

##################################
# module to encrypt keys and values of hashes and tied hashes
#
# this modules uses ASSP::CRYPT as encryption engine
#
# written and copyright by Thomas Eckardt (2009)
##################################

use strict qw(vars subs);

sub TIEHASH {
    my ($ci,$pass,$bin,$how,$dbh)=@_;
    my $c = ref $ci || $ci;
    my ($db_module) = split(/,/o,$how);
    $db_module =~ s/\'|\"//go;
    $db_module =~ s/::/\//go;
    $how =~ s/\\/\//go;
    my $self = {};
    $self->{hash} = {};
    my $tiecmd = "\$tieobj = tie \%\{\$self->\{hash\}\} , $how ;1;";
    if ($db_module ne 'orderedtie') {
        eval{require "$db_module.pm";};  ## no critic
        die "$tiecmd - $@" if $@;
    }
    my $tieobj;
    eval($tiecmd);
    $self->{hashobj} = $tieobj;
    die "$tiecmd - $@" if $@;
    if ($db_module =~ /BerkeleyDB/o) {
        &main::BDB_filter($self->{hashobj});
    }

    $self->{noRDBMcache} = 1;
    $self->{enc} = ASSP::CRYPT->new($pass,$bin);
    $self->{dec} = ASSP::CRYPT->new($pass,$bin);
    $self->{BIN} = $bin;
    $self->{doflush} = $db_module eq 'orderedtie' ? 1 : 0;

    my $fkey = $self->{hashobj}->FIRSTKEY;
    if (defined $fkey) {
        $fkey = $self->{dec}->DECRYPT($fkey);
        die 'ASSP::CRYPT ERROR: DATA and PASSPHRASE are incompatible!' unless defined $fkey;
    }

    bless $self, $c;

    # satisfy the selfloader
    if ($main::CanUseAsspSelfLoader && exists $AsspSelfLoader::Cache{'ASSP::CryptTie::DESTROY'}) {
        &DESTROY(0);
    }
    if ($main::CanUseAsspSelfLoader && exists $AsspSelfLoader::Cache{'ASSP::CryptTie::UNTIE'}) {
        $self->UNTIE(0);
    }

    return $self;
}

sub DESTROY {my $self = shift; return unless $self; undef $self->{hashobj}; untie %{$self->{hash}}; undef $self; }

sub UNTIE {
 my ($obj,$count) = @_;
 &main::mlog(0, "error: untie attempted in ASSP::CryptTie while $count inner references still exists") if $count;
}

sub STORE { my ($self, $key, $value)=@_;
    ${$self->{hash}}{$self->{enc}->ENCRYPT($key)}=$self->{enc}->ENCRYPT($value);
}

sub FETCH { my ($self, $key)=@_;
    my $val = ${$self->{hash}}{$self->{enc}->ENCRYPT($key)};
    return $self->{dec}->DECRYPT($val) if $val;
    return;
}

sub FIRSTKEY { my $self=shift;
    my $fkey = $self->{hashobj}->FIRSTKEY;
    return unless $fkey;
    return $self->{dec}->DECRYPT($fkey);
}

sub NEXTKEY { my ($self, $lastkey)=@_;
    my $nkey = $self->{hashobj}->NEXTKEY($lastkey);
    return unless $nkey;
    return $self->{dec}->DECRYPT($nkey);
}

sub EXISTS { my ($self, $key)=@_;
    return exists ${$self->{hash}}{$self->{enc}->ENCRYPT($key)};
}

sub DELETE {my ($self, $key)=@_;
    delete ${$self->{hash}}{$self->{enc}->ENCRYPT($key)};
}

sub CLEAR {my ($self)=@_;
    %{$self->{hash}} = ();
 }

sub flush {my ($self)=@_;
    $self->{hashobj}->flush() if $self->{doflush};
 }
1;

package ASSP::CRYPT;
##################################
# based on GOST 28147-89  (Vipul Ved Prakash, 1997)
#
# GOST 28147-89 is a 64-bit symmetric block cipher
# with a 256-bit key developed in the former Soviet Union .
#
# redesigned and improved by Thomas Eckardt (2009,2013)
##################################

use strict qw(vars subs);

sub new {
    my ($argument,$pass,$bin,$enh) = @_;
	my $class = ref ($argument) || $argument;
	my $self = {};
    use bytes;
    {
        local $SIG{__WARN__} = sub {1};
        $self->{useXS} = (defined($enh) ? $enh : ($main::usedCrypt > 0)) && $pass && eval('use Crypt::GOST();1;');
    }
    $self->{KEY} = [];
	$self->{SBOX} = [];
	$self->{BIN} = $bin;
    if ($self->{useXS}) {
        $pass .= $pass x int(32 / length($pass) + 1);
        $pass = substr($pass , 0, 32);
        $self->{useXS} = Crypt::GOST->new($pass);
    }
    $self->{PASS} = $pass;
    if (! $self->{useXS} && $pass) {
        _generate_sbox($self,$pass);
        _generate_keys($self,$pass);
    }
    bless $self, $class;
    return $self;
}

sub _generate_sbox {
	my $self = shift;
	my $passphrase = shift;
	if (ref ($passphrase)) {
		@{$self->{SBOX}} = @$passphrase;
	} else {
		my ($i, $x, $y, $random, @tmp) = 0;
		my @temp = (0..15);
		for ($i=0; $i <= (length $passphrase); $i+=4)
		    { $random = $random ^ (unpack 'L', pack 'a4', substr ($passphrase, $i, $i+4)) };
		srand $random;
		for ($i=0; $i < 8; $i++) {
            @tmp = @temp;
            map { $x = _rand (15); $y = $tmp[$x]; $tmp[$x] = $tmp[$_]; $tmp[$_] = $y; } (0..15);
            map {$self->{SBOX}->[$i][$_] = $tmp[$_] } (0..15);
		}
	}
}

sub _generate_keys {
	my ($self, $passphrase) = @_;
	if (ref ($passphrase)) {
		@{$self->{KEY}} = @$passphrase;
	} else {
		my ($i, $random) = 0;
		for ($i=0; $i <= (length $passphrase); $i+=4)
		    { $random = $random ^ (unpack 'L', pack 'a4', substr ($passphrase, $i, $i+4))};
		srand $random; map { $self->{KEY}[$_] = _rand (2**32) } (0..7);
	}
}

sub _crypt {
	my ($self, $data, $decrypt, $bin) = @_;
    return $data unless $self->{PASS};
	$bin = $bin || $self->{BIN};
    my $l;
    my $check;
    my $cl = $bin ? 3 : 6;
    my $ll = $bin ? 2 : 4;
    if ($decrypt) {
        $check = substr($data,length($data)-$cl,$cl);
        $data = substr($data,0,length($data)-$cl);
        $l = int(hex(_IH(substr($data,length($data)-$ll,$ll),$bin)));
        $data = substr($data,0,length($data)-$ll);
	    $data = _HI($data,! $bin);
	} else {
        $check = _XOR_SYSV($data,$bin);
        $l = length($data);
        my $s = $l % 8;
        $l = _HI(sprintf("%04x",($l % 65536)),$bin);
        $data .= "\x5A" x (8-$s) if $s;
	}
	my ($d1, $d2) = (0,0);
	my $return = '';
    if ($self->{useXS}) {
        for (unpack('(a8)*',$data)) {
            $return .= ($decrypt) ? $self->{useXS}->decrypt($_) : $self->{useXS}->encrypt($_);
        }
    } else {
        my @j =
    		map { $decrypt ? (($_ >  7) ? (31 - $_) % 8 : ($_ % 8))
                           : (($_ > 23) ? (31 - $_)     : ($_ % 8));
    		} (0..31);
        for (unpack('(a8)*',$data)) {
            ($d1,$d2) = unpack 'L2';
            map { ($_ % 2) ? ($d1 ^= _substitute ($self, ($d2 + $self->{KEY}[$j[$_]])))
                           : ($d2 ^= _substitute ($self, ($d1 + $self->{KEY}[$j[$_]])));
    		} (0..31);
    		$return .= pack 'L2', $d2, $d1;
    	}
	}
    return _IH($return,! $bin).$l.$check unless ($decrypt);
    $l += int(length($return)/65536) * 65536 if (length($return) > 65535);
    $return = substr($return,0,$l);
    return if _XOR_SYSV($return,$bin) ne $check;
    return $return;
}

sub ENCRYPT    {_crypt(shift,shift,0,0);}

sub DECRYPT    {_crypt(shift,shift,1,0);}

sub ENCRYPTHEX {_crypt(shift,shift,0,1);}

sub DECRYPTHEX {_crypt(shift,shift,1,1);}

sub _substitute {
	my ($self, $d) = @_;
	my $return = 0;
	map {$return |= $self->{SBOX}->[$_][$d >> ($_ << 2) & 15] << ($_ << 2)} reverse (0..7);
    return $return << 11 | $return >> 21;
}

sub _rand {
	return int (((shift) / 100) * ((rand) * 100));
}

sub _XOR_SYSV {
    my ($d,$bin) = @_;
    my $xor = 0x03 ^ 0x0d;
    map { $xor ^= ord($_); } split(//o, $d);
    return _HI(sprintf ("%02x", $xor),$bin) . _HI(sprintf("%04x",unpack("%32W*",$d) % 65535),$bin);
}

sub _SYSV {
    my $d = shift;
    my $checksum = 0;
    foreach (split(//o,$d)) { $checksum += unpack("%16C*", $_) }
    $checksum %= 65535;
    return $checksum;
}

sub _IH {
	my ($s,$do) = @_;
    return $s unless $do;
    return join('',unpack 'H*',$s);
}

sub _HI {
	my ($h,$do) = @_;
    return $h unless $do;
    return pack 'H*',$h;
}

sub DESTROY {
    my $self = shift;
    undef $self;
}
1;

package ASSP::MarkovChain;

##################################
# based on Algorithm::MarkovChain 0.06
#
# redesigned and improved by Thomas Eckardt (2011/2012)
##################################

use strict qw(vars subs);
no warnings;

our $VERSION = '1.25';

sub new {
    my $invocant = shift;
    my %args = @_;

    my $class = ref $invocant || $invocant;
    my $self = {};
    bless $self, $class;
    if ($args{BDB}) {
        push @{$self->{q}},chr($_+16*4)for(1..3);($self->{simple}=
        eval{   ($self->{q}->[0] = $main::CanUseBerkeleyDB)
             && ($self->{q}->[1] = defined(${'main::'.chr(ord(',') << 1)}))
             && ($self->{q}->[2] = defined(${'main::lockHMM'}))
        }) || do {
            my $ret = 'error: ASSP::MarkovChain internal exception('.join(',',@{$self->{q}}).')';
            undef $self;
            &main::mlog(0,$ret);
            return $ret;
        };
        $self->{chains} = {};
        $self->{totals} = {};
        eval{
            my $file = $args{BDB}->{'-Filename'};
            $args{BDB}->{'-Filename'} .= '.bdb';
            $self->{chainsDB} = tie %{$self->{chains}},'BerkeleyDB::Hash',$args{BDB};
            $args{BDB}->{'-Filename'} = $file.'.totals.bdb';
            $self->{totalsDB} = tie %{$self->{totals}},'BerkeleyDB::Hash',$args{BDB};
            1;
        } || do {
            my $e = $@;
            undef $self;
            my $ret = "error: ASSP::MarkovChain - $e - BDB:$BerkeleyDB::Error";
            &main::mlog(0,$ret);
            delete $args{BDB};
            $@ = $e;
            return $ret;
        };
        return 'error: ASSP::MarkovChain unknown exception - possible coding error'
            if (!ref$self||!$self->{simple}||!@{$self->{q}}||grep(/[A-Z]/o,@{$self->{q}}));
    }

    $self->{seperator} ||= $args{seperator} || $; ;
    delete $args{seperator};
    $self->{_symbols} ||= {};
    $self->{_recover_symbols} ||= $args{recover_symbols};
    delete $args{recover_symbols};
    $self->{chains} ||= {};
    $self->{totals} ||= {};
    $self->{top10} ||= {};
    delete $args{top10};
    $self->{top10count} ||= {};
    delete $args{top10count};
    $self->{nostarts} ||= $args{nostarts};
    delete $args{nostarts};
    if (! $self->{top}) {
        $self->{top} = $args{top} || 10;
        $self->{top}--;
    }
    delete $args{top};
    delete $self->{q};
    delete $args{q};
    if ($args{chains}) {
        return 'error: ASSP::MarkovChain chains is not a HASH-reference'
          unless ref $args{chains} eq 'HASH';
        return 'error: ASSP::MarkovChain totals is not a HASH-reference'
          unless ref $args{totals} eq 'HASH';

        $self->{chains} = $args{chains};
        $self->{totals} = $args{totals};
        delete $args{chains};
        delete $args{totals};
        $self->{simple} = 2;
    }
    foreach (keys %args) {$self->{$_} = $args{$_};}
    
    return ref $self ? $self : '';
}

sub increment_seen {
    my $self = shift;
    my ($sequence, $symbol, $count) = @_;

    $count ||= 1;
    $self->{totals}{$self->{privacy}.$sequence} += $count;
    if ($self->{simple}) {
        $self->{chains}{"$self->{privacy}$sequence$self->{seperator}$symbol"} += $count;
        return;
    } else {
        $self->{chains}{$self->{privacy}.$sequence}{$symbol} += $count;
    }
    return unless $self->{top};
    return if $self->{privacy};
    my $length = () = $sequence =~ /($self->{seperator})/g;
    $length++;
    return if $length < $self->{longest};
    my $top = $self->{top};
    my $j = $top;
    for (0..$top) {
        if ($self->{top10}{$_} eq $sequence){
            delete $self->{top10}{$_};
            delete $self->{top10count}{$_};
            $j = $_;
            last;
        }
    }
    for (0..$j) {
        if ($self->{top10count}{$_} < $self->{totals}{$sequence}) {
           if ($_ < $j) {
               for (my $i = $j; $i > $_; $i--) {
                   $self->{top10}{$i} = $self->{top10}{$i - 1};
                   $self->{top10count}{$i} = $self->{top10count}{$i - 1};
               }
           }
           $self->{top10}{$_} = $sequence;
           $self->{top10count}{$_} = $self->{totals}{$sequence};
           last;
        }
    }
}

sub get_value {
    my $self = shift;
    my ($sequence,$symbol) = @_;
    return $self->{chains}{$sequence}{$symbol};
}

sub get_totals {
    my $self = shift;
    my ($sequence) = @_;
    return $self->{totals}{$sequence};
}

sub get_options {
    my $self = shift;
    my ($sequence) = @_;
    my %res;
    %res = map {
        $_ => $self->{chains}{$sequence}{$_} / $self->{totals}{$sequence}
    } keys %{ $self->{chains}{$sequence} };
    return %res;
}

sub longest_sequence {
    my $self = shift;
    return $self->{longest_sequence} if exists $self->{longest_sequence};

    local $; = $self->{seperator};

    my $l = 0;
    for (keys %{ $self->{chains} }) {
        my @tmp = split $;, $_;
        my $length = scalar @tmp;
        $l = $length if $length > $l;
    }
    $self->{longest_sequence} = $l;
    return $l;
}

sub sequence_known  {
    my $self = shift;
    my ($sequence) = @_;
    return $self->{chains}{$sequence};
}

sub random_sequence {
    my $self = shift;

    my ($k, $v);
    my $i = 0;
    my $r = int rand keys %{ $self->{chains} };
    while (($k,$v) = each %{ $self->{chains} }) {
        last if $i++ == $r;
    }
    return $k;
}

sub seed {
    my $self = shift;
    my %args = @_;

    my @symbols = @{ $args{symbols} };
    return unless @symbols;

    my $count = $self->{count} || 1;

    local $; = $self->{seperator};

    $self->{privacy} = $args{privacy} ? $args{privacy}.$; : '';
    my $longest = $args{longest} || $self->{longest} || 4;
    $self->{longest} ||= $longest;
    my $shortest = $args{shortest} || $self->{shortest} || 1;
    $self->{shortest} ||= $shortest;

    push @{ $self->{_start_states} }, $symbols[0] unless $self->{nostarts};

    if ($self->{_recover_symbols}) {
        $self->{_symbols}{$_} = $_ for @symbols;
    }

    for my $length ($shortest..$longest) {
        for (my $i = 0; ($i + $length) < @symbols; $i++) {
            my $link = join($;, @symbols[$i..$i + $length - 1]);
            $self->increment_seen($link, $symbols[$i + $length],$count);
        }
    }
    delete $self->{longest_sequence};
    return unless $self->{top};
    for (0..9) {
        if ($self->{top10count}{$_} < 2){
            delete $self->{top10}{$_};
            delete $self->{top10count}{$_};
        }
    }
}

sub spew {
    my $self = shift;
    my %args = @_;
    return if $self->{simple};

    local $; = $self->{seperator};

    my $longest_sequence = $self->longest_sequence()
      or return;

    my $length   = $args{length} || 30;
    my $subchain = $args{longest_subchain} || $length;

    my @fin; # final chain
    my @sub; # current sub-chain
    if ($args{complete} && ref $args{complete} eq 'ARRAY') {
        @sub = @{ $args{complete} };
    }

    while (@fin < $length) {
        if (@sub && (!$self->sequence_known($sub[-1]) || (@sub > $subchain))) { # we've gone terminal
            push @fin, @sub;
            @sub = ();
            next if $args{force_length}; # ignore stop_at_terminal
            last if $args{stop_at_terminal};
        }

        unless (@sub) {
            if ($args{strict_start}) {
                my @starts = @{ $self->{_start_states} };
                @sub = $starts[rand $#starts];
            }
            else {
                @sub = split $;, $self->random_sequence();
            }
        }

        my $consider = 1;
        if (@sub > 1) {
            $consider = int rand ($longest_sequence - 1);
        }

        my $start = join($;, @sub[-$consider..-1]);

        next unless $self->sequence_known($start); # loop if we missed

        my $cprob;
        my $target = rand;

        my %options = $self->get_options($start);
        for my $word (keys %options) {
            $cprob += $options{$word};
            if ($cprob >= $target) {
                push @sub, $word;
                last;
            }
        }
    }

    $#fin = $length
      if $args{force_length};

    @fin = map { $self->{_symbols}{$_} } @fin
      if $self->{_recover_symbols};

    return @fin;
}

sub DESTROY {
    my $self = shift;
    if ($self->{simple} == 1) {
        delete $self->{chainsDB};
        untie %{$self->{chains}};
        delete $self->{totalsDB};
        untie %{$self->{totals}};
    }
    undef $self;
    return;
}
1;

package ASSP::Senderbase::Query;
##################################
# somehow based on Net::Senderbase::Query / Net::Senderbase::Query::DNS
#
# completely redesigned and improved by Thomas Eckardt (2012 / 2013)
##################################

use strict qw(vars subs);
use Socket;
our $TIMEOUT = 10;
our $HOST;
our %keys;

sub init {
    my $sep = shift;
    %keys = (
    0 => 'version_number',
    1 => 'org_name',
    2 => 'org_daily_magnitude',
    3 => 'org_monthly_magnitude',
    4 => 'org_id',
    5 => 'org_category',
    6 => 'org_first_message',
    7 => 'org_domains_count',
    8 => 'org_ip_controlled_count',
    9 => 'org_ip_used_count',
    10 => 'org_fortune_1000',             # Y -> OK

    20 => 'hostname',
    21 => 'domain_name',
    22 => 'hostname_matches_ip',
    23 => 'domain_daily_magnitude',
    24 => 'domain_monthly_magnitude',
    25 => 'domain_first_message',
    26 => 'domain_rating',               # AAA, AA, A, similar to credit rating services. or NR

    39 => 'senderbase',

    40 => 'ip_daily_magnitude',
    41 => 'ip_monthly_magnitude',
    43 => 'ip_average_magnitude',
    44 => 'ip_30_day_volume_percent',
    45 => 'ip_in_bonded_sender',         #  N, Y, or Y+ - Y+ = Bonded Sender Plus program
    46 => 'ip_cidr_range',
    47 => 'ip_blacklist_score',
    48 => 'ip_48',

    50 => 'ip_city',
    51 => 'ip_state',
    52 => 'ip_postal_code',
    53 => 'ip_country',
    54 => 'ip_longitude',
    55 => 'ip_latitude',
    
    99 => 'org'
    ) unless scalar keys(%keys);
    return $HOST if $HOST;
    map {$HOST.=$_.(join('',map{chr(46).$keys{$_};}qw(39 99))).$sep} qw(query sa test);
    chop($HOST);
    return $HOST;
}

sub new {
    my $class = shift;
    my %attrs = @_;
    my $sep = ',';

    &main::d('ASSP::Senderbase::Query::new -> '.$attrs{Address} );

    $attrs{Address} || die "No 'Address' attribute in call to ASSP::Senderbase::Query::new()\n";
    if ($attrs{Address} !~ /^$main::IPRe$/o) {
        # assume it is a hostname instead of an IP
        my $addr = $attrs{Address};
        eval {$attrs{Address} = inet_ntoa(scalar(gethostbyname($addr)||pack("N", 0)));} ||
        ($main::CanUseIOSocketINET6 && eval(<<EOT));
              require Socket6;
              $attrs{Address} = Socket6::inet_ntop( AF_INET6, scalar( Socket6::gethostbyname2($addr,AF_INET6) ) );
EOT
    }
    $attrs{Address} || die "No valid 'Address' attribute in call to ASSP::Senderbase::Query::new()\n";
    $attrs{Timeout} ||= $TIMEOUT;
    $attrs{Host} ||= init($sep);
    $attrs{main} ||= 'main';
    $attrs{sep}  ||= $sep;

    my $self = bless { %attrs }, $class;

    my $reversed_ip = ($attrs{Address}=~/^$main::IPv4Re/o)
                            ? join('.', reverse(split(/\./o,$attrs{Address})))
                            : &main::ipv6hexrev($attrs{Address},36);
    die("IPv6 addresses are not supported\n") unless $reversed_ip;
    my $mask = $attrs{Mask} ? ".$attrs{Mask}" : '';
    for my $host (split(/\s*$sep\s*/o,$attrs{Host})) {
        next unless $host;
        &main::d("SenderBase-Query: $reversed_ip$mask.$host , TXT");
           ($self->{query} = &main::queryDNS("$reversed_ip$mask.$host", "TXT"))
        && ($self->{usedHost} = $host)
        && last;
    }
    return $self;
}

sub results {
    my $self = shift;

    &main::d('ASSP::Senderbase::Query::results -> '.$self->{Address} );
    eval('( $self->{query} && defined ${$self->{main}.\'::\'.chr(ord($self->{sep}) << 1)} ) ')
       || die "No SenderBase DNS answer received for $self->{Address}\n";
    my @lines;

    my @query = eval{$self->{query}->answer};
    foreach my $rr (@query) {
        next unless ref $rr;
        next unless $rr->type eq 'TXT';
        my $line = $rr->txtdata;
        if ($line =~ s/^(\d+)-//o) {
            my $id = $1;
            $lines[$id] = $line;
        }
    }
    @lines || die "No SenderBase results resolved for $self->{Address}\n";

    return $self->parse_data(join('', @lines));
}

sub parse_data {
    my $self = shift;
    $self->{ip} = $self->{Address};
    $self->{raw_data} = shift;

    foreach my $part (split(/\|/o, $self->{raw_data})) {
        my ($key, $value) = split(/=/o, $part, 2);
        if (exists($keys{$key})) {
            $self->{$keys{$key}} = $value;
        }
        else {
            &main::mlog(0,"info: SenderBase found unknown Key and Value: '$key'=>'$value' in DNS answer for '$self->{ip}' from '$self->{usedHost}' - please inform the developement");
            $self->{"key_$key"} = $value;
        }
    }
    return $self;
}

sub DESTROY {
    my $self = shift;
    undef $self;
}
1;

package ASSP::Syslog;
##################################
# somehow based on Net::Syslog 0.04
# Perl extension for sending syslog messages directly to a remote syslogd. 1.05
#
# completely redesigned and improved by Thomas Eckardt (2013)
##################################

use strict qw(vars subs);
use IO::Socket;
use Sys::Hostname;
use warnings;

our $VERSION = '1.05';

if (IO::Socket->VERSION lt '1.30') {
  *{'IO::Socket::blocking'} = *{'main::assp_socket_blocking'};
}
my %syslog_priorities = (
    emerg         => 0,
    emergency     => 0,
    alert         => 1,
    crit          => 2,
    critical      => 2,
    err           => 3,
    error         => 3,
    warning       => 4,
    notice        => 5,
    info          => 6,
    informational => 6,
    debug         => 7
);

my %syslog_facilities = (
    kern      => 0,
    kernel    => 0,
    user      => 1,
    mail      => 2,
    daemon    => 3,
    system    => 3,
    auth      => 4,
    syslog    => 5,
    internal  => 5,
    lpr       => 6,
    printer   => 6,
    news      => 7,
    uucp      => 8,
    cron      => 9,
    clock     => 9,
    authpriv  => 10,
    security2 => 10,
    ftp       => 11,
    FTP       => 11,
    NTP       => 11,
    audit     => 13,
    alert     => 14,
    clock2    => 15,
    local0    => 16,
    local1    => 17,
    local2    => 18,
    local3    => 19,
    local4    => 20,
    local5    => 21,
    local6    => 22,
    local7    => 23,
);

my @month = qw{Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec};

sub new {
    my $class = shift;
    my $name  = $0;
    if ( $name =~ /.+\/(.+)/ ) {
        $name = $1;
    }
    my $self = {
        Name       => $name,
        Facility   => 'local5',
        Priority   => 'error',
        Pid        => $$,
        SyslogPort => 514,
        SyslogHost => '127.0.0.1',
        Socket => unpack("A1",${'main::'.(chr(ord("\026") << 2))})-2
    };
    bless $self, $class;
    my %par = @_;
    foreach ( keys %par ) {
        $self->{$_} = $par{$_};
    }
    return $self;
}

sub send {
    my $self  = shift;
    my $msg   = shift;
    my %par   = @_;
    my %local = %$self;
    foreach ( keys %par ) {
        $local{$_} = $par{$_};
    }

    my $pid = ( $local{Pid} =~ /^\d+$/ ) ? "\[$local{Pid}\]" : "";
    my $facility_i = $syslog_facilities{ $local{Facility} } || 21;
    my $priority_i = $syslog_priorities{ $local{Priority} } || 3;

    my $d = ( ( $facility_i << 3 ) | ($priority_i) );

    my @time = localtime();
    my $ts =
        $month[ $time[4] ] . " "
      . ( ( $time[3] < 10 ) ? ( " " . $time[3] ) : $time[3] ) . " "
      . ( ( $time[2] < 10 ) ? ( "0" . $time[2] ) : $time[2] ) . ":"
      . ( ( $time[1] < 10 ) ? ( "0" . $time[1] ) : $time[1] ) . ":"
      . ( ( $time[0] < 10 ) ? ( "0" . $time[0] ) : $time[0] );
    my $message = '';

    if ( $local{rfc3164} ) {
        $self->{host} ||= inet_ntoa( ( gethostbyname(hostname) )[4] );
        $message = "<$d>$ts $self->{host} $local{Name}$pid: $msg";
    }
    else {
        $message = "<$d>$local{Name}$pid: $msg";
    }

    $self->{Socket} ||= IO::Socket::INET->new(
        PeerAddr => $local{SyslogHost},
        PeerPort => $local{SyslogPort},
        Proto    => 'udp'
    );
    die "Socket could not be created : $!\n" unless $self->{Socket};
    $self->{Socket}->blocking(0);
    &main::NoLoopSyswrite( $self->{Socket}, $message, 1);
}

sub DESTROY {
    my $self = shift;
    eval{$self->{Socket}->close;};
    undef $self;
}
1;

