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