r75104 - in /branches/upstream/libnet-ntp-perl/current: Changes MANIFEST META.yml Makefile.PL NTP.pm eg/ lib/ lib/Net/ lib/Net/NTP.pm t/1.t
periapt-guest at users.alioth.debian.org
periapt-guest at users.alioth.debian.org
Sat Jun 4 09:35:20 UTC 2011
Author: periapt-guest
Date: Sat Jun 4 09:35:13 2011
New Revision: 75104
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=75104
Log:
[svn-upgrade] new version libnet-ntp-perl (1.3)
Added:
branches/upstream/libnet-ntp-perl/current/lib/
branches/upstream/libnet-ntp-perl/current/lib/Net/
branches/upstream/libnet-ntp-perl/current/lib/Net/NTP.pm
Removed:
branches/upstream/libnet-ntp-perl/current/NTP.pm
branches/upstream/libnet-ntp-perl/current/eg/
Modified:
branches/upstream/libnet-ntp-perl/current/Changes
branches/upstream/libnet-ntp-perl/current/MANIFEST
branches/upstream/libnet-ntp-perl/current/META.yml
branches/upstream/libnet-ntp-perl/current/Makefile.PL
branches/upstream/libnet-ntp-perl/current/t/1.t
Modified: branches/upstream/libnet-ntp-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-ntp-perl/current/Changes?rev=75104&op=diff
==============================================================================
--- branches/upstream/libnet-ntp-perl/current/Changes (original)
+++ branches/upstream/libnet-ntp-perl/current/Changes Sat Jun 4 09:35:13 2011
@@ -1,11 +1,14 @@
Revision history for Perl extension Net::NTP.
-0.01 Sat Feb 14 13:00:52 2004
- - original version; created by h2xs 1.22 with options
- -XAn 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
-##IMPORTED TO CVS
-$Log: Changes,v $
-Revision 1.1.1.1 2004/02/23 17:13:10 jim
-Imported Net::NTP into CVS
+1.2 February 25, 2004
+ - Last release by James G Willmore
+
Modified: branches/upstream/libnet-ntp-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-ntp-perl/current/MANIFEST?rev=75104&op=diff
==============================================================================
--- branches/upstream/libnet-ntp-perl/current/MANIFEST (original)
+++ branches/upstream/libnet-ntp-perl/current/MANIFEST Sat Jun 4 09:35:13 2011
@@ -1,7 +1,7 @@
Changes
Makefile.PL
MANIFEST
-NTP.pm
+lib/Net/NTP.pm
README
t/1.t
META.yml Module meta-data (added by MakeMaker)
Modified: branches/upstream/libnet-ntp-perl/current/META.yml
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-ntp-perl/current/META.yml?rev=75104&op=diff
==============================================================================
--- branches/upstream/libnet-ntp-perl/current/META.yml (original)
+++ branches/upstream/libnet-ntp-perl/current/META.yml Sat Jun 4 09:35:13 2011
@@ -1,10 +1,21 @@
-# http://module-build.sourceforge.net/META-spec.html
-#XXXXXXX This is a prototype!!! It will change in the future!!! XXXXX#
-name: Net-NTP
-version: 1.2
-version_from: NTP.pm
-installdirs: site
-requires:
-
-distribution_type: module
-generated_by: ExtUtils::MakeMaker version 6.21
+--- #YAML:1.0
+name: Net-NTP
+version: 1.3
+abstract: Perl extension for decoding NTP server responses
+author:
+ - Ask Bjørn Hansen <ask at develooper.com>
+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
Modified: branches/upstream/libnet-ntp-perl/current/Makefile.PL
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-ntp-perl/current/Makefile.PL?rev=75104&op=diff
==============================================================================
--- branches/upstream/libnet-ntp-perl/current/Makefile.PL (original)
+++ branches/upstream/libnet-ntp-perl/current/Makefile.PL Sat Jun 4 09:35:13 2011
@@ -1,12 +1,26 @@
use 5.008;
use ExtUtils::MakeMaker;
-# See lib/ExtUtils/MakeMaker.pm for details of how to influence
-# the contents of the Makefile that is written.
+
WriteMakefile(
- 'NAME' => 'Net::NTP',
- 'VERSION_FROM' => 'NTP.pm', # finds $VERSION
- 'PREREQ_PM' => {}, # e.g., Module::Name => 1.1
- ($] >= 5.005 ? ## Add these new keywords supported since 5.005
- (ABSTRACT_FROM => 'NTP.pm', # retrieve abstract from module
- AUTHOR => 'James G Willmore <jwillmore at adelphia.net>') : ()),
+ '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 <ask at develooper.com>'
+ )
+ : ()
+ ),
);
+
+sub MY::postamble {
+ qq[
+testcover :
+\t cover -delete && \\
+ HARNESS_PERL_SWITCHES=-MDevel::Cover \$(MAKE) test && \\
+ cover
+]
+
+}
+
Added: branches/upstream/libnet-ntp-perl/current/lib/Net/NTP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-ntp-perl/current/lib/Net/NTP.pm?rev=75104&op=file
==============================================================================
--- branches/upstream/libnet-ntp-perl/current/lib/Net/NTP.pm (added)
+++ branches/upstream/libnet-ntp-perl/current/lib/Net/NTP.pm Sat Jun 4 09:35:13 2011
@@ -1,0 +1,264 @@
+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(<server>, <port>);
+
+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, E<lt>ask at develooper.com<gt>
+
+Originally by James G. Willmore, E<lt>jwillmore (at) adelphia.net<gt>
+or E<lt>owner (at) ljcomputing.net<gt>
+
+Special thanks to Ralf D. Kloth E<lt>ralf (at) qrq.de<gt> 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
Modified: branches/upstream/libnet-ntp-perl/current/t/1.t
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-ntp-perl/current/t/1.t?rev=75104&op=diff
==============================================================================
--- branches/upstream/libnet-ntp-perl/current/t/1.t (original)
+++ branches/upstream/libnet-ntp-perl/current/t/1.t Sat Jun 4 09:35:13 2011
@@ -1,15 +1,5 @@
-# Before `make install' is performed this script should be runnable with
-# `make test'. After `make install' it should work as `perl 1.t'
-
-#########################
-
-# change 'tests => 1' to 'tests => last_test_to_print';
use Test::More tests => 1;
BEGIN { use_ok('Net::NTP') };
#########################
-
-# Insert your test code below, the Test::More module is use()ed here so read
-# its man page ( perldoc Test::More ) for help writing this test script.
-my $ntp = get_ntp_response();
More information about the Pkg-perl-cvs-commits
mailing list