# -*- Mode: Cperl -*- # mimedefang-filter<mimedefang> --- # Author : Manoj Srivastava ( srivasta@golden-gryphon.com ) # Created On : Fri May 20 03:37:06 2005 # Created On Node : glaurung.internal.golden-gryphon.com # Last Modified By : Manoj Srivastava # Last Modified On : Tue Sep 18 10:24:52 2007 # Last Machine Used: anzu.internal.golden-gryphon.com # Update Count : 107 # Status : Unknown, Use with caution! # HISTORY : # Description : # Downloadable :mimedefang-filter.txt # #use strict; #*********************************************************************** # # mimedefang-filter # # Suggested minimum-protection filter for Microsoft Windows clients, plus # SpamAssassin checks if SpamAssassin is installed. # # Copyright (C) 2002 Roaring Penguin Software Inc. # # This program may be distributed under the terms of the GNU General # Public License, Version 2, or (at your option) any later version. # # $Id: suggested-minimum-filter-for-windows-clients,v 1.81 2004/10/26 18:34:33 dfs Exp $ #*********************************************************************** $FilterRevision = "16.42"; #*********************************************************************** # Settings for SpamAssassin. # # Set SALocalTestsOnly if you do not want to use SA's network tests. # Messages larger than SASizeLimit will not be scanned by SA. #*********************************************************************** $SALocalTestsOnly = 0; $SASizeLimit = 200*1024; #*********************************************************************** # Set administrator's e-mail address here. The administrator receives # quarantine messages and is listed as the contact for site-wide # MIMEDefang policy. A good example would be 'defang-admin@mydomain.com' #*********************************************************************** $AdminAddress = 'postmaster@your.domain.name'; $AdminName = "Manoj Srivastava"; $AdminContactAddress = 'srivasta@your.domain.name'; $OurDomains = '(your\.domain\.name|other\.domain\.name)'; $MyFilterHostName = "smtp.your.domain.name"; #*********************************************************************** # There two values provide the thresholds for the values returned by # CRM114 and spamassassin before we reject them. #*********************************************************************** my $CRM_THRESHOLD=120; my $SA_THRESHOLD=15; #*********************************************************************** # If there is a local relay in use, like fetchmail, chacking for the # relay to whitelist is counterproductive -- since all mail appears local #*********************************************************************** my $local_relay_in_use = 0; #*********************************************************************** # Set this to use discard rather than bounce spam. This is useful if # you use a local relay like fetchmail. #*********************************************************************** my $discard_not_bounce = $local_relay_in_use; #*********************************************************************** # Set the e-mail address from which MIMEDefang quarantine warnings and # user notifications appear to come. A good example would be # 'mimedefang@mydomain.com'. Make sure to have an alias for this # address if you want replies to it to work. #*********************************************************************** $DaemonAddress = 'mailer-daemon@your.domain.name'; # Detect and load Perl modules detect_and_load_perl_modules(); # Using ClamAV with default run-as-user settings $Features{'Virus:CLAMD'} = '/usr/sbin/clamd'; $ClamdSock = "/var/run/clamav/clamd.ctl"; #*********************************************************************** # If you set $AddWarningsInline to 1, then MIMEDefang tries *very* hard # to add warnings directly in the message body (text or html) rather # than adding a separate "WARNING.TXT" MIME part. If the message # has no text or html part, then a separate MIME part is still used. #*********************************************************************** $AddWarningsInline = 1; $GeneralWarning = "WARNING: This e-mail has been altered by MIMEDefang at $MyFilterHostName.\n\n"; #*********************************************************************** # To enable syslogging of virus and spam activity, add the following # to the filter: # md_graphdefang_log_enable(); # You may optionally provide a syslogging facility by passing an # argument such as: md_graphdefang_log_enable('local4'); If you do this, be # sure to setup the new syslog facility (probably in /etc/syslog.conf). # An optional second argument causes a line of output to be produced # for each recipient (if it is 1), or only a single summary line # for all recipients (if it is 0.) The default is 1. # Comment this line out to disable logging. #*********************************************************************** md_graphdefang_log_enable('mail', 1); my $debug_loglevel = 0; #*********************************************************************** # Uncomment this to block messages with more than 50 parts. This will # *NOT* work unless you're using Roaring Penguin's patched version # of MIME tools, version MIME-tools-5.411a-RP-Patched-02 or later. # # WARNING: DO NOT SET THIS VARIABLE unless you're using at least # MIME-tools-5.411a-RP-Patched-02; otherwise, your filter will fail. #*********************************************************************** $MaxMIMEParts = 100; #*********************************************************************** # Set various stupid things your mail client does below. #*********************************************************************** # Set the next one if your mail client cannot handle multiple "inline" # parts. $Stupidity{"NoMultipleInlines"} = 0; # Set the next one if your mail client cannot handle nested multipart # messages. DO NOT set this lightly; it will cause action_add_part to # work rather strangely. Leave it at zero, even for MS Outlook, unless # you have serious problems. # $Stupidity{"flatten"} = 0; #*********************************************************************** # Settings for file extensions. # # $bad_exts are forbidden extensions. # Attachments matching $office_exts may not be executable files. #*********************************************************************** $bad_exts = '(' . join ('|', qw{ade adp app asd asf asx bas bat chm cmd com cpl crt dll fxp hlp hta hto ins isp jse? lib lnk mde msc msi msp mst ocx pcd pif prg scr sct sh shb shs sys vb vbe vbs vcs vxd wmd wms wmz wsc wsf wsh}) . '|\{[^\}]+\})'; $office_exts = '(' . join("|", qw{doc xml dot rtf wps xls xlt csv xlw wk4 wk3 wk1 wks xla mdb adp dbf ppt pot pps ppa wmf emf mpp mpt mpd pub}) . ')'; #*********************************************************************** # Settings for disabling bad HTML. # # If disable_bad_html is set, some html tags will be disabled. # Messages larger than $dbh_sizelimit will not be checked for this. #*********************************************************************** $disable_bad_html = 0; $dbh_sizelimit = 1024*1024; # The next lines force SpamAssassin modules to be loaded and rules # to be compiled immediately. This may improve performance on busy # mail servers. Comment the lines out if you don't like them. if ($Features{"SpamAssassin"}) { spam_assassin_init()->compile_now(1) if defined(spam_assassin_init()); # If you want to use auto-whitelisting: # if (defined($SASpamTester)) { # use Mail::SpamAssassin::DBBasedAddrList; # my $awl = Mail::SpamAssassin::DBBasedAddrList->new(); # $SASpamTester->set_persistent_address_list_factory($awl) # if defined($awl); # } } # This procedure returns true for entities with bad filenames. sub filter_bad_filename ($) { my($entity) = @_; my($re); # Do not allow: # - CLSIDs {foobarbaz} # - bad extensions (possibly with trailing dots) at end $re = '\.' . $bad_exts . '\.*$'; return 1 if (re_match($entity, $re)); # Look inside ZIP files if (re_match($entity, '\.zip$') and $Features{"Archive::Zip"}) { my $bh = $entity->bodyhandle(); if (defined($bh)) { my $path = $bh->path(); if (defined($path)) { return re_match_in_zip_directory($path, $re); } } } return 0; } #*********************************************************************** ############################ BEGIN GREYLISTING STUFF ################## #*********************************************************************** # If greylist is 1, greylisting will be used. my $greylist = 1; # Time units (in seconds) my $minute = 60; my $hour = 60*$minute; my $day = 24*$hour; # # Greylisting is done on a triplet of # sending hosts IP, mail from: and rcpt to:. # # When mail with a new triplet arrives, all sessions with that # triplet will be tempfailed for $greylist_black seconds. This would catch # most professional spammers; they can't afford to wait aorund to # resend mail, and a temporary 30 minute failure is usually not an issue. my $greylist_black = 30*$minute; # some people say 1 * $hour # After $greylist_black seconds, the triplet will be white-listed for # $greylist_grey seconds. Mail arriving in this time shall not be bounced. # This should allow for most legitimate senders. my $greylist_grey = 5*$hour; # If maile for the triplet arrives within the $greylist_grey white-listing # period, it will not only be accepted, it shall also be white-listed # for $greylist_white seconds, and this is long anough that monthly notices # are automatically accepted. my $greylist_white = 36*$day; # # If $greylist_subnet is true, only the first 3 octes of the IP-addresses will be # used in the greylist. my $greylist_subnet = 1; # If $greylist_from_domain is true, only the domain part of the mail from: address # will be used in the greylist. my $greylist_from_domain = 0; # If $greylist_to_domain is true, only the domain part of the rcpt to: address # will be used in the greylist. my $greylist_to_domain = 0; # If $greylist_from_strip is true, some stuff in the user part of the mail from: # address will be replaced in order to handle mailinglists and some other # stuff better. my $greylist_from_strip = 1; # If $greylist_reset_host is true, all triplets from the same host IP # will be reset whenever a spam triggers the reset. $greylist_reset_host = 0; # If $greylist_to_strip is true, some stuff in the user part of the rcpt to: # address will be replaced in order to handle use parameters and some other # stuff better. my $greylist_to_strip = 1; #*********************************************************************** my $greylist_log = 1; our $dbh; #our $greylist_dbname = 'DBI:Pg:database=mimedefang'; #our $greylist_dbname = 'DBI:Pg:dbname=mimedefang;host=localhost;port=5432;'; our $greylist_dbname = 'DBI:Pg:dbname=mimedefang;'; our $greylist_username = 'defang'; our $greylist_password = 'PASSWORD_HERE'; #*********************************************************************** # This is the list of places which we get mail from which are mailing # lists. These are excempt from greylist checks, and spam from them is # discarded, not bounced. #*********************************************************************** our %gwl = ( "aadvantage.info.aa.com" => "64.73.138.116", "alumni.iitkgp.ernet.in" => "144.16.192.210", "bmsmail3.ieee.org" => "140.98.193.199", "cards.bankofamerica.com" => "66.179.26.39", "chat1.netcentral.net" => "216.33.114.151", "chiark.greenend.org.uk" => "212.13.197.229", "cluster5.us.messagelabs.com" => "216.82.241.67", "corp.shopharmony.com" => "64.21.131.4", "crossover.codeweavers.com" => "209.46.25.132", "cwflyris.computerworld.com" => "199.92.213.58", "cwonline.computerworld.com" => "199.92.213.69", "diesel.bestpractical.com" => "4.79.3.63", "drsfostersmith.com" => "64.73.26.107", "e.homefocuscatalog.com" => "63.210.43.103", "e.improvementscatalog.com" => "63.210.43.103", "eletters.ztechsaver.com" => "72.2.37.147", "email.bn.com" => "216.73.89.11", "email.countrywide.com" => "209.11.136.183", "email.discovercard.com" => "206.132.3.49", "email.firststreetonline.com" => "76.12.20.136", "email.newegg.com" => "65.125.54.133", "email.officedepot.com" => "64.5.35.225", "enews.eweek.com" => "72.2.38.2", "enews.webbuyersguide.com" => "204.92.135.67", "engine.ieee.org" => "140.98.193.23", "events.networkcomputing.com" => "66.37.227.42", "expediamail.com" => "206.132.3.45", "extendedstayhotels.com" => "66.150.50.51", "firststreet.messages1.com" => "129.41.69.80", "fvwm.org" => "129.7.128.5", "gluck.debian.org" => "192.25.206.10", "hijli.iitkgp.ernet.in" => "144.16.192.6", "hometheatermag.email.primedia.com" => "216.73.89.11", "hot-redcross.org" => "216.251.43.98", "info.aa.com" => "64.73.138.118", "info.cmptechdirect.com" => "66.250.53.151", "info1.quicken.com" => "209.11.136.183", "jazzhorn.ncsc.mil" => "144.51.88.129", "linux-nfs.org" => "141.211.133.37", "linuxlists.org" => "216.85.40.94", "listar.org" => "66.116.125.121", "lists-outbound.sourceforge.net" => "66.35.250.225", "lists.alioth.debian.org" => "217.196.43.134", "lists.backports.org" => "82.195.75.76", "lists.bestpractical.com" => "4.79.3.63", "lists.crutchfield.com" => "216.30.179.4", "lists.debconf.org" => "82.195.75.76", "lists.gnu.org" => "199.232.76.165", "lists.linux-india.org" => "216.103.113.202", "lists.madduck.net" => "130.60.75.72", "lists.math.uh.edu" => "129.7.128.18", "lists.sourceforge.net" => "66.35.250.206", "lists.spambouncer.org" => "131.161.246.83", "listserv.acm.org" => "63.118.7.46", "listserv.fnal.gov" => "131.225.111.29", "listserver.rediff.com" => "202.54.124.217", "mail.vresp.com" => "209.66.113.42", "mailer.last.fm" => "87.117.229.54", "master.debian.org" => "70.103.162.29", "mercycorps.org" => "207.189.99.69", "messages.crutchfield.com" => "12.4.198.133", "messaging.tiaa-cref.org" => "206.132.3.45", "myuhc.1nc030.com" => "207.189.106.22", "netflix.com" => "208.75.76.17", "news.palmnewsletters.com" => "216.73.89.58", "newsletter.abtelectronics.com" => "63.240.155.131", "newsletter.infoworld.com" => "63.211.217.130", "newsletter.quicken.com" => "65.197.236.51", "newsletters.sdmediagroup.com" => "216.73.89.11", "notifications.paypal.com" => "206.165.245.170", "officedepot.chtah.com" => "216.15.189.57", "oit.umass.edu" => "128.119.100.34", "opensciencegrid.org" => "69.36.40.106", "orbitz.com" => "65.216.67.53", "outletbusiness.dell.com" => "209.11.136.183", "primediamags.chtah.com" => "216.15.189.57", "promo.tigeronline.com" => "199.181.77.19", "race.oit.umass.edu" => "128.119.101.42", "relianceindiacall.com" => "202.138.126.225", "rent.thriftyemail.net" => "206.18.187.15", "ruebert.ieee.org" => "140.98.193.10", "schneier.com" => "204.11.246.1", "selinux-symposium.org" => "207.44.200.175", "sho.delivery.net" => "209.11.136.89", "shop.hammacher.com" => "63.211.217.169", "shop.josbank.com" => "208.49.63.39", "sierraclub.org" => "69.59.163.42", "toyotapartsandservice.com" => "70.42.52.155", "unicefusa.org" => "63.108.92.133", "update.informationweek.com" => "216.73.89.11", "usa.redcross.org" => "162.6.217.63", "util0.math.uh.edu" => "129.7.128.18", "vger.rutgers.edu" => "128.6.225.194", "wwfus.org" => "63.150.152.200", "www1.codeweavers.com" => "209.46.25.132", "xmr3.com" => "137.236.223.7", ); our %gwip = map {$gql{$_} => $_} keys %gwl; # creditsecure.com # billpay.bankofamerica.com # service.discovercard.com # treocentral-mailings.com use DBI; use Date::Manip; #my $trace = DBI->trace(2); # Initialize database used for greylisting sub init_db { # code to bring up $dbh # prep SQL handles, etc. my $current_handle ; eval { $current_handle = DBI->connect_cached($greylist_dbname, $greylist_username, $greylist_password, { PrintError => 0, RaiseError => 0, AutoCommit => 0 }) or die $DBI::errstr; }; if ($@ || ! defined $current_handle) { md_syslog('warning', "greylist: Could not connect to DB:$@"); return undef; } # else { # md_syslog('info', "greylist: Connected to DB"); # } $dbh = $current_handle; return $dbh; } ############################### #Greylist Subroutines ######## ############################### #Strip strings sub address_strip ($) { my($address) = @_; $address = "" if (!defined($address)); $address =~ s/^[<\[]//; $address =~ s/[>\]]$//; return lc($address); } sub greylist_strip ($) { my($a) = @_; $a =~ s/;/:/g; return $a; } sub greylist_strip_ip($) { my($address) = @_; #$address =~ s/(.*)\.[0-9]+$/$1\.*/ if $greylist_subnet; return greylist_strip(address_strip($address)); } sub greylist_strip_mail($$$) { my($address,$domin_only,$strip_name) = @_; $address = address_strip($address); my $name = $address; my $domain = $address; $domain =~ s/.*@([^@]*)$/$1/; $name =~ s/@[^@]*$//; if ($domin_only) { $name = "*"; } elsif ($strip_name) { $name =~ s/(.+)\+.*$/$1/; # take only the user name # Now, this is to handle adresses with ever changing numbers (some # times decimal, sometimes hex). so, user_12124e6a@foo.com shall # become user_#@foo.com, but 1212-4e6a@foo.com remains unchanged my $aut = $name; my $autt = $name; do { $aut = $autt; # Look for numbers and strings with non alphanumerics on either side # Numbers at the beginning and the end of the user name are also # suppressed. so, this affects: # <number> <delim> <user> -> # <delim> <user> # <name> <delim> <number> <delim> <user> -> <name> <delim> # <delim> <user> # <name> <delim> <number> -> <name> <delim> # # <delim> <number> <delim> -> delim> # <delim> # <number> <delim> -> # <delim> # <delim> <number> -> <delim> # $autt =~ s/^(|.*[^a-z0-9])[a-f0-9]*\d[a-f0-9]*(|[^a-z0-9].*)$/$1#$2/; } until ($autt eq $aut); $name = $aut if ($aut =~ /[a-z0-9]/); # only replace name if sane #$name =~ s/[^-a-z0-9_.#]/?/g; } my $ret_val = $name."@".$domain; # prepare for use in the DB $ret_val =~ s/;/:/g; return $ret_val; } sub greylist_strip_triplet(@) { my($ip,$sender,$recipient) = @_; $sender = greylist_strip_mail($sender, $greylist_from_domain, $greylist_from_strip); $recipient = greylist_strip_mail($recipient, $greylist_to_domain, $greylist_to_strip); $ip = greylist_strip_ip($ip); return ($ip,$sender,$recipient); } # return a time string... sub time_string($) { my ($time) = @_; my $h = int($time / (60*60)); $time = $time % (60*60); my $m = int($time / 60); my $s = $time % 60; my $r = ""; $r.="$h hours, " if ($h); $r.="$m minutes and " if ($h || $m); $r.="$s seconds"; return $r; } # Checks authentication sub check_authenticated () { open(COMM, "<./COMMANDS") or return 0; while(<COMM>) { if (/^=auth_authen/) { close(COMM); return 1; } } close(COMM); return 0; } # from http://cvs.puremagic.com/viewcvs/*checkout*/greylisting/schema/whitelist_ip.txt?rev= my %greylist_whitelist = ( '12.5.136.141' => 1, # Southwest Airlines (unique sender, no retry) '12.5.136.141' => 1, # Southwest Airlines (unique sender, no retry) '12.5.136.142 ' => 1, # Southwest Airlines '64.12.136' => 1, # AOL (common pool) '64.12.137' => 1, # AOL '64.12.138' => 1, # AOL '64.125.132.254' => 1, # collab.net (unique sender per attempt) '66.135.209' => 1, # Ebay (for time critical alerts) '66.135.197' => 1, # Ebay '66.218.66' => 1, # Yahoo Groups servers (common pool, no retry) '152.163.225' => 1, # AOL '195.238.2.105' => 1, # skynet.be (wierd retry pattern) '195.238.2.124' => 1, # skynet.be '195.238.3.12' => 1, # skynet.be '195.238.3.13' => 1, # skynet.be '204.107.120.10' => 1, # Ameritrade (no retry) '205.188.156' => 1, # AOL '205.206.231' => 1, # SecurityFocus.com (unique sender per attempt) '207.115.63' => 1, # Prodigy - broken software that retries continually ( no delay) '207.171.168' => 1, # Amazon.com '207.171.180' => 1, # Amazon.com '207.171.187' => 1, # Amazon.com '207.171.188' => 1, # Amazon.com '207.171.190' => 1, # Amazon.com '213.136.52.31' => 1, # Mysql.com (unique sender) '217.158.50.178' => 1, # AXKit mailing list (unique sender per attempt # The following are mailing list hosts; they always retry, no point greylisting '70.103.162.29' => 1, # master.debian.org '129.7.128.18' => 1, # util0.math.uh.edu '192.25.206.10' => 1, # gluck.debian.org '199.232.76.165' => 1, # lists.gnu.org '140.98.193.199' => 1, # bmsmail3.ieee.org '4.79.3.63' => 1, # diesel.bestpractical.com '144.51.88.129' => 1, # jazzhorn.ncsc.mil '216.33.114.151' => 1, # chat1.netcentral.net '140.98.193.10' => 1, # ruebert.ieee.org '140.98.193.23' => 1, # engine.ieee.org '66.35.250.225' => 1, # lists-outbound.sourceforge.net '63.118.7.108' => 1, #acm mailing lists '63.118.7.109' => 1, #acm mailing lists '140.98.193' => 1, # various IEEE mailing lists ); sub greylist_ip_whitelist($) { # checks if a given ip number or block is free from whitelisting # it checks only the part of the ip number that is sent, so if # you whitelist here 192.168.0, then that's all it will check # against my $ip = shift; if ($ip =~ m/^(\d+)\.(\d+)\.(\d+)\.(\d+)$/) { return 1 if ($greylist_whitelist{"$1.$2.$3.$4"}); return 1 if ($greylist_whitelist{"$1.$2.$3"}); return 1 if ($greylist_whitelist{"$1.$2"}); return 1 if ($greylist_whitelist{"$1"}); } return 0; } my %SQL_Commands = ( 'Select' => qq{ SELECT id, create_time,last_update,record_expires,block_expires,passed_count FROM triplets WHERE relay_ip=? AND mail_from=? AND rcpt_to=?; }, 'Insert' => qq{ INSERT INTO triplets (relay_ip,mail_from,rcpt_to,block_expires,record_expires, create_time,last_update) values (?::inet, ?, ?, ?::timestamp + ?::interval, ?::timestamp + ?::interval, ?::timestamp, ?::timestamp); }, 'Blocked' => qq { UPDATE triplets SET blocked_count=blocked_count+1, last_update=?::timestamp WHERE id=?; }, 'Success' => qq { UPDATE triplets SET passed_count=passed_count+1, record_expires=?::timestamp + ?::interval, last_update=?::timestamp WHERE id=?; }, 'Old' => qq{ UPDATE triplets SET blocked_count=blocked_count+1, block_expires=?::timestamp + ?::interval, record_expires=?::timestamp + ?::interval, last_update=?::timestamp WHERE id=?; }, 'Reset' => qq{ UPDATE triplets SET blocked_count=1, block_expires=?::timestamp + ?::interval, record_expires=?::timestamp + ?::interval, last_update=?::timestamp WHERE id=?; }, 'Reset_IP' => qq{ UPDATE triplets SET blocked_count=1, block_expires=?::timestamp + ?::interval, record_expires=?::timestamp + ?::interval, last_update=?::timestamp WHERE relay_ip=inet ?; }, 'Whitelist' => qq { UPDATE triplets SET blocked_count=0, passed_count=1, block_expires=?::timestamp, record_expires=?::timestamp + ?::interval, last_update=?::timestamp WHERE id=?; }, ); my %Handles; # Checks if a triplet is in the grey-list. # Returns seconds until the triplet will be accepted, or -1 for error. sub greylist_check($$$) { my ($ip,$sender,$recipient) = greylist_strip_triplet(@_); my $result = -1; my $event = ""; my $now = scalar localtime(); my $dbh = init_db() unless $dbh and $dbh->ping; if (! defined $dbh) { $dbh = init_db(); if (! defined $dbh) { md_syslog('info', "greylist: No connection to DB") if $greylist_log; } } if (! defined $dbh) { $result = 0; # accept if we can't connect to the DB $event = 'unknown'; } elsif ($dbh) { my $safe_from = $dbh->quote($sender); my $safe_to = $dbh->quote($recipient); for my $sql (keys %SQL_Commands) { $Handles{$sql} = $dbh->prepare($SQL_Commands{ $sql}) or die $Handles{$sql}->errstr . ' preparing ' . $SQL_Commands{ $sql}; } $Handles{Select}->execute($ip, $sender, $recipient) or die $Handles{Insert}->errstr . ' executing ' . $SQL_Commands{Select}; my ($rid,$create_time,$last_update,$record_expires,$block_expires, $passed_count); $Handles{Select}->bind_columns( undef, \$rid, \$create_time, \$last_update, \$record_expires, \$block_expires, \$passed_count ); if (!$Handles{Select}->fetch()) { # insert new row in database $Handles{Select}->finish; $Handles{Insert}->execute($ip, $sender, $recipient, $now, "$greylist_black seconds", $now, "$greylist_grey seconds", $now, $now) or die $Handles{Insert}->errstr . ' executing ' . $SQL_Commands{Insert}; $dbh->commit() or die $dbh->errstr; $result = $greylist_black; $event = 'new'; } else { $Handles{Select}->finish; if (Date_Cmp($now, $block_expires) < 0 ) { #$now <= $block_expires # At this point they are retrying under their blacklist window $result = UnixDate($block_expires,"%s")-UnixDate($now,"%s"); $event = 'black'; #Log a note that they retried under our window $Handles{Blocked}->execute($now, $rid) or die $Handles{Blocked}->errstr . ' executing ' . $SQL_Commands{Blocked}; $dbh->commit() or die $dbh->errstr; $Handles{Blocked}->finish; } elsif (Date_Cmp($now, $record_expires) < 0) { #$now <= $record_expires # At this point they are retrying past the blacklist window, # but inside their expiration window. $result = 0; $event = 'white'; # Log a note that they retried sucessfully, and make sure they are # updated to the whitelist window $Handles{Success}->execute($now,"$greylist_white seconds", $now, $rid) or die $Handles{Success}->errstr . ' executing ' . $SQL_Commands{Success}; $dbh->commit() or die $dbh->errstr; $Handles{Success}->finish; } else { #$now > $record_expires # At this point they are retrying past their expiration $Handles{Old}->execute($now, "$greylist_black seconds", $now, "$greylist_grey seconds", $now, $rid) or die $Handles{Old}->errstr . ' executing ' . $SQL_Commands{Old}; $dbh->commit() or die $dbh->errstr; $Handles{Old}->finish; $result = $greylist_black; $event = 'old'; } } } md_syslog('info', "greylist: $event; $result; $ip; $sender; $recipient") if $greylist_log; return $result; } #Resets record(s) in the grey list. sub greylist_reset($$$) { my ($ip,$sender,$recipient) = greylist_strip_triplet(@_); my $dbh = init_db() unless $dbh and $dbh->ping; if (! defined $dbh) { $dbh = init_db(); if (! defined $dbh) { md_syslog('info', "greylist: No connection to DB") if $greylist_log; return; } } my $now = scalar localtime(); if ($sender && $recipient) { my $safe_from = $dbh->quote($sender); my $safe_to = $dbh->quote($recipient); $Handles{Select} = $dbh->prepare($SQL_Commands{Select}) or die $Handles{Select}->errstr . ' preparing ' . $SQL_Commands{Select}; $Handles{Select}->execute($ip, $sender, $recipient) or die $Handles{Select}->errstr . ' executing ' . $SQL_Commands{Select}; my ($rid,$create_time,$last_update,$record_expires,$block_expires, $passed_count); $Handles{Select}->bind_columns( undef, \$rid, \$create_time, \$last_update, \$record_expires, \$block_expires, \$passed_count ); if (!$Handles{Select}->fetch()) { $Handles{Select}->finish; # insert new row in database $Handles{Insert} = $dbh->prepare($SQL_Commands{Insert}) or die $Handles{Insert}->errstr . ' preparing ' . $SQL_Commands{Insert}; $Handles{Insert}->execute($ip, $sender, $recipient, $now, "$greylist_black seconds", $now, "$greylist_grey seconds", $now, $now) or die $Handles{Insert}->errstr . ' executing ' . $SQL_Commands{Insert}; $dbh->commit() or die $dbh->errstr; $Handles{Insert}->finish; } else { $Handles{Select}->finish; $Handles{Reset} = $dbh->prepare($SQL_Commands{Reset}) or die $Handles{Reset}->errstr . ' preparing ' . $SQL_Commands{Reset}; $Handles{Reset}->execute($now, "$greylist_black seconds", $now, "$greylist_grey seconds", $now, $rid) or die $Handles{Reset}->errstr . ' preparing ' . $SQL_Commands{Reset}; $dbh->commit() or die $dbh->errstr; $Handles{Reset}->finish; } md_syslog('info', "greylist: reset; -; $ip; $sender; $recipient") if $greylist_log; } else { $Handles{Reset_IP} = $dbh->prepare($SQL_Commands{Reset_IP}) or die $Handles{Reset_IP}->errstr . ' preparing ' . $SQL_Commands{Reset_IP}; $Handles{Reset_IP}->execute($now, "$greylist_black seconds", $now, "$greylist_grey seconds", $now, $ip) or die $Handles{Reset_IP}->errstr . ' preparing ' . $SQL_Commands{Reset_IP};; $dbh->commit() or die $dbh->errstr; $Handles{Reset_IP}->finish; md_syslog('info', "greylist: resetip; -, $ip") if $greylist_log; } } sub whitelist_record($$$) { my ($ip,$sender,$recipient) = greylist_strip_triplet(@_); my $dbh = init_db() unless $dbh and $dbh->ping; if (! defined $dbh) { $dbh = init_db(); if (! defined $dbh) { md_syslog('info', "greylist: No connection to DB") if $greylist_log; return; } } my $now = scalar localtime(); my $safe_from = $dbh->quote($sender); my $safe_to = $dbh->quote($recipient); $Handles{Select} = $dbh->prepare($SQL_Commands{Select}) or die $Handles{Select}->errstr . ' preparing ' . $SQL_Commands{Select}; $Handles{Select}->execute($ip, $sender, $recipient) or die $Handles{Select}->errstr . ' executing ' . $SQL_Commands{Select}; my ($rid,$create_time,$last_update,$record_expires,$block_expires, $passed_count); $Handles{Select}->bind_columns( undef, \$rid, \$create_time, \$last_update, \$record_expires, \$block_expires, \$passed_count ); if (!$Handles{Select}->fetch()) { $Handles{Select}->finish; # insert new row in database $Handles{Insert} = $dbh->prepare($SQL_Commands{Insert}) or die $Handles{Insert}->errstr . ' preparing ' . $SQL_Commands{Insert}; $Handles{Insert}->execute($ip, $sender, $recipient, $now, 0, $now, "$greylist_white seconds", $now, $now) or die $Handles{Insert}->errstr . ' executing ' . $SQL_Commands{Insert}; $dbh->commit() or die $dbh->errstr; $Handles{Insert}->finish; } else { $Handles{Whitelist} = $dbh->prepare($SQL_Commands{Whitelist}) or die $Handles{Whitelist}->errstr . ' preparing ' . $SQL_Commands{Whitelist}; $Handles{Whitelist}->execute($now, $now, "$greylist_white seconds", $now, $rid) or die $Handles{Whitelist}->errstr . ' executing ' . $SQL_Commands{Whitelist}; $dbh->commit() or die $dbh->errstr; $Handles{Whitelist}->finish; } md_syslog('info', "greylist: whitellist; -; $ip; $sender; $recipient") if $greylist_log; } ### END GREYLISTING STUFF #*********************************************************************** sub filter_recipient ($$$$$$$$$) { my ($recipient, $sender, $ip, $hostname, $first, $helo, $rcpt_mailer, $rcpt_host, $rcpt_addr) = @_; if ($recipient =~ /^<?testcrm\@glaurung\.internal\.golden-gryphon\.com>?$/i) { return ('ACCEPT_AND_NO_MORE_FILTERING', "ok"); } if (defined($greylist) && $greylist) { my($subnet_action); #Database tells us what to do with given IP ranges # Do initialize the database $dbh = init_db() unless $dbh and $dbh->ping; if (! defined $dbh) { $dbh = init_db(); } if($dbh) { my $statement=<<EOS; SELECT action from subnet_rules WHERE inet '$ip' <<= subnet ORDER BY subnet DESC LIMIT 1; EOS ; $sth = $dbh->prepare($statement) or die $dbh->errstr . ' preparing ' . $statement; $sth->execute or die $dbh->errstr . ' executing ' . $statement; $sth->bind_columns(undef, \$subnet_action); if(!$sth->fetch()) { md_syslog('warning', "filter_recipient: subnet rules check returned error!"); } $sth->finish; } else { md_syslog('warning', "No connection to DB!"); } if ($subnet_action eq "black") { md_syslog('info', "greylist black: $event; $result; $ip; $sender; $recipient") if $greylist_log; return ('REJECT', "Message rejected as SPAM. Subnet is blacklisted."); } if ($subnet_action eq "white") { md_syslog('info', "greylist white: $event; $result; $ip; $sender; $recipient") if $greylist_log; return ('ACCEPT_AND_NO_MORE_FILTERING', "ok"); } if (! $local_relay_in_use) { if ($subnet_action eq "local") { md_syslog('info', "greylist local: $event; $result; $ip; $sender; $recipient") if $greylist_log; return ('ACCEPT_AND_NO_MORE_FILTERING', "ok"); } } } ### If we were filtering on a different machine than mail.your.domain.name ### We could have used the following to check with the real mail server to see ### if we could have delivered to a recipient. Use only if server responds with ### a failure code for nonexistent users at the RCPT TO: level. Also, this ### has high overhead. # my($answer, $explanation) = # md_check_against_smtp_server($sender, $recip, "helo", 'mail.your.domain.name'); # # Convert TEMPFAIL to CONTINUE # $answer = 'CONTINUE' if ($answer eq 'TEMPFAIL'); # return ($answer, $explanation); return ('CONTINUE', "Ok, go ahead."); } ### MX_SENDER_CHECK=yes is set # sub filter_sender { # my ($sender, $ip, $hostname, $helo) = @_; # syslog('info', "Sender $sender on Host $ip ($hostname) claims to be $helo"); # if ($ip =~ /192.168.1.*/i) { # return ('ACCEPT_AND_NO_MORE_FILTERING'); # } # # Can't be "wesmo.com" unless it's one of our IP's. # if ($helo =~ /(^|.)mydomain\.com$/i) # { # if ($hostip ne "127.0.0.1" and $hostip ne "$myserverIP") # { # syslog('info', "Host $hostip said HELO $helo"); # return(0, "Go away. $hostip is not a mydomain.com machine"); # } # } # # The hostname better match the helo string. # if (($helo =~ /^(\d{1,3})(.)(\d{1,3})(.)(\d{1,3})(.)(\d{1,3})$/) && # ($hostip ne $helo)) # { # syslog('info', "Host $hostip claims to be $helo"); # return (0, "Header forgery attempt, $ip claims to be $helo") # } # if ($sender =~ /^<?spammer\@badguy\.com>?$/i) { # return ('REJECT', 'Sorry; spammer@badguy.com is blacklisted.'); # } # return ('CONTINUE', "OK"); # } ### detect correct Content-Transfer-Encoding headers. (too many bounces?) # sub filter_bad_encoding ($) { # my($entity) = @_; # my($bad_enc); # $bad_enc = '(plain|quoted-pintable)'; # $enc = $entity->head->mime_encoding; # if ($enc =~ /$bad_enc/i) { # return 1; # } # return 0; # } ### make sure that MX_RELAY_CHECK=yes # sub filter_relay { # my ($ip, $name) = @_; # if ($ip =~ /^192\.168\.1/) { # return('ACCEPT_AND_NO_MORE_FILTERING', "ok") # } # if ($name =~ /spammer\.com$/) { # return ('REJECT', "Sorry; spammer.com is blacklisted"); # } # return ('CONTINUE', "ok"); # } #################################################################### ## New function: check for corrupted JPEG files sub filter_corrupt_jpeg ($) { my($entity) = @_; if (re_match($entity, '\.jp(e?)g$' )) { #')){ my $bh = $entity->bodyhandle(); if (defined($bh)) { my $path = $bh->path(); if (defined($path)) { my($code, $category, $action) = run_virus_scanner("djpeg -fast -dither none -grayscale -scale 1/8 -outfile /dev/null $path" ); if ($action ne 'proceed') { return $code; } if ($code) { return $code; } } } } return 0; } ################################################################### #*********************************************************************** # %PROCEDURE: filter_begin # %ARGUMENTS: # None # %RETURNS: # Nothing # %DESCRIPTION: # Called just before e-mail parts are processed #*********************************************************************** sub filter_begin { # ALWAYS drop messages with suspicious chars in headers if (!$WasResent) { if ($SuspiciousCharsInHeaders) { md_graphdefang_log('suspicious_chars'); # action_quarantine_entire_message("Message quarantined because of \ # suspicious characters in headers"); # Do NOT allow message to reach recipient(s) #return action_discard(); if ($discard_not_bounce) { return action_discard(); } else { return action_bounce("suspicious characters in message"); } } if ($greylist) { # Do initialize the database $dbh = init_db(); } # Discard bad headers/lines in body # if (open (INF, "./HEADERS")) { # my $bad = 0; # while (my line = <INF>) { # $line =~ s/\n//g; # if ($line =~ /^Subject:\s+.*hastalavistababy.*$/) { # $bad = 1; # last; # } # } # close(INF); # return action_bounce('Bad, bad header!') if ($bad); # } # if (open (INF, "./INPUTMSG")) { # my $bad = 0; # while (my line = <INF>) { # $line =~ s/\n//g; # if ($line =~ /hastalavistababy/) { # $bad = 1; # last; # } # } # close(INF); # return action_bounce('Bad, bad body!') if ($bad); # } # Copy original message into work directory as an "mbox" file for # virus-scanning md_copy_orig_msg_to_work_dir_as_mbox_file(); # Scan for viruses if any virus-scanners are installed my($code, $category, $action) = message_contains_virus(); # Lower level of paranoia - only looks for actual viruses $FoundVirus = ($category eq "virus"); # Higher level of paranoia - takes care of "suspicious" objects # $FoundVirus = ($action eq "quarantine"); if ($FoundVirus) { md_graphdefang_log('virus', $VirusName, $RelayAddr); md_syslog('warning', "Discarding because of virus $VirusName"); if (defined($greylist) && $greylist) { greylist_reset($RelayAddr,"",""); } if ($discard_not_bounce) { return act