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 

     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.09"; # $Id: //depot/libnet/Net/Time.pm#9 $

    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 $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  $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-1998 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 =for html <hr>

   148 

   149 I<$Id: //depot/libnet/Net/Time.pm#9 $>

   150 

   151 =cut