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