lib/Net/Time.pm

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