7 IO::Socket - Object interface to socket communications
15 C<IO::Socket> provides an object interface to creating and using sockets. It
16 is built upon the L<IO::Handle> interface and inherits all the methods defined
19 C<IO::Socket> only defines methods for those operations which are common to all
20 types of socket. Operations which are specified to a socket in a particular
21 domain have methods defined in sub classes of C<IO::Socket>
29 Creates a C<IO::Pipe>, which is a reference to a
30 newly created symbol (see the C<Symbol> package). C<new>
31 optionally takes arguments, these arguments are in key-value pairs.
32 C<new> only looks for one key C<Domain> which tells new which domain
33 the socket it will be. All other arguments will be passed to the
34 configuration method of the package for that domain, See below.
40 See L<perlfunc> for complete descriptions of each of the following
41 supported C<IO::Seekable> methods, which are just front ends for the
42 corresponding built-in functions:
51 peername (getpeername)
52 sockname (getsockname)
54 Some methods take slightly different arguments to those defined in L<perlfunc>
55 in attempt to make the interface more flexible. These are
61 perform the system call C<accept> on the socket and return a new object. The
62 new object will be created in the same class as the listen socket, unless
63 C<PKG> is specified. This object can be used to communicate with the client
64 that was trying to connect. In a scalar context the new socket is returned,
65 or undef upon failure. In an array context a two-element array is returned
66 containing the new socket and the peer address, the list will
67 be empty upon failure.
69 Additional methods that are provided are
73 Set or get the timeout value associated with this socket. If called without
74 any arguments then the current setting is returned. If called with an argument
75 the current setting is changed and the previous value returned.
77 =item sockopt(OPT [, VAL])
79 Unified method to both set and get options in the SOL_SOCKET level. If called
80 with one argument then getsockopt is called, otherwise setsockopt is called.
84 Returns the numerical number for the socket domain type. For example, fir
85 a AF_INET socket the value of &AF_INET will be returned.
89 Returns the numerical number for the socket type. For example, fir
90 a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
94 Returns the numerical number for the protocol being used on the socket, if
95 known. If the protocol is unknown, as with an AF_UNIX socket, zero
110 use vars qw(@ISA @EXPORT_OK $VERSION);
113 @ISA = qw(IO::Handle);
115 # This one will turn 1.2 => 1.02 and 1.2.3 => 1.0203 and so on ...
117 $VERSION = do{my @r=(q$Revision: 1.13 $=~/(\d+)/g);sprintf "%d."."%02d"x$#r,@r};
121 my $callpkg = caller;
122 Exporter::export 'Socket', $callpkg, @_;
126 my($class,%arg) = @_;
127 my $fh = $class->SUPER::new();
129 ${*$fh}{'io_socket_timeout'} = delete $arg{Timeout};
131 return scalar(%arg) ? $fh->configure(\%arg)
137 sub register_domain {
139 $domain2pkg[$d] = bless \$d, $p;
145 croak "Unsupported socket domain"
146 unless defined $domain2pkg[$domain];
153 my $domain = delete $arg->{Domain};
155 croak 'IO::Socket: Cannot configure a generic socket'
156 unless defined $domain;
158 my $sub = ref(_domain2pkg($domain)) . "::configure";
163 croak "IO::Socket: Cannot configure socket in domain '$domain' $sub";
167 @_ == 4 or croak 'usage: $fh->socket(DOMAIN, TYPE, PROTOCOL)';
168 my($fh,$domain,$type,$protocol) = @_;
170 if(!defined ${*$fh}{'io_socket_domain'}
171 || !ref(${*$fh}{'io_socket_domain'})
172 || ${${*$fh}{'io_socket_domain'}} != $domain) {
174 ${*$fh}{'io_socket_domain'} = _domain2pkg($domain);
177 socket($fh,$domain,$type,$protocol) or
180 ${*$fh}{'io_socket_type'} = $type;
181 ${*$fh}{'io_socket_proto'} = $protocol;
186 @_ == 4 || croak 'usage: IO::Socket->pair(DOMAIN, TYPE, PROTOCOL)';
187 my($class,$domain,$type,$protocol) = @_;
188 my $fh1 = $class->new();
189 my $fh2 = $class->new();
191 socketpair($fh1,$fh1,$domain,$type,$protocol) or
194 ${*$fh1}{'io_socket_type'} = ${*$fh2}{'io_socket_type'} = $type;
195 ${*$fh1}{'io_socket_proto'} = ${*$fh2}{'io_socket_proto'} = $protocol;
201 @_ == 2 || @_ == 3 or croak 'usage: $fh->connect(NAME) or $fh->connect(PORT, ADDR)';
203 my $addr = @_ == 1 ? shift : sockaddr_in(@_);
204 my $timeout = ${*$fh}{'io_socket_timeout'};
205 local($SIG{ALRM}) = $timeout ? sub { undef $fh; }
206 : $SIG{ALRM} || 'DEFAULT';
209 croak 'connect: Bad address'
210 if(@_ == 2 && !defined $_[1]);
213 defined $Config{d_alarm} && defined alarm($timeout) or
217 my $ok = connect($fh, $addr);
222 croak "connect: timeout"
225 undef $fh unless $ok;
232 @_ == 2 || @_ == 3 or croak 'usage: $fh->bind(NAME) or $fh->bind(PORT, ADDR)';
234 my $addr = @_ == 1 ? shift : sockaddr_in(@_);
236 return bind($fh, $addr) ? $fh
241 @_ >= 1 && @_ <= 2 or croak 'usage: $fh->listen([QUEUE])';
244 unless $queue && $queue > 0;
246 return listen($fh, $queue) ? $fh
251 @_ == 1 || @_ == 2 or croak 'usage $fh->accept([PKG])';
253 my $pkg = shift || $fh;
254 my $timeout = ${*$fh}{'io_socket_timeout'};
255 my $new = $pkg->new(Timeout => $timeout);
261 vec($fdset, $fh->fileno,1) = 1;
262 croak "accept: timeout"
263 unless select($fdset,undef,undef,$timeout);
265 $peer = accept($new,$fh);
268 return wantarray ? defined $peer ? ($new, $peer)
270 : defined $peer ? $new
275 @_ == 1 or croak 'usage: $fh->sockname()';
280 @_ == 1 or croak 'usage: $fh->peername()';
283 || ${*$fh}{'io_socket_peername'}
288 @_ >= 2 && @_ <= 4 or croak 'usage: $fh->send(BUF, [FLAGS, [TO]])';
290 my $flags = $_[2] || 0;
291 my $peer = $_[3] || $fh->peername;
293 croak 'send: Cannot determine peer address'
296 my $r = defined(getpeername($fh))
297 ? send($fh, $_[1], $flags)
298 : send($fh, $_[1], $flags, $peer);
300 # remember who we send to, if it was sucessful
301 ${*$fh}{'io_socket_peername'} = $peer
302 if(@_ == 4 && defined $r);
308 @_ == 3 || @_ == 4 or croak 'usage: $fh->recv(BUF, LEN [, FLAGS])';
311 my $flags = $_[3] || 0;
313 # remember who we recv'd from
314 ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
319 @_ == 4 or croak '$fh->setsockopt(LEVEL, OPTNAME)';
320 setsockopt($_[0],$_[1],$_[2],$_[3]);
323 my $intsize = length(pack("i",0));
326 @_ == 3 or croak '$fh->getsockopt(LEVEL, OPTNAME)';
327 my $r = getsockopt($_[0],$_[1],$_[2]);
330 if(defined $r && length($r) == $intsize);
336 @_ == 1 ? $fh->getsockopt(SOL_SOCKET,@_)
337 : $fh->setsockopt(SOL_SOCKET,@_);
341 @_ == 1 || @_ == 2 or croak 'usage: $fh->timeout([VALUE])';
343 my $r = ${*$fh}{'io_socket_timeout'} || undef;
345 ${*$fh}{'io_socket_timeout'} = 0 + $val
352 @_ == 1 or croak 'usage: $fh->sockdomain()';
354 ${${*$fh}{'io_socket_domain'}}
358 @_ == 1 or croak 'usage: $fh->socktype()';
360 ${*$fh}{'io_socket_type'}
364 @_ == 1 or croak 'usage: $fh->protocol()';
366 ${*$fh}{'io_socket_protocol'};
379 my $pkg = ref(${*{$_[0]}}{'io_socket_domain'});
380 my $sub = "${pkg}::${n}";
381 goto &{$sub} if defined &{$sub};
382 croak qq{Can't locate object method "$n" via package "$pkg"};
384 unless defined &{$n};
398 package IO::Socket::INET;
401 use vars qw(@ISA $VERSION);
406 @ISA = qw(IO::Socket);
408 IO::Socket::INET->_addmethod( qw(sockaddr sockport sockhost peeraddr peerport peerhost));
409 IO::Socket::INET->register_domain( AF_INET );
411 my %socket_type = ( tcp => SOCK_STREAM,
415 =head2 IO::Socket::INET
417 C<IO::Socket::INET> provides a constructor to create an AF_INET domain socket
418 and some related methods. The constructor can take the following options
420 PeerAddr Remote host address
421 PeerPort Remote port or service
422 LocalPort Local host bind port
423 LocalAddr Local host bind address
424 Proto Protocol name (eg tcp udp etc)
425 Type Socket type (SOCK_STREAM etc)
426 Listen Queue size for listen
427 Timeout Timeout value for various operations
430 If Listen is defined then a listen socket is created, else if the socket
431 type, which is derived from the protocol, is SOCK_STREAM then a connect
434 Only one of C<Type> or C<Proto> needs to be specified, one will be assumed
443 Return the address part of the sockaddr structure for the socket
447 Return the port number that the socket is using on the local host
451 Return the address part of the sockaddr structure for the socket in a
452 text form xx.xx.xx.xx
456 Return the address part of the sockaddr structure for the socket on
461 Return the port number for the socket on the peer host.
465 Return the address part of the sockaddr structure for the socket on the
466 peer host in a text form xx.xx.xx.xx
474 my($addr,$port,$proto) = @_;
479 if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
482 @proto = $proto =~ m,\D, ? getprotobyname($proto)
483 : getprotobynumber($proto);
485 $proto = $proto[2] || undef;
489 $port =~ s,\((\d+)\)$,,;
491 my $defport = $1 || undef;
492 my $pnum = ($port =~ m,^(\d+)$,)[0];
494 @serv= getservbyname($port, $proto[0] || "")
497 $port = $pnum || $serv[2] || $defport || undef;
499 $proto = (getprotobyname($serv[3]))[2] || undef
503 return ($addr || undef,
511 carp join("",ref($fh),": ",@_) if @_;
513 if(defined fileno($fh));
519 my($lport,$rport,$laddr,$raddr,$proto,$type);
522 ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
526 $laddr = defined $laddr ? inet_aton($laddr)
529 return _error($fh,"Bad hostname '",$arg->{LocalAddr},"'")
530 unless(defined $laddr);
532 unless(exists $arg->{Listen}) {
533 ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
539 $raddr = inet_aton($raddr);
540 return _error($fh,"Bad hostname '",$arg->{PeerAddr},"'")
541 unless(defined $raddr);
544 return _error($fh,'Cannot determine protocol')
547 my $pname = (getprotobynumber($proto))[0];
548 $type = $arg->{Type} || $socket_type{$pname};
550 my $domain = AF_INET;
551 ${*$fh}{'io_socket_domain'} = bless \$domain;
553 $fh->socket(AF_INET, $type, $proto) or
556 $fh->bind($lport || 0, $laddr) or
559 if(exists $arg->{Listen}) {
560 $fh->listen($arg->{Listen} || 5) or
564 return _error($fh,'Cannot determine remote port')
565 unless($rport || $type == SOCK_DGRAM);
567 if($type == SOCK_STREAM || defined $raddr) {
568 return _error($fh,'Bad peer address')
569 unless(defined $raddr);
571 $fh->connect($rport,$raddr) or
580 @_ == 1 or croak 'usage: $fh->sockaddr()';
582 (sockaddr_in($fh->sockname))[1];
586 @_ == 1 or croak 'usage: $fh->sockport()';
588 (sockaddr_in($fh->sockname))[0];
592 @_ == 1 or croak 'usage: $fh->sockhost()';
594 inet_ntoa($fh->sockaddr);
598 @_ == 1 or croak 'usage: $fh->peeraddr()';
600 (sockaddr_in($fh->peername))[1];
604 @_ == 1 or croak 'usage: $fh->peerport()';
606 (sockaddr_in($fh->peername))[0];
610 @_ == 1 or croak 'usage: $fh->peerhost()';
612 inet_ntoa($fh->peeraddr);
619 package IO::Socket::UNIX;
622 use vars qw(@ISA $VERSION);
627 @ISA = qw(IO::Socket);
629 IO::Socket::UNIX->_addmethod(qw(hostpath peerpath));
630 IO::Socket::UNIX->register_domain( AF_UNIX );
632 =head2 IO::Socket::UNIX
634 C<IO::Socket::UNIX> provides a constructor to create an AF_UNIX domain socket
635 and some related methods. The constructor can take the following options
637 Type Type of socket (eg SOCK_STREAM or SOCK_DGRAM)
638 Local Path to local fifo
639 Peer Path to peer fifo
640 Listen Create a listen socket
648 Returns the pathname to the fifo at the local end.
652 Returns the pathanme to the fifo at the peer end.
662 my $type = $arg->{Type} || SOCK_STREAM;
664 my $domain = AF_UNIX;
665 ${*$fh}{'io_socket_domain'} = bless \$domain;
667 $fh->socket(AF_UNIX, $type, 0) or
670 if(exists $arg->{Local}) {
671 my $addr = sockaddr_un($arg->{Local});
675 if(exists $arg->{Listen}) {
676 $fh->listen($arg->{Listen} || 5) or
679 elsif(exists $arg->{Peer}) {
680 my $addr = sockaddr_un($arg->{Peer});
681 $fh->connect($addr) or
689 @_ == 1 or croak 'usage: $fh->hostpath()';
690 my $n = $_[0]->sockname || return undef;
692 (sockaddr_un($n))[0];
696 @_ == 1 or croak 'usage: $fh->peerpath()';
697 my $n = $_[0]->peername || return undef;
699 my @n = sockaddr_un($n);
701 (sockaddr_un($n))[0];
706 Graham Barr E<lt>F<Graham.Barr@tiuk.ti.com>E<gt>
712 The VERSION is derived from the revision turning each number after the
713 first dot into a 2 digit number so
715 Revision 1.8 => VERSION 1.08
716 Revision 1.2.3 => VERSION 1.0203
720 Copyright (c) 1995 Graham Barr. All rights reserved. This program is free
721 software; you can redistribute it and/or modify it under the same terms
726 1; # Keep require happy