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]);
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,
385 =head2 IO::Socket::INET
387 C<IO::Socket::INET> provides a constructor to create an AF_INET domain socket
388 and some related methods. The constructor can take the following options
390 PeerAddr Remote host address <hostname>[:<port>]
391 PeerPort Remote port or service <service>[(<no>)] | <no>
392 LocalAddr Local host bind address hostname[:port]
393 LocalPort Local host bind port <service>[(<no>)] | <no>
394 Proto Protocol name "tcp" | "udp" | ...
395 Type Socket type SOCK_STREAM | SOCK_DGRAM | ...
396 Listen Queue size for listen
397 Reuse Set SO_REUSEADDR before binding
398 Timeout Timeout value for various operations
401 If C<Listen> is defined then a listen socket is created, else if the
402 socket type, which is derived from the protocol, is SOCK_STREAM then
405 The C<PeerAddr> can be a hostname or the IP-address on the
406 "xx.xx.xx.xx" form. The C<PeerPort> can be a number or a symbolic
407 service name. The service name might be followed by a number in
408 parenthesis which is used if the service is not known by the system.
409 The C<PeerPort> specification can also be embedded in the C<PeerAddr>
410 by preceding it with a ":".
412 Only one of C<Type> or C<Proto> needs to be specified, one will be
413 assumed from the other. If you specify a symbolic C<PeerPort> port,
414 then the constructor will try to derive C<Type> and C<Proto> from
419 $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org',
420 PeerPort => 'http(80)',
423 $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)');
425 $sock = IO::Socket::INET->new(Listen => 5,
426 LocalAddr => 'localhost',
436 Return the address part of the sockaddr structure for the socket
440 Return the port number that the socket is using on the local host
444 Return the address part of the sockaddr structure for the socket in a
445 text form xx.xx.xx.xx
449 Return the address part of the sockaddr structure for the socket on
454 Return the port number for the socket on the peer host.
458 Return the address part of the sockaddr structure for the socket on the
459 peer host in a text form xx.xx.xx.xx
466 my($addr,$port,$proto) = @_;
471 if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
474 @proto = $proto =~ m,\D, ? getprotobyname($proto)
475 : getprotobynumber($proto);
477 $proto = $proto[2] || undef;
481 $port =~ s,\((\d+)\)$,,;
483 my $defport = $1 || undef;
484 my $pnum = ($port =~ m,^(\d+)$,)[0];
486 @serv= getservbyname($port, $proto[0] || "")
489 $port = $pnum || $serv[2] || $defport || undef;
491 $proto = (getprotobyname($serv[3]))[2] || undef
495 return ($addr || undef,
503 $@ = join("",ref($fh),": ",@_);
506 if(defined fileno($fh));
512 my($lport,$rport,$laddr,$raddr,$proto,$type);
515 ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
519 $laddr = defined $laddr ? inet_aton($laddr)
522 return _error($fh,"Bad hostname '",$arg->{LocalAddr},"'")
523 unless(defined $laddr);
525 unless(exists $arg->{Listen}) {
526 ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
532 $raddr = inet_aton($raddr);
533 return _error($fh,"Bad hostname '",$arg->{PeerAddr},"'")
534 unless(defined $raddr);
537 return _error($fh,'Cannot determine protocol')
540 my $pname = (getprotobynumber($proto))[0];
541 $type = $arg->{Type} || $socket_type{$pname};
543 $fh->socket(AF_INET, $type, $proto) or
544 return _error($fh,"$!");
547 $fh->sockopt(SO_REUSEADDR,1) or
551 $fh->bind($lport || 0, $laddr) or
552 return _error($fh,"$!");
554 if(exists $arg->{Listen}) {
555 $fh->listen($arg->{Listen} || 5) or
556 return _error($fh,"$!");
559 return _error($fh,'Cannot determine remote port')
560 unless($rport || $type == SOCK_DGRAM);
562 if($type == SOCK_STREAM || defined $raddr) {
563 return _error($fh,'Bad peer address')
564 unless(defined $raddr);
566 $fh->connect($rport,$raddr) or
567 return _error($fh,"$!");
575 @_ == 1 or croak 'usage: $fh->sockaddr()';
577 (sockaddr_in($fh->sockname))[1];
581 @_ == 1 or croak 'usage: $fh->sockport()';
583 (sockaddr_in($fh->sockname))[0];
587 @_ == 1 or croak 'usage: $fh->sockhost()';
589 inet_ntoa($fh->sockaddr);
593 @_ == 1 or croak 'usage: $fh->peeraddr()';
595 (sockaddr_in($fh->peername))[1];
599 @_ == 1 or croak 'usage: $fh->peerport()';
601 (sockaddr_in($fh->peername))[0];
605 @_ == 1 or croak 'usage: $fh->peerhost()';
607 inet_ntoa($fh->peeraddr);
614 package IO::Socket::UNIX;
617 use vars qw(@ISA $VERSION);
622 @ISA = qw(IO::Socket);
624 IO::Socket::UNIX->register_domain( AF_UNIX );
626 =head2 IO::Socket::UNIX
628 C<IO::Socket::UNIX> provides a constructor to create an AF_UNIX domain socket
629 and some related methods. The constructor can take the following options
631 Type Type of socket (eg SOCK_STREAM or SOCK_DGRAM)
632 Local Path to local fifo
633 Peer Path to peer fifo
634 Listen Create a listen socket
642 Returns the pathname to the fifo at the local end
646 Returns the pathanme to the fifo at the peer end
656 my $type = $arg->{Type} || SOCK_STREAM;
658 $fh->socket(AF_UNIX, $type, 0) or
661 if(exists $arg->{Local}) {
662 my $addr = sockaddr_un($arg->{Local});
666 if(exists $arg->{Listen}) {
667 $fh->listen($arg->{Listen} || 5) or
670 elsif(exists $arg->{Peer}) {
671 my $addr = sockaddr_un($arg->{Peer});
672 $fh->connect($addr) or
680 @_ == 1 or croak 'usage: $fh->hostpath()';
681 my $n = $_[0]->sockname || return undef;
682 (sockaddr_un($n))[0];
686 @_ == 1 or croak 'usage: $fh->peerpath()';
687 my $n = $_[0]->peername || return undef;
688 (sockaddr_un($n))[0];
693 L<Socket>, L<IO::Handle>
697 Graham Barr E<lt>F<Graham.Barr@tiuk.ti.com>E<gt>
701 Copyright (c) 1996 Graham Barr. All rights reserved. This program is free
702 software; you can redistribute it and/or modify it under the same terms
707 1; # Keep require happy