1# Net::Time.pm 2# 3# Copyright (C) 1995-2004 Graham Barr. All rights reserved. 4# Copyright (C) 2014, 2020 Steve Hay. All rights reserved. 5# This module is free software; you can redistribute it and/or modify it under 6# the same terms as Perl itself, i.e. under the terms of either the GNU General 7# Public License or the Artistic License, as specified in the F<LICENCE> file. 8 9package Net::Time; 10 11use 5.008001; 12 13use strict; 14use warnings; 15 16use Carp; 17use Exporter; 18use IO::Select; 19use IO::Socket; 20use Net::Config; 21 22our @ISA = qw(Exporter); 23our @EXPORT_OK = qw(inet_time inet_daytime); 24 25our $VERSION = "3.15"; 26 27our $TIMEOUT = 120; 28 29sub _socket { 30 my ($pname, $pnum, $host, $proto, $timeout) = @_; 31 32 $proto ||= 'udp'; 33 34 my $port = (getservbyname($pname, $proto))[2] || $pnum; 35 36 my $hosts = defined $host ? [$host] : $NetConfig{$pname . '_hosts'}; 37 38 my $me; 39 40 foreach my $addr (@$hosts) { 41 $me = IO::Socket::INET->new( 42 PeerAddr => $addr, 43 PeerPort => $port, 44 Proto => $proto 45 ) 46 and last; 47 } 48 49 return unless $me; 50 51 $me->send("\n") 52 if $proto eq 'udp'; 53 54 $timeout = $TIMEOUT 55 unless defined $timeout; 56 57 IO::Select->new($me)->can_read($timeout) 58 ? $me 59 : undef; 60} 61 62 63sub inet_time { 64 my $s = _socket('time', 37, @_) || return; 65 my $buf = ''; 66 my $offset = 0 | 0; 67 68 return 69 unless defined $s->recv($buf, length(pack("N", 0))); 70 71 # unpack, we | 0 to ensure we have an unsigned 72 my $time = (unpack("N", $buf))[0] | 0; 73 74 # the time protocol return time in seconds since 1900, convert 75 # it to a the required format 76 77 if ($^O eq "MacOS") { 78 79 # MacOS return seconds since 1904, 1900 was not a leap year. 80 $offset = (4 * 31536000) | 0; 81 } 82 else { 83 84 # otherwise return seconds since 1972, there were 17 leap years between 85 # 1900 and 1972 86 $offset = (70 * 31536000 + 17 * 86400) | 0; 87 } 88 89 $time - $offset; 90} 91 92 93sub inet_daytime { 94 my $s = _socket('daytime', 13, @_) || return; 95 my $buf = ''; 96 97 defined($s->recv($buf, 1024)) 98 ? $buf 99 : undef; 100} 101 1021; 103 104__END__ 105 106=head1 NAME 107 108Net::Time - time and daytime network client interface 109 110=head1 SYNOPSIS 111 112 use Net::Time qw(inet_time inet_daytime); 113 114 print inet_time(); # use default host from Net::Config 115 print inet_time('localhost'); 116 print inet_time('localhost', 'tcp'); 117 118 print inet_daytime(); # use default host from Net::Config 119 print inet_daytime('localhost'); 120 print inet_daytime('localhost', 'tcp'); 121 122=head1 DESCRIPTION 123 124C<Net::Time> provides subroutines that obtain the time on a remote machine. 125 126=head2 Functions 127 128=over 4 129 130=item C<inet_time([$host[, $protocol[, $timeout]]])> 131 132Obtain the time on C<$host>, or some default host if C<$host> is not given 133or not defined, using the protocol as defined in RFC868. The optional 134argument C<$protocol> should define the protocol to use, either C<tcp> or 135C<udp>. The result will be a time value in the same units as returned 136by time() or I<undef> upon failure. 137 138=item C<inet_daytime([$host[, $protocol[, $timeout]]])> 139 140Obtain the time on C<$host>, or some default host if C<$host> is not given 141or not defined, using the protocol as defined in RFC867. The optional 142argument C<$protocol> should define the protocol to use, either C<tcp> or 143C<udp>. The result will be an ASCII string or I<undef> upon failure. 144 145=back 146 147=head1 EXPORTS 148 149The following symbols are, or can be, exported by this module: 150 151=over 4 152 153=item Default Exports 154 155I<None>. 156 157=item Optional Exports 158 159C<inet_time>, 160C<inet_daytime>. 161 162=item Export Tags 163 164I<None>. 165 166=back 167 168=head1 KNOWN BUGS 169 170I<None>. 171 172=head1 AUTHOR 173 174Graham Barr E<lt>L<gbarr@pobox.com|mailto:gbarr@pobox.com>E<gt>. 175 176Steve Hay E<lt>L<shay@cpan.org|mailto:shay@cpan.org>E<gt> is now maintaining 177libnet as of version 1.22_02. 178 179=head1 COPYRIGHT 180 181Copyright (C) 1995-2004 Graham Barr. All rights reserved. 182 183Copyright (C) 2014, 2020 Steve Hay. All rights reserved. 184 185=head1 LICENCE 186 187This module is free software; you can redistribute it and/or modify it under the 188same terms as Perl itself, i.e. under the terms of either the GNU General Public 189License or the Artistic License, as specified in the F<LICENCE> file. 190 191=head1 VERSION 192 193Version 3.15 194 195=head1 DATE 196 19720 March 2023 198 199=head1 HISTORY 200 201See the F<Changes> file. 202 203=cut 204