1#!/usr/bin/perl 2 3use DB_File; 4use Fcntl; 5use Sys::Syslog qw(:DEFAULT setlogsock); 6 7# 8# Usage: greylist.pl [-v] 9# 10# Demo delegated Postfix SMTPD policy server. This server implements 11# greylisting. State is kept in a Berkeley DB database. Logging is 12# sent to syslogd. 13# 14# How it works: each time a Postfix SMTP server process is started 15# it connects to the policy service socket, and Postfix runs one 16# instance of this PERL script. By default, a Postfix SMTP server 17# process terminates after 100 seconds of idle time, or after serving 18# 100 clients. Thus, the cost of starting this PERL script is smoothed 19# out over time. 20# 21# To run this from /etc/postfix/master.cf: 22# 23# policy unix - n n - - spawn 24# user=nobody argv=/usr/bin/perl /usr/libexec/postfix/greylist.pl 25# 26# To use this from Postfix SMTPD, use in /etc/postfix/main.cf: 27# 28# smtpd_recipient_restrictions = 29# ... 30# reject_unauth_destination 31# check_policy_service unix:private/policy 32# ... 33# 34# NOTE: specify check_policy_service AFTER reject_unauth_destination 35# or else your system can become an open relay. 36# 37# To test this script by hand, execute: 38# 39# % perl greylist.pl 40# 41# Each query is a bunch of attributes. Order does not matter, and 42# the demo script uses only a few of all the attributes shown below: 43# 44# request=smtpd_access_policy 45# protocol_state=RCPT 46# protocol_name=SMTP 47# helo_name=some.domain.tld 48# queue_id=8045F2AB23 49# sender=foo@bar.tld 50# recipient=bar@foo.tld 51# client_address=1.2.3.4 52# client_name=another.domain.tld 53# instance=123.456.7 54# sasl_method=plain 55# sasl_username=you 56# sasl_sender= 57# size=12345 58# [empty line] 59# 60# The policy server script will answer in the same style, with an 61# attribute list followed by a empty line: 62# 63# action=dunno 64# [empty line] 65# 66 67# 68# greylist status database and greylist time interval. DO NOT create the 69# greylist status database in a world-writable directory such as /tmp 70# or /var/tmp. DO NOT create the greylist database in a file system 71# that can run out of space. 72# 73# In case of database corruption, this script saves the database as 74# $database_name.time(), so that the mail system does not get stuck. 75# 76$database_name="/var/mta/greylist.db"; 77$greylist_delay=60; 78 79# 80# Auto-whitelist threshold. Specify 0 to disable, or the number of 81# successful "come backs" after which a client is no longer subject 82# to greylisting. 83# 84$auto_whitelist_threshold = 10; 85 86# 87# Syslogging options for verbose mode and for fatal errors. 88# NOTE: comment out the $syslog_socktype line if syslogging does not 89# work on your system. 90# 91$syslog_socktype = 'unix'; # inet, unix, stream, console 92$syslog_facility="mail"; 93$syslog_options="pid"; 94$syslog_priority="info"; 95 96# 97# Demo SMTPD access policy routine. The result is an action just like 98# it would be specified on the right-hand side of a Postfix access 99# table. Request attributes are available via the %attr hash. 100# 101sub smtpd_access_policy { 102 my($key, $time_stamp, $now, $count); 103 104 # Open the database on the fly. 105 open_database() unless $database_obj; 106 107 # Search the auto-whitelist. 108 if ($auto_whitelist_threshold > 0) { 109 $count = read_database($attr{"client_address"}); 110 if ($count > $auto_whitelist_threshold) { 111 return "dunno"; 112 } 113 } 114 115 # Lookup the time stamp for this client/sender/recipient. 116 $key = 117 lc $attr{"client_address"}."/".$attr{"sender"}."/".$attr{"recipient"}; 118 $time_stamp = read_database($key); 119 $now = time(); 120 121 # If this is a new request add this client/sender/recipient to the database. 122 if ($time_stamp == 0) { 123 $time_stamp = $now; 124 update_database($key, $time_stamp); 125 } 126 127 # The result can be any action that is allowed in a Postfix access(5) map. 128 # 129 # To label mail, return ``PREPEND'' headername: headertext 130 # 131 # In case of success, return ``DUNNO'' instead of ``OK'' so that the 132 # check_policy_service restriction can be followed by other restrictions. 133 # 134 # In case of failure, specify ``DEFER_IF_PERMIT optional text...'' 135 # so that mail can still be blocked by other access restrictions. 136 # 137 syslog $syslog_priority, "request age %d", $now - $time_stamp if $verbose; 138 if ($now - $time_stamp > $greylist_delay) { 139 # Update the auto-whitelist. 140 if ($auto_whitelist_threshold > 0) { 141 update_database($attr{"client_address"}, $count + 1); 142 } 143 return "dunno"; 144 } else { 145 return "defer_if_permit Service is unavailable"; 146 } 147} 148 149# 150# You should not have to make changes below this point. 151# 152sub LOCK_SH { 1 }; # Shared lock (used for reading). 153sub LOCK_EX { 2 }; # Exclusive lock (used for writing). 154sub LOCK_NB { 4 }; # Don't block (for testing). 155sub LOCK_UN { 8 }; # Release lock. 156 157# 158# Log an error and abort. 159# 160sub fatal_exit { 161 my($first) = shift(@_); 162 syslog "err", "fatal: $first", @_; 163 exit 1; 164} 165 166# 167# Open hash database. 168# 169sub open_database { 170 my($database_fd); 171 172 # Use tied database to make complex manipulations easier to express. 173 $database_obj = tie(%db_hash, 'DB_File', $database_name, 174 O_CREAT|O_RDWR, 0644, $DB_BTREE) || 175 fatal_exit "Cannot open database %s: $!", $database_name; 176 $database_fd = $database_obj->fd; 177 open DATABASE_HANDLE, "+<&=$database_fd" || 178 fatal_exit "Cannot fdopen database %s: $!", $database_name; 179 syslog $syslog_priority, "open %s", $database_name if $verbose; 180} 181 182# 183# Read database. Use a shared lock to avoid reading the database 184# while it is being changed. XXX There should be a way to synchronize 185# our cache from the on-file database before looking up the key. 186# 187sub read_database { 188 my($key) = @_; 189 my($value); 190 191 flock DATABASE_HANDLE, LOCK_SH || 192 fatal_exit "Can't get shared lock on %s: $!", $database_name; 193 # XXX Synchronize our cache from the on-disk copy before lookup. 194 $value = $db_hash{$key}; 195 syslog $syslog_priority, "lookup %s: %s", $key, $value if $verbose; 196 flock DATABASE_HANDLE, LOCK_UN || 197 fatal_exit "Can't unlock %s: $!", $database_name; 198 return $value; 199} 200 201# 202# Update database. Use an exclusive lock to avoid collisions with 203# other updaters, and to avoid surprises in database readers. XXX 204# There should be a way to synchronize our cache from the on-file 205# database before updating the database. 206# 207sub update_database { 208 my($key, $value) = @_; 209 210 syslog $syslog_priority, "store %s: %s", $key, $value if $verbose; 211 flock DATABASE_HANDLE, LOCK_EX || 212 fatal_exit "Can't exclusively lock %s: $!", $database_name; 213 # XXX Synchronize our cache from the on-disk copy before update. 214 $db_hash{$key} = $value; 215 $database_obj->sync() && 216 fatal_exit "Can't update %s: $!", $database_name; 217 flock DATABASE_HANDLE, LOCK_UN || 218 fatal_exit "Can't unlock %s: $!", $database_name; 219} 220 221# 222# Signal 11 means that we have some kind of database corruption (yes 223# Berkeley DB should handle this better). Move the corrupted database 224# out of the way, and start with a new database. 225# 226sub sigsegv_handler { 227 my $backup = $database_name . "." . time(); 228 229 rename $database_name, $backup || 230 fatal_exit "Can't save %s as %s: $!", $database_name, $backup; 231 fatal_exit "Caught signal 11; the corrupted database is saved as $backup"; 232} 233 234$SIG{'SEGV'} = 'sigsegv_handler'; 235 236# 237# This process runs as a daemon, so it can't log to a terminal. Use 238# syslog so that people can actually see our messages. 239# 240setlogsock $syslog_socktype; 241openlog $0, $syslog_options, $syslog_facility; 242 243# 244# We don't need getopt() for now. 245# 246while ($option = shift(@ARGV)) { 247 if ($option eq "-v") { 248 $verbose = 1; 249 } else { 250 syslog $syslog_priority, "Invalid option: %s. Usage: %s [-v]", 251 $option, $0; 252 exit 1; 253 } 254} 255 256# 257# Unbuffer standard output. 258# 259select((select(STDOUT), $| = 1)[0]); 260 261# 262# Receive a bunch of attributes, evaluate the policy, send the result. 263# 264while (<STDIN>) { 265 if (/([^=]+)=(.*)\n/) { 266 $attr{substr($1, 0, 512)} = substr($2, 0, 512); 267 } elsif ($_ eq "\n") { 268 if ($verbose) { 269 for (keys %attr) { 270 syslog $syslog_priority, "Attribute: %s=%s", $_, $attr{$_}; 271 } 272 } 273 fatal_exit "unrecognized request type: '%s'", $attr{request} 274 unless $attr{"request"} eq "smtpd_access_policy"; 275 $action = smtpd_access_policy(); 276 syslog $syslog_priority, "Action: %s", $action if $verbose; 277 print STDOUT "action=$action\n\n"; 278 %attr = (); 279 } else { 280 chop; 281 syslog $syslog_priority, "warning: ignoring garbage: %.100s", $_; 282 } 283} 284