|
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
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
];
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
];
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";
Sample of output:
Round Trip delay: 0.0255537033081055
Clock offset: 0.000513792037963867
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!
|
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;
}
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] |
|
|
| [reply]
[d/l]
[select] |
|
|
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.
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)
Wrap each call to pack/unpack like this and you'll see what's wrong. | [reply]
[d/l]
[select] |
|
|
| [reply] |
A reply falls below the community's threshold of quality. You may see it by logging in.
| |
|
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.
Line 50 is:
my $send_sntp_packet = pack @argsforpacksend_sntp_packet;
Seeking for Perl wisdom...on the process of learning...not there...yet!
| [reply]
[d/l]
[select] |
|
|
As can be easily demonstrated by
print prototype 'CORE::pack';
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] |
|
|
|
|
| [reply] |
|
|
| [reply]
[d/l]
[select] |
|
|
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.
| |
|
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] |
|
|
