#!/usr/bin/perl
use strict;
use warnings;
use IO::Socket::INET;
use POSIX qw( CLOCKS_PER_SEC );
use Time::HiRes qw( gettimeofday CLOCK_REALTIME );

use constant TRUE      => scalar 1;
use constant ARGUMENTS => scalar 1;
use constant MAXBYTES  => scalar 512;
use constant MAX_PORT  => scalar 65536;
use constant MIN_PORT  => scalar 1;

my $dot = ".";
my ( $rcv_sntp_packet , $root_dispersion , $server_send_microsec_epoc , $precision_client , $client_microsec_ref_d );

if ( @ARGV > ARGUMENTS ) {
    print "\nPlease no more than ".ARGUMENTS." argument input!\n";
    print "\nCorrect Syntax: perl $0 IP:PORT (e.g. 127.0.0.1:12345)\n";
    exit(0);
}
elsif ( @ARGV < ARGUMENTS ) {
    print "\nPlease no less than ".ARGUMENTS." argument input!\n";
    print "\nCorrect Syntax: perl $0 IP:PORT (e.g. 127.0.0.1:12345)\n";
    exit(0);
}
else {

    my $info = $ARGV[0]; # User input IP:PORT;

    my $string = index($info, ':');

    if ($string == '-1') {
	die "Please include ':' in between the IP and Port - ".$info."\n";
    }

    my @input = split( ':' , $info );

    die "\nPlease use PORT number between ".MIN_PORT." - ".MAX_PORT."\n\n" 
	if ( ( $input[1] > MAX_PORT ) || ( $input[1] < MIN_PORT ) );

    my $client_socket = new IO::Socket::INET (
	PeerHost => $input[0],
	Type     => SOCK_DGRAM,
	PeerPort => $input[1], # Default NTP port 123, due to permission denied switch to client set
	Proto    => 'udp'
	) or die "ERROR in Socket Creation: $@\n";

    my $Peer_Port = $client_socket->peerport();
    
    while (TRUE) {
	
	my $li = 0; # is the client we have no warning for asynchronization on the first round
	my $li_b = dec2bin( $li , 8 , "c" );
	$li_b = substr $li_b, -2;

	my $vn = 3; # is the version 3 only IPV4
	my $vn_b = dec2bin( $vn , 8 , "c" );
	$vn_b = substr $vn_b, -3;

	my $mode = 3; # is the client (mode 3)
	my $mode_b = dec2bin( $mode , 8 , "c" );
	$mode_b = substr $mode_b, -3;

	my $stratum = 15; # is the client clock with SNTP synchronization
	my $stratum_b = dec2bin( $stratum , 8 , "C" );

	my $poll = 6; # is the poll interval between messages 2**0 (2 to the power of 0) = 0 sec
	my $poll_b = dec2bin( $poll , 8 , "c" );

	# The precission size on the RFC is 8 bits, anything lower than 1e-03 (0.001) it can not fit on 8 bits. In such cases we round to clossest digit. Never the less the value is so small not even worth mentioning it. Range from -6 for mains-frequency clocks to -20

	( undef , undef , $precision_client , undef , undef ) = POSIX::times() ;

	my $precision_b = dec2bin( $precision_client , 8 , "c" );

	my $root_delay = 0; # Initializing the client root delay is 0 we need at least on receive to have new root delay
	my $root_delay_b = dec2bin( $root_delay , 32 , "f" );

        # is the nominal error relative to the primary reference, we need the hardware clock to know and compare with the current time in order to get the value. And update the value when we will receive the message from the server.
	if ( defined $client_microsec_ref_d ) {
	    $server_send_microsec_epoc = $dot . $server_send_microsec_epoc;
	    $client_microsec_ref_d = $dot . $client_microsec_ref_d;
	    $root_dispersion = $client_microsec_ref_d - $server_send_microsec_epoc;
	}
	else {
	    $root_dispersion = 0;
	}

	my $root_dispersion_b = dec2bin( $root_dispersion , 32 , "f" );

	my $reference_identifier = 0; # this is the client In the case of NTP Version 3 or Version 4 stratum-0 (unspecified)
	my $reference_identifier_b = dec2bin( $reference_identifier , 32 , "N" );
	
	# NTP uses 64-bit Time Stamps to exchange information. Two parts are used, 32-bits for seconds and 32-bits for portions of a second. The 64-bit Time Stamp can manage 136 years of time based from January 1, 1970. Ref. http://www.linux.org/threads/tcp-ip-protocol-network-time-protocol-ntp.4912/

	# Client epoc ref in sec and microsec
	my ( $client_sec_ref_d , $client_microsec_ref_d ) = gettimeofday();

	# Convert to binary epoc ref seconds
	my $client_sec_ref_b = dec2bin( $client_sec_ref_d , 32 , "N" );

	# Convert to binary epoc ref micro seconds
	my $client_microsec_ref_b = dec2bin( $client_microsec_ref_d , 32 , "N" );

	# Concatenate the epoc ref sec and micro sec to a string 64 bits long to send
	my $client_epoc_ref_b = $client_sec_ref_b . $client_microsec_ref_b;

	# Print decimal epoc ref message
	my $client_epoc_ref_d = $client_sec_ref_d . $dot . $client_microsec_ref_d;

	# Client epoc send in sec and microsec
	my ( $client_sec_send_d , $client_microsec_send_d ) = gettimeofday();

	# Convert to binary epoc send seconds
	my $client_sec_send_b = dec2bin( $client_sec_send_d , 32 , "N" );

	# Convert to binary epoc send micro seconds
	my $client_microsec_send_b = dec2bin( $client_microsec_send_d , 32 , "N" );

	# Concatenate the epoc send sec and micro sec to a string 64 bits long to send
	my $client_epoc_send_b = $client_sec_send_b . $client_microsec_send_b;

	# Print decimal epoc send message
	my $client_epoc_send_d = $client_sec_send_d . $dot . $client_microsec_send_d;

	my $send_sntp_packet = $li_b . $vn_b . $mode_b . $stratum_b . $poll_b . $precision_b . $root_delay_b . $root_dispersion_b . $reference_identifier_b . $client_epoc_ref_b . $client_epoc_send_b;

	$client_socket->send( $send_sntp_packet ) 
	    or die "Client error while send: $!\n";

	$client_socket->recv( $rcv_sntp_packet , MAXBYTES )
	    or die "Client error while received: $!\n";

	# Client epoc rcv in sec and microsec
	my ( $client_sec_rcv_d , $client_microsec_rcv_d ) = gettimeofday();

	# Print decimal epoc rcv message
	my $client_epoc_rcv_d = $client_sec_rcv_d . $dot . $client_microsec_rcv_d;

	die "Client check send MSG!\n" if ( $rcv_sntp_packet eq "Invalid Request" );

	my $server_li_binary = substr( $rcv_sntp_packet , 0 , 2 );
	my $server_li = bin2dec( $server_li_binary , 8 , "c" );

	my $server_vn_binary = substr( $rcv_sntp_packet , 2 , 3 );
	my $server_vn = bin2dec( $server_vn_binary , 8 , "c" );

	my $server_mode_binary = substr( $rcv_sntp_packet , 5 , 3 );
	my $server_mode = bin2dec( $server_mode_binary , 8 , "c" );

	my $server_stratum_binary = substr( $rcv_sntp_packet , 8 , 8 );
	my $server_stratum = bin2dec( $server_stratum_binary , 8 , "C" );

	my $server_poll_interval_binary = substr( $rcv_sntp_packet , 16 , 8 );
	my $server_poll_interval = bin2dec( $server_poll_interval_binary , 32 , "N" );

	my $server_precision_binary = substr( $rcv_sntp_packet , 24 , 8 );
	my $server_precision = bin2dec( $server_precision_binary , 32 , "N" );

	my $server_root_delay_binary = substr( $rcv_sntp_packet , 32 , 32 );
	my $server_root_delay = bin2dec( $server_root_delay_binary , 32 , "f" );

	my $server_root_dispersion_binary = substr( $rcv_sntp_packet , 64 , 32 );
	my $server_root_dispersion = bin2dec( $server_root_dispersion_binary , 32 , "N" );

	my $server_ref_identifier_binary = substr( $rcv_sntp_packet , 96 , 32 );
	my $server_ref_identifier  = pack("B32", $server_ref_identifier_binary);

	my $client_ref_sec_epoc_b = substr( $rcv_sntp_packet , 128 , 32 );
	my $client_ref_sec_epoc = bin2dec( $client_ref_sec_epoc_b , 32 , "N" );

	my $client_ref_microsec_epoc_b = substr( $rcv_sntp_packet , 160 , 32 );
	my $client_ref_microsec_epoc = bin2dec( $client_ref_microsec_epoc_b , 32 , "N" );

	my $client_ref_epoc_total = $client_ref_sec_epoc . $dot . $client_ref_microsec_epoc;

	# Concatenate client ref sec and ref microsec for server message transmission
	my $client_epoc_ref_binary = $client_ref_sec_epoc_b . $client_ref_microsec_epoc_b;

	my $client_send_sec_epoc_b = substr( $rcv_sntp_packet , 192 , 32 );
	my $client_send_sec_epoc = bin2dec( $client_send_sec_epoc_b , 32 , "N" );

	my $client_send_microsec_epoc_b = substr( $rcv_sntp_packet , 224 , 32 );
	my $client_send_microsec_epoc = bin2dec( $client_send_microsec_epoc_b , 32 , "N" );

	my $client_send_epoc_d = $client_send_sec_epoc . $dot . $client_send_microsec_epoc;
	
	# Concatenate client ref sec and ref microsec for server message transmission
	my $client_epoc_send_binary = $client_send_sec_epoc_b . $client_send_microsec_epoc_b;

	my $server_rcv_sec_epoc_b = substr( $rcv_sntp_packet , 256 , 32 );
	my $server_rcv_sec_epoc = bin2dec( $server_rcv_sec_epoc_b , 32 , "N" );

	my $server_rcv_microsec_epoc_b = substr( $rcv_sntp_packet , 288 , 32 );
	my $server_rcv_microsec_epoc = bin2dec( $server_rcv_microsec_epoc_b , 32 , "N" );

	my $server_rcv_epoc_d = $server_rcv_sec_epoc . $dot . $server_rcv_microsec_epoc;

	my $server_send_sec_epoc_b = substr( $rcv_sntp_packet , 320 , 32 );
	my $server_send_sec_epoc = bin2dec( $server_send_sec_epoc_b , 32 , "N" );

	my $server_send_microsec_epoc_b = substr( $rcv_sntp_packet , 352 , 32 );
	$server_send_microsec_epoc = bin2dec( $server_send_microsec_epoc_b , 32 , "N" );

	my $server_send_epoc_d = $server_send_sec_epoc . $dot . $server_send_microsec_epoc;

	# RFC2030 reference http://tools.ietf.org/html/rfc2030

	my $d = (($client_epoc_rcv_d -  $client_epoc_send_d) - ($server_rcv_epoc_d - $server_send_epoc_d));
	my $t = ((($server_rcv_epoc_d -  $client_epoc_send_d) + ($server_send_epoc_d - $client_epoc_rcv_d))/2);
	
        # Clear screen for viewing the output
	system $^O eq 'MSWin32' ? 'cls' : 'clear';

	print "
\t Timestamp Name \t ID \t When Generated
\t ------------------------------------------------------------
\t Originate Timestamp \t T1 \t time request sent by client
\t Receive Timestamp \t T2 \t time request received by server
\t Transmit Timestamp \t T3 \t time reply sent by server
\t Destination Timestamp \t T4 \t time reply received by client

\t The roundtrip delay d and local clock offset t are defined as

\t d = (T4 - T1) - (T2 - T3) \t t = ((T2 - T1) + (T3 - T4)) / 2 \n

\t Round Trip delay: ".$d."\n
\t Clock offset: ".$t."\n

\t Field Name \t\t\t Unicast/Anycast
\t\t\t\t Request \t\t Reply
\t ------------------------------------------------------------
\t LI \t\t\t $li \t\t\t $server_li
\t VN \t\t\t $vn \t\t\t $server_vn
\t Mode \t\t\t $mode \t\t\t $server_mode
\t Stratum \t\t $stratum \t\t\t $server_stratum
\t Poll \t\t\t $poll \t\t\t $server_poll_interval
\t Precision \t\t $precision_client \t\t\t $server_precision
\t Root Delay \t\t $root_delay \t\t\t $server_root_delay
\t Root Dispersion \t $root_dispersion \t\t\t $server_root_dispersion
\t Reference Identifier \t $reference_identifier \t\t\t $server_ref_identifier
\t Reference Timestamp \t $client_epoc_ref_d \t $server_rcv_epoc_d
\t Originate Timestamp \t $client_epoc_send_d \t $server_send_epoc_d
\t Receive Timestamp \t $client_epoc_rcv_d \t $server_rcv_epoc_d
\t Transmit Timestamp \t $client_epoc_send_d \t $server_send_epoc_d\n";

	sleep(2**$server_poll_interval);
	# Clear screen for viewing the output
	system $^O eq 'MSWin32' ? 'cls' : 'clear';

    } # End of While (TRUE)

    $client_socket->close(); # Close socket()

} # End of else ARGV provided

sub dec2bin {
    my $bits      = shift;
    my $size      = shift;
    my $template  = shift;
    my $str = unpack("B$size", pack($template, $bits));
    return $str;
}

sub bin2dec {
    my $bits     = shift;
    my $size     = shift;
    my $template = shift;
    return unpack($template, pack("B$size", substr("0" x $size . $bits , -$size)));
}