File Coverage

blib/lib/Net/Frame/Layer/NTP.pm

Criterion	Covered	Total	%
statement	125	134	93.2
branch	9	18	50.0
condition			n/a
subroutine	32	34	94.1
pod	8	8	100.0
total	174	194	89.6

#
# $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__