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