#!/usr/local/cpanel/3rdparty/bin/perl -U -I /usr/share/MailScanner/perl

# (c) 2019-2020 MailScanner Project <https://www.mailscanner.info>
#          Version 1.6
#
#    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 Getopt::Long;

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_ref} !~ /^Received:/ ) {
        ${$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};

            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<|E<|A<)/;
            }

            ${$message_ref} = $data;
            MailScanner::Lock::unlockclose($queuehandle);

            # Done with previous message
            unlink $file;
        }


        # 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} .= "\t(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} .= "\t(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} .= "\t(Authenticated sender)\n";
            MailScanner::Log::DebugLog("envrcpt_callback: Authenticated sender: " . $symbols->{'M'}->{'{auth_authen}'});
            ${$message_ref} = "A<sasl_method=" . $symbols->{'M'}->{'{auth_type}'} . ">\n" . ${$message_ref};
        } else {
            ${$message_ref} .= "\n";
        }
        ${$message_ref} .= "\tby " . hostname . ' (MailScanner Milter) with SMTP id ';
    }

    my $rcptto = $args[0];
    my $esmtpnotify = '';
    # Capture the ESMTP options for pass through MailScanner engine
    # RFC 3461
    foreach (@args)
    {
        if ($_ =~ /^NOTIFY=/)
        {
            MailScanner::Log::DebugLog("envrcpt_callback: NOTIFY argument found: " . $_);
            $esmtpnotify = $_;
        }
    }

    # Build original recipient milter header
    ${$message_ref} = 'O' . $rcptto . "\n" . ${$message_ref};
    
    # Add options milter header
    if ($esmtpnotify ne '') 
    {
        ${$message_ref} = 'E<' . $esmtpnotify . ">\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\tfor " . $1 . "; ";
        } else {
            ${$message_ref} .= ";\n\t";
        }
        ${$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);

    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};

    copy($file, $file2);

    # 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};

    unlink $file;

    $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, $foreground) = @_;

    my $procname = 'MSMilter';

    my $logbanner = "MSMilter Daemon starting...";

    if ($foreground) {
        MailScanner::Log::Configure($logbanner, 'foreground');
    } else {
        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);
}

BEGIN {
    chdir('/usr/share/MailScanner/perl');

    $ENV{PATH}="/sbin:/bin:/usr/sbin:/usr/bin";
   
    umask 0077;

    my $WantHelp          = 0;
    my $result = GetOptions ("h|H|help"            => \$WantHelp);

    if ($WantHelp) {
        print STDERR "Usage:\n";
        print STDERR "MSMilter [ -h|--help] |\n";
        print STDERR "         <MailScanner.conf-file-location>\n";
        exit 0;
    }
    
    $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);

    my $RunInForeground = MailScanner::Config::QuickPeek($ConfFile, 'runinforeground');
    $RunInForeground = 0 unless $RunInForeground =~ /yes|1/i;

    $| = 1 if $RunInForeground;
     
    # Start logging
    StartLogging($ConfFile, $RunInForeground);
   
    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";

        my $PidFile = MailScanner::Config::Value('milterpidfile');
        WritePIDFile($$,$PidFile) or die("Unable to Write PID!");

        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");

        # Cleanup temps after a start/restart
        my $incoming = MailScanner::Config::Value('inqueuedir');
        if ($incoming eq '') {
          MailScanner::Log::WarnLog("Unable to determine incoming queue!");
          exit 1
        }

        unlink glob @{$incoming}[0] . "/temp-*";

        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
    while ($RunInForeground) 
    { 
        sleep 1;
        #Do nothing just sit here :D
    }
    exit 0;
}

1;
