#!/usr/local/bin/perl -w
#!c:\perl\bin\perl.exe -w
# Created by hackmen and weazy at Interz0ne '02
# Released by Cybnet Security Group as freeware
#
# Date Last Modified: 10/15/2002 1437
#
# Abstract: Simulates and SMTP server in order to catch crackers and spammers.
# Notes for future development:
# need to add comments
# modularize the prog to accept unique SMTP distro specs to allow easy emulation
# create IP masquerading to simulate an entire network from the same prog
#
# legalz: modify and use at will, if you make any changes, improvements, updates or use the code
# in another project, please send us what you did and give credit
# if you have any questions, post them at forum.hackerthreads.net
# be sure to check out hackerthreads.org for updates and new tutorials/downloads
# Alter $host = to whatever hostname you want to simulate
use strict;
use Socket;
my $port = 25;
my $host = "admin.secure.fbi.gov";
my $smtpver = "Sendmail 8.11.3";
my $tcp = getprotobyname('tcp');
socket(Server, PF_INET, SOCK_STREAM, $tcp) or die "socket: $!";
setsockopt(Server, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or die "setsockopt: $!";
bind(Server, sockaddr_in($port, INADDR_ANY)) or die "bind: $!";
listen(Server,SOMAXCONN) or die "listen: $!";
print STDERR ("\n");
logmsg ("server started on port ", $port, "\n\n");
my ( $addr,
@inetaddr
);
my $old_handle = select Client;
$| =1;
select $old_handle;
*STDOUT = *Client;
*STDIN = *Client;
while (1) {
$addr = accept(Client,Server);
my(undef, undef, $inetaddr) = unpack('S n a4 x8', $addr);
@inetaddr = unpack('C4', $inetaddr);
print STDERR ("\n\n");
logmsg ("incoming connection from: ", join(".", @inetaddr), "\n");
&READ ();
}
close Client;
sub logmsg {
print STDERR (scalar (localtime), ": ", $$, ": ", @_);
}
sub READ {
my $saidhelo = 0;
my $saidmail = 0;
my $maildata;
print ("220 ", $host, ' ', $smtpver, ' ', scalar (localtime), "\r\n");
while (1) {
my $commands = <STDIN>;
if (!defined ($commands)) {
return;
}
$commands =~ s/[\r\n]+|\s+$//g;
my @commands = split (/\s+/, $commands);
logmsg ($commands, "\n");
if (!defined $commands[1]) {
$commands[1] = '';
}
if (!defined $commands[2]) {
$commands[2] = '';
}
my %smtphash = ( AUTH => "503 AUTH mechanism not available.\x0d\x0a",
BADRCPT => "503 5.0.0 Need MAIL before RCPT\x0d\x0a",
BADHELO => "503 5.0.0 Polite people say HELO first\x0d\x0a",
DATA => "354 Enter mail, end with \"\.\" on a line by itself\x0d\x0a",
DATAerr => "503 5.0.0 Need MAIL command\x0d\x0a",
DATAsent => "250 2.0.0 g8684xUD014698 Message accepted for delivery\x0d\x0a",
EHLOOUT => "501 5.0.0 HELO requires domain address.\x0d\x0a",
ERR => "500 5.5.1 Command unrecognized: $commands\x0d\x0a",
ETRN => "500 5.5.2 Parameter required\x0d\x0a",
EXPN => "502 5.7.0 Sorry, we do not allow this operation.\x0d\x0a",
HELOERR => "501 5.0.0 Invalid domain name\x0d\x0a",
HELOOUT => "501 5.0.0 HELO requires domain address.\x0d\x0a",
HELOIN => "250 $host Hello $commands[1], pleased to meet you.\x0d\x0a",
MAILFROM => "553 5.5.4 MAILDATA... Domain name required for sender address MAILDATA\x0d\x0a",
MAILTO => "250 2.1.0 MAILDATA... Sender ok\x0d\x0a",
MAIL => "501 5.5.2 Syntax error in parameters scanning \"$commands[1]\"\x0d\x0a",
NOOP => "250 2.0.0 OK.\x0d\x0a",
QUIT => "220 2.0.0 $host closing connection..\x0d\x0a",
RCPTTO => "250 2.1.5 $commands[2]... Recipient ok\x0d\x0a",
RESET => "250 2.0.0 Reset state.\x0d\x0a",
RSET => "250 2.0.0 Reset state\x0d\x0a",
STARTTLS => "454 4.3.3 TLS not available after start..\x0d\x0a",
VRFY => "252 2.5.2 Cannot VRFY user; try RCPT to attempt delivery (or try finger).\x0d\x0a",
HELP => "214-2.0.0 Sendmail v8.4.3\x0d\x0a214-2.0.0 Topics:\x0d\x0a214-2.0.0 HELO EHLO MAIL RCPT DATA\x0d\x0a214-2.0.0 RSET NOOP QUIT HELP VRFY\x0d\x0a214-2.0.0 EXPN VERB ETRN DSN AUTH\x0d\x0a214-2.0.0 STARTTLS\x0d\x0a214-2.0.0 For more info use \"HELP <topic>\".\x0d\x0a214-2.0.0 For local information send email to Postmaster at your site.\x0d\x0a214 2.0.0 End of HELP info.\x0d\x0a",
EHLO => "250-ENHANCEDSTATUSCODES\x0d\x0a250-8BITMIME\x0d\x0a250-SIZE\x0d\x0a250-DSN\x0d\x0a250-ONEX\x0d\x0a250-ETRN\x0d\x0a250-XUSR\x0d\x0a250 HELP\x0d\x0a",
);
if (!defined ($commands[0]) or $commands[0] eq '') {
next;
} elsif ($commands[0] =~ /^HELO$/) {
if($commands[1] eq '') {
print ($smtphash{HELOOUT});
} elsif ($commands[1] =~ /[\!\@\#\$\%\^&\*\(\)\|\\,>?\/\"\':;\{\}]/) {
print $smtphash{HELOERR};
} else {
print $smtphash{HELOIN};
$saidhelo = 1;
}
} elsif ($commands[0] =~ /^HELP$|^RESET$|^NOOP$|^AUTH$|^STARTTLS$|^VRFY$|^EXPN$|^ETRN$|^RSET$/) {
print ($smtphash{$commands[0]});
sleep 1;
} elsif ($commands[0] =~ /^EHLO$/) {
if($commands[1] eq '') {
print ($smtphash{EHLOOUT});
} else {
print ($smtphash{HELOIN});
print ($smtphash{EHLO});
$saidhelo = 1;
}
} elsif ($commands[0] =~ /^QUIT$/) {
print $smtphash{QUIT};
return;
} elsif ($commands[0] =~ /^MAIL$/) {
$maildata = $commands[2];
if ($commands[2] eq '') {
$maildata = $commands[1];
if ($commands[1] =~ m@.*from:<(.*)>@i) {
$maildata = $1;
}
}
if ($saidhelo == 0) {
print $smtphash{BADHELO};
# Is there a space after from:
} elsif ($commands[1] =~ /from:/) {
if ($commands[2] =~ /\@/ || $commands[1] =~ /\@/) {
$saidmail = 1;
$smtphash{MAILTO} =~ s/MAILDATA/$maildata/g;
print ($smtphash{MAILTO});
} else {
$smtphash{MAILFROM} =~ s/MAILDATA/$maildata/g;
print ($smtphash{MAILFROM});
}
} elsif ($saidhelo == 1) {
print ($smtphash{MAIL});
}
} elsif ($commands[0] =~ /^RCPT$/) {
$maildata = $commands[2];
if ($commands[1] =~ /to:<(.*?)>/i || $commands[2] =~ /<(.*?)>/ ) {
$maildata = $1;
}
if ($saidmail == 0) {
print ($smtphash{BADRCPT});
} else {
# Is there a space after to:
if ($commands[1] =~ /to:/ && $maildata ne '') {
print ("250 2.1.5 $maildata... Recipient ok\x0d\x0a");
} else {
print ($smtphash{MAIL});
}
}
} elsif ($commands[0] =~ /^DATA$/) {
if ($saidmail == 1) {
print ($smtphash{DATA});
while (<STDIN>) {
last if /^\.\x0d$/;
}
print ($smtphash{DATAsent});
} else {
print ($smtphash{DATAERR});
}
} else {
print ($smtphash{ERR});
}
}
}