\author{Simon Cozens}
\title{IRC Multiplexing Proxy}


@* IRC Multiplexing Proxy.

This project allows multiple clients to be masqueraded as a single nick to
an IRC server. This allows those connecting from several hosts or environments
to present a single face to IRC. The proxy will also be extensible, allowing
client-side alias and function operations.

@p
print "This is IRCProxy, version 1.0.0\n";

@ 
This code uses standard Perl libraries alone. The socket/select libraries
are used as an OO interface to socket connections.

@<Requirements@>=
use IO::Socket;
use IO::Select;

@ Here are some global variables; the listening port, the connection password,
the server to connect to, the external nick and ircname.

@<Global Variables@>=
$listenport=6680;
$password='furrfu';
$server='nexus.cipe';
$extnick='Burble';
$extname='Does this work?';
$username='simon';
$debug=1;

chomp($hostname=`hostname`);
$initial_mode='+iw';
my @@clients,@@channels;


@* Initialisation.

Here we deal with the setting up and starting off of the connections.
Firstly we open out our listening socket and the destination socket.

@<Open Static Sockets@>=
$listen_sock = new IO::Socket::INET   (LocalAddr => 'localhost',
                                      LocalPort => "$listenport",
                                      Listen    => 5,
                                      Proto     => 'tcp',
                                      Reuse     => 1
                                      )
    or die "! Could not create listening socket\n$!\n";

$server_sock = new IO::Socket::INET  (PeerAddr => $server,	
                                     PeerPort => 6667,
                                     Proto    => 'tcp'
				     ) 
    or die "! Could not connect to remote server\n$!\n";


@ Shit. Now I need to think. We do both input and output on both client and
server sockets. Hence, |$server_sock| needs to be |select()|ed all the time.
We also need to listen for connections to ourself.

@<Initialise Select@>=
$read_select=new IO::Select($listen_sock,$server_sock);
$write_select=new IO::Select($server_sock);

@ When we connect to the server, we need to do a certain amount of IRC magic.
We register, and attempt to set our mode. While we make this attempt, we save
all the messages from the server so we can feed them to each connecting client,
making us look like the server. Good idea, huh? 

@<Register with server@>=
print $server_sock "\n";
print $server_sock "NICK $extnick\n";
print $server_sock "USER $username $hostname $server :$extname\n";
print "USER $username $hostname $server :$extname\n";
$saved_motd='';
print "Getting MOTD...\n";
until (($_=<$server_sock>)=~ /^:(.*) 376 $extnick .*/) {
	if ($_=~/^PING(.*)/) {
		print $server_sock "PONG$1\n";
	} else { 
		$saved_motd.=$_;
	}
} 
print $saved_motd;
($server) = $saved_motd=~/^:(.*) 001/;
print "Setting Mode...\n";
print $server_sock "MODE $extnick :$initial_mode\n";
until (<$server_sock>=~ /MODE/) {};
print "Connection to $server made.\n";


@ General useful function. Allows us to look like the server when sending 
messages to the client.

@p
sub serv_spoof {
	($outsock,$message)=(shift,shift);
	print $outsock ":$server ".$message."\n";
}
	

@* Input phase. 

In this section, we deal with all the material coming into the proxy,
whether it be a new connection, a client or the server sending us data.

This is the rough skeleton of the input phase.

@<Input Phase@>=
foreach $sock (@@$readable_socks) {
	if ($sock == $listen_sock) {
		@<Register a new client@>
	} elsif ($sock == $server_sock) {
		@<Deal with incoming server material@>
	} else {
		if ($authenticated{$sock}<3) {
			@<Authenticate client@>
		} else {
			@<Deal with incoming client material@>
		}
	}
}

@ Every time a new client connects, it needs to be added to the list of
things to read and write from. We also want the fucker to authenticate
before doing anything else.

@<Register a new client@>=
print "New connection.\n";
$this_connect=scalar($listen_sock->accept());
push @@clients, $this_connect;
$authenticated{$this_connect}=0;
$read_select->add($this_connect);
$write_select->add($this_connect);

@ When we get material in from the server, we need to decide how much
of it to pass on, and to which sockets.

@ Here we attempt the authentication by comparing a password request to
the specified password; easy, really.

@<Authenticate client@>=
if ($authenticated{$sock}==0) {
	$nicked=$usered=0;
        until ($nicked and $usered) {
		$_=<$sock>;
		chomp;
		print $_ if $debug;
		if (/NICK (.*)/i) {
			$nicked=1;
			/NICK (.*)\s+/i;
			print "- Nick ($1) given.\n" if $debug;
			$nicks{$sock}=$mynick=$1;
		} elsif (/USER/i) {
			$usered=1;
			print "- User Given\n" if $debug;
		} else {
			print "- Unknown\n" if $debug;
		}
	}	
	print $sock $saved_motd;
	print "Client Registered.\n" if $debug;
	$authenticated{$sock}=2;
} 
if ($authenticated{$sock} ==2) {
	if (($_=<$sock>) =~ /PASS \Q$password\E/i)  {
		$authenticated{$sock}=3;
		print $sock "NOTICE ".$nicks{$sock}." :Authenticated successfully.\n";
		print "Authenticated.\n" if $debug;
	} elsif (($_=<$sock>)=~/MODE $mynick (.*)/i) {
		print "Client asserted mode $1\n" if $debug;
		print $sock ":$mynick MODE $mynick $initial_mode\n";
		print $sock "NOTICE ".$nicks{$sock}." :Please authenticate to the proxy.\n";
	} else {
		print $sock "NOTICE ".$nicks{$sock}." :Please authenticate to the proxy.\n";
		serv_spoof($sock,"464 :Password incorrect (/PASS First)"); 
		next;
	}
}

@ I can't put it off any longer. We've got to deal with real input and output.
At the moment, we're doing nothing interesting. We'll add in more filters as
time goes by.

@<Deal with incoming client material@>=
	$_=<$sock>;
	if (1==0) { } @{ There is a reason for that @}
	@<Client pings@>
	@<Joining channels@>
	@<Parting channels@>
	@<WHO command@>
	$to_server.=$_;

@ Likewise.

@<Deal with incoming server material@>=
	$srv_in=<$sock>;
	print $sock "PONG$1\n" if $srv_in=~/^PING.*/;
	$to_clients.=$srv_in unless $srv_in=~ /^P.NG/;

@* Input filters.

Here we react to what is being said to us.

@<Joining channels@>=
elsif (/JOIN (#.*)/) {
	$chan=$1;
	chop($chan);
	chop($chan);
	if (exists $channels{$chan}) {
		print "Other client joined $chan\n" if $debug;
	} else {
		print "Joining new channel ($chan)\n" if $debug;
		print $server_sock $_;
		$channels{$chan}=<$server_sock>;
	}
	print "Replying :\n $channels{$chan}" if $debug;
	print $sock $channels{$chan};
	$_=""; @{ Swallow it @}
}

@ 

@<Parting channels@>=
elsif (/PART (#.*?)\s.*/) {
	if (exists $channels{$1}) {
		delete $channels{$1};
		print "We've left $1\n" if $debug;
	} else {
		print "Parting $1, which we're not on.\n" if $debug;
		$_=""; @{ Swallow it @}
	}
}

@ 

@<Client pings@>=
elsif (/^P.NG(.*)/) {
	print $sock "PONG$1\n" if $cli_in=~/^PING.*/;
	$_="";
}

@ 

@<WHO command@>=
elsif (/WHO/) {
	print "Replying to a WHO:\n$_";
	print $server_sock $_;
	print $sock ($foo=<$server_sock>) until $foo=~/315/;
	$_="";
}

@* Output Phase.

This section is so simplistic it's moronic, but it's here for symmetry.
@<Output Phase@>=
	@<Output to server@>
	@<Output to clients@>

@ 
@<Output to server@>=
print $server_sock $to_server if $to_server;
print "->SRV $to_server" if $debug and $to_server;
undef $to_server;

@ 
@<Output to clients@>=
if ($to_clients) {
	foreach (@@clients) { print $_ $to_clients;
		print "->$_ $to_clients";
		} 
}
undef $to_clients;

@ This gets stuck here because there's nowhere else for it.

@<Ping-Pong@>=
	print $server_sock "PING $server\n"  unless $readable_socks or $writeable_socks;

@* Main Program.

This is where we put all the pieces together. {\tt ircproxy} starts and
ends here.

@p
@<Requirements@>
@<Global Variables@>
@<Open Static Sockets@>
@<Register with server@>
@<Initialise Select@>
while (1) {
	@<Iterate the Main Loop@>
}

@ And here is that all-important loop.

@<Iterate the Main Loop@>=
($readable_socks, $writable_socks) =
IO::Select->select($read_select, $write_select, undef, 2);

@<Input Phase@>
@<Output Phase@>
@<Ping-Pong@>