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