#!/usr/bin/perl

###############################################################################
#                                                                             #
# This is based on auto-dnsbl.pl (iptables version)                           #
# https://gist.github.com/jikamens/07220fc98361421c2ddfabb5286c14d8           #
#                                                                             #
# This version if for IPFire 2.27 (x86_64) - Core-Update 182 and later        #
#                                                                             #
# This program  parses /var/log/messages for incoming SMTP connections        #
# generated by special iptables log entry on Ipfire.                          #
#                                                                             #
# Whitelist added for known users to prevent unnecessary dnsbl lookups.       #
#                                                                             #
# This script monitors log messages with IP addresses indicating              #
# probably nefarious activity, checks the IP addresses against a DNS          #
# Blackhole List (DNSBL), and adds the addresses that are in the DNSBL        #
# to iptables, so that further connections from those addresses will be       #
# blocked automatically.                                                      #
#                                                                             #
# 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 3 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, see <http://www.gnu.org/licenses/>.       #
#                                                                             #
#                                                                             #
# Version 1.0                                                                 #
#                                                                             #
# Rob Brewer  <rob.brewer@ipfire.org>                                         #
#                                                                             #
# Copyright (C) 2024  IPFire Team                                             #
###############################################################################

use strict;
use warnings;
use SDBM_File;
use Net::IP;
use Net::CIDR::Lite;
use Sys::Syslog qw(:DEFAULT setlogsock);


my $log_file = 'tail --follow=name /var/log/messages|';
my $regex = '.*kernel:.*smtpconnections.*IN=ppp0.*SRC=(\d+\.\d+\.\d+\.\d+).DST=192.168.2.4.*DPT=25.*'; # See README
my $state_file = '/run/auto-dnsbl.state';
my @dnsbls = ('zen.spamhaus.org', 'bl.spamcop.net');
my $block_for = 60 * 60;                     # Block for one hour (3600 seconds)
my $whitelist = '/var/ipfire/auto-dnsbl/whitelist';
my $chain = "AUTO-DNSBL";
my $to = 'postmaster@example.com';  # Change postmaster@example.com to your administrator's email address


# write PID to /run
my $pidfile="/run/auto-dnsbl.pid";
open(my $fh, '>', $pidfile) or die "Could not open file '$pidfile' $!";
print $fh "$$";
undef $fh;

# Establish the connection to the syslog service.
openlog('auto-dnsbl', 'cons', 'user');

# In: state file name
# Out: Opaque object representing state
sub parse {
    my($state_file, $chain) = @_;
    dbmopen(my %state_file, $state_file, 0600) or die "Error: Cannot open dbmfile $state_file: $!";
    my(%current);
    foreach my $prot (qw(iptables)) {
        open(IPTABLES, "-|", $prot, "-n", "-L", $chain) or die;
        while (<IPTABLES>) {
            @_ = split;
            next if ($_[0] ne "DROP"); 
            $current{$_[3]} = 1;
        }
        close IPTABLES;
    }
    for (keys %state_file) {
        if (! $current{$_}) {
            delete $state_file{$_};
        }
    }
    return \%state_file;
}

# ip6tables not applicable to ipfire v2 but left for forward compatibility.
#
sub iptables {
    return ($_[0] =~ /:/) ? 'ip6tables' : 'iptables';
}

# In: Parsed state object, seconds to block IPs for
# Out: None
# Side effects: Removes stale records
sub purge {
    my($denier, $block_for, $chain) = @_;
    my $then = time() - $block_for;
    my(@new);
    foreach my $ip (keys %$denier) {
        my $stamp = $denier->{$ip};
        if ($stamp <= $then) {
            &_log_to_syslog("UNBAN: $ip\n");
            if ( system(&iptables($ip), "-D", $chain, "-s", $ip, "-j", "LOG", "--log-prefix", "DROP-AUTO-DNSBL ")
             ||  system(&iptables($ip), "-D", $chain, "-s", $ip, "-j", "DROP" )
             ||  system(&iptables($ip), "-D", $chain, "-d", $ip, "-j", "DROP" ))
                {
                &_log_to_syslog("Failed to remove $ip from iptables\n");
            }
            delete $denier->{$ip};
        }
    }
}

# In: Parsed state object, IP address to add
# Out: None
# Side effects: Adds record for IP
sub add {
    my $conntrack = "/usr/sbin/conntrack";
    my($denier, $ip, $chain) = @_;
    &_log_to_syslog("BAN: $ip\n");  
# Rather more agressive rules used for ipfire blocking
     system(&iptables($ip), "-A", $chain, "-s", $ip, "-j", "LOG", "--log-prefix", "DROP-AUTO-DNSBL ") and die;
     system(&iptables($ip), "-A", $chain, "-s", $ip, "-j", "DROP") and die;
     system(&iptables($ip), "-A", $chain, "-d", $ip, "-j", "DROP") and die;
     qx/$conntrack -D -d "$ip" > \/dev\/null 2>&1/;
     qx/$conntrack -D -s "$ip" > \/dev\/null 2>&1/;
     $denier->{$ip} = time();
}

# In: Denier, IP address
# Out: True if IP is already in denier
sub in {
    my($denier, $ip) = @_;
    $denier->{$ip} ? 1 : 0;
}

# In: blocklist, IP
# Out: True if in blocklist
sub check_blocklist {
    my($dnsbl, @numbers) = @_;
    my $lookup = join('.', @numbers) . '.' . $dnsbl;
    return qx/dig +short $lookup/;
}

# In: Blocklists ref, IP
# Out: True if in any of them
sub check_blocklists {
    my($dnsbls, $ip) = @_;
    my $ipo = new Net::IP($ip) or die;
    my(@numbers);
    if ($ipo->version() == 4) {
        @numbers = reverse split(/\./, $ip);
    }
    else {
        @numbers = reverse grep(! /:/, split(//, $ipo->ip()));
    }
    foreach my $dnsbl (@{$dnsbls}) {
        return 1 if (&check_blocklist($dnsbl, @numbers));
    }
    return undef;
}

# Check if IP is in Whitelist
# In Whitelist, IP
# Out True if in Whitelist
sub check_whitelist {
    my($whitelist, $ip) = @_;
    my @CIDR;
    open LIST, '<', $whitelist or die;
    while ( my $line =  <LIST> ) {
        $line =~ s/\s.*//;          # remove whitespace
        $line =~ s/\s*#.*//;        # remove comments '#'
        chomp($line);
        push  @CIDR, $line;
        }
    close LIST;
     my $cidr = Net::CIDR::Lite->new();
     $cidr->add_any($_) for @CIDR;
     return $cidr->find($ip);
}

#
#  function to send the error message to the syslog.
#
sub _log_to_syslog($) {
        my ($message) = @_;
        my @syslog = ("ERR", "$message");
        syslog(@syslog);
}

# expire timer - run in background
# In denier
# Out purge timer (60s)
sub expire {
    my ($denier) =@_;
    my $parent_pid = "$$";
    my $pid = fork();

    if (not defined $pid) {             # fork failed
    die "Cannot fork: $!";
    }
    elsif ($pid == 0) {                 # child process
    $0 = 'auto-dnsbl-expire';
    while (1) {
        my $time = localtime;
        $denier = &parse($state_file, $chain);
        &purge($denier, $block_for, $chain);
        sleep 60;
        }
       exit;
    }
}

# Function to add blocklist test to email
# In IP
# Out host listed/not listed
sub rblcheck {
    my($ip) = @_;
    my @dnsbls = ('sbl.spamhaus.org', 'xbl.spamhaus.org', 'pbl.spamhaus.org ', 'bl.spamcop.net', 'psbl.surriel.com', 'dul.dnsbl.sorbs.net');
    my $qip = join '.', reverse(split /\./, $ip);
    my $blacklisted;
    my @listed;
    foreach my $dnsbl (@dnsbls)
        {
        my $lookup = join('.', $qip, $dnsbl);
        my $string = qx/dig +short $lookup/;
        if($string =~  /127\.0\.0.\d{1,3}/) {
             $blacklisted = "$ip listed by $dnsbl";
              }
        else  {
             $blacklisted = "$ip not listed by $dnsbl";
              }
        push  @listed, $blacklisted, "\n";
        }
    return @listed;
}

# send email to administrator
# In To, IP
# Out email 
sub mail {
    my($to, $ip) = @_;
    my @rbl = &rblcheck($ip);
    my $check = join '',@rbl;
    my $whois = qx(/usr/bin/timeout 5 /usr/bin/whois $ip);
    my $host = qx(/bin/hostname);
       chomp $host;
    my $from = "auto-dnsbl\@$host";
    my $subject = "[AUTO-DNSBL] banned $ip from $host";
    my $message = 
"Hi,\n
The IP $ip has just been banned by AUTO-DNSBL.\n\n
Here is more information about $ip.:\n
Found in the following blacklists :\n
$check\n
$whois
Regards,\n
Auto-dnsbl";

    open(MAIL, "|/usr/sbin/sendmail -t");
    
    # Email Header
    print MAIL "To: $to\n";
    print MAIL "From: $from\n";
    print MAIL "Subject: $subject\n\n";
    # Email Body
    print MAIL $message;
    close(MAIL);
}

# In: logfile, regexes, state file, dnsbls, block_for, whitelist, chain
# Out: None
# Side effects: Launches and runs forever, processing and updating state
sub daemon {
    my($log_file, $regex, $state_file, $dnsbls, $block_for, $whitelist, $chain) = @_;
    my($denier, %recent);
    open(LOGFILE, $log_file) or die;
    $denier = &parse($state_file, $chain);
    &expire($denier);

  logline:
    while (<LOGFILE>) {
        my $ip;
            if (/$regex/) {
                $ip = $1;
            }
        next if (! $ip);
        next if ($ip =~ /^(?:127\..*|(?:0:)+1|::1)$/);

        # There are two cases where we don't want to log again about a
        # "recent" IP address: (1) when the IP appears twice very
        # close together in time in the logs; (2) when, for reasons I
        # don't quite understand perhaps related to TCP timeouts, the
        # IP appears twice within about 2.5 hours. We use the latter
        # as the timeout, which covers the former.
        my $now = time();
        my $then = $now - 60 * 60; # set to 1hr
        foreach my $oldip (keys %recent) {
            my $oldtime = $recent{$oldip};
            if ($oldtime < $then) {
                delete $recent{$oldip};
            }
            elsif ($oldip eq $ip) {
                next logline;
            }
        }
        $recent{$ip} = $now;

        if (&in($denier, $ip)) {
            &_log_to_syslog("Skipping (already in $state_file): $ip\n");
            next;
        }

        if (&check_whitelist($whitelist, $ip)) {
            &_log_to_syslog("Skipping (Found in Whitelist): $ip\n");
            next;
        }

        if (! &check_blocklists($dnsbls, $ip)) {
            &_log_to_syslog("Skipping (not in blocklist): $ip\n");
            next;
        }

        &add($denier, $ip, $chain);
        &mail($to, $ip);
    }
}

&daemon($log_file, $regex, $state_file, \@dnsbls, $block_for, $whitelist, $chain);
