#!/usr/bin/perl
use strict;
use warnings;
use Data::Dumper;
#path to the location of the module
use lib '/home/username/Desktop/SNTP_Module/'; # note here
use Net::SNTP::Client;
=netNTP
use Net::NTP;
my %response = get_ntp_response("192.36.144.22:123");
print Dumper \%response;
=cut
my %hashInput = (
-hostname => "192.36.144.22",
-port => 123,
-RFC4330 => 1,
-clearScreen => 1,
);
my ($error, $hashOutput) = getSNTPTime( %hashInput );
print Dumper $hashOutput;
print "Error: $error\n" if ($error);
####
-hostname => NTP Hostname or NTP IP
-port => 123 Default or Users choice e.g. 5000
-RFC4330 => 1
-clearScreen => 1
####
package Net::SNTP::Client;
=head1 NAME
Net::SNTP::Client - Perl module to retrieve higher accuracy from NTP server
=head1 SYNOPSIS
use Net::SNTP::Client;
my %hashInput = (
-hostname => "0.pool.ntp.org", # hostnmae or IP
-port => 123, # default NTP port 123
-RFC4330 => 1,
-clearScreen => 1,
);
my ( $error , $hashRefOutput ) = getSNTPTime( %hashInput );
=head1 ABSTRACT
The module sends a UDP packet formated according to L to a defined NTP server set by the user. The received packet, gets decoded to a human readable form and also calculated the roundtrip delay d and system clock offset t, based on the decoded data.
=head1 DESCRIPTION
This module exports a single method (getSNTPTime) and returns an associative hash of hashes upon RFC4330 and a string in case of an error occurs. The response from the NTP or SNTP server is beeen decoded to a human readable format. The obtained information recieved from the server can be can be used into further processing or manipulation according to the user needs. Maximum accuracy down to nano seconds can only be achieved on LinuxOS.
=head2 EXPORT
my %hashInput = (
-hostname => "0.pool.ntp.org", # hostnmae or IP
-port => 123, # default NTP port 123
-RFC4330 => 1,
-clearScreen => 1,
);
my ( $error , $hashRefOutput ) = getSNTPTime( %hashInput );
This module exports a single method - getSNTPTime and an error string in case of an error or a faulty operation. It expects a hash as an input. The input can have four different hash keys => values (-hostname, port, RFC4330 and -clearScreen).
-hostname: The mandatory key inorder the method to produce an output is only the hostname, the rest of the keys are optional.
-port: By default the the port is set to 123 (NTP default port). The user has the option to overwite the port based on his preference (e.g. -port => 123456).
-RFC4330: This is an optional way to produce an easy visuable output based on RFC4330 documentation.
-clearScreen: This is an optional choice based on user preference if he/she desires to clear the "terminal screen" before printing the captured data.
=cut
use strict;
use warnings;
## Validate the version of Perl
BEGIN
{
die 'Perl version 5.6.0 or greater is required' if ($] < 5.006);
}
## Version of the Net::SNTP::Client module
our $VERSION = '0.01';
$VERSION = eval $VERSION;
## Load our modules
use IO::Socket::INET;
use Time::HiRes qw( gettimeofday );
## Handle importing/exporting of symbols
use base qw( Exporter );
our @ISA = qw ( Exporter );
our @EXPORT = qw ( getSNTPTime );
## Define constands
use constant {
TRUE => 1,
FALSE => 0,
MAXBYTES => 512,
ARGUMENTS => 1,
UNIX_EPOCH => 2208988800,
MIN_UDP_PORT => 1,
MAX_UDP_PORT => 65535,
DEFAULT_NTP_PORT => 123,
};
sub getSNTPTime {
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 $bin_2_frac = sub {
my @bin = split '', shift;
my $frac = 0;
while (@bin) {
$frac = ( $frac + pop @bin ) / 2;
}
return $frac;
};
my $bin_2_dec = sub {
my $bits = shift;
my $size = shift;
my $template = shift;
return unpack($template, pack("B$size", substr("0" x $size . $bits , -$size)));
};
my $checkHashKeys = sub {
my @keysToCompare = ( "-hostname", "-port", "-RFC4330", "-clearScreen" );
my %hashInputToCompare = @_;
my @hashInputKeysToCompare = keys %hashInputToCompare;
my @differendKeys = keyDifference(\@hashInputKeysToCompare, \@keysToCompare);
if (@differendKeys) { return TRUE } else { return FALSE };
sub keyDifference {
my %hashdiff = map{ $_ => 1 } @{$_[1]};
return grep { !defined $hashdiff{$_} } @{$_[0]};
}
};
my $verify_port = sub {
my $port = shift;
if ( defined $port && $port =~ /^[+-]?(?=\.?\d)\d*\.?\d*(?:e[+-]?\d+)?\z/i ) {
if ( $port <= MIN_UDP_PORT || $port >= MAX_UDP_PORT ) {
return TRUE;
}
}
return FALSE;
};
my $dot = ".";
my $error = undef;
my $rcvSntpPacket = undef;
my %moduleInput = @_;
my %moduleOutput = ();
return ($error = "Not defined key(s)", \%moduleInput) if ($checkHashKeys->(%moduleInput));
return ($error = "Not defined Hostname", \%moduleInput) if (!$moduleInput{-hostname});
return ($error = "Not correct port number", \%moduleInput) if ($verify_port->($moduleInput{-port}));
my $client_socket;
eval {
$client_socket = new IO::Socket::INET (
PeerHost => $moduleInput{-hostname},
Type => SOCK_DGRAM,
PeerPort => $moduleInput{-port} || DEFAULT_NTP_PORT, # Default NTP port 123
Proto => 'udp'
) or die "Error Creating Socket";
};
return ($error = "Problem While Creating Socket '$!'", \%moduleInput) if ( $@ && $@ =~ /Error Creating Socket/ );
my $clientLi = 0;
my $clientVn = 4;
my $clientMode = 3;
# $li = 00 2 bit = value 0 no warning
# $vn = 100 3 bit = Value 4 IPV4
# $mode = 011 3 bit = Value 3 client mode
my $clientLiVnMode = '00100011'; # 8 bit
my $clientStratum = '0'; # 8 bit
my $clientPoll = '0'; # 8 bit
my $clientPrecision = '0'; # 8 bit
my $clientRootDelay = '0'; # 32 bit
my $clientDispersion = '0'; # 32 bit
my $clientReferenceIdentifier = '0'; # 32 bit
my $clientReferenceTimestampSec = '0'; # 32 bit
my $clientReferenceTimestampMicrosec = '0'; # 32 bit
my $clientOriginateTimestampSec = '0'; # 32 bit
my $clientOriginateTimestampMicrosec = '0'; # 32 bit
my $clientReceiveTimestampSec = '0'; # 32 bit
my $clientReceiveTimestampMicrosec = '0'; # 32 bit
my ($clientTransmitSec , $clientTransmitMicrosec) = gettimeofday();
my $clientTransmitTimestamp = $clientTransmitSec . $dot . $clientTransmitMicrosec;
my @arraySendSntpPacket = ( $clientLiVnMode , $clientStratum , $clientPoll , $clientPrecision , $clientRootDelay , $clientDispersion , $clientReferenceIdentifier , $clientReferenceTimestampSec , $clientReferenceTimestampMicrosec , $clientOriginateTimestampSec , $clientOriginateTimestampMicrosec , $clientReceiveTimestampSec , $clientReceiveTimestampMicrosec , $clientTransmitSec , $clientTransmitMicrosec );
my $sendSntpPacket = pack "B8 C3 N11", @arraySendSntpPacket;
eval {
$client_socket->send( $sendSntpPacket )
or die "Error Sending";
};
return ($error = "Problem While Sending '$!'", \%moduleInput) if ( $@ && $@ =~ /Error Sending/ );
eval {
$client_socket->recv( $rcvSntpPacket , MAXBYTES )
or die "Error Receiving";
};
return ($error = "Problem While Receiving '$!'", \%moduleInput) if ( $@ && $@ =~ /Error Receiving/ );
($clientReceiveTimestampSec , $clientReceiveTimestampMicrosec) = gettimeofday();
my $clientReceiveTimestamp = $clientReceiveTimestampSec . $dot . $clientReceiveTimestampMicrosec;
eval {
$client_socket->close()
or die "Error Closing Socket";
};
return ($error = "Problem While Clossing Socket '$!'", \%moduleInput) if ( $@ && $@ =~ /Error Closing Socket/ );
my @arrayRcvSntpPacket = unpack("B8 C3 n B16 n B16 H8 N8" , $rcvSntpPacket);
my ( $serverLiVnMode , $serverStratum , $serverPollInterval , $serverPrecision , $serverRootDelaySec , $serverRootDelayMicrosec , $serverDispersionSec, $serverDispersionMicrosec , $serverReferenceIdentifierBinary , $serverReferenceTimestampSec , $serverReferenceTimestampMicrosec , $serverOriginateTimestampSec , $serverOriginateTimestampMicrosec , $serverReceiveTimestampSec , $serverReceiveTimestampMicrosec , $serverTransmitTimestampSec , $serverTransmitTimestampMicrosec ) = @arrayRcvSntpPacket;
my $serverLiBinary = substr( $serverLiVnMode , 0 , 2 );
my $serverLi = $bin_2_dec->( $serverLiBinary , 8 , "c" );
my $serverVnBinary = substr( $serverLiVnMode , 2 , 3 );
my $serverVn = $bin_2_dec->( $serverVnBinary , 8 , "c" );
my $serverModeBinary = substr( $serverLiVnMode , 5 , 3 );
my $serverMode = $bin_2_dec->( $serverModeBinary , 8 , "c" );
my $serverPoll = (sprintf("%0.1d", $serverPollInterval));
if ($serverPrecision < 127) {
$serverPrecision = 0;
}
else {
$serverPrecision = $serverPrecision - 255;
}
my $serverRootDelay = ($bin_2_frac -> ($serverRootDelayMicrosec));
my $serverDispersionSeconds = sprintf("%0.10f", $serverDispersionSec);
$serverDispersionSeconds =~ s/\..*$//;
my $serverDispersionFinalSeconds = $bin_2_frac->($serverDispersionSeconds);
my $serverDispersionMicroSeconds = sprintf("%0.10f", $serverDispersionMicrosec);
$serverDispersionMicroSeconds =~ s/\..*$//;
my $serverDispersionFinalMicroSeconds = $bin_2_frac->($serverDispersionMicroSeconds);
my $serverReferenceIdentifier = $unpack_ip->($serverStratum, $serverReferenceIdentifierBinary);
$serverReferenceTimestampSec -= UNIX_EPOCH;
my $serverReferenceTimestamp = $serverReferenceTimestampSec . $dot . $serverReferenceTimestampMicrosec;
my $serverOriginateTimestamp = $serverOriginateTimestampSec . $dot . $serverOriginateTimestampMicrosec;
$serverReceiveTimestampSec -= UNIX_EPOCH;
my $serverReceiveTimestamp = $serverReceiveTimestampSec . $dot . $serverReceiveTimestampMicrosec;
$serverTransmitTimestampSec -= UNIX_EPOCH;
my $serverTransmitTimestamp = $serverTransmitTimestampSec . $dot . $serverTransmitTimestampMicrosec;
my $d = ( ( $clientReceiveTimestamp - $clientTransmitTimestamp ) - ( $serverReceiveTimestamp - $serverTransmitTimestamp ) );
my $t = ( ( ( $serverReceiveTimestamp - $clientTransmitTimestamp ) + ( $serverTransmitTimestamp - $clientReceiveTimestamp ) ) / 2 );
(system $^O eq 'MSWin32' ? 'cls' : 'clear') if ($moduleInput{-clearScreen});
if ($moduleInput{-RFC4330}) {
$moduleOutput{-RFC4330} = "
\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 ".$clientLi." \t\t\t ".$serverLi."
\t VN \t\t\t ".$clientVn." \t\t\t ".$serverVn."
\t Mode \t\t\t ".$clientMode." \t\t\t ".$serverMode."
\t Stratum \t\t ".$clientStratum." \t\t\t ".$serverStratum."
\t Poll \t\t\t ".$clientPoll." \t\t\t ".$serverPollInterval."
\t Precision \t\t ".$clientPrecision." \t\t\t ".$serverPrecision."
\t Root Delay \t\t ".$clientRootDelay." \t\t\t ".$serverRootDelay."
\t Root Dispersion \t ".$clientDispersion." \t\t\t ".$serverDispersionFinalMicroSeconds."
\t Reference Identifier \t ".$clientReferenceIdentifier." \t\t\t ".$serverReferenceIdentifier."
\t Reference Timestamp \t ".$clientReferenceTimestampSec.$clientReferenceTimestampMicrosec." \t\t\t ".$serverReferenceTimestamp."
\t Originate Timestamp \t ".$clientOriginateTimestampSec.$clientOriginateTimestampMicrosec." \t\t\t ".$serverOriginateTimestamp."
\t Receive Timestamp \t ".$clientReceiveTimestamp." \t ".$serverReceiveTimestamp."
\t Transmit Timestamp \t ".$clientTransmitTimestamp." \t ".$serverTransmitTimestamp."\n\n";
}
else {
%moduleOutput = (
$moduleInput{-hostname} => {
"LI" => $serverLi,
"VN" => $serverVn,
"Mode" => $serverMode,
"Stratum" => $serverStratum,
"Poll" => $serverPollInterval,
"Precision" => $serverPrecision,
"Root Delay" => $serverRootDelay,
"Root Dispersion" => $serverDispersionFinalMicroSeconds,
"Reference Identifier" => $serverReferenceIdentifier,
"Reference Timestamp" => $serverReferenceTimestamp,
"Originate Timestamp" => $serverOriginateTimestamp,
"Receive Timestamp" => $serverReceiveTimestamp,
"Transmit Timestamp" => $clientTransmitTimestamp,
},
$0 => {
"LI" => $clientLi,
"VN" => $clientVn,
"Mode" => $clientMode,
"Stratum" => $clientStratum,
"Poll" => $clientPoll,
"Precision" => $clientPrecision,
"Root Delay" => $clientRootDelay,
"Root Dispersion" => $clientDispersion,
"Reference Identifier" => $clientReferenceIdentifier,
"Reference Timestamp" => $clientReferenceTimestampSec.$clientReferenceTimestampMicrosec,
"Originate Timestamp" => $clientOriginateTimestampSec.$clientOriginateTimestampMicrosec,
"Receive Timestamp" => $clientReceiveTimestamp,
"Transmit Timestamp" => $serverTransmitTimestamp,
},
RFC4330 => {
"Round Trip Delay" => $d,
"Clock Offset" => $t
}
);
}
return $error, \%moduleOutput;
}
=head1 BUGS AND SUPPORT
This module should be considered beta quality, everything seems to work but it may yet contain critical bugs.
If you find any, report it via email (to garyfalos@cpan.org), please.
Feedback and comments are also welcome!
=head1 SEE ALSO
perl, IO::Socket, Net::NTP, RFC4330
Net::NTP has a similar focus as this module. In my opinion it is less accurate when it comes to the precission bellow second(s).
=head1 AUTHOR
Athanasios Garyfalos Egaryfalos@cpan.orgE
=head1 ACKNOWLEDGMENTS
The original concept for this module was based on F
written by James G. Willmore Ewillmorejg@gmail.comE.
Copyright 2004 by James G. Willmore
This library is free software; you can redistribute it and/or modify it under
the same terms as Perl itself.
=head1 LICENSE AND COPYRIGHT
Copyright (c) 2015 Athanasios Garyfalos. All rights reserved.
This program is free software; you may redistribute it and/or modify it under
the same terms as the Perl 5 programming language system itself.
=head1 CHANGE LOG
$Log: Client.pm,v $
Revision 1.0 2015/07/01 22:53:31 Thanos
=cut
1;