checkminecraft-17.pl

#!/usr/bin/perl
use strict;
use warnings;

use IO::Socket;
use Pod::Usage;
use Getopt::Long  qw(GetOptions);
use Encode        qw(decode encode);
use Time::HiRes   qw(gettimeofday tv_interval);
use LWP::Simple;
use JSON          qw(decode_json);
use Data::Dumper;


my(%opt);

if(!GetOptions(\%opt, 'help|?')) {
    pod2usage(-exitval => 1,  -verbose => 0);
}

pod2usage(-exitstatus => 0, -verbose => 2) if $opt{help};

my $target = shift or pod2usage(
    -exitval => 1,  -verbose => 0, -message => 'No host specified'
);

my $port = 25565;
if($target =~ /(.*?):(\d+)$/) {
    $target = $1;
    $port   = $2;
}

ping_server($target, $port);

exit 0;

sub ping_server {
    my($host, $port) = @_;

    my $t0 = [gettimeofday];
    my $s = IO::Socket->new(
        Domain   => AF_INET,
        PeerAddr => $host,
        PeerPort => $port,
        Proto    => 'tcp',
    ) || die "$!\n";

    $s->autoflush(1);

    # Packet identifier for a handshake packet
    my $packeta = "\x00";

    # Protocol Version
    $packeta .= "\x04";

    # Length of hostname
    my $hostnamelength = pack 'c', length($host);
    $packeta .= $hostnamelength;

    # Hostname
    $packeta .= $host;

    # Port
    my $packedport = pack 'n', $port;
    $packeta .= $packedport;

    # Next state (1 for status)
    $packeta .= "\x01";
    my $packetalen = pack 'c' , length($packeta);
    print $s $packetalen;
    print $s $packeta;
    my $fullpacketa = $packetalen . $packeta;

    # Status request packet
    my $packetb = "\x01\x00";
    print $s $packetb;

    #sysread($s, my $resp, 4096);

    sysread($s, my $resp, 4096);

    my $elapsed = tv_interval($t0);

    #print "Packet A: \n";
    #hdump($fullpacketa);

    #print "Packet B: \n";
    #hdump($packetb);

    # Clean the response
    $resp =~ s/^[^{]*{/{/;
    $resp =~ s/\xc2|\xa7.//g;
    $resp =~ s/[^ -~]//g;

    #print "\nResponse: \n" ;
    #hdump($resp);
    #print "\n$resp\n";

    # Decode the json
    my $decoded_resp = decode_json($resp);

    #print Dumper($decoded_resp);

    # Find the bits
    my $protocol = $decoded_resp->{'version'}{'protocol'};
    my $version  = $decoded_resp->{'version'}{'name'};
    my $motd     = $decoded_resp->{'description'};
    my $players  = $decoded_resp->{'players'}{'online'};
    my $max_players  = $decoded_resp->{'players'}{'max'};

    print "Protocol Version:  $protocol\n"
        . "Minecraft Version: $version\n"
        . "Msg of the Day:    $motd\n"
        . "Players Online:    $players\n"
        . "Max Players:       $max_players\n";

   printf "Ping Time:         %5.3fs\n", $elapsed;
}


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;
    }
}