File Coverage

blib/lib/Net/Frame/Layer/NTP.pm
Criterion Covered Total %
statement 227 236 96.1
branch 9 18 50.0
condition n/a
subroutine 66 68 97.0
pod 8 8 100.0
total 310 330 93.9


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   20396 use strict; use warnings;
  3     3   7  
  3         81  
  3         15  
  3         7  
  3         151  
6              
7             our $VERSION = '1.02';
8              
9 3     3   2597 use Net::Frame::Layer qw(:consts :subs);
  3         326044  
  3         797  
10 3     3   25 use Exporter;
  3         6  
  3         411  
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             NF_NTP_STRATUM_UNSYNC
31             NF_NTP_REFID_GOES
32             NF_NTP_REFID_GPS
33             NF_NTP_REFID_GAL
34             NF_NTP_REFID_PPS
35             NF_NTP_REFID_IRIG
36             NF_NTP_REFID_WWVB
37             NF_NTP_REFID_DCF
38             NF_NTP_REFID_HBG
39             NF_NTP_REFID_MSF
40             NF_NTP_REFID_JJY
41             NF_NTP_REFID_LORC
42             NF_NTP_REFID_TDF
43             NF_NTP_REFID_CHU
44             NF_NTP_REFID_WWV
45             NF_NTP_REFID_WWVH
46             NF_NTP_REFID_NIST
47             NF_NTP_REFID_ACTS
48             NF_NTP_REFID_USNO
49             NF_NTP_REFID_PTB
50             NF_NTP_KoD_ACST
51             NF_NTP_KoD_AUTH
52             NF_NTP_KoD_AUTO
53             NF_NTP_KoD_BCST
54             NF_NTP_KoD_CRYP
55             NF_NTP_KoD_DENY
56             NF_NTP_KoD_DROP
57             NF_NTP_KoD_RSTR
58             NF_NTP_KoD_INIT
59             NF_NTP_KoD_MCST
60             NF_NTP_KoD_NKEY
61             NF_NTP_KoD_RATE
62             NF_NTP_KoD_RMOT
63             NF_NTP_KoD_STEP
64             )],
65             subs => [qw(
66             ntpTimestamp
67             ntp2date
68             )],
69             );
70             our @EXPORT_OK = (
71             @{$EXPORT_TAGS{consts}},
72             @{$EXPORT_TAGS{subs}},
73             );
74              
75 3     3   14 use constant NF_NTP_ADJ => 2208988800;
  3         5  
  3         152  
76 3     3   15 use constant NF_NTP_LI_NOWARN => 0;
  3         6  
  3         129  
77 3     3   15 use constant NF_NTP_LI_61 => 1;
  3         4  
  3         157  
78 3     3   13 use constant NF_NTP_LI_59 => 2;
  3         6  
  3         136  
79 3     3   19 use constant NF_NTP_LI_ALARM => 3;
  3         5  
  3         124  
80 3     3   37 use constant NF_NTP_MODE_RSVD => 0;
  3         6  
  3         133  
81 3     3   12 use constant NF_NTP_MODE_SYMACTIVE => 1;
  3         6  
  3         134  
82 3     3   13 use constant NF_NTP_MODE_SYMPASSIVE => 2;
  3         4  
  3         118  
83 3     3   13 use constant NF_NTP_MODE_CLIENT => 3;
  3         5  
  3         136  
84 3     3   18 use constant NF_NTP_MODE_SERVER => 4;
  3         5  
  3         157  
85 3     3   15 use constant NF_NTP_MODE_BROADCAST => 5;
  3         5  
  3         133  
86 3     3   15 use constant NF_NTP_MODE_NTPCONTROL => 6;
  3         4  
  3         148  
87 3     3   13 use constant NF_NTP_MODE_PRIVATE => 7;
  3         15  
  3         121  
88 3     3   13 use constant NF_NTP_STRATUM_UNSPEC => 0;
  3         6  
  3         199  
89 3     3   13 use constant NF_NTP_STRATUM_PRIMARY => 1;
  3         5  
  3         139  
90 3     3   15 use constant NF_NTP_STRATUM_UNSYNC => 16;
  3         4  
  3         126  
91 3     3   12 use constant NF_NTP_REFID_GOES => 0x474f4553;
  3         5  
  3         127  
92 3     3   15 use constant NF_NTP_REFID_GPS => 0x47505300;
  3         3  
  3         119  
93 3     3   16 use constant NF_NTP_REFID_GAL => 0x47414c00;
  3         4  
  3         122  
94 3     3   14 use constant NF_NTP_REFID_PPS => 0x50505300;
  3         4  
  3         122  
95 3     3   15 use constant NF_NTP_REFID_IRIG => 0x49524947;
  3         8  
  3         124  
96 3     3   14 use constant NF_NTP_REFID_WWVB => 0x57575642;
  3         9  
  3         139  
97 3     3   14 use constant NF_NTP_REFID_DCF => 0x44434600;
  3         5  
  3         120  
98 3     3   13 use constant NF_NTP_REFID_HBG => 0x48424700;
  3         5  
  3         126  
99 3     3   13 use constant NF_NTP_REFID_MSF => 0x4d534600;
  3         5  
  3         116  
100 3     3   14 use constant NF_NTP_REFID_JJY => 0x4a4a5900;
  3         4  
  3         122  
101 3     3   13 use constant NF_NTP_REFID_LORC => 0x4c4f5243;
  3         32  
  3         120  
102 3     3   12 use constant NF_NTP_REFID_TDF => 0x54444600;
  3         5  
  3         123  
103 3     3   12 use constant NF_NTP_REFID_CHU => 0x43485500;
  3         9  
  3         143  
104 3     3   13 use constant NF_NTP_REFID_WWV => 0x57575600;
  3         6  
  3         152  
105 3     3   15 use constant NF_NTP_REFID_WWVH => 0x57575648;
  3         57  
  3         138  
106 3     3   13 use constant NF_NTP_REFID_NIST => 0x4e495354;
  3         6  
  3         118  
107 3     3   14 use constant NF_NTP_REFID_ACTS => 0x41435453;
  3         4  
  3         129  
108 3     3   13 use constant NF_NTP_REFID_USNO => 0x55534e4f;
  3         5  
  3         115  
109 3     3   15 use constant NF_NTP_REFID_PTB => 0x50544200;
  3         3  
  3         129  
110 3     3   15 use constant NF_NTP_KoD_ACST => 0x41435354;
  3         4  
  3         126  
111 3     3   13 use constant NF_NTP_KoD_AUTH => 0x41555448;
  3         5  
  3         125  
112 3     3   13 use constant NF_NTP_KoD_AUTO => 0x4155544f;
  3         5  
  3         131  
113 3     3   12 use constant NF_NTP_KoD_BCST => 0x42435354;
  3         9  
  3         125  
114 3     3   12 use constant NF_NTP_KoD_CRYP => 0x43525950;
  3         5  
  3         119  
115 3     3   24 use constant NF_NTP_KoD_DENY => 0x44454e59;
  3         5  
  3         127  
116 3     3   12 use constant NF_NTP_KoD_DROP => 0x44524f50;
  3         5  
  3         135  
117 3     3   13 use constant NF_NTP_KoD_RSTR => 0x52535452;
  3         5  
  3         121  
118 3     3   12 use constant NF_NTP_KoD_INIT => 0x494e4954;
  3         6  
  3         173  
119 3     3   14 use constant NF_NTP_KoD_MCST => 0x4d435354;
  3         5  
  3         140  
120 3     3   12 use constant NF_NTP_KoD_NKEY => 0x4e4b4559;
  3         6  
  3         138  
121 3     3   14 use constant NF_NTP_KoD_RATE => 0x52415445;
  3         4  
  3         141  
122 3     3   12 use constant NF_NTP_KoD_RMOT => 0x524d4f54;
  3         6  
  3         130  
123 3     3   14 use constant NF_NTP_KoD_STEP => 0x53544550;
  3         5  
  3         272  
124              
125             our @AS = qw(
126             leap
127             version
128             mode
129             stratum
130             poll
131             precision
132             rootDelay
133             rootDisp
134             refId
135             refTime
136             refTime_frac
137             org
138             org_frac
139             rec
140             rec_frac
141             xmt
142             xmt_frac
143             );
144             __PACKAGE__->cgBuildIndices;
145             __PACKAGE__->cgBuildAccessorsScalar(\@AS);
146              
147             #no strict 'vars';
148              
149 3     3   2384 use Bit::Vector;
  3         3486  
  3         143  
150 3     3   2598 use Time::HiRes qw (time);
  3         5464  
  3         12  
151              
152             $Net::Frame::Layer::UDP::Next->{123} = "NTP";
153              
154             sub new {
155              
156             shift->SUPER::new(
157 1     1 1 16 leap => NF_NTP_LI_NOWARN,
158             version => 3,
159             mode => NF_NTP_MODE_CLIENT,
160             stratum => NF_NTP_STRATUM_UNSPEC,
161             poll => 0,
162             precision => 0,
163             rootDelay => 0,
164             rootDisp => 0,
165             refId => 0,
166             refTime => 0,
167             refTime_frac => 0,
168             org => 0,
169             org_frac => 0,
170             rec => 0,
171             rec_frac => 0,
172             xmt => ntpTimestamp(time),
173             xmt_frac => 0,
174             @_,
175             );
176             }
177              
178 0     0 1 0 sub getLength { 48 }
179              
180             sub pack {
181 1     1 1 577 my $self = shift;
182              
183 1         5 my $leap = Bit::Vector->new_Dec(2, $self->leap);
184 1         46 my $version = Bit::Vector->new_Dec(3, $self->version);
185 1         15 my $mode = Bit::Vector->new_Dec(3, $self->mode);
186 1         19 my $bvlist = $leap->Concat_List($version, $mode);
187              
188 1 50       11 my $raw = $self->SUPER::pack('CCCC N11',
189             $bvlist->to_Dec,
190             $self->stratum,
191             $self->poll,
192             $self->precision,
193             $self->rootDelay,
194             $self->rootDisp,
195             $self->refId,
196             $self->refTime,
197             $self->refTime_frac,
198             $self->org,
199             $self->org_frac,
200             $self->rec,
201             $self->rec_frac,
202             $self->xmt,
203             $self->xmt_frac,
204             ) or return;
205              
206 1         130 return $self->raw($raw);
207             }
208              
209             sub unpack {
210 1     1 1 19 my $self = shift;
211              
212 1 50       43 my ($bv, $stratum, $poll, $precision,
213             $rootDelay, $rootDisp,
214             $refId,
215             $refTime, $refTime_frac,
216             $org, $org_frac,
217             $rec, $rec_frac,
218             $xmt, $xmt_frac,
219             $payload) =
220             $self->SUPER::unpack('CCCC N N H8 N8 a*', $self->raw)
221             or return;
222              
223 1         43 my $bvlist = Bit::Vector->new_Dec(8, $bv);
224 1         10 $self->leap ($bvlist->Chunk_Read(2,6));
225 1         14 $self->version($bvlist->Chunk_Read(3,3));
226 1         12 $self->mode ($bvlist->Chunk_Read(3,0));
227              
228 1         10 $self->stratum($stratum);
229 1         10 $self->poll($poll);
230 1         10 $self->precision($precision);
231 1         10 $self->rootDelay($rootDelay);
232 1         10 $self->rootDisp($rootDisp);
233 1         9 $self->refId(_unpack_refid($stratum, $refId));
234 1         11 $self->refTime($refTime);
235 1         11 $self->refTime_frac($refTime_frac);
236 1         10 $self->org($org);
237 1         11 $self->org_frac($org_frac);
238 1         10 $self->rec($rec);
239 1         10 $self->rec_frac($rec_frac);
240 1         10 $self->xmt($xmt);
241 1         11 $self->xmt_frac($xmt_frac);
242              
243 1         12 $self->payload($payload);
244              
245 1         12 return $self;
246             }
247              
248             sub encapsulate {
249 1     1 1 8 my $self = shift;
250              
251 1 50       8 return $self->nextLayer if $self->nextLayer;
252              
253             # Needed?
254 1 50       15 if ($self->payload) {
255 0         0 return 'NTP';
256             }
257              
258 1         13 NF_LAYER_NONE;
259             }
260              
261             sub print {
262 1     1 1 5 my $self = shift;
263              
264 1         4 my $refTime_frac = _bin2frac(_dec2bin($self->refTime_frac));
265 1         4 my $org_frac = _bin2frac(_dec2bin($self->org_frac));
266 1         5 my $rec_frac = _bin2frac(_dec2bin($self->rec_frac));
267 1         5 my $xmt_frac = _bin2frac(_dec2bin($self->xmt_frac));
268              
269 1         6 my $l = $self->layer;
270 1         17 my $buf = sprintf
271             "$l: leap:%d version:%d mode:%d stratum:%d\n".
272             "$l: poll:%d precision:%d\n".
273             "$l: rootDelay:%d rootDisp:%d refId:%s\n".
274             "$l: refTime:%d refTime_frac:%s\n".
275             # "$l: [%s%s]\n".
276             "$l: org:%d org_frac:%s\n".
277             # "$l: [%s%s]\n".
278             "$l: rec:%d rec_frac:%s\n".
279             # "$l: [%s%s]\n".
280             "$l: xmt:%d xmt_frac:%s\n",
281             # "$l: [%s%s]",
282             $self->leap, $self->version, $self->mode, $self->stratum,
283             $self->poll, $self->precision,
284             $self->rootDelay, $self->rootDisp, $self->refId,
285             $self->refTime, $self->refTime_frac,
286             # _getTime($self->refTime + $refTime_frac - NF_NTP_ADJ), substr($refTime_frac, 1),
287             $self->org, $self->org_frac,
288             # _getTime($self->org + $org_frac - NF_NTP_ADJ), substr($org_frac, 1),
289             $self->rec, $self->rec_frac,
290             # _getTime($self->rec + $rec_frac - NF_NTP_ADJ), substr($rec_frac, 1),
291             $self->xmt, $self->xmt_frac;
292             # _getTime($self->xmt + $xmt_frac - NF_NTP_ADJ), substr($xmt_frac, 1);
293              
294 1         719 return $buf;
295             }
296              
297             ####
298              
299             sub ntp2date {
300 1     1 1 6 my ($time, $frac) = @_;
301 1         4 my $adj_frac = _bin2frac(_dec2bin($frac));
302 1         6 my $ts = _getTime($time + $adj_frac - NF_NTP_ADJ) . substr($adj_frac, 1) . " UTC";
303 1         3 return $ts
304             }
305              
306             sub ntpTimestamp {
307 2     2 1 393 return int(shift() + NF_NTP_ADJ);
308             }
309              
310             sub _unpack_refid {
311 1     1   3 my $stratum = shift;
312 1         2 my $raw_id = shift;
313 1 50       5 if ($stratum < 2) {
314 1         13 return CORE::unpack("A4", CORE::pack("H8", $raw_id));
315             }
316 0         0 return sprintf("%d.%d.%d.%d", CORE::unpack("C4", CORE::pack("H8", $raw_id)));
317             }
318              
319             sub _dec2bin {
320 5     5   53 my $str = CORE::unpack("B32", CORE::pack("N", shift));
321 5         15 return $str;
322             }
323              
324             sub _frac2bin {
325 0     0   0 my $bin = '';
326 0         0 my $frac = shift;
327 0         0 while (length($bin) < 32) {
328 0         0 $bin = $bin . int($frac * 2);
329 0         0 $frac = ($frac * 2) - (int($frac * 2));
330             }
331 0         0 return $bin;
332             }
333              
334             sub _bin2frac {
335 5     5   43 my @bin = split '', shift;
336 5         8 my $frac = 0;
337 5         14 while (@bin) {
338 160         404 $frac = ($frac + pop @bin) / 2;
339             }
340 5         12 return $frac;
341             }
342              
343             sub _getTime {
344 1     1   47 my @time = gmtime(shift);
345 1         6 my @month = qw(Jan Feb Mar Apr May Jun Jul Aug Sep Oct Nov Dec);
346 1 50       15 my $ts =
    50          
    50          
    50          
347             $month[ $time[4] ] . " "
348             . ( ( $time[3] < 10 ) ? ( " " . $time[3] ) : $time[3] ) . " "
349             . (1900 + $time[5]) . " "
350             . ( ( $time[2] < 10 ) ? ( "0" . $time[2] ) : $time[2] ) . ":"
351             . ( ( $time[1] < 10 ) ? ( "0" . $time[1] ) : $time[1] ) . ":"
352             . ( ( $time[0] < 10 ) ? ( "0" . $time[0] ) : $time[0] );
353              
354 1         12 return $ts
355             }
356              
357             1;
358              
359             __END__