This is a live mirror of the Perl 5 development currently hosted at https://github.com/perl/perl5
PowerMAX hints update from Tom Horsley <Tom.Horsley@mail.ccur.com>
[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
8add82fc
PP
9require 5.000;
10
8add82fc
PP
11use IO::Handle;
12use Socket 1.3;
13use Carp;
14use strict;
7a4c00b4 15use vars qw(@ISA $VERSION);
8add82fc
PP
16use Exporter;
17
cf7fe8a2
GS
18# legacy
19
20require IO::Socket::INET;
21require IO::Socket::UNIX;
22
8add82fc
PP
23@ISA = qw(IO::Handle);
24
00fdd80d 25$VERSION = "1.251";
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 {
84 @_ == 4 || croak 'usage: IO::Socket->pair(DOMAIN, TYPE, PROTOCOL)';
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
PP
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
PP
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
PP
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
PP
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
PP
210
211 # remember who we send to, if it was sucessful
cf7fe8a2 212 ${*$sock}{'io_socket_peername'} = $peer
8add82fc
PP
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
PP
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
PP
233
234sub setsockopt {
cf7fe8a2 235 @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME)';
8add82fc
PP
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
PP
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
PP
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
PP
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
PP
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
360containing the new socket and the peer address, the list will
361be empty upon failure.
8add82fc 362
cf7fe8a2 363Additional methods that are provided are
8add82fc 364
cf7fe8a2 365=item timeout([VAL])
8add82fc 366
cf7fe8a2
GS
367Set or get the timeout value associated with this socket. If called without
368any arguments then the current setting is returned. If called with an argument
369the current setting is changed and the previous value returned.
8add82fc 370
cf7fe8a2 371=item sockopt(OPT [, VAL])
27d4819a 372
cf7fe8a2
GS
373Unified method to both set and get options in the SOL_SOCKET level. If called
374with one argument then getsockopt is called, otherwise setsockopt is called.
8add82fc 375
cf7fe8a2 376=item sockdomain
8add82fc 377
cf7fe8a2
GS
378Returns the numerical number for the socket domain type. For example, for
379a AF_INET socket the value of &AF_INET will be returned.
8add82fc 380
cf7fe8a2 381=item socktype
8add82fc 382
cf7fe8a2
GS
383Returns the numerical number for the socket type. For example, for
384a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
27d4819a 385
cf7fe8a2 386=item protocol
8add82fc 387
cf7fe8a2
GS
388Returns the numerical number for the protocol being used on the socket, if
389known. If the protocol is unknown, as with an AF_UNIX socket, zero
390is returned.
8add82fc 391
cf7fe8a2 392=item connected
8add82fc 393
cf7fe8a2
GS
394If the socket is in a connected state the the peer address is returned.
395If the socket is not in a connected state then undef will be returned.
27d4819a
JM
396
397=back
8add82fc 398
7a4c00b4 399=head1 SEE ALSO
8add82fc 400
cf7fe8a2 401L<Socket>, L<IO::Handle>, L<IO::Socket::INET>, L<IO::Socket::UNIX>
8add82fc 402
7a4c00b4 403=head1 AUTHOR
8add82fc 404
854822f1
GS
405Graham Barr. Currently maintained by the Perl Porters. Please report all
406bugs to <perl5-porters@perl.org>.
760ac839 407
8add82fc
PP
408=head1 COPYRIGHT
409
cf7fe8a2
GS
410Copyright (c) 1997-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.
8add82fc
PP
413
414=cut