SNTP pack and unpack

thanos1983 has asked for the wisdom of the Perl Monks concerning the following question:

Dear Monks,

Several days now, I have been trying to find the correct TEMPLATE combinations on pack and unpack. I have tried any possible combination that I can understand through reading the documentation and I can not figure it out how to print the correct output.

The code seems to be working fine, or at least some printouts are coming correctly the minor details is that are messing up completely my result.

Can someone assist me who is more experienced can help me with my problem?

I was reading also the Net::NTP source code which is which the result is what I want to have, I mean the number and precision not the output.

Update: polishing code removing unnecessary parts. Also including sample of output.

Update 2: modifying code based on elaborating input from cheako. Also including sample of output.

How to execute the script: perl sample.pl 0.se.pool.ntp.org:123

Sample of code:

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

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 $rcvSntpPacket;

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 d
+enied switch to client set
    Proto    => 'udp'
    ) or die "ERROR in Socket Creation: $@\n";

    my $Peer_Port = $client_socket->peerport();

    my $client_li_vm_mode = '00100011'; # 8 bit
    my $client_stratum = '0'; # 8 bit
    my $client_poll = '0'; # 8 bit
    my $client_precision = '0'; # 8 bit
    my $client_root_delay = '0'; # 32 bit
    my $client_dispersion = '0'; # 32 bit
    my $client_reference_identifier = '0'; # 32 bit
    my $client_reference_timestamp_sec = '0'; # 32 bit
    my $client_reference_timestamp_microsec = '0'; # 32 bit
    my $client_receive_timestamp_sec = '0'; # 32 bit
    my $client_receive_timestamp_microsec = '0'; # 32 bit

    my ( $client_transmit_sec , $client_transmit_microsec ) = gettimeo
+fday(); # 64 bit

    my $client_originate_timestamp_sec = $client_transmit_sec;
    my $client_originate_timestamp_microsec = $client_transmit_microse
+c;

    my @arraySendSntpPacket = ($client_li_vm_mode , $client_stratum , 
+$client_poll , $client_precision , $client_root_delay , $client_dispe
+rsion , $client_reference_identifier , $client_reference_timestamp_se
+c , $client_reference_timestamp_microsec , $client_originate_timestam
+p_sec , $client_originate_timestamp_microsec , $client_receive_timest
+amp_sec , $client_receive_timestamp_microsec , $client_transmit_sec ,
+ $client_transmit_microsec );

    warn Dumper \@arraySendSntpPacket;

    my $sendSntpPacket = pack "B8 C3 N11", @arraySendSntpPacket;

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

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

    my ( $client_rcv_sec , $client_rcv_microsec ) = gettimeofday();

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

    my @arrayRcvSntpPacket = unpack("B8 C3 N11" , $rcvSntpPacket);

    my ( $server_li_vm_mode , $server_stratum , $server_poll_interval 
+, $server_precision , $server_root_delay , $server_dispersion , $serv
+er_reference_identifier , $server_reference_timestamp_sec , $server_r
+eference_timestamp_microsec , $server_originate_timestamp_sec , $serv
+er_originate_timestamp_microsec , $server_rcv_timestamp_sec , $server
+_rcv_timestamp_microsec , $server_transmit_timestamp_sec , $server_tr
+ansmit_timestamp_microsec ) = @arrayRcvSntpPacket;

    warn Dumper \@arrayRcvSntpPacket;

} # End of else ARGV provided
[download]

Sample of output.

$VAR1 = [
          '00100011',
          '0',
          '0',
          '0',
          '0',
          '0',
          '0',
          '0',
          '0',
          1425730335,
          839953,
          '0',
          '0',
          1425730335,
          839953
        ];
$VAR1 = [
          '00100100',
          1,
          110,
          0,
          0,
          4294942144,
          2214694912,
          1425730335,
          2080374784,
          1425730335,
          268435456,
          1425730335,
          0,
          0,
          0
        ];
[download]

Expected output:

$VAR1 = [
          '00100011',
          '0',
          '0',
          '0',
          '0',
          '0',
          '0',
          '0',
          '0',
          1425730335,
          839953,
          '0',
          '0',
          1425730335,
          839953
        ];
$VAR1 = [
          '00100100',
          1,
          110,
          0,
          0,
          4294942144,
          2214694912,
          1425730335, 
          2080374784, # instead  839953,
          1425730335,
          268435456,  # instead  839953,
          1425730335,
          0,
          0,
          0
        ];
[download]

Final Update with solution: In case of future reference. The solution to my question is the following.

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

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;
use constant UNIX_EPOCH => 2208988800;

my $unpack_ip = sub {
    my $ip;
    my $stratum = shift;
    my $tmp_ip = shift;
    if($stratum < 2){
    $ip = unpack("A4", 
             pack("H8", $tmp_ip)
            );
    }else{
    $ip = sprintf("%d.%d.%d.%d",
              unpack("C4",
                 pack("H8", $tmp_ip)
              )
            );
    }
    return $ip;
};

my $frac2bin = sub {
    my $bin  = '';
    my $frac = shift;
    while ( length($bin) < 32 ) {
    $bin  = $bin . int( $frac * 2 );
    $frac = ( $frac * 2 ) - ( int( $frac * 2 ) );
    }
    return $bin;
};

my $bin2frac = sub {
    my @bin = split '', shift;
    my $frac = 0;
    while (@bin) {
    $frac = ( $frac + pop @bin ) / 2;
    }
    return $frac;
};

my $dot = ".";
my $rcvSntpPacket;
my $serverPrecision;

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

my $client_socket = new IO::Socket::INET (
    PeerHost => $input[0],
    Type     => SOCK_DGRAM,
    PeerPort => $input[1],
    Proto    => 'udp'
    ) or die "ERROR in Socket Creation: $@\n";

my $Peer_Port = $client_socket->peerport();

my $client_li_vn_mode = '00100011'; # 8 bit
my $client_stratum = '0'; # 8 bit
my $client_poll = '0'; # 8 bit
my $client_precision = '0'; # 8 bit
my $client_root_delay = '0'; # 32 bit
my $client_dispersion = '0'; # 32 bit
my $client_reference_identifier = '0'; # 32 bit
my $client_reference_timestamp_sec = '0'; # 32 bit
my $client_reference_timestamp_microsec = '0'; # 32 bit
my $client_originate_timestamp_sec = 0; # 32 bit
my $client_originate_timestamp_microsec = 0; # 32 bit
my $client_receive_timestamp_sec = '0'; # 32 bit
my $client_receive_timestamp_microsec = '0'; # 32 bit

my ($client_transmit_sec , $client_transmit_microsec) = gettimeofday()
+;
my $client_transmit_timestamp = $client_transmit_sec . $dot . $client_
+transmit_microsec;

my @arraySendSntpPacket = ($client_li_vn_mode , $client_stratum , $cli
+ent_poll , $client_precision , $client_root_delay , $client_dispersio
+n , $client_reference_identifier , $client_reference_timestamp_sec , 
+$client_reference_timestamp_microsec , $client_originate_timestamp_se
+c , $client_originate_timestamp_microsec , $client_receive_timestamp_
+sec , $client_receive_timestamp_microsec , $client_transmit_sec , $cl
+ient_transmit_microsec );

my $sendSntpPacket = pack "B8 C3 N10 B32", @arraySendSntpPacket;

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

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

my ($client_rcv_sec , $client_rcv_microsec) = gettimeofday();
my $client_rcv_timestamp = $client_rcv_sec . $dot . $client_rcv_micros
+ec;

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

my @arrayRcvSntpPacket = unpack("a C3   n B16 n B16 H8   N B32 N B32  
+ N B32 N B32" , $rcvSntpPacket);

my ( $server_li_vm_mode , $server_stratum , $server_poll_interval , $s
+erver_precision , $server_root_delay_sec , $server_root_delay_microse
+c , $server_dispersion_sec , $server_dispersion_microsec , $server_re
+ference_identifier , $server_reference_timestamp_sec , $server_refere
+nce_timestamp_microsec , $server_originate_timestamp_sec , $server_or
+iginate_timestamp_microsec , $server_rcv_timestamp_sec , $server_rcv_
+timestamp_microsec , $server_transmit_timestamp_sec , $server_transmi
+t_timestamp_microsec ) = @arrayRcvSntpPacket;

my @serverLiVnMode = ((unpack( "C", $server_li_vm_mode & "\xC0" ) >> 6
+),
              (unpack( "C", $server_li_vm_mode & "\x38" ) >> 3),
              (unpack( "C", $server_li_vm_mode & "\x07" )));

my $serverPoll = (sprintf("%0.1d", $server_poll_interval));

if ($server_precision < 127) {
    $server_precision = 0;
}
else {
    $server_precision = $server_precision - 255;
}

my $serverRootDelay = ($bin2frac -> ($server_root_delay_microsec));
my $serverDispersionSeconds = sprintf("%0.10f", $server_dispersion_sec
+);
$serverDispersionSeconds =~ s/\..*$//;
my $serverDispersionFinalSeconds = $bin2frac->($serverDispersionSecond
+s);
my $serverDispersionMicroSeconds = sprintf("%0.10f", $server_dispersio
+n_microsec);
$serverDispersionMicroSeconds =~ s/\..*$//;
my $serverDispersionFinalMicroSeconds = $bin2frac->($serverDispersionM
+icroSeconds);
my $serverReferenceIdentifier = $unpack_ip->($server_stratum,$server_r
+eference_identifier);
(($server_reference_timestamp_sec += $bin2frac->($server_reference_tim
+estamp_microsec)) -= UNIX_EPOCH);
($server_originate_timestamp_sec += $bin2frac->($server_originate_time
+stamp_microsec));
(($server_rcv_timestamp_sec += $bin2frac->($server_rcv_timestamp_micro
+sec)) -= UNIX_EPOCH);
(($server_transmit_timestamp_sec += $bin2frac->($server_transmit_times
+tamp_microsec)) -= UNIX_EPOCH);

# RFC2030 reference https://tools.ietf.org/html/rfc4330
my $d = ( ( $client_rcv_timestamp -  $client_transmit_timestamp ) - ( 
+$server_rcv_timestamp_sec - $server_transmit_timestamp_sec ) );
my $t = ( ( ( $server_rcv_timestamp_sec -  $client_transmit_timestamp 
+) + ( $server_transmit_timestamp_sec - $client_rcv_timestamp ) ) / 2 
+);

# Clear screen for viewing the output
system $^O eq 'MSWin32' ? 'cls' : 'clear';

print "Round Trip delay: ".$d."\n";
print "Clock offset: ".$t."\n";
[download]

Sample of output:

Round Trip delay: 0.0255537033081055
Clock offset: 0.000513792037963867
[download]

Analysis of expected output:

Based on RFC 4330 we can find how the sequence of sending and receiving bytes format should be. I think I have made a major mistake somewhere where I am receiving the message. I am using unpack("B8 C3 N11" , $rcvSntpPacket); where N I think is ok for the timestamp sec but it modifies the timestamp microsec. Both are 32 bit but upon receiving it is a mess.

Thank you in advance for your time and effort.

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

Comment on SNTP pack and unpack Select or Download Code

Replies are listed 'Best First'.
Re: SNTP pack and unpack by Anonymous Monk on Mar 07, 2015 at 00:04 UTC
There is too much stuff in code tags thats not directly related to pack/unpack, please clean it, chances of getting an answer increase if format is like this, and the data is fixed/repeatable and you know what to expect `use Data::Dump qw/ dd /; my $wanted => { hi => 4, bye => 2 }; my $raw = "bits"; dd( $wanted , RawToRecord( $raw ) ); sub RawToRecord { my( $raw ) = @_; %record ... unpack ... pack ...; return \%record; }` [download] That way you can only focus on pack/unpack with known data, only focus on the template, once you get that working, work on the rest of the program	[reply] [d/l]
Re^2: SNTP pack and unpack by thanos1983 (Parson) on Mar 07, 2015 at 01:47 UTC
Hello Anonymous Monk, Thank you for your time and effort. Well I am afraid that it is not so clear to me your solution I will try to work on it though. Again I appreciate your time. BR Seeking for Perl wisdom...on the process of learning...not there...yet!	[reply] [d/l] [select]
Re^3: SNTP pack and unpack by Anonymous Monk on Mar 07, 2015 at 04:08 UTC
its not a solution, its an outline on how to ask the question so it doesn't depend on things like an SNTP server... you did do some cleaning of your code and provided sample of error output, but now what the correct output is supposed to be	[reply]
Re: SNTP pack and unpack by cheako (Beadle) on Mar 07, 2015 at 00:00 UTC
Here are two solutions and the problem. cheako@arcadia:~$ perl warn unpack("B620",pack( 'B8 C3 N10 B32', '00100011', '0', '0', '0', '0', '0', '0', '0', '0', 1425691777, 761152, '0', '0', 1425691777, 761152 )); 00100011000000000000000000000000 00000000000000000000000000000000 00000000000000000000000000000000 00000000000000000000000000000000 00000000000000000000000000000000 00000000000000000000000000000000 01010100111110100101010010000001 00000000000010111001110101000000 00000000000000000000000000000000 00000000000000000000000000000000 01010100111110100101010010000001 10111000000000000000000000000000 at - line 1. Different output, but identical input :/. cheako@arcadia:~$ perl warn unpack("B620",pack( 'B8 C3 N11', '00100011', '0', '0', '0', '0', '0', '0', '0', '0', 1425691777, 761152, '0', '0', 1425691777, 761152 )); cheako@arcadia:~$ perl warn unpack("B620",pack( 'B8 C3 N11', '00100011', '0', '0', '0', '0', '0', '0', '0', '0', 1425691777, 761152, '0', '0', 1425691777, 761152 )); 00100011000000000000000000000000 00000000000000000000000000000000 00000000000000000000000000000000 00000000000000000000000000000000 00000000000000000000000000000000 00000000000000000000000000000000 01010100111110100101010010000001 00000000000010111001110101000000 00000000000000000000000000000000 00000000000000000000000000000000 01010100111110100101010010000001 00000000000010111001110101000000 at - line 1. cheako@arcadia:~$ perl warn unpack("B620",pack( 'B8 C3 N10 B32', '00100011', '0', '0', '0', '0', '0', '0', '0', '0', 1425691777, 761152, '0', '0', 1425691777, '00000000000010111001110101000000' )); 00100011000000000000000000000000 00000000000000000000000000000000 00000000000000000000000000000000 00000000000000000000000000000000 00000000000000000000000000000000 00000000000000000000000000000000 01010100111110100101010010000001 00000000000010111001110101000000 00000000000000000000000000000000 00000000000000000000000000000000 01010100111110100101010010000001 00000000000010111001110101000000 at - line 1. [download] I've a lot of experience with pack and unpack and every time I learn something new, seems they never behave the way one would think they should. Check it with a `warn unpack("B384",$send_sntp_packet)` the best thing you can do at times like this is add in warn every branch. my@argsforpacksend_sntp_packet=($client_li_vm_mode , + $client_stratum , $client_poll , $client_precision , $client_root_de +lay , $client_dispersion , $client_reference_identifier , $client_ref +erence_timestamp_sec , $client_reference_timestamp_microsec , $client +_originate_timestamp_sec , $client_originate_timestamp_microsec , $cl +ient_receive_timestamp_sec , $client_receive_timestamp_microsec , $cl +ient_transmit_sec , $client_transmit_microsec); warn Dumper \@argsfo +rpacksend_sntp_packet; my $send_sntp_packet = pack "B8 C3 N10 B32", @argsforpacksend_sntp_p +acket; warn unpack("B384",$send_sntp_packet) [download] Wrap each call to pack/unpack like this and you'll see what's wrong.	[reply] [d/l] [select]
Re^2: SNTP pack and unpack by thanos1983 (Parson) on Mar 07, 2015 at 01:33 UTC
Hello cheako, Thank you for your time and effort reading and replying to my question. I modified the code as you propose and also I am using `use diagnostics;` as I found online to assist me identifying the error. Still I can not understand why my send packet is wrong. This is the output that I am getting when I execute the code. `Client Transmit: Sat Mar 7 02:29:37 2015 $VAR1 = [ 'B8 C3 N10 B32', '00100011', '0', '0', '0', '0', '0', '0', '0', '0', 1425691777, 761152, '0', '0', 1425691777, 761152 ]; Invalid type '1' in pack at NTPperl.pl line 50 (#1) (F) The given character is not a valid pack or unpack type. See "pack" in perlfunc. (W) The given character is not a valid pack or unpack type but use +d to be silently ignored. Uncaught exception from user code: Invalid type '1' in pack at NTPperl.pl line 50.` [download] Line 50 is: `my $send_sntp_packet = pack @argsforpacksend_sntp_packet;` [download] Seeking for Perl wisdom...on the process of learning...not there...yet!	[reply] [d/l] [select]
Re^3: SNTP pack and unpack by choroba (Cardinal) on Mar 07, 2015 at 02:03 UTC
As can be easily demonstrated by `print prototype 'CORE::pack';` [download] pack evaluates the first argument in scalar context. If you supply an array, it turns into the number of its members. You got 1, which is double weird, as it means the array only had one member - you have to supply two things to `pack`, the template and the list (and, as we have just seen, you can't bundle them in one array). لսႽ� ᥲᥒ⚪⟊Ⴙᘓᖇ Ꮅᘓᖇ⎱ Ⴙᥲ𝇋ƙᘓᖇ	[reply] [d/l] [select]
Re^4: SNTP pack and unpack by thanos1983 (Parson) on Mar 07, 2015 at 17:23 UTC
Re^2: SNTP pack and unpack by Anonymous Monk on Mar 07, 2015 at 11:06 UTC
Node has been edited again; please mark your updates. See also the section "It is uncool to update a node in a way that renders replies confusing or meaningless" in How do I change/delete my post?	[reply]
Re^2: SNTP pack and unpack by Anonymous Monk on Mar 07, 2015 at 00:42 UTC
At the time of posting the node consisted of a single dot, and was replaced by its current content roughly 30 mins later. Looks like cheako followed ambrus's advice.	[reply]
A reply falls below the community's threshold of quality. You may see it by logging in.
Re^2: SNTP pack and unpack by thanos1983 (Parson) on Mar 07, 2015 at 12:13 UTC
Hello again cheako, Thank you for your time and effort again. You answer helped a lot to understand much more. I have updated my code and the sample of output that I am getting. and also the expected output. Seeking for Perl wisdom...on the process of learning...not there...yet!	[reply] [d/l] [select]
Re^2: SNTP pack and unpack by Anonymous Monk on Mar 07, 2015 at 00:07 UTC
Hi cheako , if you're itching for replies, reply to your own nodes, don't bother the nice people working on code ... also look at Past Polls, no code required there, just jokes and regular opinions, great place to earn some karma	[reply]
A reply falls below the community's threshold of quality. You may see it by logging in.
Re^2: SNTP pack and unpack by cheako (Beadle) on Mar 07, 2015 at 02:09 UTC
Adding debugging and working with the output was the right path. Even if I didn't know pack would behave that way when given a list.	[reply]