# # MailScanner - SMTP E-Mail Virus Scanner # Copyright (C) 2002 Julian Field # # $Id: Config.pm 3887 2007-05-12 18:36:48Z sysjkf $ # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. # # This program is distributed in the hope that it will be useful, # but WITHOUT ANY WARRANTY; without even the implied warranty of # MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the # GNU General Public License for more details. # # You should have received a copy of the GNU General Public License # along with this program; if not, write to the Free Software # Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA # # The author, Julian Field, can be contacted by email at # Jules@JulianField.net # or by paper mail at # Julian Field # Dept of Electronics & Computer Science # University of Southampton # Southampton # SO17 1BJ # United Kingdom # package MailScanner::Config; use Net::CIDR; use strict 'vars'; use strict 'refs'; no strict 'subs'; # Allow bare words for parameter %'s use vars qw($VERSION); ### The package version, both in 1.23 style *and* usable by MakeMaker: $VERSION = substr q$Revision: 3887 $, 10; #1 exception to general rule of forming replies to Config::Value() #is %Config::ScannerCmds #This maps the virus scanner name to the command used to execute it #and is all defined in 1 config file (virus.scanners.conf). # Needs to provide method called Value which takes # Value( [, ]) # and returns the value for this case # # Simple variables won't need a . # Locking definitions for flock() which is used to lock the config files my($LOCK_SH) = 1; my($LOCK_EX) = 2; my($LOCK_NB) = 4; my($LOCK_UN) = 8; # This is global within this package to save passing them all over the place my(%File, %LineNos, %ItoE, %EtoI); my(%StaticScalars, %ScannerCmds, %SpamLists); my(%KeywordCategory, %KeywordType, %FilenameRules, %FiletypeRules); my(%LanguageStrings, %YesNoItoE, %YesNoEtoI, %HardCodedDefaults); my(%RuleScalars, %Defaults, $DefaultAddressRegexp, $DefaultVirusRegexp); my(%CustomFunctions, %CustomFunctionsParams); my(%PercentVars); # For putting substituted variables in all settings my($RequireLDAPDone); use vars qw(%PhishingWhitelist); # Whitelist of hostnames for Phishing Net use vars qw($LDAP $LDAPserver $LDAPbase $LDAPsite); # LDAP connection info $RequireLDAPDone = 0; # Have we done the "require Net::LDAP"? %KeywordCategory = (); # These store the type of rule for every keyword %StaticScalars = (); # Need to work out defaults for sendmail2 somewhere! %RuleScalars = (); # These are the ones created from rulesets %CustomFunctions = (); # These are names of user-written functions %CustomFunctionsParams = (); # and their parameters passed to Init and End # This is what the RuleToRegexp function produces when given # either "*@*" or "default". $DefaultAddressRegexp = '^.*\@.*\.?$'; $DefaultVirusRegexp = '.*'; # Need to read in a filename/ruleset whose value is the location of # filename.rules.conf files. Check every rule of every ruleset in # turn, stopping with the result of the first rule that matches. # If nothing matches, then allow the filename. # 3 little accessor functions for reading package-local variables from # inside Custom Functions, so you can make a configuration option act # as a Function and a Ruleset at the same time :-) sub GetFileValue { my($name) = @_; return $File{$name}; } sub SetFileValue { my($name, $value) = @_; if (defined $value) { $File{$name} = $value; } else { delete $File{$name}; } } sub GetItoE { return \%ItoE; } sub GetEtoI { return \%EtoI; } sub SetCustomFunction { my($func, $value) = @_; if (defined $value) { $CustomFunctions{$func} = $value; } else { delete $CustomFunctions{$func}; } } sub GetCustomFunction { my($func) = @_; return $CustomFunctions{$func}; } # # Given a keyword name (in lowercase) and optionally a message, # work out the value of the keyword. # It is designed to produce a result very fast when there is no ruleset, # as most people will only use rulesets in a couple of places. # sub Value { my($name, $msg) = @_; my($funcname, $result); #$name = lc($name); # Debug output #print STDERR "Looking up config value $name => " . # $StaticScalars{$name} . "\n" # if $name eq 'spamwhitelist'; #$StaticScalars{$name}; #print STDERR "*** 1 $name\n" if $name eq 'spamwhitelist'; # Make this as fast as possible in simple situations return $StaticScalars{$name} if exists $StaticScalars{$name}; # User custom-written functions are easy to spot too $funcname = $CustomFunctions{$name}; if ($funcname) { my $param = ""; $funcname = 'MailScanner::CustomConfig::' . $funcname; no strict 'refs'; if ($param = $CustomFunctionsParams{$name}) { $param =~ s/^\(//; # Trim the brackets $param =~ s/\)$//; $param =~ s/\"//g; # and quotes my @params = split(/,/, $param); $result = &$funcname($msg, \@params); # Call with a ref-->list of params } else { $result = &$funcname($msg); } use strict 'refs'; #print STDERR "It was a CF\n" if $name eq 'spamwhitelist'; return $result; } #print STDERR "*** 2 $name\n" if $name eq 'languagestrings'; # # Must be a check against a ruleset # # If it's a ruleset, and they didn't supply a message to test against, # then the only thing we can do is return the default value. return $Defaults{$name} unless $msg; # # They have supplied a message, so check all its addresses against the rules # #print STDERR "*** 3 $name\n" if $name eq 'spamwhitelist'; my($category, $rulelist, $rule); my($direction, $iporaddr, $regexp2, $value); my(@addresses); $category = $KeywordCategory{$name}; $rulelist = $RuleScalars{$name}; #print STDERR "Evaluating ruleset for $name\n"; # They might want the behaviour that when there are multiple recipients # in the same domain, only the rule that matches *@domain.com (the # literal character "*") is used. When there are multiple recipients # in different domains, only the rule that matches *@* is used. If no # specific rule for \*@\* is specified, then naturally the default value # is used, as that would match *@* anyway. # The switch that controls this behaviour is a "simple" switch, so as # not to make this function too recursive and for speed. my $tooverride; $tooverride = undef; #print STDERR "*** 4 $name\n" if $name eq 'spamwhitelist'; if ($StaticScalars{'usedefaultswithmanyrecips'}) { my(%recipdomains, $recip); # This only applies with multiple recipients if (scalar(@{$msg->{to}}) > 1) { # Get a list of all the domains into keys(%recipdomains) foreach $recip (@{$msg->{to}}) { $recipdomains{lc($1)} = 1 if $recip =~ m/\@(.*)$/; } if (scalar(%recipdomains) =~ /^1\//) { # There was just 1 domain, so use *@domain.com my $domain = (keys %recipdomains)[0]; # Protect domain name against evil SMTP clients $domain =~ s/\s//g; $tooverride = '*@' . $domain; } else { # There were many domains, so look up *@* which would *normally* # be the default value $tooverride = '*@*'; } } } #print STDERR "*** 5 $name\n" if $name eq 'languagestrings'; #return '/etc/MailScanner/reports/cz/languages.conf' if $name eq 'languagestrings'; my($directiona, $iporaddra, $regexp2a, $valuea, @results); if ($category =~ /first/i) { # print STDERR "*** 6 First $name\n" if $name eq 'spamwhitelist'; # # It's a first-match rule # #print STDERR "$name first-match rule\n"; # If there is no ruleset either, then return the default #print STDERR "There are rules for languagestrings\n" if $name eq 'languagestrings'; #return '/etc/MailScanner/reports/cz/languages.conf' if $name eq 'languagestrings'; return $Defaults{$name} unless $RuleScalars{$name}; foreach $rule (@{$rulelist}) { ($direction, $iporaddr, $regexp2, $value) = split(/\0/, $rule, 4); if ($value =~ /\0/) { # The value is actually another "and" condition # Let's only allow 1 "and" at the moment ($directiona, $iporaddra, $regexp2a, $valuea) = split(/\0/, $value); # Do first condition and bail out if it failed $result = FirstMatchValue($direction, $iporaddr, $regexp2, $valuea, $name, $msg, $tooverride); #print STDERR "1st half result is $result\n"; next if $result eq "CoNfIgFoUnDnOtHiNg"; # Condition matched, so do 2nd half $result = FirstMatchValue($directiona, $iporaddra, $regexp2a, $valuea, $name, $msg, $tooverride); #print STDERR "2nd half result is $result\n"; return $result unless $result eq "CoNfIgFoUnDnOtHiNg"; } else { # It's a simple rule with no "and" in it #print STDERR "Matching against $direction $iporaddr /$regexp/\n"; $result = FirstMatchValue($direction, $iporaddr, $regexp2, $value, $name, $msg, $tooverride); return $result unless $result eq "CoNfIgFoUnDnOtHiNg"; } } # No rule matched, so return the default #print STDERR "Returning default as nothing matched.\n"; return $Defaults{$name}; } else { # # It's an all-matches rule # #print STDERR "all-match rule\n" if $name eq 'spamwhitelist'; # If there is no ruleset either, then return the default #print STDERR "RuleScalars = " . $RuleScalars{$name} . "\n"; #print STDERR "Default is " . $Defaults{$name} . "\n\n"; return $Defaults{$name} unless $RuleScalars{$name}; foreach $rule (@{$rulelist}) { ($direction, $iporaddr, $regexp2, $value) = split(/\0/, $rule, 4); if ($value =~ /\0/) { # The value is actually another "and" condition # Let's only allow 1 "and" at the moment ($directiona, $iporaddra, $regexp2a, $valuea) = split(/\0/, $value); # Do first condition and bail out if it failed $result = AllMatchesValue($direction, $iporaddr, $regexp2, $valuea, $name, $msg, $tooverride); next if $result eq "CoNfIgFoUnDnOtHiNg"; # Condition matched, so do 2nd half $result = AllMatchesValue($directiona, $iporaddra, $regexp2a, $valuea, $name, $msg, $tooverride); next if $result eq "CoNfIgFoUnDnOtHiNg"; push @results, $result; } else { # It's a simple rule with no "and" in it #print STDERR "Matching against $direction $iporaddr /$regexp/\n"; $result = AllMatchesValue($direction, $iporaddr, $regexp2, $value, $name, $msg, $tooverride); next if $result eq "CoNfIgFoUnDnOtHiNg"; push @results, $result; } } # Return the results if there were any, else the defaults return join(" ", @results) if @results; return $Defaults{$name}; } } sub FirstMatchValue { my($direction, $iporaddr, $regexp2, $value, $name, $msg, $tooverride) = @_; #print STDERR "Params are: $direction, $iporaddr, $regexp2, $value, $name, $msg, $tooverride\n"; my($regexp, $misses, $to); # Pre-compile $regexp2 and include case-insensitivity flag $regexp = qr/$regexp2/i; if ($iporaddr eq 't') { # It is a virus name matching rule. if ($direction =~ /v/) { # Look through the reports and match substrings. # This is for first-matching rules only. # Don't return anything unless we find a match. my($file, $text); while(($file, $text) = each %{$msg->{allreports}}) { return $value if $text =~ /$regexp/; } } elsif ($direction =~ /b/) { # It's a text address-based rule # Match against all the To addresses and the From address $misses = 0; $misses++ unless $msg->{from} =~ /$regexp/; if (defined $tooverride) { $misses++ unless $tooverride =~ /$regexp/; } else { foreach $to (@{$msg->{to}}) { $misses++,last unless $to =~ /$regexp/; } } return $value if $misses == 0; } else { # Match against any of From and/or To addresses if ($direction =~ /f/) { # Match against the From address #print STDERR "From " . $msg->{from} . " against $regexp\n"; return $value if $msg->{from} =~ /$regexp/; #print STDERR "Miss\n"; } if ($direction =~ /t/) { # Match against every To address if (defined $tooverride) { return $value if $tooverride =~ /$regexp/; } else { foreach $to (@{$msg->{to}}) { #print STDERR "To " . $to . " against $regexp\n"; #print STDERR "Resulting value would be $value\n"; return $value if $to =~ /$regexp/; #print STDERR "Miss\n"; } } } } } elsif ($iporaddr eq 'd') { # # It is an all-digits rule # # It is a virus name matching rule. if ($direction =~ /v/) { # Look through the reports and match substrings. # This is for first-matching rules only. # Don't return anything unless we find a match. my($file, $text); while(($file, $text) = each %{$msg->{allreports}}) { return $value if $text =~ /$regexp/; } } elsif ($direction =~ /f/) { # It's a numeric ip-number-based rule # Can only check these with From:, not To: addresses # Match against the SMTP Client IP address #print STDERR "Matching IP " . $msg->{clientip} . " against $regexp\n"; if ($regexp =~ /\d+\\\.\d+\\\.\d+\\\.\d+\)*$/) { # It's a complete IPv4 address so it's a total string match, not a re #print STDERR "Got a match\n"; return $value if $msg->{clientip} =~ /^$regexp$/; } else { # It's not a complete IPv4 address so substring match it #print STDERR "Got no match\n"; return $value if $msg->{clientip} =~ /$regexp/; } } if ($direction =~ /[tb]/) { # Don't know the target IP address MailScanner::Log::WarnLog("Config Error: Cannot match against " . " destination IP address when resolving configuration option " . " \"%s\"", $name); } } else { # # It is a CIDR (network/netmask) rule # # It is a virus name matching rule. if ($direction =~ /v/) { # Look through the reports and match substrings. # This is for first-matching rules only. # Don't return anything unless we find a match. my($file, $text); while(($file, $text) = each %{$msg->{allreports}}) { return $value if $text =~ /$regexp/; } } elsif ($direction =~ /f/) { # Can only check these with From:, not To: addresses # Match against the SMTP Client IP address my(@cidr) = split(',', $regexp2); #print STDERR "Matching IP " . $msg->{clientip} . # " against " . join(',',@cidr) . "\n"; return $value if Net::CIDR::cidrlookup($msg->{clientip}, @cidr); } if ($direction =~ /[tb]/) { # Don't know the target IP address MailScanner::Log::WarnLog("Config Error: Cannot match against " . " destination IP address when resolving configuration option " . " \"%s\"", $name); } } # Nothing matched, so return the default value #print STDERR "Nothing matched, so returning default value: " . # $Defaults{$name} . "\n"; #return $Defaults{$name}; return "CoNfIgFoUnDnOtHiNg"; # Caller will work out the default value now } sub AllMatchesValue { my($direction, $iporaddr, $regexp2, $value, $name, $msg, $tooverride) = @_; my($regexp, $misses, $to, @matches); # Pre-compile $regexp2 and include case-insensitivity flag $regexp = qr/$regexp2/i; if ($iporaddr eq 't') { # We may be over-riding the "to" addresses we are looking up with # an over-riding address if there are multiple recipients. if ($direction =~ /v/) { # It is a virus name matching rule. # Look through the reports and match substrings. # This is for first-matching rules only. # Don't return anything unless we find a match. my($file, $text); #print STDERR "Value eq $value\n"; #print STDERR "Regexp = $regexp\n"; #print STDERR "Matches keys = " . join(" ",@matches) . "\n"; while(($file, $text) = each %{$msg->{allreports}}) { #print STDERR "File is $file and text is $text\n"; push @matches, split(" ",$value) if $text =~ /$regexp/; } } elsif ($direction =~ /b/) { # It's a text address-based rule # Match against the From and every To $misses = 0; $misses++ unless $msg->{from} =~ /$regexp/; if (defined $tooverride) { $misses++ unless $tooverride =~ /$regexp/; } else { foreach $to (@{$msg->{to}}) { $misses++,last unless $to =~ /$regexp/; } } push @matches, split(" ",$value) if $misses == 0; } else { if ($direction =~ /f/) { # Match against the From address push @matches, split(" ",$value) if $msg->{from} =~ /$regexp/; } if ($direction =~ /t/) { # Match against every To address if (defined $tooverride) { push @matches, split(" ",$value) if $tooverride =~ /$regexp/; } else { foreach $to (@{$msg->{to}}) { push @matches, split(" ",$value) if $to =~ /$regexp/; } } } } } elsif ($iporaddr eq 'd') { if ($direction eq 'v') { # It is a virus name matching rule. # Look through the reports and match substrings. # This is for first-matching rules only. # Don't return anything unless we find a match. my($file, $text); while(($file, $text) = each %{$msg->{allreports}}) { push @matches, split(" ",$value) if $text =~ /$regexp/; } } elsif ($direction eq 'f') { # It's a numeric ip-number-based rule # Can only check these with From:, not To: addresses # Match against the SMTP Client IP address if ($regexp =~ /\d+\\\.\d+\\\.\d+\\\.\d+\)*$/) { # It's a complete IPv4 address so it's a total string match, not a re push @matches, split(" ",$value) if $msg->{clientip} =~ /^$regexp$/; } else { # It's not a complete IPv4 address so substring match it push @matches, split(" ",$value) if $msg->{clientip} =~ /$regexp/; } } else { # Don't know the target IP address MailScanner::Log::WarnLog("Cannot match against destination " . "IP address when resolving configuration option \"%s\"", $name); } } else { # # It is a CIDR (network/netmask) rule # if ($direction eq 'v') { # It is a virus name matching rule. # Look through the reports and match substrings. # This is for first-matching rules only. # Don't return anything unless we find a match. my($file, $text); while(($file, $text) = each %{$msg->{allreports}}) { push @matches, split(" ",$value) if $text =~ /$regexp/; } } elsif ($direction =~ /f/) { # Can only check these with From:, not To: addresses # Match against the SMTP Client IP address my(@cidr) = split(',', $regexp2); #print STDERR "Matching IP " . $msg->{clientip} . # " against " . join(',',@cidr) . "\n"; push @matches, split(" ",$value) if Net::CIDR::cidrlookup($msg->{clientip}, @cidr); } if ($direction =~ /[tb]/) { # Don't know the target IP address MailScanner::Log::WarnLog("Config Error: Cannot match against " . " destination IP address when resolving configuration option " . " \"%s\"", $name); } } # Return the concatenation of all the matching rules my($results); $results = join(" ", @matches); #print STDERR "Result is \"$results\"\n"; return $results if @matches; # JKF $results ne ""; # Nothing matched, so return the default value #print STDERR "Nothing matched, so returning default\n"; #return $Defaults{$name}; return "CoNfIgFoUnDnOtHiNg"; } # # Is this value just a simple yes/no value, or is it pointing to a ruleset? # sub IsSimpleValue { my($name) = @_; return 1 if exists $StaticScalars{$name}; return 0; } # # Substitute Percent Variables into a line of text # sub DoPercentVars { my($string) = @_; $string =~ s/\%([^%\s]+)\%/$PercentVars{lc($1)}/g; $string =~ s/\\n/\n/g; $string; } # # Read all the CustomConfig.pm files in the Custom Config Dir # sub initialise { my($dir) = @_; my($dirh,$filename,$fullfile); $dirh = new DirHandle; unless ($dirh->open($dir)) { MailScanner::Log::WarnLog("Could not read Custom Functions directory %s", $dir); return; } while(defined($filename = $dirh->read)) { # Only process files ending with .pm or .pl # Skip all dot files and rpmnew files next if $filename =~ /^\./ || $filename =~ /\.(rpmnew|dpkg-dist|dpkg-new|dpkg-old)$/i; unless ($filename =~ /\.p[lm]$/i) { MailScanner::Log::NoticeLog("Skipping Custom Function file %s as its name does not end in .pm or .pl", $filename); next; } $fullfile = "$dir/$filename"; next unless -f $fullfile and -s $fullfile; eval { require $fullfile; }; if ($@) { MailScanner::Log::WarnLog("Could not use Custom Function code %s, " . "it could not be \"require\"d. Make sure " . "the last line of the file says \"1;\"", $fullfile); } # else { # MailScanner::Log::InfoLog("Using Custom Function file %s", $fullfile); # } } } # # Set one of the %percentvars%. # sub SetPercent { my($percent, $value) = @_; $PercentVars{$percent} = $value; } # # Hack quickly through the config file looking for a keyword. # Cannot use MailScanner::Log here at all, as it hasn't started yet. # sub QuickPeek { my($filename, $target, $notifldap) = @_; my($fh, $key, $value, $targetfound, $targetvalue); my($ldapserver, $ldapsite, $ldapbase); $target = lc($target); $target =~ s/[^%a-z0-9]//g; # Leave % vars intact $fh = new FileHandle; $fh->open("<$filename") or die "Cannot open config file $filename, $!"; flock($fh, $LOCK_SH); while(<$fh>) { chomp; s/^#.*$//; s/^\s*//g; s/\s*$//g; next if /^$/; $key = undef; # Don't carry over values from previous iteration $value = undef; /^(.*?)\s*=\s*(.*)$/; ($key,$value) = ($1,$2); # Allow %var% = value lines with $VAR in value $value =~ s/\%([^%]+)\%/$PercentVars{lc($1)}/g; $value =~ s/\$\{?(\w+)\}?/$ENV{$1}/g; $value =~ s/\\n/\n/g; if ($key =~ /^\%([^%]+)\%$/) { $PercentVars{lc($1)} = $value unless exists $PercentVars{lc($1)}; #next; -- Store the percentvars in the key{value} hash as well. } $key = lc($key); $key =~ s/[^%a-z0-9]//g; # Leave numbers and letters only -- leave % vars $ldapserver = $value if $key =~ /ldapserver/i; $ldapsite = $value if $key =~ /ldapsite/i; $ldapbase = $value if $key =~ /ldapbase/i; if ($key =~ /^$target$/i) { #print STDERR "Key is \"$key\" and target is \"$target\"\n"; $targetfound = 1; $targetvalue = $value; } # Allow %% on left had side } # Unlock and close flock($fh, $LOCK_UN); $fh->close(); # Now do the stuff if $noldap is set, so we don't actually if ($ldapserver && $notifldap) { return undef; } # # Now try and over-ride the value with the setting from LDAP # #print STDERR "About to QuickPeek into LDAP for $target\n"; if ($ldapserver) { my($connection, $binding); my($result, $searchfor, $number, $entr, $attr, $attr2); # Load all the LDAP code require 'Net/LDAP.pm' unless $RequireLDAPDone; $RequireLDAPDone = 1; # Connect and bind $connection = Net::LDAP->new($ldapserver, onerror=>'warn') or print STDERR "Making LDAP connection error: $@\n"; # Change for JPK $binding = $connection->bind($ldapbase, anonymous=>1); $binding = $connection->bind(); $binding->code and print STDERR "LDAP binding error: $@\n"; # Build the search string 1 bit at a time. Gets syntax right that way. $searchfor = "(objectClass=mailscannerconfmain)"; $searchfor = "(&$searchfor(mailScannerSite=$ldapsite))"; $searchfor = "(&$searchfor(mailScannerConfBranch=main))"; $result = $connection->search( base => $ldapbase, scope => 'sub', filter => $searchfor ); $result->code and print STDERR "LDAP search for configuration option " . "$target returned error: " . $result->error . "\n"; $number = 0; while (defined($entr = $result->entry($number))) { #print STDERR "Fetched Entry $number\n"; #print STDERR "DN: ", $entr->dn, "\n"; foreach $attr (sort $entr->attributes) { next if $attr =~ /;binary$/; $attr2 = lc($attr); #next if $attr2 eq 'mailscannerconfbranch'; #$attr2 =~ s/^mailscannerconf//i or next; if ($attr2 =~ /^$target$/i) { $targetfound = 1; $targetvalue = join(' ',@{$entr->get_value($attr, asref=>1)}); #print STDERR "$attr2 : $targetvalue\n"; #print STDERR "QuickPeek LDAP found $attr2 : $targetvalue\n"; last; } } $number++; } # Disconnect LDAP server again $connection->unbind(); } # # If we found the target key in either the conf file or LDAP, return it # if ($targetfound) { #print STDERR "QuickPeek returning $targetvalue\n"; return $targetvalue; } else { return undef; } #warn "Cannot find definition of $target in config file $filename" # unless $key =~ /$target/i; } # # Allow external code to over-ride values of config variables # if they are currently "" # sub Default { my($keyword, $value) = @_; if (Value($keyword) eq "") { $StaticScalars{$keyword} = $value; } } # # Translate external <--> internal keyword names # sub ItoE { my($val) = @_; lc($ItoE{$val}) or lc($val); } sub EtoI { my($val) = @_; lc($EtoI{$val}) or lc($val); } # Process and setup the configuration sub Read { my($filename) = @_; # Save the configuration filename and directory for later potential use # in Custom Functions. $MailScanner::Config::ConfFile = $filename; ReadData($filename); # Read all the filename rules. The "Value" of filenamerules is a list # of filenames, each of which contains a list of allow/deny rules. # We will have to construct a list of allow/deny rules from the list of # matching filenames. We need to build a hash mapping filename to a list # of rules. ReadFilenameRules('filenamerules'); #print STDERR "Finished reading filename rules files\n"; # Read all the filetype rules. The "Value" of filetyperules is a list # of filenames, each of which contains a list of allow/deny rules. # We will have to construct a list of allow/deny rules from the list of # matching filenames. We need to build a hash mapping filename to a list # of rules. ReadFiletypeRules('filetyperules'); #print STDERR "Finished reading filename rules files\n"; # Read all the language strings to provide multi-lingual output of # all data that goes to the end user. # The "value" of languagestrings is a filename, which contains a list # of language translation strings. ReadLanguageStrings('languagestrings'); #print STDERR "Finished reading language strings files\n"; # Read the name/glob/list-name of incoming queue dirs, # remove it from the config data, and replace it with # a list of incoming queue dirs. my($list) = $StaticScalars{inqueuedir}; delete $StaticScalars{inqueuedir}; ReadInQueueDirs($list); # Read all the virus scanner definitions. # These map a scanner name onto a filename. %ScannerCmds = ReadDefinitions(Value('virusscannerdefinitions')); # Read all the spam list definitions. # These map a spam list name onto a DNS domain %SpamLists = ReadDefinitions(Value('spamlistdefinitions')); # Read in the Phishing Net whitelist. # This lists all the hostnames of places to ignore when phishing. %PhishingWhitelist = ReadPhishingWhitelist(Value('phishingwhitelist')); # Call all the user's custom initialisation functions my($key, $param, $custom, $fn); foreach $key (keys %CustomFunctions) { $custom = $CustomFunctions{$key}; next unless $custom; $param = $CustomFunctionsParams{$key}; MailScanner::Log::InfoLog("Config: calling custom init function %s%s", $custom, $param); $fn = 'MailScanner::CustomConfig::Init' . $custom . $param; no strict 'refs'; eval ($fn); if ($@) { MailScanner::Log::WarnLog("Could not use Custom Function code %s, " . "it could not be \"eval\"ed. Make sure the module is correct with " . "perl -wc", $fn); $StaticScalars{$key} = $Defaults{$key}; # Over-ride if function broken } use strict 'refs'; } # Read the list of second-level country domain codes that exist %MailScanner::Config::SecondLevelDomainExists = (); ReadCountryDomainList(MailScanner::Config::Value('secondlevellist')) unless MailScanner::Config::IsSimpleValue('strictphishing') && MailScanner::Config::Value('strictphishing'); # Debug output #PrintDefinitions(%ScannerCmds); #PrintDefinitions(%SpamLists); # Over-ride for EnableSpamBounce option $StaticScalars{'enablespambounce'} if exists $StaticScalars{'enablespambounce'}; $Defaults{'enablespambounce'} = 0; } # Read the list of hostnames to be ignored when doing phishing tests. # Pass in the filename. Return the hash. sub ReadPhishingWhitelist { my($filename) = @_; my($fh, %whitelist, @blacklist, $counter); %whitelist = (); # Skip this if they have findphishing = no return if MailScanner::Config::IsSimpleValue('findphishing') && !MailScanner::Config::Value('findphishing'); $filename =~ s/^\s*//g; $filename =~ s/\s*$//g; return () unless $filename; $fh = new FileHandle; unless (open($fh, "<$filename")) { MailScanner::Log::WarnLog("Could not read phishing whitelist file %s"); return (); } $counter = 0; while(<$fh>) { chomp; s/^#.*$//; # Remove comments s/^\s*//g; # Remove leading white space s/\s*$//g; # Remove trailing white space s/\s+.*$//g; # Leave only the 1st word next if /^$/; # Entries in the list starting with "REMOVE " in capitals cause the entry # to be forcibly removed from the phishing whitelist. if (/^REMOVE\s+(\S+)/i) { delete $whitelist{$1}; push @blacklist, $1; } else { $whitelist{$_} = 1; $counter++; } } # Now process the blacklist foreach (@blacklist) { delete $whitelist{$_}; } close $fh; MailScanner::Log::InfoLog("Read %d hostnames from the phishing whitelist", $counter); return %whitelist; } # Give all the user's custom functions a chance to clear up # and neatly shutdown, log totals, close databases, etc. sub EndCustomFunctions { my($custom, $key, $param, $fn); foreach $key (keys %CustomFunctions) { $custom = $CustomFunctions{$key}; next unless $custom; $param = $CustomFunctionsParams{$key}; MailScanner::Log::InfoLog("Config: calling custom end function %s%s", $custom, $param); $fn = 'MailScanner::CustomConfig::End' . $custom . $param; no strict 'refs'; eval($fn); use strict 'refs'; } } # Read the list of second-level domains. We don't check top-level domains # as you cannot hide much in there. sub ReadCountryDomainList { my ($filename) = @_; %MailScanner::Config::SecondLevelDomainExists = (); my $fh = new FileHandle; unless ($fh->open("< $filename")) { MailScanner::Log::WarnLog("Could not read list of country code second-level domain names from %s, \"Use Stricter Phishing Net = no\" will not work properly", $filename); return; } while(<$fh>) { chomp; s/^#.*$//; # Remove comments s/^\s*//g; # Remove leading white space s/\s*$//g; # Remove trailing white space s/\s+.*$//g; # Leave only the 1st word next if /^$/; # Only allow 2 dots at most if (/\..*\..*\./) { # There were at least 3 dots MailScanner::Log::WarnLog("Domain name \"%s\" in %s is deeper than third-level, ignoring it", $_, $filename); next; } $MailScanner::Config::SecondLevelDomainExists{"$_"} = 1; } $fh->close; } # Return a ref to a list of all the filename-rules for a message # This is done completely separately from the Value() function # as that will just return the list of filename rules, not the # rules themselves. sub FilenameRulesValue { my($message) = @_; my($list,@filenamelist,$file,$listref,@totallist); # Get the list of filenames and split it $list = Value('filenamerules', $message); @filenamelist = split(" ", $list); return undef unless @filenamelist; # Now construct a list containing the concatenation of all the allow-deny # rules #print STDERR "Filename rulesets are " . join(', ', @filenamelist) . "\n"; foreach $file (@filenamelist) { if (!exists($FilenameRules{$file})) { #print STDERR "Could not find filenamerules $file, forcing a re-read.\n"; # This filename has not been seen before, so compile it now. # Skip the file if it didn't exist, error already generated. next unless $FilenameRules{$file} = ReadOneFilenameRulesFile($file); } $listref = $FilenameRules{$file}; #print STDERR "listref = $listref\n"; #print STDERR "listref = " . @{$listref} . "\n"; push @totallist, @{$listref}; } #print STDERR "Filename rules for message are\n" . join("\n",@totallist) . # "Filename rules for message ends.\n"; return \@totallist; } # Return a ref to a list of all the filetype-rules for a message # This is done completely separately from the Value() function # as that will just return the list of filetype rules, not the # rules themselves. sub FiletypeRulesValue { my($message) = @_; my($list,@filetypelist,$file,$listref,@totallist); # Get the list of filenames and split it $list = Value('filetyperules', $message); @filetypelist = split(" ", $list); return undef unless @filetypelist; # Now construct a list containing the concatenation of all the allow-deny # rules #print STDERR "Filetype rulesets are " . join(', ', @filenamelist) . "\n"; foreach $file (@filetypelist) { if (!exists($FiletypeRules{$file})) { # This filename has not been seen before, so compile it now. # Skip the file if it didn't exist, error already generated. next unless $FiletypeRules{$file} = ReadOneFilenameRulesFile($file); } $listref = $FiletypeRules{$file}; #print "listref = $listref\n"; push @totallist, @{$listref}; } #print STDERR "Filetype rules for message are\n" . join("\n",@totallist) . # "Filetype rules for message ends.\n"; return \@totallist; } # Return a string which is the input string translated into the correct # language for this particular message. sub LanguageValue { my($message, $string) = @_; my $filename = Value('languagestrings', $message); #print STDERR "Looking up $string in $filename\n"; #print STDERR "Answer is " . $LanguageStrings{$filename}{$string} . "\n"; if (exists $LanguageStrings{$filename}{$string}) { return $LanguageStrings{$filename}{$string}; } else { MailScanner::Log::WarnLog('Looked up unknown string %s in language ' . 'translation file %s', $string, $filename); # As a special case, automatically capitalise my name! $string = "MailScanner" if $string eq "mailscanner"; return $string; } } # Read all the possible filename-rules files. # Store them each in a hash of list of \0-separated fields. sub ReadFilenameRules { my($keyword) = @_; my($rule, $ruleset, $direction, $iporaddr, $regexp, $filename, $namelist, %donefile); #print STDERR "About to read in all the possible filename rules\n"; # Do the static filename list if there is one $namelist = $StaticScalars{$keyword}; #print STDERR "Filename-rules: keyword is $keyword, filename is $namelist\n"; foreach $filename (split(" ", $namelist)) { $donefile{"$filename"} = 1; $FilenameRules{$filename} = ReadOneFilenameRulesFile($filename); #print STDERR "Storing: $filename is " . $FilenameRules{$filename} . "\n"; } # Do the default filename list if there is one $namelist = $Defaults{$keyword}; #print STDERR "Filename-rules: default keyword is $keyword, filename is $namelist\n"; if (defined $namelist) { foreach $filename (split(" ", $namelist)) { $donefile{"$filename"} = 1; $FilenameRules{$filename} = ReadOneFilenameRulesFile($filename); #print STDERR "Storing: $filename is " . $FilenameRules{$filename} . "\n"; } } # Iterate through every possible rule containing a filename $ruleset = $RuleScalars{$keyword}; #print STDERR "ruleset is $ruleset\n"; #foreach $rule (split(" ", @{$ruleset})) { foreach $rule (@{$ruleset}) { ($direction, $iporaddr, $regexp, $namelist) = split(/\0/, $rule, 4); # Handle rules with an "and" in them if ($namelist =~ /\0/) { ($direction, $iporaddr, $regexp, $namelist) = split(/\0/, $namelist, 4); } #print STDERR "Filename rules are $direction $iporaddr $regexp $namelist\n"; # Each value in the list can itself be a list of filename-rules files foreach $filename (split(" ", $namelist)) { # Skip this allow/deny filename if we've read it already next if $donefile{"$filename"}; $donefile{"$filename"} = 1; # This builds a hash of filename-->ref-to-list-of-rules $FilenameRules{$filename} = ReadOneFilenameRulesFile($filename); #print STDERR "Storing: $filename is " . $FilenameRules{$filename} . "\n"; } } } # Read all the possible filetype-rules files. # Store them each in a hash of list of \0-separated fields. sub ReadFiletypeRules { my($keyword) = @_; my($rule, $ruleset, $direction, $iporaddr, $regexp, $filename, $namelist, %donefile); #print STDERR "About to read in all the possible filetype rules\n"; # Do the static filename list if there is one $namelist = $StaticScalars{$keyword}; #print STDERR "Filetype-rules: keyword is $keyword, filename is $namelist\n"; foreach $filename (split(" ", $namelist)) { $donefile{"$filename"} = 1; $FiletypeRules{$filename} = ReadOneFilenameRulesFile($filename); #print STDERR "Storing: $filename is " . $FiletypeRules{$filename} . "\n"; } # Do the default filename list if there is one $namelist = $Defaults{$keyword}; #print STDERR "Filetype-rules: default keyword is $keyword, filename is $namelist\n"; if (defined $namelist) { foreach $filename (split(" ", $namelist)) { $donefile{"$filename"} = 1; $FiletypeRules{$filename} = ReadOneFilenameRulesFile($filename); #print STDERR "Storing: $filename is " . $FiletypeRules{$filename} . "\n"; } } # Iterate through every possible rule containing a filename $ruleset = $RuleScalars{$keyword}; #print STDERR "ruleset is $ruleset\n"; #foreach $rule (split(" ", @{$ruleset})) { foreach $rule (@{$ruleset}) { ($direction, $iporaddr, $regexp, $namelist) = split(/\0/, $rule, 4); # Handle rules with an "and" in them if ($namelist =~ /\0/) { ($direction, $iporaddr, $regexp, $namelist) = split(/\0/, $namelist, 4); } #print STDERR "Filename rules are $direction $iporaddr $regexp $namelist\n"; # Each value in the list can itself be a list of filename-rules files foreach $filename (split(" ", $namelist)) { # Skip this allow/deny filename if we've read it already next if $donefile{"$filename"}; $donefile{"$filename"} = 1; # This builds a hash of filename-->ref-to-list-of-rules $FiletypeRules{$filename} = ReadOneFilenameRulesFile($filename); #print STDERR "Storing: $filename is " . $FiletypeRules{$filename} . "\n"; } } } # Read all the possible language-strings files. # Store them each in a hash of a hash of key/value pairs. sub ReadLanguageStrings { my($keyword) = @_; my($rule, $ruleset, $direction, $iporaddr, $regexp, $filename, $namelist, %donefile); #print STDERR "About to read in all the possible language strings\n"; # Do the static filename list if there is one $namelist = $StaticScalars{$keyword}; foreach $filename (split(" ", $namelist)) { $donefile{"$filename"} = 1; $LanguageStrings{$filename} = ReadOneLanguageStringsFile($filename); #print STDERR "Storing: $filename is " . $LanguageStrings{$filename} . "\n"; } ## Do the default filename list if there is one #$namelist = $Defaults{$keyword}; ##print STDERR "Language-strings: default keyword is $keyword, filename is $namelist\n"; #foreach $filename (split(" ", $namelist)) { # $donefile{"$filename"} = 1; # $LanguageStrings{$filename} = ReadOneLanguageStringsFile($filename); # print STDERR "Storing: $filename is " . $LanguageStrings{$filename} . "\n"; #} # Iterate through every possible rule containing a filename $ruleset = $RuleScalars{$keyword}; #print STDERR "ruleset is $ruleset\n"; #foreach $rule (split(" ", @{$ruleset})) { foreach $rule (@{$ruleset}) { ($direction, $iporaddr, $regexp, $namelist) = split(/\0/, $rule, 4); # Handle rules with an "and" in them if ($namelist =~ /\0/) { ($direction, $iporaddr, $regexp, $namelist) = split(/\0/, $namelist, 4); } #print STDERR "Language string rules are $direction $iporaddr " . # "$regexp $namelist\n"; # Each value in the list can itself be a list of language-strings files foreach $filename (split(" ", $namelist)) { # Skip this allow/deny filename if we've read it already next if $donefile{"$filename"}; $donefile{"$filename"} = 1; # This builds a hash of filename-->ref-to-list-of-rules #print STDERR "Reading Language Strings file $filename\n"; $LanguageStrings{$filename} = ReadOneLanguageStringsFile($filename); #print STDERR "Storing: $filename is " . $LanguageStrings{$filename} . # "\n"; } } $namelist = $Defaults{$keyword}; if ($namelist) { #print STDERR "Namelist is $namelist\n"; # Each value in the list can itself be a list of language-strings files foreach $filename (split(" ", $namelist)) { # Skip this allow/deny filename if we've read it already next if $donefile{"$filename"}; $donefile{"$filename"} = 1; # This builds a hash of filename-->ref-to-list-of-rules #print STDERR "Reading Language Strings file $filename\n"; $LanguageStrings{$filename} = ReadOneLanguageStringsFile($filename); #print STDERR "Storing: $filename is " . $LanguageStrings{$filename} . # "\n"; } } } # Read one of the lists of filename rules. # Now locks the filename rules file. sub ReadOneFilenameRulesFile { my($filename) = @_; my(@AllowDenyList, $result); # If the rulesfilename ends in ".FileRule" and doesn't contain any '/' # characters, then it's an LDAP ruleset. if ($LDAP && $filename !~ /\// && $filename =~ /\.FileRule$/) { my($searchfor, $linecounter, $default, $error, $errors); my($number, $entr, $attr, $attr2); my($rulenum, $ruleaction, $rulematch, $rulelog, $rulereport, @ruleset); $searchfor = "(objectClass=mailscannerfileruleObject)"; $searchfor = "(&$searchfor(mailScannerFileRuleName=$filename))"; $searchfor = "(&$searchfor(mailScannerSite=$LDAPsite))"; $result = $LDAP->search( base => $LDAPbase, scope => 'sub', filter => $searchfor, attrs => [ 'mailScannerFileRuleNum', 'mailScannerFileRuleAction', 'mailScannerFileRuleMatch', 'mailScannerFileRuleLog', 'mailScannerFileRuleReport' ] ); $result->code and MailScanner::Log::WarnLog("LDAP search for ruleset " . "%s returned error: %s", $filename, $result->error); $number = 0; while (defined($entr = $result->entry($number))) { #print STDERR "Fetched Entry $number\n"; #print STDERR "DN: ", $entr->dn, "\n"; foreach $attr (sort $entr->attributes) { #print STDERR "Filename/type attribute is $attr\n"; next if $attr =~ /;binary$/; $attr = lc($attr); $rulenum = $entr->get_value($attr) if $attr =~ /rulenum/i; $ruleaction = $entr->get_value($attr) if $attr =~ /ruleaction/i; $rulematch = $entr->get_value($attr) if $attr =~ /rulematch/i; $rulelog = $entr->get_value($attr) if $attr =~ /rulelog/i; $rulereport = $entr->get_value($attr) if $attr =~ /rulereport/i; } $ruleset[$rulenum] = Store1FilenameRule( join("\t", $ruleaction, $rulematch, $rulelog, $rulereport), $number, $filename); #print STDERR "Filename/type rule is " . $ruleset[$rulenum] . "\n"; $number++; } #print STDERR "Filename/type rule set is 0.." . $#ruleset . "\n"; foreach $rulenum (0..$#ruleset) { push @AllowDenyList, $ruleset[$rulenum] if $ruleset[$rulenum] ne ""; } foreach $rulenum (@AllowDenyList) { #print STDERR "Filename/type rule is $rulenum\n"; } return \@AllowDenyList; } # # It's not an LDAP rule, so must be a normal file based rule # my($fileh, $linenum); # Open and lock the filename rules to ensure they can't be updated # and read simultaneously $fileh = new FileHandle; unless ($fileh->open("<$filename")) { MailScanner::Log::WarnLog("Cannot open filename-rules file %s, skipping", $filename); return undef; } flock($fileh, $LOCK_SH); $linenum = 0; while(<$fileh>) { chomp; s/^#.*$//; s/^\s*//g; s/\s*$//g; $linenum++; next if /^$/; $result = Store1FilenameRule($_, $linenum, $filename); push @AllowDenyList, $result if $result ne ""; } # Unlock and close flock($fileh, $LOCK_UN); $fileh->close(); return \@AllowDenyList; } sub Store1FilenameRule { my($line, $linenum, $filename) = @_; my($allow, $regexp, $logtext, $usertext); ($allow, $regexp, $logtext, $usertext) = split(/\t+/, $line, 4); unless ($allow && $regexp && $logtext && $usertext) { MailScanner::Log::WarnLog("Possible syntax error on line %d of %s", $linenum, $filename); MailScanner::Log::WarnLog("Remember to separate fields with tab " . "characters!"); return ""; } # 3 possibilities are something like "allow", "deny", "denyanddelete". $allow = lc($allow); if ($allow =~ /allow/) { $allow = 'allow'; } elsif ($allow =~ /deny/) { if ($allow =~ /delete/) { $allow = 'denydelete'; } else { $allow = 'deny'; } } else { MailScanner::Log::WarnLog("Possible syntax error in first keyword " . "on line %d of %s", $linenum, $filename); } # OLD $allow = ($allow =~ /allow/i)?'allow':'deny'; $regexp =~ s/^\/(.*)\/$/$1/; $logtext = "" if $logtext eq '-'; $usertext = "" if $usertext eq '-'; return join("\0", $allow, $regexp, $logtext, $usertext); } # Read one of the lists of language strings. # Now locks the language strings file. sub ReadOneLanguageStringsFile { my($filename) = @_; my($fileh, $key, $value, $linenum); my(%Store); # Open and lock the filename rules to ensure they can't be updated # and read simultaneously $fileh = new FileHandle; unless ($fileh->open("<$filename")) { MailScanner::Log::WarnLog("Cannot open language-strings file %s, skipping", $filename); return undef; } flock($fileh, $LOCK_SH); $linenum = 0; while(<$fileh>) { chomp; s/^#.*$//; s/^\s*//g; s/\s*$//g; $linenum++; next if /^$/; ($key, $value) = split(/\s*=\s*/, $_, 2); $value =~ s/\%([^%]+)\%/$PercentVars{lc($1)}/g; $value =~ s/\$\{?(\w+)\}?/$ENV{$1}/g; $value =~ s/\\n/\n/g; #unless ($key && $value) { unless (/=/) { MailScanner::Log::WarnLog("Possible syntax error on line %d of %s", $linenum, $filename); MailScanner::Log::WarnLog("Remember to separate fields with an = " . "sign!"); next; } #print STDERR "Storing $value in $key\n"; $Store{lc($key)} = $value; } # Unlock and close flock($fileh, $LOCK_UN); $fileh->close(); return \%Store; } # Construct the list of incoming queue dirs. # Take any one of 1. directory name # 2. directory name glob (contains * or ?) # 3. name of file containing directory names sub ReadInQueueDirs { my($taintedname) = @_; my(@list, $listh, $dir, $name); # We trust the admin to only put sensible names in # config file, so untaint it: $taintedname =~ /(.*)/; $name = $1; $name =~ s/\%([^%]+)\%/$PercentVars{lc($1)}/g; $name =~ s/\$\{?(\w+)\}?/$ENV{$1}/g; if ($name =~ /[\?\*]/) { # It's a glob so contains directory names @list = glob($name); #print STDERR "Adding list of inq's " . join(', ', @list) . "\n"; push @{$StaticScalars{inqueuedir}}, @list; return; } if (-d $name) { # It's a simple directory name #print STDERR "Adding simple dir name $name\n"; push @{$StaticScalars{inqueuedir}}, $name; return; } if (-l $name) { # It's a soft link to somewhere MailScanner::Log::WarnLog("For the incoming queue directory %s, please " . "supply the absolute path not including any links", $name); MailScanner::Log::WarnLog("I am assuming that %s points to a directory" , $name); push @{$StaticScalars{inqueuedir}}, $name; return; } # Open and lock the list file $listh = new FileHandle; $listh->open("<$name") or MailScanner::Log::WarnLog("File containing list of incoming queue dirs" . " (%s) does not exist", $name),return; flock($listh, $LOCK_SH); while(<$listh>) { chomp; s/^#.*$//; s/^\s*//g; s/\s*$//g; /^(.*)$/; # Untaint as well as check for empty string (it's coming # from a file only the admin should be able to access) next if $1 eq ""; $dir = $1; $dir =~ s/\%([^%]+)\%/$PercentVars{lc($1)}/g; $dir =~ s/\$\{?(\w+)\}?/$ENV{$1}/g; if ($dir =~ /[\?\*]/) { # It's a glob so contains directory names @list = glob($dir); push @{$StaticScalars{inqueuedir}}, @list; next; } unless (-d $dir) { MailScanner::Log::WarnLog("Incoming queue dir %s does not exist " . "(listed in directory list file %s)", $dir, $name); next; } #print STDERR "Adding dir $dir to list of incoming queues\n"; push @{$StaticScalars{inqueuedir}}, $dir; } # Unlock and close flock($listh, $LOCK_UN); $listh->close(); } # Read all the definitions of the virus scanner. 2 fields per line, # separated by whitespace. 1st field is scanner name, 2nd field is # scanner command. This may be a direct binary, or it may be a script. sub ReadDefinitions { my($filename) = @_; #print STDERR "Reading virus scanner definitions from $filename\n"; my($fileh, $linenum, $key, $value, %hash); $fileh = new FileHandle; $fileh->open("<$filename") or MailScanner::Log::DieLog("Cannot read definitions from %s, %s", $filename, $!); flock($fileh, $LOCK_SH); $linenum = 0; while(<$fileh>) { chomp; s/^#.*$//; s/^\s*//g; s/\s*$//g; $linenum++; next if /^$/; $key = ""; $value = ""; if (/^(\S+)\s+(\S+)\s+(.+)$/) { # There are 3 words, so separate last 2 with commas $key = lc($1); $value = $2 . ',' . $3; } else { /^(\S+)\s+(.+)$/; $key = lc($1); $value = $2; } if ($key && $value) { $hash{"$key"} = "$value"; } else { MailScanner::Log::DieLog("Syntax error in definitions file %s", $filename); } } # Unlock and close flock($fileh, $LOCK_UN); $fileh->close(); #print STDERR "Finished reading definitions\n"; return %hash; } # Print out the translation table referred to by the hash-ref passed in. sub PrintDefinitions { my(%hash) = @_; my($key,$value); #print STDERR "\nHere is a definitions file:\n"; while(($key,$value) = each %hash) { #print STDERR "$key\t\t$value\n"; } #print STDERR "End of definition file.\n\n"; } # Tiny access function: # Return the value of a virus scanner command sub ScannerCmds { my($key) = @_; return $ScannerCmds{$key}; } # Tiny access function: # Return the value of an RBL list sub SpamLists { my($key) = @_; return $SpamLists{lc($key)}; } # # Read the LDAP configuration. # Just read the basic settings, don't worry about rulesets yet. # #$base = "o=fsl"; #$sitename = "default"; sub ReadConfBasicLDAP { my($LDAP, $LDAPbase, $LDAPsite) = @_; my($result, $searchfor, $number, $entr, $attr, $attr2); # Build the search string 1 bit at a time. Gets syntax right that way. $searchfor = "(objectClass=mailscannerconfmain)"; $searchfor = "(&$searchfor(mailScannerSite=$LDAPsite))"; $searchfor = "(&$searchfor(mailScannerConfBranch=main))"; $result = $LDAP->search( base => $LDAPbase, scope => 'sub', filter => $searchfor ); $result->code and MailScanner::Log::WarnLog("LDAP search for basic " . "configuration returned error: %s", $result->error); $number = 0; while (defined($entr = $result->entry($number))) { #print STDERR "Fetched Entry $number\n"; #print STDERR "DN: ", $entr->dn, "\n"; foreach $attr (sort $entr->attributes) { next if $attr =~ /;binary$/; $attr2 = lc($attr); next if $attr2 eq 'confserialnumber'; next if $attr2 eq 'description'; next if $attr2 eq 'mailscannerconfbranch'; next if $attr2 eq 'mailscannersite'; next if $attr2 eq 'mschildren'; next if $attr2 eq 'objectclass'; #$attr2 =~ s/^mailscannerconf//i or next; $File{$attr2} = join(' ',@{$entr->get_value($attr, asref=>1)}); #print STDERR "$attr2 : " . $File{$attr2} . "\n"; } $number++; } # SF - Read the rest of the LDAP config MailScanner::Config::LDAPUpdated(); } # # Read the configuration file. Doesn't allow includes yet... # sub ReadConfFile { my($filename) = @_; # Slurp the whole file into a big hash. # Complain if we see the same keyword more than once. my($fileh, $linecounter, $origkey, $key, $value, $ErrorsSeen, $ErrorReport); $fileh = new FileHandle; $fileh->open("<$filename") or MailScanner::Log::DieLog("Could not read configuration file %s, %s", $filename, $!); flock($fileh, $LOCK_SH); $linecounter = 0; $ErrorsSeen = 0; while(<$fileh>) { $linecounter++; chomp; s/#.*$//; s/^\s+//; s/\s+$//; next if /^$/; undef $origkey; undef $key; undef $value; /^(.*?)\s*=\s*(.*)$/; ($origkey,$value) = ($1,$2); # Allow %var% = value lines $value =~ s/\%([^%]+)\%/$PercentVars{lc($1)}/g; $value =~ s/\$\{?(\w+)\}?/$ENV{$1}/g; $value =~ s/\\n/\n/g; if ($origkey =~ /^\%([^%]+)\%$/) { # Always use the first definition of the %variable% $PercentVars{lc($1)} = $value unless exists $PercentVars{lc($1)}; next; } $key = lc($origkey); $key =~ s/[^a-z0-9]//g; # Leave numbers and letters only # Translate the value to the internal (shorter) version of it $key = EtoI($key); if ($key eq "") { # Invalid line $ErrorReport .= "Error in line $linecounter of $filename, " . "line does not make sense. "; $ErrorsSeen = 1; } elsif (defined $File{$key}) { # We've seen this keyword before. $ErrorReport .= "Error in line $linecounter of $filename, " . "setting value of ". $origkey ." twice! "; $ErrorsSeen = 1; } else { $File{$key} = $value; #print STDERR "Defining $key = $value\n"; $LineNos{$key} = $linecounter; # Save where the value was stored } } flock($fileh, $LOCK_UN); $fileh->close(); # If we have seen any errors, we can't trust the line numbers in # %LineNos, so bail out. # # Error messages are grouped and reported together, otherwise # The reference to 'these errors' in the last message doesn't make # sense. if ($ErrorsSeen) { $ErrorReport .= "Can't continue processing configuration file " . "until these errors have been corrected."; MailScanner::Log::DieLog("%s", $ErrorReport); } } sub ReadData { my($filename) = @_; # Fetch all the configuration setup. require 'MailScanner/ConfigDefs.pl' or die "Could not read ConfigDefs.pl, $!"; #print STDERR "In ReadData\n"; # Now go through the different types of config variable, # reading them from *DATA. my($category, $type, $keyword, %values, $line, $ConfigFileRead); $ConfigFileRead = 0; seek(DATA,0,0); while() { chomp; #print STDERR "In ReadData, data is '$_'\n"; s/#.*$//; s/^\s+//; s/\s+$//; next if /^$/; $line = $_; # Handle section headings #print STDERR "In processing of $category, $type\n"; if ($line =~ s/^\[(.*)\]$/$1/) { $line = lc($line); ($category, $type) = split(/\s*,\s*/, $line, 2); #print STDERR "About to process $category, $type\n"; next; } # Ignore any lines above the top heading next unless $category && $type; # Store the internal<-->external name translation tables if ($category =~ /translation/i) { $line = lc($line); my($int, $ext); ($int, $ext) = split(/\s*=\s*/, $line, 2); $ItoE{$int} = $ext; $EtoI{$ext} = $int; #print STDERR "Translation from e $ext to i $int\n"; next; } # At this point, the translation table has been read. # So now go and read their mailscanner.conf file! unless ($ConfigFileRead) { #print STDERR "Reading ConfFile\n"; ReadConfFile($filename); # Setup LDAP Connection ($LDAP, $LDAPserver, $LDAPbase, $LDAPsite) = ConnectLDAP(); #print STDERR "Made LDAP connection to $LDAP, $LDAPbase, $LDAPsite\n"; ReadConfBasicLDAP($LDAP, $LDAPbase, $LDAPsite) if $LDAP; $ConfigFileRead = 1; } # # Read in all the possible configuration values # #print STDERR "$category, $type\n"; if ($type =~ /yesno/i) { ProcessYesNo($line, $category); } elsif ($type =~ /file/i) { ProcessFile($line, $category); } elsif ($type =~ /command/i) { ProcessCommand($line, $category); } elsif ($type =~ /dir/i) { ProcessDir($line, $category); } elsif ($type =~ /number/i) { ProcessNumber($line, $category); } else { #print STDERR "line is $line category $category\n" if $line =~ /tnef/i; ProcessOther($line, $category); } } # We have now processed all the valid keywords, so anything left # in %File is a syntax error. delete $File{""}; # Just in case! my(@leftovers, $leftover); @leftovers = keys %File; if (@leftovers) { MailScanner::Log::WarnLog("Syntax error(s) in configuration file:"); #print STDERR "Syntax error(s) in configuration file:\n"; foreach $leftover (sort @leftovers) { MailScanner::Log::WarnLog("Unrecognised keyword \"%s\" at line %d", ItoE($leftover), $LineNos{$leftover}); #print STDERR "Unrecognised keyword \"" . ItoE($leftover) . # "\" at line " . $LineNos{$leftover} . "\n"; } MailScanner::Log::WarnLog("Warning: syntax errors in %s.", $filename); } } # Connect to the LDAP server sub ConnectLDAP { my($ldapserver, $connection, $binding, $site, $dns); $ldapserver = $File{'ldapserver'}; return unless $ldapserver; $site = $File{'ldapsite'}; $dns = $File{'ldapbase'}; MailScanner::Log::InfoLog("Using LDAP server %s", $ldapserver); $connection = Net::LDAP->new($ldapserver, onerror=>'warn') or MailScanner::Log::WarnLog("Making LDAP connection error: %s", $@); $binding = $connection->bind($dns, anonymous=>1); $binding->code and MailScanner::Log::WarnLog("LDAP binding error: %s", $@); return ($connection, $ldapserver, $dns, $site); } # Disconnect from the LDAP server sub DisconnectLDAP { $LDAP->unbind() if $LDAP; } # Knock out a keyword from the config file once it has been processed, # so anything left at the end must be syntax errors. # Passed an internal keyword. sub KeywordDone { my($keyword) = @_; delete $File{$keyword}; } # # Read in a email address rule and turn it into a regexp for fast # matching against an address later. Allowed forms of input are: # *@* (or the keyword "default") # *@domain.com (or just "domain.com") # *@*.domain.com (or just "*.domain.com") # user@* (or just "user@") # user@*.domain.com # user@domain.com # user*@* # user*@*.domain.com # user*@domain.com # 152.78. # /any-regular-expression/ # # If the regular expression does not contain any letters, then it # will be matched against the IP number. If it contains any letters # then it will be matched against the sender or recipient addresses. # # Returns a tuple of (d|t, regexp) where # d => digits, ie. IP number # t => text, ie. sender or recipient address # c => cidr, ie. Range or network/netmask of IP numbers # sub RuleToRegexp { my($rule, $type, $nestinglevel) = @_; # If the rule starts with / but doesn't end in / then it is a filename # which contains a list of regexps (which could in turn include more # filenames. if ($rule =~ m#^/.*[^/]$#) { # $rule is a filename. my($file, $line, @result); if ($nestinglevel>4) { MailScanner::Log::WarnLog("You have nested address pattern list " . "files to a depth of at least 4, which probably is not what you " . "intended to do. Ignoring the current address pattern list file %s", $rule); return (); } $file = new FileHandle; $file->open("<$rule") or MailScanner::Log::WarnLog("Could not open ruleset's address pattern list file %s, %s", $rule, $!),return; flock($file, $LOCK_SH); MailScanner::Log::DebugLog("Reading ruleset's address pattern list file %s", $rule); while(defined($line=<$file>)) { chomp $line; $line =~ s/#.*$//; $line =~ s/^\s+//; $line =~ s/\s+$//; next if $line =~ /^$/; push @result, RuleToRegexp($line, $type, $nestinglevel+1); } # Unlock and close rules file flock($file, $LOCK_UN); $file->close(); return(@result); } # Setup variables for handling errors and reproducing # their rule expression and not the compiled regexp. my($theirrule, $evalok, $compiledre); $theirrule = $rule; # Handle entirely numeric strings as netblocks (and allow IPv6 addresses!) if ($rule =~ /^[.:\dabcdef]+$/) { # Replace . with \. $rule =~ s/\./\\./g; # And anchor it to the start of the IP number $rule = '^' . $rule; # Test their rule eval { $compiledre = qr/$rule/i; }; if ($@) { MailScanner::Log::WarnLog("Invalid expression in rule \"%s\". " . "Compiler said \"%s\"", $theirrule, $@); $rule = '/^$/'; # This should never match anything } return ('d',$rule); } # Handle non-alphabetic regexps as IP number tests. # These must not contain any letters. if ($rule ne '/^$/' && $rule =~ s#^/([^a-z]+)/$#$1#) { # Test their rule eval { $compiledre = qr/$rule/i; }; if ($@) { MailScanner::Log::WarnLog("Invalid expression in rule \"%s\". " . "Compiler said \"%s\"", $theirrule, $@); $rule = '/^$/'; # This should never match anything } return ('d',$rule); } # Could be a CIDR or network range or network/netmask pair if ($rule =~ /^([.:\da-f]+)\s*\/\s*([.:\da-f]+)$/) { # It's a CIDR, e.g. 152.78/16 my($network, $bits, $count); ($network,$bits) = ($1,$2); $count = split(/\./, $network); $network .= '.0' x (4-$count); return ('c',"$network/$bits"); } ## Could be a CIDR or network range or network/netmask pair #if ($rule =~ /^[.:\da-f]+\s*\/\s*[.:\da-f]+$/) { # # It's a CIDR, e.g. 152.78/16 # $rule =~ s/\s*//g; # Remove whitespace # return ('c',$rule); #} if ($rule =~ /^[.:\da-f]+\s*-\s*[.:\da-f]+$/) { # It's a network range, e.g. 152.78.0.0-152.78.255.255 my(@cidr); $rule =~ s/\s*//g; # Remove whitespace @cidr = Net::CIDR::range2cidr($rule); return ('c',join(',',@cidr)); } # Otherwise they are address rules $rule = lc($rule); # If it is surrounded with '/', then it is an arbitrary regexp if ($rule =~ s#^/(.*)/$#$1#) { # Test their rule eval { $compiledre = qr/$rule/i; }; if ($@) { MailScanner::Log::WarnLog("Invalid expression in rule \"%s\". " . "Compiler said \"%s\"", $theirrule, $@); $rule = '/^$/'; # This should never match anything } return ('t',$rule); } if ($type =~ /[fbt]/i) { # If it is "default" or "*", then make it *@* if ($rule eq 'default' || $rule eq '*') { $rule = '*@*'; } # If it doesn't contain @ if ($rule !~ /@/) { if ($rule =~ /^\*/) { # If it starts with *, then make it *@*.domain.com $rule = '*@' . $rule; } else { # If it doesn't contain a *, then make it *@domain.com $rule = '*@' . $rule; } } # Prepend * if leading @ $rule = '*' . $rule if $rule =~ /^\@/; # Append * if traiing @ $rule = $rule . '*' if $rule =~ /\@$/; # Now it's got an @ sign and something both sides of it # Change . into \., @ into \@, * into .* $rule =~ s/\@/\\@/g; $rule =~ s/\./\\./g; $rule =~ s/\+/\\+/g; $rule =~ s/\*/.*/g; # and tack on the optional "." at the end $rule .= '\.?'; # and tack on the start+end anchors $rule = '^' . $rule . '$'; # Test their rule eval { $compiledre = qr/$rule/i; }; if ($@) { MailScanner::Log::WarnLog("Invalid expression in rule \"%s\". " . "Compiler said \"%s\"", $theirrule, $@); $rule = '/^$/'; # This should never match anything } return ('t',$rule); } elsif ($type =~ /v/) { #print STDERR "Compiling $type $rule\n"; # It is a virus pattern # If it is "default" or "*", then make it *@* if ($rule eq 'default') { $rule = '*'; } $rule =~ s#\/#\\/#g; $rule =~ s#\-#\\-#g; $rule =~ s/\./\\./g; $rule =~ s/\*/.*/g; #$rule = '^' . $rule . '$'; # Test their rule eval { $compiledre = qr/$rule/i; }; if ($@) { MailScanner::Log::WarnLog("Invalid expression in rule \"%s\". " . "Compiler said \"%s\"", $theirrule, $@); $rule = '/^$/'; # This should never match anything } return ('t',$rule); } else { # Error MailScanner::Log::WarnLog("Invalid rule of type %s, rule is \"%s\"", $type, $theirrule); return ('t','/^$/'); } } # # Read in a complete ruleset for 1 keyword. # Ignore numbered netblocks for now, I'll write them later. # Turn every pattern into a complete regexp to match against the target # address, and store them in a list together with From/To flags # and possibly some type information (to cope with netblocks). # $ScalarRules{$keyword}[] = join("\0", FromTo, Type, Regexp, Value). # sub ReadRuleset { my($keyword, $rulesfilename, $rulesettype, %values) = @_; #print STDERR "Keyword is $keyword, filename is $rulesfilename\n"; # If the rulesfilename ends in ".RuleSet" and doesn't contain any '/' # characters, then it's an LDAP ruleset. #if ($LDAP && $rulesfilename !~ /\// && $rulesfilename =~ /\.RuleSet$/) { if ($LDAP && $rulesfilename =~ /customi[sz]e/) { my($searchfor, $linecounter, $default, $error, $errors); my($number, $entr, $attr, $attr2, $result); my($rulenum, $ruledir, $ruleaddr, $ruleresult, @ruleset); $searchfor = "(objectClass=mailscannerRuleSetObject)"; #$searchfor = "(&$searchfor(mailScannerRuleSetName=$rulesfilename))"; #$searchfor = "(&$searchfor(mailScannerSite=$LDAPsite))"; $searchfor = "(&$searchfor(mailScannerRuleSetName=$keyword))"; $result = $LDAP->search( base => $LDAPbase, scope => 'sub', filter => $searchfor, attrs => [ 'mailScannerRuleSetNum', 'mailScannerRuleSetDirection', 'mailScannerRuleSetMatch', 'mailScannerRuleSetResult' ] ); $result->code and MailScanner::Log::WarnLog("LDAP search for ruleset " . # "%s returned error: %s", $rulesfilename, $result->error); "%s returned error: %s", $keyword, $result->error); $number = 0; while (defined($entr = $result->entry($number))) { #print STDERR "Fetched Entry $number\n"; #print STDERR "DN: ", $entr->dn, "\n"; foreach $attr (sort $entr->attributes) { next if $attr =~ /;binary$/; $attr = lc($attr); $rulenum = $entr->get_value($attr) if $attr =~ /rulesetnum/i; $ruledir = $entr->get_value($attr) if $attr =~ /rulesetdirection/i; $ruleaddr = $entr->get_value($attr) if $attr =~ /rulesetmatch/i; $ruleresult = $entr->get_value($attr) if $attr =~ /rulesetresult/i; } $ruleset[$rulenum] = join("\t", $ruledir, $ruleaddr, $ruleresult); $number++; } $RuleScalars{$keyword} = []; # Delete any old inherited rulesets foreach $rulenum (0..$#ruleset) { #($error, $default) = Store1Rule($ruleset[$rulenum], $rulesfilename, ($error, $default) = Store1Rule($ruleset[$rulenum], $keyword, $rulenum, $rulesettype, $RuleScalars{$keyword}, %values); $Defaults{$keyword} = $default if defined($default); $errors += $error; } # If the default value was defined and there was only 1 rule, # then that single rule must be defining the default value, # so it can actually be treated as a simple scalar value and # not a ruleset at all. $StaticScalars{$keyword} = $default if $#ruleset==0 && defined($default); MailScanner::Log::WarnLog("Found syntax errors in %s.", $keyword) if $errors; return; } # # It is a normal filename ruleset. # my($rulesfh,$errors,$linecounter, $default, $error); $rulesfh = new FileHandle; $rulesfh->open("<$rulesfilename") or MailScanner::Log::WarnLog('Cannot open ruleset file %s, %s', $rulesfilename, $!), return; flock($rulesfh, $LOCK_SH); $RuleScalars{$keyword} = []; # Set up empty ruleset $linecounter = 0; $errors = 0; while(<$rulesfh>) { $linecounter++; ($error, $default) = Store1Rule($_, $rulesfilename, $linecounter, $rulesettype, $RuleScalars{$keyword}, %values); #print STDERR "Store1Rule returned $error, $default\n"; $Defaults{$keyword} = $default if defined($default); $errors += $error; } # Unlock and close rules file flock($rulesfh, $LOCK_UN); $rulesfh->close(); MailScanner::Log::WarnLog("Found syntax errors in %s.", $rulesfilename) if $errors; } sub Store1Rule { $_ = shift; my($filename, $linecounter, $settype, $StoreIn, %values) = @_; my($line, $fromto, $rule, $value, $errors, $firstword); my($ruletype, $regexp, $direction, $DefaultValue); chomp; s/#.*$//; s/^\s+//; s/\s+$//; next if /^$/; $fromto = undef; $rule = undef; $value = undef; #print STDERR "Line is \"$_\"\n"; #if (/^(\S+)\s+(\S+)(\s+(\S+))?$/) { # ($direction, $rule, $value) = ($1, $2, $4); if (/^(\S+)\s+(\S+)(\s+(.*))?$/) { ($direction, $rule, $value) = ($1, $2, $4); #print STDERR "Dir = $direction, Rule = $rule, Value = $value\n"; } else { #print STDERR "value is \"$_\"\n"; MailScanner::Log::WarnLog('Syntax error in line %d of ruleset %s', $linecounter, $filename); $errors = 1; next; } #print STDERR "Fields are \"$fromto\", \"$rule\", \"$value\"\n"; # Syntax check and shorten fromto $fromto = ''; if ($direction =~ /and/i) { $fromto = 'b'; # b = both from AND to at the same time } else { $fromto .= 'f' if $direction =~ /from/i; $fromto .= 't' if $direction =~ /to/i; $fromto = 'v' if $direction =~ /virus/i; } if ($fromto eq '') { MailScanner::Log::WarnLog('Syntax error in first field in line ' . '%d of ruleset %s', $linecounter, $filename); $errors = 1; next; } # # Look for 2-part conditions with an "and" at the start of the value # my($direction2, $rule2, $fromto2); $fromto2 = ''; #if ($value =~ /^and\s+(\S+)\s+(\S+)(\s+(\S+))?$/i) { # This should fix bug with "and" with multi-value rule results if ($value =~ /^and\s+(\S+)\s+(\S+)(\s+(.+))?$/i) { ($direction2, $rule2, $value) = ($1, $2, $4); $fromto2 = ''; if ($direction2 =~ /and/i) { $fromto2 = 'b'; # both from and to } else { $fromto2 .= 'f' if $direction2 =~ /from/i; $fromto2 .= 't' if $direction2 =~ /to/i; $fromto2 = 'v' if $direction2 =~ /virus/i; } if ($fromto2 eq '') { MailScanner::Log::WarnLog('Syntax error in 4th field in line ' . '%d of ruleset %s', $linecounter, $filename); $errors = 1; next; } } # Substitute %% variables $value =~ s/\%([^%]+)\%/$PercentVars{lc($1)}/g; $value =~ s/\$\{?(\w+)\}?/$ENV{$1}/g; $value =~ s/\\n/\n/g; # Syntax check the value #print STDERR "Config: $keyword has rule value " . $File{$keyword} . # " = " . $values{$value} . "\n"; # Is it a valid value? my $internalvalue = undef; $internalvalue = InternalDataValue($settype, $value, %values); # Convert the rule into a regexp. # Pass it the keyword so it can set the default value if there is one. #($ruletype, $regexp) = RuleToRegexp($rule); my(@ruledata, @ruledata2, $ruletype2, $regexp2); @ruledata = RuleToRegexp($rule, $fromto, 0); @ruledata2 = RuleToRegexp($rule2, $fromto2, 0) if $fromto2 ne ''; while(@ruledata) { $ruletype = shift @ruledata; $regexp = shift @ruledata; $ruletype2 = shift @ruledata2; $regexp2 = shift @ruledata2; # 0 might be a valid value! if (defined $internalvalue || $settype eq 'other') { # Update the default value if this is it #print STDERR "Ruleset: Is \"$regexp\" and \"$regexp2\" the default rule?\n"; if (($regexp eq $DefaultAddressRegexp || $regexp eq $DefaultVirusRegexp) && $fromto2 ne '' && ($regexp2 eq $DefaultAddressRegexp || $regexp2 eq $DefaultVirusRegexp)) { # Don't store it in the main ruleset as it will always match, # whereas we want it to be used only if nothing else matches. #print STDERR "Ruleset: Storing Defaults = $internalvalue\n"; #$Defaults{$keyword} = $internalvalue; $DefaultValue = $internalvalue; next; } elsif (($regexp eq $DefaultAddressRegexp || $regexp eq $DefaultVirusRegexp) && $fromto2 eq '') { # Don't store it in the main ruleset as it will always match, # whereas we want it to be used only if nothing else matches. #print STDERR "Ruleset: Storing Defaults = $internalvalue\n"; #$Defaults{$keyword} = $internalvalue; $DefaultValue = $internalvalue; next; } # It is a valid value, so use it and store it my($record); if ($fromto2) { $record = join("\0", $fromto, $ruletype, $regexp, $fromto2, $ruletype2, $regexp2, $internalvalue); #print STDERR "Storing long rule $record\n"; } else { $record = join("\0", $fromto, $ruletype, $regexp, $internalvalue); #print STDERR "Storing short rule $record\n"; } push @{$StoreIn}, $record; #print STDERR "Storing data: for $record\n"; #print STDERR "Storing data: " . join(',',@{$StoreIn}) . "\n"; } else { # It is an invalid value MailScanner::Log::WarnLog("Syntax error in line %d of ruleset file " . "%s", $linecounter, $filename); $errors = 1; } } return ($errors, $DefaultValue); } # Given a ruleset type, a value to check, and an optional hash defining # all the possible valid values and their internal representations. sub InternalDataValue { my($rulesettype, $value, %validvalues) = @_; my(@words, $word, $word2, $internal); $internal = ""; @words = split(" ", $value); if ($rulesettype =~ /other/i) { # Other rules can contain anything # They might have passed in a comma-separated list, # so delete any trailing comma $value =~ s/,$//; $internal .= $value; return "$internal"; # if $internal ne ""; #return undef; } foreach $word (@words) { if ($rulesettype =~ /yesno/i) { # YesNo rules can contain words and/or email addresses # They might also have put in a comma-separated list rather than space $word2 = lc($word); # Allow upper+lower case $word2 =~ s/,$//; # Delete any trailing comma if (defined($validvalues{$word2})) { # It is a valid keyword $internal .= ' ' if $internal ne ""; $internal .= $validvalues{$word2}; } elsif ($word2 =~ /\@/) { # It is an email address $internal .= ' ' if $internal ne ""; $internal .= $word2; } else { # It is invalid return undef; } } elsif ($rulesettype =~ /file/i) { # File rules can only contains filenames which must exist # To let them use /dev/null, we just say it exists and isn't a dir unless ((-e $word && !-d $word) || ($LDAP && $word !~ /\//)) { MailScanner::Log::WarnLog("Could not read file %s", $word); return undef; } $internal .= ' ' if $internal ne ""; $internal .= $word; } elsif ($rulesettype =~ /dir/i) { # Dir rules can only contains directories which must exist $word =~ s/\/$//g; # Delete any trailing '/' unless (-d $word) { MailScanner::Log::WarnLog("Could not read directory %s", $word); return undef; } $internal .= ' ' if $internal ne ""; $internal .= $word; } elsif ($rulesettype =~ /number/i) { # Number rules can only contain digits and dots and _ and - #print STDERR "Word is \"$word\"\n"; return undef unless $word =~ /^([\d._-]+)([kmgKMG]?)/; $word = $1; my $multiplier = lc $2; #print STDERR "Multiplier = $multiplier, Word = $word\n"; $internal .= ' ' if $internal ne ""; $word =~ s/_//g; $word = $word * 1000 if $multiplier eq 'k'; $word = $word * 1000000 if $multiplier eq 'm'; $word = $word * 1000000000 if $multiplier eq 'g'; $internal .= $word; #print STDERR "Word = \"$word\"\n"; } elsif ($rulesettype =~ /command/i) { # Command rules must contain executable as first # element, then anything unless (-x $words[0]) { MailScanner::Log::WarnLog("Could not read executable %s", $words[0]); return undef; } $internal .= ' ' if $internal ne ""; $internal .= $word; } else { # It's unknown, so warn and return something sensible MailScanner::Log::WarnLog('Error: Unknown ruleset type %s in ' . 'InternalDataValue()', $rulesettype); $internal .= ' ' if $internal ne ""; $internal .= $word; } } return "$internal" if $internal ne ""; #print STDERR "OOPS! Returning undef.\n"; return undef; } sub ReadYesNoValue { my($keyword, $RulesAllowed, %values) = @_; my($first, $isfile, $isrules); $first = $File{$keyword}; $isfile = 1 if $first =~ /^\//; # Filenames start with '/' $isrules = 1 if $isfile && $first !~ /(txt|html)$/; # Rules ain't called .txt $isrules = 1 if $LDAP && $first =~ /customi[sz]e|\.RuleSet$/; # LDAP ruleset # It might be a function name if ($first =~ /^&/) { $first =~ s/^&//; $CustomFunctionsParams{$keyword} = $CustomFunctions{$keyword} = $first; $CustomFunctions{$keyword} =~ s/\(.*//; $CustomFunctionsParams{$keyword} =~ s/^[^\(]+//; return; } if ($isrules) { # It's a ruleset so try to read it in if we're allowed to #print STDERR "Config: $keyword has a ruleset $isrules\n"; if (!$RulesAllowed) { MailScanner::Log::WarnLog("Value of %s cannot be a ruleset, only a " . "simple value", $keyword); } ReadRuleset($keyword, $first, 'yesno', %values); } else { # It's a simple value #print STDERR "Config: $keyword has simple value " . $File{$keyword} . # " = " . $values{$File{$keyword}} . "\n"; my $internal = InternalDataValue('yesno', $File{$keyword}, %values); if ($internal ne "") { # It is a valid value #print STDERR "Config: Setting scalar " . $keyword . # " = $internal\n"; $StaticScalars{$keyword} = $internal; } else { # It is an invalid value MailScanner::Log::WarnLog("Syntax error in line %d, value \"%s\" " . "for %s is not one of allowed values \"%s\"", $LineNos{$keyword}, $File{$keyword}, $keyword, join("\",\"", keys %values)); } } } # # Handle YesNo values # sub ProcessYesNo { my($line, $category) = @_; my($keyword, $default, %values, $rules); undef $keyword; undef $default; undef %values; ($keyword, $default, %values) = split(" ", lc($line)); $KeywordCategory{$keyword} = $category; $KeywordType{$keyword} = 'yesno'; $HardCodedDefaults{$keyword} = $default; # Save the %values for when needed to do internal to external conversion $YesNoEtoI{$keyword} = \%values; $YesNoItoE{$keyword} = (); my($key,$value); while (($key,$value) = each %values) { $YesNoItoE{$keyword}{$value} = $key; } #$keyword = EtoI($keyword); #print STDERR "Config: YesNo keyword \"$keyword\" default \"$default\" " . # "values are \"". %values . "\"\n"; # if $keyword =~ /spamwhite|definitelynot/i; if (exists $File{$keyword}) { #print STDERR "About to read the ReadYesNoValue\n"; # if $keyword =~ /spamwhite|definitelynot/i; ReadYesNoValue($keyword, ($category !~ /simple/i), %values); $Defaults{$keyword} = $default unless exists $Defaults{$keyword}; KeywordDone($keyword); } else { #print STDERR "Using default $default for keyword $keyword\n" if $keyword =~ /spamwhite|definitelynot/i; $StaticScalars{$keyword} = $default; } } # # Handle filenames # sub ReadFileValue { my($keyword, $RulesAllowed) = @_; my($first, $isfile, $isrules); $first = $File{$keyword}; $first =~ s/\s+.*$//; # Extract the first word $isfile = 1 if $first =~ /^\//; # Filenames start with '/' $isrules = 1 if $isfile && $first =~ /rules?$/; # Try to find ruleset $isrules = 1 if $LDAP && $first =~ /customi[sz]e|\.RuleSet$/; # LDAP ruleset # It might be a function name if ($first =~ /^&/) { $first =~ s/^&//; $CustomFunctionsParams{$keyword} = $CustomFunctions{$keyword} = $first; $CustomFunctions{$keyword} =~ s/\(.*//; $CustomFunctionsParams{$keyword} =~ s/^[^\(]+//; return; } if ($isrules) { #print STDERR "Config: $keyword has a ruleset $isrules\n"; if (!$RulesAllowed) { MailScanner::Log::WarnLog("Value of %s cannot be a ruleset, only a " . "simple value", $keyword); } #print STDERR "Reading ruleset for $keyword, $first, file\n"; ReadRuleset($keyword, $first, 'file'); } else { # It's a simple value #print STDERR "Config: $keyword has simple value $first\n"; my $internal = InternalDataValue('file', $File{$keyword}); #print STDERR "Config: internal = \"$internal\"\n"; if ($internal ne "") { # It is a valid value #print STDERR "Config: Setting scalar " . $keyword . # " = $internal\n"; $StaticScalars{$keyword} = $internal; } else { # It is an invalid value MailScanner::Log::WarnLog("Error in line %d, file \"%s\" " . "for %s does not exist (or can not be read)", $LineNos{$keyword}, $File{$keyword}, $keyword); } } } sub ProcessFile { my($line, $category) = @_; my($keyword, $default); $keyword = undef; $default = undef; ($keyword, $default) = split(" ", $line); $keyword = lc($keyword); $KeywordCategory{$keyword} = $category; $KeywordType{$keyword} = 'file'; $HardCodedDefaults{$keyword} = $default; #$keyword = EtoI($keyword); #print STDERR "File keyword \"$keyword\" default \"$default\" value \"" . # $File{$keyword} . "\"\n"; if ($File{$keyword} ne "") { ReadFileValue($keyword, ($category !~ /simple/i)); $Defaults{$keyword} = $default unless exists $Defaults{$keyword}; KeywordDone($keyword); } else { $StaticScalars{$keyword} = $default; } } # # Handle commands # sub ReadCommandValue { my($keyword, $RulesAllowed) = @_; my($first, $isfile, $isrules); $first = $File{$keyword}; $first =~ s/\s+.*$//; # Extract the first word $isfile = 1 if $first =~ /^\//; # Filenames start with '/' $isrules = 1 if $isfile && $first =~ /rules?$/; # Try to find ruleset $isrules = 1 if $LDAP && $first =~ /\.RuleSet$/; # LDAP ruleset # It might be a function name if ($first =~ /^&/) { $first =~ s/^&//; $CustomFunctionsParams{$keyword} = $CustomFunctions{$keyword} = $first; $CustomFunctions{$keyword} =~ s/\(.*//; $CustomFunctionsParams{$keyword} =~ s/^[^\(]+//; return; } if ($isrules) { #print STDERR "Config: $keyword has a ruleset $isrules\n"; if (!$RulesAllowed) { MailScanner::Log::WarnLog("Value of %s cannot be a ruleset, only a " . "simple value", $keyword); } ReadRuleset($keyword, $first, 'file'); } else { # It's a simple value #print STDERR "Config: $keyword has simple value $first\n"; my $internal = InternalDataValue('command', $File{$keyword}); #print STDERR "Config: internal = \"$internal\"\n"; if ($internal ne "") { # It is a valid value #print STDERR "Config: Setting scalar " . $keyword . # " = $internal\n"; $StaticScalars{$keyword} = $internal; } else { # It is an invalid value MailScanner::Log::WarnLog("Error in line %d, file \"%s\" " . "for %s does not exist (or can not be read)", $LineNos{$keyword}, $File{$keyword}, $keyword); } } } sub ProcessCommand { my($line, $category) = @_; my($keyword, $default); $keyword = undef; $default = undef; ($keyword, $default) = split(" ", $line); $keyword = lc($keyword); $KeywordCategory{$keyword} = $category; $KeywordType{$keyword} = 'command'; $HardCodedDefaults{$keyword} = $default; #$keyword = EtoI($keyword); #print STDERR "File keyword \"$keyword\" default \"$default\" value \"" . # $File{$keyword} . "\"\n"; if ($File{$keyword} ne "") { ReadCommandValue($keyword, ($category !~ /simple/i)); $Defaults{$keyword} = $default unless exists $Defaults{$keyword}; KeywordDone($keyword); } else { $StaticScalars{$keyword} = $default; } } # # Handle directories # sub ReadDirValue { my($keyword, $RulesAllowed) = @_; my($first, $isrules); $first = $File{$keyword}; $isrules = 1 if -f $first; # Rules are files $isrules = 1 if $LDAP && $first =~ /customi[sz]e|\.RuleSet$/; # LDAP ruleset # It might be a function name if ($first =~ /^&/) { $first =~ s/^&//; $CustomFunctionsParams{$keyword} = $CustomFunctions{$keyword} = $first; $CustomFunctions{$keyword} =~ s/\(.*//; $CustomFunctionsParams{$keyword} =~ s/^[^\(]+//; return; } if ($isrules) { #print STDERR "Config: $keyword has a ruleset $isrules\n" # if $keyword =~ /^in.*dir$/i; if (!$RulesAllowed) { MailScanner::Log::WarnLog("Value of %s cannot be a ruleset, only a " . "simple value", $keyword); } # Read the ruleset here ReadRuleset($keyword, $first, 'dir'); } else { # It's a simple value $first =~ s/\/$//g; # Delete any trailing '/' #print STDERR "Config: $keyword has simple value $first\n" # if $keyword =~ /^in.*dir$/i; my $internal = InternalDataValue('dir', $File{$keyword}); if ($internal ne "") { # It is a valid value #print STDERR "Config: Setting scalar " . $keyword . # " = $internal\n" if $keyword =~ /^in.*dir$/i; $StaticScalars{$keyword} = $internal; } else { # It is an invalid value MailScanner::Log::WarnLog("Error in configuration file line %d, " . "directory %s for %s does not exist (or is not readable)", $LineNos{$keyword}, $first, $keyword); } } } sub ProcessDir { my($line, $category) = @_; my($keyword, $default); undef $keyword; undef $default; ($keyword, $default) = split(" ", $line); $keyword = lc($keyword); $KeywordCategory{$keyword} = $category; $KeywordType{$keyword} = 'dir'; $HardCodedDefaults{$keyword} = $default; #$keyword = EtoI($keyword); #print STDERR "Dir keyword \"$keyword\" default \"$default\" value \"" . # $File{$keyword} . "\n" if $keyword =~ /^in.*dir$/i; if (defined $File{$keyword} && $File{$keyword} ne "") { ReadDirValue($keyword, ($category !~ /simple/i)); $Defaults{$keyword} = $default unless exists $Defaults{$keyword}; KeywordDone($keyword); } else { $StaticScalars{$keyword} = $default; } } # # Handle numbers # sub ReadNumberValue { my($keyword, $RulesAllowed) = @_; my($first, $isrules); $first = $File{$keyword}; $isrules = 1 if $first !~ /^[\d._-]+[kmgKMG]?/; # Rules aren't all digits or ._- followed by optional multiplier $isrules = 1 if $LDAP && $first =~ /customi[sz]e|\.RuleSet$/; # LDAP ruleset # It might be a function name if ($first =~ /^&/) { $first =~ s/^&//; $CustomFunctionsParams{$keyword} = $CustomFunctions{$keyword} = $first; $CustomFunctions{$keyword} =~ s/\(.*//; $CustomFunctionsParams{$keyword} =~ s/^[^\(]+//; return; } if ($isrules) { #print STDERR "Config: $keyword has a ruleset $isrules\n"; if (!$RulesAllowed) { MailScanner::Log::WarnLog("Value of %s cannot be a ruleset, only a " . "simple value", $keyword); } # Read the ruleset here ReadRuleset($keyword, $first, 'number'); } else { # It's a simple value #print STDERR "Config: $keyword has simple value $first\n"; my $internal = InternalDataValue('number', $File{$keyword}); if ($internal ne "") { # It is a valid value #print STDERR "Config: Setting scalar " . $keyword . # " = $internal\n"; $StaticScalars{$keyword} = $internal; } else { # It is an invalid value MailScanner::Log::WarnLog("Syntax error in line %d, %s for %s " . "should be a number", $LineNos{$keyword}, $first, $keyword); } } } sub ProcessNumber { my($line, $category) = @_; my($keyword, $default); $keyword = undef; $default = undef; #$keyword = EtoI($keyword); ($keyword, $default) = split(" ", $line); $keyword = lc($keyword); $KeywordCategory{$keyword} = $category; $KeywordType{$keyword} = 'number'; $HardCodedDefaults{$keyword} = $default; #print STDERR "Number keyword \"$keyword\" default \"$default\" value \"" . # $File{$keyword} . "\n"; if ($File{$keyword} ne "") { ReadNumberValue($keyword, ($category !~ /simple/i)); $Defaults{$keyword} = $default unless exists $Defaults{$keyword}; KeywordDone($keyword); } else { $StaticScalars{$keyword} = $default; } } # # Handle other values... # This includes a special case for "inqueuedir" as that can be the name # of a file containing a list of mqueue.in directories, not a ruleset. # sub ReadOtherValue { my($keyword, $RulesAllowed) = @_; my($first, $isrules); $first = $File{$keyword}; $isrules = 1 if $first =~ /^\// && $first =~ /rules?$/ && -f $first; # Rules are filenames $isrules = 1 if $LDAP && $first =~ /customi[sz]e|\.RuleSet$/; # LDAP ruleset # It might be a function name if ($first =~ /^&/) { $first =~ s/^&//; $CustomFunctionsParams{$keyword} = $CustomFunctions{$keyword} = $first; $CustomFunctions{$keyword} =~ s/\(.*//; $CustomFunctionsParams{$keyword} =~ s/^[^\(]+//; return; } if ($isrules && $keyword ne 'inqueuedir') { #print STDERR "Config: $keyword has a ruleset $isrules\n"; if (!$RulesAllowed) { MailScanner::Log::WarnLog("Value of %s cannot be a ruleset, only a " . "simple value", $keyword); } # Read the ruleset here ReadRuleset($keyword, $first, 'other'); } else { # It's a simple value #print STDERR "Config: $keyword has simple other value $first\n"; my $internal = InternalDataValue('other', $File{$keyword}); #if ($internal ne "") { if (defined $internal) { # It is a valid value #print STDERR "Config: Setting other scalar " . $keyword . # " = $internal\n"; # Percent variables need to be substituted here. $internal = DoPercentVars($internal); # %vars% must be defined before use $internal =~ s/\$\{?(\w+)\}?/$ENV{$1}/g; $StaticScalars{$keyword} = $internal; } # Could do some specific syntax checking in here } } sub ProcessOther { my($line, $category) = @_; my($keyword, $default); ($keyword, $default) = split(" ", $line, 2); # Allow spaces in it $keyword = lc($keyword); $KeywordCategory{$keyword} = $category; $KeywordType{$keyword} = 'other'; $HardCodedDefaults{$keyword} = $default; #$keyword = EtoI($keyword); #print STDERR "Other keyword \"$keyword\" default \"$default\" value \"" . # $File{$keyword} . "\"\n"; if (exists $File{$keyword}) { # ne "") { ReadOtherValue($keyword, ($category !~ /simple/i)); $Defaults{$keyword} = $default unless exists $Defaults{$keyword}; KeywordDone($keyword); } else { $StaticScalars{$keyword} = $default; } } # Go through the configuration we have loaded and try to find all the # options whose settings do not match the default. # Use &Value to find the current setting, %RuleScalars exists where there # is a ruleset for the value, %Defaults contains the default setting. # Don't know what happens when there is a %Default which is a pointer to # a ruleset, we'll have to find out. # Print out a list of all the changed settings, what their default was and # what their new value is. If it's a ruleset, just print out "rules". sub PrintNonDefaults { my($key, $default, $actual, $external, %Output, $fixed, $fixed2); print "\nTable of Changed Values:\n\n"; print PrintFixedWidth("Option Name", 35) . PrintFixedWidth("Default", 15) . "Current Value\n"; print "=" x 79 . "\n"; while (($key,$default) = each %HardCodedDefaults) { # This is a cheap Value($key) that won't evaluate Custom Functions $actual = $Defaults{$key}; $actual = $StaticScalars{$key} if exists $StaticScalars{$key}; $external = ItoE($key); # Special case for this one as it is a list of directory names if ($key eq 'inqueuedir') { my @dirs = @{Value('inqueuedir')}; $actual = join(',',@dirs); } # Translate the internal numbers into user-readable keywords if ($KeywordType{$key} eq 'yesno') { $default = 0 unless $default; $actual = 0 unless $actual; $default = $YesNoItoE{$key}{$default}; $actual = $YesNoItoE{$key}{$actual}; } $fixed = PrintFixedWidth($external, 35); $fixed2 = PrintFixedWidth($default, 15); $actual =~ s/\n/\\n/g; if ($CustomFunctions{$key}) { # It's a Custom Function $Output{$external} = "$fixed$fixed2" . "FUNCTION:" . $CustomFunctions{$key}; } elsif ($RuleScalars{$key}) { # It's a ruleset $Output{$external} = "$fixed$fixed2" . "RULESET:Default=$actual"; } else { # It's a scalar $Output{$external} = "$fixed$fixed2$actual" if ($actual ne $default) && !($default eq '0' && $actual eq ''); } } foreach $external (sort keys %Output) { print $Output{$external} . "\n"; } } sub PrintFixedWidth { my($text,$width) = @_; my $length = length $text; $text .= ' '; $width--; $text .= ' ' x ($width-$length) if $width > $length; return $text; } # Has the LDAP configuration data changed in the last couple of minutes? # Only actually do the LDAP query every 2 minutes, just cache it in # between. my($LDAPSerial, $LDAPSerialExpires); my $LDAPSerialRetryTime = 120; # 2 minutes sub LDAPUpdated { # Do nothing if we aren't using LDAP anyway return 0 unless $LDAP; if (!$LDAPSerial) { # There is no serial number, so fetch the current serial number # and do not trigger a restart. $LDAPSerial = LDAPFetchSerial(); return 0; } # The first time around, the expiry time will be 0 so it will trigger. my $now = time; if ($now>$LDAPSerialExpires) { # Serial number has expired, fetch a new one my $newserial = LDAPFetchSerial(); if ($newserial) { # Attempt to get serial number succeeded. # Trigger restart if it has changed. return 1 if $newserial ne $LDAPSerial; } $LDAPSerialExpires = $now + $LDAPSerialRetryTime; } return 0; } # Fetch the serial number from the same point in the tree as the rest of # the LDAP MailScanner.conf settings. # Attribute is 'mailScannerConfSerialNumber'. sub LDAPFetchSerial { my($result, $searchfor, $number, $entr, $attr, $serial); # Build the search string 1 bit at a time. Gets syntax right that way. $searchfor = "(objectClass=mailscannerconfmain)"; $searchfor = "(&$searchfor(mailScannerSite=$LDAPsite))"; $searchfor = "(&$searchfor(mailScannerConfBranch=main))"; $result = $LDAP->search( base => $LDAPbase, scope => 'sub', filter => $searchfor, # attrs => ['mailScannerConfSerialNumber'] attrs => ['ConfSerialNumber'] ); if ($result->code) { MailScanner::Log::WarnLog("LDAP search for configuration serial number " . "returned error: %s", $result->error); return undef; } $number = 0; while (defined($entr = $result->entry($number))) { #print STDERR "Fetched Entry $number\n"; #print STDERR "DN: ", $entr->dn, "\n"; foreach $attr (sort $entr->attributes) { next unless $attr =~ /serialnumber/i; next if $attr =~ /;binary$/; $serial = join(' ',@{$entr->get_value($attr, asref=>1)}); } $number++; } MailScanner::Log::DebugLog("LDAP configuration serial number is %s", $serial); return $serial; } 1;