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.
15 our(@ISA, $VERSION, @EXPORT_OK);
21 require IO::Socket::INET;
22 require IO::Socket::UNIX if ($^O ne 'epoc');
24 @ISA = qw(IO::Handle);
28 @EXPORT_OK = qw(sockatmark);
32 if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast
33 Exporter::export_to_level('IO::Socket', 1, $pkg, 'sockatmark');
36 Exporter::export 'Socket', $callpkg, @_;
42 my $sock = $class->SUPER::new();
46 ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
48 return scalar(%arg) ? $sock->configure(\%arg)
61 my $domain = delete $arg->{Domain};
63 croak 'IO::Socket: Cannot configure a generic socket'
64 unless defined $domain;
66 croak "IO::Socket: Unsupported socket domain"
67 unless defined $domain2pkg[$domain];
69 croak "IO::Socket: Cannot configure socket in domain '$domain'"
70 unless ref($sock) eq "IO::Socket";
72 bless($sock, $domain2pkg[$domain]);
73 $sock->configure($arg);
77 @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
78 my($sock,$domain,$type,$protocol) = @_;
80 socket($sock,$domain,$type,$protocol) or
83 ${*$sock}{'io_socket_domain'} = $domain;
84 ${*$sock}{'io_socket_type'} = $type;
85 ${*$sock}{'io_socket_proto'} = $protocol;
91 @_ == 4 || croak 'usage: IO::Socket->socketpair(DOMAIN, TYPE, PROTOCOL)';
92 my($class,$domain,$type,$protocol) = @_;
93 my $sock1 = $class->new();
94 my $sock2 = $class->new();
96 socketpair($sock1,$sock2,$domain,$type,$protocol) or
99 ${*$sock1}{'io_socket_type'} = ${*$sock2}{'io_socket_type'} = $type;
100 ${*$sock1}{'io_socket_proto'} = ${*$sock2}{'io_socket_proto'} = $protocol;
106 @_ == 2 or croak 'usage: $sock->connect(NAME)';
109 my $timeout = ${*$sock}{'io_socket_timeout'};
113 $blocking = $sock->blocking(0) if $timeout;
114 if (!connect($sock, $addr)) {
115 if (defined $timeout && $!{EINPROGRESS}) {
118 my $sel = new IO::Select $sock;
120 if (!$sel->can_write($timeout)) {
121 $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
122 $@ = "connect: timeout";
124 elsif (!connect($sock,$addr) && not $!{EISCONN}) {
125 # Some systems refuse to re-connect() to
126 # an already open socket and set errno to EISCONN.
131 elsif ($blocking || !$!{EINPROGRESS}) {
137 $sock->blocking(1) if $blocking;
141 $err ? undef : $sock;
145 @_ == 2 or croak 'usage: $sock->bind(NAME)';
149 return bind($sock, $addr) ? $sock
154 @_ >= 1 && @_ <= 2 or croak 'usage: $sock->listen([QUEUE])';
155 my($sock,$queue) = @_;
157 unless $queue && $queue > 0;
159 return listen($sock, $queue) ? $sock
164 @_ == 1 || @_ == 2 or croak 'usage $sock->accept([PKG])';
166 my $pkg = shift || $sock;
167 my $timeout = ${*$sock}{'io_socket_timeout'};
168 my $new = $pkg->new(Timeout => $timeout);
171 if(defined $timeout) {
174 my $sel = new IO::Select $sock;
176 unless ($sel->can_read($timeout)) {
177 $@ = 'accept: timeout';
178 $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
183 $peer = accept($new,$sock)
186 return wantarray ? ($new, $peer)
191 @_ == 1 or croak 'usage: $sock->sockname()';
196 @_ == 1 or croak 'usage: $sock->peername()';
199 || ${*$sock}{'io_socket_peername'}
204 @_ == 1 or croak 'usage: $sock->connected()';
210 @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
212 my $flags = $_[2] || 0;
213 my $peer = $_[3] || $sock->peername;
215 croak 'send: Cannot determine peer address'
218 my $r = defined(getpeername($sock))
219 ? send($sock, $_[1], $flags)
220 : send($sock, $_[1], $flags, $peer);
222 # remember who we send to, if it was sucessful
223 ${*$sock}{'io_socket_peername'} = $peer
224 if(@_ == 4 && defined $r);
230 @_ == 3 || @_ == 4 or croak 'usage: $sock->recv(BUF, LEN [, FLAGS])';
233 my $flags = $_[3] || 0;
235 # remember who we recv'd from
236 ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
240 @_ == 2 or croak 'usage: $sock->shutdown(HOW)';
241 my($sock, $how) = @_;
242 shutdown($sock, $how);
246 @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME)';
247 setsockopt($_[0],$_[1],$_[2],$_[3]);
250 my $intsize = length(pack("i",0));
253 @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)';
254 my $r = getsockopt($_[0],$_[1],$_[2]);
257 if(defined $r && length($r) == $intsize);
263 @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_)
264 : $sock->setsockopt(SOL_SOCKET,@_);
268 @_ == 1 or croak 'usage: $sock->atmark()';
274 @_ == 1 || @_ == 2 or croak 'usage: $sock->timeout([VALUE])';
276 my $r = ${*$sock}{'io_socket_timeout'} || undef;
278 ${*$sock}{'io_socket_timeout'} = 0 + $val
285 @_ == 1 or croak 'usage: $sock->sockdomain()';
287 ${*$sock}{'io_socket_domain'};
291 @_ == 1 or croak 'usage: $sock->socktype()';
293 ${*$sock}{'io_socket_type'}
297 @_ == 1 or croak 'usage: $sock->protocol()';
299 ${*$sock}{'io_socket_proto'};
308 IO::Socket - Object interface to socket communications
316 C<IO::Socket> provides an object interface to creating and using sockets. It
317 is built upon the L<IO::Handle> interface and inherits all the methods defined
320 C<IO::Socket> only defines methods for those operations which are common to all
321 types of socket. Operations which are specified to a socket in a particular
322 domain have methods defined in sub classes of C<IO::Socket>
324 C<IO::Socket> will export all functions (and constants) defined by L<Socket>.
332 Creates an C<IO::Socket>, which is a reference to a
333 newly created symbol (see the C<Symbol> package). C<new>
334 optionally takes arguments, these arguments are in key-value pairs.
335 C<new> only looks for one key C<Domain> which tells new which domain
336 the socket will be in. All other arguments will be passed to the
337 configuration method of the package for that domain, See below.
339 NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
341 As of VERSION 1.18 all IO::Socket objects have autoflush turned on
342 by default. This was not the case with earlier releases.
344 NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
350 See L<perlfunc> for complete descriptions of each of the following
351 supported C<IO::Socket> methods, which are just front ends for the
352 corresponding built-in functions:
361 peername (getpeername)
362 sockname (getsockname)
365 Some methods take slightly different arguments to those defined in L<perlfunc>
366 in attempt to make the interface more flexible. These are
372 perform the system call C<accept> on the socket and return a new
373 object. The new object will be created in the same class as the listen
374 socket, unless C<PKG> is specified. This object can be used to
375 communicate with the client that was trying to connect.
377 In a scalar context the new socket is returned, or undef upon
378 failure. In a list context a two-element array is returned containing
379 the new socket and the peer address; the list will be empty upon
382 The timeout in the [PKG] can be specified as zero to effect a "poll",
383 but you shouldn't do that because a new IO::Select object will be
384 created behind the scenes just do to the single poll. This is
385 horrendously inefficient. Use rather true select() with a zero
386 timeout on the handle, or non-blocking IO.
388 =item socketpair(DOMAIN, TYPE, PROTOCOL)
390 Call C<socketpair> and return a list of two sockets created, or an
391 empty list on failure.
395 Additional methods that are provided are:
401 True if the socket is currently positioned at the urgent data mark,
406 my $sock = IO::Socket::INET->new('some_server');
407 $sock->read(1024,$data) until $sock->atmark;
409 Note: this is a reasonably new addition to the family of socket
410 functions, so all systems may not support this yet. If it is
411 unsupported by the system, an attempt to use this method will
414 The atmark() functionality is also exportable as sockatmark() function:
416 use IO::Socket 'sockatmark';
418 This allows for a more traditional use of sockatmark() as a procedural
423 If the socket is in a connected state the the peer address is returned.
424 If the socket is not in a connected state then undef will be returned.
428 Returns the numerical number for the protocol being used on the socket, if
429 known. If the protocol is unknown, as with an AF_UNIX socket, zero
434 Returns the numerical number for the socket domain type. For example, for
435 an AF_INET socket the value of &AF_INET will be returned.
437 =item sockopt(OPT [, VAL])
439 Unified method to both set and get options in the SOL_SOCKET level. If called
440 with one argument then getsockopt is called, otherwise setsockopt is called.
444 Returns the numerical number for the socket type. For example, for
445 a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
449 Set or get the timeout value associated with this socket. If called without
450 any arguments then the current setting is returned. If called with an argument
451 the current setting is changed and the previous value returned.
457 L<Socket>, L<IO::Handle>, L<IO::Socket::INET>, L<IO::Socket::UNIX>
461 Graham Barr. atmark() by Lincoln Stein. Currently maintained by the
462 Perl Porters. Please report all bugs to <perl5-porters@perl.org>.
466 Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
467 This program is free software; you can redistribute it and/or
468 modify it under the same terms as Perl itself.
470 The atmark() implementation: Copyright 2001, Lincoln Stein <lstein@cshl.org>.
471 This module is distributed under the same terms as Perl itself.
472 Feel free to use, modify and redistribute it as long as you retain
473 the correct attribution.