This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
small improvements to documentation of IO::Socket
[perl5.git] / dist / IO / lib / IO / Socket / INET.pm
CommitLineData
cf7fe8a2
GS
1# IO::Socket::INET.pm
2#
3# Copyright (c) 1997-8 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
7package IO::Socket::INET;
8
9use strict;
17f410f9 10our(@ISA, $VERSION);
cf7fe8a2 11use IO::Socket;
90b9a713 12use Socket;
cf7fe8a2
GS
13use Carp;
14use Exporter;
e541f5e7 15use Errno;
cf7fe8a2
GS
16
17@ISA = qw(IO::Socket);
1936be83 18$VERSION = "1.34";
cf7fe8a2 19
e541f5e7
GS
20my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1;
21
cf7fe8a2
GS
22IO::Socket::INET->register_domain( AF_INET );
23
24my %socket_type = ( tcp => SOCK_STREAM,
25 udp => SOCK_DGRAM,
26 icmp => SOCK_RAW
27 );
ebcd0cc0
GA
28my %proto_number;
29$proto_number{tcp} = Socket::IPPROTO_TCP() if defined &Socket::IPPROTO_TCP;
7027b9a3 30$proto_number{udp} = Socket::IPPROTO_UDP() if defined &Socket::IPPROTO_UDP;
ebcd0cc0
GA
31$proto_number{icmp} = Socket::IPPROTO_ICMP() if defined &Socket::IPPROTO_ICMP;
32my %proto_name = reverse %proto_number;
cf7fe8a2
GS
33
34sub new {
35 my $class = shift;
36 unshift(@_, "PeerAddr") if @_ == 1;
37 return $class->SUPER::new(@_);
38}
39
ebcd0cc0
GA
40sub _cache_proto {
41 my @proto = @_;
42 for (map lc($_), $proto[0], split(' ', $proto[1])) {
43 $proto_number{$_} = $proto[2];
44 }
45 $proto_name{$proto[2]} = $proto[0];
46}
47
48sub _get_proto_number {
49 my $name = lc(shift);
50 return undef unless defined $name;
51 return $proto_number{$name} if exists $proto_number{$name};
52
53 my @proto = getprotobyname($name);
54 return undef unless @proto;
55 _cache_proto(@proto);
56
57 return $proto[2];
58}
59
60sub _get_proto_name {
61 my $num = shift;
62 return undef unless defined $num;
63 return $proto_name{$num} if exists $proto_name{$num};
64
65 my @proto = getprotobynumber($num);
66 return undef unless @proto;
67 _cache_proto(@proto);
68
69 return $proto[0];
70}
71
cf7fe8a2
GS
72sub _sock_info {
73 my($addr,$port,$proto) = @_;
83fe8690 74 my $origport = $port;
cf7fe8a2
GS
75 my @serv = ();
76
77 $port = $1
78 if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
79
7822251e 80 if(defined $proto && $proto =~ /\D/) {
ebcd0cc0
GA
81 my $num = _get_proto_number($proto);
82 unless (defined $num) {
c9fcc6c4
GS
83 $@ = "Bad protocol '$proto'";
84 return;
85 }
ebcd0cc0 86 $proto = $num;
cf7fe8a2
GS
87 }
88
89 if(defined $port) {
293f53d8 90 my $defport = ($port =~ s,\((\d+)\)$,,) ? $1 : undef;
cf7fe8a2
GS
91 my $pnum = ($port =~ m,^(\d+)$,)[0];
92
ebcd0cc0 93 @serv = getservbyname($port, _get_proto_name($proto) || "")
83fe8690 94 if ($port =~ m,\D,);
cf7fe8a2 95
a957f605 96 $port = $serv[2] || $defport || $pnum;
83fe8690
GS
97 unless (defined $port) {
98 $@ = "Bad service '$origport'";
99 return;
100 }
cf7fe8a2 101
ebcd0cc0 102 $proto = _get_proto_number($serv[3]) if @serv && !$proto;
cf7fe8a2
GS
103 }
104
105 return ($addr || undef,
106 $port || undef,
107 $proto || undef
108 );
109}
110
111sub _error {
112 my $sock = shift;
c9fcc6c4
GS
113 my $err = shift;
114 {
115 local($!);
6f36ad4a 116 my $title = ref($sock).": ";
117 $@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_);
2d169392 118 $sock->close()
cf7fe8a2 119 if(defined fileno($sock));
c9fcc6c4
GS
120 }
121 $! = $err;
cf7fe8a2
GS
122 return undef;
123}
124
125sub _get_addr {
126 my($sock,$addr_str, $multi) = @_;
127 my @addr;
128 if ($multi && $addr_str !~ /^\d+(?:\.\d+){3}$/) {
129 (undef, undef, undef, undef, @addr) = gethostbyname($addr_str);
130 } else {
131 my $h = inet_aton($addr_str);
132 push(@addr, $h) if defined $h;
133 }
134 @addr;
135}
136
137sub configure {
138 my($sock,$arg) = @_;
139 my($lport,$rport,$laddr,$raddr,$proto,$type);
140
141
142 $arg->{LocalAddr} = $arg->{LocalHost}
143 if exists $arg->{LocalHost} && !exists $arg->{LocalAddr};
144
145 ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
146 $arg->{LocalPort},
c9fcc6c4
GS
147 $arg->{Proto})
148 or return _error($sock, $!, $@);
cf7fe8a2
GS
149
150 $laddr = defined $laddr ? inet_aton($laddr)
151 : INADDR_ANY;
152
e541f5e7 153 return _error($sock, $EINVAL, "Bad hostname '",$arg->{LocalAddr},"'")
cf7fe8a2
GS
154 unless(defined $laddr);
155
156 $arg->{PeerAddr} = $arg->{PeerHost}
157 if exists $arg->{PeerHost} && !exists $arg->{PeerAddr};
158
159 unless(exists $arg->{Listen}) {
160 ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
161 $arg->{PeerPort},
c9fcc6c4
GS
162 $proto)
163 or return _error($sock, $!, $@);
cf7fe8a2
GS
164 }
165
ebcd0cc0 166 $proto ||= _get_proto_number('tcp');
cf7fe8a2 167
ebcd0cc0 168 $type = $arg->{Type} || $socket_type{lc _get_proto_name($proto)};
cf7fe8a2
GS
169
170 my @raddr = ();
171
172 if(defined $raddr) {
173 @raddr = $sock->_get_addr($raddr, $arg->{MultiHomed});
e541f5e7 174 return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
cf7fe8a2
GS
175 unless @raddr;
176 }
177
178 while(1) {
179
180 $sock->socket(AF_INET, $type, $proto) or
c9fcc6c4 181 return _error($sock, $!, "$!");
cf7fe8a2 182
3c83a670
DM
183 if (defined $arg->{Blocking}) {
184 defined $sock->blocking($arg->{Blocking})
185 or return _error($sock, $!, "$!");
186 }
187
121c220b 188 if ($arg->{Reuse} || $arg->{ReuseAddr}) {
cf7fe8a2 189 $sock->sockopt(SO_REUSEADDR,1) or
c9fcc6c4 190 return _error($sock, $!, "$!");
cf7fe8a2
GS
191 }
192
8b9593b7
JZ
193 if ($arg->{ReusePort}) {
194 $sock->sockopt(SO_REUSEPORT,1) or
195 return _error($sock, $!, "$!");
196 }
197
3e3f5e61
MB
198 if ($arg->{Broadcast}) {
199 $sock->sockopt(SO_BROADCAST,1) or
200 return _error($sock, $!, "$!");
201 }
202
cf7fe8a2
GS
203 if($lport || ($laddr ne INADDR_ANY) || exists $arg->{Listen}) {
204 $sock->bind($lport || 0, $laddr) or
c9fcc6c4 205 return _error($sock, $!, "$!");
cf7fe8a2
GS
206 }
207
208 if(exists $arg->{Listen}) {
209 $sock->listen($arg->{Listen} || 5) or
c9fcc6c4 210 return _error($sock, $!, "$!");
cf7fe8a2
GS
211 last;
212 }
213
23925046
JH
214 # don't try to connect unless we're given a PeerAddr
215 last unless exists($arg->{PeerAddr});
216
cf7fe8a2
GS
217 $raddr = shift @raddr;
218
e541f5e7 219 return _error($sock, $EINVAL, 'Cannot determine remote port')
cf7fe8a2
GS
220 unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);
221
222 last
223 unless($type == SOCK_STREAM || defined $raddr);
224
e541f5e7 225 return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
cf7fe8a2
GS
226 unless defined $raddr;
227
228# my $timeout = ${*$sock}{'io_socket_timeout'};
229# my $before = time() if $timeout;
230
6f36ad4a 231 undef $@;
cf7fe8a2
GS
232 if ($sock->connect(pack_sockaddr_in($rport, $raddr))) {
233# ${*$sock}{'io_socket_timeout'} = $timeout;
234 return $sock;
235 }
236
6f36ad4a 237 return _error($sock, $!, $@ || "Timeout")
cf7fe8a2
GS
238 unless @raddr;
239
240# if ($timeout) {
241# my $new_timeout = $timeout - (time() - $before);
c9fcc6c4 242# return _error($sock,
e541f5e7 243# (exists(&Errno::ETIMEDOUT) ? Errno::ETIMEDOUT() : $EINVAL),
c9fcc6c4 244# "Timeout") if $new_timeout <= 0;
cf7fe8a2
GS
245# ${*$sock}{'io_socket_timeout'} = $new_timeout;
246# }
247
248 }
249
250 $sock;
251}
252
253sub connect {
254 @_ == 2 || @_ == 3 or
255 croak 'usage: $sock->connect(NAME) or $sock->connect(PORT, ADDR)';
256 my $sock = shift;
257 return $sock->SUPER::connect(@_ == 1 ? shift : pack_sockaddr_in(@_));
258}
259
260sub bind {
261 @_ == 2 || @_ == 3 or
262 croak 'usage: $sock->bind(NAME) or $sock->bind(PORT, ADDR)';
263 my $sock = shift;
264 return $sock->SUPER::bind(@_ == 1 ? shift : pack_sockaddr_in(@_))
265}
266
267sub sockaddr {
268 @_ == 1 or croak 'usage: $sock->sockaddr()';
269 my($sock) = @_;
270 my $name = $sock->sockname;
271 $name ? (sockaddr_in($name))[1] : undef;
272}
273
274sub sockport {
275 @_ == 1 or croak 'usage: $sock->sockport()';
276 my($sock) = @_;
277 my $name = $sock->sockname;
278 $name ? (sockaddr_in($name))[0] : undef;
279}
280
281sub sockhost {
282 @_ == 1 or croak 'usage: $sock->sockhost()';
283 my($sock) = @_;
284 my $addr = $sock->sockaddr;
285 $addr ? inet_ntoa($addr) : undef;
286}
287
288sub peeraddr {
289 @_ == 1 or croak 'usage: $sock->peeraddr()';
290 my($sock) = @_;
291 my $name = $sock->peername;
292 $name ? (sockaddr_in($name))[1] : undef;
293}
294
295sub peerport {
296 @_ == 1 or croak 'usage: $sock->peerport()';
297 my($sock) = @_;
298 my $name = $sock->peername;
299 $name ? (sockaddr_in($name))[0] : undef;
300}
301
302sub peerhost {
303 @_ == 1 or croak 'usage: $sock->peerhost()';
304 my($sock) = @_;
305 my $addr = $sock->peeraddr;
306 $addr ? inet_ntoa($addr) : undef;
307}
308
3091;
310
311__END__
312
313=head1 NAME
314
315IO::Socket::INET - Object interface for AF_INET domain sockets
316
317=head1 SYNOPSIS
318
319 use IO::Socket::INET;
320
321=head1 DESCRIPTION
322
323C<IO::Socket::INET> provides an object interface to creating and using sockets
324in the AF_INET domain. It is built upon the L<IO::Socket> interface and
325inherits all the methods defined by L<IO::Socket>.
326
327=head1 CONSTRUCTOR
328
329=over 4
330
331=item new ( [ARGS] )
332
333Creates an C<IO::Socket::INET> object, which is a reference to a
334newly created symbol (see the C<Symbol> package). C<new>
335optionally takes arguments, these arguments are in key-value pairs.
336
337In addition to the key-value pairs accepted by L<IO::Socket>,
338C<IO::Socket::INET> provides.
339
340
d7d631d3
FC
341 PeerAddr Remote host address <hostname>[:<port>]
342 PeerHost Synonym for PeerAddr
343 PeerPort Remote port or service <service>[(<no>)] | <no>
344 LocalAddr Local host bind address hostname[:port]
345 LocalHost Synonym for LocalAddr
346 LocalPort Local host bind port <service>[(<no>)] | <no>
347 Proto Protocol name (or number) "tcp" | "udp" | ...
348 Type Socket type SOCK_STREAM | SOCK_DGRAM | ...
349 Listen Queue size for listen
350 ReuseAddr Set SO_REUSEADDR before binding
351 Reuse Set SO_REUSEADDR before binding (deprecated,
352 prefer ReuseAddr)
353 ReusePort Set SO_REUSEPORT before binding
354 Broadcast Set SO_BROADCAST before binding
355 Timeout Timeout value for various operations
356 MultiHomed Try all addresses for multi-homed hosts
357 Blocking Determine if connection will be blocking mode
cf7fe8a2
GS
358
359If C<Listen> is defined then a listen socket is created, else if the
360socket type, which is derived from the protocol, is SOCK_STREAM then
1936be83
RS
361connect() is called. If the C<Listen> argument is given, but false,
362the queue size will be set to 5.
cf7fe8a2
GS
363
364Although it is not illegal, the use of C<MultiHomed> on a socket
365which is in non-blocking mode is of little use. This is because the
0a719618 366first connect will never fail with a timeout as the connect call
cf7fe8a2
GS
367will not block.
368
369The C<PeerAddr> can be a hostname or the IP-address on the
370"xx.xx.xx.xx" form. The C<PeerPort> can be a number or a symbolic
371service name. The service name might be followed by a number in
372parenthesis which is used if the service is not known by the system.
373The C<PeerPort> specification can also be embedded in the C<PeerAddr>
374by preceding it with a ":".
375
376If C<Proto> is not given and you specify a symbolic C<PeerPort> port,
377then the constructor will try to derive C<Proto> from the service
378name. As a last resort C<Proto> "tcp" is assumed. The C<Type>
379parameter will be deduced from C<Proto> if not specified.
380
381If the constructor is only passed a single argument, it is assumed to
382be a C<PeerAddr> specification.
383
ae1c8c83
RD
384If C<Blocking> is set to 0, the connection will be in nonblocking mode.
385If not specified it defaults to 1 (blocking mode).
386
cf7fe8a2
GS
387Examples:
388
389 $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org',
390 PeerPort => 'http(80)',
391 Proto => 'tcp');
392
393 $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)');
394
395 $sock = IO::Socket::INET->new(Listen => 5,
396 LocalAddr => 'localhost',
397 LocalPort => 9000,
398 Proto => 'tcp');
399
400 $sock = IO::Socket::INET->new('127.0.0.1:25');
401
d7d631d3
FC
402 $sock = IO::Socket::INET->new(
403 PeerPort => 9999,
404 PeerAddr => inet_ntoa(INADDR_BROADCAST),
405 Proto => udp,
406 LocalAddr => 'localhost',
407 Broadcast => 1 )
408 or die "Can't bind : $@\n";
cf7fe8a2
GS
409
410 NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
3cb6de81 411
cf7fe8a2
GS
412As of VERSION 1.18 all IO::Socket objects have autoflush turned on
413by default. This was not the case with earlier releases.
414
415 NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
416
a45bd81d
GS
417=back
418
cf7fe8a2
GS
419=head2 METHODS
420
421=over 4
422
423=item sockaddr ()
424
425Return the address part of the sockaddr structure for the socket
426
427=item sockport ()
428
429Return the port number that the socket is using on the local host
430
431=item sockhost ()
432
433Return the address part of the sockaddr structure for the socket in a
434text form xx.xx.xx.xx
435
436=item peeraddr ()
437
438Return the address part of the sockaddr structure for the socket on
439the peer host
440
441=item peerport ()
442
443Return the port number for the socket on the peer host.
444
445=item peerhost ()
446
447Return the address part of the sockaddr structure for the socket on the
448peer host in a text form xx.xx.xx.xx
449
450=back
451
452=head1 SEE ALSO
453
454L<Socket>, L<IO::Socket>
455
456=head1 AUTHOR
457
854822f1 458Graham Barr. Currently maintained by the Perl Porters. Please report all
9f7d1e40 459bugs to <perlbug@perl.org>.
cf7fe8a2
GS
460
461=head1 COPYRIGHT
462
463Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
464This program is free software; you can redistribute it and/or
465modify it under the same terms as Perl itself.
466
467=cut