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


line stmt bran cond sub pod time code
1             #
2             # $Id: NTP.pm 49 2012-11-19 13:15:34Z VinsWorldcom $
3             #
4             package Net::Frame::Layer::NTP;
5 3     3   32679 use strict; use warnings;
  3     3   9  
  3         92  
  3         16  
  3         7  
  3         193  
6              
7             our $VERSION = '1.00';
8              
9 3     3   3004 use Net::Frame::Layer qw(:consts :subs);
  3         265523  
  3         788  
10 3     3   27 use Exporter;
  3         5  
  3         365  
11             our @ISA = qw(Net::Frame::Layer Exporter);
12              
13             our %EXPORT_TAGS = (
14             consts => [qw(
15             NF_NTP_ADJ
16             NF_NTP_LI_NOWARN
17             NF_NTP_LI_61
18             NF_NTP_LI_59
19             NF_NTP_LI_ALARM
20             NF_NTP_MODE_RSVD
21             NF_NTP_MODE_SYMACTIVE
22             NF_NTP_MODE_SYMPASSIVE
23             NF_NTP_MODE_CLIENT
24             NF_NTP_MODE_SERVER
25             NF_NTP_MODE_BROADCAST
26             NF_NTP_MODE_NTPCONTROL
27             NF_NTP_MODE_PRIVATE
28             NF_NTP_STRATUM_UNSPEC
29             NF_NTP_STRATUM_PRIMARY
30             )],
31             subs => [qw(
32             ntpTimestamp
33             ntp2date
34             )],
35             );
36             our @EXPORT_OK = (
37             @{$EXPORT_TAGS{consts}},
38             @{$EXPORT_TAGS{subs}},
39             );
40              
41 3     3   16 use constant NF_NTP_ADJ => 2208988800;
  3         5  
  3         155  
42 3     3   14 use constant NF_NTP_LI_NOWARN => 0;
  3         6  
  3         131  
43 3     3   13 use constant NF_NTP_LI_61 => 1;
  3         6  
  3         141  
44 3     3   14 use constant NF_NTP_LI_59 => 2;
  3         6  
  3         127  
45 3     3   13 use constant NF_NTP_LI_ALARM => 3;
  3         5  
  3         131  
46 3     3   37 use constant NF_NTP_MODE_RSVD => 0;
  3         5  
  3         148  
47 3     3   14 use constant NF_NTP_MODE_SYMACTIVE => 1;
  3         5  
  3         151  
48 3     3   14 use constant NF_NTP_MODE_SYMPASSIVE => 2;
  3         10  
  3         128  
49 3     3   13 use constant NF_NTP_MODE_CLIENT => 3;
  3         5  
  3         139  
50 3     3   20 use constant NF_NTP_MODE_SERVER => 4;
  3         4  
  3         139  
51 3     3   14 use constant NF_NTP_MODE_BROADCAST => 5;
  3         4  
  3         143  
52 3     3   14 use constant NF_NTP_MODE_NTPCONTROL => 6;
  3         5  
  3         127  
53 3     3   13 use constant NF_NTP_MODE_PRIVATE => 7;
  3         6  
  3         128  
54 3     3   14 use constant NF_NTP_STRATUM_UNSPEC => 0;
  3         4  
  3         122  
55 3     3   13 use constant NF_NTP_STRATUM_PRIMARY => 1;
  3         5  
  3         305  
56              
57             our @AS = qw(
58             li
59             version
60             mode
61             stratum
62             pollInterval
63             precision
64             rootDelay
65             rootDispersion
66             refClockId
67             refTimestamp
68             refTimestamp_frac
69             origTimestamp
70             origTimestamp_frac
71             recvTimestamp
72             recvTimestamp_frac
73             xmitTimestamp
74             xmitTimestamp_frac
75             );
76             __PACKAGE__->cgBuildIndices;
77             __PACKAGE__->cgBuildAccessorsScalar(\@AS);
78              
79             #no strict 'vars';
80              
81 3     3   2466 use Bit::Vector;
  3         6513  
  3         156  
82 3     3   2576 use Time::HiRes qw (time);
  3         4364  
  3         15  
83              
84             $Net::Frame::Layer::UDP::Next->{123} = "NTP";
85              
86             sub new {
87              
88             shift->SUPER::new(
89 1     1 1 18 li => NF_NTP_LI_NOWARN,
90             version => 3,
91             mode => NF_NTP_MODE_CLIENT,
92             stratum => NF_NTP_STRATUM_UNSPEC,
93             pollInterval => 0,
94             precision => 0,
95             rootDelay => 0,
96             rootDispersion => 0,
97             refClockId => 0,
98             refTimestamp => 0,
99             refTimestamp_frac => 0,
100             origTimestamp => 0,
101             origTimestamp_frac => 0,
102             recvTimestamp => 0,
103             recvTimestamp_frac => 0,
104             xmitTimestamp => ntpTimestamp(time),
105             xmitTimestamp_frac => 0,
106             @_,
107             );
108             }
109              
110 0     0 1 0 sub getLength { 48 }
111              
112             sub pack {
113 1     1 1 588 my $self = shift;
114              
115 1         4 my $li = Bit::Vector->new_Dec(2, $self->li);
116 1         74 my $version = Bit::Vector->new_Dec(3, $self->version);
117 1         15 my $mode = Bit::Vector->new_Dec(3, $self->mode);
118 1         20 my $bvlist = $li->Concat_List($version, $mode);
119              
120 1 50       10 my $raw = $self->SUPER::pack('CCCC N11',
121             $bvlist->to_Dec,
122             $self->stratum,
123             $self->pollInterval,
124             $self->precision,
125             $self->rootDelay,
126             $self->rootDispersion,
127             $self->refClockId,
128             $self->refTimestamp,
129             $self->refTimestamp_frac,
130             $self->origTimestamp,
131             $self->origTimestamp_frac,
132             $self->recvTimestamp,
133             $self->recvTimestamp_frac,
134             $self->xmitTimestamp,
135             $self->xmitTimestamp_frac,
136             ) or return;
137              
138 1         139 return $self->raw($raw);
139             }
140              
141             sub unpack {
142 1     1 1 19 my $self = shift;
143              
144 1 50       4 my ($bv, $stratum, $pollInterval, $precision,
145             $rootDelay, $rootDispersion,
146             $refClockId,
147             $refTimestamp, $refTimestamp_frac,
148             $origTimestamp, $origTimestamp_frac,
149             $recvTimestamp, $recvTimestamp_frac,
150             $xmitTimestamp, $xmitTimestamp_frac,
151             $payload) =
152             $self->SUPER::unpack('CCCC N N H8 N8 a*', $self->raw)
153             or return;
154              
155 1         35 my $bvlist = Bit::Vector->new_Dec(8, $bv);
156 1         10 $self->li ($bvlist->Chunk_Read(2,6));
157 1         12 $self->version($bvlist->Chunk_Read(3,3));
158 1         12 $self->mode ($bvlist->Chunk_Read(3,0));
159              
160 1         11 $self->stratum($stratum);
161 1         10 $self->pollInterval($pollInterval);
162 1         10 $self->precision($precision);
163 1         10 $self->rootDelay($rootDelay);
164 1         11 $self->rootDispersion($rootDispersion);
165 1         11 $self->refClockId(_unpack_refid($stratum, $refClockId));
166 1         11 $self->refTimestamp($refTimestamp);
167 1         11 $self->refTimestamp_frac($refTimestamp_frac);
168 1         14 $self->origTimestamp($origTimestamp);
169 1         10 $self->origTimestamp_frac($origTimestamp_frac);
170 1         10 $self->recvTimestamp($recvTimestamp);
171 1         10 $self->recvTimestamp_frac($recvTimestamp_frac);
172 1         10 $self->xmitTimestamp($xmitTimestamp);
173 1         10 $self->xmitTimestamp_frac($xmitTimestamp_frac);
174              
175 1         13 $self->payload($payload);
176              
177 1         12 return $self;
178             }
179              
180             sub encapsulate {
181 1     1 1 8 my $self = shift;
182              
183 1 50       7 return $self->nextLayer if $self->nextLayer;
184              
185             # Needed?
186 1 50       16 if ($self->payload) {
187 0         0 return 'NTP';
188             }
189              
190 1         12 NF_LAYER_NONE;
191             }
192              
193             sub print {
194 1     1 1 11 my $self = shift;
195              
196 1         3 my $refTimestamp_frac = _bin2frac(_dec2bin($self->refTimestamp_frac));
197 1         5 my $origTimestamp_frac = _bin2frac(_dec2bin($self->origTimestamp_frac));
198 1         4 my $recvTimestamp_frac = _bin2frac(_dec2bin($self->recvTimestamp_frac));
199 1         4 my $xmitTimestamp_frac = _bin2frac(_dec2bin($self->xmitTimestamp_frac));
200              
201 1         6 my $l = $self->layer;
202 1         22 my $buf = sprintf
203             "$l: li:%d version:%d mode:%d stratum:%d\n".
204             "$l: pollInterval:%d precision:%d\n".
205             "$l: rootDelay:%d rootDispersion:%d refClockId:%s\n".
206             "$l: refTimestamp:%d refTimestamp_frac:%s\n".
207             # "$l: [%s%s]\n".
208             "$l: origTimestamp:%d origTimestamp_frac:%s\n".
209             # "$l: [%s%s]\n".
210             "$l: recvTimestamp:%d recvTimestamp_frac:%s\n".
211             # "$l: [%s%s]\n".
212             "$l: xmitTimestamp:%d xmitTimestamp_frac:%s\n",
213             # "$l: [%s%s]",
214             $self->li, $self->version, $self->mode, $self->stratum,
215             $self->pollInterval, $self->precision,
216             $self->rootDelay, $self->rootDispersion, $self->refClockId,
217             $self->refTimestamp, $self->refTimestamp_frac,
218             # _getTime($self->refTimestamp + $refTimestamp_frac - NF_NTP_ADJ), substr($refTimestamp_frac, 1),
219             $self->origTimestamp, $self->origTimestamp_frac,
220             # _getTime($self->origTimestamp + $origTimestamp_frac - NF_NTP_ADJ), substr($origTimestamp_frac, 1),
221             $self->recvTimestamp, $self->recvTimestamp_frac,
222             # _getTime($self->recvTimestamp + $recvTimestamp_frac - NF_NTP_ADJ), substr($recvTimestamp_frac, 1),
223             $self->xmitTimestamp, $self->xmitTimestamp_frac;
224             # _getTime($self->xmitTimestamp + $xmitTimestamp_frac - NF_NTP_ADJ), substr($xmitTimestamp_frac, 1);
225              
226 1         770 return $buf;
227             }
228              
229             ####
230              
231             sub ntp2date {
232 1     1 1 6 my ($time, $frac) = @_;
233 1         4 my $adj_frac = _bin2frac(_dec2bin($frac));
234 1         5 my $ts = _getTime($time + $adj_frac - NF_NTP_ADJ) . substr($adj_frac, 1) . " UTC";
235 1         3 return $ts
236             }
237              
238             sub ntpTimestamp {
239 2     2 1 344 return int(shift() + NF_NTP_ADJ);
240             }
241              
242             sub _unpack_refid {
243 1     1   2 my $stratum = shift;
244 1         1 my $raw_id = shift;
245 1 50       5 if ($stratum < 2) {
246 1         8 return CORE::unpack("A4", CORE::pack("H8", $raw_id));
247             }
248 0         0 return sprintf("%d.%d.%d.%d", CORE::unpack("C4", CORE::pack("H8", $raw_id)));
249             }
250              
251             sub _dec2bin {
252 5     5   50 my $str = CORE::unpack("B32", CORE::pack("N", shift));
253 5         21 return $str;
254             }
255              
256             sub _frac2bin {
257 0     0   0 my $bin = '';
258 0         0 my $frac = shift;
259 0         0 while (length($bin) < 32) {
260 0         0 $bin = $bin . int($frac * 2);
261 0         0 $frac = ($frac * 2) - (int($frac * 2));
262             }
263 0         0 return $bin;
264             }
265              
266             sub _bin2frac {
267 5     5   38 my @bin = split '', shift;
268 5         7 my $frac = 0;
269 5         14 while (@bin) {
270 160         350 $frac = ($frac + pop @bin) / 2;
271             }
272 5         9 return $frac;
273             }
274              
275             sub _getTime {
276 1     1   7 my @time = gmtime(shift);
277 1         4 my @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
278 1 50       12 my $ts =
    50          
    50          
    50          
279             $month[ $time[4] ] . " "
280             . ( ( $time[3] < 10 ) ? ( " " . $time[3] ) : $time[3] ) . " "
281             . (1900 + $time[5]) . " "
282             . ( ( $time[2] < 10 ) ? ( "0" . $time[2] ) : $time[2] ) . ":"
283             . ( ( $time[1] < 10 ) ? ( "0" . $time[1] ) : $time[1] ) . ":"
284             . ( ( $time[0] < 10 ) ? ( "0" . $time[0] ) : $time[0] );
285              
286 1         12 return $ts
287             }
288              
289             1;
290              
291             __END__