[perl5.git] / dist / IO / lib / IO / Socket / INET.pm

# IO::Socket::INET.pm
#
# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.

package IO::Socket::INET;

use strict;
our(@ISA, $VERSION);
use IO::Socket;
use Socket;
use Carp;
use Exporter;
use Errno;

@ISA = qw(IO::Socket);
$VERSION = "1.31";

my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1;

IO::Socket::INET->register_domain( AF_INET );

my %socket_type = ( tcp  => SOCK_STREAM,
		    udp  => SOCK_DGRAM,
		    icmp => SOCK_RAW
		  );
my %proto_number;
$proto_number{tcp}  = Socket::IPPROTO_TCP()  if defined &Socket::IPPROTO_TCP;
$proto_number{udp}  = Socket::IPPROTO_UDP()  if defined &Socket::IPPROTO_UDP;
$proto_number{icmp} = Socket::IPPROTO_ICMP() if defined &Socket::IPPROTO_ICMP;
my %proto_name = reverse %proto_number;

sub new {
    my $class = shift;
    unshift(@_, "PeerAddr") if @_ == 1;
    return $class->SUPER::new(@_);
}

sub _cache_proto {
    my @proto = @_;
    for (map lc($_), $proto[0], split(' ', $proto[1])) {
	$proto_number{$_} = $proto[2];
    }
    $proto_name{$proto[2]} = $proto[0];
}

sub _get_proto_number {
    my $name = lc(shift);
    return undef unless defined $name;
    return $proto_number{$name} if exists $proto_number{$name};

    my @proto = getprotobyname($name);
    return undef unless @proto;
    _cache_proto(@proto);

    return $proto[2];
}

sub _get_proto_name {
    my $num = shift;
    return undef unless defined $num;
    return $proto_name{$num} if exists $proto_name{$num};

    my @proto = getprotobynumber($num);
    return undef unless @proto;
    _cache_proto(@proto);

    return $proto[0];
}

sub _sock_info {
  my($addr,$port,$proto) = @_;
  my $origport = $port;
  my @serv = ();

  $port = $1
	if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);

  if(defined $proto  && $proto =~ /\D/) {
    my $num = _get_proto_number($proto);
    unless (defined $num) {
      $@ = "Bad protocol '$proto'";
      return;
    }
    $proto = $num;
  }

  if(defined $port) {
    my $defport = ($port =~ s,\((\d+)\)$,,) ? $1 : undef;
    my $pnum = ($port =~ m,^(\d+)$,)[0];

    @serv = getservbyname($port, _get_proto_name($proto) || "")
	if ($port =~ m,\D,);

    $port = $serv[2] || $defport || $pnum;
    unless (defined $port) {
	$@ = "Bad service '$origport'";
	return;
    }

    $proto = _get_proto_number($serv[3]) if @serv && !$proto;
  }

 return ($addr || undef,
	 $port || undef,
	 $proto || undef
	);
}

sub _error {
    my $sock = shift;
    my $err = shift;
    {
      local($!);
      my $title = ref($sock).": ";
      $@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_);
      $sock->close()
	if(defined fileno($sock));
    }
    $! = $err;
    return undef;
}

sub _get_addr {
    my($sock,$addr_str, $multi) = @_;
    my @addr;
    if ($multi && $addr_str !~ /^\d+(?:\.\d+){3}$/) {
	(undef, undef, undef, undef, @addr) = gethostbyname($addr_str);
    } else {
	my $h = inet_aton($addr_str);
	push(@addr, $h) if defined $h;
    }
    @addr;
}

sub configure {
    my($sock,$arg) = @_;
    my($lport,$rport,$laddr,$raddr,$proto,$type);


    $arg->{LocalAddr} = $arg->{LocalHost}
	if exists $arg->{LocalHost} && !exists $arg->{LocalAddr};

    ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
					$arg->{LocalPort},
					$arg->{Proto})
			or return _error($sock, $!, $@);

    $laddr = defined $laddr ? inet_aton($laddr)
			    : INADDR_ANY;

    return _error($sock, $EINVAL, "Bad hostname '",$arg->{LocalAddr},"'")
	unless(defined $laddr);

    $arg->{PeerAddr} = $arg->{PeerHost}
	if exists $arg->{PeerHost} && !exists $arg->{PeerAddr};

    unless(exists $arg->{Listen}) {
	($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
					    $arg->{PeerPort},
					    $proto)
			or return _error($sock, $!, $@);
    }

    $proto ||= _get_proto_number('tcp');

    $type = $arg->{Type} || $socket_type{lc _get_proto_name($proto)};

    my @raddr = ();

    if(defined $raddr) {
	@raddr = $sock->_get_addr($raddr, $arg->{MultiHomed});
	return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
	    unless @raddr;
    }

    while(1) {

	$sock->socket(AF_INET, $type, $proto) or
	    return _error($sock, $!, "$!");

        if (defined $arg->{Blocking}) {
	    defined $sock->blocking($arg->{Blocking})
		or return _error($sock, $!, "$!");
	}

	if ($arg->{Reuse} || $arg->{ReuseAddr}) {
	    $sock->sockopt(SO_REUSEADDR,1) or
		    return _error($sock, $!, "$!");
	}

	if ($arg->{ReusePort}) {
	    $sock->sockopt(SO_REUSEPORT,1) or
		    return _error($sock, $!, "$!");
	}

	if ($arg->{Broadcast}) {
		$sock->sockopt(SO_BROADCAST,1) or
		    return _error($sock, $!, "$!");
	}

	if($lport || ($laddr ne INADDR_ANY) || exists $arg->{Listen}) {
	    $sock->bind($lport || 0, $laddr) or
		    return _error($sock, $!, "$!");
	}

	if(exists $arg->{Listen}) {
	    $sock->listen($arg->{Listen} || 5) or
		return _error($sock, $!, "$!");
	    last;
	}

 	# don't try to connect unless we're given a PeerAddr
 	last unless exists($arg->{PeerAddr});
 
        $raddr = shift @raddr;

	return _error($sock, $EINVAL, 'Cannot determine remote port')
		unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);

	last
	    unless($type == SOCK_STREAM || defined $raddr);

	return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
	    unless defined $raddr;

#        my $timeout = ${*$sock}{'io_socket_timeout'};
#        my $before = time() if $timeout;

	undef $@;
        if ($sock->connect(pack_sockaddr_in($rport, $raddr))) {
#            ${*$sock}{'io_socket_timeout'} = $timeout;
            return $sock;
        }

	return _error($sock, $!, $@ || "Timeout")
	    unless @raddr;

#	if ($timeout) {
#	    my $new_timeout = $timeout - (time() - $before);
#	    return _error($sock,
#                         (exists(&Errno::ETIMEDOUT) ? Errno::ETIMEDOUT() : $EINVAL),
#                         "Timeout") if $new_timeout <= 0;
#	    ${*$sock}{'io_socket_timeout'} = $new_timeout;
#        }

    }

    $sock;
}

sub connect {
    @_ == 2 || @_ == 3 or
       croak 'usage: $sock->connect(NAME) or $sock->connect(PORT, ADDR)';
    my $sock = shift;
    return $sock->SUPER::connect(@_ == 1 ? shift : pack_sockaddr_in(@_));
}

sub bind {
    @_ == 2 || @_ == 3 or
       croak 'usage: $sock->bind(NAME) or $sock->bind(PORT, ADDR)';
    my $sock = shift;
    return $sock->SUPER::bind(@_ == 1 ? shift : pack_sockaddr_in(@_))
}

sub sockaddr {
    @_ == 1 or croak 'usage: $sock->sockaddr()';
    my($sock) = @_;
    my $name = $sock->sockname;
    $name ? (sockaddr_in($name))[1] : undef;
}

sub sockport {
    @_ == 1 or croak 'usage: $sock->sockport()';
    my($sock) = @_;
    my $name = $sock->sockname;
    $name ? (sockaddr_in($name))[0] : undef;
}

sub sockhost {
    @_ == 1 or croak 'usage: $sock->sockhost()';
    my($sock) = @_;
    my $addr = $sock->sockaddr;
    $addr ? inet_ntoa($addr) : undef;
}

sub peeraddr {
    @_ == 1 or croak 'usage: $sock->peeraddr()';
    my($sock) = @_;
    my $name = $sock->peername;
    $name ? (sockaddr_in($name))[1] : undef;
}

sub peerport {
    @_ == 1 or croak 'usage: $sock->peerport()';
    my($sock) = @_;
    my $name = $sock->peername;
    $name ? (sockaddr_in($name))[0] : undef;
}

sub peerhost {
    @_ == 1 or croak 'usage: $sock->peerhost()';
    my($sock) = @_;
    my $addr = $sock->peeraddr;
    $addr ? inet_ntoa($addr) : undef;
}

1;

__END__

=head1 NAME

IO::Socket::INET - Object interface for AF_INET domain sockets

=head1 SYNOPSIS

    use IO::Socket::INET;

=head1 DESCRIPTION

C<IO::Socket::INET> provides an object interface to creating and using sockets
in the AF_INET domain. It is built upon the L<IO::Socket> interface and
inherits all the methods defined by L<IO::Socket>.

=head1 CONSTRUCTOR

=over 4

=item new ( [ARGS] )

Creates an C<IO::Socket::INET> object, which is a reference to a
newly created symbol (see the C<Symbol> package). C<new>
optionally takes arguments, these arguments are in key-value pairs.

In addition to the key-value pairs accepted by L<IO::Socket>,
C<IO::Socket::INET> provides.


    PeerAddr	Remote host address          <hostname>[:<port>]
    PeerHost	Synonym for PeerAddr
    PeerPort	Remote port or service       <service>[(<no>)] | <no>
    LocalAddr	Local host bind	address      hostname[:port]
    LocalHost	Synonym for LocalAddr
    LocalPort	Local host bind	port         <service>[(<no>)] | <no>
    Proto	Protocol name (or number)    "tcp" | "udp" | ...
    Type	Socket type                  SOCK_STREAM | SOCK_DGRAM | ...
    Listen	Queue size for listen
    ReuseAddr	Set SO_REUSEADDR before binding
    Reuse	Set SO_REUSEADDR before binding (deprecated, prefer ReuseAddr)
    ReusePort	Set SO_REUSEPORT before binding
    Broadcast	Set SO_BROADCAST before binding
    Timeout	Timeout	value for various operations
    MultiHomed  Try all addresses for multi-homed hosts
    Blocking    Determine if connection will be blocking mode

If C<Listen> is defined then a listen socket is created, else if the
socket type, which is derived from the protocol, is SOCK_STREAM then
connect() is called.

Although it is not illegal, the use of C<MultiHomed> on a socket
which is in non-blocking mode is of little use. This is because the
first connect will never fail with a timeout as the connect call
will not block.

The C<PeerAddr> can be a hostname or the IP-address on the
"xx.xx.xx.xx" form.  The C<PeerPort> can be a number or a symbolic
service name.  The service name might be followed by a number in
parenthesis which is used if the service is not known by the system.
The C<PeerPort> specification can also be embedded in the C<PeerAddr>
by preceding it with a ":".

If C<Proto> is not given and you specify a symbolic C<PeerPort> port,
then the constructor will try to derive C<Proto> from the service
name.  As a last resort C<Proto> "tcp" is assumed.  The C<Type>
parameter will be deduced from C<Proto> if not specified.

If the constructor is only passed a single argument, it is assumed to
be a C<PeerAddr> specification.

If C<Blocking> is set to 0, the connection will be in nonblocking mode.
If not specified it defaults to 1 (blocking mode).

Examples:

   $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org',
                                 PeerPort => 'http(80)',
                                 Proto    => 'tcp');

   $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)');

   $sock = IO::Socket::INET->new(Listen    => 5,
                                 LocalAddr => 'localhost',
                                 LocalPort => 9000,
                                 Proto     => 'tcp');

   $sock = IO::Socket::INET->new('127.0.0.1:25');

   $sock = IO::Socket::INET->new(PeerPort  => 9999,
                                 PeerAddr  => inet_ntoa(INADDR_BROADCAST),
                                 Proto     => udp,    
                                 LocalAddr => 'localhost',
                                 Broadcast => 1 ) 
                             or die "Can't bind : $@\n";

 NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE

As of VERSION 1.18 all IO::Socket objects have autoflush turned on
by default. This was not the case with earlier releases.

 NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE

=back

=head2 METHODS

=over 4

=item sockaddr ()

Return the address part of the sockaddr structure for the socket

=item sockport ()

Return the port number that the socket is using on the local host

=item sockhost ()

Return the address part of the sockaddr structure for the socket in a
text form xx.xx.xx.xx

=item peeraddr ()

Return the address part of the sockaddr structure for the socket on
the peer host

=item peerport ()

Return the port number for the socket on the peer host.

=item peerhost ()

Return the address part of the sockaddr structure for the socket on the
peer host in a text form xx.xx.xx.xx

=back

=head1 SEE ALSO

L<Socket>, L<IO::Socket>

=head1 AUTHOR

Graham Barr. Currently maintained by the Perl Porters.  Please report all
bugs to <perl5-porters@perl.org>.

=head1 COPYRIGHT

Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
This program is free software; you can redistribute it and/or
modify it under the same terms as Perl itself.

=cut
Commit	Line	Data
cf7fe8a2 GS	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;
17f410f9	10	our(@ISA, $VERSION);
cf7fe8a2	11	use IO::Socket;
90b9a713	12	use Socket;
cf7fe8a2 GS	13	use Carp;
cf7fe8a2 GS	14	use Exporter;
e541f5e7	15	use Errno;
cf7fe8a2 GS	16
cf7fe8a2 GS	17	@ISA = qw(IO::Socket);
90b9a713	18	$VERSION = "1.31";
cf7fe8a2	19
e541f5e7 GS	20	my $EINVAL = exists(&Errno::EINVAL) ? Errno::EINVAL() : 1;
e541f5e7 GS	21
cf7fe8a2 GS	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	);
ebcd0cc0 GA	28	my %proto_number;
ebcd0cc0 GA	29	$proto_number{tcp} = Socket::IPPROTO_TCP() if defined &Socket::IPPROTO_TCP;
7027b9a3	30	$proto_number{udp} = Socket::IPPROTO_UDP() if defined &Socket::IPPROTO_UDP;
ebcd0cc0 GA	31	$proto_number{icmp} = Socket::IPPROTO_ICMP() if defined &Socket::IPPROTO_ICMP;
ebcd0cc0 GA	32	my %proto_name = reverse %proto_number;
cf7fe8a2 GS	33
	34	sub new {
	35	my $class = shift;
	36	unshift(@_, "PeerAddr") if @_ == 1;
	37	return $class->SUPER::new(@_);
	38	}
	39
ebcd0cc0 GA	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
cf7fe8a2 GS	72	sub _sock_info {
cf7fe8a2 GS	73	my($addr,$port,$proto) = @_;
83fe8690	74	my $origport = $port;
cf7fe8a2 GS	75	my @serv = ();
	76
	77	$port = $1
	78	if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
	79
7822251e	80	if(defined $proto && $proto =~ /\D/) {
ebcd0cc0 GA	81	my $num = _get_proto_number($proto);
ebcd0cc0 GA	82	unless (defined $num) {
c9fcc6c4 GS	83	$@ = "Bad protocol '$proto'";
	84	return;
	85	}
ebcd0cc0	86	$proto = $num;
cf7fe8a2 GS	87	}
	88
	89	if(defined $port) {
293f53d8	90	my $defport = ($port =~ s,\((\d+)\)$,,) ? $1 : undef;
cf7fe8a2 GS	91	my $pnum = ($port =~ m,^(\d+)$,)[0];
cf7fe8a2 GS	92
ebcd0cc0	93	@serv = getservbyname($port, _get_proto_name($proto) \|\| "")
83fe8690	94	if ($port =~ m,\D,);
cf7fe8a2	95
a957f605	96	$port = $serv[2] \|\| $defport \|\| $pnum;
83fe8690 GS	97	unless (defined $port) {
	98	$@ = "Bad service '$origport'";
	99	return;
	100	}
cf7fe8a2	101
ebcd0cc0	102	$proto = _get_proto_number($serv[3]) if @serv && !$proto;
cf7fe8a2 GS	103	}
	104
	105	return ($addr \|\| undef,
	106	$port \|\| undef,
	107	$proto \|\| undef
	108	);
	109	}
	110
	111	sub _error {
	112	my $sock = shift;
c9fcc6c4 GS	113	my $err = shift;
	114	{
	115	local($!);
6f36ad4a	116	my $title = ref($sock).": ";
6f36ad4a	117	$@ = join("", $_[0] =~ /^$title/ ? "" : $title, @_);
2d169392	118	$sock->close()
cf7fe8a2	119	if(defined fileno($sock));
c9fcc6c4 GS	120	}
c9fcc6c4 GS	121	$! = $err;
cf7fe8a2 GS	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},
c9fcc6c4 GS	147	$arg->{Proto})
c9fcc6c4 GS	148	or return _error($sock, $!, $@);
cf7fe8a2 GS	149
	150	$laddr = defined $laddr ? inet_aton($laddr)
	151	: INADDR_ANY;
	152
e541f5e7	153	return _error($sock, $EINVAL, "Bad hostname '",$arg->{LocalAddr},"'")
cf7fe8a2 GS	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},
c9fcc6c4 GS	162	$proto)
c9fcc6c4 GS	163	or return _error($sock, $!, $@);
cf7fe8a2 GS	164	}
cf7fe8a2 GS	165
ebcd0cc0	166	$proto \|\|= _get_proto_number('tcp');
cf7fe8a2	167
ebcd0cc0	168	$type = $arg->{Type} \|\| $socket_type{lc _get_proto_name($proto)};
cf7fe8a2 GS	169
	170	my @raddr = ();
	171
	172	if(defined $raddr) {
	173	@raddr = $sock->_get_addr($raddr, $arg->{MultiHomed});
e541f5e7	174	return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
cf7fe8a2 GS	175	unless @raddr;
	176	}
	177
	178	while(1) {
	179
	180	$sock->socket(AF_INET, $type, $proto) or
c9fcc6c4	181	return _error($sock, $!, "$!");
cf7fe8a2	182
3c83a670 DM	183	if (defined $arg->{Blocking}) {
	184	defined $sock->blocking($arg->{Blocking})
	185	or return _error($sock, $!, "$!");
	186	}
	187
121c220b	188	if ($arg->{Reuse} \|\| $arg->{ReuseAddr}) {
cf7fe8a2	189	$sock->sockopt(SO_REUSEADDR,1) or
c9fcc6c4	190	return _error($sock, $!, "$!");
cf7fe8a2 GS	191	}
cf7fe8a2 GS	192
8b9593b7 JZ	193	if ($arg->{ReusePort}) {
	194	$sock->sockopt(SO_REUSEPORT,1) or
	195	return _error($sock, $!, "$!");
	196	}
	197
3e3f5e61 MB	198	if ($arg->{Broadcast}) {
	199	$sock->sockopt(SO_BROADCAST,1) or
	200	return _error($sock, $!, "$!");
	201	}
	202
cf7fe8a2 GS	203	if($lport \|\| ($laddr ne INADDR_ANY) \|\| exists $arg->{Listen}) {
cf7fe8a2 GS	204	$sock->bind($lport \|\| 0, $laddr) or
c9fcc6c4	205	return _error($sock, $!, "$!");
cf7fe8a2 GS	206	}
	207
	208	if(exists $arg->{Listen}) {
	209	$sock->listen($arg->{Listen} \|\| 5) or
c9fcc6c4	210	return _error($sock, $!, "$!");
cf7fe8a2 GS	211	last;
	212	}
	213
23925046 JH	214	# don't try to connect unless we're given a PeerAddr
	215	last unless exists($arg->{PeerAddr});
	216
cf7fe8a2 GS	217	$raddr = shift @raddr;
cf7fe8a2 GS	218
e541f5e7	219	return _error($sock, $EINVAL, 'Cannot determine remote port')
cf7fe8a2 GS	220	unless($rport \|\| $type == SOCK_DGRAM \|\| $type == SOCK_RAW);
	221
	222	last
	223	unless($type == SOCK_STREAM \|\| defined $raddr);
	224
e541f5e7	225	return _error($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr},"'")
cf7fe8a2 GS	226	unless defined $raddr;
	227
	228	# my $timeout = ${*$sock}{'io_socket_timeout'};
	229	# my $before = time() if $timeout;
	230
6f36ad4a	231	undef $@;
cf7fe8a2 GS	232	if ($sock->connect(pack_sockaddr_in($rport, $raddr))) {
	233	# ${*$sock}{'io_socket_timeout'} = $timeout;
	234	return $sock;
	235	}
	236
6f36ad4a	237	return _error($sock, $!, $@ \|\| "Timeout")
cf7fe8a2 GS	238	unless @raddr;
	239
	240	# if ($timeout) {
	241	# my $new_timeout = $timeout - (time() - $before);
c9fcc6c4	242	# return _error($sock,
e541f5e7	243	# (exists(&Errno::ETIMEDOUT) ? Errno::ETIMEDOUT() : $EINVAL),
c9fcc6c4	244	# "Timeout") if $new_timeout <= 0;
cf7fe8a2 GS	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
121c220b JH	350	ReuseAddr Set SO_REUSEADDR before binding
121c220b JH	351	Reuse Set SO_REUSEADDR before binding (deprecated, prefer ReuseAddr)
8b9593b7	352	ReusePort Set SO_REUSEPORT before binding
3e3f5e61	353	Broadcast Set SO_BROADCAST before binding
cf7fe8a2	354	Timeout Timeout value for various operations
3c4b39be	355	MultiHomed Try all addresses for multi-homed hosts
ae1c8c83	356	Blocking Determine if connection will be blocking mode
cf7fe8a2 GS	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
0a719618	364	first connect will never fail with a timeout as the connect call
cf7fe8a2 GS	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
ae1c8c83 RD	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
cf7fe8a2 GS	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
3e3f5e61 MB	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";
cf7fe8a2 GS	406
cf7fe8a2 GS	407	NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
3cb6de81	408
cf7fe8a2 GS	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
a45bd81d GS	414	=back
a45bd81d GS	415
cf7fe8a2 GS	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
854822f1 GS	455	Graham Barr. Currently maintained by the Perl Porters. Please report all
854822f1 GS	456	bugs to <perl5-porters@perl.org>.
cf7fe8a2 GS	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