Dear monks,

Update: In case of future reference I have created a new improved version SNTP Client/Server V2 RFC.

I have just finished my first SNTP Client/Server script based on what I have read on Simple Network Time Protocol (SNTP) Version 4.

Well from my point of view it works just fine, but I would like to ask for possible improvements or modifications from experts, from all of you.

Working code of Client:

#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
use IO::Socket::INET;
use Time::HiRes qw( time gettimeofday clock );

use constant MAXBYTES => scalar 1024;
use constant ARGUMENTS => scalar 1;

# flush after every write
$| = 1;

my ($received_data,$Peer_Port);
#printf "This is the number of arguments: ".ARGUMENTS."\n";

my $IP = $ARGV[0] or die "Please provide IP of Server $!\n";

if (@ARGV > ARGUMENTS) {
    print "\nPlease no more than ".ARGUMENTS." arguments (ARGV[])!\n";
    print "\nCorrect Syntax: perl $0 IP (e.g. 127.0.0.1)\n\n";
    exit();
}
else {
    
    #my %response = get_ntp_response(<127.0.0.1>,123);
    #printf "This is the responce: ".Dumper(\%response)."\n";
    #  We call IO::Socket::INET->new() to create the UDP Socket
    # and bind with the PeerAddr.

    my $localhost = "127.0.0.2";
    my $port = "12345";
    
    my $client_socket = new IO::Socket::INET (
    PeerHost => $IP || $localhost,
    Type     => SOCK_DGRAM,
    PeerPort => $port || "12345", # Default NTP port 123, due to permi
+ssion denied switch to 12345
    Proto    => 'udp'
    ) or die "ERROR in Socket Creation: $!\n";

    $Peer_Port = $client_socket->peerport();
    
    # $li = 0; is the client we have no waring for asynchronization
    my $dec_li = "0";
    my $li = sprintf ("%02b",$dec_li);

    #print "\$dec_li: ".$dec_li."\n";
  
    # $vn = 3; is the version 3 only IPV4
    my $dec_vn = "3";
    my $vn = sprintf ("%03b",$dec_vn);

    # $mode = 3; is the client (mode 3) 
    my $dec_mode = "3";
    my $mode = sprintf ("%03b",$dec_mode);

    # $stratum = 0; is the client clock which is unspecified
    my $dec_stratum = "0";
    my $stratum = sprintf ("%08b",$dec_stratum);

    #print "\$dec_stratum: ".$dec_stratum."\n";

    # $poll = 6; is the poll interval between messages 6 = 64 sec
    my $dec_poll = "6";
    my $poll = sprintf ("%08b",$dec_poll);

    # $precision = 0; is the precission interval undefined local clock
+ pecision
    my $dec_precision = "0";
    my $precision = sprintf ("%08b",$dec_precision);
    
    # $root_delay = 0; is the roundtrip delay 32 bit client is 0
    my $dec_root_delay = "0";
    my $root_delay = sprintf ("%032b",$dec_root_delay);

    # $root_dispersion = 0; is the nominal error relative to the prima
+ry reference
    my $dec_root_dispersion = "0";
    my $root_dispersion = sprintf ("%032b",$dec_root_dispersion);

    # $reference_identifier = 0; is the nominal error relative to the 
+primary reference
    my $dec_reference_identifier = "0";
    my $reference_identifier = sprintf ("%032b",$dec_reference_identif
+ier);

    # $epoc_ref = time(); local clock last updated
    my ($dec_epoc_ref, $usec_ref) = gettimeofday();
    my $epoc_ref = sprintf ("%064b",$dec_epoc_ref);

    # $epoc_send = time(); local clock when packet was send
    my ($dec_epoc_send, $usec_send) = gettimeofday();
    my $epoc_send = sprintf ("%064b",$dec_epoc_send);
    
    my $ntp_packet = $li . $vn . $mode . $stratum . $poll . $precision
+ . $root_delay . $root_dispersion . $reference_identifier . $epoc_ref
+ . $epoc_send;

    my $clock_t0 = clock();
    $client_socket->send($ntp_packet) 
    or die "Client send: $!\n";

    printf "\nNumber of seconds since Jan 1, 1970 - ".$dec_epoc_send."
+ time of message departure.\n";
    #read operation
    # For verification purposes causing 2 sec delay.
    sleep(2);
    $client_socket->recv($received_data,MAXBYTES)
    or die "Client send: $!\n";
    my $clock_t1 = clock();
    my ($epoc_receive, $usec_receive) = gettimeofday();

    #my $roundtrip_time = $clock_t1 - $clock_t0;
    
    printf "Number of seconds since Jan 1, 1970 - ".$epoc_receive." ti
+me of message arrival.\n";
    
    if ($received_data eq 'Invalid Request') {
    printf("Server send: ".$received_data.", please check the message 
+send!\n");
    exit();
    }
    else {
    my $server_li_binary =  substr($received_data, 0, 2);
    my $server_li = oct("0b".$server_li_binary);

    my $server_vn_binary =  substr($received_data, 2, 3);
    my $server_vn = oct("0b".$server_vn_binary);

    my $server_mode_binary =  substr($received_data, 5, 3);
    my $server_mode = oct("0b".$server_mode_binary);

    my $server_stratum_binary =  substr($received_data, 8, 8);
    my $server_stratum = oct("0b".$server_stratum_binary);

    my $server_poll_interval_binary =  substr($received_data, 16, 8);
    my $server_poll_interval = oct("0b".$server_poll_interval_binary);

    my $server_precision_binary =  substr($received_data, 24, 8);
    my $server_precision = oct("0b".$server_precision_binary);

    my $server_root_delay_binary =  substr($received_data, 32, 32);
    my $server_root_delay = oct("0b".$server_root_delay_binary);

    my $server_root_dispersion_binary =  substr($received_data, 64, 32
+);
    my $server_root_dispersion = oct("0b".$server_root_dispersion_bina
+ry);

    my $server_root_identifier_binary =  substr($received_data, 96, 32
+);
    my $server_root_identifier  = pack("B32", $server_root_identifier_
+binary);

    my $ref_server_epoch_binary =  substr($received_data, 128, 64);
    my $ref_server_epoch = oct("0b".$ref_server_epoch_binary);

    my $originate_server_epoch_binary =  substr($received_data, 192, 6
+4);
    my $originate_server_epoch = oct("0b".$originate_server_epoch_bina
+ry);

    my $receive_server_epoch_binary =  substr($received_data, 256, 64)
+;
    my $receive_server_epoch = oct("0b".$receive_server_epoch_binary);

    my $transmit_server_epoch_binary =  substr($received_data, 320, 64
+);
    my $transmit_server_epoch = oct("0b".$transmit_server_epoch_binary
+);

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

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

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

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

    my $d = (($epoc_receive - $dec_epoc_send) - ($receive_server_epoch
+ - $transmit_server_epoch));
    my $t = ((($receive_server_epoch - $dec_epoc_send) + ($transmit_se
+rver_epoch - $epoc_receive))/2);

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

    print "\n         Field Name         Unicast/Anycast
                                Request \t Reply
        -----------------------------------------------
        LI \t                   $dec_li \t\t   $server_li
        VN \t                   $dec_vn \t\t   $server_vn
        Mode \t                   $dec_mode \t\t   $server_mode
        Stratum \t           $dec_stratum \t\t   $server_stratum
        Poll \t                   $dec_poll \t\t   $server_poll_interv
+al
        Precision \t           $dec_precision \t\t   $server_precision
        Root Delay \t           $dec_root_delay \t\t   $server_root_de
+lay
        Root Dispersion \t   $dec_root_dispersion \t\t   $server_root_
+dispersion
        Reference Identifier \t   $dec_reference_identifier \t\t   $se
+rver_root_identifier
        Reference Timestamp \t   $dec_epoc_send \t   $ref_server_epoch
        Originate Timestamp \t   $dec_epoc_send \t   $originate_server
+_epoch
        Receive Timestamp \t   $epoc_receive \t   $receive_server_epoc
+h
        Transmit Timestamp \t   0   \t\t   $transmit_server_epoch\n\n"
+;

    }
    $client_socket->close(); # Close socket()
} # End of else condition (ARGV[])

[download]

I have added 2 seconds delay on Client to check the calculation part.

Working code of Server:

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

use constant TRUE      => scalar 1;
use constant PORT      => scalar 12345;
use constant MAXBYTES  => scalar 1024;
use constant ARGUMENTS => scalar 0;

# flush after every initialization
$| = 1;

my ($server_socket,$received_data,$peer_address,$peer_port,$ntp_packet
+);

# we call IO::Socket::INET->new() to create the UDP Socket and bound

if (@ARGV > ARGUMENTS) {
    print "\nPlease no more than ".ARGUMENTS." arguments (ARGV[])!\n";
    print "\nCorrect Syntax: perl $0 \n\n";
    exit();
}
else {

    $server_socket = new IO::Socket::INET (
    LocalPort => 12345, # Default NTP port 123
    Type      => SOCK_DGRAM,
    Proto     => 'udp',
    ) or die "ERROR in Socket Creation : $!\n";

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

    while (TRUE) {
    
    # read operation on the socket
    $server_socket->recv($received_data,MAXBYTES) 
        or die "Server received: $!\n";
    my ($epoc_rec_sec, $epoc_rec_nano_sec) = gettimeofday();

    $peer_address = $server_socket->peerhost();
    $peer_port = $server_socket->peerport();

        #send the data to the client at which the read/write operation
+s done recently.
    if ($received_data) {

        my $server_li_binary =  substr($received_data, 0, 2);
        my $server_li = oct("0b".$server_li_binary);

        my $server_vn_binary =  substr($received_data, 2, 3);
        my $server_vn = oct("0b".$server_vn_binary);

        my $server_mode_binary =  substr($received_data, 5, 3);
        my $server_mode = oct("0b".$server_mode_binary);

        my $server_stratum_binary =  substr($received_data, 8, 8);
        my $server_stratum = oct("0b".$server_stratum_binary);

        my $server_poll_interval_binary =  substr($received_data, 16, 
+8);
        my $server_poll_interval = oct("0b".$server_poll_interval_bina
+ry);

        my $server_precission_binary =  substr($received_data, 24, 8);
        my $server_precission = oct("0b".$server_precission_binary);

        my $server_root_delay_binary =  substr($received_data, 32, 32)
+;
        my $server_root_delay = oct("0b".$server_root_delay_binary);

        my $server_root_dispersion_binary =  substr($received_data, 64
+, 32);
        my $server_root_dispersion = oct("0b".$server_root_dispersion_
+binary);

        my $server_root_identifier_binary =  substr($received_data, 96
+, 32);
        my $server_root_identifier = oct("0b".$server_root_identifier_
+binary);

        my $ref_client_epoch_binary =  substr($received_data, 128, 64)
+;
        my $ref_client_epoch = oct("0b".$ref_client_epoch_binary);

        my $originate_client_epoch_binary =  substr($received_data, 19
+2, 64);
        my $originate_client_epoch = oct("0b".$originate_client_epoch_
+binary);

        printf "\nNumber of seconds since Jan 1, 1970 - ".$epoc_rec_se
+c." time of message arrival.\n";

            # save exported data...prepare new packet

        my $difference = $epoc_rec_sec - $originate_client_epoch;

        my $dec_li;

        if ($difference < 59) {
        
        $dec_li = "0";

        } elsif ($difference > 61 ) {

        $dec_li = "1";

        } else {

        $dec_li = "3";

        }

            # $li = 0; is the client we have no waring for asynchroniz
+ation
        my $li = sprintf ("%02b",$dec_li);

            # $vn = 3; is the version 3 only IPV4
        my $dec_vn = "3";
        my $vn = sprintf ("%03b",$dec_vn);

            # $mode = 4; is the server (mode 4) 
        my $dec_mode = "4";
        my $mode = sprintf ("%03b",$dec_mode);

            # $stratum = 1; is the server clock which is radio or cloc
+k (Read RFC)
        my $dec_stratum = "1";
        my $stratum = sprintf ("%08b",$dec_stratum);

            # $poll = 6; maximum interval between messages 6 = 64 sec
        my $dec_poll = "6";
        my $poll = sprintf ("%08b",$dec_poll);

            # $precision = 0; is the precission interval undefined loc
+al clock pecision
        my $dec_precision = "0";
        my $precision = sprintf ("%08b",$dec_precision);

            # $root_delay = 0; is the roundtrip delay 32 bit client is
+ 0
        my $dec_root_delay = "0";
        my $root_delay = sprintf ("%032b",$dec_root_delay);

            # $root_dispersion = 0; is the nominal error relative to t
+he primary reference
        my $dec_root_dispersion = "0";
        my $root_dispersion = sprintf ("%032b",$dec_root_dispersion);

            # $reference_identifier = 0; is the nominal error relative
+ to the primary reference
        my $reference_identifier_str = "LOCL";
        my $reference_identifier .= unpack("B32", $reference_identifie
+r_str);

        my ($dec_epoc_ref, $epoc_ref_nano_sec) = gettimeofday();
        my $epoc_ref = sprintf ("%064b",$dec_epoc_ref);

        # $ref_client_epoch is the time that the message departed the 
+client
        my $epoc_send = sprintf ("%064b",$ref_client_epoch);

            # Receive time of msg client
        my $epoc_rec_sec_msg = sprintf ("%064b",$epoc_rec_sec);

        #printf "\$epoc_rec_sec_msg: ".$epoc_rec_sec."\n";

        my ($dec_epoc_sec_send, $dec_epoc_nano_sec_send) = gettimeofda
+y();
        my $epoc_send_msg = sprintf ("%064b",$dec_epoc_sec_send);

            #get the peerhost and peerport at which the recent data re
+ceived.

            #print "\n(".$time." \, ".$peer_address.") data received a
+t port number: ".$peer_port." Client said: ".$received_data."\n";

        printf "Number of seconds since Jan 1, 1970 - ".$dec_epoc_sec_
+send." time of message departure.\n";

        $ntp_packet = $li . $vn . $mode . $stratum . $poll . $precisio
+n . $root_delay . $root_dispersion . $reference_identifier . $epoc_re
+f . $epoc_send . $epoc_rec_sec_msg . $epoc_send_msg;

    } # End of if($received_data)
    else {
        $ntp_packet = "Invalid Request";
    }

    $server_socket->send($ntp_packet)
        or die "Server Send: $!\n";
    } # End of while loop

} #End of else ARGV
$server_socket->close(); # Close socket

[download]

Sample of output:

Number of seconds since Jan 1, 1970 - 1410816865 time of message depar
+ture.
Number of seconds since Jan 1, 1970 - 1410816867 time of message arriv
+al.


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

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

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

Round Trip delay: 2
Clock offset: -1

         Field Name         Unicast/Anycast
                                Request      Reply
        -----------------------------------------------
        LI                        0            0
        VN                        3            3
        Mode                        3            4
        Stratum                0            1
        Poll                        6            6
        Precision                0            0
        Root Delay                0            0
        Root Dispersion        0            0
        Reference Identifier        0            LOCL
        Reference Timestamp        1410816865        1410816865
        Originate Timestamp        1410816865        1410816865
        Receive Timestamp        1410816867        1410816865
        Transmit Timestamp        0              1410816865

[download]

Thank you in advance for everyone's time and effort read and review my question.

Seeking for Perl wisdom...on the process of learning...not there...yet!

In reply to UDP SNTP Client/Server RFC by thanos1983

Title:
Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post, it's "PerlMonks-approved HTML":


  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, details, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, summary, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.