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