3 # Copyright (c) 1996 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
4 # reserved. This program is free software; you can redistribute it and/or
5 # modify it under the same terms as Perl itself.
11 IO::Socket - Object interface to socket communications
19 C<IO::Socket> provides an object interface to creating and using sockets. It
20 is built upon the L<IO::Handle> interface and inherits all the methods defined
23 C<IO::Socket> only defines methods for those operations which are common to all
24 types of socket. Operations which are specified to a socket in a particular
25 domain have methods defined in sub classes of C<IO::Socket>
27 C<IO::Socket> will export all functions (and constants) defined by L<Socket>.
35 Creates an C<IO::Socket>, which is a reference to a
36 newly created symbol (see the C<Symbol> package). C<new>
37 optionally takes arguments, these arguments are in key-value pairs.
38 C<new> only looks for one key C<Domain> which tells new which domain
39 the socket will be in. All other arguments will be passed to the
40 configuration method of the package for that domain, See below.
46 See L<perlfunc> for complete descriptions of each of the following
47 supported C<IO::Socket> methods, which are just front ends for the
48 corresponding built-in functions:
57 peername (getpeername)
58 sockname (getsockname)
60 Some methods take slightly different arguments to those defined in L<perlfunc>
61 in attempt to make the interface more flexible. These are
67 perform the system call C<accept> on the socket and return a new object. The
68 new object will be created in the same class as the listen socket, unless
69 C<PKG> is specified. This object can be used to communicate with the client
70 that was trying to connect. In a scalar context the new socket is returned,
71 or undef upon failure. In an array context a two-element array is returned
72 containing the new socket and the peer address, the list will
73 be empty upon failure.
75 Additional methods that are provided are
79 Set or get the timeout value associated with this socket. If called without
80 any arguments then the current setting is returned. If called with an argument
81 the current setting is changed and the previous value returned.
83 =item sockopt(OPT [, VAL])
85 Unified method to both set and get options in the SOL_SOCKET level. If called
86 with one argument then getsockopt is called, otherwise setsockopt is called.
90 Returns the numerical number for the socket domain type. For example, for
91 a AF_INET socket the value of &AF_INET will be returned.
95 Returns the numerical number for the socket type. For example, for
96 a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
100 Returns the numerical number for the protocol being used on the socket, if
101 known. If the protocol is unknown, as with an AF_UNIX socket, zero
116 use vars qw(@ISA $VERSION);
119 @ISA = qw(IO::Handle);
125 my $callpkg = caller;
126 Exporter::export 'Socket', $callpkg, @_;
130 my($class,%arg) = @_;
131 my $fh = $class->SUPER::new();
133 ${*$fh}{'io_socket_timeout'} = delete $arg{Timeout};
135 return scalar(%arg) ? $fh->configure(\%arg)
141 sub register_domain {
143 $domain2pkg[$d] = $p;
148 my $domain = delete $arg->{Domain};
150 croak 'IO::Socket: Cannot configure a generic socket'
151 unless defined $domain;
153 croak "IO::Socket: Unsupported socket domain"
154 unless defined $domain2pkg[$domain];
156 croak "IO::Socket: Cannot configure socket in domain '$domain'"
157 unless ref($fh) eq "IO::Socket";
159 bless($fh, $domain2pkg[$domain]);
160 $fh->configure($arg);
164 @_ == 4 or croak 'usage: $fh->socket(DOMAIN, TYPE, PROTOCOL)';
165 my($fh,$domain,$type,$protocol) = @_;
167 socket($fh,$domain,$type,$protocol) or
170 ${*$fh}{'io_socket_domain'} = $domain;
171 ${*$fh}{'io_socket_type'} = $type;
172 ${*$fh}{'io_socket_proto'} = $protocol;
178 @_ == 4 || croak 'usage: IO::Socket->pair(DOMAIN, TYPE, PROTOCOL)';
179 my($class,$domain,$type,$protocol) = @_;
180 my $fh1 = $class->new();
181 my $fh2 = $class->new();
183 socketpair($fh1,$fh1,$domain,$type,$protocol) or
186 ${*$fh1}{'io_socket_type'} = ${*$fh2}{'io_socket_type'} = $type;
187 ${*$fh1}{'io_socket_proto'} = ${*$fh2}{'io_socket_proto'} = $protocol;
193 @_ == 2 || @_ == 3 or croak 'usage: $fh->connect(NAME) or $fh->connect(PORT, ADDR)';
195 my $addr = @_ == 1 ? shift : sockaddr_in(@_);
196 my $timeout = ${*$fh}{'io_socket_timeout'};
197 local($SIG{ALRM}) = $timeout ? sub { undef $fh; }
198 : $SIG{ALRM} || 'DEFAULT';
201 croak 'connect: Bad address'
202 if(@_ == 2 && !defined $_[1]);
205 defined $Config{d_alarm} && defined alarm($timeout) or
209 my $ok = connect($fh, $addr);
214 croak "connect: timeout"
217 undef $fh unless $ok;
224 @_ == 2 || @_ == 3 or croak 'usage: $fh->bind(NAME) or $fh->bind(PORT, ADDR)';
226 my $addr = @_ == 1 ? shift : sockaddr_in(@_);
228 return bind($fh, $addr) ? $fh
233 @_ >= 1 && @_ <= 2 or croak 'usage: $fh->listen([QUEUE])';
236 unless $queue && $queue > 0;
238 return listen($fh, $queue) ? $fh
243 @_ == 1 || @_ == 2 or croak 'usage $fh->accept([PKG])';
245 my $pkg = shift || $fh;
246 my $timeout = ${*$fh}{'io_socket_timeout'};
247 my $new = $pkg->new(Timeout => $timeout);
253 vec($fdset, $fh->fileno,1) = 1;
254 croak "accept: timeout"
255 unless select($fdset,undef,undef,$timeout);
257 $peer = accept($new,$fh);
260 return wantarray ? defined $peer ? ($new, $peer)
262 : defined $peer ? $new
267 @_ == 1 or croak 'usage: $fh->sockname()';
272 @_ == 1 or croak 'usage: $fh->peername()';
275 || ${*$fh}{'io_socket_peername'}
280 @_ >= 2 && @_ <= 4 or croak 'usage: $fh->send(BUF, [FLAGS, [TO]])';
282 my $flags = $_[2] || 0;
283 my $peer = $_[3] || $fh->peername;
285 croak 'send: Cannot determine peer address'
288 my $r = defined(getpeername($fh))
289 ? send($fh, $_[1], $flags)
290 : send($fh, $_[1], $flags, $peer);
292 # remember who we send to, if it was sucessful
293 ${*$fh}{'io_socket_peername'} = $peer
294 if(@_ == 4 && defined $r);
300 @_ == 3 || @_ == 4 or croak 'usage: $fh->recv(BUF, LEN [, FLAGS])';
303 my $flags = $_[3] || 0;
305 # remember who we recv'd from
306 ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
311 @_ == 4 or croak '$fh->setsockopt(LEVEL, OPTNAME)';
312 setsockopt($_[0],$_[1],$_[2],$_[3]);
315 my $intsize = length(pack("i",0));
318 @_ == 3 or croak '$fh->getsockopt(LEVEL, OPTNAME)';
319 my $r = getsockopt($_[0],$_[1],$_[2]);
322 if(defined $r && length($r) == $intsize);
328 @_ == 1 ? $fh->getsockopt(SOL_SOCKET,@_)
329 : $fh->setsockopt(SOL_SOCKET,@_);
333 @_ == 1 || @_ == 2 or croak 'usage: $fh->timeout([VALUE])';
335 my $r = ${*$fh}{'io_socket_timeout'} || undef;
337 ${*$fh}{'io_socket_timeout'} = 0 + $val
344 @_ == 1 or croak 'usage: $fh->sockdomain()';
346 ${*$fh}{'io_socket_domain'};
350 @_ == 1 or croak 'usage: $fh->socktype()';
352 ${*$fh}{'io_socket_type'}
356 @_ == 1 or croak 'usage: $fh->protocol()';
358 ${*$fh}{'io_socket_protocol'};
369 package IO::Socket::INET;
377 @ISA = qw(IO::Socket);
379 IO::Socket::INET->register_domain( AF_INET );
381 my %socket_type = ( tcp => SOCK_STREAM,
386 =head2 IO::Socket::INET
388 C<IO::Socket::INET> provides a constructor to create an AF_INET domain socket
389 and some related methods. The constructor can take the following options
391 PeerAddr Remote host address <hostname>[:<port>]
392 PeerPort Remote port or service <service>[(<no>)] | <no>
393 LocalAddr Local host bind address hostname[:port]
394 LocalPort Local host bind port <service>[(<no>)] | <no>
395 Proto Protocol name "tcp" | "udp" | ...
396 Type Socket type SOCK_STREAM | SOCK_DGRAM | ...
397 Listen Queue size for listen
398 Reuse Set SO_REUSEADDR before binding
399 Timeout Timeout value for various operations
402 If C<Listen> is defined then a listen socket is created, else if the
403 socket type, which is derived from the protocol, is SOCK_STREAM then
406 The C<PeerAddr> can be a hostname or the IP-address on the
407 "xx.xx.xx.xx" form. The C<PeerPort> can be a number or a symbolic
408 service name. The service name might be followed by a number in
409 parenthesis which is used if the service is not known by the system.
410 The C<PeerPort> specification can also be embedded in the C<PeerAddr>
411 by preceding it with a ":".
413 Only one of C<Type> or C<Proto> needs to be specified, one will be
414 assumed from the other. If you specify a symbolic C<PeerPort> port,
415 then the constructor will try to derive C<Type> and C<Proto> from
420 $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org',
421 PeerPort => 'http(80)',
424 $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)');
426 $sock = IO::Socket::INET->new(Listen => 5,
427 LocalAddr => 'localhost',
437 Return the address part of the sockaddr structure for the socket
441 Return the port number that the socket is using on the local host
445 Return the address part of the sockaddr structure for the socket in a
446 text form xx.xx.xx.xx
450 Return the address part of the sockaddr structure for the socket on
455 Return the port number for the socket on the peer host.
459 Return the address part of the sockaddr structure for the socket on the
460 peer host in a text form xx.xx.xx.xx
467 my($addr,$port,$proto) = @_;
472 if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
475 @proto = $proto =~ m,\D, ? getprotobyname($proto)
476 : getprotobynumber($proto);
478 $proto = $proto[2] || undef;
482 $port =~ s,\((\d+)\)$,,;
484 my $defport = $1 || undef;
485 my $pnum = ($port =~ m,^(\d+)$,)[0];
487 @serv= getservbyname($port, $proto[0] || "")
490 $port = $pnum || $serv[2] || $defport || undef;
492 $proto = (getprotobyname($serv[3]))[2] || undef
496 return ($addr || undef,
504 $@ = join("",ref($fh),": ",@_);
507 if(defined fileno($fh));
513 my($lport,$rport,$laddr,$raddr,$proto,$type);
516 ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
520 $laddr = defined $laddr ? inet_aton($laddr)
523 return _error($fh,"Bad hostname '",$arg->{LocalAddr},"'")
524 unless(defined $laddr);
526 unless(exists $arg->{Listen}) {
527 ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
533 $raddr = inet_aton($raddr);
534 return _error($fh,"Bad hostname '",$arg->{PeerAddr},"'")
535 unless(defined $raddr);
538 return _error($fh,'Cannot determine protocol')
541 my $pname = (getprotobynumber($proto))[0];
542 $type = $arg->{Type} || $socket_type{$pname};
544 $fh->socket(AF_INET, $type, $proto) or
545 return _error($fh,"$!");
548 $fh->sockopt(SO_REUSEADDR,1) or
552 $fh->bind($lport || 0, $laddr) or
553 return _error($fh,"$!");
555 if(exists $arg->{Listen}) {
556 $fh->listen($arg->{Listen} || 5) or
557 return _error($fh,"$!");
560 return _error($fh,'Cannot determine remote port')
561 unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);
563 if($type == SOCK_STREAM || defined $raddr) {
564 return _error($fh,'Bad peer address')
565 unless(defined $raddr);
567 $fh->connect($rport,$raddr) or
568 return _error($fh,"$!");
576 @_ == 1 or croak 'usage: $fh->sockaddr()';
578 (sockaddr_in($fh->sockname))[1];
582 @_ == 1 or croak 'usage: $fh->sockport()';
584 (sockaddr_in($fh->sockname))[0];
588 @_ == 1 or croak 'usage: $fh->sockhost()';
590 inet_ntoa($fh->sockaddr);
594 @_ == 1 or croak 'usage: $fh->peeraddr()';
596 (sockaddr_in($fh->peername))[1];
600 @_ == 1 or croak 'usage: $fh->peerport()';
602 (sockaddr_in($fh->peername))[0];
606 @_ == 1 or croak 'usage: $fh->peerhost()';
608 inet_ntoa($fh->peeraddr);
615 package IO::Socket::UNIX;
618 use vars qw(@ISA $VERSION);
623 @ISA = qw(IO::Socket);
625 IO::Socket::UNIX->register_domain( AF_UNIX );
627 =head2 IO::Socket::UNIX
629 C<IO::Socket::UNIX> provides a constructor to create an AF_UNIX domain socket
630 and some related methods. The constructor can take the following options
632 Type Type of socket (eg SOCK_STREAM or SOCK_DGRAM)
633 Local Path to local fifo
634 Peer Path to peer fifo
635 Listen Create a listen socket
643 Returns the pathname to the fifo at the local end
647 Returns the pathanme to the fifo at the peer end
657 my $type = $arg->{Type} || SOCK_STREAM;
659 $fh->socket(AF_UNIX, $type, 0) or
662 if(exists $arg->{Local}) {
663 my $addr = sockaddr_un($arg->{Local});
667 if(exists $arg->{Listen}) {
668 $fh->listen($arg->{Listen} || 5) or
671 elsif(exists $arg->{Peer}) {
672 my $addr = sockaddr_un($arg->{Peer});
673 $fh->connect($addr) or
681 @_ == 1 or croak 'usage: $fh->hostpath()';
682 my $n = $_[0]->sockname || return undef;
683 (sockaddr_un($n))[0];
687 @_ == 1 or croak 'usage: $fh->peerpath()';
688 my $n = $_[0]->peername || return undef;
689 (sockaddr_un($n))[0];
694 L<Socket>, L<IO::Handle>
698 Graham Barr E<lt>F<Graham.Barr@tiuk.ti.com>E<gt>
702 Copyright (c) 1996 Graham Barr. All rights reserved. This program is free
703 software; you can redistribute it and/or modify it under the same terms
708 1; # Keep require happy