PageRenderTime 46ms CodeModel.GetById 14ms app.highlight 27ms RepoModel.GetById 1ms app.codeStats 0ms

/IronPython_Main/Runtime/Tests/LinqDlrTests/testenv/perl/lib/io/socket/inet.pm

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