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
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
7 package IO::Socket::INET;
8
9 use strict;
10 our(@ISA, $VERSION);
11 use IO::Socket;
12 use Socket;
13 use Carp;
14 use Exporter;
15 use Errno;
16
17 @ISA = qw(IO::Socket);
18 $VERSION = "1.34";
19
20 my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1;
21
22 IO::Socket::INET->register_domain( AF_INET );
23
24 my %socket_type = ( tcp  => SOCK_STREAM,
25                     udp  => SOCK_DGRAM,
26                     icmp => SOCK_RAW
27                   );
28 my %proto_number;
29 $proto_number{tcp}  = Socket::IPPROTO_TCP()  if defined &Socket::IPPROTO_TCP;
30 $proto_number{udp}  = Socket::IPPROTO_UDP()  if defined &Socket::IPPROTO_UDP;
31 $proto_number{icmp} = Socket::IPPROTO_ICMP() if defined &Socket::IPPROTO_ICMP;
32 my %proto_name = reverse %proto_number;
33
34 sub new {
35     my $class = shift;
36     unshift(@_, "PeerAddr") if @_ == 1;
37     return $class->SUPER::new(@_);
38 }
39
40 sub _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
48 sub _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
60 sub _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
72 sub _sock_info {
73   my($addr,$port,$proto) = @_;
74   my $origport = $port;
75   my @serv = ();
76
77   $port = $1
78         if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
79
80   if(defined $proto  && $proto =~ /\D/) {
81     my $num = _get_proto_number($proto);
82     unless (defined $num) {
83       $@ = "Bad protocol '$proto'";
84       return;
85     }
86     $proto = $num;
87   }
88
89   if(defined $port) {
90     my $defport = ($port =~ s,\((\d+)\)$,,) ? $1 : undef;
91     my $pnum = ($port =~ m,^(\d+)$,)[0];
92
93     @serv = getservbyname($port, _get_proto_name($proto) || "")
94         if ($port =~ m,\D,);
95
96     $port = $serv[2] || $defport || $pnum;
97     unless (defined $port) {
98         $@ = "Bad service '$origport'";
99         return;
100     }
101
102     $proto = _get_proto_number($serv[3]) if @serv && !$proto;
103   }
104
105  return ($addr || undef,
106          $port || undef,
107          $proto || undef
108         );
109 }
110
111 sub _error {
112     my $sock = shift;
113     my $err = shift;
114     {
115       local($!);
116       my $title = ref($sock).": ";
117       $@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_);
118       $sock->close()
119         if(defined fileno($sock));
120     }
121     $! = $err;
122     return undef;
123 }
124
125 sub _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
137 sub 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},
147                                         $arg->{Proto})
148                         or return _error($sock, $!, $@);
149
150     $laddr = defined $laddr ? inet_aton($laddr)
151                             : INADDR_ANY;
152
153     return _error($sock, $EINVAL, "Bad hostname '",$arg->{LocalAddr},"'")
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},
162                                             $proto)
163                         or return _error($sock, $!, $@);
164     }
165
166     $proto ||= _get_proto_number('tcp');
167
168     $type = $arg->{Type} || $socket_type{lc _get_proto_name($proto)};
169
170     my @raddr = ();
171
172     if(defined $raddr) {
173         @raddr = $sock->_get_addr($raddr, $arg->{MultiHomed});
174         return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
175             unless @raddr;
176     }
177
178     while(1) {
179
180         $sock->socket(AF_INET, $type, $proto) or
181             return _error($sock, $!, "$!");
182
183         if (defined $arg->{Blocking}) {
184             defined $sock->blocking($arg->{Blocking})
185                 or return _error($sock, $!, "$!");
186         }
187
188         if ($arg->{Reuse} || $arg->{ReuseAddr}) {
189             $sock->sockopt(SO_REUSEADDR,1) or
190                     return _error($sock, $!, "$!");
191         }
192
193         if ($arg->{ReusePort}) {
194             $sock->sockopt(SO_REUSEPORT,1) or
195                     return _error($sock, $!, "$!");
196         }
197
198         if ($arg->{Broadcast}) {
199                 $sock->sockopt(SO_BROADCAST,1) or
200                     return _error($sock, $!, "$!");
201         }
202
203         if($lport || ($laddr ne INADDR_ANY) || exists $arg->{Listen}) {
204             $sock->bind($lport || 0, $laddr) or
205                     return _error($sock, $!, "$!");
206         }
207
208         if(exists $arg->{Listen}) {
209             $sock->listen($arg->{Listen} || 5) or
210                 return _error($sock, $!, "$!");
211             last;
212         }
213
214         # don't try to connect unless we're given a PeerAddr
215         last unless exists($arg->{PeerAddr});
216  
217         $raddr = shift @raddr;
218
219         return _error($sock, $EINVAL, 'Cannot determine remote port')
220                 unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);
221
222         last
223             unless($type == SOCK_STREAM || defined $raddr);
224
225         return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
226             unless defined $raddr;
227
228 #        my $timeout = ${*$sock}{'io_socket_timeout'};
229 #        my $before = time() if $timeout;
230
231         undef $@;
232         if ($sock->connect(pack_sockaddr_in($rport, $raddr))) {
233 #            ${*$sock}{'io_socket_timeout'} = $timeout;
234             return $sock;
235         }
236
237         return _error($sock, $!, $@ || "Timeout")
238             unless @raddr;
239
240 #       if ($timeout) {
241 #           my $new_timeout = $timeout - (time() - $before);
242 #           return _error($sock,
243 #                         (exists(&Errno::ETIMEDOUT) ? Errno::ETIMEDOUT() : $EINVAL),
244 #                         "Timeout") if $new_timeout <= 0;
245 #           ${*$sock}{'io_socket_timeout'} = $new_timeout;
246 #        }
247
248     }
249
250     $sock;
251 }
252
253 sub 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
260 sub 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
267 sub 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
274 sub 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
281 sub sockhost {
282     @_ == 1 or croak 'usage: $sock->sockhost()';
283     my($sock) = @_;
284     my $addr = $sock->sockaddr;
285     $addr ? inet_ntoa($addr) : undef;
286 }
287
288 sub 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
295 sub 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
302 sub peerhost {
303     @_ == 1 or croak 'usage: $sock->peerhost()';
304     my($sock) = @_;
305     my $addr = $sock->peeraddr;
306     $addr ? inet_ntoa($addr) : undef;
307 }
308
309 1;
310
311 __END__
312
313 =head1 NAME
314
315 IO::Socket::INET - Object interface for AF_INET domain sockets
316
317 =head1 SYNOPSIS
318
319     use IO::Socket::INET;
320
321 =head1 DESCRIPTION
322
323 C<IO::Socket::INET> provides an object interface to creating and using sockets
324 in the AF_INET domain. It is built upon the L<IO::Socket> interface and
325 inherits all the methods defined by L<IO::Socket>.
326
327 =head1 CONSTRUCTOR
328
329 =over 4
330
331 =item new ( [ARGS] )
332
333 Creates an C<IO::Socket::INET> object, which is a reference to a
334 newly created symbol (see the C<Symbol> package). C<new>
335 optionally takes arguments, these arguments are in key-value pairs.
336
337 In addition to the key-value pairs accepted by L<IO::Socket>,
338 C<IO::Socket::INET> provides.
339
340
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
358
359 If C<Listen> is defined then a listen socket is created, else if the
360 socket type, which is derived from the protocol, is SOCK_STREAM then
361 connect() is called.  If the C<Listen> argument is given, but false,
362 the queue size will be set to 5.
363
364 Although it is not illegal, the use of C<MultiHomed> on a socket
365 which is in non-blocking mode is of little use. This is because the
366 first connect will never fail with a timeout as the connect call
367 will not block.
368
369 The 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
371 service name.  The service name might be followed by a number in
372 parenthesis which is used if the service is not known by the system.
373 The C<PeerPort> specification can also be embedded in the C<PeerAddr>
374 by preceding it with a ":".
375
376 If C<Proto> is not given and you specify a symbolic C<PeerPort> port,
377 then the constructor will try to derive C<Proto> from the service
378 name.  As a last resort C<Proto> "tcp" is assumed.  The C<Type>
379 parameter will be deduced from C<Proto> if not specified.
380
381 If the constructor is only passed a single argument, it is assumed to
382 be a C<PeerAddr> specification.
383
384 If C<Blocking> is set to 0, the connection will be in nonblocking mode.
385 If not specified it defaults to 1 (blocking mode).
386
387 Examples:
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
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";
409
410  NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
411
412 As of VERSION 1.18 all IO::Socket objects have autoflush turned on
413 by default. This was not the case with earlier releases.
414
415  NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
416
417 =back
418
419 =head2 METHODS
420
421 =over 4
422
423 =item sockaddr ()
424
425 Return the address part of the sockaddr structure for the socket
426
427 =item sockport ()
428
429 Return the port number that the socket is using on the local host
430
431 =item sockhost ()
432
433 Return the address part of the sockaddr structure for the socket in a
434 text form xx.xx.xx.xx
435
436 =item peeraddr ()
437
438 Return the address part of the sockaddr structure for the socket on
439 the peer host
440
441 =item peerport ()
442
443 Return the port number for the socket on the peer host.
444
445 =item peerhost ()
446
447 Return the address part of the sockaddr structure for the socket on the
448 peer host in a text form xx.xx.xx.xx
449
450 =back
451
452 =head1 SEE ALSO
453
454 L<Socket>, L<IO::Socket>
455
456 =head1 AUTHOR
457
458 Graham Barr. Currently maintained by the Perl Porters.  Please report all
459 bugs to <perlbug@perl.org>.
460
461 =head1 COPYRIGHT
462
463 Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
464 This program is free software; you can redistribute it and/or
465 modify it under the same terms as Perl itself.
466
467 =cut