| Subject: | Make timeout a parameter, and fix Originate Timestamp bugs |
| Date: | Tue, 05 Aug 2008 18:40:20 +0100 |
| To: | bug-Net-NTP [...] rt.cpan.org |
| From: | "Gordon Lack" <gml4410 [...] gsk.com> |
The following patch:
a) Adds a 3rd parameter to the get_ntp_response function, which allows
you to specify the timeout in seconds (the default is still 60).
b) Fixes the setting up of the client localtime in the call, as the
original code is passing the complete time to frac2bin, rather than just
the fractional part (which, in the standard code would always be 0).
c) Use gettimeofday (if Time::HiRes is available) rather than just
time(), so that there can be a fractional part to the client localtime.
d) Removes $CLIENT_TIME_SEND. This was being set on the first call, and
the same value was then used for *ll *calls. Since this is meant to be
the time of *this* call that makes no sense.
e) Removed $CLIENT_TIME_RECEIVE, as it was unused.
=============== patch ========================
--- NTP.pm.orig 2004-02-23 17:53:47.000000000 +0000
+++ NTP.pm 2008-08-05 18:25:21.023337000 +0100
@@ -18,10 +18,7 @@
#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 $DFLT_TIMEOUT = 60,
our %MODE = (
'0' => 'reserved',
@@ -139,12 +136,24 @@
return $ip;
};
+# Allow HiRes timing iff it can be done.
+#
+ my $use_gtod;
+BEGIN {
+ eval {use Time::HiRes qw( gettimeofday ) };
+ $use_gtod = ($@ eq '');
+}
+
sub get_ntp_response{
use IO::Socket;
my $host = shift || 'localhost';
my $port = shift || 'ntp';
+# Allow timeout to be specified
+#
+ my $TIMEOUT = shift || $DFLT_TIMEOUT;
+
my $sock = IO::Socket::INET->new(
Proto => 'udp',
PeerHost => $host,
@@ -155,11 +164,20 @@
my %packet;
my $data;
+# Use Hires timers if avail, and split int/frac(if there) when packing
- $CLIENT_TIME_SEND = time() unless defined $CLIENT_TIME_SEND;
- my $client_localtime = $CLIENT_TIME_SEND;
+ my ($client_localtime, $client_part_localtime);
+ if ($use_gtod) {
+ my $atime = gettimeofday();
+ $client_localtime = int($atime);
+ $client_part_localtime = $atime - $client_localtime;
+ }
+ else {
+ $client_localtime = time();
+ $client_part_localtime = 0;
+ }
my $client_adj_localtime = $client_localtime + NTP_ADJ;
- my $client_frac_localtime = $frac2bin->($client_adj_localtime);
+ my $client_frac_localtime = $frac2bin->($client_part_localtime);
my $ntp_msg =
pack( "B8 C3 N10 B32", '00011011', (0) x 12, int($client_localtime),
@@ -180,8 +198,6 @@
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/;
@@ -237,9 +253,9 @@
=head2 EXPORT
-get_ntp_resonse(<server>, <port>);
+get_ntp_resonse(<server>, <port>, <timeout>);
-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.
+This module exports a single method - get_ntp_response. It takes the server as the first argument (localhost is the default), port to send/recieve the packets (ntp or 123 by default) and a timeout as the third (default is 60s). 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