#!/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)));
}

##</code><code>##

#!/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 256;
use constant MAX_PORT  => scalar 65536;
use constant MIN_PORT  => scalar 1;

my $dot = ".";
my ( $rcv_sntp_packet , $li_d , $send_sntp_packet , $precision_server );

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

    my $port = $ARGV[0]; # User input PORT;

    die "\nPlease provide only numeric characters for PORT number!\n\n"
	if ( $port =~ /\D/ );

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

    my $server_socket = IO::Socket::INET->new(
	LocalPort  => $port, # Default NTP port 123
	Proto      => 'udp',
	Type       => SOCK_DGRAM,
	LocalAddr  => 'localhost',
	Broadcast  => 1 ) or die "Can't bind: $@\n";

    printf("\nServer is up, listens on PORT: ".$port." waiting for client...\n");

    while ( TRUE ) {

	my $peer_address = $server_socket->peerhost();
	my $peer_port = $server_socket->peerport();
	
	if ( defined $peer_address ) { print "Peer address: ".$peer_address."\n" };
	if ( defined $peer_port ) { print "Peer port: ".$peer_port."\n" };
	
	# read operation on the socket
	$server_socket->recv( $rcv_sntp_packet , MAXBYTES ) 
	    or die "Server error received: $!\n";
	my ( $server_rcv_epoc_sec , $server_rcv_epoc_microsec ) = gettimeofday(); # Server epoc time in sec and microsec

	# Convert to binary epoc rcv seconds
	my $server_sec_rcv_b = dec2bin( $server_rcv_epoc_sec , 32 , "N" );
	#print "Epoc rcv sec ".$server_sec_rcv_b."\n";

	# Convert to binary epoc rcv micro seconds
	my $server_microsec_rcv_b = dec2bin( $server_rcv_epoc_microsec , 32 , "N" );
	#print "Epoc rcv microsec ".$server_microsec_rcv_b."\n";

	# Concatenate the rcv sec and rcv microsec 64 in total
	my $server_epoc_rcv_b = $server_sec_rcv_b . $server_microsec_rcv_b;
	#print "Length of rcv time server: ".length( $server_epoc_rcv_b )."\n";

	my $server_rcv_epoc_d = $server_rcv_epoc_sec . $dot . $server_rcv_epoc_microsec;

	#print "\n\n" . "Server received: ".$rcv_sntp_packet."\n\n";

	if ( !defined $rcv_sntp_packet ) {
	    $send_sntp_packet = "Invalid Request";

	    $server_socket->send( $send_sntp_packet )
		or die "Server error send:  $!\n";
	}
	else {

	    my $client_li_binary = substr( $rcv_sntp_packet , 0 , 2 );
	    my $client_li = bin2dec( $client_li_binary , 8 , "c" );

	    my $client_vn_binary = substr( $rcv_sntp_packet , 2 , 3 );
	    my $client_vn = bin2dec( $client_vn_binary , 8 , "c" );

	    my $client_mode_binary = substr( $rcv_sntp_packet , 5 , 3 );
	    my $client_mode = bin2dec( $client_mode_binary , 8 , "c" );

	    my $client_stratum_binary = substr( $rcv_sntp_packet , 8 , 8 );
	    my $client_stratum = bin2dec( $client_stratum_binary , 8 , "C" );

	    my $client_poll_interval_binary = substr( $rcv_sntp_packet , 16 , 8 );
	    my $client_poll_interval = bin2dec( $client_poll_interval_binary , 8 , "c" );

	    my $client_precision_binary = substr( $rcv_sntp_packet , 24 , 8 );
	    my $client_precision = bin2dec( $client_precision_binary , 8 , "c" );

	    my $client_root_delay_binary = substr( $rcv_sntp_packet , 32 , 32 );
	    my $client_root_delay = bin2dec( $client_root_delay_binary , 32 , "f" );

	    my $client_root_dispersion_binary = substr( $rcv_sntp_packet , 64 , 32 );
	    my $client_root_dispersion = bin2dec( $client_root_dispersion_binary , 32 , "N" );

	    my $client_ref_identifier_binary = substr( $rcv_sntp_packet , 96 , 32 );
	    my $client_ref_identifier = bin2dec( $client_ref_identifier_binary , 32 , "N" );

	    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_d = $client_ref_sec_epoc . $dot . $client_ref_microsec_epoc;

	    # Concatenate client ref sec and ref microsec for server message transmission
	    my $client_epoc_ref_b = $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_b = $client_send_sec_epoc_b . $client_send_microsec_epoc_b;

	    # Server data preparing message

	    # Root Delay, total roundtrip delay to the primary reference source
	    $server_rcv_epoc_microsec = $dot . $server_rcv_epoc_microsec;
	    my $root_delay_server = $server_rcv_epoc_microsec - $client_root_delay;

	    if ($root_delay_server < 59) {
		$li_d = 0;
	    } elsif ($root_delay_server == 61 ) {		
		$li_d = 1;		
	    } elsif ($root_delay_server == 59) {		
		$li_d = 2;
	    } else {
		$li_d = 3;
	    }

	    # $li = 0; is the server we have no warning for asynchronization
	    my $li_b = dec2bin( $li_d , 8 , "c" );
	    $li_b = substr $li_b, -2;

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

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

	    # $stratum = 1; is the server clock which is primary reference
	    my $stratum_b = dec2bin( 1 , 8 , "c" );

	    # $poll = 6; # is the poll interval between messages 2**6 (2 to the power of 6) = 64 sec
	    my $poll_b = dec2bin( 2 , 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.
	    #my ($realtime, $user, $system, $cuser, $csystem) = POSIX::times() ;
	    
	    ( undef , undef , $precision_server , undef , undef ) = POSIX::times();
	
	    my $precision_b = dec2bin( $precision_server , 8 , "c" );

	    #my $root_delay_server = $server_rcv_epoc_d - $client_root_delay;
	    my $root_delay_server_b = dec2bin( $root_delay_server , 32 , "f" );

	    my $root_dispersion = 0; # is the nominal error relative to the primary reference since the server is the reference we can not have relative error. We assume the source is accurate 100%.
	    my $root_dispersion_b = dec2bin( $root_dispersion , 32 , "N" );

	    # $reference_identifier = 0; if this is the primary server then there is not of offset LOCL or PPS if GPS
	    my $reference_identifier_str = "LOCL";
	    my $reference_identifier_b .= unpack( "B32" , $reference_identifier_str );

	    # 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/
	    # Server epoc receive packet from client in binary $server_epoc_rcv_b in decimal $server_rcv_epoc_d

	    # Server epoc send in sec and microsec
	    my ( $server_sec_send_d , $server_microsec_send_d ) = gettimeofday();

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

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

	    # Concatenate the epoc send sec and micro sec to a string 64 bits long to send
	    my $server_epoc_send_b = $server_sec_send_b . $server_microsec_send_b;

	    # Print decimal epoc send message
	    my $server_epoc_send_d = $server_sec_send_d . $dot . $server_microsec_send_d;

	    $send_sntp_packet = $li_b . $vn_b . $mode_b . $stratum_b . $poll_b . $precision_b . $root_delay_server_b . $root_dispersion_b . $reference_identifier_b . $client_epoc_ref_b . $client_epoc_send_b . $server_epoc_rcv_b . $server_epoc_send_b;

	    $server_socket->send( $send_sntp_packet )
		or die "Server error send:  $!\n";
	    
	} # End of else not Invalid Message

	#print "Send packet: ".$send_sntp_packet."\n";

    } # End of while(TRUE) loop

    $server_socket->close(); # Close socket

} # End of else arguments

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

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