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