external/ibm-public/postfix/dist/examples/smtpd-policy/greylist.pl

   1 #!/usr/bin/perl
   2
   3 use DB_File;
   4 use Fcntl;
   5 use 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 #
 101 sub 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 #
 152 sub LOCK_SH { 1 };      # Shared lock (used for reading).
 153 sub LOCK_EX { 2 };      # Exclusive lock (used for writing).
 154 sub LOCK_NB { 4 };      # Don't block (for testing).
 155 sub LOCK_UN { 8 };      # Release lock.
 156
 157 #
 158 # Log an error and abort.
 159 #
 160 sub fatal_exit {
 161     my($first) = shift(@_);
 162     syslog "err", "fatal: $first", @_;
 163     exit 1;
 164 }
 165
 166 #
 167 # Open hash database.
 168 #
 169 sub 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 #
 187 sub 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 #
 207 sub 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 #
 226 sub 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 #
 240 setlogsock $syslog_socktype;
 241 openlog $0, $syslog_options, $syslog_facility;
 242
 243 #
 244 # We don't need getopt() for now.
 245 #
 246 while ($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 #
 259 select((select(STDOUT), $| = 1)[0]);
 260
 261 #
 262 # Receive a bunch of attributes, evaluate the policy, send the result.
 263 #
 264 while (<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 }