[perl5.git] / ext / 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;

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

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

my %socket_type = ( tcp  => SOCK_STREAM,
		    udp  => SOCK_DGRAM,
		    icmp => SOCK_RAW
		  );

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

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

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

  if(defined $proto) {
    @proto = $proto =~ m,\D, ? getprotobyname($proto)
			     : getprotobynumber($proto);

    $proto = $proto[2] || undef;
  }

  if(defined $port) {
    $port =~ s,\((\d+)\)$,,;

    my $defport = $1 || undef;
    my $pnum = ($port =~ m,^(\d+)$,)[0];

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

    $port = $pnum || $serv[2] || $defport || undef;

    $proto = (getprotobyname($serv[3]))[2] || undef
	if @serv && !$proto;
  }

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

sub _error {
    my $sock = shift;
    local($!);
    $@ = join("",ref($sock),": ",@_);
    close($sock)
	if(defined fileno($sock));
    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});

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

    return _error($sock,"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);
    }

    $proto ||= (getprotobyname('tcp'))[2];

    my $pname = (getprotobynumber($proto))[0];
    $type = $arg->{Type} || $socket_type{$pname};

    my @raddr = ();

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

    while(1) {

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

	if ($arg->{Reuse}) {
	    $sock->sockopt(SO_REUSEADDR,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,'Cannot determine remote port')
		unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);

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

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

#        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 $sock;
        }

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

#	if ($timeout) {
#	    my $new_timeout = $timeout - (time() - $before);
#	    return _error($sock, "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
    Reuse	Set SO_REUSEADDR before binding
    Timeout	Timeout	value for various operations
    MultiHomed  Try all adresses for multi-homed hosts


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 connaect 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.

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');


 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 GS	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
23925046 JH	150	# don't try to connect unless we're given a PeerAddr
	151	last unless exists($arg->{PeerAddr});
	152
cf7fe8a2 GS	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
a45bd81d GS	335	=back
a45bd81d GS	336
cf7fe8a2 GS	337	=head2 METHODS
	338
	339	=over 4
	340
	341	=item sockaddr ()
	342
	343	Return the address part of the sockaddr structure for the socket
	344
	345	=item sockport ()
	346
	347	Return the port number that the socket is using on the local host
	348
	349	=item sockhost ()
	350
	351	Return the address part of the sockaddr structure for the socket in a
	352	text form xx.xx.xx.xx
	353
	354	=item peeraddr ()
	355
	356	Return the address part of the sockaddr structure for the socket on
	357	the peer host
	358
	359	=item peerport ()
	360
	361	Return the port number for the socket on the peer host.
	362
	363	=item peerhost ()
	364
	365	Return the address part of the sockaddr structure for the socket on the
	366	peer host in a text form xx.xx.xx.xx
	367
	368	=back
	369
	370	=head1 SEE ALSO
	371
	372	L<Socket>, L<IO::Socket>
	373
	374	=head1 AUTHOR
	375
854822f1 GS	376	Graham Barr. Currently maintained by the Perl Porters. Please report all
854822f1 GS	377	bugs to <perl5-porters@perl.org>.
cf7fe8a2 GS	378
	379	=head1 COPYRIGHT
	380
	381	Copyright (c) 1996-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
	382	This program is free software; you can redistribute it and/or
	383	modify it under the same terms as Perl itself.
	384
	385	=cut