package Net::SNTP::Client;

use strict;
use warnings;

## Validate the version of Perl

BEGIN { die 'Perl version 5.6.0 or greater is required' if ($] < 5.006); }

=head1 NAME

Net::SNTP::Client - Perl module to calculate the roundtrip delay d and
 system clock offset t from NTP or SNTP Server.


=head1 VERSION

Version 0.04

=cut

## Version of the Net::SNTP::Client module

our $VERSION = '0.04';
    $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 );

=head1 SYNOPSIS

The Net::SNTP::Client - Perl module retrieves the time from an NTP server
 and uses the local time to calculate the roundtrip delay d and system 
 clock offset t based on RFC4330. The module is calculating with higher
 accuracy in comparison to other modules.


=head1 ABSTRACT

The module sends a UDP packet formated according to
 L<RFC4330|https://tools.ietf.org/html/rfc4330> 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      => $hostname,    # hostnmae or IP
      -port          => $port,        # default NTP port 123 
      -RFC4330       => $RFC4330,     # default 0
      -clearScreen   => $clearScreen, # default 0
      );

  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 (-hostname, port, RFC4330 and -clearScreen). 

=over 4

=item * HOSTNAME

    -hostname: The mandatory key inorder the method to produce
    an output is only the hostname, the rest of the keys are optional. 


=item * PORT

    -port: By default the the port is set to 123 (NTP default port). 
    The user has the option to overwite the port based on the expected
    NTP port on the server side (e.g. -port => 123456).


=item * RFC4330 OUTPUT

    -RFC4330: This is an optional way to produce an easy visuable
    output based on RFC4330 documentation.


=item * CLEARSCREEN

    -clearScreen: This is an optional choice based on user preference
    if he/she desires to clear the "terminal screen" before printing
    the captured data.

=back

=head1 SUBROUTINES/METHODS

  my ( $error , $hashRefOutput ) = getSNTPTime( %hashInput );


=cut

## 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 EXAMPLE

This example gets the time from a remote NTP server from the
 L<pool.ntp.org: public ntp time server for everyone|http://www.pool.ntp.org/en/> 
 and calculates the roundtrip delay d and local clock offset
 t as defined on RFC4330.

We use the L<Data::Dumper|http://search.cpan.org/~ilyam/Data-Dumper-2.121/Dumper.pm>
 module to print the output.

  #!/usr/bin/perl
  use strict;
  use warnings;
  use Data::Dumper;

  use Net::SNTP::Client;

  my %hashInput = (
      -hostname      => "0.pool.ntp.org",
      -port          => 123,
      -RFC4330       => 1,
      -clearScreen   => 1,
      );

  my ( $error , $hashRefOutput ) = getSNTPTime( %hashInput );

  print Dumper $hashRefOutput;
  print "Error: $error\n" if ($error);


=head1 AUTHOR

Athanasios Garyfalos, C<< <garyfalos at cpan.org> >>

=head1 BUGS

Please report any bugs or feature requests to C<bug-net-sntp-client at rt.cpan.org>, or through
the web interface at L<http://rt.cpan.org/NoAuth/ReportBug.html?Queue=Net-SNTP-Client>.  I will be notified, and then you'll
automatically be notified of progress on your bug as I make changes.

=head1 SUPPORT

You can find documentation for this module with the perldoc command.

    perldoc Net::SNTP::Client

You can also look for information at:

=over 4

=item * RT: CPAN's request tracker (report bugs here)

L<http://rt.cpan.org/NoAuth/Bugs.html?Dist=Net-SNTP-Client>

=item * AnnoCPAN: Annotated CPAN documentation

L<http://annocpan.org/dist/Net-SNTP-Client>

=item * CPAN Ratings

L<http://cpanratings.perl.org/d/Net-SNTP-Client>

=item * Search CPAN

L<http://search.cpan.org/dist/Net-SNTP-Client/>

=back

=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 DIFFERENCES FROM OTHER MODULES

Based on the current known modules Net::SNTP::Client is only similar
 to Net::NTP module. The two modules do not have in common the
 encoding and decoding process of fractions of seconds.

Be aware that on different OS different precision can be achieved.

=head1 ACKNOWLEDGEMENTS

The original concept for this module was based on F<NTP.pm>
written by James G. Willmore E<lt>willmorejg@gmail.comE<gt>.

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 2015 Athanasios Garyfalos.

This program is free software; you can redistribute it and/or modify it
under the terms of the the Artistic License (2.0). You may obtain a
copy of the full license at:

L<http://www.perlfoundation.org/artistic_license_2_0>

Any use, modification, and distribution of the Standard or Modified
Versions is governed by this Artistic License. By using, modifying or
distributing the Package, you accept this license. Do not use, modify,
or distribute the Package, if you do not accept this license.

If your Modified Version has been derived from a Modified Version made
by someone other than you, you are nevertheless required to ensure that
your Modified Version complies with the requirements of this license.

This license does not grant you the right to use any trademark, service
mark, tradename, or logo of the Copyright Holder.

This license includes the non-exclusive, worldwide, free-of-charge
patent license to make, have made, use, offer to sell, sell, import and
otherwise transfer the Package with respect to any patent claims
licensable by the Copyright Holder that are necessarily infringed by the
Package. If you institute patent litigation (including a cross-claim or
counterclaim) against any party alleging that the Package constitutes
direct or contributory patent infringement, then this Artistic License
to you shall terminate on the date that such litigation is filed.

Disclaimer of Warranty: THE PACKAGE IS PROVIDED BY THE COPYRIGHT HOLDER
AND CONTRIBUTORS "AS IS' AND WITHOUT ANY EXPRESS OR IMPLIED WARRANTIES.
THE IMPLIED WARRANTIES OF MERCHANTABILITY, FITNESS FOR A PARTICULAR
PURPOSE, OR NON-INFRINGEMENT ARE DISCLAIMED TO THE EXTENT PERMITTED BY
YOUR LOCAL LAW. UNLESS REQUIRED BY LAW, NO COPYRIGHT HOLDER OR
CONTRIBUTOR WILL BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, OR
CONSEQUENTIAL DAMAGES ARISING IN ANY WAY OUT OF THE USE OF THE PACKAGE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

=head1 CHANGE LOG
$Log: Client.pm,v $
Revision 1.0  2015/07/10 22:53:31  Thanos


=cut

1; # End of Net::SNTP::Client
