#
# $Id: NTP.pm 49 2012-11-19 13:15:34Z VinsWorldcom $
#
package Net::Frame::Layer::NTP;
use strict; use warnings;

our $VERSION = '1.00';

use Net::Frame::Layer qw(:consts :subs);
use Exporter;
our @ISA = qw(Net::Frame::Layer Exporter);

our %EXPORT_TAGS = (
   consts => [qw(
      NF_NTP_ADJ
      NF_NTP_LI_NOWARN
      NF_NTP_LI_61
      NF_NTP_LI_59
      NF_NTP_LI_ALARM
      NF_NTP_MODE_RSVD
      NF_NTP_MODE_SYMACTIVE
      NF_NTP_MODE_SYMPASSIVE
      NF_NTP_MODE_CLIENT
      NF_NTP_MODE_SERVER
      NF_NTP_MODE_BROADCAST
      NF_NTP_MODE_NTPCONTROL
      NF_NTP_MODE_PRIVATE
      NF_NTP_STRATUM_UNSPEC
      NF_NTP_STRATUM_PRIMARY
   )],
   subs => [qw(
      ntpTimestamp
      ntp2date
   )],
);
our @EXPORT_OK = (
   @{$EXPORT_TAGS{consts}},
   @{$EXPORT_TAGS{subs}},
);

use constant NF_NTP_ADJ             => 2208988800;
use constant NF_NTP_LI_NOWARN       => 0;
use constant NF_NTP_LI_61           => 1;
use constant NF_NTP_LI_59           => 2;
use constant NF_NTP_LI_ALARM        => 3;
use constant NF_NTP_MODE_RSVD       => 0;
use constant NF_NTP_MODE_SYMACTIVE  => 1;
use constant NF_NTP_MODE_SYMPASSIVE => 2;
use constant NF_NTP_MODE_CLIENT     => 3;
use constant NF_NTP_MODE_SERVER     => 4;
use constant NF_NTP_MODE_BROADCAST  => 5;
use constant NF_NTP_MODE_NTPCONTROL => 6;
use constant NF_NTP_MODE_PRIVATE    => 7;
use constant NF_NTP_STRATUM_UNSPEC  => 0;
use constant NF_NTP_STRATUM_PRIMARY => 1;

our @AS = qw(
   li
   version
   mode
   stratum
   pollInterval
   precision
   rootDelay
   rootDispersion
   refClockId
   refTimestamp
   refTimestamp_frac
   origTimestamp
   origTimestamp_frac
   recvTimestamp
   recvTimestamp_frac
   xmitTimestamp
   xmitTimestamp_frac
);
__PACKAGE__->cgBuildIndices;
__PACKAGE__->cgBuildAccessorsScalar(\@AS);

#no strict 'vars';

use Bit::Vector;
use Time::HiRes qw (time);

$Net::Frame::Layer::UDP::Next->{123} = "NTP";

sub new {

   shift->SUPER::new(
      li             => NF_NTP_LI_NOWARN,
      version        => 3,
      mode           => NF_NTP_MODE_CLIENT,
      stratum        => NF_NTP_STRATUM_UNSPEC,
      pollInterval   => 0,
      precision      => 0,
      rootDelay      => 0,
      rootDispersion => 0,
      refClockId     => 0,
      refTimestamp   => 0,
      refTimestamp_frac  => 0,
      origTimestamp      => 0,
      origTimestamp_frac => 0,
      recvTimestamp      => 0,
      recvTimestamp_frac => 0,
      xmitTimestamp      => ntpTimestamp(time),
      xmitTimestamp_frac => 0,
      @_,
   );
}

sub getLength { 48 }

sub pack {
   my $self = shift;

   my $li      = Bit::Vector->new_Dec(2, $self->li);
   my $version = Bit::Vector->new_Dec(3, $self->version);
   my $mode    = Bit::Vector->new_Dec(3, $self->mode);
   my $bvlist = $li->Concat_List($version, $mode);

   my $raw = $self->SUPER::pack('CCCC N11',
      $bvlist->to_Dec,
      $self->stratum,
      $self->pollInterval,
      $self->precision,
      $self->rootDelay,
      $self->rootDispersion,
      $self->refClockId,
      $self->refTimestamp,
      $self->refTimestamp_frac,
      $self->origTimestamp,
      $self->origTimestamp_frac,
      $self->recvTimestamp,
      $self->recvTimestamp_frac,
      $self->xmitTimestamp,
      $self->xmitTimestamp_frac,
   ) or return;

   return $self->raw($raw);
}

sub unpack {
   my $self = shift;

   my ($bv, $stratum, $pollInterval, $precision,
       $rootDelay, $rootDispersion, 
       $refClockId,
       $refTimestamp, $refTimestamp_frac,
       $origTimestamp, $origTimestamp_frac,
       $recvTimestamp, $recvTimestamp_frac,
       $xmitTimestamp, $xmitTimestamp_frac,
       $payload) =
      $self->SUPER::unpack('CCCC N N H8 N8 a*', $self->raw)
         or return;

   my $bvlist = Bit::Vector->new_Dec(8, $bv);
   $self->li     ($bvlist->Chunk_Read(2,6));
   $self->version($bvlist->Chunk_Read(3,3));
   $self->mode   ($bvlist->Chunk_Read(3,0));

   $self->stratum($stratum);
   $self->pollInterval($pollInterval);
   $self->precision($precision);
   $self->rootDelay($rootDelay);
   $self->rootDispersion($rootDispersion);
   $self->refClockId(_unpack_refid($stratum, $refClockId));
   $self->refTimestamp($refTimestamp);
   $self->refTimestamp_frac($refTimestamp_frac);
   $self->origTimestamp($origTimestamp);
   $self->origTimestamp_frac($origTimestamp_frac);
   $self->recvTimestamp($recvTimestamp);
   $self->recvTimestamp_frac($recvTimestamp_frac);
   $self->xmitTimestamp($xmitTimestamp);
   $self->xmitTimestamp_frac($xmitTimestamp_frac);

   $self->payload($payload);

   return $self;
}

sub encapsulate {
   my $self = shift;

   return $self->nextLayer if $self->nextLayer;

   # Needed?
   if ($self->payload) {
      return 'NTP';
   }

   NF_LAYER_NONE;
}

sub print {
   my $self = shift;

   my $refTimestamp_frac = _bin2frac(_dec2bin($self->refTimestamp_frac));
   my $origTimestamp_frac = _bin2frac(_dec2bin($self->origTimestamp_frac));
   my $recvTimestamp_frac = _bin2frac(_dec2bin($self->recvTimestamp_frac));
   my $xmitTimestamp_frac = _bin2frac(_dec2bin($self->xmitTimestamp_frac));

   my $l = $self->layer;
   my $buf = sprintf
      "$l: li:%d  version:%d  mode:%d  stratum:%d\n".
      "$l: pollInterval:%d  precision:%d\n".
      "$l: rootDelay:%d  rootDispersion:%d  refClockId:%s\n".
      "$l: refTimestamp:%d   refTimestamp_frac:%s\n".
#      "$l:   [%s%s]\n".
      "$l: origTimestamp:%d  origTimestamp_frac:%s\n".
#      "$l:   [%s%s]\n".
      "$l: recvTimestamp:%d  recvTimestamp_frac:%s\n".
#      "$l:   [%s%s]\n".
      "$l: xmitTimestamp:%d  xmitTimestamp_frac:%s\n",
#      "$l:   [%s%s]",
         $self->li, $self->version, $self->mode, $self->stratum,
         $self->pollInterval, $self->precision,
         $self->rootDelay, $self->rootDispersion, $self->refClockId,
         $self->refTimestamp, $self->refTimestamp_frac,
#         _getTime($self->refTimestamp  + $refTimestamp_frac  - NF_NTP_ADJ), substr($refTimestamp_frac, 1),
         $self->origTimestamp, $self->origTimestamp_frac, 
#         _getTime($self->origTimestamp + $origTimestamp_frac - NF_NTP_ADJ), substr($origTimestamp_frac, 1),
         $self->recvTimestamp, $self->recvTimestamp_frac, 
#         _getTime($self->recvTimestamp + $recvTimestamp_frac - NF_NTP_ADJ), substr($recvTimestamp_frac, 1),
         $self->xmitTimestamp, $self->xmitTimestamp_frac;
#         _getTime($self->xmitTimestamp + $xmitTimestamp_frac - NF_NTP_ADJ), substr($xmitTimestamp_frac, 1);

   return $buf;
}

####

sub ntp2date {
   my ($time, $frac) = @_;
   my $adj_frac = _bin2frac(_dec2bin($frac));
   my $ts = _getTime($time + $adj_frac - NF_NTP_ADJ) . substr($adj_frac, 1) . " UTC";
   return $ts
}

sub ntpTimestamp {
   return int(shift() + NF_NTP_ADJ);
}

sub _unpack_refid {
    my $stratum = shift;
    my $raw_id  = shift;
    if ($stratum < 2) {
        return CORE::unpack("A4", CORE::pack("H8", $raw_id));
    }
    return sprintf("%d.%d.%d.%d", CORE::unpack("C4", CORE::pack("H8", $raw_id)));
}

sub _dec2bin {
    my $str = CORE::unpack("B32", CORE::pack("N", shift));
    return $str;
}

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

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

sub _getTime {
   my @time = gmtime(shift);
   my @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
   my $ts =
        $month[ $time[4] ] . " "
      . ( ( $time[3] < 10 ) ? ( " " . $time[3] ) : $time[3] ) . " "
      . (1900 + $time[5]) . " "
      . ( ( $time[2] < 10 ) ? ( "0" . $time[2] ) : $time[2] ) . ":"
      . ( ( $time[1] < 10 ) ? ( "0" . $time[1] ) : $time[1] ) . ":"
      . ( ( $time[0] < 10 ) ? ( "0" . $time[0] ) : $time[0] );

   return $ts
}

1;

__END__

=head1 NAME

Net::Frame::Layer::NTP - NTP layer object

=head1 SYNOPSIS

   use Net::Frame::Simple;
   use Net::Frame::Layer::NTP qw(:consts);

   my $layer = Net::Frame::Layer::NTP->new(
      li             => NF_NTP_LI_NOWARN,
      version        => 3,
      mode           => NF_NTP_MODE_CLIENT,
      stratum        => NF_NTP_STRATUM_UNSPEC,
      pollInterval   => 0,
      precision      => 0,
      rootDelay      => 0,
      rootDispersion => 0,
      refClockId     => 0,
      refTimestamp   => 0,
      refTimestamp_frac  => 0,
      origTimestamp      => 0,
      origTimestamp_frac => 0,
      recvTimestamp      => 0,
      recvTimestamp_frac => 0,
      xmitTimestamp      => ntpTimestamp(time),
      xmitTimestamp_frac => 0,
   );

   #
   # Read a raw layer
   #

   my $layer = Net::Frame::Layer::NTP->new(raw => $raw);

   print $layer->print."\n";
   print 'PAYLOAD: '.unpack('H*', $layer->payload)."\n"
      if $layer->payload;

=head1 DESCRIPTION

This modules implements the encoding and decoding of the NTP layer.

RFC: ftp://ftp.rfc-editor.org/in-notes/rfc1305.txt

See also B<Net::Frame::Layer> for other attributes and methods.

=head1 ATTRIBUTES

=over 4

=item B<li>

NTP Leap Indicator.  See B<CONSTANTS> for more information.

=item B<version>

NTP version.

=item B<mode>

NTP mode.  See B<CONSTANTS> for more information.

=item B<stratum>

NTP stratum.  See B<CONSTANTS> for more information.

=item B<pollInterval>

Maximum poll interval between messages in seconds to the nearest power of two.

=item B<precision>

Precision of the local clock in seconds to the nearest power of two.

=item B<rootDelay>

Total roundtrip delay to the primary reference source, in seconds with the fraction point between bits 15 and 16.

=item B<rootDispersion>

Maximum error relative to the primary reference source in seconds with the fraction point between bits 15 and 16.

=item B<refClockId>

In the case of stratum 2 or greater, this is the IPv4 address of the primary reference host.  In the case of stratum 0 or 1, this is a four byte, left-justified, zero padded ASCII string.

=item B<refTimestamp>

=item B<refTimestamp_frac>

The local time at which the local clock was last set or corrected and the fractional part.

=item B<origTimestamp>

=item B<origTimestamp_frac>

The local time when the client sent the request and the fractional part.

=item B<recvTimestamp>

=item B<recvTimestamp_frac>

The local time when the request was received by the server and the fractional part.

=item B<xmitTimestamp>

=item B<xmitTimestamp_frac>

The local time when the reply was sent from the server and the fractional part.

=back

The following are inherited attributes. See B<Net::Frame::Layer> for more information.

=over 4

=item B<raw>

=item B<payload>

=item B<nextLayer>

=back

=head1 METHODS

=over 4

=item B<new>

=item B<new> (hash)

Object constructor. You can pass attributes that will overwrite default ones. See B<SYNOPSIS> for default values.

=back

The following are inherited methods. Some of them may be overriden in this layer, and some others may not be meaningful in this layer. See B<Net::Frame::Layer> for more information.

=over 4

=item B<layer>

=item B<computeLengths>

=item B<pack>

=item B<unpack>

=item B<encapsulate>

=item B<getLength>

=item B<getPayloadLength>

=item B<print>

=item B<dump>

=back

=head1 USEFUL SUBROUTINES

Load them: use Net::Frame::Layer::NTP qw(:subs);

=over 4

=item B<ntpTimestamp> (time)

Create an NTP-adjusted timestamp.

=item B<ntp2date> (time, frac)

Provided the NTP time and fracional timestamps, returns a human-readable time string.

=back

=head1 CONSTANTS

Load them: use Net::Frame::Layer::NTP qw(:consts);

=over 4

=item B<NF_NTP_ADJ>

NTP adjustment (2208988800).

=item B<NF_NTP_LI_NOWARN>

=item B<NF_NTP_LI_61>

=item B<NF_NTP_LI_59>

=item B<NF_NTP_LI_ALARM>

NTP leap indicators.

=item B<NF_NTP_MODE_RSVD>

=item B<NF_NTP_MODE_SYMACTIVE>

=item B<NF_NTP_MODE_SYMPASSIVE>

=item B<NF_NTP_MODE_CLIENT>

=item B<NF_NTP_MODE_SERVER>

=item B<NF_NTP_MODE_BROADCAST>

=item B<NF_NTP_MODE_NTPCONTROL>

=item B<NF_NTP_MODE_PRIVATE>

NTP modes.

=item B<NF_NTP_STRATUM_UNSPEC>

=item B<NF_NTP_STRATUM_PRIMARY>

NTP stratums.

=back

=head1 SEE ALSO

L<Net::Frame::Layer>

=head1 AUTHOR

Michael Vincent

=head1 COPYRIGHT AND LICENSE

Copyright (c) 2016, Michael Vincent

You may distribute this module under the terms of the Artistic license.
See LICENSE.Artistic file in the source distribution archive.

=cut
