SMTP Honeypot (Perl)

Ich habe einen SMTP Honeypot in Perl geschrieben.
Zweck des SMTP Honeypot (email Honeypot) ist es, einen offenen SMTP Server (Open Relay) zu simulieren. Wenn ein Spammer auf den Honeypot zugreift denkt er, er sei bei einem offenen SMTP Server gelandet und fängt an Spam zu über ihn senden. In Wirklichkeit kommt jedoch keines seiner Mails an. Das Perl Script logt jede Aktivität in einem Logfile und generiert ein ‘blacklist’-File (blacklist.txt) mit den IP-Adressen, welche auf den Honeypot zugegriffen haben.
Der SMTP Honeypot läuft auf Windows sowie auch auf Linux/Unix. Falls du jedoch Linux/Unix verwendest, musst du den Logfile Pfad ändern!

Der SMTP Honeypot der bei mir zuhause läuft hab ich so programmiert, dass er jede Verbindung in eine Datenbank rein schreibt. Das Logfile kannst du hier anschauen (Realtime): www.abuse.ch/honey/list.php

Das Perl Script kannst du hier downloaden

#!/usr/local/bin/perl
#!c:\perl\bin\perl.exe

# SMTP Honeypot
# (c) 2007 – admin at abuse.ch
# Version 1.2 – DATE: FEB 9th 2007

use Socket;
use strict;

# Port on which the service will be run
my $port = 25;

# The name of the hostname you want to simulate eg. mail.fbi.gov
my $host = “mail.uno.org”;

# SMTP-Daemon Version
my $smtpver = “Sendmail 8.14.0″;

# Get the protocol nr. of TCP
my $tcp = getprotobyname(‘tcp’);

# Path to Logfile
my $logfile = ‘C:/smtp_honeypot.log’;

# Path to Blacklist
my $blacklist = ‘C:/blacklist.txt’;

# Define variables
my $lastline;
my $ipaddress;

# Create a socket at $port with protocol $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”);

# Display a message that the server is now running
logmsg (“SMTP server started on port “, $port, “\n\n”);

# Save to Logfile START
open (DATA, “+>>$logfile”) or die “can’t open $logfile $!”;
print DATA “\n\n\n”, scalar (localtime), “: SMTP server started on “, $port, “\n”;
close (DATA);
# Save to Logfile END

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”);
# Save to Logfile START
open (DATA, “+>>$logfile”) or die “can’t open $logfile $!”;
print DATA “\n\n”, scalar (localtime), “: “, join(“.”, @inetaddr), “: incomming conection\n”;
close (DATA);
# Save to Logfile END

# Save to blacklist.txt START
open (DATA, “+>>$blacklist”) or die “can’t open $blacklist $!”;
print DATA join(“.”, @inetaddr), “\n”;
close (DATA);
# Save to blacklist.txt END

# Save to blacklist.txt START
my $ipaddr = join(“.”, @inetaddr);
my $host = gethostbyaddr($ipaddr, AF_INET);
open (DATA, “+>>$blacklist”) or die “can’t open $blacklist $!”;
print DATA “$host \n”;
close (DATA);
# Save to blacklist.txt END

&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 = ;

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 \”.\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 ”) {
# Save to Logfile START
open (DATA, “+>>$logfile”) or die “can’t open $logfile $!”;
print DATA scalar (localtime), “: “, join(“.”, @inetaddr), “: helo $commands[1]\n”;
close (DATA);
# Save to Logfile END

next;

} elsif ($commands[0] =~ /^HELO$/i) {

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$/i) {

print ($smtphash{$commands[0]});
sleep 1;
# Save to Logfile START
open (DATA, “+>>$logfile”) or die “can’t open $logfile $!”;
print DATA scalar (localtime), “: “, join(“.”, @inetaddr), “: $commands[0]\n”;
close (DATA);
# Save to Logfile END

} elsif ($commands[0] =~ /^EHLO$/i) {

if($commands[1] eq ”) {

print ($smtphash{EHLOOUT});

} else {

print ($smtphash{HELOIN});
print ($smtphash{EHLO});
$saidhelo = 1;
}

} elsif ($commands[0] =~ /^QUIT$/i) {

print $smtphash{QUIT};
# Save to Logfile START
open (DATA, “+>>$logfile”) or die “can’t open $logfile $!”;
print DATA scalar (localtime), “: “, join(“.”, @inetaddr), “: Quit\n”;
close (DATA);
# Save to Logfile END

return;

} elsif ($commands[0] =~ /^MAIL$/i) {

$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:/i) {

if ($commands[2] =~ /\@/ || $commands[1] =~ /\@/) {

$saidmail = 1;
$smtphash{MAILTO} =~ s/MAILDATA/$maildata/g;
print ($smtphash{MAILTO});
# Save to Logfile START
open (DATA, “+>>$logfile”) or die “can’t open $logfile $!”;
print DATA scalar (localtime), “: “, join(“.”, @inetaddr), “: MAIL FROM: $commands[2]\n”;
close (DATA);
# Save to Logfile END

} else {

$smtphash{MAILFROM} =~ s/MAILDATA/$maildata/g;
print ($smtphash{MAILFROM});
# Save to Logfile START
open (DATA, “+>>$logfile”) or die “can’t open $logfile $!”;
print DATA scalar (localtime), “: “, join(“.”, @inetaddr), “: ERROR ‘Mail $commands[1] $commands[2]‘\n”;
close (DATA);
# Save to Logfile END
}

} elsif ($saidhelo == 1) {

print ($smtphash{MAIL});
}

} elsif ($commands[0] =~ /^RCPT$/i) {

$maildata = $commands[2];
# Save to Logfile START
open (DATA, “+>>$logfile”) or die “can’t open $logfile $!”;
print DATA scalar (localtime), “: “, join(“.”, @inetaddr), “: RCPT TO: $commands[2]\n”;
close (DATA);
# Save to Logfile END

# if ($commands[1] =~ m@.*to:<(.*)>@i || $commands[2] =~ m@<(.*)>@ ) {
if ($commands[1] =~ /to:<(.*?)>/i || $commands[2] =~ /<(.*?)>/ ) {

$maildata = $1;

}

if ($saidmail == 0) {

print ($smtphash{BADRCPT});
# Save to Logfile START
open (DATA, “+>>$logfile”) or die “can’t open $logfile $!”;
print DATA scalar (localtime), “: “, join(“.”, @inetaddr), “: ERROR ‘Mail $commands[1] $commands[2]‘\n”;
close (DATA);
# Save to Logfile END

} 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$/i) {

if ($saidmail == 1) {

print ($smtphash{DATA});

while () {
# Save to Logfile START
open (DATA, “+>>$logfile”) or die “can’t open $logfile $!”;
chomp ($lastline = $_);
print DATA scalar (localtime), “: “, join(“.”, @inetaddr), “: DATA $lastline\n”;
close (DATA);
# Save to Logfile END
last if /^\.\x0d$/;
}

print ($smtphash{DATAsent});

} else {

print ($smtphash{DATAERR});

}

} else {

print ($smtphash{ERR});
# Save to Logfile START
open (DATA, “+>>$logfile”) or die “can’t open $logfile $!”;
print DATA scalar (localtime), “: “, join(“.”, @inetaddr), “: ERROR ‘$commands[1] $commands[2]‘\n”;
close (DATA);
# Save to Logfile END

}

}

}

0 Responses to “SMTP Honeypot (Perl)”


  • No Comments

Leave a Reply




economics-recluse
Scene
Urgent!