[p5sagit/p5-mst-13.2.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;
use vars qw(@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;
	}

        $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

=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	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
854822f1	371	Graham Barr. Currently maintained by the Perl Porters. Please report all
854822f1	372	bugs to <perl5-porters@perl.org>.
cf7fe8a2	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