[ Index ]

PHP Cross Reference of Unnamed Project

title

Body

[close]

/se3-unattended/var/se3/unattended/install/linuxaux/opt/perl/lib/5.10.0/i586-linux-thread-multi/IO/Socket/ -> INET.pm (source)

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


Generated: Tue Mar 17 22:47:18 2015 Cross-referenced by PHPXref 0.7.1