File: //sbin/MSMilter
#!/usr/bin/perl -U -I /usr/share/MailScanner/perl
# (c) 2019 MailScanner Project <https://www.mailscanner.info>
# Version 1.5
#
# This program is free software; you can redistribute it and/or modify
# it under the terms of the GNU General Public License as published by
# the Free Software Foundation; either version 2 of the License, or
# (at your option) any later version.
#
# This program is distributed in the hope that it will be useful,
# but WITHOUT ANY WARRANTY; without even the implied warranty of
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
# GNU General Public License for more details.
#
# You should have received a copy of the GNU General Public License along
# with this program; if not, write to the Free Software Foundation, Inc.,
# 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA.
#
# Contributed by Shawn Iverson for MailScanner <shawniverson@efa-project.org>
use strict 'vars';
no strict 'refs';
no strict 'subs';
use POSIX;
require 5.005;
use DirHandle;
use File::Basename;
use File::Copy;
use IO::File;
use IO::Pipe;
use Sendmail::PMilter;
use Socket;
use Socket qw(inet_ntop);
use POSIX qw(strftime);
use Sys::Hostname;
use Time::HiRes qw( gettimeofday );
use MailScanner::Lock;
use MailScanner::Log;
use MailScanner::Config;
use MailScanner::CustomConfig;
use MailScanner::Message;
my $ConfFile;
my $PidFile;
sub smtp_id {
my $type = MailScanner::Config::Value('msmailqueuetype');
MailScanner::Log::DebugLog("msmailqueuetype = $type");
if ($type =~ /long/i) {
# Long queue IDs
my $seconds=0;
my $microseconds=0;
use Time::HiRes qw( gettimeofday );
($seconds, $microseconds) = gettimeofday;
my $microseconds_orig=$microseconds;
my @BASE52_CHARACTERS = ("0","1","2","3","4","5","6","7","8","9",
"B","C","D","F","G","H","J","K","L","M",
"N","P","Q","R","S","T","V","W","X","Y",
"Z","b","c","d","f","g","h","j","k","l",
"m","n","p","q","r","s","t","v","w","x","y","z");
my $encoded='';
my $file_out;
my $count=0;
while ($count < 6) {
$encoded.=$BASE52_CHARACTERS[$seconds%52];
$seconds/=52;
$count++;
}
$file_out=reverse $encoded;
$encoded='';
$count=0;
while ($count < 4) {
$encoded.=$BASE52_CHARACTERS[$microseconds%52];
$microseconds/=52;
$count++;
}
$file_out.=reverse $encoded;
$file_out.="z";
# File doesn't exist yet, just randomize
my $inode=int(rand 1000000) + 1;
$encoded='';
$count=0;
while ($count < 4) {
$encoded.=$BASE52_CHARACTERS[$inode%51];
$inode/=51;
$count++;
}
$file_out.=reverse $encoded;
# We check the generated ID...
if ($file_out !~ /[A-Za-z0-9]{12,20}/) {
# Something has gone wrong, back to short ID for safety
MailScanner::Log::WarnLog("ERROR generating long queue ID");
$file_out = sprintf("%05X%lX", int(rand 1000000)+1, int(rand 1000000)+1);
}
return $file_out;
} else {
# No file to stat, so just randomly generate
return sprintf("%05X%lX", int(rand 1000000)+1, int(rand 1000000)+1);
}
}
sub connect_callback
{
my $ctx = shift;
my $hostname = shift;
my $sockaddr_in = shift;
my ($port, $iaddr);
my $ip;
my $message_ref = $ctx->getpriv();
my $message = $hostname;
if (defined $sockaddr_in)
{
my $family = sockaddr_family($sockaddr_in);
if ($family eq AF_INET) {
($port, $iaddr) = sockaddr_in($sockaddr_in);
$ip = inet_ntop(AF_INET, $iaddr);
$message .= ' [' . $ip . ']';
} elsif ($family eq AF_INET6) {
($port, $iaddr) = sockaddr_in6($sockaddr_in);
$ip = inet_ntop(AF_INET6, $iaddr);
$message .= ' [' . $ip . ']';
} else {
$ip = '';
}
}
# Localhost relaying email? Accept the message for delivery if enabled
my $loopback = MailScanner::Config::Value('milterignoreloopback');
if ($loopback == 1 && ($ip =~ /^127/ || $ip =~ /^::1$/)) {
MailScanner::Log::DebugLog("Localhost relay detected");
return Sendmail::PMilter::SMFIS_ACCEPT;
}
MailScanner::Log::DebugLog("connect_callback: ip = $ip");
${$message_ref} = $message;
$ctx->setpriv($message_ref);
Sendmail::PMilter::SMFIS_CONTINUE;
}
sub helo_callback
{
my $ctx = shift;
my $helohost = shift;
my $message_ref = $ctx->getpriv();
my $message = "Received: from $helohost";
# Watch for the second callback
if ( $message ne substr(${$message_ref}, 0, length($message)) ) {
${$message_ref} = $message . ' (' . ${$message_ref} . ')' ."\n";
MailScanner::Log::DebugLog("helo_callback: $message");
}
$ctx->setpriv($message_ref);
Sendmail::PMilter::SMFIS_CONTINUE;
}
sub envrcpt_callback
{
my $ctx = shift;
my @args = @_;
my $message_ref = $ctx->getpriv();
my $symbols = $ctx->{symbols};
my $mailfrom;
# Watch for second callback
if ( ${$message_ref} !~ /MailScanner Milter/ ) {
# Is this a subsequent message? Grab previous message id to reconstruct header
if ( ${$message_ref} =~ /^[0-9A-F]{7,20}|[0-9B-DF-HJ-NP-TV-Zb-df-hj-np-tv-z]{8,20}$/ ) {
# Read envelope
my $queuehandle = new FileHandle;
my $incoming = MailScanner::Config::Value('inqueuedir');
MailScanner::Log::DebugLog("envrcpt_callback: incoming = " . @{$incoming}[0]);
if ($incoming eq '') {
MailScanner::Log::WarnLog("Unable to determine incoming queue!");
Sendmail::PMilter::SMFIS_TEMPFAIL;
return;
}
my $file = @{$incoming}[0] . '/temp-' . ${$message_ref};
my $file2 = @{$incoming}[0] . '/' . ${$message_ref};
MailScanner::Log::DebugLog("envrcpt_callback: file = $file");
my $ret;
$ret = MailScanner::Lock::openlock($queuehandle,'+<' . $file, 'w');
if ($ret != 1) {
MailScanner::Log::WarnLog("Unable to to open temp queue file for reading!");
Sendmail::PMilter::SMFIS_TEMPFAIL;
return;
}
my $data;
my $pos;
# Locate predata header
while($data = readline $queuehandle) {
last if $data !~ /^(O<|S<)/;
}
${$message_ref} = $data;
MailScanner::Lock::unlockclose($queuehandle);
# Done with previous message, make ready for mailscanner
move($file, $file2);
}
# Capture the Mail From address for further processing
if (defined($symbols->{'M'}) && defined($symbols->{'M'}->{'{mail_addr}'})) {
$mailfrom=$symbols->{'M'}->{'{mail_addr}'};
} else {
# Null Sender
# RFC 1123, 821
$mailfrom='';
}
${$message_ref} = 'S<' . $mailfrom . ">\n" . ${$message_ref};
if (defined($symbols->{'H'}) && defined($symbols->{'H'}->{'{tls_version}'}) && defined($symbols->{'H'}->{'{cipher}'}) && defined($symbols->{'H'}->{'{cipher_bits}'})) {
${$message_ref} .= ' (using ' . $symbols->{'H'}->{'{tls_version}'} . ' with cipher ' . $symbols->{'H'}->{'{cipher}'} . ' (' . $symbols->{'H'}->{'{cipher_bits}'} . '/' . $symbols->{'H'}->{'{cipher_bits}'} . ' bits))' . "\n";
MailScanner::Log::DebugLog("envrcpt_callback: ssl/tls detected");
}
if (!defined($symbols->{'H'}->{'{cert_subject}'})) {
${$message_ref} .= ' (no client certificate requested)';
MailScanner::Log::DebugLog("envrcpt_callback: no client certificate requested");
}
if (defined($symbols->{'M'}->{'{auth_type}'}) && defined($symbols->{'M'}->{'{auth_authen}'})) {
${$message_ref} .= ' (Authenticated sender: ' . $symbols->{'M'}->{'{auth_authen}'} . ")\n";
MailScanner::Log::DebugLog("envrcpt_callback: Authenticated sender: " . $symbols->{'M'}->{'{auth_authen}'});
} else {
${$message_ref} .= "\n";
}
${$message_ref} .= ' by ' . hostname . ' (MailScanner Milter) with SMTP id ';
}
# Build original recipient milter header
${$message_ref} = 'O' . $args[0] . "\n" . ${$message_ref};
$ctx->setpriv($message_ref);
Sendmail::PMilter::SMFIS_CONTINUE;
}
sub header_callback
{
my $ctx = shift;
my $headerf = shift;
my $headerv = shift;
my $message_ref = $ctx->getpriv();
my $symbols = $ctx->{symbols};
my $id;
my $datestring = strftime "%a, %e %b %Y %T %z (%Z)", localtime;
# Postfix queue id revealed during this phase, capture it if defined
# and populate the rest of the Received: header
if (${$message_ref} =~ /SMTP\sid\s$/ ) {
if (defined($symbols->{'L'}) && defined($symbols->{'L'}->{'i'}) ) {
$id = $symbols->{'L'}->{'i'};
if ( $id ne '' ) {
MailScanner::Log::DebugLog("Postfix ID captured: $id");
} else {
$id = smtp_id;
MailScanner::Log::DebugLog("Postfix id empty, generated one instead: $id");
}
} else {
$id = smtp_id;
MailScanner::Log::DebugLog("Unable to capture real postfix id, generated one instead: $id");
}
${$message_ref} .= $id;
# Check for only one original recipient and add 'for <>' if so.
if (${$message_ref} =~ /^O(<.*>)\n(?!O)/ ) {
${$message_ref} .= "\n for " . $1 . "; ";
} else {
${$message_ref} .= ";\n ";
}
${$message_ref} .= "$datestring\n";
MailScanner::Log::DebugLog("header_callback: datestring = $datestring");
}
${$message_ref} .= $headerf . ': ' . $headerv . "\n";
$ctx->setpriv($message_ref);
Sendmail::PMilter::SMFIS_CONTINUE;
}
sub eoh_callback
{
my $ctx = shift;
my $message_ref = $ctx->getpriv();
my $id;
my $line;
my $buffer;
my $ip;
my @to;
my $from;
# Are we in scanner mode?
my $scannermode = MailScanner::Config::Value('milterscanner');
MailScanner::Log::DebugLog("eoh_callback: scannermode = $scannermode");
while (${$message_ref} =~ /([^\n]+)\n?/g) {
my $line = $1;
$buffer .= $1 . "\n";
if ($line =~ /^Received: / ) {
$ip = '127.0.0.1';
if ($line =~ /^Received: .+?\(.*?\[(?:IPv6:)?([0-9a-f.:]+)\]/i) {
$ip = $1;
}
MailScanner::Log::DebugLog("eoh_callback: ip = $ip");
} elsif ( $line =~ m/^.*SMTP id / ) {
# We may have added a trailing ; so remove it if so.
$line =~ s/^.*SMTP id ([^;]*)(?:;?)/$1/;
$id = $line;
MailScanner::Log::DebugLog("eoh_callback: id = $id");
last;
} elsif ( $line =~ /^O/ ) {
$line =~ s/^O//;
$line =~ s/^\<//;
$line =~ s/\>.*$//;
push @to, $line;
MailScanner::Log::DebugLog("eoh_callback: to = $line");
} elsif ( $line =~ /^F/ ) {
$line =~ s/^F//;
$line =~ s/^\<//;
$line =~ s/\>.*$//;
$from = $line;
MailScanner::Log::DebugLog("eoh_callback: from = $line");
}
}
if ( $id eq '' ) {
# Missing a queue id, header_callback possibly skipped, reject
MailScanner::Log::WarnLog("Postfix queue id is missing");
Sendmail::PMilter::SMFIS_TEMPFAIL;
return;
}
# Write header to file
my $queuehandle = new FileHandle;
my $incoming = MailScanner::Config::Value('inqueuedir');
MailScanner::Log::DebugLog("eoh_callback: incoming = " . @{$incoming}[0]);
if ($incoming eq '') {
MailScanner::Log::WarnLog("Unable to determine incoming queue!");
Sendmail::PMilter::SMFIS_TEMPFAIL;
return;
}
my $file = @{$incoming}[0] . '/temp-' . $id;
MailScanner::Log::DebugLog("eoh_callback: file = $file");
my $ret;
$ret = MailScanner::Lock::openlock($queuehandle,'>>' . $file, 'w');
if ($ret != 1) {
MailScanner::Log::WarnLog("Unable to to open queue temp file for writing!");
Sendmail::PMilter::SMFIS_TEMPFAIL;
return;
}
$queuehandle->print(${$message_ref});
# Signal end of header
$queuehandle->print("\n");
$queuehandle->flush();
MailScanner::Lock::unlockclose($queuehandle);
# Determine what to do next
if ($scannermode == 1) {
MailScanner::Log::DebugLog("eoh_callback: scanner mode enabled");
# Blacklist test
# Build a message object to test against
my $message = {};
if ($from ne '<>') {
$message->{from} = $from;
} else {
$message->{from} = '';
}
@{$message->{to}} = @to;
$message->{clientip} = $ip;
my $user;
my $domain;
($user, $domain) = MailScanner::Message::address2userdomain($message->{from});
$message->{fromuser} = $user;
$message->{fromdomain} = $domain;
my $touser;
my $todomain;
my $count;
foreach my $msgto (@{$message->{to}}) {
($touser, $todomain) = MailScanner::Message::address2userdomain($msgto);
push @{$message->{touser}}, $touser;
push @{$message->{todomain}}, $todomain;
$count++;
}
my $test;
# Check whitelist first
$test = MailScanner::Config::Value('spamwhitelist', $message);
my $maxrecips = MailScanner::Config::Value('whitelistmaxrecips');
$maxrecips = 999999 unless $maxrecips;
# Not in whitelist or a large number of recipients, then check blacklist
if ($test == 0 || $count > $maxrecips) {
MailScanner::Log::DebugLog("eom_callback: no whitelist match, proceeding to blacklist test");
# test
$test = MailScanner::Config::Value('spamblacklist', $message);
# Blacklisted, fire a reject
if ($test == 1) {
MailScanner::Log::DebugLog("eom_callback: blacklist match, firing reject");
# Set reject code
$ctx->setreply('554', '5.7.1', 'Message Blacklisted');
# Delete temp file
unlink $file;
return Sendmail::PMilter::SMFIS_REJECT;
}
}
}
MailScanner::Log::DebugLog("eoh_callback: End of Header detected");
# Start storing just the id
${$message_ref} = $id;
$ctx->setpriv($message_ref);
Sendmail::PMilter::SMFIS_CONTINUE;
}
sub body_callback
{
my $ctx = shift;
my $body_chunk = shift;
my $len = shift;
my $message_ref = $ctx->getpriv();
my $queuehandle = new FileHandle;
my $incoming = MailScanner::Config::Value('inqueuedir');
MailScanner::Log::DebugLog("body_callback: incoming = " . @{$incoming}[0]);
if ($incoming eq '') {
MailScanner::Log::WarnLog("Unable to determine incoming queue!");
Sendmail::PMilter::SMFIS_TEMPFAIL;
return;
}
my $file = @{$incoming}[0] . '/temp-' . ${$message_ref};
MailScanner::Log::DebugLog("body_callback: file = $file");
my $ret;
$ret = MailScanner::Lock::openlock($queuehandle,'>>' . $file, 'w');
if ($ret != 1) {
MailScanner::Log::WarnLog("Unable to to open queue temp file for writing!");
Sendmail::PMilter::SMFIS_TEMPFAIL;
return;
}
$queuehandle->print($body_chunk);
$queuehandle->flush();
MailScanner::Lock::unlockclose($queuehandle);
$ctx->setpriv($message_ref);
Sendmail::PMilter::SMFIS_CONTINUE;
}
sub eom_callback
{
my $ctx = shift;
my $message_ref = $ctx->getpriv();
# Store reference for subsequent messages in connection or for connection close
$ctx->setpriv($message_ref);
# Send DISCARD signal to accept message and drop from postfix
# for mailscanner processing
Sendmail::PMilter::SMFIS_DISCARD;
}
sub close_callback
{
my $ctx = shift;
my $message_ref = $ctx->getpriv();
my $incoming = MailScanner::Config::Value('inqueuedir');
MailScanner::Log::DebugLog("eom_callback: incoming = " . @{$incoming}[0]);
if ($incoming eq '') {
MailScanner::Log::WarnLog("Unable to determine incoming queue!");
Sendmail::PMilter::SMFIS_TEMPFAIL;
return;
}
my $file = @{$incoming}[0] . '/temp-' . ${$message_ref};
my $file2 = @{$incoming}[0] . '/' . ${$message_ref};
move($file, $file2);
$ctx->setpriv(undef);
Sendmail::PMilter::SMFIS_CONTINUE;
}
#
# Create and write a PID file for a given process id
#
sub WritePIDFile {
my($process,$PidFile) = @_;
my $pidfh = new FileHandle;
$pidfh->open(">$PidFile")
or MailScanner::Log::WarnLog("Cannot write pid file %s, %s", $PidFile, $!);
print $pidfh "$process\n";
$pidfh->close();
}
#
# Start logging
#
sub StartLogging {
my($filename) = @_;
my $procname = 'MSMilter';
my $logbanner = "MSMilter Daemon starting...";
MailScanner::Log::Configure($logbanner, 'syslog');
# Need to know log facility *before* we have read the whole config file!
my $facility = MailScanner::Config::QuickPeek($filename, 'syslogfacility');
my $logsock = MailScanner::Config::QuickPeek($filename, 'syslogsockettype');
MailScanner::Log::Start($procname, $facility, $logsock);
}
sub ExitParent {
my($sig) = @_; # Arg is the signal name
# Reap children (wait up to one minute)
my $counter=0;
while ($counter < 30) {
if (wait() > 0) {
# Still active children
sleep(2);
$counter++;
MailScanner::Log::NoticeLog("Milter closing, waiting on children to finish...");
} else {
$counter=30;
}
}
# Cleanup partial writes
my $incoming = MailScanner::Config::Value('inqueuedir');
unlink glob @{$incoming}[0] . "/temp-*";
unlink $PidFile; # Ditch the pid file
MailScanner::Log::Stop();
exit 0;
}
BEGIN {
chdir('/usr/share/MailScanner/perl');
$ENV{PATH}="/sbin:/bin:/usr/sbin:/usr/bin";
umask 0077;
$ConfFile = $ARGV[0];
# Use the default if we couldn't find theirs. Will save a lot of grief.
$ConfFile = '/etc/MailScanner/MailScanner.conf' if $ConfFile eq "" ||
!(-f $ConfFile);
# Start logging
StartLogging($ConfFile);
MailScanner::Config::initialise(MailScanner::Config::QuickPeek($ConfFile,
'customfunctionsdir'));
# Read Config File
MailScanner::Config::Read($ConfFile);
my $pid = fork;
if (!defined($pid)) {
MailScanner::Log::WarnLog("Milter: Unable to fork!");
exit 1;
}
if ($pid == 0) {
$0 = "MSMilter Daemon";
# Need this new parent process to ignore SIGHUP, and catch SIGTERM
$SIG{'HUP'} = 'IGNORE';
$SIG{'TERM'} = \&ExitParent;
my $PidFile = MailScanner::Config::Value('milterpidfile');
WritePIDFile($$,$PidFile);
my $dispatcher = MailScanner::Config::Value('milterdispatcher');
my $children = MailScanner::Config::Value('miltermaxchildren');
my $user = MailScanner::Config::Value('runasuser');
my $group = MailScanner::Config::Value('workgroup');
my $bind = MailScanner::Config::Value('milterbind');
my $port = MailScanner::Config::Value('milterport');
MailScanner::Log::Reset();
MailScanner::Log::DebugLog("initialization:\n PidFile = $PidFile\n user = $user\n group = $group\n bind = $bind\n port = $port");
my %my_callbacks =
(
'connect' => \&connect_callback,
'helo' => \&helo_callback,
'envrcpt' => \&envrcpt_callback,
'header' => \&header_callback,
'eoh' => \&eoh_callback,
'body' => \&body_callback,
'eom' => \&eom_callback,
'close' => \&close_callback,
);
my $conn = 'inet:'. $port . '@' . $bind;
$ENV{PMILTER_DISPATCHER} = $dispatcher;
my $milter = Sendmail::PMilter->new();
$milter->register('MSMilter',
\%my_callbacks,
Sendmail::PMilter::SMFI_CURR_ACTS
);
$milter->setconn($conn);
$< = $> = getpwnam($user);
$( = $) = getgrnam($group);
if ( $dispatcher eq "prefork" ) {
$milter->main($children,100);
} else {
$milter->main();
}
# Should never get here, if we did, it didn't work
MailScanner::Log::WarnLog("Unable to spawn milter!");
exit 1
}
# Successful if we reach this point
exit 0;
}
1;