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