This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
adapted suggested patch for IO-1.20x
[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 6
7package IO::Socket;
8
8add82fc 9require 5.000;
10
8add82fc 11use IO::Handle;
12use Socket 1.3;
13use Carp;
14use strict;
7a4c00b4 15use vars qw(@ISA $VERSION);
8add82fc 16use Exporter;
17
cf7fe8a2
GS
18# legacy
19
20require IO::Socket::INET;
21require IO::Socket::UNIX;
22
8add82fc 23@ISA = qw(IO::Handle);
24
c4be5b27 25$VERSION = "1.252";
8add82fc 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 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 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 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 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 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 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 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 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 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 141}
142
143sub listen {
cf7fe8a2
GS
144 @_ >= 1 && @_ <= 2 or croak 'usage: $sock->listen([QUEUE])';
145 my($sock,$queue) = @_;
8add82fc 146 $queue = 5
147 unless $queue && $queue > 0;
148
cf7fe8a2
GS
149 return listen($sock, $queue) ? $sock
150 : undef;
8add82fc 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 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 };
172
173 return wantarray ? defined $peer ? ($new, $peer)
174 : ()
175 : defined $peer ? $new
176 : undef;
177}
178
179sub sockname {
cf7fe8a2 180 @_ == 1 or croak 'usage: $sock->sockname()';
8add82fc 181 getsockname($_[0]);
182}
183
184sub peername {
cf7fe8a2
GS
185 @_ == 1 or croak 'usage: $sock->peername()';
186 my($sock) = @_;
187 getpeername($sock)
188 || ${*$sock}{'io_socket_peername'}
8add82fc 189 || undef;
190}
191
cf7fe8a2
GS
192sub connected {
193 @_ == 1 or croak 'usage: $sock->connected()';
194 my($sock) = @_;
195 getpeername($sock);
196}
197
8add82fc 198sub send {
cf7fe8a2
GS
199 @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
200 my $sock = $_[0];
8add82fc 201 my $flags = $_[2] || 0;
cf7fe8a2 202 my $peer = $_[3] || $sock->peername;
8add82fc 203
204 croak 'send: Cannot determine peer address'
205 unless($peer);
206
cf7fe8a2
GS
207 my $r = defined(getpeername($sock))
208 ? send($sock, $_[1], $flags)
209 : send($sock, $_[1], $flags, $peer);
8add82fc 210
211 # remember who we send to, if it was sucessful
cf7fe8a2 212 ${*$sock}{'io_socket_peername'} = $peer
8add82fc 213 if(@_ == 4 && defined $r);
214
215 $r;
216}
217
218sub recv {
cf7fe8a2 219 @_ == 3 || @_ == 4 or croak 'usage: $sock->recv(BUF, LEN [, FLAGS])';
8add82fc 220 my $sock = $_[0];
221 my $len = $_[2];
222 my $flags = $_[3] || 0;
223
224 # remember who we recv'd from
225 ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
226}
227
cf7fe8a2
GS
228sub shutdown {
229 @_ == 2 or croak 'usage: $sock->shutdown(HOW)';
230 my($sock, $how) = @_;
231 shutdown($sock, $how);
232}
8add82fc 233
234sub setsockopt {
cf7fe8a2 235 @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME)';
8add82fc 236 setsockopt($_[0],$_[1],$_[2],$_[3]);
237}
238
239my $intsize = length(pack("i",0));
240
241sub getsockopt {
cf7fe8a2 242 @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)';
8add82fc 243 my $r = getsockopt($_[0],$_[1],$_[2]);
244 # Just a guess
245 $r = unpack("i", $r)
246 if(defined $r && length($r) == $intsize);
247 $r;
248}
249
250sub sockopt {
cf7fe8a2
GS
251 my $sock = shift;
252 @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_)
253 : $sock->setsockopt(SOL_SOCKET,@_);
8add82fc 254}
255
256sub timeout {
cf7fe8a2
GS
257 @_ == 1 || @_ == 2 or croak 'usage: $sock->timeout([VALUE])';
258 my($sock,$val) = @_;
259 my $r = ${*$sock}{'io_socket_timeout'} || undef;
8add82fc 260
cf7fe8a2 261 ${*$sock}{'io_socket_timeout'} = 0 + $val
8add82fc 262 if(@_ == 2);
263
264 $r;
265}
266
27d4819a 267sub sockdomain {
cf7fe8a2
GS
268 @_ == 1 or croak 'usage: $sock->sockdomain()';
269 my $sock = shift;
270 ${*$sock}{'io_socket_domain'};
27d4819a
JM
271}
272
8add82fc 273sub socktype {
cf7fe8a2
GS
274 @_ == 1 or croak 'usage: $sock->socktype()';
275 my $sock = shift;
276 ${*$sock}{'io_socket_type'}
8add82fc 277}
278
27d4819a 279sub protocol {
cf7fe8a2
GS
280 @_ == 1 or croak 'usage: $sock->protocol()';
281 my($sock) = @_;
282 ${*$sock}{'io_socket_protocol'};
27d4819a
JM
283}
284
cf7fe8a2 2851;
8add82fc 286
cf7fe8a2 287__END__
27d4819a 288
cf7fe8a2 289=head1 NAME
e713eafe 290
cf7fe8a2 291IO::Socket - Object interface to socket communications
8add82fc 292
cf7fe8a2 293=head1 SYNOPSIS
7a4c00b4 294
cf7fe8a2 295 use IO::Socket;
7a4c00b4 296
cf7fe8a2 297=head1 DESCRIPTION
7a4c00b4 298
cf7fe8a2
GS
299C<IO::Socket> provides an object interface to creating and using sockets. It
300is built upon the L<IO::Handle> interface and inherits all the methods defined
301by L<IO::Handle>.
8add82fc 302
cf7fe8a2
GS
303C<IO::Socket> only defines methods for those operations which are common to all
304types of socket. Operations which are specified to a socket in a particular
305domain have methods defined in sub classes of C<IO::Socket>
e713eafe 306
cf7fe8a2 307C<IO::Socket> will export all functions (and constants) defined by L<Socket>.
e713eafe 308
cf7fe8a2 309=head1 CONSTRUCTOR
8add82fc 310
27d4819a
JM
311=over 4
312
cf7fe8a2 313=item new ( [ARGS] )
27d4819a 314
cf7fe8a2
GS
315Creates an C<IO::Socket>, which is a reference to a
316newly created symbol (see the C<Symbol> package). C<new>
317optionally takes arguments, these arguments are in key-value pairs.
318C<new> only looks for one key C<Domain> which tells new which domain
319the socket will be in. All other arguments will be passed to the
320configuration method of the package for that domain, See below.
8add82fc 321
cf7fe8a2
GS
322 NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
323
324As of VERSION 1.18 all IO::Socket objects have autoflush turned on
325by default. This was not the case with earlier releases.
27d4819a 326
cf7fe8a2 327 NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
27d4819a
JM
328
329=back
8add82fc 330
cf7fe8a2 331=head1 METHODS
8add82fc 332
cf7fe8a2
GS
333See L<perlfunc> for complete descriptions of each of the following
334supported C<IO::Socket> methods, which are just front ends for the
335corresponding built-in functions:
8add82fc 336
cf7fe8a2
GS
337 socket
338 socketpair
339 bind
340 listen
341 accept
342 send
343 recv
344 peername (getpeername)
345 sockname (getsockname)
346 shutdown
8add82fc 347
cf7fe8a2
GS
348Some methods take slightly different arguments to those defined in L<perlfunc>
349in attempt to make the interface more flexible. These are
8add82fc 350
cf7fe8a2 351=over 4
8add82fc 352
cf7fe8a2 353=item accept([PKG])
8add82fc 354
cf7fe8a2
GS
355perform the system call C<accept> on the socket and return a new object. The
356new object will be created in the same class as the listen socket, unless
357C<PKG> is specified. This object can be used to communicate with the client
358that was trying to connect. In a scalar context the new socket is returned,
359or undef upon failure. In an array context a two-element array is returned
c4be5b27 360containing the new socket and the peer address; the list will
cf7fe8a2 361be empty upon failure.
8add82fc 362
c4be5b27
IP
363=item socketpair(DOMAIN, TYPE, PROTOCOL)
364
365Call C<socketpair> and return a list of two sockets created, or an
366empty list on failure.
367
368=back
369
370Additional methods that are provided are:
371
372=over 4
8add82fc 373
cf7fe8a2 374=item timeout([VAL])
8add82fc 375
cf7fe8a2
GS
376Set or get the timeout value associated with this socket. If called without
377any arguments then the current setting is returned. If called with an argument
378the current setting is changed and the previous value returned.
8add82fc 379
cf7fe8a2 380=item sockopt(OPT [, VAL])
27d4819a 381
cf7fe8a2
GS
382Unified method to both set and get options in the SOL_SOCKET level. If called
383with one argument then getsockopt is called, otherwise setsockopt is called.
8add82fc 384
cf7fe8a2 385=item sockdomain
8add82fc 386
cf7fe8a2
GS
387Returns the numerical number for the socket domain type. For example, for
388a AF_INET socket the value of &AF_INET will be returned.
8add82fc 389
cf7fe8a2 390=item socktype
8add82fc 391
cf7fe8a2
GS
392Returns the numerical number for the socket type. For example, for
393a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
27d4819a 394
cf7fe8a2 395=item protocol
8add82fc 396
cf7fe8a2
GS
397Returns the numerical number for the protocol being used on the socket, if
398known. If the protocol is unknown, as with an AF_UNIX socket, zero
399is returned.
8add82fc 400
cf7fe8a2 401=item connected
8add82fc 402
cf7fe8a2
GS
403If the socket is in a connected state the the peer address is returned.
404If the socket is not in a connected state then undef will be returned.
27d4819a
JM
405
406=back
8add82fc 407
7a4c00b4 408=head1 SEE ALSO
8add82fc 409
cf7fe8a2 410L<Socket>, L<IO::Handle>, L<IO::Socket::INET>, L<IO::Socket::UNIX>
8add82fc 411
7a4c00b4 412=head1 AUTHOR
8add82fc 413
854822f1
GS
414Graham Barr. Currently maintained by the Perl Porters. Please report all
415bugs to <perl5-porters@perl.org>.
760ac839 416
8add82fc 417=head1 COPYRIGHT
418
cf7fe8a2
GS
419Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
420This program is free software; you can redistribute it and/or
421modify it under the same terms as Perl itself.
8add82fc 422
423=cut