#!/usr/bin/perl


#         	+-------------------------------------+
# 		| Multi-Protocol Honeypot (MPH v0.1)  |
#		|-------------------------------------|
# 		| A feeble attempt at doing something |
# 		| constructive with my time.	      |
#		|-------------------------------------|
#		| ---	By: k0pp | SABS Coding	  --- |
#		| --  irc.system-abuse.net:+6697   -- |
#		+-------------------------------------+


use warnings;
#use strict qw(vars);

use IO::Socket;
use Net::hostent;
use Term::ANSIColor;
use DBI::Mysqlsimple;
use Data::Dumper;
local $Data::Dumper::Purity = 1;
my %config = (
		"ftp"		=> 21,
		"ssh"		=> 22,
		"telnet"	=> 23,
		"VNC"		=> 5900,
		"mysql_user"	=> '*********',
		"mysql_pass"	=> '*************',
		"mysql_db"	=> 'honey',
		"verbosity"	=> 1,
);

my $db = DBI::Mysqlsimple->new($config{mysql_db},'127.0.0.1',$config{mysql_user},$config{mysql_pass});
my $telnet = IO::Socket::INET->new( 	LocalAddr	=> 'localhost',
					Proto     	=> 'tcp',
                                 	LocalPort 	=> $config{telnet},
                                 	Listen    	=> 1,
	                                Reuse     	=> 1,
);
die("Cant start TELNET daemon.. $$") unless $telnet;

print "[TELNET honeypot waiting for connections...]\n";
my ($aut, $pat) = '';
while ($telnet = $telnet->accept()) {
	$telnet->autoflush(1);
	print $telnet "\n\nUser Access Verification\n\n";
	my $hostinfo = gethostbyaddr($telnet->peeraddr);
	fprintf $telnet,"Hi %s\n",$hostinfo;
	print $telnet "Username: ";
	$uat = <$telnet>;
	chomp $uat;
	if($uat =~ /([a-z]+)/i){$uat = $1;}
	print $telnet "\nOk.\n\nPassword: ";
	$pat = <$telnet>;
	chomp $pat;
	if($pat =~ /([a-z]+)/i){$pat = $1;} else { print "Pat fucked up..\n $pat\n\n";}
	print $telnet "\nWelcome\n\nCommand: ";
	while (my $body = <$telnet>) {
		chomp $body;
		#if($body =~ /([a-z\s]+)/i){$body = $1;print "BODY: $body ------------\n";}
		#telog($telnet->peerhost,"USA",$uat,$pat,$body);
	        $db->do("INSERT INTO telnet (IP,country,user,pass,command) VALUES (?,?,?,?,?)", [$telnet->peeraddr,'usa',$uat,$pat,$body]);
	        print "While: INSERT INTO telnet (IP,country,user,pass,command) VALUES (?,?,?,?,?), ['honkey','USA',$uat,$pat,$body])\n";
		printf "\n\nPrintf %s USA $uat $pat $body\n\n", $telnet->peeraddr;
		print $telnet "$body is not a recognized command\n";
		print $telnet "Command: ";
	}
	close $telnet;
}
$db->disconnect;
sub telog {
	my ($ip,$country,$user,$pass,$command) = @_;
        $db->do("INSERT INTO telnet (IP,country,user,pass,command) VALUES (?,?,?,?,?)", [$ip,$country,$user,$pass,$command]);
        print "INSERT INTO telnet (IP,country,user,pass,command) VALUES (?,?,?,?,?), [$ip,$country,$user,$pass,$command])\n";

	if($config{verbosity} == 1){
		print color 'bold red';
#		print "$_ " for @_;
		print color 'reset';
	}
}