1# Net::Time.pm 2# 3# Copyright (c) 1995-1998 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 7package Net::Time; 8 9use strict; 10use vars qw($VERSION @ISA @EXPORT_OK $TIMEOUT); 11use Carp; 12use IO::Socket; 13require Exporter; 14use Net::Config; 15use IO::Select; 16 17@ISA = qw(Exporter); 18@EXPORT_OK = qw(inet_time inet_daytime); 19 20$VERSION = "2.09"; # $Id: //depot/libnet/Net/Time.pm#9 $ 21 22$TIMEOUT = 120; 23 24sub _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 57sub 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 $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 85sub inet_daytime 86{ 87 my $s = _socket('daytime',13,@_) || return undef; 88 my $buf = ''; 89 90 $s->recv($buf, 1024) ? $buf 91 : undef; 92} 93 941; 95 96__END__ 97 98=head1 NAME 99 100Net::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 116C<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 122Obtain the time on C<HOST>, or some default host if C<HOST> is not given 123or not defined, using the protocol as defined in RFC868. The optional 124argument C<PROTOCOL> should define the protocol to use, either C<tcp> or 125C<udp>. The result will be a time value in the same units as returned 126by time() or I<undef> upon failure. 127 128=item inet_daytime ( [HOST [, PROTOCOL [, TIMEOUT]]]) 129 130Obtain the time on C<HOST>, or some default host if C<HOST> is not given 131or not defined, using the protocol as defined in RFC867. The optional 132argument C<PROTOCOL> should define the protocol to use, either C<tcp> or 133C<udp>. The result will be an ASCII string or I<undef> upon failure. 134 135=back 136 137=head1 AUTHOR 138 139Graham Barr <gbarr@pobox.com> 140 141=head1 COPYRIGHT 142 143Copyright (c) 1995-1998 Graham Barr. All rights reserved. 144This program is free software; you can redistribute it and/or modify 145it under the same terms as Perl itself. 146 147=for html <hr> 148 149I<$Id: //depot/libnet/Net/Time.pm#9 $> 150 151=cut 152