This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
mention portability caveat about C<use Errno 'EFOO'>
[perl5.git] / ext / IO / lib / IO / Socket.pm
CommitLineData
774d564b 1# IO::Socket.pm
8add82fc 2#
cf7fe8a2
GS
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
774d564b 5# modify it under the same terms as Perl itself.
8add82fc
PP
6
7package IO::Socket;
8
17f410f9 9require 5.005_64;
8add82fc 10
8add82fc
PP
11use IO::Handle;
12use Socket 1.3;
13use Carp;
14use strict;
17f410f9 15our(@ISA, $VERSION);
8add82fc
PP
16use Exporter;
17
cf7fe8a2
GS
18# legacy
19
20require IO::Socket::INET;
3a2f06e9 21require IO::Socket::UNIX if ($^O ne 'epoc');
cf7fe8a2 22
8add82fc
PP
23@ISA = qw(IO::Handle);
24
c4be5b27 25$VERSION = "1.252";
8add82fc
PP
26
27sub import {
28 my $pkg = shift;
29 my $callpkg = caller;
30 Exporter::export 'Socket', $callpkg, @_;
31}
32
33sub new {
34 my($class,%arg) = @_;
cf7fe8a2
GS
35 my $sock = $class->SUPER::new();
36
37 $sock->autoflush(1);
8add82fc 38
cf7fe8a2 39 ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
8add82fc 40
cf7fe8a2
GS
41 return scalar(%arg) ? $sock->configure(\%arg)
42 : $sock;
8add82fc
PP
43}
44
cf7fe8a2 45my @domain2pkg;
27d4819a
JM
46
47sub register_domain {
48 my($p,$d) = @_;
774d564b 49 $domain2pkg[$d] = $p;
27d4819a
JM
50}
51
8add82fc 52sub configure {
cf7fe8a2 53 my($sock,$arg) = @_;
27d4819a
JM
54 my $domain = delete $arg->{Domain};
55
56 croak 'IO::Socket: Cannot configure a generic socket'
57 unless defined $domain;
58
774d564b
PP
59 croak "IO::Socket: Unsupported socket domain"
60 unless defined $domain2pkg[$domain];
27d4819a 61
7a4c00b4 62 croak "IO::Socket: Cannot configure socket in domain '$domain'"
cf7fe8a2 63 unless ref($sock) eq "IO::Socket";
27d4819a 64
cf7fe8a2
GS
65 bless($sock, $domain2pkg[$domain]);
66 $sock->configure($arg);
8add82fc
PP
67}
68
69sub socket {
cf7fe8a2
GS
70 @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
71 my($sock,$domain,$type,$protocol) = @_;
8add82fc 72
cf7fe8a2 73 socket($sock,$domain,$type,$protocol) or
8add82fc
PP
74 return undef;
75
cf7fe8a2
GS
76 ${*$sock}{'io_socket_domain'} = $domain;
77 ${*$sock}{'io_socket_type'} = $type;
78 ${*$sock}{'io_socket_proto'} = $protocol;
774d564b 79
cf7fe8a2 80 $sock;
8add82fc
PP
81}
82
83sub socketpair {
c4be5b27 84 @_ == 4 || croak 'usage: IO::Socket->socketpair(DOMAIN, TYPE, PROTOCOL)';
8add82fc 85 my($class,$domain,$type,$protocol) = @_;
cf7fe8a2
GS
86 my $sock1 = $class->new();
87 my $sock2 = $class->new();
8add82fc 88
cf7fe8a2 89 socketpair($sock1,$sock2,$domain,$type,$protocol) or
8add82fc
PP
90 return ();
91
cf7fe8a2
GS
92 ${*$sock1}{'io_socket_type'} = ${*$sock2}{'io_socket_type'} = $type;
93 ${*$sock1}{'io_socket_proto'} = ${*$sock2}{'io_socket_proto'} = $protocol;
8add82fc 94
cf7fe8a2 95 ($sock1,$sock2);
8add82fc
PP
96}
97
98sub connect {
cf7fe8a2
GS
99 @_ == 2 or croak 'usage: $sock->connect(NAME)';
100 my $sock = shift;
101 my $addr = shift;
102 my $timeout = ${*$sock}{'io_socket_timeout'};
103
00fdd80d
BL
104 my $blocking;
105 $blocking = $sock->blocking(0) if $timeout;
cf7fe8a2 106
00fdd80d 107 eval {
8add82fc
PP
108 croak 'connect: Bad address'
109 if(@_ == 2 && !defined $_[1]);
110
cf7fe8a2
GS
111 unless(connect($sock, $addr)) {
112 if($timeout && ($! == &IO::EINPROGRESS)) {
113 require IO::Select;
8add82fc 114
cf7fe8a2 115 my $sel = new IO::Select $sock;
8add82fc 116
cf7fe8a2 117 unless($sel->can_write($timeout) && defined($sock->peername)) {
cf7fe8a2
GS
118 croak "connect: timeout";
119 }
120 }
121 else {
cf7fe8a2
GS
122 croak "connect: $!";
123 }
124 }
8add82fc 125 };
760ac839 126
00fdd80d
BL
127 my $ret = $@ ? undef : $sock;
128
129 $sock->blocking($blocking) if $timeout;
130
131 $ret;
8add82fc
PP
132}
133
134sub bind {
cf7fe8a2
GS
135 @_ == 2 or croak 'usage: $sock->bind(NAME)';
136 my $sock = shift;
137 my $addr = shift;
8add82fc 138
cf7fe8a2
GS
139 return bind($sock, $addr) ? $sock
140 : undef;
8add82fc
PP
141}
142
143sub listen {
cf7fe8a2
GS
144 @_ >= 1 && @_ <= 2 or croak 'usage: $sock->listen([QUEUE])';
145 my($sock,$queue) = @_;
8add82fc
PP
146 $queue = 5
147 unless $queue && $queue > 0;
148
cf7fe8a2
GS
149 return listen($sock, $queue) ? $sock
150 : undef;
8add82fc
PP
151}
152
153sub accept {
cf7fe8a2
GS
154 @_ == 1 || @_ == 2 or croak 'usage $sock->accept([PKG])';
155 my $sock = shift;
156 my $pkg = shift || $sock;
157 my $timeout = ${*$sock}{'io_socket_timeout'};
8add82fc
PP
158 my $new = $pkg->new(Timeout => $timeout);
159 my $peer = undef;
160
161 eval {
162 if($timeout) {
cf7fe8a2
GS
163 require IO::Select;
164
165 my $sel = new IO::Select $sock;
166
8add82fc 167 croak "accept: timeout"
cf7fe8a2 168 unless $sel->can_read($timeout);
8add82fc 169 }
cf7fe8a2 170 $peer = accept($new,$sock) || undef;
8add82fc 171 };
81be85b8 172 croak "$@" if $@ and $sock;
8add82fc
PP
173
174 return wantarray ? defined $peer ? ($new, $peer)
175 : ()
176 : defined $peer ? $new
177 : undef;
178}
179
180sub sockname {
cf7fe8a2 181 @_ == 1 or croak 'usage: $sock->sockname()';
8add82fc
PP
182 getsockname($_[0]);
183}
184
185sub peername {
cf7fe8a2
GS
186 @_ == 1 or croak 'usage: $sock->peername()';
187 my($sock) = @_;
188 getpeername($sock)
189 || ${*$sock}{'io_socket_peername'}
8add82fc
PP
190 || undef;
191}
192
cf7fe8a2
GS
193sub connected {
194 @_ == 1 or croak 'usage: $sock->connected()';
195 my($sock) = @_;
196 getpeername($sock);
197}
198
8add82fc 199sub send {
cf7fe8a2
GS
200 @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
201 my $sock = $_[0];
8add82fc 202 my $flags = $_[2] || 0;
cf7fe8a2 203 my $peer = $_[3] || $sock->peername;
8add82fc
PP
204
205 croak 'send: Cannot determine peer address'
206 unless($peer);
207
cf7fe8a2
GS
208 my $r = defined(getpeername($sock))
209 ? send($sock, $_[1], $flags)
210 : send($sock, $_[1], $flags, $peer);
8add82fc
PP
211
212 # remember who we send to, if it was sucessful
cf7fe8a2 213 ${*$sock}{'io_socket_peername'} = $peer
8add82fc
PP
214 if(@_ == 4 && defined $r);
215
216 $r;
217}
218
219sub recv {
cf7fe8a2 220 @_ == 3 || @_ == 4 or croak 'usage: $sock->recv(BUF, LEN [, FLAGS])';
8add82fc
PP
221 my $sock = $_[0];
222 my $len = $_[2];
223 my $flags = $_[3] || 0;
224
225 # remember who we recv'd from
226 ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
227}
228
cf7fe8a2
GS
229sub shutdown {
230 @_ == 2 or croak 'usage: $sock->shutdown(HOW)';
231 my($sock, $how) = @_;
232 shutdown($sock, $how);
233}
8add82fc
PP
234
235sub setsockopt {
cf7fe8a2 236 @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME)';
8add82fc
PP
237 setsockopt($_[0],$_[1],$_[2],$_[3]);
238}
239
240my $intsize = length(pack("i",0));
241
242sub getsockopt {
cf7fe8a2 243 @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)';
8add82fc
PP
244 my $r = getsockopt($_[0],$_[1],$_[2]);
245 # Just a guess
246 $r = unpack("i", $r)
247 if(defined $r && length($r) == $intsize);
248 $r;
249}
250
251sub sockopt {
cf7fe8a2
GS
252 my $sock = shift;
253 @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_)
254 : $sock->setsockopt(SOL_SOCKET,@_);
8add82fc
PP
255}
256
257sub timeout {
cf7fe8a2
GS
258 @_ == 1 || @_ == 2 or croak 'usage: $sock->timeout([VALUE])';
259 my($sock,$val) = @_;
260 my $r = ${*$sock}{'io_socket_timeout'} || undef;
8add82fc 261
cf7fe8a2 262 ${*$sock}{'io_socket_timeout'} = 0 + $val
8add82fc
PP
263 if(@_ == 2);
264
265 $r;
266}
267
27d4819a 268sub sockdomain {
cf7fe8a2
GS
269 @_ == 1 or croak 'usage: $sock->sockdomain()';
270 my $sock = shift;
271 ${*$sock}{'io_socket_domain'};
27d4819a
JM
272}
273
8add82fc 274sub socktype {
cf7fe8a2
GS
275 @_ == 1 or croak 'usage: $sock->socktype()';
276 my $sock = shift;
277 ${*$sock}{'io_socket_type'}
8add82fc
PP
278}
279
27d4819a 280sub protocol {
cf7fe8a2
GS
281 @_ == 1 or croak 'usage: $sock->protocol()';
282 my($sock) = @_;
8fd73a68 283 ${*$sock}{'io_socket_proto'};
27d4819a
JM
284}
285
cf7fe8a2 2861;
8add82fc 287
cf7fe8a2 288__END__
27d4819a 289
cf7fe8a2 290=head1 NAME
e713eafe 291
cf7fe8a2 292IO::Socket - Object interface to socket communications
8add82fc 293
cf7fe8a2 294=head1 SYNOPSIS
7a4c00b4 295
cf7fe8a2 296 use IO::Socket;
7a4c00b4 297
cf7fe8a2 298=head1 DESCRIPTION
7a4c00b4 299
cf7fe8a2
GS
300C<IO::Socket> provides an object interface to creating and using sockets. It
301is built upon the L<IO::Handle> interface and inherits all the methods defined
302by L<IO::Handle>.
8add82fc 303
cf7fe8a2
GS
304C<IO::Socket> only defines methods for those operations which are common to all
305types of socket. Operations which are specified to a socket in a particular
306domain have methods defined in sub classes of C<IO::Socket>
e713eafe 307
cf7fe8a2 308C<IO::Socket> will export all functions (and constants) defined by L<Socket>.
e713eafe 309
cf7fe8a2 310=head1 CONSTRUCTOR
8add82fc 311
27d4819a
JM
312=over 4
313
cf7fe8a2 314=item new ( [ARGS] )
27d4819a 315
cf7fe8a2
GS
316Creates an C<IO::Socket>, which is a reference to a
317newly created symbol (see the C<Symbol> package). C<new>
318optionally takes arguments, these arguments are in key-value pairs.
319C<new> only looks for one key C<Domain> which tells new which domain
320the socket will be in. All other arguments will be passed to the
321configuration method of the package for that domain, See below.
8add82fc 322
cf7fe8a2
GS
323 NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
324
325As of VERSION 1.18 all IO::Socket objects have autoflush turned on
326by default. This was not the case with earlier releases.
27d4819a 327
cf7fe8a2 328 NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
27d4819a
JM
329
330=back
8add82fc 331
cf7fe8a2 332=head1 METHODS
8add82fc 333
cf7fe8a2
GS
334See L<perlfunc> for complete descriptions of each of the following
335supported C<IO::Socket> methods, which are just front ends for the
336corresponding built-in functions:
8add82fc 337
cf7fe8a2
GS
338 socket
339 socketpair
340 bind
341 listen
342 accept
343 send
344 recv
345 peername (getpeername)
346 sockname (getsockname)
347 shutdown
8add82fc 348
cf7fe8a2
GS
349Some methods take slightly different arguments to those defined in L<perlfunc>
350in attempt to make the interface more flexible. These are
8add82fc 351
cf7fe8a2 352=over 4
8add82fc 353
cf7fe8a2 354=item accept([PKG])
8add82fc 355
cf7fe8a2
GS
356perform the system call C<accept> on the socket and return a new object. The
357new object will be created in the same class as the listen socket, unless
358C<PKG> is specified. This object can be used to communicate with the client
359that was trying to connect. In a scalar context the new socket is returned,
360or undef upon failure. In an array context a two-element array is returned
c4be5b27 361containing the new socket and the peer address; the list will
cf7fe8a2 362be empty upon failure.
8add82fc 363
c4be5b27 364=item socketpair(DOMAIN, TYPE, PROTOCOL)
365
366Call C<socketpair> and return a list of two sockets created, or an
367empty list on failure.
368
369=back
370
371Additional methods that are provided are:
372
373=over 4
8add82fc 374
cf7fe8a2 375=item timeout([VAL])
8add82fc 376
cf7fe8a2
GS
377Set or get the timeout value associated with this socket. If called without
378any arguments then the current setting is returned. If called with an argument
379the current setting is changed and the previous value returned.
8add82fc 380
cf7fe8a2 381=item sockopt(OPT [, VAL])
27d4819a 382
cf7fe8a2
GS
383Unified method to both set and get options in the SOL_SOCKET level. If called
384with one argument then getsockopt is called, otherwise setsockopt is called.
8add82fc 385
cf7fe8a2 386=item sockdomain
8add82fc 387
cf7fe8a2
GS
388Returns the numerical number for the socket domain type. For example, for
389a AF_INET socket the value of &AF_INET will be returned.
8add82fc 390
cf7fe8a2 391=item socktype
8add82fc 392
cf7fe8a2
GS
393Returns the numerical number for the socket type. For example, for
394a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
27d4819a 395
cf7fe8a2 396=item protocol
8add82fc 397
cf7fe8a2
GS
398Returns the numerical number for the protocol being used on the socket, if
399known. If the protocol is unknown, as with an AF_UNIX socket, zero
400is returned.
8add82fc 401
cf7fe8a2 402=item connected
8add82fc 403
cf7fe8a2
GS
404If the socket is in a connected state the the peer address is returned.
405If the socket is not in a connected state then undef will be returned.
27d4819a
JM
406
407=back
8add82fc 408
7a4c00b4 409=head1 SEE ALSO
8add82fc 410
cf7fe8a2 411L<Socket>, L<IO::Handle>, L<IO::Socket::INET>, L<IO::Socket::UNIX>
8add82fc 412
7a4c00b4 413=head1 AUTHOR
8add82fc 414
854822f1
GS
415Graham Barr. Currently maintained by the Perl Porters. Please report all
416bugs to <perl5-porters@perl.org>.
760ac839 417
8add82fc
PP
418=head1 COPYRIGHT
419
cf7fe8a2
GS
420Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
421This program is free software; you can redistribute it and/or
422modify it under the same terms as Perl itself.
8add82fc
PP
423
424=cut