#!/opt/local/bin/perl

#use Data::Dump qw(dump);
#use Strict;
#use Warnings;

# perl antispam smtp proxy
# (c) John Hanna, John Calvi, Robert Orso, AJ 2004 under the terms of the GPL
# ASSP founded and developed to Version 1.0.12 by John Hanna.
# ASSP web interface by AJ.
# ASSP development since 1.0.12 by John Calvi.
# LDAP implementation by Robert Orso.

use bytes; # get rid of anoying 'Malformed UTF-8' messages

$version='1.1.0';
$modversion=''; #appended in version display.

$CanUseLDAP = 0;
$CanUseLDAP = eval("use Net::LDAP; 1"); # do LDAP lookup of email addresses if possible
$CanUseAddress = 0;
$CanUseAddress = eval("use Email::Valid; 1"); # do validation of email addresses if possible

# load from command line if specified
if($ARGV[0]) {
 $base=$ARGV[0];
} else {
 # the last one is the one used if all else fail
 for ('.','assp','/opt/local/var/assp','/home/assp','/usr/assp','/assp','.') {
  $base=$_;
  last if -e "$base/assp.cfg";
 }
}

loadConfig();
sub loadConfig {
 print "loading config -- base='$base'\n";
 @Config=(
 [0,0,0,heading,'Network Setup'],
 # except for the heading lines, all config lines have the following:
 #  $name,$nicename,$size,$func,$default,$valid,$onchange,$group,$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
 # group is the heading group belonged to.
 # description is text displayed to help the user figure what to put in the entry

 [showNetworkSetup,'Show Configuration Options',0,checkbox,'','(.*)',undef,
  0,''],
 [smtpDestination,'SMTP Destination',20,textinput,'127.0.0.1:225','(\S*)',undef,
  ns,'The address:port of your message handling system\'s smtp server. For example: 127.0.0.1:125'],
 [AsAService,'As a Service',0,checkbox,'','(\S*)',undef,
  ns,'In Windows 2000 / NT you can run it as a service; requires <a href="http://www.roth.net/perl/Daemon/" target=_blank>win32::daemon</a>. Requires start from the service control panel.'],
 [AsADaemon,'As a Daemon',0,checkbox,'','(\S*)',undef,
  ns,'In Linux/BSD/Unix/OSX fork and close file handles, kinda like "perl assp.pl &amp;" but better. Requires restart.'],
 [myName,'My Name',20,textinput,'ASSP-nospam','(\S+)',undef,
  ns,'What the program calls itself in the email "received by" header. Usually ASSP-nospam.'],
 [listenPort,'Listen Port',20,textinput,'125','(\S+)',ConfigChangeMailPort,
  ns,'On what port should ASSP accept smtp connections? Normally 25. You can supply an interface:port to limit connections.'],
 [listenPort2,'Another Listen Port',20,textinput,'','(\S+)',ConfigChangeMailPort2,
  ns,'Listen for incoming SMTP requests on a second port, for those clients on the outside
  whose ISP\'s will not let them use SMTP Port 25 outside of their ISP Network, or as a
  dedicated port for VPN purposes, or whatever. You can supply an interface:port to limit connections.
  For example: 2525 or 127.0.0.2:325'],
 [proxyserver,'Proxy Server',20,textinput,'','(\S*)',undef,
  ns,'Use a Proxy Server for up/downloading greylist etc. Format - interface:port. For example: 192.168.0.1:8080'],
 [webAdminPort,'Web Admin Port',20,textinput,55555,'(\S+)',ConfigChangeAdminPort,
  ns,'On what port should ASSP listen for http connections for the web administration interface? If you change this you will need to change the URL on your browser to reconnect. You can supply an interface:port to limit connections.'],
 # I hate 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',2,passinput,'nospam4me','(.{5,})',undef,
 [webAdminPassword,'Web Admin Password',2,textinput,'nospam4me','(.{5,})',undef,
  ns,'This is your password for the administrative interface -- if you leave this default then you deserve what you get. Must be at least 5 characters long.'],
 [allowAdminConnectionsFrom,'Allow Admin Connections From*',40,textinput,'','(\S*)',ConfigMakeRe,
  ns,'This is an optional list of IP addresses from which you will accept web admin connections, separated by pipes (|). For example: 127.0.0.1|10.
  Blank means accept all connections. 127.0.0.1 means accept connections from only the localhost. Note that IP source
  addresses are very easy to spoof, so this should not be considered as a security feature.
  <span class="negative">Also note that if you make a mistake here you will likely disable your
  web admin interface and have to manually edit your configuration file to fix it.</span>'],

 [0,0,0,heading,'Relaying'],
  [showRelaying,'Show Configuration Options',0,checkbox,'','(.*)',undef,
  0,''],
  [ispip,'ISP IP',40,textinput,'','(\S*)',undef,
  rl,'Your isp\'s ip address for greylist bypassing, only the first three octets required . For example: 203.12.22<br />Blank means the actual greylist value will be looked up and used (Default Mode).'],
  [ispgreyvalue,'ISP Grey Value',10,textinput,'','(\S*)',undef,
  rl,'If you want to bypass the greylist &amp; assign your own greylist value enter it here, For eg. 0.5 (Completely grey).<br />If left blank and an address is entered above for "ISP IP" then the greylist "X" value is used.<br />Note: value should be greater than 0 and less than 1, where 0 = never spam &amp; 1 = always spam'],
 [acceptAllMail,'Accept All Mail*',40,textinput,'127.0.0.|10.|169.254.|172.16.|192.168.','(\S*)',ConfigMakeRe,
  rl,'Denies relaying for hosts besides these. These hosts also contribute to the whitelist.
  Do not leave this blank -- enter "none" for none.
  For example: 127.0.0.1|10.|169.254.|172.16.|192.168.'],
 [relayHostFile,'Relay Host File',40,textinput,'','(.*)',undef,
  rl,'Like Accept All Mail, but this is a file that contains a list of ip addresses (one per line)
   for whom you want to relay mail. This is an ABSOLUTE path, not relative to base.
   For example: /opt/local/var/assp/relayhosts'],
 [localDomains,'Local Domains*',80,textinput,'putYourDomains.com|here.org','(\S*)',ConfigMakeRe,
  rl,'Addresses in these domains are considered local delivery. Separate addresses with |.
  Include all subdomains. Don\'t leave this blank -- if you don\'t have any local domains
  then use xyzxyz. For example: put.YourDomains.com|here.org'],
 [localDomainsFile,'Local Domains File',40,textinput,'','(.*)',undef,
  rl,'Like Local Domains, but this is a file that contains a list of host names (one per line)
   for whom you want to accept mail. This is an ABSOLUTE path, not relative to base.
   For example: /opt/local/var/assp/locals'],
 [PopB4SMTPFile,'Pop Before SMTP DB File',40,textinput,'','(.*)',undef,
  rl,'If your POP before SMTP implementation uses a DB File database with records stored for valid
  dotted-quad IP addresses, you can just put the filename here. For example: /etc/mail/popip.db<br />
  If it\'s got something else, you\'ll need to edit the PopB4SMTP subroutine.'],
 [relayHost,'Relay Host',40,textinput,'','(\S*)',undef,
  rl,'Your isp\'s mail relayhost (smarthost). For example: mail.isp.com:25<br />
  If you run Exchange or Notes and you want assp to automatically update the nonspam database and
  the whitelist, then use your isp\'s smtp relay host here. Blank means no relayhost.
  You only need this if your clients don\'t deliver mail through SMTP.'],
 [relayPort,'Relay Port',20,textinput,'','(\S*)',ConfigChangeRelayPort,
  rl,'Tell your mail server to connect to this port (e.g. 127.0.0.1:225 or 127.0.0.2) as its smarthost / relayhost. For example: 225
  Note that you\'ll want to keep the relayPort protected from external access by your firewall or else
  spammers can use it to send as much spam as they want. You can supply an interface:port to limit connections.'],
 [NoRelaying,'No Relaying Error',80,textinput,'550 Relaying not allowed','(5\d\d .*)',undef,
  rl,'SMTP error message to deny relaying.'],
 [defaultLocalHost,'Default Local Host',40,textinput,'','(\S*)',undef,
  rl,'If you want users to be able to send mail to local users without giving a domain name
   then put the default local domain to use here. Blank disables this feature. For example: mydomain.com'],

[0,0,0,heading,'Validate Recipients'],
 [showValidateRecipients,'Show Configuration Options',0,checkbox,'','(.*)',undef,
  0,''],
 [NoValidRecipient,'No-Valid-User Reply',80,textinput,'550 5.1.1 User unknown','([5|2]\d\d .*)',undef,
  vr,'SMTP reply for invalid Users. Default: \'550 5.1.1 User unknown\'
  You may reply with a \'fake OK\' by entering \'250 OK - Recipient &lt;EMAILADDRESS&gt;\' or the equivalent for your mail server
  to confuse address harvesters.
  The literal EMAILADDRESS (case sensitive) is replaced by the fully qualified SMTP recipient (e.g. thisuser@yourcompany.com)'],
 [DoRFC822,'validate recipient addresses to conform with RFC 822',0,checkbox,1,'(.*)',undef,
  vr,'If activated, each recipient address is checked to conform with the email format
  defined in RFC 822. This requires an installed <a href="http://search.cpan.org/~maurice/Email-Valid-0.15/Valid.pm" target="_blank">Email::Valid</a> module in PERL.'],
 [LocalAddresses_Flat,'Local Addresses*',40,textinput,'','(\S*)',ConfigMakeRe,
  vr,'This email addresses are considered local by ASSP.
  You can list specific addresses (user@mydomain.com), addresses
   at any local domain (user), or entire local domains (@mydomain.com). Separate entries with pipes: |.
   For example: jhanna@thisdomain.com|fhanna|@sillyguys.org
   or place them in a plain ASCII list one address per line and note its path here.'],
 [DoLDAP,'Do LDAP lookup for valid recipients',0,checkbox,1,'(.*)',undef,
  vr,'Sometime it is pereferable to check recipients against an LDAP database before
  accepting the message. If you check this, be sure to fill all the other values below too!
  This requires an installed <a href="http://search.cpan.org/~gbarr/perl-ldap-0.31/lib/Net/LDAP.pod" target="_blank">NET::LDAP</a> module in PERL.'],
 [LDAPHost,'LDAP Host',60,textinput,'localhost','(\S*)',undef,
  vr,'Enter the DNS-name or IP address of the server that runs the LDAP database here.
  for example:
  localhost'],
 [LDAPLogin,'LDAP Login',60,textinput,'','(.*)',undef,
  vr,'Most LDAP servers require login and password before they allow queries. Enter the DN specification
  for a user with sufficient permissions here.
  for example:
  cn=Administrator,cn=Users,DC=yourcompany,DC=com'],
 [LDAPPassword,'LDAP Password',2,textinput,'','(.*)',undef,
  vr,'Enter the password for the specified LDAP login here.'],
 [LDAPRoot,'LDAP Root container',60,textinput,'','(.*)',undef,
  vr,'The LDAP lookup will use this container and all sub-containers to match the query.
  for example:
  DC=yourcompany,DC=com'],
 [LDAPFilter,'LDAP Filter',60,textinput,'','(\S*)',undef,
  vr,'This filter is used to query the LDAP database. This highly depends on the LDAP structure.
  The filter must return an entry if the recipient address matches with that of any user.
  The literal EMAILADDRESS (case sensitive) is replaced by the fully qualified SMTP recipient (e.g. thisuser@yourcompany.com)
  when the search is to be executed.
  for example:
  (proxyaddresses=smtp:EMAILADDRESS)'],

[0,0,0,heading,'Virus Control'],
 [showVirusControl,'Show Configuration Options',0,checkbox,'','(.*)',undef,
  0,''],
 [BlockExes,'Block Executable Attachments',0,checkbox,1,'(.*)',undef,
  vc,'Most executable attachments are email viruses. Check this box to not allow delivery of mail
  with executable attachments from non-whitelisted or local users.'],
 [BlockWLExes,'Block Whitelisted &amp; Local Exe Attachments too',0,checkbox,1,'(.*)',undef,
  vc,'Check the above box to block attachments even from whitelisted &amp; local senders.'],
 [BlockNPExes,'Block NoProcessing Exe Attachments too',0,checkbox,1,'(.*)',undef,
  vc,'Check the above box to block attachments even from noprocessing senders.'],
 [ExtensionsToBlock,'List of Blocked File Extensions',60,textinput,'exe|scr|pif|vb[es]|js|jse|ws[fh]|sh[sb]|lnk|bat|cmd|com|ht[ab]','(.*)',updateBadAttach,
  vc,'This regular expression is used to identify attachments that should be blocked. Separate entries
  with a pipe |. The dot . is assumed to preceed these, so don\'t include it. For example:
  exe|scr|pif|vb[es]|js|jse|ws[fh]|sh[sb]|lnk|bat|cmd|com|ht[ab]'],
 [AttachmentError,'Executable Attachment Error',80,textinput,'500 Executable attachments are not allowed -- Compress before mailing.','(5\d\d .*)',undef,
  vc,'SMTP error message to reject executable attachments.'],
 [AvPath,'Path to Anti-virus Databases',60,textinput,'','(.*)',undef,
  vc,'The directory path to your anti-virus databases, uses ASSP\'s base if left blank. For example: /usr/share/clamav/db'],
 [AvDbs,'List of Anti-virus Signature Database Files',60,textinput,'viruses.db,viruses.db2','(.*)',undef,
  vc,'A comma (no space!) separated list of virus signature files. Blank this out to disable virus scanning.
   For example: viruses.db,viruses.db2 NOTE: Changing this field requires restarting ASSP before changes take effect.'],
 [AvError,'Error Message to Reject Infected Email',60,textinput,'500 Mail appears infected with \'$infection\' -- disinfect and resend.','(5\d\d .*)',undef,
  vc,'SMTP error message to reject infected mail. The string $infection is replaced with the name of the detected virus. For example: 500 Mail appears infected with \'$infection\' -- disinfect and resend.'],
 [Avlocal,'Virus Scan Local',0,checkbox,1,'(.*)',undef,
  vc,'Check this box to scan local users email as well.'],
 [AVBytes,'AV Bytes',10,textinput,100000,'(\d*)',undef,
  vc,'How many bytes of the message will be Virus scanned? For example: 100000, Leave Blank to scan entire email which results in a significant performance penalty on large attachments, Most virus signatures match in the first 10-100K of the message.'],

[0,0,0,heading,'Spam Bombs & Scripting'],
 [showSpamBomb,'Show Configuration Options',0,checkbox,'','(.*)',undef,
  0,''],
 [bombRe,'Expression to Identify Spam Bombs',60,textinput,'','(.*)',ConfigCompileRe,
  sb,'It is possible for a spammer to create 1000s of messages that appear to be from your domain.
  When these messages bounce, the bounces come to you. You can use this feature to block those
  messages. Leave this blank to disable the feature. For example: images/ad12\.gif'],
 [bombError,'Spam Bomb Error',80,textinput,'500 Your message was rejected because it appears to be part of a spam bomb -- rephrase your message and try sending it again.','(.*)',undef,
  sb,'SMTP error message to reject spam bombs.'],
 [scriptRe,'Expression to Identify Mobile Scripts',60,textinput,'','(.*)',ConfigCompileRe,
  sb,'Spam emails may contain mobile scripting code, eg activex and java. You can use this feature to block those messages. Leave this blank to disable the feature. For example: \&lt;applet|\&lt;embed|\&lt;iframe|\&lt;object|\&lt;script|onmouseover|javascript:'],
 [scriptError,'Script Error',80,textinput,'500 Your email contains html scripting code -- please resend as plain text.','(.*)',undef,
  sb,'SMTP error message to reject scripts.'],

[0,0,0,heading,'SPAM Control'],
 [showSpamControl,'Show Configuration Options',0,checkbox,'','(.*)',undef,
  0,''],
 [SpamError,'Spam Error',80,textinput,'500 Mail appears to be unsolicited -- send error reports to postmaster@yourdomain.com','(5\d\d .*)',undef,
  sc,'SMTP error message to reject spam.'],
 [spamaddresses,'Spam Addresses*',60,textinput,'put|your@spambucket.com|addresses|@here.org','(\S*)',ConfigMakeRe,
  sc,'Mail to any of these users at are always spam unless from someone on the whitelist; @domain.com makes
  the whole domain a spam domain. A username without domain will register across all local domains.'],
 [spamLovers,'Spam-Lover Addresses*',60,textinput,'postmaster','(\S*)',ConfigMakeRe,
  sc,'Spam addressed entirely to spam lovers is not blocked. Mail addressed to both spam lovers
   and non spam lovers IS blocked. You can list specific addresses (user@mydomain.com), addresses
   at any local domain (user), or entire local domains (@mydomain.com). Separate entries with pipes: |.
   For example: jhanna@thisdomain.com|fhanna|@sillyguys.org'],
 [noProcessing,'Unprocessed Addresses*',40,textinput,'','(\S*)',ConfigMakeRe,
  sc,'Mail solely to or from any of these addresses are ignored by ASSP, like
  a more effecient version of spamLovers &amp; redlist combined.
  Separate addresses with pipes: | For example: postmaster@here.com|julie_vipul@razor.org'],
	[noProcessingDomains,'Unprocessed Domains*',60,textinput,'','(\S*)',ConfigMakeRe,
  sc,'Mail solely to or from any of these domains are ignored by ASSP. For example: newsletters.net|monthlyupdate.com'],
 [blackListedDomains,'Blacklisted Domains*',60,textinput,'','(\S*)',ConfigMakeRe,
  sc,'Domains from which you always want to reject mail -- they only send you spam. For example: email-deliveries.net|xxxpics.com'],
 [whiteRe,'Expression to Identify Non-Spam',60,textinput,'','(.*)',ConfigCompileRe,
  sc,'If an incoming email matches this Perl regular expression it will be considered non-spam. 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" target=_blank>here</a>. Note that flags are "si" and
  the header as well as body is scanned. Some things you might include here are your office phone
  number or street address -- spam rarely includes these details.'],
 [blackRe,'Expression to Identify Spam',60,textinput,'http://[\\w\\.]+@|\w<[a-z0-9]+[abcdfghjklmnpqrstuvwxyz0-9]{4}[a-z0-9]*>|subject: [^\\n]*     \S','(.*)',ConfigCompileRe,
  sc,'If an incoming email that\'s not local or whitelisted matches this Perl regular expression
  it will be considered spam. May match text from the body or header of the email.
  For example: penis|virgin|X-Priority: 1'],
 [redRe,'Expression to Identify Redlisted Mail',60,textinput,'','(.*)',ConfigCompileRe,
  sc,'If an email header matches this Perl regular expression it will be considered redlisted.
  For example: \\[autoreply\\]'],
 [npRe,'Expression to Identify No-processing Mail',60,textinput,'','(.*)',ConfigCompileRe,
  sc,'If an email header matches this Perl regular expression it will pass through unprocessed.
  For example: \\[autoreply\\]'],
 [heloBlacklistIgnore,'Don\'t block these HELO\'s*',60,textinput,'','(.*)',ConfigMakeRe,
  sc,'HELO / EHLO greetings on this list will be excluded from the HELO blacklist. For example: host123.isp.com|host456.isp.com'],
 [noHeloBlacklist,'Don\'t Use the Helo Blacklist',1,checkbox,'','(.*)',undef,
  sc,'Check this box to accept mail from blacklisted-helo hosts. You problably want to disable
  the HELO blacklist in the initial training phase for ASSP.'],
 [noGreyListUpload,'Don\'t Upload Greylist Stats',0,checkbox,'','(.*)',undef,
  sc,'Check this to disable the greylist upload when rebuildspamdb runs.'],
 [AddSpamProbHeader,'Add Spam Probability Header?',0,checkbox,1,'(.*)',undef,
  sc,'Adds a line to the email header "X-Assp-Spam-Prob: 0.0123" Probs range from 0 to +1 where > 0.6 = spam.'],
 [NoExternalSpamProb,'Block Outgoing Spam-Prob header?',0,checkbox,1,'(.*)',undef,
  sc,'Check this box if you don\'t want your X-Assp-Spam-Prob header on external mail -- Note this
   means mail from local users to local users will also be missing the header.'],
 [AddSpamHeader,'Add Spam Header?',0,checkbox,1,'(.*)',undef,
  sc,'Adds a line to the email header "X-Assp-Spam: YES" if the message is spam.'],
 [UseSubjectsAsMaillogNames,'Use Subject as Maillog Names',0,checkbox,1,'(.*)',undef,
  sc,'You can turn this on to help you manually identify mail in your spam and non-spam collections.'],
 [TestMode,'Test Mode',0,checkbox,1,'(.*)',undef,
  sc,'If TestMode is true all Bayesian-spam is delivered.'],
 [spamSubject,'Prepend Spam Subject',10,textinput,'','(.*)',undef,
  sc,'If TestMode and message is spam spamSubject gets prepended to the subject of the email. For example; [SPAM]'],
 [sendAllSpam,'Address to CC All Spam',20,textinput,'','(.*)',undef,
  sc,'If you put an email address in this box ASSP will try to deliver a copy of all spam email to this
   address. Don\'t forget to purge the account from time to time. This is the forward all spam feature.
   For example: spammeister@mydomain.com'],

[0,0,0,heading,'Whitelist Options'],
 [showWhitelistOptions,'Show Configuration Options',0,checkbox,'','(.*)',undef,
  0,''],
 [whiteListedDomains,'Whitelisted Domains*',60,textinput,'sourceforge.net','(\S*)',ConfigMakeRe,
  wl,'Domains from which you want to receive all mail -- your ISP, domain registeration, 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.
  DO NOT put your local domains on this list. Do not put microsoft.com on this list.
  For example: sourceforge.net|@google.com|.buy.com'],
 [MaxWhitelistDays,'Max Whitelist Days',5,textinput,'90','(\d+)',undef,
  wl,'This is the number of days an address will be kept on the whitelist without receiving email.'],
 [WhitelistOnly,'Reject All But Whitelisted Mail',0,checkbox,'','(.*)',undef,
  wl,'Check this if you don\'t want Bayesian filtering and want to reject all mail from
   anyone not whitelisted. Note: this turns the redlist into a blacklist.'],
 [NoMaillog,'Don\'t log mail',0,checkbox,'','(.*)',undef,
  wl,'Check this if you\'re using Whitelist-Only and don\'t care to save mail to build
   the Bayesian database.'],
 [NotGreedyWhitelist,'Only the envelope-sender is added/compared to the whitelist',0,checkbox,'','(.*)',undef,
  wl,'Normal operation includes addresses in the FROM, SENDER, REPLY-TO, ERRORS-TO, or LIST-* header
  fields. This allows nearly all list email to be whitelisted. Check this option to disable this.'],
 [WhitelistLocalOnly,'Only local or authenticated users contribute to the whitelist.',0,checkbox,'','(.*)',undef,
  wl,'Normal operation allows all local, authenticated, or whitelisted users to add to the whitelist.
  Check this box to not allow whitelisted users to add to the whitelist.'],
 [KeepWhitelistedSpam,'Keep Whitelisted Spam',0,checkbox,0,'(.*)',undef,
  wl,'Check this box if you don\'t want rebuildspamdb to remove entries from the spam collection
   after they have been subsequently whitelisted. Checking this box will speed up your rebuild.'],

[0,0,0,heading,'Email Interface'],
 [showEmailInterface,'Show Configuration Options',0,checkbox,'','(.*)',undef,
  0,''],
 [EmailInterfaceOk,'Enable Email Interface',0,checkbox,1,'(.*)',undef,
  ei,'Checked means that you want to ASSP to intercept and parse mail to the following usernames
   at any of your localdomains. If you are using RelayHost and RelayPort see
   <a href="http://assp.sourceforge.net/fom/cache/45.html" target=_blank>this note</a>.'],
 [EmailSpam,'Report Spam Address',20,textinput,'assp-spam','(.*)',undef,
  ei,'Any mail sent by local or authenticated users to this username will be interpreted as a
   spam report. No mail is delivered! For example: assp-spam'],
 [EmailHam,'Report not-Spam Address',20,textinput,'assp-notspam','(.*)',undef,
  ei,'Any mail sent by local or authenticated users to this username will be interpreted as a
   false-positive (not-spam) report. No mail is delivered! For example: assp-notspam'],
 [EmailWhitelist,'Add to Whitelist Address',20,textinput,'assp-white','(.*)',undef,
  ei,'Any mail sent by local or authenticated users to this username will be interpreted as a request
   to add addresses to the whitelist. No mail is delivered! For example: assp-white'],
 [EmailFrom,'From Address for Email',20,textinput,'ASSP <>','(.+)',undef,
  ei,'Email sent from ASSP acknowledging your submissions will be sent from this address. Some
   mailers don\'t like the default setting. For example: ASSP &lt;&gt; or Mail Administrator
   &lt;mailadmin@mydomain.com&gt;'],
 [NoHaiku,'Don\'t reply to messages to the Email Interface',0,checkbox,0,'(.*)',undef,
  ei,'Check this option to suppress email reports for spam and not-spam reports and whitelist additions via the email interface.'],

[0,0,0,heading,'File Paths'],
 [showFilePaths,'Show Configuration Options',0,checkbox,'','(.*)',undef,
  0,''],
 ['base','Directory Base',40,textinput,'.','',undef,fp,'All paths are relative to this folder. <b>Note: this must be changed as a command line parameter and is displayed here for reference only.</b>'],
 [spamlog,'Spam Collection',40,textinput,'spam','(\S+)',undef,fp,'The folder to save the collection of spam emails. For example: spam'],
 [notspamlog,'Not-spam Collection',40,textinput,'notspam','(\S+)',undef,fp,'The folder to save the collection of not-spam emails. For example: notspam'],
 [incomingOkMail,'External OK mail',40,textinput,'','(\S*)',undef,fp,'The folder to save Bayesian non-spam (message ok). Leave this blank to not save these files (default). If you want to keep copies of OK mail then put in a directory name. Note: you must create the directory. For example: okmail'],
 [viruslog,'Virus Collection',40,textinput,'','(\S*)',undef,fp,'The folder to save virii, blocked attachments and scripting. Leave this blank to not save these files (default). If you want to keep copies of blocked content then put in a directory name. Note: you must create the directory. For example: virii'],
 [correctedspam,'False-negative Collection',40,textinput,'errors/spam','(\S+)',undef,fp,'Spam that got through -- counts double. For example: errors/spam'],
 [correctednotspam,'False-positive Collection',40,textinput,'errors/notspam','(\S+)',undef,fp,'Good mail that was listed as spam, count 4x. For example: errors/notspam'],
 [maillogExt,'Extension for Mail Files',10,textinput,'.eml','(\S*)',undef,fp,'Enter the file extension (include the period) you want appended to the mail files in the mail collections. Leave it blank for no extension. For Example: .eml'],
 [spamdb,'Spam Bayesian Database File',40,textinput,'spamdb','(\S+)',undef,fp,'The output file from rebuildspamdb.pl.'],
 [whitelistdb,'Email Whitelist Database File',40,textinput,'whitelist','(\S+)',undef,fp,'The file with the whitelist.'],
 [redlistdb,'Email Redlist Database File',40,textinput,'redlist','(\S+)',undef,fp,'The file with the redlist.'],
 [dnsbl,'DNS Blacklist Database File',40,textinput,'','(\S*)',undef,fp,'The file with the current DNSBL -- make this blank if you don\'t use it.'],
 [greylist,'Greylist Database',40,textinput,'greylist','(\S*)',undef,fp,'The file with the current greylist database -- make this blank if you don\'t use it.'],
 [nogreydownload,'Don\'t auto-download the greylist file',0,checkbox,'','(.*)',undef,fp,'Set this checkbox if don\'t use the greylist or want to download it manually.'],
 [logfile,'ASSP Logfile',40,textinput,'maillog.txt','(\S*)',ConfigChangeLogfile,fp,'Blank if you don\'t want a log file. Change it to maillog.log if you don\'t want
  auto rollover.'],
 [LogRollDays,'Roll the Logfile How Often?',5,textinput,'14','([\d\.]+)',undef,fp,'ASSP closes and renames the log file after this number of days. Decimals are ok. For example: 14 or 0.5'],
 [pidfile,'PID File',40,textinput,'pid','(\S*)',undef,fp,'Blank to skip writing a pid file. *nix users need pid files. Leave it blank in Windows.
   You have to restart the service before you get a pid file in the new location.'],

[0,0,0,heading,'Logging'],
 [showLogging,'Show Configuration Options',0,checkbox,'','(.*)',undef,
  0,''],
 [silent,'Silent Mode',0,checkbox,'','(.*)',undef,
  lg,'Checked means don\'t print log messages to the console. AsADaemon overrides this.'],
 [DEBUG,'Debug Mode',0,checkbox,'','(.*)',ConfigDEBUG,
  lg,'Checked means you want debugging to go to a .dbg file. Leave this unchecked unless there is a program error you are trying to track down.'],
 [sendNoopInfo,'Send NOOP Info',0,checkbox,'','(.*)',undef,
  lg,'Checked means you want ASSP to send a "NOOP Connection from $ip" message to your SMTP server. (Postfix croaks on this.)'],
 [wlAttachLog,'Whitelisted Blocked Attachments',1,textinput,5,'(\d*)',undef,lg,'Where to store Whitelisted blocked attachments. Recommended : 5 <br><span class="negative"> 2 = notspam folder, 3 = spamfolder, 4 = mailok folder, 5 = virii folder &amp 6 = discard.</span></br>'],
 [extAttachLog,'External Blocked Attachments',1,textinput,5,'(\d*)',undef,lg,'Where to store external blocked attachments. Recommended: 5'],
 [spamBombLog,'Spam Bombs',1,textinput,6,'(\d*)',undef,lg,'Where to store spam bombs. Recommended: 6'],
 [scriptLog,'Scripts',1,textinput,3,'(\d*)',undef,lg,'Where to store scripted emails. Recommended: 3'],
 [baysNonSpamLog,'Bayesian Non Spam',1,textinput,4,'(\d*)',undef,lg,'Where to store bayesian non spam (message ok) emails. Recommended: 4'],
 [blDomainLog,'Blacklisted Domains',1,textinput,3,'(\d*)',undef,lg,'Where to store blacklisted domain emails. Recommended: 3'],
 [spamHeloLog,'Spam Helos',1,textinput,3,'(\d*)',undef,lg,'Where to store spam helo emails. Recommended: 3'],
 [spamBucketLog,'Spam Addresses',1,textinput,6,'(\d*)',undef,lg,'Where to store has spam address emails. Recommended: 6'],
 [baysSpamLog,'Bayesian Spams',1,textinput,3,'(\d*)',undef,lg,'Where to store bayesian spam emails. Recommended: 3'],

[0,0,0,heading,'Security'],
 [showSecurity,'Show Configuration Options',0,checkbox,'','(.*)',undef,
  0,''],
 [runAsUser,'Run as UID',20,textinput,'','(\S*)',undef,
  se,'The *nix user name to assume after startup: assp or nobody -- requires ASSP restart.'],
 [runAsGroup,'Run as GID',20,textinput,'','(\S*)',undef,
  se,'The *nix group to assume after startup: assp or nogroup -- requires ASSP restart.'],
 [ChangeRoot,'Change Root',60,textinput,'','(.*)',undef,
  se,'Non-blank means to run in chroot jail in *nix. You need an etc/protocols file to make this work -- copy or link the file to your new root directory.  -- requires ASSP restart.'],

[0,0,0,heading,'Other Settings'],
 [showOtherSettings,'Show Configuration Options',0,checkbox,'','(.*)',undef,
  0,''],
 [MaxFiles,'Max Files',10,textinput,14009,'(\d+)',undef,
  os,'If you\'re not using subjects as file names, MaxFiles is the maximum
  number of files to keep in each collection (spam and nonspam) -- it\'s actually
  less than this -- files get a random number between 1 and $MaxFiles.'],
 [MaxBytes,'Max Bytes',10,textinput,20000,'(\d+)',undef,
  os,'How many bytes of the message will ASSP look at? For example: 20000'],
 [RamSaver,'Use less RAM to rebuild the spamdb',0,checkbox,'','(.*)',undef,
  os,'Checking this slows down your rebuildspamdb process, but will do so with less ram.'],
 [OutgoingBufSize,'Size of TCP/IP Buffer',20,textinput,102400,'(\d+)',undef,
  os,'If ASSP talks to the internet over a modem change this to 4096, 102400 is the default.
  For example: 102400'],
 [OrderedTieHashSize,'Ordered-Tie hash table size',10,textinput,5000,'(\d+)',undef,
  os,'Tunable value of the size of the hash tables used by both ASSP and rebuildspamdb.pl
  (default = 5000). Larger numbers mean more RAM, fewer disk hits. Adjust down to use less RAM.'],
 [MaxErrors,'Max Errors',10,textinput,'10','(\d+)',undef,
  os,'If the smtp destination sends $MaxErrors 501s, 502s, 503s... the connection is dropped.'],
 [RestartEvery,'Restart Every',10,textinput,'0','(\d+)',undef,
  os,'Program terminates after this many seconds -- this is really only useful if ASSP runs in a script that restarts it after
   it stops. Note: the current timeout must expire before the new setting is loaded.'],
 [UpdateWhitelist,'Save Whitelist',10,textinput,3600,'(\d+)',undef,
  os,'Save a copy of the white list every this many seconds. Note: the current timeout must expire
   before the new setting is loaded, or you can restart.'],
 [totalizeSpamStats,'Upload Consolidated Spam Statistics',0,checkbox,1,'(.*)',undef,os,'Checked means your ASSP will upload its totalled statistics to the <a href="http://assp.sourceforge.net/cgi-bin/total.pl" target=_blank>ASSP web site totals</a>.
  This is a great marketing tool for the ASSP project; please don\'t disable it unless you\'ve got
  a good reason to. No private information is being disclosed by this upload.'],

 );
 $MakeRE{allowAdminConnectionsFrom}=\&setACFRE;
 $MakeRE{acceptAllMail}=\&setAMRE;
 $MakeRE{localDomains}=\&setLDRE;
 $MakeRE{spamaddresses}=\&setSARE;
 $MakeRE{spamLovers}=\&setSLRE;
 $MakeRE{noProcessing}=\&setNPRE;
 $MakeRE{noProcessingDomains}=\&setNPDRE;
 $MakeRE{whiteListedDomains}=\&setWLDRE;
 $MakeRE{blackListedDomains}=\&setBLDRE;
 $MakeRE{heloBlacklistIgnore}=\&setHBIRE;
 $MakeRE{LocalAddresses_Flat}=\&setLAFRE;

 # allow override for default web admin port
 if($ARGV[1]=~/^\d+$/) {
  for (@Config) {
   if($_->[0] eq 'webAdminPort' ) {
    $_->[4]=$ARGV[1];
    last;
   }
  }
 }
 open(F,"<$base/assp.cfg"); local $/; (%Config)=split(/:=|\n/,<F>); close F;
 # load defaults
 unless( %Config ) { for $c (@Config) {$Config{$c->[0]}=$c->[4] if $c->[0];} }

 $NavMenu = '<a href="/">Main</a>,
    <a href="stats">Statistics</a>,
    <a href="lists">Update / Verify the Whitelist or Redlist</a>,
    <a href="analyze">Analyze an email</a>,
    <a href="maillog">See the maillog tail</a>,
    <a href="donations">Donations</a>';

$StyleSheet = 'body,p,td {font-size: 11pt; font-family : Arial, sans-serif; }
H1, h2, h3 {font-variant: small-caps; }
table {border-color: #de7813; border-width: 0px; border-style: solid; width: 100%}
td {border-color: white; border-width: 1px; border-style: solid; padding: 2px 2px 2px 5px;}
a {color: #913104;}
a:hover {color: #3c79c9;}
img {border-style: none;}
.header2 {text-align: right; font-size: 130%; font-weight: bold;}
.smaller {font-size: 50%; font-weight: normal;}
.nav {background-color: #ededed; padding: 5px; text-align: center;
    border-style: solid; border-color: #de7813;  border-width: 2px; font-weight: bold;}
.sectionHeader {color: #f8f1df; font-weight: bold; font-size: 130%; text-align: center;
    background-color: #0e386b;}
.noBorder {border-width: 0px; border-style: none;}
.textBox {background-color: #f8f1df; border-color: black; border-width: 1px; padding:
    5px; border-style: solid; text-align: left;}
.warning {border-style: solid; border-color: #de7813; border-width: 1px; margin-top: 3px;
    font-weight: bold; padding: 5px;}
.negative {color: red;}
.positive {color: green;}
.optionTitle {background-color: #dfa273; border-style: none;}
/*extra "optionTitle" for the stats page, because the
    defalut one looks pretty horrible */
.statsOptionTitle {background-color: #f8f1df; border-style: none; text-align: right;}
.optionValue {background-color: #f8f1df; border-style: none;}';


 fixConfigSettings();
 $SIG{HUP}=\&reloadConfigFile;
 $SIG{PIPE} = "IGNORE";
}

# data for DayOfWeek function
#my %Months=(Jan,1,Feb,2,Mar,3,Apr,4,May,5,Jun,6,Jul,7,Aug,8,Sep,9,Oct,10,Nov,11,Dec,12);
#my %Month=(1,0,2,3,3,2,4,5,5,0,6,3,7,5,8,1,9,4,10,6,11,2,12,4,);
#my %Weekday=(0,'srdSUN',1,'srdMON',2,'srdTUE',3,'srdWED',4,'srdTHU',5,'srdFRI',6,'srdSAT',);

$EmailAdrRe="[^()<>@,;:\\/\"\\[\\]\000-\040]+";
$EmailDomainRe='\w[\w\.\-]*\.\w+';

# Notes on general operation & program structure
# I'm using 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 header (and eventually the first 10000 bytes) are stored
# ->{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 spammy.
# ->{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

use IO::Select;
use IO::Socket;

sub serviceCheck {}
sub d {}

eval(q[sub d {
 $time=gmtime(); $time=~s/... (...) (..) (........) ..(..)/$2 $1 $4 $3/;
 print DEBUG "$time <$_[0]>";
 }
]) if $DEBUG;

if($AsADaemon) {
 fork() && exit;
 close STDOUT;
 close STDERR;
 $silent=1;
}

if($pidfile) {open(F,">$base/$pidfile"); print F $$; close F;}

sub RemovePid {
 if ($pidfile) {
  d('RemovePid');
  unlink("$base/$pidfile");
 }
}

if($DEBUG) {open(DEBUG, ">$base/".time.".dbg"); binmode(DEBUG); my $oldfh = select(DEBUG); $| = 1; select($oldfh);}
if($logfile && open(LOG,">>$base/$logfile")) {my $oldfh = select(LOG); $| = 1; select($oldfh);}

if($AsAService) {
 eval(<<'EOT');
 use Win32::Daemon;
 mlog(0,'Starting as a Service');
 Win32::Daemon::StartService();

 # Wait until the service manager is ready for us to continue...
 while( SERVICE_START_PENDING != Win32::Daemon::State() ) { sleep( 1 ); }
 Win32::Daemon::State( SERVICE_RUNNING );

sub serviceCheck {
 d(50);
 if(Win32::Daemon::State() == SERVICE_STOP_PENDING ) {
  d(51);
  mlog(0,'Service Stopping');
  &saveWhitelist;
  Win32::Daemon::State( SERVICE_STOPPED );
  Win32::Daemon::StopService();
  exit;
 }
}

EOT
 print STDERR "error: $@\n" if $@;
 print LOG "error: $@\n" if $@;
}

init();
while(1) {
 &MainLoop;
}


sub init {
 mlog(0,"ASSP version $version$modversion initializing");

 $readable = new IO::Select( );
 $writable = new IO::Select( );

 $lsn = newListen($listenPort,\&NewSMTPConnection);
 $WebSocket = newListen($webAdminPort,\&NewWebConnection);
 mlog(0,"Listening for mail connections at $listenPort and admin connections at $webAdminPort");
 if($listenPort2) {
  $lsn2 = newListen($listenPort2,\&NewSMTPConnection);
  mlog(0,"Listening for additional mail connections at $listenPort2");
 }
 # handle the possible relayhost / smarthost option
 if($relayHost && $relayPort) {
  $Relay=newListen($relayPort,\&NewSMTPConnection);
  mlog(0,"Listening for relay connections at $relayPort");
 }

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

 $SIG{INT}=sub {mlog(0,'Sig INT'); &SaveWhitelist; kill 6,$$ if $ENV{windir}; RemovePid(); exit;};
 $SIG{TERM}=sub {mlog(0,'Sig TERM'); &SaveWhitelist; RemovePid(); exit;};

 my ($uid,$gid)=getUidGid($runAsUser,$runAsGroup) if ($runAsUser || $runAsGroup);
 if($ChangeRoot) {
  my $chroot;
  eval('$chroot=chroot($ChangeRoot)');
  if($@) {
   mlog('',"Request to change root to '$ChangeRoot' failed: $@");
   die "Request to change root to '$ChangeRoot' failed: $@";
  } elsif(! $chroot) {
   mlog('',"Request to change root to '$ChangeRoot' did not succeed: $!");
   die "Request to change root to '$ChangeRoot' did not succeed: $!";
  } else {
   $chroot=$ChangeRoot; $chroot=~s/(\W)/\\$1/g;
   $base=~s/^$chroot//i;
   chdir("/");
   mlog('',"Successfully changed root to '$ChangeRoot' -- new base is '$base'");
  }
 }
 switchUsers($uid,$gid) if ($runAsUser || $runAsGroup);

 # create folders if they're missing
 mkdir "$base/$spamlog",0700; mkdir "$base/$notspamlog",0700;
 my $dir=$correctedspam;
 $dir=~s/\/.*?$//;
 mkdir "$base/$dir",0700;
 mkdir "$base/$correctedspam",0700; mkdir "$base/$correctednotspam",0700;

 # put this after chroot so the paths don't change
 $SpamdbObject=tie %Spamdb,orderedtie,"$base/$spamdb" if $spamdb;
 mlog(0,"Warning: Bayesian spam database is small or empty: '$base/$spamdb'") if $spamdb && -s "$base/$spamdb" < 10000;
 $HeloBlackObject=tie %HeloBlack,orderedtie,"$base/$spamdb.helo" if $spamdb;
 $DnsblObject=tie %Dnsbl,orderedtie,"$base/$dnsbl" if $dnsbl;
 mlog(0,"Warning: DNS blacklist database is small or empty: '$base/$dnsbl'") if $dnsbl && -s "$base/$dnsbl" < 10000;
 $WhitelistObject=tie %Whitelist,orderedtie,"$base/$whitelistdb";
 mlog(0,"Warning: Whitelist is small or empty: '$base/$whitelistdb' (ignore if this is a new install)") if $whitelistdb && -s "$base/$whitelistdb" < 1000;
 $RedlistObject=tie %Redlist,orderedtie,"$base/$redlistdb";
 $GreylistObject=tie %Greylist,orderedtie,"$base/$greylist" if $greylist;
 if($AvDbs) {
  mlog(0,"Loading Virus definitions ...");
  Av->init( {path => ($AvPath || $base), databases => $AvDbs} );
  mlog(0,"Virus definitions loaded; count=".Av->count);
 }

 $Stats{starttime}=time;
 $Stats{version}=$version;
 $Stats{pid}=$$;
 &ResetStats;

 mlog(0,"Starting");
}

sub newListen {
 my($port,$handler)=@_;
 my ($interface,$p)=$port=~/(.*):(.*)/;
 my $s;
 if($interface) {
  #print "i=$interface p=$p ($port)\n";
  $s = new IO::Socket::INET(Listen => 10, LocalPort => $p, Reuse=>1, LocalAddr => $interface);
 } else {
  $s = new IO::Socket::INET(Listen => 10, LocalPort => $port, Reuse=>1);
 }
 if(! $s) {
  mlog('',"Couldn't create server socket on port '$port' -- maybe another service is running or I'm not root (uid=$>)?");
  #die "Couldn't create server socket on port '$port' -- maybe another service is running or I'm not root (uid=$>)?\n";
  return undef;
 }
 $SocketCalls{$s}=$handler;
 $readable->add($s); # add to select list
 $s;
}

sub getUidGid { my ($uname,$gname)=@_;
 return if $AsAService;
 eval('getgrnam(root);getpwnam(root);');
 if($@) {
  # windows pukes "unimplemented" for these -- just skip it
  mlog('',"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 {
   mlog('',"Could not find gid for group '$gname' -- not switching effective gid -- quitting");
   die "Could not find gid for group '$gname' -- not switching effective gid -- quitting";
  }
 }
 my $uid;
 if($uname) {
  $uid = getpwnam($uname);
  if(defined $uid) {
  } else {
   mlog('',"Could not find uid for user '$uname' -- not switching effective uid -- quitting");
   die "Could not find uid for user '$uname' -- not switching effective uid -- quitting";
  }
 }
 ($uid,$gid);
}

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

sub MainLoop {
 my $wait=7; # keep it short enough for servicecheck to be called regularly
 my ($canread,$canwrite)=IO::Select->select($readable,$writable,undef,$wait);
 foreach $fh (@$canwrite) {
  my $l=length($Con{$fh}->{outgoing});
  print DEBUG "$fh $Con{$fh} l=$l\n" if $DEBUG;# '$Con{$fh}->{outgoing}'\n";
  if(length($Con{$fh}->{outgoing})) {
   my $written=syswrite($fh,$Con{$fh}->{outgoing},$OutgoingBufSize);
   if($DEBUG) {
   	if($written < 200) {
     print DEBUG "wrote: ($written)<",substr($Con{$fh}->{outgoing},0,$written),">\n";
    } else {
     print DEBUG "wrote: ($written)<long text>\n";
    }
   }
   $Con{$fh}->{outgoing}=substr($Con{$fh}->{outgoing},$written);
   $l=length($Con{$fh}->{outgoing});
   # test for highwater mark
   if($written>0 && $l < $OutgoingBufSize && $Con{$fh}->{paused}) {
    $Con{$fh}->{paused}=0;
    $readable->add($Con{$fh}->{friend});
   }
  }
  if(length($Con{$fh}->{outgoing})==0) {
   $writable->remove($fh);
  }
 }
 foreach $fh (@$canread) {
  #print "fh=$fh\n";
  $SocketCalls{$fh}->($fh) if $fh && $SocketCalls{$fh};
 }
 d(6);

 serviceCheck(); # for win32 services

 # timer related issues
 $time=time;
 if($time - $ltime == $wait) {
  # noactive connections -- check for maintenance
  d(8);
  if($time >= $saveWhite) {
   d(9);
   &SaveWhitelist;
   $saveWhite=$time+$UpdateWhitelist;
  }
  if($RestartEvery && $time >= $endtime) {
   # time to quit -- after endtime and we're bored.
   $opencon=(keys %Con);
   if($opencon == 0) {
    &SaveWhitelist;
    mlog(0,"Restarting");
    exit 1;
   }
  }
  uploadStats() if($totalizeSpamStats && $time >= $Stats{nextUpload});
  downloadGrey() if(!$nogreydownload && $greylist && $time >= $NextGreylistDownload);
  if($AvDbs && Av->checkReload()) {
   mlog(0,"Reloading virus database ...");
   Av->loadAll();
   mlog(0,"Virus signature database reloaded; count=".Av->count);
  }
 }
 $ltime=$time;
}
d(11);
# Never reached...

sub SaveWhitelist {
 d(35);
 mlog(0,"Saving Whitelist");
 $WhitelistObject->flush() if $WhitelistObject;
 $RedlistObject->flush() if $RedlistObject;
 SaveStats();
}

sub mlog{
 my $fh=shift;
 d(34);
 my $m=localtime();
 $m=~s/^... (...) +(\d+) (\S+) ..(..)/$1-$2-$4 $3/;

 my $t=int(time()/($LogRollDays*24*3600)); # roll log every 14 days
 if($logfile && $mlogLastT && $t != $mlogLastT && $logfile ne "maillog.log") {
  # roll the log
  my ($sec,$min,$hour,$mday,$mon,$year) = localtime(time);
  $mon++; $year-=100;
  my $mm=sprintf("%02d-%02d-%02d",$year,$mon,$mday);
  $archivelogfile = "$mm.$logfile";
  print LOG "$m: Rolling log file -- archive saved as '$archivelogfile'\n";
  print "$m: Rolling log file -- archive saved as '$archivelogfile'\n" unless $silent;
  close LOG;
  rename("$base/$logfile", "$base/$archivelogfile");
  if(open(LOG,">>$base/$logfile")) {my $oldfh = select(LOG); $| = 1; select($oldfh);}
  print LOG "$m: new log file -- old log file renamed to '$archivelogfile'\n";
  SaveConfig();
 }
 $mlogLastT=$t;
 if($fh && $Con{$fh}) {
  $m.= " $Con{$fh}->{ip} <$Con{$fh}->{mailfrom}>";
  my ($to) = $Con{$fh}->{rcpt}=~/(\S+)/;
  $m.= " to: $to" if $to;
 }
 $m.= " $_[0]\n";
 print $m unless $silent;
 print DEBUG $m if $DEBUG;
 print LOG $m if $logfile;
}

#####################################################################################
#                Socket handlers


sub NewSMTPConnection {
 my $fh=shift;
 my ($client, $server, $destination);
 if($fh==$Relay) {
  # a relay connection -- destination is the relayhost
  d(101);
  $destination=$relayHost;
 } else {
  d(1);
  $destination=$smtpDestination;
 }
 if(!($client=$fh->accept)) {
  d("accept failed: $fh");
  return;
 }
 $server=new IO::Socket::INET(Proto=>'tcp',PeerAddr=>$destination,Timeout=>2);
 #print "friend=$server\n";
 #$NewCon=1;
 if(! $server) {
  mlog('',"Couldn't create server socket to $destination -- aborting connection");
  $client->close();
  next;
 }
 addfh($client,\&getline,$server);
 if($sendNoopInfo) {
  addfh($server,\&skipok,$client);
 } else {
  addfh($server,\&reply,$client);
 }
 #$ffh='aaaa' unless $ffh; open($ffh,">e:/spamdb/$ffh") &&  ($Con{$client}->{ffh}=$ffh) && binmode($ffh); $ffh++;
 my $ip=$Con{$client}->{ip}=$client->peerhost();
 print DEBUG "Connected: $client -- $server\n" if $DEBUG;
 $Stats{connects}++;
 if(ok2Relay($ip) || $fh == $Relay ) {
  $Con{$client}->{relayok}=1;
  #mlog($client,"relaying ok");
  print DEBUG "$client relaying ok: $ip\n" if $DEBUG;
 }
 $time=gmtime(); $time=~s/... (...) (..) (........) ..(..)/$2 $1 $4 $3/;
 $Con{$client}->{rcvd}="Received: from $ip ([$ip] helo=) by $myName ; $time -0000\r\n";
 print DEBUG  "\n* connect ip=$Con{$client}->{ip} relay=<$Con{$client}->{relayok}> *\n" if $DEBUG;
 mlog(0, "Connected: $ip:".$client->peerport());
 $Con{$server}->{noop}="NOOP Connection from: $ip, $time -0000 relayed by $myName\r\n" if $sendNoopInfo;

 # check if options files have been updated and need to be re-read
 if(time-$lastOptionCheck > 60) { # check for updates each 60 seconds
  for $f (@PossibleOptionFiles) {
   ${$f}=optionList($Config{$f},$f) if $Config{$f}=~/^ *file: *(.+)/i && fileUpdated($1);
  }
  $lastOptionCheck=time;
 }
}

sub SMTPTraffic {
 my $fh=shift;
 my $buf;
 if($fh->sysread($buf,4096)>0) {
  d(2);
  $this=$Con{$fh};
  $buf=$this->{_}.$buf;
  if((my $sb=$this->{skipbytes})>0) {
   # support for XEXCH50
   # thankyou Microsoft for making my life miserable
   my $l=length($buf);
   print DEBUG "skipbytes=$sb l=$l -> " if $DEBUG;
   if($l >= $sb) {
    sendque($this->{friend},substr($buf,0,$sb)); # send the binary chunk on to the server
    $buf=substr($buf,$sb);
    delete $this->{skipbytes};
   } else {
    sendque($this->{friend},$buf); # send the binary chunk on to the server
    $this->{skipbytes}=$sb-=length($buf);
    $buf='';
   }
   print DEBUG "skipbytes=$this->{skipbytes}\n" if $DEBUG;
  }
  $bn=$lbn=-1;
  while(($bn=index($buf,"\n",$bn+1)) >= 0) {
   $s=substr($buf,$lbn+1,$bn-$lbn);
   if(defined($this->{bdata})) { $this->{bdata}-=length($s); }
   print DEBUG  "doing <$s>\n" if $DEBUG;
   #print $fgfh $s if $fgfh=$Con{$fh}->{ffh};
   Maillog($fh,$s) if $Con{$fh}->{maillog};
   $Con{$fh}->{getline}->($fh,$s);
   last unless $Con{$fh};  # it's possible that the connection can be deleted while there's still something in the buffer
   $lbn=$bn;
  }
  d(3);
  if($Con{$fh}) {
   ($this->{_})=substr($buf,$lbn+1);
   if(length($this->{_}) > $MaxBytes) {
    d(4);
    if(defined($this->{bdata})) { $this->{bdata}-=length($this->{_}); }
    Maillog($fh,$this->{_}) if $Con{$fh}->{maillog};
    $Con{$fh}->{getline}->($fh,$this->{_});
    ($this->{_})='';
   }
  }
 } else {
  d(5);
  done($fh);
 }
}

sub check4update {
 # only check every 15 seconds
 my $fil=shift;

 return if $check4updateTime{$fil} + 15 > time;
 $check4updateTime{$fil}=time;

 my @s=stat(${$fil});
 my $mtime=$s[9];
 if ($mtime != $FileUpdate{$fil}) {
  # reload
  $FileUpdate{$fil}=$mtime;
  open(F,"<${$fil}");
  local $/="\n";
  my $l; my %h;
  while($l=<F>) {
   $l=~y/\r\n\t //d;
   next unless $l;
   $h{lc $l}=1;
   #print "$fil: <$l>=1\n";
  }
  close F;
  %{$fil}=%h;
 }
}

sub SetRE { my ($var,$r,$f,$log)=@_;
 #print "\$$var=qr/$r/$f\n";
 eval("\$$var=qr/\$r/$f");
 if($@) {
  mlog(0,"Regular Expression Error in '$r' for $log: $@");
 }
}
sub setAMRE {
 # return 1 if $acceptAllMail && $ip=~/^($acceptAllMail)/i;
 SetRE(AMRE,"^($_[0])",'i','Accept All Mail');
}

sub ok2Relay {
 my $ip=shift;
 return 1 if $acceptAllMail && $ip=~$AMRE;

 if($relayHostFile) {
  check4update(relayHostFile);
  return 1 if $relayHostFile{$ip};
 }

 # If you want to allow pop before smtp uncomment this line and check PopB4SMTP below
 return 1 if PopB4SMTP($ip);

 # failed all tests -- return 0
 0;
}

# if you want to allow pop before smtp authentication then umcomment the line above
# where this sub is called and edit this sub to be appropriate for your implementation
sub PopB4SMTP {
 return 0 unless $PopB4SMTPFile;
 unless ($TriedDBFileUse) {
  eval 'use DB_File';
  mlog(0,"Could not load module DB_File: $@") if $@;
  $TriedDBFileUse=1;
 }
 my $ip=shift;
 my %hash;
 tie %hash,  'DB_File', $PopB4SMTPFile, O_READ, 0400, $DB_HASH;
 if($hash{$ip}) {
  return 1;
 } else {
  return 0;
 }
}

# Another possible PopB4SMTP implementation
# works with Merak and other text based popb4smtp files.
#  -- this could be implemented more effeciently...
#sub PopB4SMTP {
# return 0 unless $PopB4SMTPFile;
# my $ip=shift;
# my $ind; my $ipMatch; my $preByte; my $postByte;
# open(MKPOPSMTP,"<$PopB4SMTPFile") or return 0 ;
# while ($line = <MKPOPSMTP>) {
#  $ind = index($line,$ip);
#  if ($ind  > 0) {
#   #find the match, and get it and the char before and after
#   #if both of those aren't a number ord("0") & ord("9") 48 - 57 then I have the whole IP [ord is same as asc]
#   #if not, this is a subset of a larger IP address and thus no good
#   #ex: 66.35.250.203 I don't want to let 66.35.250.20 or 6.35.250.203 or 6.35.250.20 you get the idea
#   $preByte = ord(substr($line, ($ind - 1), 1));
#   $postByte = ord(substr($line, ($ind + length($ip)), 1)); #0 based, so no + 1
#   if ( (($preByte < 48) || ($preByte > 57)) & (($postByte < 48) || ($postByte > 57)) ) {
#    close(MKPOPSMTP);
#    mlog(0,"PopB4SMTP OK for $ip");
#    return 1;
#   }
#  }
# }
# close(MKPOPSMTP);
# mlog(0,"PopB4SMTP NOT OK for $ip");
# return 0;
#}

sub setACFRE {
  #if($ip!~/^($allowAdminConnectionsFrom)/i) {
 SetRE(ACFRE,"^($_[0])",'i',"Allow Admin Connections From");
}

sub NewWebConnection {
 my $s=$WebSocket->accept;
 return unless $s;
 if($allowAdminConnectionsFrom) {
  my $ip=$s->peerhost();
  mlog('',"admin connection from $ip");
  if($ip!~$ACFRE) {
   mlog('',"admin connection from $ip rejected by allowAdminConnectionsFrom");
   $s->close();
   return;
  }
 }
 $readable->add($s);
 $SocketCalls{$s}=\&WebTraffic;
}

sub WebTraffic {
 my $fh=shift;
 if($fh->sysread($buf,4096)>0) {
  local $_=$WebCon{$fh}.=$buf;
  if(length($_) > 1030000) {
   # throw away connections longer than 1M to prevent flooding
   WebDone($fh);
   return;
  }
  if(/Content-length: (\d+)/i) {
   my $l=$1;
   webRequest($fh,$1,$2) if	/(.*\n)\r?\n\r?(.*)/s && length($2) >= $l;
  } elsif(/\n\r?\n/) {
   webRequest($fh,$_);
  }
 } else {
  # connection closed
  WebDone($fh);
 }
}

sub WebDone {
 my $fh=shift;
 delete $SocketCalls{$fh};
 delete $WebCon{$fh};
 $readable->remove($fh);
}

# done with a file handle -- close him and his friend(s)
sub done {
 my $fh=shift;
 d(12);
 done2($Con{$fh}->{friend});
 done2($Con{$fh}->{forwardSpam});
 done2($fh);
}

# close a file handle & clean up associated records
sub done2 {
 my $fh=shift;
 d(13);
 return unless $fh;
 my $this=$Con{$fh};
 return unless $this;
 print DEBUG  "closing $fh\n" if $DEBUG;
 # close the maillog if it's still open
 my $f=$this->{maillogfh};
 close $f if $f;
 #$f=$this->{ffh}; close $f if $f;
 # remove from the select structure
 delete $SocketCalls{$fh};
 $readable->remove($fh);
 $writable->remove($fh);
 # close it
 $fh->close;
 # delete the Connection data
 delete $Con{$fh};
}

# adding a socket to the Select structure and Con hash
sub addfh {
 my ($fh,$getline,$friend) =@_;
 d(14);
 $SocketCalls{$fh}=\&SMTPTraffic;
 $readable->add($fh);
 binmode($fh);
 $Con{$fh}={};
 my $this=$Con{$fh};
 $this->{getline}=$getline;
 $this->{friend}=$friend;
 #print "add $fh: f=$friend\n";
}

# sendque enques a string for a socket
sub sendque {
 my ($fh,$message)=@_;
 my $l=length($message);
 print DEBUG "sq: $fh l=$l\n" if $DEBUG;#'$message'\n";
 #print "sq: $message\n";
 return unless $fh && $Con{$fh};
 $writable->add($fh);
 $Con{$fh}->{outgoing}.=$message;
 if(!$Con{$fh}->{paused} && length($Con{$fh}->{outgoing}) > $OutgoingBufSize) {
  $Con{$fh}->{paused}=1;
  print DEBUG "pausing\n" if $DEBUG;
  $readable->remove($Con{$fh}->{friend});
 }
}

#####################################################################################
#                SMTP stuff

# compile the regular expression (RE) for the local domains list (LDRE)
sub setLDRE {
 # return 1 if $localDomains && $h=~/^($localDomains)$/i;
 SetRE(LDRE,"^($_[0])\$","i","Local Domains");
}

# returns true if this address is local
sub localmail {
 my $h=shift;
 $h = $1 if $h=~/\@(.*)/;
 #print "h=$h ld=$localDomains ldf=$localDomainsFile\n";
 return 1 if $localDomains && $h=~$LDRE;
 if($localDomainsFile) {
  check4update(localDomainsFile);
  return 1 if $localDomainsFile{lc $h};
 }
 0;
}

# begin modification RO
sub localmailaddress {
 my $h=shift;
 my $retcode;
 my $retmsg;
 $h = $1 if $h=~/\@(.*)/;
 
 # do LDAP lookup
$current_email = "$1$h";
$ldapflt = $LDAPFilter;
$ldapflt =~ s/EMAILADDRESS/$current_email/g;
 
 print DEBUG  "doing LDAP lookup with $ldapflt in $LDAPRoot\n" if $DEBUG;

 $ldap = Net::LDAP->new( $LDAPHost );
 if(! $ldap) {
   seterror($fh,"451 Could not check recipient, try later\r\n",1);
   mlog($fh,"Couldn't contact LDAP server at $LDAPHost -- aborting connection");
   next;
 }
 
 # bind to a directory anonymous or with dn and password
 if ($LDAPLogin) {
 $mesg = $ldap->bind( $LDAPLogin,
 			password => $LDAPPassword);
 } else {
 #	mlog($fh,"LDAP anonymous bind");
 	$mesg = $ldap->bind;
 }
 $retcode = $mesg->code;
 if ($retcode) {
# 	$retmsg=$mesg->error_text();
# 	mlog($fh,"LDAP bind error: $retcode - Login Problem?");
   seterror($fh,"451 Could not check recipient, try later\r\n",1);
   mlog($fh,"LDAP bind error: $retcode -- aborting connection");
   next;
 }
 # perform a search
 $mesg = $ldap->search( base   => $LDAPRoot,
 			filter => $ldapflt,
 			attrs => ['cn']);
 $retcode = $mesg->code;
# mlog($fh,"LDAP search: $retcode");
 if($retcode > 0) {
   seterror($fh,"451 Could not check recipient, try later\r\n",1);
   mlog($fh,"LDAP search error: $retcode -- aborting connection");
   next;
 }
 
 $entry_count = $mesg->count;
 $retmsg = $mesg->entry(1);
 
 #	mlog($fh,"LDAP Results: $entry_count : $retmsg");
 print DEBUG  "got $entry_count result(s) from LDAP lookup\n" if $DEBUG;

 $mesg = $ldap->unbind;  # take down session

 return $entry_count
}
# end modification RO

# compile the regular expression for the spam addresses
sub setSARE {
 # if($spamaddresses && $this->{islocal} && $u=~/^($spamaddresses)\@/i) {
  my (@uad, @u, @d);
  for $a (split(/\|/,$_[0])) {
   if($a=~/\S\@\S/) {
    push(@uad,$a);
   } elsif( $a=~/^\@/ ) {
    push(@d,$a);
   } else {
    push(@u,$a);
   }
  }
  my @s;
  push(@s,'^('.join('|',@uad).')$') if @uad;
  push(@s,'^('.join('|',@u).')@') if @u;
  push(@s,'('.join('|',@d).')$') if @d;
  my $s=join("|",@s);
  $s='<not a valid list>' unless $s;
  SetRE(SARE,$s,'i',"Spam Addresses");
 #$SARE=qr/^($_[0])\@/i;
}

# compile the no-processing regular expression
sub setNPRE {
 #    if("$u$h"=~/^($noProcessing)$/i) {
 SetRE(NPRE,"^($_[0])\$","i","No Processing");
}

sub setNPDRE {
 SetRE(NPDRE1,"($_[0])\$","i","No Processing Domains");
 SetRE(NPDRE2,"($_[0]) ",'i',"No Processing Domains");
}

# a line of input has been received from the smtp client
sub getline {
 my($fh,$l)=@_;
 d(15);
 my $this=$Con{$fh};
 my $server=$this->{friend};
 print DEBUG  "gl: <$l>\n" if $DEBUG;
 if($l=~/^ *(helo|ehlo) .*?([^<>,;"'\(\)\s]+)/i) {
  my $helo = $2;
  my $helo2 = $helo;
  $helo=~s/(\W)/\\\1/g;
  $l =~ s/$helo/$myName/ ;
  $this->{helo}=$helo2;
  $this->{rcvd}=~s/=\)/=$helo2\)/;
  $this->{rcvd}=~s/(.{60,75}) /$1\r\n  /g unless $this->{rcvd}=~/\n/; # wrap long lines
 } elsif($l=~/mail from:.*?($EmailAdrRe\@$EmailDomainRe)/io) {
  $this->{rcpt}=$this->{header}=''; # reset everything else
  $this->{mailfrom}=$1;
  $this->{noprocessing}=0;
 } elsif($l=~/rcpt to: *(.*)/i) {
  my $e=$1;
  my ($u,$h);
  #begin modification RO
  #enforce valid email address pattern
  if ($CanUseAddress && $DoRFC822) {
  	if ($l=~/rcpt to:\s*<*([^\r\n>]*).*/i) {
  		my $RO_e=$1;
  		if (!Email::Valid->address($RO_e)) {
   	# couldn't understand recipient
		   	sendque($fh, "553 malformed address: $RO_e\r\n");
   			mlog($fh,"malformed address: '$RO_e'");
		   	$Stats{norelays}++;
		 	  return;
	  	};
  	}
	}
  # end modification RO
  if($e=~/[\!\%\@]\S*\@/) {
   # blatent attempt at relaying
   sendque($fh, $NoRelaying."\r\n");
   mlog($fh,"relay attempt blocked for (evil): $e");
   $Stats{norelays}++;
   return;
  } elsif($e=~/([a-z\-_\.]+)!([a-z\-_\.]+)$/i) {
   # someone give me one good reason why I should support bang paths! grumble...
   $u="$2@";
   $h=$1;
  } elsif($l=~/rcpt to:.*?($EmailAdrRe\@)($EmailDomainRe)/io) {
   ($u,$h)=($1,$2);
  } elsif($defaultLocalHost && $l=~/rcpt to:.*?<($EmailAdrRe)>/io) {
   ($u,$h)=($1,$defaultLocalHost);
   $u.='@';
  } else {
   # couldn't understand recipient
   sendque($fh, $NoRelaying."\r\n");
   mlog($fh,"relay attempt blocked for (parsing): $e");
   $Stats{norelays}++;
   return;
  }
  #print "rcp <$u$h> r=<$this->{'relayok'}> $fh\n";
  $this->{islocal}=localmail($h);
  # begin modification RO
  # skip check when RELAYOK
  if (!$this->{'relayok'}) {
  	  # Need Check?
  	  if($LocalAddresses_Flat || $DoLDAP) {
  	  	$this->{islocalmailaddress}=0;
  	  }
  	  # check recipient against flat list?
	  if($LocalAddresses_Flat) {
	   if("$u$h"=~$LAFRE) {
	    $this->{islocalmailaddress}=1;
	    print DEBUG  "$u$h validated by flat LocalAddresses list\n" if $DEBUG;
	   }
	  }
	  # Need another check?
	  if (!$this->{islocalmailaddress}) {
		  # check recipient against LDAP ?
		  if ($DoLDAP) {
		  	if ($CanUseLDAP) {
		  		$this->{islocalmailaddress}=localmailaddress($h);
		  	} else {
			  	$this->{islocalmailaddress}=localmail($h);
				mlog($fh,"Net::LDAP not installed, cannot check: $u$h");
			}
		  }
	  }
  } else {
    $this->{islocalmailaddress}=localmail($h);
  }
  # end modification RO
  if(!($this->{'relayok'}) && (! $this->{islocal} || ($u.$h)=~/\%/) || $u =~/\@\w+/) {
   sendque($fh, $NoRelaying."\r\n");
   mlog($fh,"relay attempt blocked for: $u$h");
   $Stats{norelays}++;
   return;
  }
  if($noProcessing) {
   if("$u$h"=~$NPRE) {
    $this->{noprocessing}|=1;
   } else {
    $this->{noprocessing}|=2;
   }
  }
  if($spamaddresses && $this->{islocal} && "$u$h"=~$SARE) {
   $this->{addressedToSpamBucket}=1;
  }
  if($EmailInterfaceOk && $this->{relayok} && $this->{islocal}) {
   if(lc $u eq lc "$EmailSpam\@") {
    $this->{getline}=\&SpamReport;
    mlog($fh,"Email spamreport");
    sendque($fh,"250 ok\r\n");
    return;
   } elsif(lc $u eq lc "$EmailHam\@") {
    $this->{getline}=\&HamReport;
    mlog($fh,"Email hamreport");
    sendque($fh,"250 ok\r\n");
    return;
   } elsif(lc $u eq lc "$EmailWhitelist\@") {
    $this->{getline}=\&EmailWhite;
    mlog($fh,"Email Whitelist");
    for $a (split(/ /,$this->{rcpt})) {EmailWhiteAdd($a,$this)};
    sendque($fh,"250 ok\r\n");
    return;
   }
  }
  # begin modification RO: check local recipients against LDAP
  # $this->{rcpt}.="$u$h ";
  # update: accept SpamBucket addresses in every case
  if (($LocalAddresses_Flat || $DoLDAP) && (! $this->{addressedToSpamBucket})) {
	  if (($this->{islocalmailaddress}) || ($this->{'relayok'}) && ! $this->{islocal}) {
	  	$this->{rcpt}.="$u$h ";
		mlog($fh,"Recipient accepted: $u$h");
  	} else {
  		if ($NoValidRecipient) {
  			$reply = $NoValidRecipient."\r\n";
  		} else {
  			$reply = "550 5.1.1 User unknown\r\n";
  		}
  		$reply =~ s/EMAILADDRESS/$u$h/g;
		sendque($fh, $reply);
		mlog($fh,"Invalid address rejected: $u$h");
		#$Stats{norelays}++;
		# increment error and drop line if necessary
		if($this->{serverErrors}++ > $MaxErrors) {
			mlog($fh,"Max errors ($MaxErrors) exceeded -- dropping connection");
			done($fh);
		}
		return;
  	}
  } else {
    #mlog($fh,"Recipient accepted unchecked: $u$h");
    $this->{rcpt}.="$u$h ";
  }
  # end modification RO: check local recipients against LDAP
 } elsif( $l=~/^ *XEXCH50 +(\d+)/i ) {
  $this->{skipbytes}=$1;
  print DEBUG "XEXCH50 b=$1\n" if $DEBUG;
 } elsif( $l=~/^ *DATA/i || $l=~/^ *BDAT (\d+)/i ) {
  if($1) {
   $this->{bdata}=$1;
   #mlog($fh,"BDAT issued -- d=$1");
  } else { delete $this->{bdata}; }
  if($this->{noprocessing}==1 ||
     $noProcessing && $this->{mailfrom}=~$NPRE) {
   # all addresses are on no-processing list
    # This code allows blocking of attachments from No-Processing addresses as well. - JC.
    $this->{noprocessing}=1;
    if($BlockNPExes) {
      $this->{getline}=\&whitebodyNoExe;
      } else {
      $this->{getline}=\&whitebody;
      mlog($fh,"message proxied without processing - (attachments unchecked)");
      }
  } else {
   MaillogStart($fh); # notify the stream logging to start logging
   $this->{getline}=\&getheader;
  }
  # begin modification RO: count only messages with valid recipients
  if ($this->{rcpt} =~/@/) {
  	$Stats{messages}++;
  	#mlog($fh,"message $Stats{messages} to: $this->{rcpt}");
  }
  #$Stats{messages}++;
  # end modification RO: count only messages with valid recipients
 } elsif( $l=~/^ *RSET/i ) {
  $this->{mailfrom}=$this->{rcpt}=$this->{header}='';
  $this->{noprocessing}=0;
 }
 sendque($server, $l);
}

# compile the blacklisted domains regular expression
sub setBLDRE {
 # } elsif( $blackListedDomains && ($this->{mailfrom}=~/($blackListedDomains)$/i || $this->{senders}=~/($blackListedDomains) /i)) {
 SetRE(BLDRE1,"($_[0])\$","i","Blacklisted Domains");
 SetRE(BLDRE2,"($_[0]) ",'i',"Blacklisted Domains");
}

# compile the helo-blacklist ignore regular expression
sub setHBIRE {
 SetRE(HBIRE,"^($_[0])\$","i","HELO Blacklisted Ignore");
}

# get the header part of the DATA.
sub getheader { #Modified by JC.
 my($fh,$l)=@_;
 d(18);
 my $this=$Con{$fh};
 $this->{header}.=$l;
 if($l=~/^\.?[\r\n]*$/) {
  $this->{maillength}=length($this->{header});
  # header is done
  $this->{spamfound}=0; #Resets spam found flag.
  if($npRe && $this->{header}=~$npReRE || 
     $noProcessingDomains && ($this->{mailfrom}=~$NPDRE1 || $this->{senders}=~$NPDRE2)) {
    $this->{noprocessing}=1;
    if($BlockNPExes) {
      $this->{getline}=\&whitebodyNoExe;
    } else {
      mlog($fh,"message proxied without processing - (attachments unchecked)");
      isnotspam($fh);
    }
  } elsif(onwhitelist($fh,$this->{header})) {
   if($BlockWLExes) {
     $this->{getline}=\&whitebodyNoExe;
   } else {
     Maillog($fh,'',2); # tell maillog this isn't spam
     $SpamProb=0; addSpamProb($fh);
     isnotspam($fh);
     mlog($fh,'local or whitelisted - (attachments unchecked)');
   }
  } elsif($blackListedDomains && ($this->{mailfrom}=~$BLDRE1 || $this->{senders}=~$BLDRE2)) {
   $Stats{spams}++;
   thisIsSpam($fh,'has blacklisted domain',$blDomainLog);
  } elsif(!$noHeloBlacklist
    && (! $heloBlacklistIgnore || $this->{helo} !~ $HBIRE)
    && $HeloBlackObject && $HeloBlack{$this->{helo}}) {
   $Stats{spams}++;
   thisIsSpam($fh,"has spam helo '$this->{helo}'",$spamHeloLog);
  } elsif($this->{addressedToSpamBucket}) {
   $Stats{spams}++;
   thisIsSpam($fh,'has spam address',$spamBucketLog);
  } else {
   # not whitelisted, not spamaddress, let's see if it's spam or not
   $this->{getline}=\&getbody;
  }
 }
}

# compile the spam-lovers regular expression
sub setSLRE {
  my (@uad, @u, @d);
  for $a (split(/\|/,$_[0])) {
   if($a=~/\S\@\S/) {
    push(@uad,$a);
   } elsif( $a=~/^\@/ ) {
    push(@d,$a);
   } else {
    push(@u,$a);
   }
  }
  my @s;
  push(@s,'^('.join('|',@uad).')$') if @uad;
  push(@s,'^('.join('|',@u).')@') if @u;
  push(@s,'('.join('|',@d).')$') if @d;
  my $s=join("|",@s);
  $s='<not a valid list>' unless $s;
  #print "slre s=$s>>\n";
  SetRE(SLRE,$s,'i',"Spam Lovers");
}

# returns true if all the addresses in the space separated list are spam-lovers
sub allLoveSpam {
 my $rcpt=shift;
 #print "r=$rcpt\n";
 my $c=0;
 for (split(' ',$rcpt)) {
  #print "a=$_\n";
  #print "yes\n" if $_=~$SLRE;
  return 0 unless $_=~$SLRE;
  $c++;
 }
 $c;
}

# the message is not spam -- route it to the server
sub isnotspam {
 my $fh=shift;
 d(23);
 my $done=shift;
 my $this=$Con{$fh};
 my $server=$this->{friend};
 my $m=$this->{header};
 sendque($server, $m);
 $this->{header}='';
 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)=@_; #Modified by JC.
 my $this=$Con{$fh};
 d(25);
 my $server=$this->{friend};
 $this->{maillength}+=length($l); #Significant performance boost by not storing data.
 my $done=$l=~/^\.[\r\n]*$/ || defined($this->{bdata}) && $this->{bdata}<=0;
 if($done) {
  $this->{getline}=\&getline;
 } else {
  if($this->{maillength}>=$AVBytes) {
    if (!$AVBytes) {
      checkInfection($fh,$l); # Full Scan
    }
  } else {
    checkInfection($fh,$l); # Scan up to AV Bytes.
  }
 }
 sendque($server, $l);
}

# the message is non spam -- check if it is executable
sub whitebodyNoExe { my($fh,$l)=@_; #Modified by JC.
 my $this=$Con{$fh};
 d(255);
 my $b=$this->{header}.=$l;
 my $done=$l=~/^\.[\r\n]*$/ || defined($this->{bdata}) && $this->{bdata}<=0;
 checkInfection($fh,$l);
 if( $done || length($b) >=$MaxBytes) {
  $this->{maillength}=length($b);
  if($badattach && $b=~$badattachRE) {
   $Stats{viri}++;
   Maillog($fh,'',$wlAttachLog);
   if ($this->{noprocessing}==1) {
     mlog($fh,'bad attachment (noprocessing)');
   } else {
     mlog($fh,'bad attachment (local/white)'); 
   }
   seterror($fh,$AttachmentError,$done);
  } else {
   if ($this->{noprocessing}==1) {
     mlog($fh,'message proxied without processing -(no bad attachments)');
     isnotspam($fh,$done);
   } else {
     $SpamProb=0; addSpamProb($fh); 
     Maillog($fh,'',2); # tell maillog this isn't spam
     mlog($fh,'local or whitelisted - (no bad attachments)');
     isnotspam($fh,$done);
   }
  }
 }
}

# the message may or may not be spam -- get the body and test it.
sub getbody { my($fh,$l)=@_; #Modified by JC.
 d(27);
 my $this=$Con{$fh};
 my $b=$this->{header}.=$l;
 my $done=$l=~/^\.[\r\n]*$/ || defined($this->{bdata}) && $this->{bdata}<=0;
 print DEBUG "bd='$this->{bdata}'\n" if $DEBUG;
 checkInfection($fh,$l);
 if( $done || length($b) >=$MaxBytes) {
  $this->{maillength}=length($b);
  if($bombRe && $b=~$bombReRE) {
   $Stats{bombs}++;
   Maillog($fh,'',$spamBombLog);
   mlog($fh,"mail bomb");
   seterror($fh,$bombError,$done);
  } elsif($scriptRe && $b=~$scriptReRE) {
   $Stats{scripts}++;
   Maillog($fh,'',$scriptLog);
   mlog($fh,"contains scripting");
   seterror($fh,$scriptError,$done);
  } elsif($BlockExes && $badattach && $b=~$badattachRE) {
   $Stats{viri}++;
   Maillog($fh,'',$extAttachLog);
   mlog($fh,'bad attachment (external)');
   seterror($fh,$AttachmentError,$done);
  } elsif($this->{spamfound}) {
   # Spam is found to be safe, lets pass it on.
   mlog($fh,"Spam determined to be safe, passing on to recipient");
   isnotspam($fh,$done);
  } elsif(isspam($b,$this->{ip})) {
   $Stats{bspams}++;
   thisIsSpam($fh,'Bayesian Spam',$baysSpamLog,$done);
  } else {
   # skip saving Bayesian nonspam -- prevents false negs from corrupting corpus
   $Stats{bhams}++;
   Maillog($fh,'',$baysNonSpamLog);
   addSpamProb($fh);
   mlog($fh,"message ok");
   isnotspam($fh,$done);
  }
 }
}

sub checkInfection {  #Modified by JC.
 my ($fh,$l)=@_;
 my $this=$Con{$fh};
 return unless $AvDbs && (!$this->{islocal} || ($Avlocal && $this->{islocal})); 
 my $av;
 unless($av=$Con{$fh}->{av}) {
  $av=$Con{$fh}->{av}=Av->new();
 }
 $l=~s/([a-zA-Z0-9+\/=]{40,}\s*)/base64decode($1)/e;
 my $r;
 my $n=0;
 for(;$n<length($l); $n++) {
  if($r=$av->addchar(substr($l,$n,1))) {
   # this mail is infected
   my $er=$AvError;
   $er=~s/\$infection/$r->[1]/gi;
   mlog($fh,"virus detected '$r->[1]'");
   $Stats{viri}++;
   $Stats{viridetected}++;
   seterror($fh,$er);
  }
 }
}
#This is spam, lets see if its test mode or spamlover.
sub thisIsSpam { #Modified by JC.
 my ($fh,$reason,$log,$done)=@_;
 my $this=$Con{$fh};
 addSpamProb($fh);
 $this->{spamfound}=1; #Set spamfound flag.
 my $slok;
 if($TestMode || ($slok=$spamLovers && allLoveSpam($this->{rcpt}))) {
  if($slok) {
   mlog($fh,"Passing if safe because spamlover: $this->{rcpt}, otherwise $reason");
   $Stats{spamlover}++;
  } else {
   mlog($fh,"Passing if safe because testmode, otherwise $reason");
  }
  # pretend it's not spam
  $this->{header}=~s/\n(\r?\n)/\nSubject: $1$1/ unless $this->{header}=~/\nSubject:/i;
  $this->{header}=~s/\nSubject:/\nSubject: $spamSubject/i if $spamSubject;
  $this->{header}=~s/\n(\r?\n)/\nX-Assp-Spam: YES$1$1/i if $AddSpamHeader;
  #Lets check if its safe to pass if not already done so. 
  if ($done) {
    Maillog($fh,'',$log); # tell maillog what this is.
    mlog($fh,"Spam determined to be safe, passing on to recipient");
    isnotspam($fh,$done);
  } else {
    $this->{getline}=\&getbody;
  }
 } else {
  Maillog($fh,'',$log); # tell maillog what this is.
  mlog($fh,$reason);
  seterror($fh,$SpamError,$done); 
 }
}

# reject the email
sub seterror {
 my($fh,$e,$done)=@_;
 d(28);
 my $this=$Con{$fh};

 $this->{error}=$e;
 if($done) {
  error($fh,".\r\n");
 } else {
  $this->{getline}=\&error;
  $this->{header}=''; # free up some memory
 }
 # detatch the friend -- closing connection to server & disregarding message
 done2($this->{friend});
 $this->{friend}=undef;
}

# ignore what's sent & give reason at the end.
sub error { my($fh,$l)=@_;
 d(29);
 my $this=$Con{$fh};
 if( $l=~/^\.[\r\n]*$/ || defined($this->{bdata}) && $this->{bdata}<=0) {
  print $fh $this->{error}."\r\n";
  done2($fh);
 }
}

# filter off the 250 OK noop response and go to reply
sub skipok {
 d(291);
 my ($fh,$l)=@_;
 if($l=~/^250/) {
  $Con{$fh}->{getline}=\&reply;
 } else {
  reply(@_);
 }
}

# messages from the server get relayed to the client
sub reply {
 my($fh,$l)=@_;
 d(30);
 my $this=$Con{$fh};
 return unless $this;
 my $cli=$this->{friend};
 return unless $cli;

 if($l=~/250-CHUNKING/i) {
  # we'll filter off the chunking directive to avoid BDAT problems.
  d('CHUNKING');
  return;
  # begin modification RO: disable advertizing XEXCH50
 } elsif($l=~/250-XEXCH50/i) {
  # we'll filter off the XEXCH50 service, as it only causes troubles
  d('XEXCH50');
  return;
  # end modification RO: disable advertizing XEXCH50
 } elsif($l=~/250-.*STARTTLS/i) {
  # we'll filter off the STARTTLS directive to avoid TLS problems.
  d('STARTTLS');
  return;
 } elsif($l=~/^220/) {
  #print DEBUG "sending $this->{noop}" if $DEBUG && $this->{noop};
  sendque($fh,$this->{noop}) if $this->{noop};
  delete $this->{noop};
 } elsif($l=~/^235/) {
  # check for authentication response
  $Con{$cli}->{relayok}=1;
  print DEBUG  "$Con{$cli}->{ip}: authenticated\n" if $DEBUG;
  mlog($cli,"Authenticated");
 } elsif($l=~/^354/) {
  d(301);
 } elsif($l=~/^50[0-9]/) {
  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($this->{serverErrors}++ > $MaxErrors) {
   mlog($fh,"Max errors ($MaxErrors) exceeded -- dropping connection");
   done($fh);
  }
 }

 #print "r: $l ($fh) ($cli)\n";
 sendque($cli, $l);
}


#####################################################################################
#                Email Interface

# this mail isn't really a mail -- it's a spam report
sub SpamReport {
 my($fh,$l)=@_;
 my $this=$Con{$fh};
 if( $l=~/^ *DATA/i || $l=~/^ *BDAT (\d+)/i ) {
  if($1) {
   $this->{bdata}=$1;
   #mlog($fh,"BDAT issued -- d=$1");
  } else { delete $this->{bdata}; }
  $this->{getline}=\&SpamReport2;
  sendque($fh,"354 ok\r\n");
  return;
 } elsif( $l=~/^ *RSET/i ) {
  $this->{getline}=\&getline;
  sendque($this->{friend},"RSET\r\n");
 } elsif( $l=~/^ *XEXCH50 +(\d+)/i ) {
  #$this->{skipbytes}=$1;
  print DEBUG "XEXCH50 b=$1\n" if $DEBUG;
  #sendque($fh,"354 Send binary data\r\n");
  sendque($fh,"504 need to authenticate first\r\n"); # this is Tim Walker's idea -- appears to work for him
  return;
 }
 sendque($fh,"250 ok\r\n");
}

# we're getting the body of a spam report
sub SpamReport2 {
 my ($fh, $l)=@_;
 $Con{$fh}->{header}.=$l if length($Con{$fh}->{header}) < $MaxBytes;
 if($l=~/^\.[\r\n]/ || defined($this->{bdata}) && $this->{bdata}<=0) {
  # we're done -- write the file & clean up
  my $this=$Con{$fh};
  my $sub=ReportMail($this->{header},$correctedspam);
  $this->{header}='';
  ReturnMail($this->{mailfrom},"$base/spamreport.txt",$sub) unless $NoHaiku;
  $this->{getline}=\&getline;
  sendque($this->{friend},"RSET\r\n");
 }
}

# this mail isn't really a mail -- it's a false-positive report
sub HamReport {
 my($fh,$l)=@_;
 my $this=$Con{$fh};
 if( $l=~/^ *DATA/i || $l=~/^ *BDAT (\d+)/i ) {
  if($1) {
   $this->{bdata}=$1;
   #mlog($fh,"BDAT issued -- d=$1");
  } else { delete $this->{bdata}; }
  $this->{getline}=\&HamReport2;
  sendque($fh,"354 ok\r\n");
  return;
 } elsif( $l=~/^ *RSET/i ) {
  $this->{getline}=\&getline;
  sendque($this->{friend},"RSET\r\n");
 } elsif( $l=~/^ *XEXCH50 +(\d+)/i ) {
  #$this->{skipbytes}=$1;
  print DEBUG "XEXCH50 b=$1\n" if $DEBUG;
  #sendque($fh,"354 Send binary data\r\n");
  sendque($fh,"504 need to authenticate first\r\n"); # this is Tim Walker's idea -- appears to work for him
  return;
 }
 sendque($fh,"250 ok\r\n");
}

# we're getting the body of a ham report
sub HamReport2 {
 my ($fh, $l)=@_;
 $Con{$fh}->{header}.=$l if length($Con{$fh}->{header}) < $MaxBytes;
 if($l=~/^\.[\r\n]/ || defined($this->{bdata}) && $this->{bdata}<=0) {
  # we're done -- write the file & clean up
  my $this=$Con{$fh};
  my $sub=ReportMail($this->{header},$correctednotspam);
  $this->{header}='';
  ReturnMail($this->{mailfrom},"$base/notspamreport.txt",$sub) unless $NoHaiku;
  $this->{getline}=\&getline;
  sendque($this->{friend},"RSET\r\n");
 }
}

sub ReportMail {
 my ($bod,$path)=@_;
 my ($sub)=$bod=~/Subject: (.*)/i;
 $sub=~s/\r//;
 $bod=~s/^.*?\n\r?\n\s*//s;
 # remove the spam subject header addition if present
 my $spamsub=$spamSubject;
 if($spamsub) {
  $spamsub=~s/(\W)/\\$1/g;
  $bod=~s/Subject: $spamsub */Subject: /gi;
 }
 $bod=~s/X-Assp-Spam-Prob: .*\n//gi;
 if($bod=~/\nReceived: /) {
  $bod=~s/^.*?\nReceived: /Received: /s;
 } else {
  $bod=~s/^.*?\n((\w[^\n]*\n)*Subject:)/$1/si;
  $bod=~s/\n> /\n/g;
 }
 my $f;
 do {
  $f=int(rand()*100000000);
 } while(-e "$base/$path/$f.rpt");
 open(F,">$base/$path/$f.rpt"); binmode F;
 print F $bod;
 close F;
 $sub;
}

# we're receiving an email to add addresses to the whitelist
sub EmailWhite {
 my($fh,$l)=@_;
 d('EmailWhite');
 my $this=$Con{$fh};
 if( $l=~/^ *DATA/i || $l=~/^ *BDAT (\d+)/i ) {
  if($1) {
   $this->{bdata}=$1;
   #mlog($fh,"BDAT issued -- d=$1");
  } else { delete $this->{bdata}; }
  $this->{getline}=\&EmailWhiteBody;
  sendque($fh,"354 OK Send whitelist body\r\n");
  return;
 } elsif( $l=~/^ *RSET/i ) {
  $this->{getline}=\&getline;
  sendque($this->{friend},"RSET\r\n");
  return;
 } elsif( $l=~/^ *XEXCH50 +(\d+)/i ) {
  #$this->{skipbytes}=$1;
  print DEBUG "XEXCH50 b=$1\n" if $DEBUG;
  #sendque($fh,"354 Send binary data\r\n");
  sendque($fh,"504 need to authenticate first\r\n"); # this is Tim Walker's idea -- appears to work for him
  return;
 } else {
  for $a ($l=~/($EmailAdrRe\@$EmailDomainRe)/og) {
   EmailWhiteAdd($a,$this);
   $this->{rcpt}.="$a ";
  }
 }
 sendque($fh,"250 OK\r\n");
}

sub EmailWhiteBody {
 my($fh,$l)=@_;
 #print "ew2($l) ";
 d('EmailWhiteBody');
 my $this=$Con{$fh};
 if($l=~/^\.[\r\n]/ || defined($this->{bdata}) && $this->{bdata}<=0) {
  # mail summary report
  ReturnMail($this->{mailfrom},"$base/whitereport.txt",'',"$this->{rcpt}\n\n$this->{report}\n") unless $NoHaiku;
  delete $this->{report};
  $this->{getline}=\&getline;
  sendque($this->{friend},"RSET\r\n");
 } elsif($l=~/message-id:/i) {
  # ignore
 } else {
  for $a ($l=~/($EmailAdrRe\@$EmailDomainRe)/go) {
   EmailWhiteAdd($a,$this);
  }
 }
}

sub EmailWhiteAdd {
 my ($a,$this)=@_;
 my $t=time;
 if(localmail($a)) {
  $this->{report}.="$a: Cannot add local users to whitelist\n";
 } elsif( $Whitelist{lc $a} ) {
  $this->{report}.="$a: already on whitelist\n";
  mlog(0,"email whitelist addition: $a");
  $Whitelist{lc $a}=$t;
 } else {
  $this->{report}.="$a: added\n";
  mlog(0,"email new whitelist addition: $a");
  $Whitelist{lc $a}=$t;
 }
}


sub ReturnMail {
 my($from,$file,$sub,$bod)=@_;
 my $s=new IO::Socket::INET(Proto=>'tcp',PeerAddr=>$smtpDestination,Timeout=>2);
 if(! $s) {
  mlog('',"Couldn't create server socket to $smtpDestination -- aborting ReturnMail connection");
  return;
 }
 addfh($s,\&RMhelo);
 my $this=$Con{$s};
 $this->{to}=$from;
 $this->{from}=$EmailFrom;
 open(F,"<$file") || mlog(0,"Couldn't open '$file' for mail report");
 local $/="\n";
 my $subject=<F>;
 $subject=~s/\s*(.*)\s*/$1 $sub/;
 $this->{subject}=$subject;
 undef $/;
 $this->{body}=<F>.$bod;
 close F;
 $this->{body}=~s/\r?\n/\r\n/g;
}

sub RMhelo { my ($fh,$l)=@_;
 if($l=~/^ *5/) {
  RMabort($fh,"helo Expected 220, got: $l");
 } elsif($l=~/^ *220 /) {
  sendque($fh,"HELO $myName\r\n");
  $Con{$fh}->{getline}=\&RMfrom;
 }
}
sub RMfrom { my ($fh,$l)=@_;
 if($l=~/^ *5/) {
  RMabort($fh,"from Expected 250, got: $l");
 } elsif($l=~/^ *250 /) {
  sendque($fh,"MAIL FROM: ".($Con{$fh}->{from}=~/(<[^<>]+>)/?$1:$Con{$fh}->{from})."\r\n");
  $Con{$fh}->{getline}=\&RMrcpt;
 }
}
sub RMrcpt { my ($fh,$l)=@_;
 if($l=~/^ *5/) {
  RMabort($fh,"rcpt Expected 250, got: $l");
 } elsif($l=~/^ *250 /) {
  sendque($fh,"RCPT TO: <$Con{$fh}->{to}>\r\n");
  $Con{$fh}->{getline}=\&RMdata;
 }
}
sub RMdata { my ($fh,$l)=@_;
 if($l=~/^ *5/) {
  RMabort($fh,"data Expected 250, got: $l");
 } elsif($l=~/^ *250 /) {
  sendque($fh,"DATA\r\n");
  $Con{$fh}->{getline}=\&RMdata2;
 }
}
sub RMdata2 { my ($fh,$l)=@_;
 if($l=~/^ *5/) {
  RMabort($fh,"data2 Expected 354, got: $l");
 } elsif($l=~/^ *354 /) {
  my $date=gmtime();
  $date=~s/(\w+) +(\w+) +(\d+) +(\S+) +(\d+)/$1, $3 $2 $5 $4/;
  my $this=$Con{$fh};
  sendque($fh,<<EOT);
From: $this->{from}\r
To: $this->{to}\r
Subject: $this->{subject}\r
X-Assp-Report: YES\r
Date: $date +0000\r
\r
$this->{body}\r
.\r
EOT
  $Con{$fh}->{getline}=\&RMdone;
 }
}
sub RMdone { my ($fh,$l)=@_;
 if($l=~/^ *5/) {
  RMabort($fh,"done Expected 250, got: $l");
 } elsif($l=~/^ *250 /) {
  done2($fh); # close and delete
 }
}
sub RMabort {mlog(0,"RMabort: $_[1]"); done2($_[0]);}


#####################################################################################
#                SPAM Detection

# check if the message is spam, based on Bayesian factors in $Spamdb
sub isspam {
 my $msg=$_[0];
 return $SpamProb=0 if $whiteRe && $msg=~$whiteReRE;
 return $SpamProb=1 if $blackRe && $msg=~$blackReRE;
 local $b=clean($_[0]);
 return $SpamProb=0 if $whiteRe && $b=~$whiteReRE;
 return $SpamProb=1 if $WhiteOnly || $blackRe && $b=~$blackReRE;
 my $ip=$_[1];
 d(31);
 my $ip3=$ip;
 $ip3=~s/(\d+\.\d+\.\d+).*/$1/;
 my ($v,$lt,$llt,$t,%seen);
 my @t;
 #print "ip=$ip ($Dnsbl{$ip}) ip3=$ip3 ($Dnsbl{$ip3})\n";
 if(defined($Dnsbl{$ip}) || defined($Dnsbl{$ip3})) {
  mlog('',"$ip dnsbl hit");
  #return $SpamProb=1; ## for DNSBL only
  push(@t,0.97);
 }
 if($greylist) {
  if ($ispip && $ispip=~$ip3) {   #Start - Added for ISP greylisting JC. 
     if ($ispgreyvalue) {
       $v=$ispgreyvalue;
     } else {
       $v=$Greylist{'x'};
     }
   } else {
     $v=$Greylist{$ip3} || $Greylist{'x'};
  }                                    #End - Added for ISP greylisting JC.
  print DEBUG "gl=$v <$Greylist{$ip3}>\n" if $DEBUG;
  push(@t,$v,$v) if $v;
 }
 while($b=~/([-\$A-Za-z0-9\'\.!\240-\377]+)/g) {
  next if length($1) > 20;
  $llt=$lt; $lt=$t; $t=lc $1;
  #next if $t=~/^\d/; # ignore numbers
  $t=~s/[,.']+$//; $t=~s/!!!+/!!/g; $t=~s/--+/-/g;
  #push(@t,$v) if ($v=$Spamdb{$t});
  #my $j="$lt $t"; #print "$t:$spa{$t} ";
  #push(@t,$v) if ($v=$Spamdb{$j});
  my $j="$lt $t"; #print "$t:$spa{$t} ";
  next if $seen{$j}++ >1; # first two occurances are significant
  push(@t,$v) if ($v=$Spamdb{$j});
 }
 @t=sort {abs($b-.5)<=>abs($a-.5)} @t;
 @t=@t[0..30];
 #print "\n",join(',',@t),"\n";
 my $p1=1; my $p2=1; for $p (@t) {if($p) {$p1*=$p; $p2*=(1-$p);}}
 $p1=$p1/($p1+$p2);
 #printf("isspam= %.4f\n",$p1);
 $SpamProb=$p1;
 $p1<.6? 0: 1;
}

# attach a header line to the message if the config option is set
sub addSpamProb {
 #print "asp: $AddSpamProbHeader; nesp=$NoExternalSpamProb rok=$Con{$_[0]}->{relayok};\n";
 return unless $AddSpamProbHeader;
 my $fh=shift;
 my $this=$Con{$fh};
 return if $NoExternalSpamProb && $this->{relayok};  ## rainer likes it this way
 my $spamprob=sprintf("X-Assp-Spam-Prob: %.5f\r\n",$SpamProb);
 $this->{spamprob}=$spamprob."X-Intended-For: $this->{rcpt}\r\n" if $sendAllSpam;
 $this->{header}=~s/\r?\nX-Assp-Spam-Prob: [0-9\.]+//g; # clear out existing spam prob
 $this->{header}=~s/^(.*?)(\r?\n)\r?\n/$1$2$spamprob$2/s;
}

sub setWLDRE {
 # if($Whitelist{$a} || $whiteListedDomains && $a=~/($whiteListedDomains)$/i) {
 SetRE(WLDRE,"($_[0])\$",'i',"Whitelisted Domains");
}

# begin modification RO
sub setLAFRE {
 # if($Whitelist{$a} || $whiteListedDomains && $a=~/($whiteListedDomains)$/i) {
  my (@uad, @u, @d);
  for $a (split(/\|/,$_[0])) {
   if($a=~/\S\@\S/) {
    push(@uad,$a);
   } elsif( $a=~/^\@/ ) {
    push(@d,$a);
   } else {
    push(@u,$a);
   }
  }
  my @s;
  push(@s,'^('.join('|',@uad).')$') if @uad;
  push(@s,'^('.join('|',@u).')@') if @u;
  push(@s,'('.join('|',@d).')$') if @d;
  my $s=join("|",@s);
  $s='<not a valid list>' unless $s;
  SetRE(LAFRE,$s,'i',"LocalAddresses");
  #SetRE(LAFRE,"($_[0])\$",'i',"Local Addresses");
  #print "LAFre s=$LAFRE>>\n";
}
# end modification RO

# see if the address in the mailfrom is on the whitelist
# meanwhile update the whitelist if that seems appropriate
sub onwhitelist {
 my($fh,$header,$a)=@_;
 d(32);
 my $this=$Con{$fh};

 $a=lc $this->{mailfrom};
 my $whitelisted=$this->{relayok};
 $Stats{locals}++ if $whitelisted;
 return $whitelisted unless $a; # don't add to the whitelist unless there's a valid envelope -- prevent bounced mail from adding to the whitelist
 $this->{red}= ( $Redlist{$a} || ($redRe && $header=~$redReRE) );
 my %senders;
 unless($whitelisted) {
  $senders{$a}=1;
  if(! $NotGreedyWhitelist) {
   while($header=~/\n(from|sender|reply-to|errors-to|list-\w+):.*?($EmailAdrRe\@$EmailDomainRe)/igo) {
    #print "$1:$2  ";
    $senders{lc $2}=1;
   }
  }
  for $a (keys %senders) {
   #print "wl: $a '$Whitelist{$a}'  ";
   return 0 if $a && $Redlist{$a};
   next if localmail($a) || $a eq '';
   if($whiteListedDomains && $a=~$WLDRE) {
    d("wld '$&'");
    $whitelisted=1;
    last;
   } elsif($Whitelist{$a}) {
    d("on whitelist");
    $whitelisted=1;
    last;
   }
  }
  $this->{senders}=join(' ',keys %senders)." "; # used for finding blacklisted domains
  $Stats{whites}++ if $whitelisted;
 }
 # don't add to whitelist if sender is redlisted
 return $whitelisted if $this->{red} || $WhitelistLocalOnly && !$this->{relayok};
 if($whitelisted) {
  # keep the whitelist up-to-date
  my %a=%senders;
  my $t=time;
  $a{$a}=1;
  $header=~s/\n\s+/ /g;
  while($header=~/\n(to|cc): (.*)/ig) {
   #print "h=$2\n";
   my $a=$2;
   while($a=~/($EmailAdrRe\@$EmailDomainRe)/go) {
    $a{lc $1}=1;
   }
  }
  #print "r=$this->{rcpt}\n";
  for $a (split(' ',lc $this->{rcpt})) {
   $a{$a}=1;
  }
  for $a (keys %a) {
   #print "wl+$a ";
   next if localmail($a) || ! $a;
   #print "notlocal ";
   next if $whiteListedDomains && $a=~$WLDRE;
   #print "whitelist+ $a\n";
   mlog($fh,"whitelist addition: $a") unless $Whitelist{$a};
   $Whitelist{$a}=$t;
  }
  #print "you are on the whitelist or are a relay client\n";
  return 1;
 }
 #print "you are NOT on the whitelist\n";
 0;
}

# clean up source email
sub clean {
 local $_="\n".shift;
 my ($helo)=/helo=([^)]+)\)/i;
 $helo=~s/(\w+)/ hlo $1 /g if length($helo) > 19; # if the helo string is long, break it up
 my $rcpt="rcpt ".join(" rcpt ",/($EmailAdrRe\@$EmailDomainRe)/g);
 # replace &#ddd encoding
 s/&#(\d{1,3});?/chr($1)/ge;
 #s/base64.{0,99}\n\n([a-zA-Z0-9+\/\n=]+)/base64decode($1)/gse;
 # replace base64 encoding
 s/\n([a-zA-Z0-9+\/=]{40,}\r?\n[a-zA-Z0-9+\/=\r\n]+)/base64decode($1)/gse;
 # clean up quoted-printable references
 s/(Subject: .*)=\r?\n/$1\n/;
 #if(/quoted-printable/) {
  s/=\r?\n//g;
  s/=([0-9a-fA-F]{2})/pack("C",hex($1))/gei;
 #}
 #s/(http:\/\/\S+)/fixurl($1)/ige;
 s/%([0-9a-fA-F][0-9a-fA-F])/pack('C',hex($1))/ge; # replace url encoding
 # strip out mime continuation
 s/.*---=_NextPart_.*\n//g;
 # mark the subject
 s/\nsubject: (.*)/fixsub($1)/ige;
 # remove received lines
 s/\n(received|Content-Type): .*(\n[\t ].*)*//ig;
 # remove other header lines
 s/(\n[a-zA-Z\-]{2,40}: .*(\n[\t ].*)*){2,}//g;
 # clean up &nbsp; and &amp;
 s/&nbsp;?/ /gi; s/&amp;?/and/gi;
 s/(\d),(\d)/$1$2/g;
 s/\r//g; s/ *\n/\n/g;
 s/\n\n\n\n\n+/\nblines blines\n/g;
 # clean up html stuff
 s/<script.*?>\s*(<!\S*)?/ jscripttag jscripttag /ig;
 while(s/(\w+)(<[^>]*>)((<[^>]*>)*\w+)/$2$1$3/g){} # move html out of words
 s/<([biu]|strong)>/ boldifytext boldifytext /gi;
 # remove some tags that are not informative
 s/<\/?(p|br|div|t[dr])[^>]*>/\n/gi; s/<\/([biu]|font|strong)>//gi;
 s/<\/?(html|meta|head|body|span|o)[^>]*>//ig;
 s/(<a\s[^>]*>)(.*?)(<\s*\/a\s*>)/$1.fixlinktext($2).$3/igse;
 s/<\s*\/a\s*>//gi;
 # treat titles like subjects
 s/<title[^>]*>(.*?)<\/title>/fixsub($1)/ige;
 # remove style sheets
 s/<style[^>]*>.*?<\/style>//igs;
 # remove html comments
 s/<!.*?-->//gs; s/<![^>]*>//g;
 # look for random words
 s/[ a-z0-9][ghjklmnpqrstvwxz_]{2}[bcdfghjklmnpqrstvwxz_0-9]{3}\S*/ randword randword /gi;
 # remove mime separators
 s/\n--.*randword.*//g;
 # look for linked images
 s/(<a[^>]*>[^<]*<img)/ linkedimage linkedimage $1/gis;
 s/<[^>]*href\s*=\s*("[^"]*"|\S*)/fixhref($1)/isge;
 s/http:\/\/(\S*)/fixhref($1)/isge;
 s/(\S+\@\S*\.\w{2,3})\b/fixhref($1)/ge;
 #open(F,">t"); print F $_; close F;
 "helo: $helo\n$rcpt\n$_";
 #"helo: $helo\n$rtime\n$_";
}

sub dayofweek {
 # this is mercilessly hacked from John Von Essen's Date::Day
 my ($d, $m, $y)=$_[0]=~/(\S+) +(\S+) +(\S+)/;
 $y+=2000;
 $m=$Months{$m};
 if($m <= 2){ $y--; }
 my $wday = (($d+$Month{$m}+$y+(int($y/4))-(int($y/100))+(int($y/400)))%7);
 return $Weekday{$wday};
}

sub fixhref { my $t=shift; $t=~s/(\w+)/ href $1 /g; $t;}

sub fixlinktext { my $t=shift; $t=~s/(\w+)/atxt $1/g; $t;}

sub fixurl {
 my $a=shift;
 $a=~s/%([0-9a-fA-F][0-9a-fA-F])/pack('C',hex($1))/ge;
 $a;
}

sub fixsub {
 my $s=shift;
 #print "$s=>";
 $s=~s/ {3,}/ lotsaspaces /g;
 $s=~s/(\S+)/ssub $1/g;
 #print "$s\n";
 "\n$s ssub";
}

sub base64decode {
 my $str = shift;
 my $res;
 $str =~ tr|A-Za-z0-9+/||cd;
 $str =~ tr|A-Za-z0-9+/| -_|;
 while ($str =~ /(.{1,60})/gs) {
  my $len = chr(32 + length($1)*3/4);
 $res .= unpack("u", $len . $1 );
 }
 $res;
}

sub downloadGrey {
 # let's check if we really need to
 my @s=stat("$base/$greylist");
 my $mtime=$s[9];
 if(time - $mtime< 12*3600) {
  $NextGreylistDownload=$mtime + 12*3600;
  return;
 }
 my $peeraddress,$connect;
 if ($proxyserver) {
   mlog(0,"Freshening greylist via Proxy:$proxyserver");
   $peeraddress = $proxyserver;
   $connect = "GET http://assp.sourceforge.net/greylist.txt HTTP/1.0

";
 } else {
   mlog(0,"Freshening greylist via Direct Connection");
   $peeraddress = "assp.sourceforge.net:80";
   $connect = "GET /greylist.txt HTTP/1.1
Host: assp.sourceforge.net

";
 }
 my $s=new IO::Socket::INET(Proto=>'tcp',PeerAddr=>$peeraddress,Timeout=>2);
 if($s) {
  print $s $connect;
  $SocketCalls{$s}=\&GreyTraffic;
  $readable->add($s);
  $NextGreylistDownload=time+3600*12;
  open(GREYTEMP,">$base/$greylist.tmp");
  binmode(GREYTEMP);
  $GreyListLen=0;
 } else {
  mlog(0,"Unable to connect to Greylist Server");
  $NextGreylistDownload=time+3600;
 }
}

sub GreyTraffic {
 my $fh=shift;
 my $buf;
 if($fh->sysread($buf,4096)>0) {
  if(!$GreyListLen) {
   # look for http header
   if($buf=~/content-length: (\d+)/i) {
    $GreyListLen=$1;
    #print "gll=$GreyListLen\n";
   }
   if($buf=~/(.*?)\n\r?\n(.*)/s) {
    $buf=$2;
   }
  }
  if($GreyListLen > 0) {
   print GREYTEMP $buf;
   $GreyListLen-=length($buf);
   #print "$GreyListLen ";
   if(! $GreyListLen) {
    close GREYTEMP;
    unlink("$base/$greylist");
    rename("$base/$greylist.tmp","$base/$greylist");
    mlog(0,"Greylist download complete.");
    if($GreylistObject) {
     $GreylistObject->resetCache();
    } else {
     $GreylistObject=tie %Greylist,orderedtie,"$base/$greylist" if $greylist;
    }
    $readable->remove($fh);
    $fh->close;
   }
  }
 } else {
  # greylist download interrupted
  $readable->remove($fh);
  $fh->close;
  close(GREYTEMP);
  #unlink("$base/$greylist.tmp");
  mlog(0,"Greylist download interrupted");
 }
}

sub uploadStats {
 my $peeraddress,$connect;
 if ($proxyserver) {
   mlog(0,"Uploading stats via Proxy:$proxyserver");
   $peeraddress = $proxyserver;
   $connect = "POST http://assp.sourceforge.net/cgi-bin/upload.pl HTTP/1.0";
 } else {
   mlog(0,"Uploading stats via Direct Connection");
   $peeraddress = "assp.sourceforge.net:80";
   $connect = "POST /cgi-bin/upload.pl HTTP/1.1
Host: assp.sourceforge.net";
 }
 my $s=new IO::Socket::INET(Proto=>'tcp',PeerAddr=>$peeraddress,Timeout=>2);
 if($s) {
  $Stats{timenow}=time;
  $Stats{testmode}=$TestMode;
  my $content=join("\001",%Stats);
  my $len=length($content);
  $connect.="
Content-Type: application/x-www-form-urlencoded
Content-Length: $len

$content";
  print $s $connect;
  $s->close;
 } else {
   mlog(0,"Unable to connect to stats server");
 }
 $Stats{nextUpload}=time+3600*8;
}

sub ResetStats {
 $Stats{nextUpload}=time+3600*8;
 $Stats{locals}=0;
 $Stats{whites}=0;
 $Stats{messages}=0;
 $Stats{hams}=0;
 $Stats{spams}=0;
 $Stats{bhams}=0;
 $Stats{bspams}=0;
 $Stats{viri}=0;
 $Stats{viridetected}=0;
 $Stats{connects}=0;
 $Stats{spamlover}=0;
 $Stats{bombs}=0; ## Thanks Gareth.
 $Stats{scripts}=0;
 open(F,"<$base/asspstats.sav");
 (%OldStats)=split(/\001/,<F>);
 close F;
}

sub SaveStats {
 my %s=%OldStats;
 for(keys %Stats) {$s{$_}+=$Stats{$_}}
 $s{starttime}=$OldStats{starttime} || $Stats{starttime};
 open(F,">$base/asspstats.sav");
 print F join("\001",%s);
 close F;
 %s;
}

#####################################################################################
#                Maillog functions


# find an appropriate name for a maillog file
sub maillogFilename {my $isspam=shift;
 my @dirs=($notspamlog,$spamlog,$incomingOkMail,$viruslog);
 my $maillog=$dirs[$isspam];
 d(19);
 if($UseSubjectsAsMaillogNames) {
  my($sub)=$_[0]=~/Subject: (.*)/;
  $sub=~y/a-zA-Z0-9/_/cs;
  $sub=substr($sub,0,50);
  $sub.="--".(++$Counter);
  return "$base/$maillog/$sub$maillogExt";
 } else {
  my $fn=(time + $Counter++ ) % $MaxFiles;
  #print "isspam=$isspam; log to $maillog/$fn\n";
  "$base/$maillog/$fn$maillogExt";
 }
}


# integrated mail collection subroutine
sub MaillogStart {
 d(361);
 $Con{$_[0]}->{maillog}=1 unless $NoMaillog;
 $Con{$_[0]}->{maillogbuf}=$Con{$_[0]}->{header}=$Con{$_[0]}->{rcvd};
}
sub Maillog {
 my ($fh,$text,$parm)=@_;
 # parm = 2 -- not spam, 3 -- is spam, 4 -- mail ok, 5 -- virii, 6 -- ignore
 return unless $Con{$fh}->{maillog};
 if($parm == 4 && !$incomingOkMail || $parm == 5 && !$viruslog || $parm == 6) {
  d(364);
  delete $Con{$fh}->{maillogbuf};
  delete $Con{$fh}->{maillog};
  close $Con{$fh}->{maillogfh} if $Con{$fh}->{maillogfh};
  delete $Con{$fh}->{maillogfh};
  delete $Con{$fh}->{mailloglength};
 } elsif($parm > 1) {
  d(362);
  # we now know if it is spam or not -- open the file
  $text=$Con{$fh}->{maillogbuf}.$text;
  delete $Con{$fh}->{maillogbuf};
  my $fn=maillogFilename($parm-2,$text);
  $FH='FHaaaaa' unless $FH;
  if(open(++$FH,">$fn")) {
   #print "maillog open $FH -> $fn\n";
   $Con{$fh}->{maillogfh}=$FH;
   $Con{$fh}->{mailloglength}=0;
   binmode $FH;
  } else {
   mlog($fh, "error opening maillog '$fn': $!");
  }
  # start sending the message to sendAllSpam if apropos
  $Con{$fh}->{forwardSpam}=forwardSpam($Con{$fh}->{from},$sendAllSpam,$fh) if ($parm==3 && $sendAllSpam);
 }
 if(my $h=$Con{$fh}->{maillogfh}) {
  print $h $text;
  if(($Con{$fh}->{mailloglength}+=length($text))>$MaxBytes || $text=~/(^|[\r\n])\.[\r\n]/) {
   d(366);
   close $h;
   delete $Con{$fh}->{maillog} unless $Con{$fh}->{forwardSpam};
   delete $Con{$fh}->{maillogfh};
   delete $Con{$fh}->{mailloglength};
  }
 } elsif(length($Con{$fh}->{maillogbuf})<$MaxBytes) {
  $Con{$fh}->{maillogbuf}.=$text;
 }
 if($Con{$fh}->{forwardSpam}) {
  my $t=$Con{$Con{$fh}->{forwardSpam}};
  #print "ml r=$t->{ready} t=$text>>\n";
  if($t->{ready}) {
   sendque($Con{$fh}->{forwardSpam},$text);
   #print "qued\n";
  } else {
   $t->{body}.=$text;
  }
 }
}


sub forwardSpam {
 my ($from,$to,$oldfh)=@_;
 my $s=new IO::Socket::INET(Proto=>'tcp',PeerAddr=>$smtpDestination,Timeout=>2);
 if(! $s) {
  mlog('',"Couldn't create server socket to $smtpDestination -- aborting sendAllSpam connection");
  return;
 }
 addfh($s,\&FShelo);
 my $this=$Con{$s};
 $this->{to}=$to;
 $this->{from}=$from;
 $this->{spamprob}=$Con{$fh}->{spamprob};
 $s;
}
sub FShelo { my ($fh,$l)=@_;
 if($l=~/^ *5/) {
  FSabort($fh,"helo Expected 220, got: $l");
 } elsif($l=~/^ *220 /) {
  sendque($fh,"HELO $myName\r\n");
  $Con{$fh}->{getline}=\&FSfrom;
 }
}
sub FSfrom { my ($fh,$l)=@_;
 if($l=~/^ *5/) {
  FSabort($fh,"from Expected 250, got: $l");
 } elsif($l=~/^ *250 /) {
  sendque($fh,"MAIL FROM: <$Con{$fh}->{from}>\r\n");
  $Con{$fh}->{getline}=\&FSrcpt;
 }
}
sub FSrcpt { my ($fh,$l)=@_;
 if($l=~/^ *5/) {
  FSabort($fh,"rcpt Expected 250, got: $l");
 } elsif($l=~/^ *250 /) {
  sendque($fh,"RCPT TO: <$Con{$fh}->{to}>\r\n");
  $Con{$fh}->{getline}=\&FSdata;
 }
}
sub FSdata { my ($fh,$l)=@_;
 if($l=~/^ *5/) {
  FSabort($fh,"data Expected 250, got: $l");
 } elsif($l=~/^ *250 /) {
  sendque($fh,"DATA\r\n");
  $Con{$fh}->{getline}=\&FSdata2;
 }
}
sub FSdata2 { my ($fh,$l)=@_;
 if($l=~/^ *5/) {
  FSabort($fh,"data2 Expected 354, got: $l");
 } elsif($l=~/^ *354 /) {
  my $this=$Con{$fh};

  $this->{body}=~s/^(.*?)(\r?\n)\r?\n/$1$2$this->{spamprob}$2/s;
  #print "sq sp=$this->{spamprob}; b=$this->{body}>>\n";

  sendque($fh,$this->{body}) if $this->{body};
  $this->{ready}=1;
  $this->{body}='';
  $Con{$fh}->{getline}=\&FSdone;
 }
}
sub FSdone { my ($fh,$l)=@_;
 if($l=~/^ *5/) {
  FSabort($fh,"done Expected 250, got: $l");
 } elsif($l=~/^ *250 /) {
  done2($fh); # close and delete
 }
}
sub FSabort {mlog(0,"FSabort: $_[1]"); done2($_[0]);}

#####################################################################################
#                Web Configuration functions

sub webRequest {
 my ($fh,$head,$data)=@_;

 %webRequests=(
  '/stats' => \&ConfigStats,
  '/lists' => \&ConfigLists,
  '/analyze' => \&ConfigAnalyze,
  '/maillog' => \&ConfigMaillog,
  '/donations' => \&Donations,
 );

 ($page,$j,$qs)=/^\w+ ([^\? ]+)(\?(\S*))?/i;
 $qs=$data if defined $data;
 ($auth)=/Authorization: Basic (\S+)/i;
 ($user,$pass)=split(':',base64decode($auth));
 #print "p=$page>\nqs=$qs>\na=$auth>\n";
 $qs=~y/+/ /;
 (%qs)=split(/[=&]/,$qs);
 for $k (keys %qs) {$qs{$k}=~s/%([0-9a-fA-F][0-9a-fA-F])/pack(C,hex($1))/ge}
 if($pass eq $webAdminPassword) {
  ConfigQuit($fh) if($page eq '/quit');
  print $fh ((defined ($v=$webRequests{$page}))? $v->(): webConfig());
 } else {
  print $fh "HTTP/1.1 401 Unauthorized
WWW-Authenticate: Basic realm=\"Anti-Spam SMTP Proxy (ASSP) Configuration\"
Content-type: text/html

<html><body><h1>Unauthorized</h1>
</body></html>\n";
 }

 WebDone($fh);
}

sub ConfigQuit {
 mlog('',"Quit requested from admin interface");
 &SaveWhitelist;
 my $fh=shift;
 print $fh "HTTP/1.1 200 OK
Content-type: text/html

<html><body><h1>ASSP Terminated.</h1>
</body></html>
";
#{ # -- check for memory leaks
# use Dumpvalue;
# my $dumper = new Dumpvalue;
# $dumper->set(globPrint => 1);
# $dumper->veryCompact(1);
# open(STDOUT,">dump");
# $dumper->dumpValue(\*::);
#}
 exit;
}

sub ConfigStats {
 #mlog('',"Stats requested from admin interface");
 # TODO -- this should be meaningful instead of what it currently is...
 my %os=SaveStats();
 my $s;
 my $uptime=(time - $Stats{starttime})/(24*3600);
 my $uptime2=(time - $os{starttime})/(24*3600);
 my $mpd=sprintf("%.1f",$Stats{messages}/$uptime);
 my $mpd2=sprintf("%.1f",$os{messages}/$uptime2);
 my $spams=$Stats{spams}+$Stats{bspams};
 my $spams2=$os{spams}+$os{bspams};
 my $pct=sprintf("%.1f",$spams/($Stats{messages}-$Stats{locals}+1)*100);
 my $pct2=sprintf("%.1f",$spams2/($os{messages}-$os{locals}+1)*100);
 my $uptime=sprintf("%.3f",$uptime);
 my $uptime2=sprintf("%.3f",$uptime2);
 my $tconns=$Stats{connects};
 if ($Stats{connects}==0) { $tconns=1000000 ; }
 my $tconns2=$os{connects};
 if ($os{connects}==0) { $tconns2=1000000 ; }
 my $rejpct=sprintf("%.1f%%",($Stats{norelays}/$tconns)*100);
 my $rejpct2=sprintf("%.1f%%",($os{norelays}/$tconns2)*100);


 #for (sort keys %Stats) {  $s.="<tr><td align=\"right\">$_</td><td>$Stats{$_}</td></tr>\n"; }
"HTTP/1.1 200 OK
Cache-control: no-cache
Content-type: text/html

<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
    \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">

<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>Anti-Spam SMTP Proxy (ASSP) Statistics</title>
<style type=\"text/css\">
<!--
$StyleSheet
//-->
</style>
</head>
<body>
<table>
<tr>
    <td>
        <a href=\"http://assp.sourceforge.net/\">
        <img src=\"http://assp.sourceforge.net/assp.png\" alt=\"ASSP\" /></a>
    </td>
    <td class=\"header2\">
        <a href=\"http://assp.sourceforge.net/\" target=_blank>ASSP</a> Statistics<br />
        <div class=\"smaller\">
          Your version: $version$modversion<br />
          Latest Documentation is <a href=\"http://assp.sourceforge.net/fom/cache/1.html\" target=_blank>here</a>.<br />
        </div>
    </td>
    </tr><tr>
    <td colspan=\"2\" class=\"nav\">$NavMenu</td>
</tr>
</table>
<p></p>
<table border=\"1\" style=\"width: 60%; margin-left: 20%\" class=\"textBox\">
<tr><td colspan=\"3\" class=\"sectionHeader\">SYSTEM Statistics</td></tr>
<tr><td class=\"statsOptionTitle\"><b>ASSP Proxy Uptime:</b></td>
<td class=\"optionValue\">$uptime days</td>
<td class=\"optionValue\">$uptime2 days</td>
</tr>
<tr><td class=\"statsOptionTitle\"><b>SMTP Connections Received:</b></td>
<td class=\"optionValue\">$Stats{connects}</td>
<td class=\"optionValue\">$os{connects}</td>
</tr>
<tr><td class=\"statsOptionTitle\"><b>Relay Attempts Rejected:</b></td>
<td class=\"optionValue\">$Stats{norelays} ($rejpct)</td>
<td class=\"optionValue\">$os{norelays} ($rejpct2)</td>
</tr>
<tr><td colspan=\"3\" class=\"sectionHeader\">MESSAGE HANDLING Statistics</td></tr>
<tr><td class=\"statsOptionTitle\"><b>Messages Processed:</b></td>
<td class=\"optionValue\">$Stats{messages} ($mpd per day)</td>
<td class=\"optionValue\">$os{messages} ($mpd2 per day)</td>
</tr>
<tr><td class=\"statsOptionTitle\"><b>Rules Spams:</b></td>
<td class=\"optionValue\">$Stats{spams}</td>
<td class=\"optionValue\">$os{spams}</td>
</tr>
<tr><td class=\"statsOptionTitle\"><b>Bayesian Spams:</b></td>
<td class=\"optionValue\">$Stats{bspams}</td>
<td class=\"optionValue\">$os{bspams}</td>
</tr>
<tr><td class=\"statsOptionTitle\"><b>Spamlover Spams Passed:</b></td>
<td class=\"optionValue\">$Stats{spamlover}</td>
<td class=\"optionValue\">$os{spamlover}</td>
</tr>
<tr><td class=\"statsOptionTitle\"><b>Local Mails:</b></td>
<td class=\"optionValue\">$Stats{locals}</td>
<td class=\"optionValue\">$os{locals}</td>
</tr>
<tr><td class=\"statsOptionTitle\"><b>Attachments Blocked:</b></td>
<td class=\"optionValue\">$Stats{viri}</td>
<td class=\"optionValue\">$os{viri}</td>
</tr>
<tr><td class=\"statsOptionTitle\"><b>Viruses Detected:</b></td>
<td class=\"optionValue\">$Stats{viridetected}</td>
<td class=\"optionValue\">$os{viridetected}</td>
</tr>
<tr><td class=\"statsOptionTitle\"><b>Spam Bombs Blocked:</b></td>
<td class=\"optionValue\">$Stats{bombs}</td>
<td class=\"optionValue\">$os{bombs}</td>
</tr>
<tr><td class=\"statsOptionTitle\"><b>Scripts Blocked:</b></td>
<td class=\"optionValue\">$Stats{scripts}</td>
<td class=\"optionValue\">$os{scripts}</td>
</tr>
<tr><td class=\"statsOptionTitle\"><b>Whitelisted Messages:</b></td>
<td class=\"optionValue\">$Stats{whites}</td>
<td class=\"optionValue\">$os{whites}</td>
</tr>
<tr><td class=\"statsOptionTitle\"><b>External Spam Percentage:</b></td>
<td class=\"optionValue\">$pct%</td>
<td class=\"optionValue\">$pct2%</td>
</tr>
</table>
<div style=\"width: 100%; text-align: center;\">ASSP Total Stats are <a href=\"http://assp.sourceforge.net/cgi-bin/total.pl\" target=_blank>here</a>.</div>
<p>
<a href=\"http://sourceforge.net\" target=_blank>
<img src=\"http://sourceforge.net/sflogo.php?group_id=69172&amp;type=1\" alt=\"SourceForge Logo\" />
</a>
</p>

</body></html>
";
}

sub ConfigLists {
 #mlog('',"lists requested from admin interface");
 my $s;
 my $act=$qs{action};
 if($act) {
  my $color=$qs{list} eq 'red'? 'Red': 'White';
  my $list=$color."list";
  for ($qs{addresses}=~/($EmailAdrRe\@$EmailDomainRe)/go) {
   $s.="<p></p><table class=\"textBox\"><tr><td style=\"text-align: center;\"   class=\"noBorder\">$_ ";
   $_=lc $_;
   if($act eq 'v') {
    if($list->{$_}) {
     $s.="${color}listed";
    } else {
     $s.="<span class=\"negative\">NOT ${color}listed</span>";
    }
   } elsif($act eq 'a') {
    if($list->{$_}) {
     $s.="<span class=\"positive\">already ${color}listed</span>";
    } else {
     if($color eq 'White' && localmail($_)) {
      $s.="<span class=\"negative\">local addresses not allowed on whitelist</span>";
     } else {
      $s.="added";
      $list->{$_}=time;
      mlog(0,"${color}list addition: $_ (admin)");
     }
    }
   } elsif($act eq 'r') {
    if($list->{$_}) {
     $s.="removed";
     delete $list->{$_};
     mlog(0,"${color}list deletion: $_ (admin)");
    } else {
     $s.="not ${color}listed";
    }
   }
   $s.="</td></tr></table>\n";
  }
 }
 if($qs{B1}=~/^Show (.)/) {
  local $/="\n";
  if($1 eq 'R') {
   $RedlistObject->flush() if $RedlistObject;
   open(F,"<$base/$redlistdb");
   $s.="<p></p><table class=\"textBox\"><tr class=\"textBox\"><td style=\"text-align: center;\" class=\"noBorder\"><b>Redlist</b></td></tr></table>\n";
  } else {
   $WhitelistObject->flush() if $WhitelistObject;
   open(F,"<$base/$whitelistdb");
   $s.="<p></p><table class=\"textBox\"><tr class=\"textBox\"><td style=\"text-align: center;\" class=\"noBorder\"><b>Whitelist</b></td></tr></table>\n";
  }
  my $l;
  while($l=<F>) {
   my ($a)=$l=~/([^\002]*)/;
   $s.="<p></p><table><tr class=\"textBox\"><td class=\"noBorder\" style=\"background-color: white;\">$a</td></tr></table>\n";
  }
  close F;
 }
<<EOT;
HTTP/1.1 200 OK
Cache-control: no-cache
Content-type: text/html

<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
    \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">

<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>Anti-Spam SMTP Proxy (ASSP) List Maintenance</title>
<style type=\"text/css\">
<!--
$StyleSheet
//-->
</style>
</head>
<body>
<table>
        <tr>
    <td>
        <a href=\"http://assp.sourceforge.net/\">
        <img src=\"http://assp.sourceforge.net/assp.png\" alt=\"ASSP\" /></a>
    </td>    
    <td class=\"header2\">
        <a href=\"http://assp.sourceforge.net/\" target=_blank>ASSP</a> List Maintenance<br />
        <div class=\"smaller\">
          Your version: $version$modversion<br />
          Latest Documentation is <a href=\"http://assp.sourceforge.net/fom/cache/1.html\" target=_blank>here</a>.<br />
        </div>
    </td>
    </tr><tr>
    <td colspan=\"2\" class=\"nav\">$NavMenu</td>    
</tr>
</table>
$s
<p></p>
<form method="post" action=\"\">    
    <table class="textBox">
        <tr>
            <td class="noBorder">Do you want to work with the:
            </td>
            <td class="noBorder">
            <input type="radio" name="list" value="white" checked="checked" /> Whitelist or<br />
            <input type="radio" name="list" value="red" /> Redlist
            </td>
        </tr>
        <tr>
            <td class="noBorder">Do you want to: </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 />
            <p><textarea name="addresses" rows="3" cols="40">$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>
    <p></p>        
</form>
<div class="textBox">
<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.

  <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>
    <tr>
      <td class="noBorder">&nbsp;</td>
    </tr>
    <tr>
      <td colspan=\"2\" 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.</td>
    </tr>
</table>
</form>
</div>

<p >
<a href=\"http://sourceforge.net\">
<img src=\"http://sourceforge.net/sflogo.php?group_id=69172&amp;type=1\" alt=\"SourceForge Logo\"  />
</a>
</p>
</body></html>
EOT
}

sub ConfigAnalyze {
 #mlog('',"lists requested from admin interface");
 my ($s,$st,$wl,%wl);
 my $mail=$qs{mail};
 if($mail) {
  my $name=$myName; $name=~s/(\W)/\\$1/g;
  my ($ip)=$mail=~/Received: from ([0-9\.]+).*?by\s+$name/is;
  my ($ip3)=$ip=~/(.*)\.\d+$/;
  my ($helo)=$mail=~/helo=(.*?)\)/i;
  $wl.="<p></p><div class=\"textBox\">";
  while($mail=~/($EmailAdrRe\@$EmailDomainRe)/go) {
   my $a=lc $1;
   next if $wl{$a}++;
   if( $Redlist{$a} ){
    $wl.="<b>$1 is redlisted<br /></b>\n"
   } else {
    $wl.="<b>$1 is whitelisted<br /></b>\n" if $Whitelist{$a};
   }
  }
  $wl.="<p>" if $wl;
  $wl.="<b>Mail matches White RE: '$&'</b><p>\n" if $whiteRe && $mail=~$whiteReRE;
  $wl.="<b>Mail matches Black RE: '$&'</b><p>\n" if $blackRe && $mail=~$blackReRE;
  $wl.="<b>Mail matches No Processing RE: '$&'</b><p>\n" if $npRe && $mail=~$npReRE;
  $wl.="<b>Mail matches Red RE: '$&'</b><p>\n" if $redRe && $mail=~$redReRE;
  $wl.="<b>Mail matches Mail Bomb RE: '$&'</b><p>\n" if $bombRe && $mail=~$bombReRE;
  $wl.="<b>Mail matches Script RE: '$&'</b><p>\n" if $scriptRe && $mail=~$scriptReRE;
  $wl.="<b>Mail matches helo blacklist '$helo'</b><p>\n" if $HeloBlack{lc $helo};

  $mail=clean(substr($mail,0,10000));
  $wl.="<b>Mail matches White RE: '$&'</b><p>\n" if $whiteRe && $mail=~$whiteReRE;
  $wl.="<b>Mail matches Black RE: '$&'</b><p>\n" if $blackRe && $mail=~$blackReRE;

  my @t; my %got;

  if(defined($Dnsbl{$ip}) || defined($Dnsbl{$ip3})) {
   $wl.="<b>$ip dnsbl hit</b> (adds 0.97 0.97)<p>\n";
   push(@t,0.97);
   push(@t,0.97);
  }
  if($greylist) {
    my $v;
    if ($ispip && $ispip=~$ip3) {  #Start - Added for ISP greylisting JC.
       if ($ispgreyvalue) {
        $v=$ispgreyvalue;
      } else {
        $v=$Greylist{'x'};
      }
    } else {
      $v=$Greylist{$ip3} || $Greylist{'x'};
    }                              #End - Added for ISP greylisting JC.
   $wl.="<b>$ip3 has a greylist value of $v</b> (adds $v $v)<p>\n";
   push(@t,$v,$v) if $v;
  }

  my ($v,$lt,$llt,$t,%seen);
  while($mail=~/([-\$A-Za-z0-9\'\.\,!]+)/g) {
   next if length($1) > 20;
   $llt=$lt; $lt=$t; $t=lc $1;
   $t=~s/[,.']+$//; $t=~s/!!!+/!!/g; $t=~s/--+/-/g;
   my $j="$lt $t";
   next if $seen{$j}++>1;
   push(@t,$v) if ($v=$Spamdb{$j}); $got{$j}=$v if $v;
  }
  my $cnt=0;
  $s.="<tr><td style=\"text-align: right;\">Bad Words</td>
  <td style=\"text-align: center;\">Bad Prob</td>
  <td style=\"text-align: right;\">Good Words</td>
  <td style=\"text-align: center;\">Good Prob</td></tr>\n";
  for (sort {abs($got{$b}-.5)<=>abs($got{$a}-.5)} keys %got) {
   my $g=sprintf("%.4f",$got{$_});
   if($g < 0.5) {
    $s.="<tr><td></td><td></td><td align=\"right\">$_</td><td>$g</td></tr>\n";
   } else {
    $s.="<tr><td align=\"right\">$_</td><td>$g</td><td></td><td></td></tr>\n";
   }
   last if $cnt++ > 20;
  }
  @t=sort {abs($b-.5)<=>abs($a-.5)} @t;
  @t=@t[0..30];
  $st="<br /><p>Analysis totals: ";
  for (@t) {$st.=sprintf ("%.4f ",$_) if $_;}
  $st.="</p>\n";
  #print "\n"; ,join(',',@t),"\n";
  my $p1=1; my $p2=1; for $p (@t) {if($p) {$p1*=$p; $p2*=(1-$p);}}
  $p1=$p1/($p1+$p2);
  $st.=sprintf("<p>spam-prob = %.5f</p>\n",$p1);
  $st.="</div>";  
  $mail=~s/([^\n]{70,84}[^\w\n<\@])/$1\n/g; $mail=~s/\s*\n+/\n/g; $mail=~s/<\/textarea>/\/textarea/ig;
 }
<<EOT;
HTTP/1.1 200 OK
Cache-control: no-cache
Content-type: text/html

<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
    \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">

<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>Anti-Spam SMTP Proxy (ASSP) Mail Analyzer</title>
<style type=\"text/css\">
<!--
$StyleSheet
//-->
</style>
</head>
<body>
<table>
        <tr>
    <td>
        <a href=\"http://assp.sourceforge.net/\">
        <img src=\"http://assp.sourceforge.net/assp.png\" alt=\"ASSP\" /></a>
    </td>    
    <td class=\"header2\">
        <a href=\"http://assp.sourceforge.net/\" target=_blank>ASSP</a> Mail Analyzer<br />
        <div class=\"smaller\">
          Your version: $version$modversion<br />
          Latest Documentation is <a href=\"http://assp.sourceforge.net/fom/cache/1.html\" target=_blank>here</a>.<br />
        </div>
    </td>
    </tr><tr>
    <td colspan=\"2\" class=\"nav\">$NavMenu</td>    
</tr>
</table>
<p></p>
<div class="textBox">This page will show you how ASSP analyzes an email to come up with the assigned spam
probability. You can also see how it pre-processes mail.
</div>
$wl<table style=\"width: 100%;\">$s</table>$st
<p></p>
<form action="" method="post">
    <table class="textBox" style=\"width: 100%;\">
        <tr>
            <td class="noBorder" align="center">Copy and paste the mail header and
            body here:<br />
            <textarea name="mail" rows="10" cols="85">$mail</textarea>
            </td>
        </tr>
        <tr>
            <td class="noBorder" align="center"><input type="submit" name="B1"
            value="Analyze" /></td>
        </tr>
    </table>
</form>
<div class="textBox">
   
    <p class="warning" >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>

<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.</p>
</div>

<p>
<a href=\"http://sourceforge.net\">
<img src=\"http://sourceforge.net/sflogo.php?group_id=69172&amp;type=1\" alt=\"SourceForge Logo\" />
</a>
</p>
</body></html>
EOT
}

sub ConfigMaillog {
 open(F,"<$base/$logfile");
 #print "$base/$logfile e=$!\n";
 seek(F,-10000,2) || seek(F,0,0);
 local $/;
 my $s=<F>;
 close F;
 $s=~s/&/&amp;/g;
 $s=~s/</&lt;/g;
 $s=~s/>/&gt;/g;
<<EOT;
HTTP/1.1 200 OK
Cache-control: no-cache
Content-type: text/html

<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
    \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">

<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>Anti-Spam SMTP Proxy (ASSP) Maillog Tail</title>
<style type=\"text/css\">
<!--
$StyleSheet
//-->
</style>
</head>
<body>
<table>
<tr>
    <td>
        <a href=\"http://assp.sourceforge.net/\">
        <img src=\"http://assp.sourceforge.net/assp.png\" alt=\"ASSP\" /></a>
    </td>
    <td class=\"header2\">
        <a href=\"http://assp.sourceforge.net/\" target=_blank>ASSP</a> Maillog Tail<br />
        <div class=\"smaller\">
          Your version: $version$modversion<br />
          Latest Documentation is <a href=\"http://assp.sourceforge.net/fom/cache/1.html\" target=_blank>here</a>.<br />
        </div>
    </td>
    </tr><tr>
    <td colspan=\"2\" class=\"nav\">$NavMenu</td>    
</tr>
</table>
<p class="textBox">Press your browser's refresh to update this screen. Newest entries are at the end.</p>
<pre>    
    $s
</pre>
<p>
<a href=\"http://sourceforge.net\">
<img src=\"http://sourceforge.net/sflogo.php?group_id=69172&amp;type=1\" alt=\"SourceForge Logo\" />
</a>
</p>
</body></html>
EOT
}

sub webConfig {
 my $r="HTTP/1.1 200 OK
Content-type: text/html
Cache-control: no-cache

<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
    \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">

<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>Anti-Spam SMTP Proxy (ASSP) Configuration</title>
<style type=\"text/css\">
<!--
$StyleSheet
//-->
</style>
</head>
<body>
<table>
<tr>
    <td>
        <a href=\"http://assp.sourceforge.net/\">
        <img src=\"http://assp.sourceforge.net/assp.png\" alt=\"ASSP\" /></a>
</td>
    <td class=\"header2\">
        <a href=\"http://assp.sourceforge.net/\">ASSP</a> Configuration<br />
        <div class=\"smaller\">
          Your version: $version$modversion<br />
          Latest Documentation is <a href=\"http://assp.sourceforge.net/fom/cache/1.html\">here</a>.<br />
        </div>
</td>
    </tr><tr>
    <td colspan=\"2\" class=\"nav\">$NavMenu</td>
</tr>
</table>
Note: Items marked with an asterisk (*) accept a list separated by | or you can specify a file to read
the list from this way: file:c:\\assp\\filename.txt <br>
Files should have one entry per line; anything on a line following a space and numbersign ( #) is ignored (a comment).<br>
Whitespace at the beginning or end of the line is ignored.<p>
<form action=\"\" method=\"post\"><table>\n";
 $ConfigChanged=0;
 undef %qs unless $qs{theButton}; # don't post partial data if somebody's browser's busted
 for $c (@Config) {$r.= $c->[3]->(@{$c});}
 if($ConfigChanged) {
  SaveConfig();
 }
 my $quit="<form method=\"post\" action=\"quit\"><p>
   Panic button:
   <input type=\"submit\" value=\"Terminate ASSP now!\" /></p></form>" unless $AsAService;

 $r.= "
<td><tu $Color1>&nbsp;</td><td align=\"center\"><input name=\"theButton\" type=\"submit\" value=\"Apply Changes\" /></td></tr>
</table>
</form>

$quit
<p>
<a href=\"http://sourceforge.net\">
<img src=\"http://sourceforge.net/sflogo.php?group_id=69172&amp;type=1\" alt=\"SourceForge Logo\" />
</a>
</p>
</body></html>\n";
 $r;
}

sub Donations {

"HTTP/1.1 200 OK
Cache-control: no-cache
Content-type: text/html

<!DOCTYPE html PUBLIC \"-//W3C//DTD XHTML 1.0 Strict//EN\"
    \"http://www.w3.org/TR/xhtml1/DTD/xhtml1-strict.dtd\">

<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>Anti-Spam SMTP Proxy (ASSP) Donations</title>
<style type=\"text/css\">
<!--
$StyleSheet
//-->
</style>
</head>
<body>
<table>
<tr>
    <td>
        <a href=\"http://assp.sourceforge.net/\">
        <img src=\"http://assp.sourceforge.net/assp.png\" alt=\"ASSP\" /></a>
    </td>
    <td class=\"header2\">
        <a href=\"http://assp.sourceforge.net/\" target=_blank>ASSP</a> Donations<br />
        <div class=\"smaller\">
          Your version: $version$modversion<br />
          Latest Documentation is <a href=\"http://assp.sourceforge.net/fom/cache/1.html\" target=_blank>here</a>.<br />
        </div>
    </td>
    </tr><tr>
    <td colspan=\"2\" class=\"nav\">$NavMenu</td>
</tr>
</table>
<p>ASSP is here thanks to the following people, please feel free to donate to support the ASSP project</p>
<table border=\"1\" style=\"width: 100%; \" class=\"textBox\">
<tr>
<td>John Hanna the founder and developer of ASSP up to version 1.0.12</td>
<td><a href=\"https://www.paypal.com/xclick/business=johnhanna77%40yahoo.com&item_name=Support+ASSP&item_number=assp&no_note=1&tax=0&currency_code=USD\" target=\"_blank\">Donate</a></td>
</tr>
<tr>
<td>AJ the designer behind ASSP's web interface &amp; site.</td>
<td>&nbsp;</td>
</tr>
<tr>
<td>John Calvi the developer of ASSP from version 1.0.12.</td>
<td><a href=\"https://www.paypal.com/xclick/business=jcalvi%40lewis.com.au&item_name=Support+ASSP&item_number=assp&no_note=1&tax=0&currency_code=USD\" target=\"_blank\">Donate</a></td>
</tr>
<td>Robert Orso the developer of ASSP's LDAP functions.</td>
<td><a href=\"https://www.paypal.com/xclick/business=ro%40astronomie.at&item_name=Support+ASSP&item_number=assp&no_note=1&tax=0&currency_code=USD\" target=\"_blank\">Donate</a></td>
</tr>
</table>
<p>
<a href=\"http://sourceforge.net\" target=_blank>
<img src=\"http://sourceforge.net/sflogo.php?group_id=69172&amp;type=1\" alt=\"SourceForge Logo\" />
</a>
</p>

</body></html>
";
}

sub SaveConfig {
 rename("$base/assp.cfg.bak","$base/assp.cfg.bak.bak");
 rename("$base/assp.cfg","$base/assp.cfg.bak");
 open(F,">$base/assp.cfg");
 for(sort keys %Config) {print F "$_:=$Config{$_}\n";}
 close F;
}

sub ShowOptions {
 my ($group)=@_;
 return my $show=1 if ($group eq 'ns' && !$showNetworkSetup || $group eq 'rl' && !$showRelaying || $group eq 'vr' && !$showValidateRecipients || $group eq 'vc' && !$showVirusControl || $group eq 'sc' && !$showSpamControl || $group eq 'sb' && !$showSpamBomb || $group eq 'wl' && !$showWhitelistOptions || $group eq 'ei' && !$showEmailInterface || $group eq 'fp' && !$showFilePaths || $group eq 'lg' && !$showLogging || $group eq 'se' && !$showSecurity || $group eq 'os' && !$showOtherSettings);
}

sub textinput {my ($name,$nicename,$size,$func,$default,$valid,$onchange,$group,$description)=@_;
 my $Error=checkUpdate($name,$valid,$onchange);
 return "<input type=hidden name=$name value=\"$Config{$name}\" />\n" if !$Error && ShowOptions($group);
"<tr><td align=\"right\" class=\"optionTitle\">$nicename</td><td class=\"optionValue\"><input name=\"$name\" size=\"$size\" value=\"$Config{$name}\" /><br />\n$Error$description</td></tr>\n";
}
# everybody wants this, but I hate it -- use it if you care.
sub passinput {my ($name,$nicename,$size,$func,$default,$valid,$onchange,$group,$description)=@_;
 my $Error=checkUpdate($name,$valid,$onchange);
 return "<input type=hidden name=\"$name\" value=\"$Config{$name}\" />\n" if !$Error && ShowOptions($group);
"<tr><td align=\"right\" class=\"optionTitle\">$nicename</td><td class=\"optionValue\"><input type=PASSWORD name=\"$name\" size=\"$size\" value=\"$Config{$name}\" /><br />\n$Error$description</td></tr>\n";
}
sub checkbox {my ($name,$nicename,$size,$func,$default,$valid,$onchange,$group,$description)=@_;
 my $Error=checkUpdate($name,$valid,$onchange);
 return "<input type=hidden name=\"$name\" value=\"$Config{$name}\" />\n" if !$Error && ShowOptions($group);
 my $checked=$Config{$name}?'checked="checked"':'';
 "<tr><td class=\"optionTitle\">&nbsp;</td><td class=\"optionValue\"><input type=\"checkbox\" name=\"$name\" value=\"1\" $checked /> $nicename<br />\n$Error$description</td></tr>\n";
}
sub heading {my ($description,$group)=@_[4,5];
 return '' if ShowOptions($group);
 "<tr><td colspan=\"2\" class=\"sectionHeader\">$description</td></tr>\n";
}

sub checkUpdate {
 my ($name,$valid,$onchange)=@_;
 return '' unless %qs;
 if($qs{$name} ne $Config{$name}) {
  if($qs{$name}=~/$valid/i) {
   my $new=$1; my $info;
   my $old=$Config{$name};
   $Config{$name}=$new;
   if($onchange) {
    $info=$onchange->($name,$old,$new);
   } else {
    mlog(0,"Admin update: $name changed from '$old' to '$new'");
    ${$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;
   return "<span class=\"positive\"><b>*** Updated $info</b></span><br />";
  } else {
   return "<span class=\"negative\"><b>*** Invalid: '$qs{$name}'</b></span><br />";
  }
 }
}

sub fixConfigSettings {
 # This function is called on startup to clean up some settings
 # Primarily these are settings that might be absent from assp.cfg after an upgrade
 $Config{'base'}=$base;
 $Config{OrderedTieHashSize}=5000 unless $Config{OrderedTieHashSize};
 $Config{ExtensionsToBlock}='exe|scr|pif|vb[es]|js|jse|ws[fh]|sh[sb]|lnk|bat|cmd|com|ht[ab]' unless $Config{ExtensionsToBlock};
 $Config{bombError}='500 Your message was rejected because it appears to be part of a spam bomb -- rephrase your message and try sending it again.' unless $Config{bombError};
 $Config{scriptError}='500 Your email contains html scripting code -- please resend as plain text.' unless $Config{scriptError};
 $Config{wlAttachLog}=5 unless $Config{wlAttachLog};
 $Config{extAttachLog}=5 unless $Config{extAttachLog};
 $Config{spamBombLog}=6 unless $Config{spamBombLog};
 $Config{scriptLog}=3 unless $Config{scriptLog};
 $Config{baysNonSpamLog}=4 unless $Config{baysNonSpamLog};
 $Config{spamHeloLog}=3 unless $Config{spamHeloLog};
 $Config{blDomainLog}=3 unless $Config{blDomainLog};
 $Config{spamBucketLog}=6 unless $Config{spamBucketLog};
 $Config{baysSpamLog}=3 unless $Config{baysSpamLog};
 $Config{OutgoingBufSize}=102400 unless $Config{OutgoingBufSize};
 $Config{MaxBytes}=10000 unless $Config{MaxBytes};
 $Config{AvError}='500 Mail appears infected with \'$infection\' -- disinfect and resend.' unless $Config{AvError};
 $Config{LogRollDays}=14 unless $Config{LogRollDays};
    # -- 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";
 for (keys %Config) {${$_}=$Config{$_};}

 $EmailFrom="<>" unless $EmailFrom;
  # turn settings into regular expressions
 @PossibleOptionFiles=();
 for (@Config) {
  if($_->[6] eq 'ConfigMakeRe') {
   ${$_->[0]}=optionList(${$_->[0]},$_->[0]);
   push(@PossibleOptionFiles,$_->[0]);
  } elsif($_->[6] eq 'ConfigCompileRe') {
   ConfigCompileRe($_->[0],'',${$_->[0]},'Initializing');
  }
 }
 updateBadAttach(ExtensionsToBlock,'',$Config{ExtensionsToBlock},'Initializing');
}

sub ConfigMakeRe { my ($name, $old, $new)=@_;
 $$name=optionList($new,$name);
 mlog(0,"Admin update: $name changed from '$old' to '$new'");
 '';
}

sub ConfigCompileRe { my ($name, $old, $new, $init)=@_;
 $$name=$new;
 my $n2=$name."RE";
 if($new) {
  SetRE($n2,$new,"is",$name);
 }
 #print "CCR $name ($old, $new) ($$name) ($n2,$$n2)\n";
 mlog(0,"Admin update: $name changed from '$old' to '$new'") unless $init;
 '';
}

sub optionList {
 # this converts a | separated list into a RE and handles the options in a file
 my $d=shift;
 my $configname=shift;
 if($d=~/^ *file: *(.+)/i) {
  # the optionlist is actually saved in a file.
  my $fil=$1;
  local $/;
  my @s=stat($fil);
  my $mtime=$s[9];
  $FileUpdate{$fil}=$mtime;
  if(open(OL,"<$fil")) {
   $d=<OL>; # read the file
   $d=~s/ #.*//g; # clean off comments
   $d=~s/\s*\n\s*/|/g; # replace newlines (and the whitespace that surrounds them) with a |
   mlog(0,"Option list file '$fil' reloaded ($configname).");
   close OL;
  } else {
   mlog(0,"Failed to open option list file '$fil' ($configname): $!");
  }
 }
 $d=~s/\|\|+/\|/g;
 $d=~s/^\|//;
 $d=~s/\|$//;
 $d=~s/([\.\[\]\-\(\)\*\+\\])/\\$1/g;
 #print "mre: $configname d=$d\n";
 $MakeRE{$configname}->($d);
 $d;
}

sub fileUpdated {
 my $fil=shift;
 return 1 unless $FileUpdate{$fil};
 my @s=stat($fil);
 my $mtime=$s[9];
 $FileUpdate{$fil}!=$mtime;
}

sub ConfigChangeMailPort {my ($name, $old, $new)=@_;
 if($> == 0 || $new >= 1024) {
  # change the listenport
  $listenPort=$new;
  if($lsn) {
   $readable->remove($lsn);
   $lsn->close();
  }
  $lsn = newListen($listenPort,\&NewSMTPConnection);
  mlog(0,"Listening on new mail port $listenPort (changed from $old) per admin request");
  return '';
 } else {
  # don't have permissions to change
  mlog(0,"Request to listen on new mail port $listenPort (changed from $old) -- restart required; euid=$>");
  return "<br />Restart required; euid=$>";
 }
}

sub ConfigChangeMailPort2 {my ($name, $old, $new)=@_;
 if($> == 0 || $new >= 1024) {
  # change the listenport2
  $listenPort2=$new;
  if($lsn2) {
   $readable->remove($lsn2);
   $lsn2->close();
  }
  $lsn2 = newListen($listenPort2,\&NewSMTPConnection);
  mlog(0,"Listening on new secondary mail port $listenPort2 (changed from $old) per admin request");
  return '';
 } else {
  # don't have permissions to change
  mlog(0,"Request to listen on new secondary mail port $listenPort2 (changed from $old) -- restart required; euid=$>");
  return "<br />Restart required; euid=$>";
 }
}

sub ConfigChangeAdminPort {my ($name, $old, $new)=@_;
 if($> == 0 || $new >= 1024) {
  # change the listenport
  $webAdminPort=$new;
  $readable->remove($WebSocket);
  $WebSocket->close();
  $WebSocket = newListen($webAdminPort,\&NewWebConnection);
  if($WebSocket) {
   mlog(0,"Listening on new admin port $new (changed from $old) per admin request");
  } else {
   # couldn't open the port -- switch back
   $webAdminPort=$old;
   $WebSocket = newListen($webAdminPort,\&NewWebConnection);
   mlog(0,"Couldn't open new port -- still listening on $old");
   $Config{$name}=$old;
   return "<span class=\"negative\">Couldn't open new port $new</span>";
  }
  return '';
 } else {
  # don't have permissions to change
  mlog(0,"Request to listen on new admin port $new (changed from $old) -- restart required; euid=$>");
  return "<br />Restart required; euid=$>";
 }
}

sub ConfigChangeRelayPort {my ($name, $old, $new)=@_;
 unless ($relayHost && $new) {
  if($Relay) {
   $readable->remove($Relay);
   $Relay->close();
   mlog(0,"Relay port disabled");
   return '<br />relay port disabled';
  } else {
   return "<br />relayHost ($relayHost) and relayPort ($new) must be defined to enable relaying";
  }
 }
 if($> == 0 || $new >= 1024) {
  # change the listenport
  $relayPort=$new;
  if($Relay) {
   $readable->remove($Relay);
   $Relay->close();
  }
  $Relay=newListen($relayPort,\&NewSMTPConnection);
  mlog(0,"Listening for relay connections at $relayPort -- changed per admin request");
  return '';
 } else {
  # don't have permissions to change
  mlog(0,"Request to listen on new relay port $new (changed from $old) -- restart required; euid=$>");
  return "<br />Restart required; euid=$>";
 }
}

sub ConfigChangeLogfile {my ($name, $old, $new)=@_;
 close LOG if $logfile;
 $logfile=$new;
 if($logfile && open(LOG,">>$base/$logfile")) {my $oldfh = select(LOG); $| = 1; select($oldfh);}
 mlog(0,"Log file changed to '$new' from '$old' per admin request");
 '';
}
sub ConfigDEBUG {my ($name, $old, $new)=@_;
 close DEBUG if $DEBUG;
 $DEBUG=$new;
 if($DEBUG) {
  open(DEBUG, ">$base/".time.".dbg"); binmode(DEBUG); my $oldfh = select(DEBUG); $| = 1; select($oldfh);
  eval(q[sub d {
   $time=gmtime(); $time=~s/... (...) (..) (........) ..(..)/$2 $1 $4 $3/;
   print DEBUG "$time <$_[0]>";
  }
  ]);
 } else {
  eval(q[sub d{}]);
 }
 mlog(0,"Debug file changed to '$new' from '$old' per admin request");
 '';
}
sub updateBadAttach {my ($name, $old, $new, $init)=@_;
 mlog(0,"Badattach updated from '$old' to '$new'.") unless $init;
 if($new) {
  SetRE(badattachRE,qq[content-\\w+: .*\\s+.*name\\s*=\\s*".*\\.($new)"|content-\\w+: .*\\s+.*name\\s*=\\s*.*\\.($new)\\s],'i',"Bad Attachment");
 }
 $badattach=$new;
 #print "ba=$badattach\n";
 '';
}

sub reloadConfigFile {
 # called on SIG HUP
 my %newConfig;
 mlog(0,"Sig HUP -- reloading config");
 open(F,"<$base/assp.cfg"); local $/; (%newConfig)=split(/:=|\n/,<F>); close F;
 for $c (@Config) {
  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 {
     mlog(0,"Admin update: $name changed from '$Config{$name}' to '$new'");
     ${$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";
    }
    $Config{$name}=$new;
   } else {
    mlog(0, "Error: invalid '$newConfig{$name}' -- not changed");
   }
  }
 }
  for $f (@PossibleOptionFiles) {
   ${$f}=optionList($Config{$f},$f) if $Config{$f}=~/^ *file: *(.+)/i && fileUpdated($1);
  }
 # reopen log file, just for fun.
  close LOG;
  if(open(LOG,">>$base/$logfile")) {my $oldfh = select(LOG); $| = 1; select($oldfh);}
  print LOG "Logfile reopened on HUP\n";
}

#####################################################################################
#                orderedtie
{
package 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::OrderedTieHashSize 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.


sub TIEHASH {
 my ($c,$fn)=@_;
 my $self={
  fn => $fn,
  age => mtime($fn),
  cnt => 0,
  cache => {},
  updated => {},
  ptr => 1,
 };
 bless $self, $c;
 return $self;
}
sub DESTROY { $_[0]->flush(); }

sub mtime { my @s=stat($_[0]); $s[9]; }

sub flush {
 my $this=shift;
 return unless %{$this->{updated}};
 my $f=$this->{fn};
 #print "flushing $f\n";
 open(O,">$f.tmp") || return undef;
 binmode(O);
 open(I,"<$f") || print O "\n";
 binmode(I);
 local $/="\n";
 my @l=(sort keys %{$this->{updated}});
 my ($k,$d,$r,$v);
 while($r=<I>) {
  ($k,$d)=split("\002",$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; close O; unlink($f); rename("$f.tmp", $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}++ >$main::OrderedTieHashSize || ($this->{cnt} & 0x1f) == 0 && mtime($this->{fn}) != $this->{age});

 return $this->{cache}{$key}=binsearch($this->{fn},$key);
}

sub resetCache {
 my $this=shift;
 $this->{cnt}=0;
 $this->{age}=mtime($this->{fn});
 $this->{cache}={%{$this->{updated}}};
 main::mlog(0,"cache reset ($this->{fn})");
}

sub binsearch {
 my ($f,$k)=@_;
 open(F,"<$f") || return undef;
 binmode(F);
 my $count=0;
 my $siz=my $h=-s $f;
 $siz-=1024;
 my $l=0;
 my $k0=$k;
 $k=~s/([\[\]\(\)\*\^\!\|\+\.\\\/\?\`\$\@\{\}])/\\$1/g; # make sure there's no re chars unqutoed in the key
 #print "k=$k ($_[1])\n";
 while(1) {
  my $m=(($l+$h)>>1)-1024;
  $m=0 if $m < 0;
  #print "($l $m $h) ";
  seek(F,$m,0);
  my $d; my $read= read(F,$d,2048);
  if( $d=~/\n$k\002([^\n]*)\n/) {
   close F;
   #print "got $1\n";
   return $1;
  }
  my ($pre,$first,$last,$post)=$d=~/^(.*?)\n(.*?)\002.*\n(.*?)\002.*?\n(.*?)$/s;
  #print "f=$first ";
  last unless defined $first;
  if($k0 gt $first && $k0 lt $last) {
   #print "got miss\n";
   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);
  }
  #print "l=$l h=$h ";
  if($count++ > 100) {
   main::mlog(0,"Error: $this->{fn} must be repaired ($k0)");
   last;
  }
 }
 close F;
 return undef;
}

sub FIRSTKEY { $this=shift;
 $this->flush();
 $this->{ptr}=1;
 $this->NEXTKEY();
}
sub NEXTKEY { my ($this, $lastkey)=@_;
 local $/="\n";
 open(F,"<$this->{fn}") || return undef;
 binmode(F);
 seek(F,$this->{ptr},0);
 my $r=<F>;
 return undef unless $r;
 $this->{ptr}=tell F;
 close F;
 my ($k,$v)=$r=~/(.*?)\002(.*?)\n/s;
 if(!exists($this->{cache}{$k}) && $this->{cnt}++ >$main::OrderedTieHashSize) {
  $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)=@_;
 open(F,">$this->{fn}"); binmode(F); print F "\n"; close F;
 $this->{cache}={};
 $this->{updated}={};
 $this->{cnt}=0;
}
}

{
#################################################################
# this package implements a pure perl virus scanner
# it uses the clam anti-virus databases (see www.clamav.net)
# Download your databases this way -- maybe once a day:
#  wget --timestamping http://database.clamav.net/database/viruses.db
#  wget --timestamping http://database.clamav.net/database/viruses.db2
#
# copyright (C) 2004, John Hanna under the terms of the GPL

package Av;

# load the databases -- return the number of signatures present
# optional parameters:
#   path => "/path/to/your/clamav/db/files", # default .
#   databases => "viruses.db,viruses.db2" # as many or as few as you want
sub init { my($proto,$args)=@_;
 $path= $args->{path} || ".";
 $databases = $args->{databases} || "viruses.db,viruses.db2";
 loadAll();
}

# public function to create a new scan buffer -- see addchar below
sub new { bless({offset=>0, buf=>'', prereq=>{}}, ref($_[0]) || $_[0]); }

# public function to reset the scan buffer
sub clear {my $self=shift; $self->{offset}=0; $self->{buf}=''; $self->{prereq}={};}

# return the number of signatures in the virus database
sub count {$count}

# called internally, but can be called to manually reload the virus signature database
sub loadAll {
 $count=0;
 $longest=0;
 undef %prereqs;
 $prereqcount='a';
 undef @db;
 load("$path/$_") for (split(/,/,$databases));
 #print "l=$longest c=$count\n";
 $count;
}

# called internally to add a signature file to the database
sub load { my ($f)=@_;
 open(F,"<$f");
 $fileTimes{$f}=[stat(F)]->[9];
 #print "ft{$f}=$fileTimes{$f}\n";
 my ($nam,$sig,$lsig);
 while(<F>) {
  ($nam,$sig)=/(.*)=(.*)/;
  next unless $sig;
  $sig=lc $sig;
  $nam=~s/ \(clam\)//i;
  $nam=~s/'/\\'/g;
  my @parts=split(/\*/,$sig);
  my $lp;
  for my $part (0 .. $#parts) {
   my $p=$parts[$part];
   $longest = length($p)/2 if length($p)/2 > $longest;
   my $prereqn=$prereqs{$p} || ($prereqs{$p}=++$prereqcount);# if($part < $#parts);
   my $prereq=$part? $prereqs{$lp} :'';
   $lp=$p;
   my $return=$part == $#parts? $nam:'';
   my $setprereq=$part == $#parts? '' : $prereqn;
   my ($tail)=$p=~/([0-9a-f]{2,16})$/;
   my $ltail = length($tail);
   my $hsize=$ltail >=16? 8: $ltail >= 8? 4: $ltail >= 4? 2: 1;
   my $loc=substr($tail,-2*$hsize);

   my($pretest,$rest)=$p=~/([0-9a-f]{2,8})([0-9a-f\?]*)$/;
   $pretest=pack("H*",$pretest);
   my $lpretest=length($pretest);
   $rest=length($rest)/2+$lpretest;
   my @pretest;
   if($rest>$hsize && length($p) > 32) {
    @pretest=(-$rest,$lpretest,$pretest);
   } else {@pretest=(0,0,'');}
   $test=$p;
   $test=~s/(..)/\\x$1/g;
   my ($re,$match,$matchlen)=('','',0);
   if($test=~s/\\x\?\?/./g) {
    $re=qr/$test$/s;
   } else {
    my $len=length($p)/2;
    $matchlen=$len; $match=pack("H*",$p);
    #$match="" if $len == $hsize;
   }

   push(@{$db[$hsize]->{pack("H*",$loc)}}, [$prereq,$return,$setprereq,@pretest,$re,$match,$matchlen]);
   #print "db[$hsize]->{$loc}.=$action if $prereq $pretest $test\n";# if length($p)/2 == $hsize;
  }
  $count++;
 }
 close F;
}

# public function to check if the database needs to be reloaded
# use this this way: Av->loadAll if Av->checkReload;
sub checkReload {
 for my $f (split(/,/,$databases)) {
  $f="$path/$f";
  # we want to reload if a file is newer (has later date) than when read,
  # and is at least 120 seconds old -- in lieu of locking
  my $modtime=[stat($f)]->[9];
  #print "$f -> $fileTimes{$f} ==? $modtime\n";
  if($modtime > $fileTimes{$f} && time - $modtime > 120) {
   #loadAll();
   return 1;
  }
 }
 0;
}

# public function to scan a file
# returns undef if no virus found
# returns array-ref with the offset into the buffer and the name of the virus if found
# you can pass in an offset to start scanning to continue scanning the file
# you may need to $av->clear to get the desired effects
sub scanfile { my ($self, $file, $n)=@_;
 open(F,"<$file") || die("Couldn't open $file: $!"); binmode F;
 my $c;
 $self->{offset}=$n; $self->{buf}=''; $self->{prereq}={};
 seek(F,$n,0) if $n>0;
 seek(F,$n,2) if $n < 0;
 #print "reading ";
 my $r;
 while(defined ($c=getc(F))) {
  #printf "$c ";
  return $r if $r=$self->addchar($c);
 }
 close F;
 undef;
}

# public function to do character-at-a-time scanning.
# $av=Av->new();
# for my $c (split(//,$buf)) {
#  print "'$r->[1]' virus found at offset $r->[0]\n" if $r=$av->addchar($c);
# }
sub addchar {
 my $self=shift;
 $self->{buf} .= $_[0];
 $self->{offset}++;
 if(length($self->{buf}) > $longest * 2) {
  $self->{buf}=substr($self->{buf}, -$longest);
 }
 for $hsiz (8,4,2,1) {
  my $l=$db[$hsiz]->{substr($self->{buf},-$hsiz)};
  for (@{$l}){
   #print "p=$_->[0] r=$_->[1] sp=$_->[2] ploc=$_->[3] plen=$_->[4] pstr=$_->[5] ml=$_->[8] m=$_->[7]\n";
   #my($prereq,$return,$setprereq,$ploc,$plen,$pstr,$re,$match,$matchlen)=@{$_};
   # turns up $_->[n] is faster than using that ^^^
   #if( ! $prereq || $self->{prereq}->{$prereq} ) {
    # pre test
    #if((! $plen) || substr($self->{buf},$ploc,$plen) eq $pstr) {
     # real test
     #if($matchlen && substr($self->{buf},-$matchlen) eq $match || ! $matchlen && $self->{buf}=~$re) {
      #$setprereq && ($self->{prereq}->{$setprereq}=1) || return [$self->{offset},$return];
   if( ! $_->[0] || $self->{prereq}->{$_->[0]} ) {
    # pre test
    if(! $_->[4] || substr($self->{buf},$_->[3],$_->[4]) eq $_->[5]) {
     # real test
     if($_->[8] && substr($self->{buf},-$_->[8]) eq $_->[7] || ! $_->[8] && $self->{buf}=~$_->[6]) {
      $_->[2] && ($self->{prereq}->{$_->[2]}=1) || return [$self->{offset},$_->[1]];
     }
    }
   }
  }
 }
 return undef;
}

}
