Net-NTP-1.3/000755 000765 000000 00000000000 11572344656 012473 5ustar00askwheel000000 000000 Net-NTP-1.3/Changes000644 000765 000000 00000000705 11572344643 013764 0ustar00askwheel000000 000000 Revision history for Perl extension Net::NTP. 1.3 June 4, 2011 - Use IO::Socket::INET6 if available (Martin v. Löwis, RT#38234) - Don't reuse the "client timestamp" on all packets (Gordon M Lack, RT#38207) - Remove unused variables - Don't use `Carp` - Don't require Perl 5.8 (Cosimo Streppone, RT#13206) - Run perltidy and move files around a bit in the distribution 1.2 February 25, 2004 - Last release by James G Willmore Net-NTP-1.3/lib/000755 000765 000000 00000000000 11572344656 013241 5ustar00askwheel000000 000000 Net-NTP-1.3/Makefile.PL000644 000765 000000 00000001062 11572344643 014440 0ustar00askwheel000000 000000 use 5.008; use ExtUtils::MakeMaker; WriteMakefile( 'NAME' => 'Net::NTP', 'VERSION_FROM' => 'lib/Net/NTP.pm', # finds $VERSION 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1 ( $] >= 5.005 ? ( ABSTRACT_FROM => 'lib/Net/NTP.pm', # retrieve abstract from module AUTHOR => 'Ask Bjørn Hansen ' ) : () ), ); sub MY::postamble { qq[ testcover : \t cover -delete && \\ HARNESS_PERL_SWITCHES=-MDevel::Cover \$(MAKE) test && \\ cover ] } Net-NTP-1.3/MANIFEST000644 000765 000000 00000000210 11572344643 013611 0ustar00askwheel000000 000000 Changes Makefile.PL MANIFEST lib/Net/NTP.pm README t/1.t META.yml Module meta-data (added by MakeMaker) Net-NTP-1.3/META.yml000644 000765 000000 00000001050 11572344656 013740 0ustar00askwheel000000 000000 --- #YAML:1.0 name: Net-NTP version: 1.3 abstract: Perl extension for decoding NTP server responses author: - Ask Bjørn Hansen license: unknown distribution_type: module configure_requires: ExtUtils::MakeMaker: 0 build_requires: ExtUtils::MakeMaker: 0 requires: {} no_index: directory: - t - inc generated_by: ExtUtils::MakeMaker version 6.56 meta-spec: url: http://module-build.sourceforge.net/META-spec-v1.4.html version: 1.4 Net-NTP-1.3/README000644 000765 000000 00000003363 11572344643 013354 0ustar00askwheel000000 000000 Net/NTP version $Revision: 1.1.1.1 $ ==================== The README is used to introduce the module and provide instructions on how to install the module, any machine dependencies it may have (for example C compilers and installed libraries) and any other information that should be provided before the module is installed. A README file is required for CPAN modules since CPAN extracts the README file from a module distribution so that people browsing the archive can use it get an idea of the modules uses. It is usually a good idea to provide version information here so that people can decide whether fixes for the module are worth downloading. Having h2xs said that ... :-) This module will allow you to send a packet to an NTP server, get a response back, and then parse out the results according to RFC1305 and RFC2030. At present, this is a developer release. This is NOT because of the code itself, but because of the lack of testing againist various time sources to verify that the code is, in fact, doing what it's supposed to do. It has been tested againist public stratum 1 and stratum 2 servers with good results. However, it would be helpful to have a variety of results for comparison. There is a test script located in the eg directory for your use. INSTALLATION To install this module type the following: perl Makefile.PL make make test make install DEPENDENCIES This module requires these other modules and libraries: IO::Socket Carp Exporter COPYRIGHT AND LICENCE Copyright 2004 by James G. Willmore Special thanks to Ralf D. Kloth Eralf (at) qrq.de for the code to decode NTP packets. This library is free software; you can redistribute it and/or modify it under the same terms as Perl itself. Net-NTP-1.3/t/000755 000765 000000 00000000000 11572344656 012736 5ustar00askwheel000000 000000 Net-NTP-1.3/t/1.t000644 000765 000000 00000000125 11572344643 013255 0ustar00askwheel000000 000000 use Test::More tests => 1; BEGIN { use_ok('Net::NTP') }; ######################### Net-NTP-1.3/lib/Net/000755 000765 000000 00000000000 11572344656 013767 5ustar00askwheel000000 000000 Net-NTP-1.3/lib/Net/NTP.pm000644 000765 000000 00000015704 11572344643 014771 0ustar00askwheel000000 000000 package Net::NTP; use 5.006; use strict; use warnings; require Exporter; our @ISA = qw(Exporter); our @EXPORT = qw( get_ntp_response ); our $VERSION = '1.3'; our $TIMEOUT = 60; our %MODE = ( '0' => 'reserved', '1' => 'symmetric active', '2' => 'symmetric passive', '3' => 'client', '4' => 'server', '5' => 'broadcast', '6' => 'reserved for NTP control message', '7' => 'reserved for private use' ); our %STRATUM = ( '0' => 'unspecified or unavailable', '1' => 'primary reference (e.g., radio clock)', ); for (2 .. 15) { $STRATUM{$_} = 'secondary reference (via NTP or SNTP)'; } for (16 .. 255) { $STRATUM{$_} = 'reserved'; } our %STRATUM_ONE_TEXT = ( 'LOCL' => 'uncalibrated local clock used as a primary reference for a subnet without external means of synchronization', 'PPS' => 'atomic clock or other pulse-per-second source individually calibrated to national standards', 'ACTS' => 'NIST dialup modem service', 'USNO' => 'USNO modem service', 'PTB' => 'PTB (Germany) modem service', 'TDF' => 'Allouis (France) Radio 164 kHz', 'DCF' => 'Mainflingen (Germany) Radio 77.5 kHz', 'MSF' => 'Rugby (UK) Radio 60 kHz', 'WWV' => 'Ft. Collins (US) Radio 2.5, 5, 10, 15, 20 MHz', 'WWVB' => 'Boulder (US) Radio 60 kHz', 'WWVH' => 'Kaui Hawaii (US) Radio 2.5, 5, 10, 15 MHz', 'CHU' => 'Ottawa (Canada) Radio 3330, 7335, 14670 kHz', 'LORC' => 'LORAN-C radionavigation system', 'OMEG' => 'OMEGA radionavigation system', 'GPS' => 'Global Positioning Service', 'GOES' => 'Geostationary Orbit Environment Satellite', ); our %LEAP_INDICATOR = ( '0' => 'no warning', '1' => 'last minute has 61 seconds', '2' => 'last minute has 59 seconds)', '3' => 'alarm condition (clock not synchronized)' ); use constant NTP_ADJ => 2208988800; my @ntp_packet_fields = ( 'Leap Indicator', 'Version Number', 'Mode', 'Stratum', 'Poll Interval', 'Precision', 'Root Delay', 'Root Dispersion', 'Reference Clock Identifier', 'Reference Timestamp', 'Originate Timestamp', 'Receive Timestamp', 'Transmit Timestamp', ); my $frac2bin = sub { my $bin = ''; my $frac = shift; while (length($bin) < 32) { $bin = $bin . int($frac * 2); $frac = ($frac * 2) - (int($frac * 2)); } return $bin; }; my $bin2frac = sub { my @bin = split '', shift; my $frac = 0; while (@bin) { $frac = ($frac + pop @bin) / 2; } return $frac; }; my $percision = sub { my $number = shift; if ($number > 127) { $number -= 255; } return sprintf("%1.4e", 2**$number); }; 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; }; sub get_ntp_response { use IO::Socket; use constant HAVE_SOCKET_INET6 => eval { require IO::Socket::INET6 }; my $host = shift || 'localhost'; my $port = shift || 'ntp'; my %args = ( Proto => 'udp', PeerHost => $host, PeerPort => $port ); my $sock; if (HAVE_SOCKET_INET6) { $sock = IO::Socket::INET6->new(%args); } else { $sock = IO::Socket::INET->new(%args); } die $@ unless $sock; my %tmp_pkt; my %packet; my $data; my $client_localtime = time; my $client_adj_localtime = $client_localtime + NTP_ADJ; my $client_frac_localtime = $frac2bin->($client_adj_localtime); my $ntp_msg = pack("B8 C3 N10 B32", '00011011', (0) x 12, int($client_localtime), $client_frac_localtime); $sock->send($ntp_msg) or die "send() failed: $!\n"; eval { local $SIG{ALRM} = sub { die "Net::NTP timed out geting NTP packet\n"; }; alarm($TIMEOUT); $sock->recv($data, 960) or die "recv() failed: $!\n"; alarm(0); }; if ($@) { die "$@"; } my @ntp_fields = qw/byte1 stratum poll precision/; push @ntp_fields, qw/delay delay_fb disp disp_fb ident/; push @ntp_fields, qw/ref_time ref_time_fb/; push @ntp_fields, qw/org_time org_time_fb/; push @ntp_fields, qw/recv_time recv_time_fb/; push @ntp_fields, qw/trans_time trans_time_fb/; @tmp_pkt{@ntp_fields} = unpack("a C3 n B16 n B16 H8 N B32 N B32 N B32 N B32", $data); @packet{@ntp_packet_fields} = ( (unpack("C", $tmp_pkt{byte1} & "\xC0") >> 6), (unpack("C", $tmp_pkt{byte1} & "\x38") >> 3), (unpack("C", $tmp_pkt{byte1} & "\x07")), $tmp_pkt{stratum}, (sprintf("%0.4f", $tmp_pkt{poll})), $tmp_pkt{precision} - 255, ($bin2frac->($tmp_pkt{delay_fb})), (sprintf("%0.4f", $tmp_pkt{disp})), $unpack_ip->($tmp_pkt{stratum}, $tmp_pkt{ident}), (($tmp_pkt{ref_time} += $bin2frac->($tmp_pkt{ref_time_fb})) -= NTP_ADJ), (($tmp_pkt{org_time} += $bin2frac->($tmp_pkt{org_time_fb}))), (($tmp_pkt{recv_time} += $bin2frac->($tmp_pkt{recv_time_fb})) -= NTP_ADJ), (($tmp_pkt{trans_time} += $bin2frac->($tmp_pkt{trans_time_fb})) -= NTP_ADJ) ); return %packet; } 1; __END__ =head1 NAME Net::NTP - Perl extension for decoding NTP server responses =head1 SYNOPSIS use Net::NTP qw(get_ntp_response); my %response = get_ntp_response(); =head1 ABSTRACT All this module does is send a packet to an NTP server and then decode the packet recieved into it's respective parts - as outlined in RFC1305 and RFC2030. =head1 DESCRIPTION This module exports a single method (get_ntp_response) and returns an associative array based upon RFC1305 and RFC2030. The response from the server is "humanized" to a point that further processing of th information recieved from the server can be manipulated. For example: timestamps are in epoch, so one could use the localtime function to produce an even more "human" representation of the timestamp. =head2 EXPORT get_ntp_response(, ); This module exports a single method - get_ntp_response. It takes the server as the first argument (localhost is the default) and port to send/recieve the packets (ntp or 123 bu default). It returns an associative array of the various parts of the packet as outlined in RFC1305. It "normalizes" or "humanizes" various parts of the packet. For example: all the timestamps are in epoch, NOT hexidecimal. =head1 SEE ALSO perl, IO::Socket, RFC1305, RFC2030 =head1 AUTHOR Now maintained by Ask Bjørn Hansen, Eask@develooper.com Originally by James G. Willmore, Ejwillmore (at) adelphia.net or Eowner (at) ljcomputing.net Special thanks to Ralf D. Kloth Eralf (at) qrq.de for the code to decode NTP packets. =head1 COPYRIGHT AND LICENSE Copyright 2009 by Ask Bjørn Hansen; 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. =cut