# 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
;
my $EINVAL = exists(&Errno
::EINVAL
) ? Errno
::EINVAL
() : 1;
IO
::Socket
::INET
->register_domain( AF_INET
);
my %socket_type = ( tcp
=> SOCK_STREAM
,
unshift(@_, "PeerAddr") if @_ == 1;
return $class->SUPER::new
(@_);
my($addr,$port,$proto) = @_;
if(defined $addr && $addr =~ s
,:([\w\
(\
)/]+)$,,);
if(defined $proto && $proto =~ /\D/) {
if(@proto = getprotobyname($proto)) {
$proto = $proto[2] || undef;
$@
= "Bad protocol '$proto'";
my $defport = ($port =~ s
,\
((\d
+)\
)$,,) ?
$1 : undef;
my $pnum = ($port =~ m
,^(\d
+)$,)[0];
@serv = getservbyname($port, $proto[0] || "")
$port = $serv[2] || $defport || $pnum;
$@
= "Bad service '$origport'";
$proto = (getprotobyname($serv[3]))[2] || undef
my $title = ref($sock).": ";
$@
= join("", $_[0] =~ /^$title/ ?
"" : $title, @_);
if(defined fileno($sock));
my($sock,$addr_str, $multi) = @_;
if ($multi && $addr_str !~ /^\d+(?:\.\d+){3}$/) {
(undef, undef, undef, undef, @addr) = gethostbyname($addr_str);
my $h = inet_aton
($addr_str);
push(@addr, $h) if defined $h;
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
},
or return _error
($sock, $!, $@
);
$laddr = defined $laddr ? inet_aton
($laddr)
return _error
($sock, $EINVAL, "Bad hostname '",$arg->{LocalAddr
},"'")
$arg->{PeerAddr
} = $arg->{PeerHost
}
if exists $arg->{PeerHost
} && !exists $arg->{PeerAddr
};
unless(exists $arg->{Listen
}) {
($raddr,$rport,$proto) = _sock_info
($arg->{PeerAddr
},
or return _error
($sock, $!, $@
);
$sock->blocking($arg->{Blocking
}) if defined $arg->{Blocking
};
$proto ||= (getprotobyname('tcp'))[2];
my $pname = (getprotobynumber($proto))[0];
$type = $arg->{Type
} || $socket_type{$pname};
@raddr = $sock->_get_addr($raddr, $arg->{MultiHomed
});
return _error
($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr
},"'")
$sock->socket(AF_INET
, $type, $proto) or
return _error
($sock, $!, "$!");
if ($arg->{Reuse
} || $arg->{ReuseAddr
}) {
$sock->sockopt(SO_REUSEADDR
,1) or
return _error
($sock, $!, "$!");
$sock->sockopt(SO_REUSEPORT
,1) or
return _error
($sock, $!, "$!");
$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, $!, "$!");
# don't try to connect unless we're given a PeerAddr
last unless exists($arg->{PeerAddr
});
return _error
($sock, $EINVAL, 'Cannot determine remote port')
unless($rport || $type == SOCK_DGRAM
|| $type == SOCK_RAW
);
unless($type == SOCK_STREAM
|| defined $raddr);
return _error
($sock, $EINVAL, "Bad hostname '",$arg->{PeerAddr
},"'")
# my $timeout = ${*$sock}{'io_socket_timeout'};
# my $before = time() if $timeout;
if ($sock->connect(pack_sockaddr_in
($rport, $raddr))) {
# ${*$sock}{'io_socket_timeout'} = $timeout;
return _error
($sock, $!, $@
|| "Timeout")
# my $new_timeout = $timeout - (time() - $before);
# (exists(&Errno::ETIMEDOUT) ? Errno::ETIMEDOUT() : $EINVAL),
# "Timeout") if $new_timeout <= 0;
# ${*$sock}{'io_socket_timeout'} = $new_timeout;
croak
'usage: $sock->connect(NAME) or $sock->connect(PORT, ADDR)';
return $sock->SUPER::connect(@_ == 1 ?
shift : pack_sockaddr_in
(@_));
croak
'usage: $sock->bind(NAME) or $sock->bind(PORT, ADDR)';
return $sock->SUPER::bind(@_ == 1 ?
shift : pack_sockaddr_in
(@_))
@_ == 1 or croak
'usage: $sock->sockaddr()';
my $name = $sock->sockname;
$name ?
(sockaddr_in
($name))[1] : undef;
@_ == 1 or croak
'usage: $sock->sockport()';
my $name = $sock->sockname;
$name ?
(sockaddr_in
($name))[0] : undef;
@_ == 1 or croak
'usage: $sock->sockhost()';
my $addr = $sock->sockaddr;
$addr ? inet_ntoa
($addr) : undef;
@_ == 1 or croak
'usage: $sock->peeraddr()';
my $name = $sock->peername;
$name ?
(sockaddr_in
($name))[1] : undef;
@_ == 1 or croak
'usage: $sock->peerport()';
my $name = $sock->peername;
$name ?
(sockaddr_in
($name))[0] : undef;
@_ == 1 or croak
'usage: $sock->peerhost()';
my $addr = $sock->peeraddr;
$addr ? inet_ntoa
($addr) : undef;
IO::Socket::INET - Object interface for AF_INET domain sockets
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>.
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 adresses 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
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
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).
$sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org',
$sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)');
$sock = IO::Socket::INET->new(Listen => 5,
LocalAddr => 'localhost',
$sock = IO::Socket::INET->new('127.0.0.1:25');
$sock = IO::Socket::INET->new(PeerPort => 9999,
PeerAddr => inet_ntoa(INADDR_BROADCAST),
LocalAddr => 'localhost',
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
Return the address part of the sockaddr structure for the socket
Return the port number that the socket is using on the local host
Return the address part of the sockaddr structure for the socket in a
Return the address part of the sockaddr structure for the socket on
Return the port number for the socket on the peer host.
Return the address part of the sockaddr structure for the socket on the
peer host in a text form xx.xx.xx.xx
Graham Barr. Currently maintained by the Perl Porters. Please report all
bugs to <perl5-porters@perl.org>.
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.