#!/usr/bin/perl -wT

#
#     Copyright (c) 2006 Thomas Liske <thomas@fiasko.dyndns.org>
#
#     You may distribute under the terms of the GNU General Public License.
#
#     http://fiasko.dyndns.org/~thomas/2006/TeamTapper/
#

use Net::Pcap;
use IO::Socket;
use IO::Select;
use String::CRC32;
use strict;

########################[ BEGIN CONFIG    ]########################
## TS2 server where to send the intercepted packages,
my $feed_host = '10.0.0.21';	# host
my $feed_port = '8767';		# port
#my $feed_alias = 'TeamTapper';	# nick
my $feed_registered = 0;	# TRUE to use login data
my $feed_user = '';		# login user
my $feed_passwd = '';		# login password

## TS2 server to sniff for
my $sniff_host = '10.0.0.201';	# host IP
my $sniff_port = '8767';	# port

my $sniff_dev;			# network device to sniff on
my $sniff_dump;			# tcpdump file for offline playback

## !!! WARNING !!!
# At least on Debian Sarge, Net::Pcap uses libpcap0.7, which
# might kill ANY network communication if promiscuous is
# disabled. So only try $promisc = 0 if you have local
# access to the host running TeamTapper!
#
# More info:
# http://bugs.debian.org/cgi-bin/bugreport.cgi?bug=301249
#
my $promisc = 1;
########################[ END CONFIG      ]########################

########################[ BEGIN CHANGELOG ]########################
#
# 0.3:                            Thu, 06 Apr 2006 00:02:48 +0200
#   - join the feeded server for each tapped connection found,
#     this improves the comprehensibility
#
# 0.2:                            Mon, 27 Mar 2006 21:56:59 +0200
#   - added signal handlers for SIGCHLD, SIGINT and SIGTERM
#   - send leave message to server when exiting
#   - ignore voice sample packets from the feeded server
#
# 0.1:                            Sat, 25 Mar 2006 01:06:11 +0100
#   - initial release
#   - intercepting client->server samples and
#     feeding them to another server works
#
########################[ END CHANGELOG   ]########################

# disable output line buffering
$|=1;

# create pipe for IPC
pipe(READER, WRITER);
WRITER->autoflush(1);

my $pid;

if ($pid = fork()) {
    # PARENT: connects to the TS2 server used for feeding

    my $running = 1;
    sub sigh {
	$running = 0;
	kill($pid);
    }
    sub sigchld {
	$running = 0;
    }
    $SIG{'INT'} = \&sigh;
    $SIG{'TERM'} = \&sigh;
    $SIG{'CHLD'} = \&sigchld;

    close(WRITER);

    # hash to hold connections to feeded hosts
    my %conns;

    # create initial connection
    my $sockaddr = sockaddr_in( $feed_port, inet_aton($feed_host));

    # create client socket
    sub createsock() {
	my $ident = shift;
	
        ${$conns{$ident}}{'sock'} = new IO::Socket::INET(
				    	    PeerAddr => $feed_host,
					    PeerPort => $feed_port,
					    Proto => 'udp',
				      );
	warn "Socket could not be created: $!\n" unless ${$conns{$ident}}{'sock'};

	# initialize counters need for TS2 protocol
	${$conns{$ident}}{'cmdcount'} = 1;
	${$conns{$ident}}{'pingcount'} = 2;
	${$conns{$ident}}{'pktcount'} = 0;
    }

    # sends login to server
    sub sendcp1() {
	my ($ident, $inputname, $registeredlogin, $name, $password) = @_;
	
	# static stuff (OS etc.)
        my @body = (0x09, 0x54, 0x65, 0x61, 0x6d, 0x53, 0x70, 0x65, 0x61, 0x6b, 0x00, 0x00, 0x00,
    		    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
    		    0x00, 0x00, 0x00, 0x00, 0x0a, 0x57, 0x69, 0x6e, 0x64, 0x6f, 0x77, 0x73, 0x20,
		    0x58, 0x50, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
		    0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x02, 0x00, 0x00, 0x00, 0x20,
		    0x00, 0x3c, 0x00, 0x01);

        # Header
	my $format = 'LLLL';
        my @values = (0x03bef4, 0, 0, 1);

	# CRC
        $format .= 'L';
	push(@values, 0);

        # Body
	$format .= 'C'.($#body+1);
        for (my $i = 0; $i <= $#body; $i++) {
	    push(@values, $body[$i]);
        }

        # Registered
	$format .= 'C';
        unless ($registeredlogin) {
    	    push(@values, 1);
	}
        else {
    	    push(@values, 2);
	}

        # Name
	$format .= 'C';
        push(@values, length($name));
        $format .= 'Z29';
        push(@values, $name);

	# Password
        $format .= 'C';
        push(@values, length($password));
        $format .= 'Z29';
        push(@values, $password);

	# Nick
        $format .= 'C';
	push(@values, length($inputname));
        $format .= 'Z29';
        push(@values, $inputname);

        # Calculate CRC
        my $requ = pack($format, @values);
	$values[4] = crc32($requ);

        # Generate final packet
        $requ = pack($format, @values);

	send(${$conns{$ident}}{'sock'}, $requ, 0, $sockaddr);
    }

    # receive login ok from server
    sub recvsp1() {
	my ($ident) = @_;

        my $resp;
	while ($sockaddr ne recv(${$conns{$ident}}{'sock'}, $resp, 600, 0)) { warn "Received packet from unexpected source!\n"; };

        die "Bad Login (name and/or password wrong)\n" if (unpack('@88L', $resp) == 0xffffffff);

	${$conns{$ident}}{'crc'} = unpack('@16L', $resp);
	@{${$conns{$ident}}{'connid'}} = unpack('@172LL', $resp);
    }

    # switch to a channel
    sub sendcp2() {
	my ($ident, $inputchan) = @_;

	# static stuff
        my @body1 = (0x01, 0x00);
	my @body2 = (0x00, 0x00, 0x00, 0x00, 0x14, 0x00, 0x00, 0x00, 0x01, 0x00, 0x00, 0x00, 0x00,
		     0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x10, 0x00, 0x00, 0x00, 0xE0, 0x5E,
		     0xF8, 0xFF, 0xFF, 0xFF, 0x00, 0xFF, 0x00, 0x00, 0x00, 0x00, 0x04, 0xF8, 0x12,
		     0x00, 0xE4, 0xF7, 0x12, 0x00, 0xC4, 0xF8, 0x12, 0x00, 0x48, 0xF8, 0x12, 0x00,
		     0x28, 0x00, 0x1C, 0x02);

        # Header
	my $format = 'LLLLL';
        my @values = (0x05bef0, @{${$conns{$ident}}{'connid'}}, ${$conns{$ident}}{'cmdcount'}++, 0);

	# CRC
        $format .= 'L';
        push(@values, 0);

        # Body1
        $format .= 'C'.($#body1+1);
        for (my $i = 0; $i <= $#body1; $i++) {
	    push(@values, $body1[$i]);
        }

	# Nick
        $format .= 'C';
        push(@values, length($inputchan));
        $format .= 'Z29';
        push(@values, $inputchan);

	# Body2
        $format .= 'C'.($#body2+1);
        for (my $i = 0; $i <= $#body2; $i++) {
	    push(@values, $body2[$i]);
        }

	# ServerCRC
        $format .= 'L';
	push(@values, ${$conns{$ident}}{'crc'});

        # Tail
        $format .= 'L';
        push(@values, 0);

        # Calculate CRC
        my $requ = pack($format, @values);
        $values[5] = crc32($requ);

        # Generate final packet
        $requ = pack($format, @values);

        send(${$conns{$ident}}{'sock'}, $requ, 0, $sockaddr);
    }

    # send ACK for an incomming packet
    sub sendack() {
        my ($ident, $resp) = @_;

	# Header
        my $format = 'LLLL';
        my @values = (0x00bef1, @{${$conns{$ident}}{'connid'}}, unpack('@12L', $resp));

        # Generate final packet
        my $requ = pack($format, @values);

	send(${$conns{$ident}}{'sock'}, $requ, 0, $sockaddr);
    }

    # send a ping
    sub sendping() {
	my ($ident) = @_;

        # Header
	my $format = 'LLLL';
	my @values = (0x01bef4, @{${$conns{$ident}}{'connid'}}, ${$conns{$ident}}{'pingcount'});

        # CRC
        $format .= 'L';
	push(@values, 0);

        # Calculate CRC
        my $requ = pack($format, @values);
	$values[4] = crc32($requ);

        # Generate final packet
        $requ = pack($format, @values);

	send(${$conns{$ident}}{'sock'}, $requ, 0, $sockaddr);
    }

    # send sample from sniffed packet
    sub sendsample() {
	my ($ident, $len, $pkt) = @_;

        # Header
	my $format = 'CCCCLL';
	my @values = (0xf2, 0xbe, 0x00, unpack('@3C', $pkt), @{${$conns{$ident}}{'connid'}});

        # Count
        $format .= 'S';
	push(@values, ${$conns{$ident}}{'pktcount'}++);

        # ?
        $format .= 'S';
	push(@values, unpack('@14S', $pkt));

	# Payload
	my $payload = substr($pkt, 16, $len-16);

        # Generate final packet
        my $requ = pack($format, @values).$payload;

	send(${$conns{$ident}}{'sock'}, $requ, 0, $sockaddr);
    }

    # send a quit request
    sub sendquit() {
	my ($ident) = @_;

        # Header
	my $format = 'LLLLL';
        my @values = (0x012cbef0, @{${$conns{$ident}}{'connid'}}, ${$conns{$ident}}{'cmdcount'}++, 0);

	# CRC
        $format .= 'L';
        push(@values, 0);

        # Calculate CRC
        my $requ = pack($format, @values);
	$values[5] = crc32($requ);

        # Generate final packet
        $requ = pack($format, @values);

	send(${$conns{$ident}}{'sock'}, $requ, 0, $sockaddr);
    }

    # remember last ping time
    my $lping = time();

    my $s = IO::Select->new();
    $s->add(\*READER);

    # main loop
    while ($running) {
	my ($handles) = IO::Select->select($s, undef, undef, 4);
	if (time()-$lping >= 4) {
    	    print(".");
		
	    foreach my $ident (keys %conns) {
		&sendping($ident);
	    }
	    $lping = time();
	}
	    
	foreach my $handle (@$handles) {
	    if($handle == \*READER) {
		my $pkt;
		    
		if (my $len = sysread(READER, $pkt, 600)) {
		    my ($rport, $raddr, $data) = unpack('SLa*', $pkt);
			
		    my $ident = "$raddr - $rport";
		    unless (exists($conns{$ident})) {
			&createsock($ident);
			&sendcp1($ident, sprintf('%d.%d.%d.%d:%d', $raddr & 0xff, $raddr >> 8 & 0xff, $raddr >> 16 & 0xff, $raddr >> 24 & 0xff, $rport), $feed_registered, $feed_user, $feed_passwd);
			&recvsp1($ident);
			&sendcp2($ident, '');

			$s->add(${$conns{$ident}}{'sock'});
		    }
			
		    # we have got a sample
		    &sendsample($ident, $len-6, $data);
		}
	    }
	    else {
		foreach my $ident (keys %conns) {
		    if ($handle == ${$conns{$ident}}{'sock'}) {
			my $resp;

		        # feeded server has send a packet
			if ($sockaddr ne recv(${$conns{$ident}}{'sock'}, $resp, 600, 0)) {
			    warn "Received packet from unexpected source!\n" ;
		        }
			else {
		    	    # got something from feeded server
    			    my $code = unpack('L', $resp);

			    # ignore incomming voice samples
			    unless (($code & 0xffffff == 0x00bef3) || ($code == 0x00bef1)) {
				#printf("\n-> %08x\n", $code);

			        # just acknowledge it
    		    		&sendack($ident, $resp);
			    }
		        }
		    }
	        }	    
    	    }
	}
    }
    
    foreach my $ident (keys %conns) {
	&sendquit($ident);
    }
    waitpid($pid, 0);
}
else {
    die "cannot fork: $!\n" unless defined $pid;
    # CLIENT: uses libpcap to sniff for packages
    close(READER);

    my $filter_str = "ip dst $sniff_host && udp port $sniff_port && udp [8:2] = 0xf2be";
#    my $filter_str = "udp [8:2] = 0xf2be";
    my $o_payload;
    my $o_ip;
    my $o_port;

    # called for each interesting packet    
    sub callback() {
	my ($ud, $hdr, $pkt) = @_;
	
	print "#";

	my $dat = pack(
		    'SLa'.(${$hdr}{'len'} - $o_payload),
		    unpack('@'.$o_port.'S@'.$o_ip.'L', $pkt),
		    unpack('@'.$o_payload.'a'.(${$hdr}{'len'} - $o_payload), $pkt),
		  );
	
	# put paket to the pipe
	syswrite(WRITER, $dat, ${$hdr}{'len'} - $o_payload + 6, 0);
#	syswrite(WRITER, $pkt, ${$hdr}{'len'} - $o_payload, $o_payload);
    }

    my $err;
    
    # find a sniffing device if not set
    $sniff_dev = Net::Pcap::lookupdev(\$err) unless (defined($sniff_dev));

    # initialize device parameters
    my ($net, $mask);
    Net::Pcap::lookupnet($sniff_dev, \$net, \$mask, \$err);

    # setup offline or live sniffing    
    my $pcap_t;
    if ($sniff_dump) {
	$pcap_t = Net::Pcap::open_offline($sniff_dump, \$err);
    }
    else {
	$pcap_t = Net::Pcap::open_live($sniff_dev, 0xff, $promisc, 0, \$err);
    }
    die "Failed to open pcap: $err\n" unless(defined($pcap_t));

    warn "Unkown datalink type - we are expecting ETHERNET frames!\n" if (Net::Pcap::datalink($pcap_t)!=1);
    # Payload offset in the UDP packets
    #            ETHERNET + IP   + UDP
    $o_payload = 0x0e     + 0x14 + 0x08;
    $o_ip      = 0x0e     + 0x0c;
    $o_port    = 0x0e     + 0x14 + 0x00;

    # use libpcap for packet filtering
    my $filter_t;
    die "Could not compile pcap filter '$filter_str': ".Net::Pcap::geterr($pcap_t)."!\n" if (Net::Pcap::compile($pcap_t, \$filter_t, $filter_str, 1, $mask));
    Net::Pcap::setfilter($pcap_t, $filter_t);

    # enter libpcap capture loop    
    Net::Pcap::loop($pcap_t, -1, \&callback, 0);
}