#!/usr/bin/perl -w
# zombiesmtp - a multi-threaded zombie smtp server
#
# Synopsis: zombismtp runs on port 25 pretending to be an SMTP server (in
# reality it only prints the initial 220 greeting message). For any connections
# that come from an address blacklisted in an RBL the connection will stay
# open for 20 mins, otherwise the connection will be closed immediately. The
# purpose of this is to simply interrupt spammers' activity by wasting their
# time as they attempt to use zombiesmtp as an open-relay server. The RBLs
# are pre-defined but you can add and delete them as you like.
#
# Run as root: ./zombiesmtp &
# Suggestion: run this from /etc/rc.local for automatic startup
# NOTE: Make sure you've disabled Sendmail or any other MTAs running on
# port 25!
#
# Released under the GPL 2005/03/17
# Author: Simon <wocky NOSPAM<AT>NOSPAM akibageeks.com>
#

# CONFIGURE RBLS HERE: add/delete as you like, make sure there's at least one!
@RBLS = (
"relays.ordb.org",
"all.rbl.jp"
);

use Socket;
use IO::Socket;
use IO::Select;
use POSIX ":sys_wait_h";
my $timeout = 1200; # in seconds
my $port = 25;
my ($selector, @sockets, $sock);
$sock = new IO::Socket (
    Domain    => AF_INET,
    Listen    => 5,
    LocalPort    => $port,
    Proto    => 'tcp',
    Reuse    => 1,
    Type    => SOCK_STREAM
);
unless (defined $sock) {
    die "$0: Error binding to socket $port: $!\n";
}
if (defined $selector) {
    $selector->add($sock);
} else {
    $selector = new IO::Select ($sock);
}
sub REAPER { 1 unless (waitpid(-1, WNOHANG) == -1) }
$SIG{CHLD} = \&REAPER;
while (1) {
    my @connections = $selector->can_read();
    foreach $sock (@connections) {
        if ((my $pid = fork) == 0) {
            my $newsock = $sock->accept();
            if (not defined $newsock) {
                exit;
            }
            my $peerPort = $newsock->peerport();
            my $peerIP = inet_ntoa($newsock->peeraddr());
            $peerIP =~ m/^(\d{1,3})\.(\d{1,3})\.(\d{1,3})\.(\d{1,3})$/;
            my $blacklisted = 0;
            foreach my $RBL (@RBLS) {
                $lookup = "$4.$3.$2.$1.$RBL";
                my $result = gethostbyname($lookup);
                if (defined $result) {
                    $blacklisted = 1;
                    next;
                }
            }
            if ($blacklisted == 0) {
                $newsock->close;
                exit; # peer is not blacklisted, 
            }
            my $hsn = `/bin/hostname`;
            chop $hsn;
            print $newsock "220 $hsn SMTP Sendmail 8.13.1/8.13.1 " .
                `/bin/date`;
            sub GRAND_CHILD_REAPER {
                1 unless (waitpid(-1, WNOHANG) == -1);
                $newsock->close;
                exit;
            }
            local $SIG{CHLD} = \&GRAND_CHILD_REAPER;
            local $timerpid;
            if (($timerpid = fork) == 0) {
                sleep $timeout;
                $newsock->close;
                exit;
            }
            while (<$newsock>) {
            }
            $newsock->close;
            my $ret = kill 9, $timerpid;
            $ret = waitpid $timerpid, WNOHANG;
            exit;
        }
    }
}
exit;