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.
42 C<IO::Socket>s will be in autoflush mode after creation. Note that
43 versions of IO::Socket prior to 1.1603 (as shipped with Perl 5.004_04)
44 did not do this. So if you need backward compatibility, you should
45 set autoflush explicitly.
51 See L<perlfunc> for complete descriptions of each of the following
52 supported C<IO::Socket> methods, which are just front ends for the
53 corresponding built-in functions:
62 peername (getpeername)
63 sockname (getsockname)
65 Some methods take slightly different arguments to those defined in L<perlfunc>
66 in attempt to make the interface more flexible. These are
72 perform the system call C<accept> on the socket and return a new object. The
73 new object will be created in the same class as the listen socket, unless
74 C<PKG> is specified. This object can be used to communicate with the client
75 that was trying to connect. In a scalar context the new socket is returned,
76 or undef upon failure. In an array context a two-element array is returned
77 containing the new socket and the peer address, the list will
78 be empty upon failure.
80 Additional methods that are provided are
84 Set or get the timeout value associated with this socket. If called without
85 any arguments then the current setting is returned. If called with an argument
86 the current setting is changed and the previous value returned.
88 =item sockopt(OPT [, VAL])
90 Unified method to both set and get options in the SOL_SOCKET level. If called
91 with one argument then getsockopt is called, otherwise setsockopt is called.
95 Returns the numerical number for the socket domain type. For example, for
96 a AF_INET socket the value of &AF_INET will be returned.
100 Returns the numerical number for the socket type. For example, for
101 a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
105 Returns the numerical number for the protocol being used on the socket, if
106 known. If the protocol is unknown, as with an AF_UNIX socket, zero
121 use vars qw(@ISA $VERSION);
124 @ISA = qw(IO::Handle);
130 my $callpkg = caller;
131 Exporter::export 'Socket', $callpkg, @_;
135 my($class,%arg) = @_;
136 my $fh = $class->SUPER::new();
139 ${*$fh}{'io_socket_timeout'} = delete $arg{Timeout};
141 return scalar(%arg) ? $fh->configure(\%arg)
147 sub register_domain {
149 $domain2pkg[$d] = $p;
154 my $domain = delete $arg->{Domain};
156 croak 'IO::Socket: Cannot configure a generic socket'
157 unless defined $domain;
159 croak "IO::Socket: Unsupported socket domain"
160 unless defined $domain2pkg[$domain];
162 croak "IO::Socket: Cannot configure socket in domain '$domain'"
163 unless ref($fh) eq "IO::Socket";
165 bless($fh, $domain2pkg[$domain]);
166 $fh->configure($arg);
170 @_ == 4 or croak 'usage: $fh->socket(DOMAIN, TYPE, PROTOCOL)';
171 my($fh,$domain,$type,$protocol) = @_;
173 socket($fh,$domain,$type,$protocol) or
176 ${*$fh}{'io_socket_domain'} = $domain;
177 ${*$fh}{'io_socket_type'} = $type;
178 ${*$fh}{'io_socket_proto'} = $protocol;
184 @_ == 4 || croak 'usage: IO::Socket->pair(DOMAIN, TYPE, PROTOCOL)';
185 my($class,$domain,$type,$protocol) = @_;
186 my $fh1 = $class->new();
187 my $fh2 = $class->new();
189 socketpair($fh1,$fh2,$domain,$type,$protocol) or
192 ${*$fh1}{'io_socket_type'} = ${*$fh2}{'io_socket_type'} = $type;
193 ${*$fh1}{'io_socket_proto'} = ${*$fh2}{'io_socket_proto'} = $protocol;
199 @_ == 2 || @_ == 3 or croak 'usage: $fh->connect(NAME) or $fh->connect(PORT, ADDR)';
201 my $addr = @_ == 1 ? shift : sockaddr_in(@_);
202 my $timeout = ${*$fh}{'io_socket_timeout'};
203 local($SIG{ALRM}) = $timeout ? sub { undef $fh; }
204 : $SIG{ALRM} || 'DEFAULT';
207 croak 'connect: Bad address'
208 if(@_ == 2 && !defined $_[1]);
211 defined $Config{d_alarm} && defined alarm($timeout) or
215 my $ok = connect($fh, $addr);
220 croak "connect: timeout"
223 undef $fh unless $ok;
230 @_ == 2 || @_ == 3 or croak 'usage: $fh->bind(NAME) or $fh->bind(PORT, ADDR)';
232 my $addr = @_ == 1 ? shift : sockaddr_in(@_);
234 return bind($fh, $addr) ? $fh
239 @_ >= 1 && @_ <= 2 or croak 'usage: $fh->listen([QUEUE])';
242 unless $queue && $queue > 0;
244 return listen($fh, $queue) ? $fh
249 @_ == 1 || @_ == 2 or croak 'usage $fh->accept([PKG])';
251 my $pkg = shift || $fh;
252 my $timeout = ${*$fh}{'io_socket_timeout'};
253 my $new = $pkg->new(Timeout => $timeout);
259 vec($fdset, $fh->fileno,1) = 1;
260 croak "accept: timeout"
261 unless select($fdset,undef,undef,$timeout);
263 $peer = accept($new,$fh);
266 return wantarray ? defined $peer ? ($new, $peer)
268 : defined $peer ? $new
273 @_ == 1 or croak 'usage: $fh->sockname()';
278 @_ == 1 or croak 'usage: $fh->peername()';
281 || ${*$fh}{'io_socket_peername'}
286 @_ >= 2 && @_ <= 4 or croak 'usage: $fh->send(BUF, [FLAGS, [TO]])';
288 my $flags = $_[2] || 0;
289 my $peer = $_[3] || $fh->peername;
291 croak 'send: Cannot determine peer address'
294 my $r = defined(getpeername($fh))
295 ? send($fh, $_[1], $flags)
296 : send($fh, $_[1], $flags, $peer);
298 # remember who we send to, if it was sucessful
299 ${*$fh}{'io_socket_peername'} = $peer
300 if(@_ == 4 && defined $r);
306 @_ == 3 || @_ == 4 or croak 'usage: $fh->recv(BUF, LEN [, FLAGS])';
309 my $flags = $_[3] || 0;
311 # remember who we recv'd from
312 ${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
317 @_ == 4 or croak '$fh->setsockopt(LEVEL, OPTNAME)';
318 setsockopt($_[0],$_[1],$_[2],$_[3]);
321 my $intsize = length(pack("i",0));
324 @_ == 3 or croak '$fh->getsockopt(LEVEL, OPTNAME)';
325 my $r = getsockopt($_[0],$_[1],$_[2]);
328 if(defined $r && length($r) == $intsize);
334 @_ == 1 ? $fh->getsockopt(SOL_SOCKET,@_)
335 : $fh->setsockopt(SOL_SOCKET,@_);
339 @_ == 1 || @_ == 2 or croak 'usage: $fh->timeout([VALUE])';
341 my $r = ${*$fh}{'io_socket_timeout'} || undef;
343 ${*$fh}{'io_socket_timeout'} = 0 + $val
350 @_ == 1 or croak 'usage: $fh->sockdomain()';
352 ${*$fh}{'io_socket_domain'};
356 @_ == 1 or croak 'usage: $fh->socktype()';
358 ${*$fh}{'io_socket_type'}
362 @_ == 1 or croak 'usage: $fh->protocol()';
364 ${*$fh}{'io_socket_protocol'};
375 package IO::Socket::INET;
383 @ISA = qw(IO::Socket);
385 IO::Socket::INET->register_domain( AF_INET );
387 my %socket_type = ( tcp => SOCK_STREAM,
392 =head2 IO::Socket::INET
394 C<IO::Socket::INET> provides a constructor to create an AF_INET domain socket
395 and some related methods. The constructor can take the following options
397 PeerAddr Remote host address <hostname>[:<port>]
398 PeerPort Remote port or service <service>[(<no>)] | <no>
399 LocalAddr Local host bind address hostname[:port]
400 LocalPort Local host bind port <service>[(<no>)] | <no>
401 Proto Protocol name (or number) "tcp" | "udp" | ...
402 Type Socket type SOCK_STREAM | SOCK_DGRAM | ...
403 Listen Queue size for listen
404 Reuse Set SO_REUSEADDR before binding
405 Timeout Timeout value for various operations
408 If C<Listen> is defined then a listen socket is created, else if the
409 socket type, which is derived from the protocol, is SOCK_STREAM then
412 The C<PeerAddr> can be a hostname or the IP-address on the
413 "xx.xx.xx.xx" form. The C<PeerPort> can be a number or a symbolic
414 service name. The service name might be followed by a number in
415 parenthesis which is used if the service is not known by the system.
416 The C<PeerPort> specification can also be embedded in the C<PeerAddr>
417 by preceding it with a ":".
419 If C<Proto> is not given and you specify a symbolic C<PeerPort> port,
420 then the constructor will try to derive C<Proto> from the service
421 name. As a last resort C<Proto> "tcp" is assumed. The C<Type>
422 parameter will be deduced from C<Proto> if not specified.
424 If the constructor is only passed a single argument, it is assumed to
425 be a C<PeerAddr> specification.
429 $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org',
430 PeerPort => 'http(80)',
433 $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)');
435 $sock = IO::Socket::INET->new(Listen => 5,
436 LocalAddr => 'localhost',
440 $sock = IO::Socket::INET->new('127.0.0.1:25');
449 Return the address part of the sockaddr structure for the socket
453 Return the port number that the socket is using on the local host
457 Return the address part of the sockaddr structure for the socket in a
458 text form xx.xx.xx.xx
462 Return the address part of the sockaddr structure for the socket on
467 Return the port number for the socket on the peer host.
471 Return the address part of the sockaddr structure for the socket on the
472 peer host in a text form xx.xx.xx.xx
481 unshift(@_, "PeerAddr") if @_ == 1;
482 return $class->SUPER::new(@_);
486 my($addr,$port,$proto) = @_;
491 if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
494 @proto = $proto =~ m,\D, ? getprotobyname($proto)
495 : getprotobynumber($proto);
497 $proto = $proto[2] || undef;
501 $port =~ s,\((\d+)\)$,,;
503 my $defport = $1 || undef;
504 my $pnum = ($port =~ m,^(\d+)$,)[0];
506 @serv= getservbyname($port, $proto[0] || "")
509 $port = $pnum || $serv[2] || $defport || undef;
511 $proto = (getprotobyname($serv[3]))[2] || undef
515 return ($addr || undef,
523 $@ = join("",ref($fh),": ",@_);
526 if(defined fileno($fh));
532 my($lport,$rport,$laddr,$raddr,$proto,$type);
535 ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
539 $laddr = defined $laddr ? inet_aton($laddr)
542 return _error($fh,"Bad hostname '",$arg->{LocalAddr},"'")
543 unless(defined $laddr);
545 unless(exists $arg->{Listen}) {
546 ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
552 $raddr = inet_aton($raddr);
553 return _error($fh,"Bad hostname '",$arg->{PeerAddr},"'")
554 unless(defined $raddr);
557 $proto ||= (getprotobyname "tcp")[2];
558 return _error($fh,'Cannot determine protocol')
561 my $pname = (getprotobynumber($proto))[0];
562 $type = $arg->{Type} || $socket_type{$pname};
564 $fh->socket(AF_INET, $type, $proto) or
565 return _error($fh,"$!");
568 $fh->sockopt(SO_REUSEADDR,1) or
572 $fh->bind($lport || 0, $laddr) or
573 return _error($fh,"$!");
575 if(exists $arg->{Listen}) {
576 $fh->listen($arg->{Listen} || 5) or
577 return _error($fh,"$!");
580 return _error($fh,'Cannot determine remote port')
581 unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);
583 if($type == SOCK_STREAM || defined $raddr) {
584 return _error($fh,'Bad peer address')
585 unless(defined $raddr);
587 $fh->connect($rport,$raddr) or
588 return _error($fh,"$!");
596 @_ == 1 or croak 'usage: $fh->sockaddr()';
598 (sockaddr_in($fh->sockname))[1];
602 @_ == 1 or croak 'usage: $fh->sockport()';
604 (sockaddr_in($fh->sockname))[0];
608 @_ == 1 or croak 'usage: $fh->sockhost()';
610 inet_ntoa($fh->sockaddr);
614 @_ == 1 or croak 'usage: $fh->peeraddr()';
616 (sockaddr_in($fh->peername))[1];
620 @_ == 1 or croak 'usage: $fh->peerport()';
622 (sockaddr_in($fh->peername))[0];
626 @_ == 1 or croak 'usage: $fh->peerhost()';
628 inet_ntoa($fh->peeraddr);
635 package IO::Socket::UNIX;
638 use vars qw(@ISA $VERSION);
643 @ISA = qw(IO::Socket);
645 IO::Socket::UNIX->register_domain( AF_UNIX );
647 =head2 IO::Socket::UNIX
649 C<IO::Socket::UNIX> provides a constructor to create an AF_UNIX domain socket
650 and some related methods. The constructor can take the following options
652 Type Type of socket (eg SOCK_STREAM or SOCK_DGRAM)
653 Local Path to local fifo
654 Peer Path to peer fifo
655 Listen Create a listen socket
663 Returns the pathname to the fifo at the local end
667 Returns the pathanme to the fifo at the peer end
677 my $type = $arg->{Type} || SOCK_STREAM;
679 $fh->socket(AF_UNIX, $type, 0) or
682 if(exists $arg->{Local}) {
683 my $addr = sockaddr_un($arg->{Local});
687 if(exists $arg->{Listen}) {
688 $fh->listen($arg->{Listen} || 5) or
691 elsif(exists $arg->{Peer}) {
692 my $addr = sockaddr_un($arg->{Peer});
693 $fh->connect($addr) or
701 @_ == 1 or croak 'usage: $fh->hostpath()';
702 my $n = $_[0]->sockname || return undef;
703 (sockaddr_un($n))[0];
707 @_ == 1 or croak 'usage: $fh->peerpath()';
708 my $n = $_[0]->peername || return undef;
709 (sockaddr_un($n))[0];
714 L<Socket>, L<IO::Handle>
718 Graham Barr E<lt>F<Graham.Barr@tiuk.ti.com>E<gt>
722 Copyright (c) 1996 Graham Barr. All rights reserved. This program is free
723 software; you can redistribute it and/or modify it under the same terms
728 1; # Keep require happy