| 1 |
# Net::Time.pm |
| 2 |
# |
| 3 |
# Copyright (c) 1995-2004 Graham Barr <gbarr@pobox.com>. All rights reserved. |
| 4 |
# This program is free software; you can redistribute it and/or |
| 5 |
# modify it under the same terms as Perl itself. |
| 6 |
|
| 7 |
package Net::Time; |
| 8 |
|
| 9 |
use strict; |
| 10 |
use vars qw($VERSION @ISA @EXPORT_OK $TIMEOUT); |
| 11 |
use Carp; |
| 12 |
use IO::Socket; |
| 13 |
require Exporter; |
| 14 |
use Net::Config; |
| 15 |
use IO::Select; |
| 16 |
|
| 17 |
@ISA = qw(Exporter); |
| 18 |
@EXPORT_OK = qw(inet_time inet_daytime); |
| 19 |
|
| 20 |
$VERSION = "2.10"; |
| 21 |
|
| 22 |
$TIMEOUT = 120; |
| 23 |
|
| 24 |
sub _socket |
| 25 |
{ |
| 26 |
my($pname,$pnum,$host,$proto,$timeout) = @_; |
| 27 |
|
| 28 |
$proto ||= 'udp'; |
| 29 |
|
| 30 |
my $port = (getservbyname($pname, $proto))[2] || $pnum; |
| 31 |
|
| 32 |
my $hosts = defined $host ? [ $host ] : $NetConfig{$pname . '_hosts'}; |
| 33 |
|
| 34 |
my $me; |
| 35 |
|
| 36 |
foreach $host (@$hosts) |
| 37 |
{ |
| 38 |
$me = IO::Socket::INET->new(PeerAddr => $host, |
| 39 |
PeerPort => $port, |
| 40 |
Proto => $proto |
| 41 |
) and last; |
| 42 |
} |
| 43 |
|
| 44 |
return unless $me; |
| 45 |
|
| 46 |
$me->send("\n") |
| 47 |
if $proto eq 'udp'; |
| 48 |
|
| 49 |
$timeout = $TIMEOUT |
| 50 |
unless defined $timeout; |
| 51 |
|
| 52 |
IO::Select->new($me)->can_read($timeout) |
| 53 |
? $me |
| 54 |
: undef; |
| 55 |
} |
| 56 |
|
| 57 |
sub inet_time |
| 58 |
{ |
| 59 |
my $s = _socket('time',37,@_) || return undef; |
| 60 |
my $buf = ''; |
| 61 |
my $offset = 0 | 0; |
| 62 |
|
| 63 |
return undef |
| 64 |
unless defined $s->recv($buf, length(pack("N",0))); |
| 65 |
|
| 66 |
# unpack, we | 0 to ensure we have an unsigned |
| 67 |
my $time = (unpack("N",$buf))[0] | 0; |
| 68 |
|
| 69 |
# the time protocol return time in seconds since 1900, convert |
| 70 |
# it to a the required format |
| 71 |
|
| 72 |
if($^O eq "MacOS") { |
| 73 |
# MacOS return seconds since 1904, 1900 was not a leap year. |
| 74 |
$offset = (4 * 31536000) | 0; |
| 75 |
} |
| 76 |
else { |
| 77 |
# otherwise return seconds since 1972, there were 17 leap years between |
| 78 |
# 1900 and 1972 |
| 79 |
$offset = (70 * 31536000 + 17 * 86400) | 0; |
| 80 |
} |
| 81 |
|
| 82 |
$time - $offset; |
| 83 |
} |
| 84 |
|
| 85 |
sub inet_daytime |
| 86 |
{ |
| 87 |
my $s = _socket('daytime',13,@_) || return undef; |
| 88 |
my $buf = ''; |
| 89 |
|
| 90 |
defined($s->recv($buf, 1024)) ? $buf |
| 91 |
: undef; |
| 92 |
} |
| 93 |
|
| 94 |
1; |
| 95 |
|
| 96 |
__END__ |
| 97 |
|
| 98 |
=head1 NAME |
| 99 |
|
| 100 |
Net::Time - time and daytime network client interface |
| 101 |
|
| 102 |
=head1 SYNOPSIS |
| 103 |
|
| 104 |
use Net::Time qw(inet_time inet_daytime); |
| 105 |
|
| 106 |
print inet_time(); # use default host from Net::Config |
| 107 |
print inet_time('localhost'); |
| 108 |
print inet_time('localhost', 'tcp'); |
| 109 |
|
| 110 |
print inet_daytime(); # use default host from Net::Config |
| 111 |
print inet_daytime('localhost'); |
| 112 |
print inet_daytime('localhost', 'tcp'); |
| 113 |
|
| 114 |
=head1 DESCRIPTION |
| 115 |
|
| 116 |
C<Net::Time> provides subroutines that obtain the time on a remote machine. |
| 117 |
|
| 118 |
=over 4 |
| 119 |
|
| 120 |
=item inet_time ( [HOST [, PROTOCOL [, TIMEOUT]]]) |
| 121 |
|
| 122 |
Obtain the time on C<HOST>, or some default host if C<HOST> is not given |
| 123 |
or not defined, using the protocol as defined in RFC868. The optional |
| 124 |
argument C<PROTOCOL> should define the protocol to use, either C<tcp> or |
| 125 |
C<udp>. The result will be a time value in the same units as returned |
| 126 |
by time() or I<undef> upon failure. |
| 127 |
|
| 128 |
=item inet_daytime ( [HOST [, PROTOCOL [, TIMEOUT]]]) |
| 129 |
|
| 130 |
Obtain the time on C<HOST>, or some default host if C<HOST> is not given |
| 131 |
or not defined, using the protocol as defined in RFC867. The optional |
| 132 |
argument C<PROTOCOL> should define the protocol to use, either C<tcp> or |
| 133 |
C<udp>. The result will be an ASCII string or I<undef> upon failure. |
| 134 |
|
| 135 |
=back |
| 136 |
|
| 137 |
=head1 AUTHOR |
| 138 |
|
| 139 |
Graham Barr <gbarr@pobox.com> |
| 140 |
|
| 141 |
=head1 COPYRIGHT |
| 142 |
|
| 143 |
Copyright (c) 1995-2004 Graham Barr. All rights reserved. |
| 144 |
This program is free software; you can redistribute it and/or modify |
| 145 |
it under the same terms as Perl itself. |
| 146 |
|
| 147 |
=cut |
