Fix RCON Response Being Cut Off

Fixes OpenGamePanel/OGP-Website#138 where returned content from rcon is
cut off due to
[this](https://developer.valvesoftware.com/wiki/Source_RCON_Protocol#Multiple-packet_Responses)

KKrcon/HL2.pm

@@ -46,7 +46,7 @@ sub new {
 		elsif ($key eq "port")     { $self->port($val)     }
 		elsif ($key eq "password") { $self->password($val) }
 		elsif ($key eq "timeout")  { $self->timeout($val)  }
-		else { print STDERR "uknown attribute: $key\n" }
+		else { print STDERR "Unknown attribute: $key\n" }
 	}
 
 	return $self;
@@ -104,7 +104,7 @@ sub connect {
 		Timeout		=> $self->timeout(),
 		Proto           => "tcp",
 		Type            => SOCK_STREAM,
-	) || die "failed to connect: $!\n";
+	) || die "Failed to connect: $!\n";
 
 	$self->socket($socket);
 	$self->connected(1);
@@ -168,18 +168,12 @@ sub packet {
 # receive packet
 sub response {
 	my $self = shift;
+	my $payload = $self->read();
 
-	my $size = unpack("V", $self->read(4));
+	# remove protocol cruft and null terminators
+	$payload =~ s/\x00{2}$//;
 
-	if ($size) {
-		my $payload = $self->read($size);
-
-		# remove protocol cruft and null terminators
-		$payload =~ s/^.{8}//;
-		$payload =~ s/\x00{2}$//;
-
-		return $payload;
-	}
+	return $payload;
 }
 
 # read length of bytes from socket with timeout
@@ -191,10 +185,24 @@ sub read {
 	my $timeout = $self->timeout();
 	my $select = IO::Select->new($socket);
 
-	if ($select->can_read($timeout)) {
-		$socket->sysread(my $read, $length, 0);
-		return $read;
+	my $reply = "";
+	my $buffer;
+
+	my ($size, $request_id, $command_response, $data);
+
+	while ($select->can_read(0.5)) {
+		$socket->recv($buffer, 4, MSG_PEEK);
+		$size = unpack("V", $buffer);
+		last if (!defined($size));
+		$socket->recv($buffer, $size+4, MSG_WAITALL);
+
+		($size, $request_id, $command_response, $data) =
+			unpack('VVVZ*x', $buffer);
+
+		$reply .= "$data";
 	}
+
+	return $reply;
 }
 
 1;
@@ -331,4 +339,4 @@ Chris Jones, E<lt>[email protected]<gt>
  it under the same terms as Perl itself, either Perl version 5.8.5 or,
  at your option, any later version of Perl 5 you may have available.
 
-=cut
+=cut

KKrcon/KKrcon.pm

@@ -69,7 +69,6 @@ sub new
 	$self->{"error"} = "";
 	
 	# Set up socket parameters
-	$self->{"_proto"}  = getprotobyname('udp');
 	$self->{"_ipaddr"} = gethostbyname($self->{"server_host"})
 		or die("KKrcon: could not resolve Host \"" . $self->{"server_host"} . "\"\n");
 	
@@ -128,20 +127,10 @@ sub _sendrecv
 	my $host = $self->{"server_host"};
 	my $port = $self->{"server_port"};
 	my $ipaddr = $self->{"_ipaddr"};
-	my $proto  = $self->{"_proto"};
 	
 	# Open socket
-	socket(RCON, PF_INET, SOCK_DGRAM, $proto)
-		or die("KKrcon: socket: $!\n");
-	
-	# bind causes problems if hostname() gets wrong interface...
-	# and it doesn't seem to be necessary
-	#
-	#my $iaddr = gethostbyname(hostname());
-	#my $paddr = sockaddr_in(0, $iaddr);
-	#bind(RCON, $paddr)
-	#	or die("KKrcon: bind: $!\n");
-	
+	socket(RCON, PF_INET, SOCK_DGRAM, getprotobyname("udp")) or die("KKrcon: socket: $!\n");
+
 	my $hispaddr = sockaddr_in($port, $ipaddr);
 	
 	unless(defined(send(RCON, $msg, 0, $hispaddr)))
@@ -149,26 +138,51 @@ sub _sendrecv
 		die("KKrcon: send $ip:$port : $!");
 	}
 
-	my $rin = "";
+	my $rin;
 	vec($rin, fileno(RCON), 1) = 1;
-	
-	my $ans = "TIMEOUT";
-	if (select($rin, undef, undef, 10.0))
-	{
-		$ans = "";
+	my $ans;
+
+	if (select($rin, undef, undef, 10.0)) {
 		$hispaddr = recv(RCON, $ans, 8192, 0);
-		$ans =~ s/\x00+$//;			# trailing crap
-		$ans =~ s/^\xFF\xFF\xFF\xFFl//;		# HL response
-		$ans =~ s/^\xFF\xFF\xFF\xFFn//;		# QW response
-		$ans =~ s/^\xFF\xFF\xFF\xFF//;		# Q2/Q3 response
-		$ans =~ s/^\xFE\xFF\xFF\xFF.....//;	# old HL bug/feature
+
+		if (defined($ans)) {
+			$ans =~ s/^\xFF\xFF\xFF\xFFprint\n//;    # CoD2 response
+			$ans =~ s/\x00+$//;			# trailing crap
+			$ans =~ s/^\xFF\xFF\xFF\xFFl//;		# HL response
+			$ans =~ s/^\xFF\xFF\xFF\xFFn//;		# QW response
+			$ans =~ s/^\xFF\xFF\xFF\xFF//;		# Q2/Q3 response
+			$ans =~ s/^\xFE\xFF\xFF\xFF.....//;	# old HL bug/feature
+
+			if (length($ans) > 512) {
+				my $tmp;
+				my @explode;
+
+				while (select($rin, undef, undef, 0.05)) {
+					@explode = split(/\n/, $ans);
+					$explode[$#explode] =~ s/^ //;
+					$explode[$#explode] = 'X' . $explode[$#explode];
+					$ans = join("\n", @explode);
+
+					$hispaddr = recv(RCON, $tmp, 8192, 0);
+
+					if (defined($tmp)) {
+						$tmp =~ s/^\xFF\xFF\xFF\xFFprint\n//;    # CoD2 response
+						$tmp =~ s/\x00+$//;			# trailing crap
+						$tmp =~ s/^\xFF\xFF\xFF\xFFl//;		# HL response
+						$tmp =~ s/^\xFF\xFF\xFF\xFFn//;		# QW response
+						$tmp =~ s/^\xFF\xFF\xFF\xFF//;		# Q2/Q3 response
+						$tmp =~ s/^\xFE\xFF\xFF\xFF.....//;	# old HL bug/feature
+						$ans .= $tmp;
+					}
+				}
+			}
+		}
 	}
 	
 	# Close socket
 	close(RCON);
 	
-	if ($ans eq "TIMEOUT")
-	{
+	if (!defined($ans)) {
 		$ans = "";
 		$self->{"error"} = "Rcon timeout";
 	}
@@ -265,4 +279,4 @@ sub getPlayer
 
 
 1;
-# end
+# end