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