"Fossies" - the Fresh Open Source Software Archive

Member "Mail-SPF-Query-1.999.1/examples/postfix-policyd-spf" (31 Dec 2005, 7586 Bytes) of package /linux/privat/old/Mail-SPF-Query-1.999.1.tar.gz:


As a special service "Fossies" has tried to format the requested source page into HTML format using (guessed) Perl source code syntax highlighting (style: standard) with prefixed line numbers and code folding option. Alternatively you can here view or download the uninterpreted source code file.

    1 #!/usr/bin/perl
    2 
    3 # postfix-policyd-spf
    4 # http://www.openspf.org
    5 # version 1.06
    6 # $Id$
    7 
    8 use Fcntl;
    9 use Sys::Syslog qw(:DEFAULT setlogsock);
   10 use strict;
   11 
   12 # ----------------------------------------------------------
   13 #                      configuration
   14 # ----------------------------------------------------------
   15 
   16 # to use SPF, install Mail::SPF::Query from CPAN or from the SPF website at http://www.openspf.org/downloads.html
   17 
   18   my @HANDLERS;
   19   push @HANDLERS, "testing";
   20   push @HANDLERS, "sender_permitted_from"; use Mail::SPF::Query;
   21 
   22 my $VERBOSE = 0;
   23 
   24 my $DEFAULT_RESPONSE = "DUNNO";
   25 
   26 #
   27 # Syslogging options for verbose mode and for fatal errors.
   28 # NOTE: comment out the $syslog_socktype line if syslogging does not
   29 # work on your system.
   30 #
   31 
   32 my $syslog_socktype = 'unix'; # inet, unix, stream, console
   33 my $syslog_facility = "mail";
   34 my $syslog_options  = "pid";
   35 my $syslog_priority = "info";
   36 my $syslog_ident    = "postfix/policy-spf";
   37 
   38 # ----------------------------------------------------------
   39 #                  minimal documentation
   40 # ----------------------------------------------------------
   41 
   42 #
   43 # Usage: smtpd-policy.pl [-v]
   44 #
   45 # Demo delegated Postfix SMTPD policy server.
   46 # This server implements SPF.
   47 # Another server implements greylisting.
   48 # Postfix has a pluggable policy server architecture.
   49 # You can call one or both from Postfix.
   50 # 
   51 # The SPF handler uses Mail::SPF::Query to do the heavy lifting.
   52 # 
   53 # This documentation assumes you have read Postfix's README_FILES/SMTPD_POLICY_README
   54 # 
   55 # Logging is sent to syslogd.
   56 #
   57 # How it works: each time a Postfix SMTP server process is started
   58 # it connects to the policy service socket, and Postfix runs one
   59 # instance of this PERL script.  By default, a Postfix SMTP server
   60 # process terminates after 100 seconds of idle time, or after serving
   61 # 100 clients. Thus, the cost of starting this PERL script is smoothed
   62 # out over time.
   63 #
   64 # To run this from /etc/postfix/master.cf:
   65 #
   66 #    policy  unix  -       n       n       -       -       spawn
   67 #      user=nobody argv=/usr/bin/perl /usr/libexec/postfix/smtpd-policy.pl
   68 #
   69 # To use this from Postfix SMTPD, use in /etc/postfix/main.cf:
   70 #
   71 #    smtpd_recipient_restrictions =
   72 #       ...
   73 #       reject_unauth_destination
   74 #       check_policy_service unix:private/policy
   75 #       ...
   76 #
   77 # NOTE: specify check_policy_service AFTER reject_unauth_destination
   78 # or else your system can become an open relay.
   79 #
   80 # To test this script by hand, execute:
   81 #
   82 #    % perl smtpd-policy.pl
   83 #
   84 # Each query is a bunch of attributes. Order does not matter, and
   85 # the demo script uses only a few of all the attributes shown below:
   86 #
   87 #    request=smtpd_access_policy
   88 #    protocol_state=RCPT
   89 #    protocol_name=SMTP
   90 #    helo_name=some.domain.tld
   91 #    queue_id=8045F2AB23
   92 #    sender=foo@bar.tld
   93 #    recipient=bar@foo.tld
   94 #    client_address=1.2.3.4
   95 #    client_name=another.domain.tld
   96 #    [empty line]
   97 #
   98 # The policy server script will answer in the same style, with an
   99 # attribute list followed by a empty line:
  100 #
  101 #    action=dunno
  102 #    [empty line]
  103 #
  104 
  105 # Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: client_address=208.210.125.227
  106 # Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: client_name=newbabe.mengwong.com
  107 # Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: helo_name=newbabe.mengwong.com
  108 # Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: protocol_name=ESMTP
  109 # Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: protocol_state=RCPT
  110 # Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: queue_id=
  111 # Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: recipient=mengwong@dumbo.pobox.com
  112 # Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: request=smtpd_access_policy
  113 # Jul 23 18:43:29 dumbo/dumbo policyd[21171]: Attribute: sender=mengwong@newbabe.mengwong.com
  114 
  115 # ----------------------------------------------------------
  116 #                      initialization
  117 # ----------------------------------------------------------
  118 
  119 #
  120 # Log an error and abort.
  121 #
  122 sub fatal_exit {
  123   syslog(err  => "fatal_exit: @_");
  124   syslog(warn => "fatal_exit: @_");
  125   syslog(info => "fatal_exit: @_");
  126   die "fatal: @_";
  127 }
  128 
  129 #
  130 # Unbuffer standard output.
  131 #
  132 select((select(STDOUT), $| = 1)[0]);
  133 
  134 #
  135 # This process runs as a daemon, so it can't log to a terminal. Use
  136 # syslog so that people can actually see our messages.
  137 #
  138 setlogsock $syslog_socktype;
  139 openlog $syslog_ident, $syslog_options, $syslog_facility;
  140 
  141 # ----------------------------------------------------------
  142 #                           main
  143 # ----------------------------------------------------------
  144 
  145 #
  146 # Receive a bunch of attributes, evaluate the policy, send the result.
  147 #
  148 my %attr;
  149 while (<STDIN>) {
  150   chomp;
  151   if (/=/)       { my ($k, $v) = split (/=/, $_, 2); $attr{$k} = $v; next }
  152   elsif (length) { syslog(warn=>sprintf("warning: ignoring garbage: %.100s", $_)); next; }
  153 
  154   if ($VERBOSE) {
  155     for (sort keys %attr) {
  156       syslog(debug=> "Attribute: %s=%s", $_, $attr{$_});
  157     }
  158   }
  159 
  160   fatal_exit ("unrecognized request type: '$attr{request}'") unless $attr{request} eq "smtpd_access_policy";
  161 
  162   my $action = $DEFAULT_RESPONSE;
  163   my %responses;
  164   foreach my $handler (@HANDLERS) {
  165     no strict 'refs';
  166     my $response = $handler->(attr=>\%attr);
  167     syslog(debug=> "handler %s: %s", $handler, $response);
  168     if ($response and $response !~ /^dunno/i) {
  169       syslog(info=> "handler %s: %s is decisive.", $handler, $response);
  170       $action = $response; last;
  171     }
  172   }
  173 
  174   syslog(info=> "decided action=%s", $action);
  175 
  176   print STDOUT "action=$action\n\n";
  177   %attr = ();
  178 }
  179 
  180 # ----------------------------------------------------------
  181 #                     plugin: SPF
  182 # ----------------------------------------------------------
  183 sub sender_permitted_from {
  184   local %_ = @_;
  185   my %attr = %{ $_{attr} };
  186 
  187   my $query = eval { new Mail::SPF::Query (ip    =>$attr{client_address},
  188                                            sender=>$attr{sender},
  189                                            helo  =>$attr{helo_name}) };
  190   if ($@) {
  191     syslog(info=>"%s: Mail::SPF::Query->new(%s, %s, %s) failed: %s",
  192            $attr{queue_id}, $attr{client_address}, $attr{sender}, $attr{helo_name}, $@); 
  193     return "DUNNO";
  194   }
  195   my ($result, $smtp_comment, $header_comment) = $query->result();
  196 
  197   syslog(info=>"%s: SPF %s: smtp_comment=%s, header_comment=%s",
  198          $attr{queue_id}, $result, $smtp_comment, $header_comment); 
  199 
  200   if    ($result eq "fail")     { return "REJECT $smtp_comment"; }
  201   elsif ($result eq "error")    { return "DEFER_IF_PERMIT $smtp_comment"; }
  202   else                          { return "PREPEND Received-SPF: $result ($header_comment)"; }
  203 }
  204 
  205 # ----------------------------------------------------------
  206 #                     plugin: testing
  207 # ----------------------------------------------------------
  208 sub testing {
  209   local %_ = @_;
  210   my %attr = %{ $_{attr} };
  211 
  212   if (lc address_stripped($attr{sender}) eq
  213       lc address_stripped($attr{recipient})
  214       and
  215       $attr{recipient} =~ /policyblock/) {
  216 
  217     syslog(info=>"%s: testing: will block as requested",
  218            $attr{queue_id}); 
  219     return "REJECT smtpd-policy blocking $attr{recipient}";
  220   }
  221   else {
  222     syslog(info=>"%s: testing: stripped sender=%s, stripped rcpt=%s",
  223            $attr{queue_id},
  224            address_stripped($attr{sender}),
  225            address_stripped($attr{recipient}),
  226            ); 
  227     
  228   }
  229   return "DUNNO";
  230 }
  231 
  232 sub address_stripped {
  233   # my $foo = localpart_lhs('foo+bar@baz.com'); # returns 'foo@baz.com'
  234   my $string = shift;
  235   for ($string) {
  236     s/[+-].*\@/\@/;
  237   }
  238   return $string;
  239 }