# Install Dulu Encoding::BER
# Cara nya ketikan di Terminal a/ Command Prompt perl -MCPAN -e shell
# lalu masukan install Encoding::BER
# CODE :
use strict;
use warnings;
use IO::Socket::INET;
use Getopt::Long;
use Encoding::BER;
my %rdp_neg_type;
$rdp_neg_type{"01"} = "TYPE_RDP_NEG_REQ";
$rdp_neg_type{"02"} = "TYPE_RDP_NEG_RSP";
$rdp_neg_type{"03"} = "TYPE_RDP_NEG_FAILURE";
my %rdp_neg_rsp_flags;
$rdp_neg_rsp_flags{"00"} = "NO_FLAGS_SET";
$rdp_neg_rsp_flags{"01"} = "EXTENDED_CLIENT_DATA_SUPPORTED";
$rdp_neg_rsp_flags{"02"} = "DYNVC_GFX_PROTOCOL_SUPPORTED";
my %rdp_neg_protocol;
$rdp_neg_protocol{"00"} = "PROTOCOL_RDP";
$rdp_neg_protocol{"01"} = "PROTOCOL_SSL";
$rdp_neg_protocol{"02"} = "PROTOCOL_HYBRID";
my %rdp_neg_failure_code;
$rdp_neg_failure_code{"01"} = "SSL_REQUIRED_BY_SERVER";
$rdp_neg_failure_code{"02"} = "SSL_NOT_ALLOWED_BY_SERVER";
$rdp_neg_failure_code{"03"} = "SSL_CERT_NOT_ON_SERVER";
$rdp_neg_failure_code{"04"} = "INCONSISTENT_FLAGS";
$rdp_neg_failure_code{"05"} = "HYBRID_REQUIRED_BY_SERVER";
$rdp_neg_failure_code{"06"} = "SSL_WITH_USER_AUTH_REQUIRED_BY_SERVER";
my %encryption_level;
$encryption_level{"00000000"} = "ENCRYPTION_LEVEL_NONE";
$encryption_level{"00000001"} = "ENCRYPTION_LEVEL_LOW";
$encryption_level{"00000002"} = "ENCRYPTION_LEVEL_CLIENT_COMPATIBLE";
$encryption_level{"00000003"} = "ENCRYPTION_LEVEL_HIGH";
$encryption_level{"00000004"} = "ENCRYPTION_LEVEL_FIPS";
my %encryption_method;
$encryption_method{"00000000"} = "ENCRYPTION_METHOD_NONE";
$encryption_method{"00000001"} = "ENCRYPTION_METHOD_40BIT";
$encryption_method{"00000002"} = "ENCRYPTION_METHOD_128BIT";
$encryption_method{"00000008"} = "ENCRYPTION_METHOD_56BIT";
$encryption_method{"00000010"} = "ENCRYPTION_METHOD_FIPS";
my %version_meaning;
$version_meaning{"00080001"} = "RDP 4.0 servers";
$version_meaning{"00080004"} = "RDP 5.0, 5.1, 5.2, 6.0, 6.1, 7.0, 7.1, and 8.0 servers";
my $enc = Encoding::BER->new(warn => sub{});
my %config;
my $VERSION = "0.8-beta";
my $usage = "Starting rdp-sec-check v$VERSION ( http://labs.portcullis.co.uk/application/rdp-sec-check/ )
Copyright (C) 2012 Mark Lowe (mrl\@portcullis-security.com)
rdp-sec-check.pl host:port
";
my $debug = 0;
my $verbose = 0;
my $help = 0;
my $result = GetOptions (
"verbose" => \$verbose,
"debug" => \$debug,
"help" => \$help
);
if ($help) {
print $usage;
exit 0;
}
if ($debug) {
use Data::Dumper;
use warnings FATAL => 'all';
use Carp qw(confess);
$SIG{ __DIE__ } = sub { confess( @_ ) };
}
my $host = shift or die $usage;
my $port = 3389;
if ($host =~ /\s*(\S+):(\d+)\s*/) {
$host = $1;
$port = $2;
}
my $ip = resolve($host);
unless (defined($ip)) {
die "[E] Can't resolve hostname $host\n";
}
# flush after every write
$| = 1;
my $global_starttime = time;
printf "Starting rdp-sec-check v%s ( http://labs.portcullis.co.uk/application/rdp-sec-check/ ) at %s\n", $VERSION, scalar(localtime);
scan_host($host, $ip, $port);
print "\n";
printf "rdp-sec-check v%s completed at %s\n", $VERSION, scalar(localtime);
print "\n";
sub scan_host {
my ($host, $ip, $port) = @_;
print "\n";
print "Target: $host\n";
print "IP: $ip\n";
print "Port: $port\n";
print "\n";
print "[+] Connecting to $ip:$port\n" if $debug > 1;
my $socket;
my @response;
print "[+] Checking supported protocols\n\n";
print "[-] Checking if RDP Security (PROTOCOL_RDP) is supported...";
$socket = get_socket($ip, $port);
@response = test_std_rdp_security($socket);
if (scalar @response == 19) {
my $type = $rdp_neg_type{sprintf "%02x", ord($response[11])};
if ($type eq "TYPE_RDP_NEG_FAILURE") {
printf "Not supported - %s\n", $rdp_neg_failure_code{sprintf("%02x", ord($response[15]))};
$config{"protocols"}{"PROTOCOL_RDP"} = 0;
} else {
if ($rdp_neg_protocol{sprintf("%02x", ord($response[15]))} eq "PROTOCOL_RDP") {
print "Supported\n";
$config{"protocols"}{"PROTOCOL_RDP"} = 1;
} else {
printf "Not supported. Negotiated %s\n", $rdp_neg_protocol{sprintf("%02x", ord($response[15]))};
}
}
} elsif (scalar @response == 11) {
printf "Negotiation ignored - old Windows 2000/XP/2003 system?\n";
$config{"protocols"}{"PROTOCOL_RDP"} = 1;
} else {
print "Not supported - unexpected response\n";
$config{"protocols"}{"PROTOCOL_RDP"} = 1;
}
print "[-] Checking if TLS Security (PROTOCOL_SSL) is supported...";
$socket = get_socket($ip, $port);
@response = test_tls_security($socket);
if (scalar @response == 19) {
my $type = $rdp_neg_type{sprintf "%02x", ord($response[11])};
if ($type eq "TYPE_RDP_NEG_FAILURE") {
printf "Not supported - %s\n", $rdp_neg_failure_code{sprintf("%02x", ord($response[15]))};
$config{"protocols"}{"PROTOCOL_SSL"} = 0;
} else {
if ($rdp_neg_protocol{sprintf("%02x", ord($response[15]))} eq "PROTOCOL_SSL") {
print "Supported\n";
$config{"protocols"}{"PROTOCOL_SSL"} = 1;
} else {
printf "Not supported. Negotiated %s\n", $rdp_neg_protocol{sprintf("%02x", ord($response[15]))};
}
}
} elsif (scalar @response == 11) {
printf "Negotiation ignored - old Windows 2000/XP/2003 system?\n";
$config{"protocols"}{"PROTOCOL_SSL"} = 0;
} else {
print "Not supported - unexpected response\n";
$config{"protocols"}{"PROTOCOL_SSL"} = 0;
}
print "[-] Checking if CredSSP Security (PROTOCOL_HYBRID) is supported [uses NLA]...";
$socket = get_socket($ip, $port);
@response = test_credssp_security($socket);
if (scalar @response == 19) {
my $type = $rdp_neg_type{sprintf "%02x", ord($response[11])};
if ($type eq "TYPE_RDP_NEG_FAILURE") {
printf "Not supported - %s\n", $rdp_neg_failure_code{sprintf("%02x", ord($response[15]))};
$config{"protocols"}{"PROTOCOL_HYBRID"} = 0;
} else {
if ($rdp_neg_protocol{sprintf("%02x", ord($response[15]))} eq "PROTOCOL_HYBRID") {
print "Supported\n";
$config{"protocols"}{"PROTOCOL_HYBRID"} = 1;
} else {
printf "Not supported. Negotiated %s\n", $rdp_neg_protocol{sprintf("%02x", ord($response[15]))};
}
}
} elsif (scalar @response == 11) {
printf "Negotiation ignored - old Windows 2000/XP/2003 system??\n";
$config{"protocols"}{"PROTOCOL_HYBRID"} = 0;
} else {
print "Not supported - unexpected response\n";
$config{"protocols"}{"PROTOCOL_HYBRID"} = 0;
}
print "\n";
print "[+] Checking RDP Security Layer\n\n";
foreach my $enc_hex (qw(00 01 02 08 10)) {
printf "[-] Checking RDP Security Layer with encryption %s...", $encryption_method{"000000" . $enc_hex};
$socket = get_socket($ip, $port);
@response = test_classic_rdp_security($socket);
if (scalar @response == 11) {
my @response_mcs = test_mcs_initial_connect($socket, $enc_hex);
unless (scalar(@response_mcs) > 8) {
print "Not supported\n";
next;
}
my $length1 = ord($response_mcs[8]);
my $ber_encoded = join("", splice @response_mcs, 7);
my $ber = $enc->decode($ber_encoded);
my $user_data = $ber->{value}->[3]->{value};
my ($sc_core, $sc_sec) = $user_data =~ /\x01\x0c..(.*)\x02\x0c..(.*)/s;
my ($version, $client_requested_protocols, $early_capability_flags) = $sc_core =~ /(....)(....)?(....)?/;
my ($encryption_method, $encryption_level, $random_length, $server_cert_length) = $sc_sec =~ /(....)(....)(....)(....)/;
my $server_cert_length_i = unpack("V", $server_cert_length);
my $random_length_i = unpack("V", $random_length);
if ("000000" . $enc_hex eq sprintf "%08x", unpack("V", $encryption_method)) {
printf "Supported. Server encryption level: %s\n", $encryption_level{sprintf "%08x", unpack("V", $encryption_level)};
$config{"encryption_level"}{$encryption_level{sprintf "%08x", unpack("V", $encryption_level)}} = 1;
$config{"encryption_method"}{$encryption_method{sprintf "%08x", unpack("V", $encryption_method)}} = 1;
$config{"protocols"}{"PROTOCOL_RDP"} = 1; # This is the only way the script detects RDP support on 2000/XP
} else {
printf "Not supported. Negotiated %s. Server encryption level: %s\n", $encryption_method{sprintf "%08x", unpack("V", $encryption_method)}, $encryption_level{sprintf "%08x", unpack("V", $encryption_level)};
$config{"encryption_level"}{$encryption_level{sprintf "%08x", unpack("V", $encryption_level)}} = 0;
$config{"encryption_method"}{$encryption_method{sprintf "%08x", unpack("V", $encryption_method)}} = 0;
}
my $random = substr $sc_sec, 16, $random_length_i;
my $cert = substr $sc_sec, 16 + $random_length_i, $server_cert_length_i;
} else {
print "Not supported\n";
}
}
if ($config{"protocols"}{"PROTOCOL_HYBRID"}) {
if ($config{"protocols"}{"PROTOCOL_SSL"} or $config{"protocols"}{"PROTOCOL_RDP"}) {
$config{"issues"}{"NLA_SUPPORTED_BUT_NOT_MANDATED_DOS"} = 1;
}
} else {
# is this really a problem?
$config{"issues"}{"NLA_NOT_SUPPORTED_DOS"} = 1;
}
if ($config{"protocols"}{"PROTOCOL_RDP"}) {
if ($config{"protocols"}{"PROTOCOL_SSL"} or $config{"protocols"}{"PROTOCOL_HYBRID"}) {
$config{"issues"}{"SSL_SUPPORTED_BUT_NOT_MANDATED_MITM"} = 1;
} else {
$config{"issues"}{"ONLY_RDP_SUPPORTED_MITM"} = 1;
}
if ($config{"encryption_method"}{"ENCRYPTION_METHOD_40BIT"} or $config{"encryption_method"}{"ENCRYPTION_METHOD_56BIT"}) {
$config{"issues"}{"WEAK_RDP_ENCRYPTION_SUPPORTED"} = 1;
}
if ($config{"encryption_method"}{"ENCRYPTION_METHOD_NONE"}) {
$config{"issues"}{"NULL_RDP_ENCRYPTION_SUPPORTED"} = 1;
}
if ($config{"encryption_method"}{"ENCRYPTION_METHOD_FIPS"} and ($config{"encryption_method"}{"ENCRYPTION_METHOD_NONE"} or $config{"encryption_method"}{"ENCRYPTION_METHOD_40BIT"} or $config{"encryption_method"}{"ENCRYPTION_METHOD_56BIT"} or $config{"encryption_method"}{"ENCRYPTION_METHOD_128BIT"})) {
$config{"issues"}{"FIPS_SUPPORTED_BUT_NOT_MANDATED"} = 1;
}
}
print "\n";
print "[+] Summary of protocol support\n\n";
foreach my $protocol (keys(%{$config{"protocols"}})) {
printf "[-] $ip:$port supports %-15s: %s\n", $protocol, $config{"protocols"}{$protocol} ? "TRUE" : "FALSE";
}
print "\n";
print "[+] Summary of RDP encryption support\n\n";
foreach my $encryption_level (sort keys(%{$config{"encryption_level"}})) {
printf "[-] $ip:$port has encryption level: %s\n", $encryption_level;
}
foreach my $encryption_method (sort keys(%encryption_method)) {
printf "[-] $ip:$port supports %-25s: %s\n", $encryption_method{$encryption_method}, (defined($config{"encryption_method"}{$encryption_method{$encryption_method}}) and $config{"encryption_method"}{$encryption_method{$encryption_method}}) ? "TRUE" : "FALSE";
}
print "\n";
print "[+] Summary of security issues\n\n";
foreach my $issue (keys(%{$config{"issues"}})) {
print "[-] $ip:$port has issue $issue\n";
}
print Dumper \%config if $debug;
}
sub test_std_rdp_security {
my ($socket) = @_;
my $string = get_x224_crq_std_rdp_security();
return do_handshake($socket, $string);
}
sub test_tls_security {
my ($socket) = @_;
my $string = get_x224_crq_tls_security();
return do_handshake($socket, $string);
}
sub test_credssp_security {
my ($socket) = @_;
my $string = get_x224_crq_credssp_security();
return do_handshake($socket, $string);
}
sub test_classic_rdp_security {
my ($socket) = @_;
my $string = get_x224_crq_classic();
return do_handshake($socket, $string);
}
sub test_mcs_initial_connect {
my ($socket, $enc_hex) = @_;
my $string = get_mcs_initial_connect($enc_hex);
return do_handshake($socket, $string);
}
sub do_handshake {
my ($socket, $string) = @_;
print "[+] Sending:\n" if $debug > 1;
hdump($string) if $debug > 1;
print $socket $string;
my $data;
$socket->recv($data,4);
if (length($data) == 4) {
print "[+] Received from Server :\n" if $debug > 1;
hdump($data) if $debug > 1;
my @data = split("", $data);
my $length = (ord($data[2]) << 8) + ord($data[3]);
printf "[+] Initial length: %d\n", $length if $debug > 1;
my $data2 = "";
while (length($data) < $length) {
$socket->recv($data2,$length - 4);
print "[+] Received " . length($data2) . " bytes from Server :\n" if $debug > 1;
hdump($data2) if $debug > 1;
$data .= $data2;
}
return split "", $data;
} else {
return undef;
}
}
# http://www.perlmonks.org/?node_id=111481
sub hdump {
my $offset = 0;
my(@array,$format);
foreach my $data (unpack("a16"x(length($_[0])/16)."a*",$_[0])) {
my($len)=length($data);
if ($len == 16) {
@array = unpack('N4', $data);
$format="0x%08x (%05d) %08x %08x %08x %08x %s\n";
} else {
@array = unpack('C*', $data);
$_ = sprintf "%2.2x", $_ for @array;
push(@array, ' ') while $len++ < 16;
$format="0x%08x (%05d)" .
" %s%s%s%s %s%s%s%s %s%s%s%s %s%s%s%s %s\n";
}
$data =~ tr/\0-\37\177-\377/./;
printf $format,$offset,$offset,@array,$data;
$offset += 16;
}
}
sub get_x224_crq_std_rdp_security {
return get_x224_connection_request("00");
}
sub get_x224_crq_tls_security {
return get_x224_connection_request("01");
}
sub get_x224_crq_credssp_security {
return get_x224_connection_request("03");
}
sub get_x224_crq_classic {
return get_old_connection_request();
}
# enc_hex is bitmask of:
# 01 - 40 bit
# 02 - 128 bit
# 08 - 56 bit
# 10 - fips
#
# common value sniffed from wireshark: 03
sub get_mcs_initial_connect {
my $enc_hex = shift;
my @packet_hex = qw(
03 00 01 a2 02 f0 80 7f 65 82
01 96 04 01 01 04 01 01 01 01 ff 30 20 02 02 00
22 02 02 00 02 02 02 00 00 02 02 00 01 02 02 00
00 02 02 00 01 02 02 ff ff 02 02 00 02 30 20 02
02 00 01 02 02 00 01 02 02 00 01 02 02 00 01 02
02 00 00 02 02 00 01 02 02 04 20 02 02 00 02 30
20 02 02 ff ff 02 02 fc 17 02 02 ff ff 02 02 00
01 02 02 00 00 02 02 00 01 02 02 ff ff 02 02 00
02 04 82 01 23 00 05 00 14 7c 00 01 81 1a 00 08
00 10 00 01 c0 00 44 75 63 61 81 0c 01 c0 d4 00
04 00 08 00 20 03 58 02 01 ca 03 aa 09 04 00 00
28 0a 00 00 68 00 6f 00 73 00 74 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 04 00 00 00 00 00 00 00 0c 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
01 ca 01 00 00 00 00 00 18 00 07 00 01 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00
04 c0 0c 00 09 00 00 00 00 00 00 00 02 c0 0c 00
);
push @packet_hex, $enc_hex;
push @packet_hex, qw(00 00 00 00 00 00 00 03 c0 20 00 02 00 00 00
63 6c 69 70 72 64 72 00 c0 a0 00 00 72 64 70 64
72 00 00 00 80 80 00 00
);
my $string = join("", @packet_hex);
$string =~ s/(..)/sprintf("%c", hex($1))/ge;
return $string;
}
# MS-RDPBCGR
sub get_x224_connection_request {
my $sec = shift;
my @packet_hex;
push @packet_hex, qw(03); # tpktHeader - version
push @packet_hex, qw(00); # tpktHeader - reserved
push @packet_hex, qw(00 13); # tpktHeader - length
push @packet_hex, qw(0e); # x224Crq - length
push @packet_hex, qw(e0); # x224Crq - connection request
push @packet_hex, qw(00 00); # x224Crq - ??
push @packet_hex, qw(00 00); # x224Crq - src-ref
push @packet_hex, qw(00); # x224Crq - class
push @packet_hex, qw(01); # rdpNegData - type
push @packet_hex, qw(00); # rdpNegData - flags
push @packet_hex, qw(08 00); # rdpNegData - length
push @packet_hex, ($sec, qw(00 00 00)); # rdpNegData - requestedProtocols. bitmask, little endian: 0=standard rdp security, 1=TLSv1, 2=Hybrid (CredSSP)
my $string = join("", @packet_hex);
$string =~ s/(..)/sprintf("%c", hex($1))/ge;
return $string;
}
sub get_old_connection_request {
my @packet_hex = qw(
03 00 00 22 1d e0 00 00 00 00
00 43 6f 6f 6b 69 65 3a 20 6d 73 74 73 68 61 73
68 3d 72 6f 6f 74 0d 0a
);
my $string = join("", @packet_hex);
$string =~ s/(..)/sprintf("%c", hex($1))/ge;
return $string;
}
sub get_socket {
my ($ip, $port) = @_;
my $socket = new IO::Socket::INET (
PeerHost => $ip,
PeerPort => $port,
Proto => 'tcp',
) or die "ERROR in Socket Creation : $!\n";
return $socket;
}
sub print_section {
my ($string) = @_;
print "\n=== $string ===\n\n";
}
sub resolve {
my $hostname = shift;
print "[D] Resolving $hostname\n" if $debug > 0;
my $ip = gethostbyname($hostname);
if (defined($ip)) {
return inet_ntoa($ip);
} else {
return undef;
}
}
0 comments:
Post a Comment