#!/usr/bin/perl -w
#prime from http://primes.utm.edu/primes/lists/all.txt

use lib "./blib/lib";
use lib "/sq/lib";
use strict;
use warnings;
use Crypt::CBC;
use Getopt::Long;
use Net::OSCAR qw(:standard);
use IO::Poll;
use Math::BigInt lib => 'GMP';
eval {
	require Data::Dumper;
};
use vars qw($toggle $cipher $key $gen $syn $pid $oscar $password %fdmap $poll $X $Y $x $g $n $x_digits $K);

$syn=0; #Y was received --synchronization complete
$gen=0; #X was sent
$key=0; #key was generated
$toggle=0;
$x_digits=200;
my $readline = 0;
eval {
	require Term::ReadLine;
};
if($@) {
	warn "Couldn't load Term::ReadLine -- omitting readline support: $@\n";
} else {
	$readline = 1;
}

$| = 1; 

sub genkey() {
	print STDERR "Generating key...";
	$K=Math::BigInt->new($Y);
	$K=$K->bmodpow($x,$n);
	$key=1;
	my $md5 = Digest::MD5->new;
	$md5->add($K);
	$cipher = new Crypt::CBC ($md5->digest, 'Blowfish');
	print STDERR "OK!\nFurther messages will be encrypted!\n";
}


sub gen() {
	print STDERR "Generating X...";
	$n = Math::BigInt->new('11');
	$n->bpow('1101');
	$n->badd('4264768249680'); #n is a very large prime, >300digits
	$g=Math::BigInt->new('2'); #g is a primitive mod n
				   #currently using 2, should be a number
				   #with at least 100 digits
	$x = Math::BigInt->new('0'x$x_digits);
	my $i=0;
	for(;$i<$x_digits;$i++) {
		my $rnd=int(rand(255)); #should modify to use Crypt::Random
					#which is an interface to /dev/random
		$x->bior($rnd);
		$x->blsft(8);
	}
	$X=Math::BigInt->new($g);
	$X=$X->bmodpow($x,$n);
	$gen=1;
	print STDERR "OK!\n";
}

sub sendX($) {
	my($who) = shift;
	if($gen==0) {
		gen(); 
		print STDERR "Sending X to $who...\n";
		my $msg= "_syn_x_$X";
		my $ret = $oscar->send_im($who,$msg);
	} else {
		print STDERR "X already sent.\n";
	}
}

sub error($$$$$) {
	my($oscar, $connection, $errno, $error, $fatal) = @_;
	if($fatal) {
		die "Fatal error $errno in ".$connection->{description}.": $error\n";
	} else {
		print STDERR "Error $errno: $error\n";
	}
}

sub signon_done($) {
	my $oscar = shift;
	print STDERR "Signed on done!\n";
}

sub rate_alert($$$) {
	my($oscar, $level, $clear, $window) = @_;

	$clear /= 1000;
	print STDERR "We received a level $level rate alert.  Wait for about $clear seconds.\n";
}

sub im_in($$$) {
	shift;
	my($who, $what, $away) = @_;
	if($away) {
		$away = "[AWAY] ";
	} else {
		$away = "";
	}
	$what=~ s/<(.|\n)+?>//g;
	if($what=~m/_syn_x_/) {
		if($syn==0) {
			print STDERR "Received Y!\n";
			$what=~s/_syn_x_//;
			$Y=Math::BigInt->new($what);
			if($gen==0) {
				sendX($who);
			}
			$syn=1;
			genkey();
		} else {
			print STDERR "Y was already received.\n";
		}
	} else {
		if($key==1) {
			if($toggle==1) { 
				print STDERR "$who: $what\n";
			}
			$what=$cipher->decrypt($what);
		}
		print "$who: $away$what\n";
	}
}


sub auth_challenge($$$) {
	my($oscar, $challenge, $hashstr) = @_;
	my $md5 = Digest::MD5->new;
	$md5->add($challenge);
	$md5->add(md5($password));
	$md5->add($hashstr);
	$oscar->auth_response($md5->digest, 5.5);
}

sub im_ok($$$) {
	my($oscar, $to, $reqid) = @_;
	print STDERR "Your message, $reqid, was sent to $to.\n";
}
sub connection_changed($$$) {
	my($oscar, $connection, $status) = @_;

	my $h = $connection->get_filehandle();
	return unless $h;
	my $mask = 0;

	if($status eq "deleted") {
		delete $fdmap{fileno($h)};
	} else {
		$fdmap{fileno($h)} = $connection;
		if($status eq "read") {
			$mask = POLLIN;
		} elsif($status eq "write") {
			$mask = POLLOUT;
		} elsif($status eq "readwrite") {
			$mask = POLLIN | POLLOUT;
		}
	}

	$poll->mask($h => $mask);
}


my $screenname = undef;
my $password = undef;
if(!GetOptions(
	"u|screenname=s" => \$screenname,
	"p|password=s" => \$password,
) or @ARGV) {
	die "Usage: $0 [--screenname S] [--password P]\n";
}

if(!defined($screenname)) {
	print "Screenname: ";
	$screenname = <STDIN>;
	chomp $screenname;
}
if(!defined($password)) {
	print "Password: ";
	system("stty -echo");
	$password = <STDIN>;
	system("stty echo");
	print "\n";
	chomp $password;
}


$poll = IO::Poll->new();
$poll->mask(STDIN => POLLIN);

$oscar = Net::OSCAR->new();
$oscar->set_callback_error(\&error);
$oscar->set_callback_im_in(\&im_in);
$oscar->set_callback_signon_done(\&signon_done);
$oscar->set_callback_auth_challenge(\&auth_challenge);
$oscar->set_callback_im_ok(\&im_ok);
$oscar->set_callback_connection_changed(\&connection_changed);

my %so_opts;
%so_opts = (screenname => $screenname, password => $password, local_port => 5190);
#hope that eve is sniffing traffic on this port

$oscar->signon(%so_opts);

my $inline = "";
my $inchar = "";
while(1) {
	next unless $poll->poll();

	my $got_stdin = 0;
	my @handles = $poll->handles(POLLIN | POLLOUT | POLLHUP | POLLERR | POLLNVAL);
	foreach my $handle (@handles) {
		if(fileno($handle) == fileno(STDIN)) {
			$got_stdin = 1;
		} else {
			my($read, $write, $error) = (0, 0, 0);
			my $events = $poll->events($handle);
			$read = 1 if $events & POLLIN;
			$write = 1 if $events & POLLOUT;
			$error = 1 if $events & (POLLNVAL | POLLERR | POLLHUP);

			$fdmap{fileno($handle)}->process_one($read, $write, $error);
		}
	}
	next unless $got_stdin;

	sysread(STDIN, $inchar, 1);
	if($inchar eq "\n") {
		my($cmd, @params) = split(/[ \t]+/, $inline);
		$inchar = "";
		$inline = "";
		$cmd ||= "";
		if($cmd eq "help" or $cmd eq "?") {
			print <<EOF
snazzy  [--screenname -S username] [-password -P password]
----------------------------------------------------------
COMMANDS:
[send s S] <screenname> <message> - send screenname message
[sendX x X] <screenname> - generate and sed X to screenname
			   start syncronization process
[key] - print your symmetric key
[e] - toggle show encrypted text along with decrypted text.
[help ?] - print this
[signoff quit exit q] - quit session
----------------------------------------------------------

The idea of this program is to implement the Diffie-Hellman
key exchange and encrypt a conversation between Alice and
Bob over an insecure channel. The advantage of using the 
Net::OSCAR module rathern than writing a basic tcp/ip 
messenger is that the exchange is guaranteed to be between
A and B, since they authenticate themselves through AIM.

Since this is just a proof of concept the implementation 
limits the implementation of securing a channel between
A and B and not also A and C. But to do so would not require
much more effort.

This program is a stripped down and heavily modified GNU GPL2
oscartest $Net::OSCAR::VERSION written by Matthew Sachs and 
included as part of the Net::OSCAR module.

Written by Deian Stefan - stefan (at) cooper (dot) edu.

Feel free to use the code for whatever you wish.

EOF
		} elsif($cmd eq "signoff" or $cmd eq "quit" or $cmd eq "exit" or $cmd eq "q") {
			exit;
		} elsif($cmd eq "send" or $cmd eq "s" or $cmd eq "S") {
			my($who) = shift @params;
			my($msg)=join(" ", @params);
			if($key==1) {
				$msg=$cipher->encrypt($msg);
			}
			my $ret = $oscar->send_im($who,$msg);
			#print "Sending IM $ret to $who...\n";
		} elsif($cmd eq "key") {
			print "Your key is...\n";
			my $l="-----------------------------------------------";
			print "Key:\n$l\n$K\n$l\n";
		} elsif($cmd eq "sendX" or $cmd eq "X" or $cmd eq "x") {
			my($who) = shift @params;
			sendX($who);
		}elsif($cmd eq "e") {
			if($toggle==0) {
				$toggle=1;
				print "You  will now see the encrypted text also.\n";
			}else {
				$toggle=0;
				print "You  will no longer see the encrypted text.\n";
			}

		}elsif($cmd eq "") {
		} else {
			print "Invalid command.\n";
		}
	}
	else {
			$inline .= $inchar;
		}
}