1 | # Net::Time.pm
|
---|
2 | #
|
---|
3 | # Copyright (c) 1995-2004 Graham Barr <[email protected]>. 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 <[email protected]>
|
---|
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
|
---|