1N/A# Net::Time.pm
1N/A#
1N/A# Copyright (c) 1995-1998 Graham Barr <gbarr@pobox.com>. All rights reserved.
1N/A# This program is free software; you can redistribute it and/or
1N/A# modify it under the same terms as Perl itself.
1N/A
1N/Apackage Net::Time;
1N/A
1N/Ause strict;
1N/Ause vars qw($VERSION @ISA @EXPORT_OK $TIMEOUT);
1N/Ause Carp;
1N/Ause IO::Socket;
1N/Arequire Exporter;
1N/Ause Net::Config;
1N/Ause IO::Select;
1N/A
1N/A@ISA = qw(Exporter);
1N/A@EXPORT_OK = qw(inet_time inet_daytime);
1N/A
1N/A$VERSION = "2.09"; # $Id: //depot/libnet/Net/Time.pm#9 $
1N/A
1N/A$TIMEOUT = 120;
1N/A
1N/Asub _socket
1N/A{
1N/A my($pname,$pnum,$host,$proto,$timeout) = @_;
1N/A
1N/A $proto ||= 'udp';
1N/A
1N/A my $port = (getservbyname($pname, $proto))[2] || $pnum;
1N/A
1N/A my $hosts = defined $host ? [ $host ] : $NetConfig{$pname . '_hosts'};
1N/A
1N/A my $me;
1N/A
1N/A foreach $host (@$hosts)
1N/A {
1N/A $me = IO::Socket::INET->new(PeerAddr => $host,
1N/A PeerPort => $port,
1N/A Proto => $proto
1N/A ) and last;
1N/A }
1N/A
1N/A return unless $me;
1N/A
1N/A $me->send("\n")
1N/A if $proto eq 'udp';
1N/A
1N/A $timeout = $TIMEOUT
1N/A unless defined $timeout;
1N/A
1N/A IO::Select->new($me)->can_read($timeout)
1N/A ? $me
1N/A : undef;
1N/A}
1N/A
1N/Asub inet_time
1N/A{
1N/A my $s = _socket('time',37,@_) || return undef;
1N/A my $buf = '';
1N/A my $offset = 0 | 0;
1N/A
1N/A return undef
1N/A unless $s->recv($buf, length(pack("N",0)));
1N/A
1N/A # unpack, we | 0 to ensure we have an unsigned
1N/A my $time = (unpack("N",$buf))[0] | 0;
1N/A
1N/A # the time protocol return time in seconds since 1900, convert
1N/A # it to a the required format
1N/A
1N/A if($^O eq "MacOS") {
1N/A # MacOS return seconds since 1904, 1900 was not a leap year.
1N/A $offset = (4 * 31536000) | 0;
1N/A }
1N/A else {
1N/A # otherwise return seconds since 1972, there were 17 leap years between
1N/A # 1900 and 1972
1N/A $offset = (70 * 31536000 + 17 * 86400) | 0;
1N/A }
1N/A
1N/A $time - $offset;
1N/A}
1N/A
1N/Asub inet_daytime
1N/A{
1N/A my $s = _socket('daytime',13,@_) || return undef;
1N/A my $buf = '';
1N/A
1N/A $s->recv($buf, 1024) ? $buf
1N/A : undef;
1N/A}
1N/A
1N/A1;
1N/A
1N/A__END__
1N/A
1N/A=head1 NAME
1N/A
1N/ANet::Time - time and daytime network client interface
1N/A
1N/A=head1 SYNOPSIS
1N/A
1N/A use Net::Time qw(inet_time inet_daytime);
1N/A
1N/A print inet_time(); # use default host from Net::Config
1N/A print inet_time('localhost');
1N/A print inet_time('localhost', 'tcp');
1N/A
1N/A print inet_daytime(); # use default host from Net::Config
1N/A print inet_daytime('localhost');
1N/A print inet_daytime('localhost', 'tcp');
1N/A
1N/A=head1 DESCRIPTION
1N/A
1N/AC<Net::Time> provides subroutines that obtain the time on a remote machine.
1N/A
1N/A=over 4
1N/A
1N/A=item inet_time ( [HOST [, PROTOCOL [, TIMEOUT]]])
1N/A
1N/AObtain the time on C<HOST>, or some default host if C<HOST> is not given
1N/Aor not defined, using the protocol as defined in RFC868. The optional
1N/Aargument C<PROTOCOL> should define the protocol to use, either C<tcp> or
1N/AC<udp>. The result will be a time value in the same units as returned
1N/Aby time() or I<undef> upon failure.
1N/A
1N/A=item inet_daytime ( [HOST [, PROTOCOL [, TIMEOUT]]])
1N/A
1N/AObtain the time on C<HOST>, or some default host if C<HOST> is not given
1N/Aor not defined, using the protocol as defined in RFC867. The optional
1N/Aargument C<PROTOCOL> should define the protocol to use, either C<tcp> or
1N/AC<udp>. The result will be an ASCII string or I<undef> upon failure.
1N/A
1N/A=back
1N/A
1N/A=head1 AUTHOR
1N/A
1N/AGraham Barr <gbarr@pobox.com>
1N/A
1N/A=head1 COPYRIGHT
1N/A
1N/ACopyright (c) 1995-1998 Graham Barr. All rights reserved.
1N/AThis program is free software; you can redistribute it and/or modify
1N/Ait under the same terms as Perl itself.
1N/A
1N/A=for html <hr>
1N/A
1N/AI<$Id: //depot/libnet/Net/Time.pm#9 $>
1N/A
1N/A=cut