#!/usr/bin/perl # # Sendmail Milter to perform SPF lookups # # (If you use the shebang line, make sure it contains # a thread-enabled Perl!) # # Code by Mark Kramer <admin@asarian-host.net> on December 3, 2003 # # Version 1.30 # # Last revision: January 30, 2004 # # With thanks to Alain Knaff for adding improved "Getopt" functionality, # waitpid stuff to ensure spf-milter parent does not exit until child # is really up and running, a new option to kill the milter, and one to # add local policy. # Tested under Perl, v5.8.0 built for i386-freebsd-thread-multi, # using the Sendmail::Milter 0.18 engine. # # Licensed under GPL # # see: http://spf.pobox.com/ # # availability: bundled with Mail::SPF::Query on CPAN # or at http://spf.pobox.com/downloads.html # # this version is compatible with SPF draft 02.9.4. # # INSTALLATION: # ============= # # Basic INSTALL doc at http://spf.pobox.com/sendmail-milter-INSTALL.txt # # Adiitional install notes by Alain Knaff: # # The milter must be started/stopped explicitly before/after sendmail. # Add the following to /etc/init.d/sendmail to start it (must be # before starting sendmail): # # $SPF_MILTER -l 'include:local-forwarders' mail # # where local-forwarders is the name of a pseudo-domain holding an SPF # record describing all hosts allowed to bypass SPF checks (typically, # foreign hosts on which your users have set up .forwards pointing # towards addresses hosted by you). If none of your users have set up # any forwarding, you can leave this away # # Add the following to stop it (must be after stopping sendmail): # # $SPF_MILTER -k # # Note: This milter looks for the sendmail.cf file in /etc/mail. If # your sendmail.cf lives elsewhere (SuSE), establish a symlink: # ln -s /etc/sendmail.cf /etc/mail/sendmail.cf # # ============== # ---------------------------------------------------------- # config # ---------------------------------------------------------- # where do we store pid, sock, and logs? No trailing / please! # Set it at will, like '/var/spool/spf-milter', as long as it # ends in "spf-milter". Sanity check, further down the road, # will ensure that it does! # # If you change $basedir, be sure to make the same change to # INPUT_MAIL_FILTER in your mc file! my $basedir = '/var/spf-milter'; # where do we log SPF activity? my $SPF_LOG_FILENAME = POSIX::strftime ($basedir . "/spflog-%Y%m.log", localtime); # do we feel a need to flock the SPF logfile? use constant FLOCK_SPFLOG => 0; # ---------------------------------------------------------- # no user-serviceable parts below this line # ---------------------------------------------------------- use POSIX qw (:sys_wait_h); use Sendmail::Milter; use Socket; use Mail::SPF::Query; use threads; use threads::shared; use strict; use Getopt::Std; use Errno qw (ESRCH EINTR); use vars qw/$opt_k $opt_l $opt_t $opt_m $opt_h $opt_T/; my $pidFile = $basedir . '/spf-milter.pid'; my $sock = $basedir . '/spf-milter.sock'; my @extraParams : shared = (); my $mx_mode : shared = 0; my $our_hostname : shared = 0; my $trust : shared = 1; my $tagOnly : shared = 0; my ($conn, $user, $pid, $login, $pass, $uid, $gid); # feel free to replace this with your preferred logging scheme, eg Sys::Syslog or Log::Dispatch sub write_log : locked { open (SPFLOG, "+>>".$SPF_LOG_FILENAME) || (warn "$0: unable to write to $SPF_LOG_FILENAME: $!" && return); if (FLOCK_SPFLOG) { flock (SPFLOG, 2); seek (SPFLOG, 0, 2); } print SPFLOG localtime () . ": @_\n"; close (SPFLOG); } sub log_error_and_exit : locked { write_log (@_); print STDERR "spf-milter: @_\n"; exit 1; } # To accomodate the thread-unsafe Socket package, the one # "socket_call" provides an additional pseudo-lock mechanism for use # within the same thread. Since socket_call has the 'locked' attribute, # within a single thread only one call can be made to it at the time. The # first parameter to the call is either 1 or 2. The former returns the IP # address of sockaddr_in; the latter does SPF::Query. Thus providing # exclusivity within the same thread. # # Though I know you will try anyway, do NOT remove the 'locked' attribute; # spf-milter WILL crash, sooner rather than later. The serialization # effect of the extra locking mechanism is negligible; it will only occur # when connect_callback and envfrom_callback (from two different threads) # should wish to access socket_call at the same time. At any rate, I # designed spf-milter to run super-stable. Adjust the code if your # priority lies elsewhere. sub socket_call : locked { # usage: # socket_call (0) => undef # socket_call (1, sockaddr_in) # socket_call (2, "1.2.3.4", 'sender@example.com', 'helohostname.example.com') my $choice = shift; return undef if not $choice; if ($choice == 1) { # connect_callback parses (defined $sockaddr_in) as first parameter, thus # forming choice 1, or none at all. As with all calls to external # packages, we run them within an eval {} clause to prevent spf-milter # from dying on us. my ($port, $iaddr); eval { ($port, $iaddr) = sockaddr_in (shift); $choice = inet_ntoa ($iaddr); }; return ($choice); } elsif ($choice == 2) { # Here we do SPF::Query. We parse $priv_data along from envfrom_callback, # as we want to store $smtp_comment for later use in eom_callback. # # We will not use the alternate 'best_guess' method here. Risking a 'fail' # from best_guess, prior to "Sunrise Date", is too rich for my blood. my $priv_data = shift; if (my $query = eval {new Mail::SPF::Query (ip => shift, sender => shift, helo => shift, @extraParams)}) { my ($call_status, $result, $smtp_comment, $header_comment, $spf_record); # In "mx" mode, we make a call to result2 (), instead of to result (), # to which we parse an extra parameter, $priv_data->{'to'}, so # result2 () can check against secondaries for the recipent. if ($mx_mode) { $call_status = eval {($result, $smtp_comment, $header_comment, $spf_record) = $query->result2 (shift)}; } else { $call_status = eval {($result, $smtp_comment, $header_comment, $spf_record) = $query->result ()}; } if ($call_status) { # Return $smtp_comment, if defined, else the prefab $header_comment. $smtp_comment ||= $header_comment; # Need to escape unprotected % characters in spf_smtp_comment, # or sendmail will use the default "Command rejected" message instead. # Noted by Paul Howarth $smtp_comment =~ s/%/%%/g; # Since $smtp_comment can be whatever is returned, we consider it highly # tainted, and first run it through a 'garbage' filter, so as to clear it # of weird characters, newlines, etc., that could potentially crash your # mailer (possible exploits?). ($priv_data->{'spf_smtp_comment'} = $smtp_comment) =~ tr/\000-\010\012-\037\200-\377/ /s; ($priv_data->{'spf_header_comment'} = $header_comment) =~ tr/\000-\010\012-\037\200-\377/ /s; return ($result); } else { return undef; } } else { return undef; } } else { return undef; } } # For some reason, the widespread misconception seems to have crept in # that Sendmail::Milter private data must somehow be "frozen/thawed" # before processing (a.l.a the namesake FreezeThaw package). This is not # the case. FreezeThaw, and similar functions, which freeze referenced # Perl structures into serialized versions, and thaw these serialized # structures back into references, are ONLY required should you wish to # transport entire hashes and such. But there is no need to do that. On a # per-connection basis, at connect_callback, we declare a private hash, # and set use "$ctx->setpriv" to set the reference to that hash: # # my $priv_data = {}; # $ctx->setpriv($priv_data); # sub connect_callback : locked { my $ctx = shift; my $priv_data = {}; $priv_data->{'hostname'} = shift; my $sockaddr_in = shift; $priv_data->{'ipaddr'} = socket_call ((defined $sockaddr_in), $sockaddr_in); # Our hostname can be extracted from the j macro; idea by Alain Knaff # There is no need to reset it on each connection, though. It is now # a global variable, and has been taken out of the per-connection hash. $our_hostname ||= $ctx -> getsymval ('j'); $ctx->setpriv($priv_data); return SMFIS_CONTINUE; } sub helo_callback : locked { my $ctx = shift; my $priv_data = $ctx->getpriv(); $priv_data->{'helo'} = shift; $ctx->setpriv($priv_data); return SMFIS_CONTINUE; } sub envfrom_callback : locked { my $ctx = shift; my $priv_data = $ctx->getpriv(); ($priv_data->{'from'} = lc (shift)) =~ s/[<>]//g; # In case of a valid MAIL FROM: <>, SPF::Query checks against the HELO string, # with 'postmaster' as localpart, but will leave an empty $priv_data->{'from'} # variable (which, for instance, shows up in $header_comment as a double space # after "domain of"). Here we compensate for that. $priv_data->{'from'} ||= "postmaster\@$priv_data->{'helo'}"; # Are we authenticated? $priv_data->{'is_authenticated'} = $ctx -> getsymval ('{auth_authen}'); # envfrom_callback can be called more than once within the same connection; # delete $priv_data->{'spf_result'} on entry! delete $priv_data->{'spf_result'}; # SASL authenticated IP addresses always pass! if ($priv_data->{'is_authenticated'}) { $priv_data->{'spf_result'} = "pass"; $priv_data->{'spf_header_comment'} = "$our_hostname: domain of $priv_data->{'from'} designates $priv_data->{'ipaddr'} as SASL permitted sender"; $ctx -> setpriv ($priv_data); return SMFIS_CONTINUE; } $ctx->setpriv($priv_data); # Do the Milter equivalent of "PrivacyOptions=needmailhelo". Needed for SPF. if (not $priv_data->{'helo'}) { $ctx->setreply('503', '5.0.0', "Need HELO before MAIL"); return SMFIS_REJECT; } # Did we start in "mx" mode? If so, we will delay SPF checks until # envrcpt_callback. return SMFIS_CONTINUE if ($mx_mode); # Make the SPF query, and immediately store the result in our private hash; # we may also need it later, at eom_callback. if ($priv_data->{'spf_result'} = socket_call (2, $priv_data, $priv_data->{'ipaddr'}, $priv_data->{'from'}, $priv_data->{'helo'})) { if ($priv_data->{'spf_result'} eq 'fail') { if ($tagOnly) { write_log ("SPF \"fail\" from ip=".$priv_data->{'ipaddr'}. " helo=".$priv_data->{'helo'}. " from=".$priv_data->{'from'}); } else { $ctx->setreply('550', '5.7.1', "$priv_data->{'spf_smtp_comment'}"); return SMFIS_REJECT; } } elsif ($priv_data->{'spf_result'} eq 'error') { $ctx->setreply('451', '4.7.1', "An error occurred during SPF processing of $priv_data->{'from'}. Please try again later"); return SMFIS_TEMPFAIL; } } $ctx -> setpriv ($priv_data); return SMFIS_CONTINUE; } sub envrcpt_callback : locked { my $ctx = shift; my $priv_data = $ctx->getpriv(); # After envrcpt_callback we no longer need the recipient names, # so we can 'close' our data-set immediately. $ctx->setpriv($priv_data); # Here we do the opposite check of envfrom_callback: if not "mx" mode, # we bale rightaway. return SMFIS_CONTINUE if (not $mx_mode); # Same deal if we were already authenticated. return SMFIS_CONTINUE if ($priv_data->{'is_authenticated'}); ($priv_data->{'to'} = lc (shift)) =~ s/[<>]//g; # We also need to purge $priv_data->{'spf_result'} for each recipient! delete $priv_data->{'spf_result'}; $ctx->setpriv($priv_data); if ($priv_data->{'spf_result'} = socket_call (2, $priv_data, $priv_data->{'ipaddr'}, $priv_data->{'from'}, $priv_data->{'helo'}, $priv_data->{'to'})) { if ($priv_data->{'spf_result'} eq 'fail') { if ($tagOnly) { write_log ("SPF \"fail\" from ip=".$priv_data->{'ipaddr'}. " helo=".$priv_data->{'helo'}. " from=".$priv_data->{'from'}. " to=".$priv_data->{'to'}); } else { $ctx->setreply('550', '5.7.1', "$priv_data->{'spf_smtp_comment'}"); return SMFIS_REJECT; } } elsif ($priv_data->{'spf_result'} eq 'error') { $ctx->setreply('451', '4.7.1', "An error occurred during SPF processing of $priv_data->{'from'}. Please try again later"); return SMFIS_TEMPFAIL; } } $ctx -> setpriv ($priv_data); return SMFIS_CONTINUE; } sub eom_callback : locked { my $ctx = shift; my $priv_data = $ctx->getpriv(); # Did we get an SPF result? If so, add the appropriate header. There is no # longer a need to use the "chgheader" method to replace the first # occurance of a Received-SPF header; "addheader" will automatically # prepend the new Received-SPF header. if ($priv_data->{'spf_result'}) { $ctx->addheader('Received-SPF', $priv_data->{'spf_result'} . ' (' . $priv_data->{'spf_header_comment'} . ')'); } $ctx->setpriv($priv_data); return SMFIS_CONTINUE; } # On RSET, forget everything except the HELO name. Noted by Paul Howarth # # (note by me: we also need to preserve the hostname of the sender, # our own hostname, and the IP address of the sender! Best, therefore, to # use a negative logic, and just delete the things that need to go) sub abort_callback : locked { my $ctx = shift; my $priv_data = $ctx->getpriv(); delete $priv_data->{'spf_result'}; delete $priv_data->{'from'}; delete $priv_data->{'to'}; delete $priv_data->{'is_authenticated'}; $ctx->setpriv($priv_data); return SMFIS_CONTINUE; } sub close_callback { my $ctx = shift; $ctx->setpriv(undef); return SMFIS_CONTINUE; } my %my_callbacks = ( 'connect' => \&connect_callback, 'helo' => \&helo_callback, 'envfrom' => \&envfrom_callback, 'envrcpt' => \&envrcpt_callback, 'eom' => \&eom_callback, 'close' => \&close_callback, 'abort' => \&abort_callback, ); ############################################################ # Main code # We start spf-milter as root for the same reason we do NOT run spf-milter # as root: security. And we start it with at least one parameter, the user # to run as. Spf-milter expects to create/read/write its log, pid, and socket, # all in /var/spf-milter/, and will itself create the directory, if need be, # and set all appropriate permissions/ownerships. # # Add "mx" as second parameter to run spf-milter in "mx" mode. In "mx" mode # spf-milter makes its SPF checks at envrcpt_callback, instead of envfrom_callback, # and calls result2 (), instead of result (), to allow for an early-out for # secondaries. The default mode performs SPF checks at envfrom_callback. # # Per default, spf-milter queries trusted-fowarder.org (on 'fail' only), to # check whether the trusted-fowarder domain yields a 'pass' after all. You can # override the default behavior, adding "dt" (disable trust) as second parameter # (or third, if you run in "mx" mode). You need at least Mail::SPF::Query 1.99 # for this functionality! getopts("kl:tmhT"); sub usage { my ($ret) = @_; print STDERR "Usage: $0 [-k] [-l local_trust] [-t] [-m] [-h] <user> [mx] [dt]\n"; print STDERR " -k kill running milter\n"; print STDERR " -l add local trust record\n"; print STDERR " -t don't add trusted-forwarder.org record\n"; print STDERR " -m trust recipient's MX hosts\n"; print STDERR " -T don't reject failed messages, tag only\n"; print STDERR " -h print this help message\n"; print STDERR " <user> user to run this script as\n"; print STDERR " mx trust recipient's MX hosts (same as -m)\n"; print STDERR " dt don't add trusted-forwarder.org (same as -t)\n"; exit ($ret); } if ($opt_h) { usage (0); } # Basic, but vital, sanity-check against $basedir. Since we set # permissions/ownerships on everything (!) in our $basedir, we # must avoid disasters, such as setting $basedir to /var/run/. # Therefore, we require that $basedir ends in "spf-milter". if (not ($basedir =~ /spf-milter$/i)) { die '$basedir' . " ('$basedir') must end in /spf-milter!\n"; } my $oldPid; if (-f $pidFile) { open (PIDFILE, $pidFile) || die "Could not read pid file: $!\n"; my $pid = <PIDFILE>; if ($pid > 0) { $oldPid=$pid; } } if (defined $opt_k) { die "SPF milter not running\n" if (!defined $oldPid); # We need to kill the milter using signal 3, it apparently doesn't react # to more "usual" signals... if (!kill (3, $oldPid)) { if ($!{ESRCH}) { print STDERR "Sendmail milter not running, cleaning files\n"; # Files will be cleaned by END block exit (0); } else { # Prevent cleaning away of the running milter's files die "Could not kill SPF milter: $!\n"; } } my $needNl=0; select (STDERR); $|=1; # Waiting for milter to die for (my $i=0; $i<79; $i++) { select (undef, undef, undef, 0.25); if (!kill (0, $oldPid) && $!{ESRCH}) { print STDERR "\n" if ($needNl); exit (0); # Milter dead } print STDERR "."; $needNl=1; } print STDERR "\nForcefully killing milter\n"; kill (9, $oldPid); exit (0); } if ($oldPid) { my $r = kill (0, $oldPid); if (!$!{ESRCH}) { $pid=1; # Prevent cleaning away of the running milter's files die "SPF milter already running\n"; } } unlink $sock; unlink $pidFile; if (not $user = lc ($ARGV[0])) { print STDERR "Missing user\n"; usage (1); } elsif ($>) { print STDERR "You need to start spf-milter as root!\n"; exit 1; } $mx_mode = 1 if ($opt_m || (lc ($ARGV[1]) eq 'mx')); $trust = 0 if ($opt_t || (lc ($ARGV[1]) eq 'dt') || (lc ($ARGV[2]) eq 'dt')); push (@extraParams, trusted => $trust); if ($opt_l) { push (@extraParams, local => $opt_l); } if ($opt_T) { $tagOnly = 1; } # Since we will daemonize, play nice. chdir ('/') or exit 1; umask (0077); if (not (-e $basedir)) { if (not mkdir $basedir) { print STDERR "Odd; cannot create $basedir/\n"; exit 1; } } # The Sendmail::Milter 0.18 engine has a small bug, causing it to extract # the wrong socket-name when, next to the F flags, there's an additional flag # in the Milter definition, (see: http://rt.cpan.org/NoAuth/Bug.html?id=3892 # for details). Since the extra flag is useful (T for timeouts), we preset our # connection string to "local:/var/spf-milter/spf-milter.sock", with "spf-milter" # as Milter name. A corresponding line in sendmail.cf could look like this: # # Xspf-milter, S=local:/var/spf-milter/spf-milter.sock, F=T, T=C:4m;S:4m;R:8m;E:16m if (not $conn = Sendmail::Milter::auto_getconn ('spf-milter', '/etc/mail/sendmail.cf')) { log_error_and_exit ("Milter for 'spf-milter' not found!"); } if ($conn =~ /^local:(.+)/) { if (not Sendmail::Milter::setconn ("local:$sock")) { log_error_and_exit ("Failed to set connection information!"); } # Now we set a fairly large timeout. The idea here is to set it so large, that # the Milter will not try and compete with the sendmail T= timings, which allow # for a more fine-grained tuning. if (not Sendmail::Milter::settimeout ('8192')) { log_error_and_exit ("Failed to set timeout value!"); } if (not Sendmail::Milter::register ('spf-milter', \%my_callbacks, SMFI_CURR_ACTS)) { log_error_and_exit ("Failed to register callbacks!"); } # Get info on the user we want to run as. If $uid is undefined, the user # does not exist on the system; if zero, it is the UID of root! ($login, $pass, $uid, $gid) = getpwnam ($user); if (not defined ($uid)) { log_error_and_exit ("$user is not a valid user on this system!"); } elsif (not $uid) { log_error_and_exit ("You cannot run spf-milter as root!"); } write_log ("Starting Sendmail::Milter $Sendmail::Milter::VERSION engine"); # Set all proper permissions/ownerships, according to the user we run as. if ((not chown $uid, $gid, $basedir, glob ($basedir . '/*')) || (not chmod 0700, $basedir)) { log_error_and_exit ("Cannot set proper permissions!"); } # Drop the Sendmail::Milter privileges! $) = $gid; $( = $gid; $> = $uid; $< = $uid; # Unlink our previous .sock file, should it exist. if (-e $sock) { if (not unlink ($sock)) { log_error_and_exit ("Cannot unlink $sock!"); } } # Give us a pretty proc-title to look at in 'ps ax'. :) $0 = 'spf-milter' . (($mx_mode) ? (" [mx mode]") : ("")); # Fork and give us a pid file. if ($pid = fork ()) { open (USERLOG, ">". $pidFile) or exit 1; flock (USERLOG, 2); seek (USERLOG, 0, 0); print USERLOG " $pid"; close (USERLOG); # Wait until either milter socket appears or child dies my $kid=0; while (!-x $sock) { select (undef,undef,undef,0.01); $kid = waitpid(-1, WNOHANG); if ($kid > 0) { $pid=0; # trigger cleanup die "Could not start milter\n"; } } exit 0; } # Redirect all input/output from/to null open (STDIN, '/dev/null'); open (STDOUT, '>/dev/null'); # Complete de daemonization process. POSIX::setsid () or exit 1; open (STDERR, '>&STDOUT'); if (Sendmail::Milter::main ()) { write_log ("Successful exit from the Sendmail::Milter engine"); } else { write_log ("Unsuccessful exit from the Sendmail::Milter engine"); } } else { log_error_and_exit ("$conn is not a valid connection object!"); } END { # On exit (child only!) we clean up the mess. if (not $pid) { unlink ($pidFile); unlink ($sock); } } exit 0;