r43643 - in /branches/upstream/libnet-ntp-perl: ./ current/ current/Changes current/MANIFEST current/META.yml current/Makefile.PL current/NTP.pm current/README current/eg/ current/eg/test_ntp.pl current/t/ current/t/1.t
dmn at users.alioth.debian.org
dmn at users.alioth.debian.org
Fri Sep 4 10:42:48 UTC 2009
Author: dmn
Date: Fri Sep 4 10:42:24 2009
New Revision: 43643
URL: http://svn.debian.org/wsvn/pkg-perl/?sc=1&rev=43643
Log:
[svn-inject] Installing original source of libnet-ntp-perl
Added:
branches/upstream/libnet-ntp-perl/
branches/upstream/libnet-ntp-perl/current/
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/NTP.pm
branches/upstream/libnet-ntp-perl/current/README
branches/upstream/libnet-ntp-perl/current/eg/
branches/upstream/libnet-ntp-perl/current/eg/test_ntp.pl (with props)
branches/upstream/libnet-ntp-perl/current/t/
branches/upstream/libnet-ntp-perl/current/t/1.t
Added: branches/upstream/libnet-ntp-perl/current/Changes
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-ntp-perl/current/Changes?rev=43643&op=file
==============================================================================
--- branches/upstream/libnet-ntp-perl/current/Changes (added)
+++ branches/upstream/libnet-ntp-perl/current/Changes Fri Sep 4 10:42:24 2009
@@ -1,0 +1,11 @@
+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
+
+##IMPORTED TO CVS
+$Log: Changes,v $
+Revision 1.1.1.1 2004/02/23 17:13:10 jim
+Imported Net::NTP into CVS
+
Added: branches/upstream/libnet-ntp-perl/current/MANIFEST
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-ntp-perl/current/MANIFEST?rev=43643&op=file
==============================================================================
--- branches/upstream/libnet-ntp-perl/current/MANIFEST (added)
+++ branches/upstream/libnet-ntp-perl/current/MANIFEST Fri Sep 4 10:42:24 2009
@@ -1,0 +1,7 @@
+Changes
+Makefile.PL
+MANIFEST
+NTP.pm
+README
+t/1.t
+META.yml Module meta-data (added by MakeMaker)
Added: 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=43643&op=file
==============================================================================
--- branches/upstream/libnet-ntp-perl/current/META.yml (added)
+++ branches/upstream/libnet-ntp-perl/current/META.yml Fri Sep 4 10:42:24 2009
@@ -1,0 +1,10 @@
+# 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
Added: 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=43643&op=file
==============================================================================
--- branches/upstream/libnet-ntp-perl/current/Makefile.PL (added)
+++ branches/upstream/libnet-ntp-perl/current/Makefile.PL Fri Sep 4 10:42:24 2009
@@ -1,0 +1,12 @@
+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>') : ()),
+);
Added: branches/upstream/libnet-ntp-perl/current/NTP.pm
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-ntp-perl/current/NTP.pm?rev=43643&op=file
==============================================================================
--- branches/upstream/libnet-ntp-perl/current/NTP.pm (added)
+++ branches/upstream/libnet-ntp-perl/current/NTP.pm Fri Sep 4 10:42:24 2009
@@ -1,0 +1,270 @@
+package Net::NTP;
+#$Header: /home/cvs/Net-NTP/Net/NTP/NTP.pm,v 1.2 2004/02/23 17:53:47 jim Exp $
+
+use 5.008;
+use strict;
+use warnings;
+use Carp;
+
+require Exporter;
+
+our @ISA = qw(Exporter);
+
+our @EXPORT = qw(
+ get_ntp_response
+);
+
+#hack found using Google; MessageID <3C955A7D.D12D160C at earthlink.net>
+#modified to give only a 2 digit version number
+our $VERSION = sprintf "%d.%d", q$Revision: 1.2 $ =~ /(\d+)\.(\d+)/g;
+
+our $CLIENT_TIME_SEND = undef;
+our $CLIENT_TIME_RECEIVE = undef;
+
+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;
+
+ my $host = shift || 'localhost';
+ my $port = shift || 'ntp';
+
+ my $sock = IO::Socket::INET->new(
+ Proto => 'udp',
+ PeerHost => $host,
+ PeerPort => $port )
+ or die $@;
+
+ my %tmp_pkt;
+ my %packet;
+ my $data;
+
+
+ $CLIENT_TIME_SEND = time() unless defined $CLIENT_TIME_SEND;
+ my $client_localtime = $CLIENT_TIME_SEND;
+ 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 "$@";
+ }
+
+ $CLIENT_TIME_RECEIVE = time() unless defined $CLIENT_TIME_RECEIVE;
+
+ 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;
+ 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_resonse(<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
+
+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 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.
+
+=head1 CHANGE LOG
+$Log: NTP.pm,v $
+Revision 1.2 2004/02/23 17:53:47 jim
+Modified regular expression used to produce version number.
+
+Revision 1.1.1.1 2004/02/23 17:11:44 jim
+Imported Net::NTP into CVS
+
+
+=cut
Added: branches/upstream/libnet-ntp-perl/current/README
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-ntp-perl/current/README?rev=43643&op=file
==============================================================================
--- branches/upstream/libnet-ntp-perl/current/README (added)
+++ branches/upstream/libnet-ntp-perl/current/README Fri Sep 4 10:42:24 2009
@@ -1,0 +1,56 @@
+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 E<lt>ralf (at) qrq.de<gt>
+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.
+
Added: branches/upstream/libnet-ntp-perl/current/eg/test_ntp.pl
URL: http://svn.debian.org/wsvn/pkg-perl/branches/upstream/libnet-ntp-perl/current/eg/test_ntp.pl?rev=43643&op=file
==============================================================================
--- branches/upstream/libnet-ntp-perl/current/eg/test_ntp.pl (added)
+++ branches/upstream/libnet-ntp-perl/current/eg/test_ntp.pl Fri Sep 4 10:42:24 2009
@@ -1,0 +1,40 @@
+#!/usr/bin/perl -w
+
+use strict;
+use Net::NTP;
+use Time::HiRes;
+
+print "$Net::NTP::VERSION\n";
+$Net::NTP::TIMEOUT = 20;
+
+#my $time_then = $Net::NTP::CLIENT_TIME_SEND;
+my $time_then = sprintf("%0.5f", Time::HiRes::time);
+$Net::NTP::CLIENT_TIME_SEND = $time_then;
+my %pkt = get_ntp_response(shift);
+my $time_now = sprintf("%0.5f", Time::HiRes::time);
+#my $time_now = time();
+#my $time_now = $Net::NTP::CLIENT_TIME_RECEIVE;
+
+while(my($k,$v) = each %pkt){
+ printf "%s = %s\n", $k, $v;
+ print scalar localtime($v),"\n" if $k =~ /Timestamp$/;
+}
+
+print "then: $time_then\tnow: $time_now\n";
+
+my $dest_org = sprintf "%0.5f", ( ($time_now - $time_then) );
+my $recv_trans = sprintf "%0.5f", ( $pkt{'Receive Timestamp'} - $pkt{'Transmit Timestamp'} );
+my $delay = sprintf "%0.5f", ($dest_org + $recv_trans);
+
+my $recv_org = sprintf "%0.5f", ( $pkt{'Receive Timestamp'} - $time_now );
+my $trans_dest = sprintf "%0.5f", ( $pkt{'Transmit Timestamp'} - $time_then );
+my $offset = sprintf "%0.5f", (($recv_org + $trans_dest) / 2);
+
+print "Delay: $delay\n";
+printf "Offset: %0.5f\n", $offset;
+printf "Mode: %s\n", $Net::NTP::MODE{$pkt{'Mode'}};
+printf "Stratum: %s\n", $Net::NTP::STRATUM{$pkt{'Stratum'}};
+printf "Stratum One Text: %s\n",
+ $Net::NTP::STRATUM_ONE_TEXT{$pkt{'Reference Clock Identifier'}}
+ if($pkt{'Stratum'} == 1);
+printf "Leap Indicator: %s\n", $Net::NTP::LEAP_INDICATOR{$pkt{'Leap Indicator'}};
Propchange: branches/upstream/libnet-ntp-perl/current/eg/test_ntp.pl
------------------------------------------------------------------------------
svn:executable =
Added: 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=43643&op=file
==============================================================================
--- branches/upstream/libnet-ntp-perl/current/t/1.t (added)
+++ branches/upstream/libnet-ntp-perl/current/t/1.t Fri Sep 4 10:42:24 2009
@@ -1,0 +1,15 @@
+# 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