# IO::Socket.pm
#
-# Copyright (c) 1996 Graham Barr <Graham.Barr@tiuk.ti.com>. All rights
-# reserved. This program is free software; you can redistribute it and/or
+# Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+# This program is free software; you can redistribute it and/or
# modify it under the same terms as Perl itself.
package IO::Socket;
-=head1 NAME
-
-IO::Socket - Object interface to socket communications
-
-=head1 SYNOPSIS
-
- use IO::Socket;
-
-=head1 DESCRIPTION
-
-C<IO::Socket> provides an object interface to creating and using sockets. It
-is built upon the L<IO::Handle> interface and inherits all the methods defined
-by L<IO::Handle>.
-
-C<IO::Socket> only defines methods for those operations which are common to all
-types of socket. Operations which are specified to a socket in a particular
-domain have methods defined in sub classes of C<IO::Socket>
-
-C<IO::Socket> will export all functions (and constants) defined by L<Socket>.
-
-=head1 CONSTRUCTOR
-
-=over 4
-
-=item new ( [ARGS] )
-
-Creates an C<IO::Socket>, which is a reference to a
-newly created symbol (see the C<Symbol> package). C<new>
-optionally takes arguments, these arguments are in key-value pairs.
-C<new> only looks for one key C<Domain> which tells new which domain
-the socket will be in. All other arguments will be passed to the
-configuration method of the package for that domain, See below.
+require 5.006;
-C<IO::Socket>s will be in autoflush mode after creation.
-
-=back
-
-=head1 METHODS
-
-See L<perlfunc> for complete descriptions of each of the following
-supported C<IO::Socket> methods, which are just front ends for the
-corresponding built-in functions:
-
- socket
- socketpair
- bind
- listen
- accept
- send
- recv
- peername (getpeername)
- sockname (getsockname)
-
-Some methods take slightly different arguments to those defined in L<perlfunc>
-in attempt to make the interface more flexible. These are
-
-=over 4
-
-=item accept([PKG])
-
-perform the system call C<accept> on the socket and return a new object. The
-new object will be created in the same class as the listen socket, unless
-C<PKG> is specified. This object can be used to communicate with the client
-that was trying to connect. In a scalar context the new socket is returned,
-or undef upon failure. In an array context a two-element array is returned
-containing the new socket and the peer address, the list will
-be empty upon failure.
-
-Additional methods that are provided are
-
-=item timeout([VAL])
-
-Set or get the timeout value associated with this socket. If called without
-any arguments then the current setting is returned. If called with an argument
-the current setting is changed and the previous value returned.
-
-=item sockopt(OPT [, VAL])
-
-Unified method to both set and get options in the SOL_SOCKET level. If called
-with one argument then getsockopt is called, otherwise setsockopt is called.
-
-=item sockdomain
-
-Returns the numerical number for the socket domain type. For example, for
-a AF_INET socket the value of &AF_INET will be returned.
-
-=item socktype
-
-Returns the numerical number for the socket type. For example, for
-a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
-
-=item protocol
-
-Returns the numerical number for the protocol being used on the socket, if
-known. If the protocol is unknown, as with an AF_UNIX socket, zero
-is returned.
-
-=back
-
-=cut
-
-
-require 5.000;
-
-use Config;
use IO::Handle;
use Socket 1.3;
use Carp;
use strict;
-use vars qw(@ISA $VERSION);
+our(@ISA, $VERSION, @EXPORT_OK);
use Exporter;
+use Errno;
+
+# legacy
+
+require IO::Socket::INET;
+require IO::Socket::UNIX if ($^O ne 'epoc' && $^O ne 'symbian');
@ISA = qw(IO::Handle);
-$VERSION = "1.1603";
+$VERSION = "1.28";
+
+@EXPORT_OK = qw(sockatmark);
sub import {
my $pkg = shift;
- my $callpkg = caller;
- Exporter::export 'Socket', $callpkg, @_;
+ if (@_ && $_[0] eq 'sockatmark') { # not very extensible but for now, fast
+ Exporter::export_to_level('IO::Socket', 1, $pkg, 'sockatmark');
+ } else {
+ my $callpkg = caller;
+ Exporter::export 'Socket', $callpkg, @_;
+ }
}
sub new {
my($class,%arg) = @_;
- my $fh = $class->SUPER::new();
- $fh->autoflush;
+ my $sock = $class->SUPER::new();
- ${*$fh}{'io_socket_timeout'} = delete $arg{Timeout};
+ $sock->autoflush(1);
- return scalar(%arg) ? $fh->configure(\%arg)
- : $fh;
+ ${*$sock}{'io_socket_timeout'} = delete $arg{Timeout};
+
+ return scalar(%arg) ? $sock->configure(\%arg)
+ : $sock;
}
-my @domain2pkg = ();
+my @domain2pkg;
sub register_domain {
my($p,$d) = @_;
}
sub configure {
- my($fh,$arg) = @_;
+ my($sock,$arg) = @_;
my $domain = delete $arg->{Domain};
croak 'IO::Socket: Cannot configure a generic socket'
unless defined $domain2pkg[$domain];
croak "IO::Socket: Cannot configure socket in domain '$domain'"
- unless ref($fh) eq "IO::Socket";
+ unless ref($sock) eq "IO::Socket";
- bless($fh, $domain2pkg[$domain]);
- $fh->configure($arg);
+ bless($sock, $domain2pkg[$domain]);
+ $sock->configure($arg);
}
sub socket {
- @_ == 4 or croak 'usage: $fh->socket(DOMAIN, TYPE, PROTOCOL)';
- my($fh,$domain,$type,$protocol) = @_;
+ @_ == 4 or croak 'usage: $sock->socket(DOMAIN, TYPE, PROTOCOL)';
+ my($sock,$domain,$type,$protocol) = @_;
- socket($fh,$domain,$type,$protocol) or
+ socket($sock,$domain,$type,$protocol) or
return undef;
- ${*$fh}{'io_socket_domain'} = $domain;
- ${*$fh}{'io_socket_type'} = $type;
- ${*$fh}{'io_socket_proto'} = $protocol;
+ ${*$sock}{'io_socket_domain'} = $domain;
+ ${*$sock}{'io_socket_type'} = $type;
+ ${*$sock}{'io_socket_proto'} = $protocol;
- $fh;
+ $sock;
}
sub socketpair {
- @_ == 4 || croak 'usage: IO::Socket->pair(DOMAIN, TYPE, PROTOCOL)';
+ @_ == 4 || croak 'usage: IO::Socket->socketpair(DOMAIN, TYPE, PROTOCOL)';
my($class,$domain,$type,$protocol) = @_;
- my $fh1 = $class->new();
- my $fh2 = $class->new();
+ my $sock1 = $class->new();
+ my $sock2 = $class->new();
- socketpair($fh1,$fh1,$domain,$type,$protocol) or
+ socketpair($sock1,$sock2,$domain,$type,$protocol) or
return ();
- ${*$fh1}{'io_socket_type'} = ${*$fh2}{'io_socket_type'} = $type;
- ${*$fh1}{'io_socket_proto'} = ${*$fh2}{'io_socket_proto'} = $protocol;
+ ${*$sock1}{'io_socket_type'} = ${*$sock2}{'io_socket_type'} = $type;
+ ${*$sock1}{'io_socket_proto'} = ${*$sock2}{'io_socket_proto'} = $protocol;
- ($fh1,$fh2);
+ ($sock1,$sock2);
}
sub connect {
- @_ == 2 || @_ == 3 or croak 'usage: $fh->connect(NAME) or $fh->connect(PORT, ADDR)';
- my $fh = shift;
- my $addr = @_ == 1 ? shift : sockaddr_in(@_);
- my $timeout = ${*$fh}{'io_socket_timeout'};
- local($SIG{ALRM}) = $timeout ? sub { undef $fh; }
- : $SIG{ALRM} || 'DEFAULT';
-
- eval {
- croak 'connect: Bad address'
- if(@_ == 2 && !defined $_[1]);
-
- if($timeout) {
- defined $Config{d_alarm} && defined alarm($timeout) or
- $timeout = 0;
- }
-
- my $ok = connect($fh, $addr);
-
- alarm(0)
- if($timeout);
+ @_ == 2 or croak 'usage: $sock->connect(NAME)';
+ my $sock = shift;
+ my $addr = shift;
+ my $timeout = ${*$sock}{'io_socket_timeout'};
+ my $err;
+ my $blocking;
+
+ $blocking = $sock->blocking(0) if $timeout;
+ if (!connect($sock, $addr)) {
+ if (defined $timeout && $!{EINPROGRESS}) {
+ require IO::Select;
+
+ my $sel = new IO::Select $sock;
+
+ if (!$sel->can_write($timeout)) {
+ $err = $! || (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+ $@ = "connect: timeout";
+ }
+ elsif (!connect($sock,$addr) && not $!{EISCONN}) {
+ # Some systems refuse to re-connect() to
+ # an already open socket and set errno to EISCONN.
+ $err = $!;
+ $@ = "connect: $!";
+ }
+ }
+ elsif ($blocking || !$!{EINPROGRESS}) {
+ $err = $!;
+ $@ = "connect: $!";
+ }
+ }
- croak "connect: timeout"
- unless defined $fh;
+ $sock->blocking(1) if $blocking;
- undef $fh unless $ok;
- };
+ $! = $err if $err;
- $fh;
+ $err ? undef : $sock;
}
sub bind {
- @_ == 2 || @_ == 3 or croak 'usage: $fh->bind(NAME) or $fh->bind(PORT, ADDR)';
- my $fh = shift;
- my $addr = @_ == 1 ? shift : sockaddr_in(@_);
+ @_ == 2 or croak 'usage: $sock->bind(NAME)';
+ my $sock = shift;
+ my $addr = shift;
- return bind($fh, $addr) ? $fh
- : undef;
+ return bind($sock, $addr) ? $sock
+ : undef;
}
sub listen {
- @_ >= 1 && @_ <= 2 or croak 'usage: $fh->listen([QUEUE])';
- my($fh,$queue) = @_;
+ @_ >= 1 && @_ <= 2 or croak 'usage: $sock->listen([QUEUE])';
+ my($sock,$queue) = @_;
$queue = 5
unless $queue && $queue > 0;
- return listen($fh, $queue) ? $fh
- : undef;
+ return listen($sock, $queue) ? $sock
+ : undef;
}
sub accept {
- @_ == 1 || @_ == 2 or croak 'usage $fh->accept([PKG])';
- my $fh = shift;
- my $pkg = shift || $fh;
- my $timeout = ${*$fh}{'io_socket_timeout'};
+ @_ == 1 || @_ == 2 or croak 'usage $sock->accept([PKG])';
+ my $sock = shift;
+ my $pkg = shift || $sock;
+ my $timeout = ${*$sock}{'io_socket_timeout'};
my $new = $pkg->new(Timeout => $timeout);
my $peer = undef;
- eval {
- if($timeout) {
- my $fdset = "";
- vec($fdset, $fh->fileno,1) = 1;
- croak "accept: timeout"
- unless select($fdset,undef,undef,$timeout);
- }
- $peer = accept($new,$fh);
- };
-
- return wantarray ? defined $peer ? ($new, $peer)
- : ()
- : defined $peer ? $new
- : undef;
+ if(defined $timeout) {
+ require IO::Select;
+
+ my $sel = new IO::Select $sock;
+
+ unless ($sel->can_read($timeout)) {
+ $@ = 'accept: timeout';
+ $! = (exists &Errno::ETIMEDOUT ? &Errno::ETIMEDOUT : 1);
+ return;
+ }
+ }
+
+ $peer = accept($new,$sock)
+ or return;
+
+ return wantarray ? ($new, $peer)
+ : $new;
}
sub sockname {
- @_ == 1 or croak 'usage: $fh->sockname()';
+ @_ == 1 or croak 'usage: $sock->sockname()';
getsockname($_[0]);
}
sub peername {
- @_ == 1 or croak 'usage: $fh->peername()';
- my($fh) = @_;
- getpeername($fh)
- || ${*$fh}{'io_socket_peername'}
+ @_ == 1 or croak 'usage: $sock->peername()';
+ my($sock) = @_;
+ getpeername($sock)
+ || ${*$sock}{'io_socket_peername'}
|| undef;
}
+sub connected {
+ @_ == 1 or croak 'usage: $sock->connected()';
+ my($sock) = @_;
+ getpeername($sock);
+}
+
sub send {
- @_ >= 2 && @_ <= 4 or croak 'usage: $fh->send(BUF, [FLAGS, [TO]])';
- my $fh = $_[0];
+ @_ >= 2 && @_ <= 4 or croak 'usage: $sock->send(BUF, [FLAGS, [TO]])';
+ my $sock = $_[0];
my $flags = $_[2] || 0;
- my $peer = $_[3] || $fh->peername;
+ my $peer = $_[3] || $sock->peername;
croak 'send: Cannot determine peer address'
unless($peer);
- my $r = defined(getpeername($fh))
- ? send($fh, $_[1], $flags)
- : send($fh, $_[1], $flags, $peer);
+ my $r = defined(getpeername($sock))
+ ? send($sock, $_[1], $flags)
+ : send($sock, $_[1], $flags, $peer);
- # remember who we send to, if it was sucessful
- ${*$fh}{'io_socket_peername'} = $peer
+ # remember who we send to, if it was successful
+ ${*$sock}{'io_socket_peername'} = $peer
if(@_ == 4 && defined $r);
$r;
}
sub recv {
- @_ == 3 || @_ == 4 or croak 'usage: $fh->recv(BUF, LEN [, FLAGS])';
+ @_ == 3 || @_ == 4 or croak 'usage: $sock->recv(BUF, LEN [, FLAGS])';
my $sock = $_[0];
my $len = $_[2];
my $flags = $_[3] || 0;
${*$sock}{'io_socket_peername'} = recv($sock, $_[1]='', $len, $flags);
}
+sub shutdown {
+ @_ == 2 or croak 'usage: $sock->shutdown(HOW)';
+ my($sock, $how) = @_;
+ shutdown($sock, $how);
+}
sub setsockopt {
- @_ == 4 or croak '$fh->setsockopt(LEVEL, OPTNAME)';
+ @_ == 4 or croak '$sock->setsockopt(LEVEL, OPTNAME)';
setsockopt($_[0],$_[1],$_[2],$_[3]);
}
my $intsize = length(pack("i",0));
sub getsockopt {
- @_ == 3 or croak '$fh->getsockopt(LEVEL, OPTNAME)';
+ @_ == 3 or croak '$sock->getsockopt(LEVEL, OPTNAME)';
my $r = getsockopt($_[0],$_[1],$_[2]);
# Just a guess
$r = unpack("i", $r)
}
sub sockopt {
- my $fh = shift;
- @_ == 1 ? $fh->getsockopt(SOL_SOCKET,@_)
- : $fh->setsockopt(SOL_SOCKET,@_);
+ my $sock = shift;
+ @_ == 1 ? $sock->getsockopt(SOL_SOCKET,@_)
+ : $sock->setsockopt(SOL_SOCKET,@_);
+}
+
+sub atmark {
+ @_ == 1 or croak 'usage: $sock->atmark()';
+ my($sock) = @_;
+ sockatmark($sock);
}
sub timeout {
- @_ == 1 || @_ == 2 or croak 'usage: $fh->timeout([VALUE])';
- my($fh,$val) = @_;
- my $r = ${*$fh}{'io_socket_timeout'} || undef;
+ @_ == 1 || @_ == 2 or croak 'usage: $sock->timeout([VALUE])';
+ my($sock,$val) = @_;
+ my $r = ${*$sock}{'io_socket_timeout'};
- ${*$fh}{'io_socket_timeout'} = 0 + $val
+ ${*$sock}{'io_socket_timeout'} = defined $val ? 0 + $val : $val
if(@_ == 2);
$r;
}
sub sockdomain {
- @_ == 1 or croak 'usage: $fh->sockdomain()';
- my $fh = shift;
- ${*$fh}{'io_socket_domain'};
+ @_ == 1 or croak 'usage: $sock->sockdomain()';
+ my $sock = shift;
+ ${*$sock}{'io_socket_domain'};
}
sub socktype {
- @_ == 1 or croak 'usage: $fh->socktype()';
- my $fh = shift;
- ${*$fh}{'io_socket_type'}
+ @_ == 1 or croak 'usage: $sock->socktype()';
+ my $sock = shift;
+ ${*$sock}{'io_socket_type'}
}
sub protocol {
- @_ == 1 or croak 'usage: $fh->protocol()';
- my($fh) = @_;
- ${*$fh}{'io_socket_protocol'};
+ @_ == 1 or croak 'usage: $sock->protocol()';
+ my($sock) = @_;
+ ${*$sock}{'io_socket_proto'};
}
-=head1 SUB-CLASSES
-
-=cut
-
-##
-## AF_INET
-##
-
-package IO::Socket::INET;
-
-use strict;
-use vars qw(@ISA);
-use Socket;
-use Carp;
-use Exporter;
-
-@ISA = qw(IO::Socket);
+1;
-IO::Socket::INET->register_domain( AF_INET );
+__END__
-my %socket_type = ( tcp => SOCK_STREAM,
- udp => SOCK_DGRAM,
- icmp => SOCK_RAW,
- );
-
-=head2 IO::Socket::INET
-
-C<IO::Socket::INET> provides a constructor to create an AF_INET domain socket
-and some related methods. The constructor can take the following options
-
- PeerAddr Remote host address <hostname>[:<port>]
- PeerPort Remote port or service <service>[(<no>)] | <no>
- LocalAddr Local host bind address hostname[:port]
- LocalPort Local host bind port <service>[(<no>)] | <no>
- Proto Protocol name (or number) "tcp" | "udp" | ...
- Type Socket type SOCK_STREAM | SOCK_DGRAM | ...
- Listen Queue size for listen
- Reuse Set SO_REUSEADDR before binding
- Timeout Timeout value for various operations
-
-
-If C<Listen> is defined then a listen socket is created, else if the
-socket type, which is derived from the protocol, is SOCK_STREAM then
-connect() is called.
-
-The C<PeerAddr> can be a hostname or the IP-address on the
-"xx.xx.xx.xx" form. The C<PeerPort> can be a number or a symbolic
-service name. The service name might be followed by a number in
-parenthesis which is used if the service is not known by the system.
-The C<PeerPort> specification can also be embedded in the C<PeerAddr>
-by preceding it with a ":".
-
-If C<Proto> is not given and you specify a symbolic C<PeerPort> port,
-then the constructor will try to derive C<Proto> from the service
-name. As a last resort C<Proto> "tcp" is assumed. The C<Type>
-parameter will be deduced from C<Proto> if not specified.
+=head1 NAME
-If the constructor is only passed a single argument, it is assumed to
-be a C<PeerAddr> specification.
+IO::Socket - Object interface to socket communications
-Examples:
+=head1 SYNOPSIS
- $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org',
- PeerPort => 'http(80)',
- Proto => 'tcp');
+ use IO::Socket;
- $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)');
+=head1 DESCRIPTION
- $sock = IO::Socket::INET->new(Listen => 5,
- LocalAddr => 'localhost',
- LocalPort => 9000,
- Proto => 'tcp');
+C<IO::Socket> provides an object interface to creating and using sockets. It
+is built upon the L<IO::Handle> interface and inherits all the methods defined
+by L<IO::Handle>.
- $sock = IO::Socket::INET->new('127.0.0.1:25');
+C<IO::Socket> only defines methods for those operations which are common to all
+types of socket. Operations which are specified to a socket in a particular
+domain have methods defined in sub classes of C<IO::Socket>
+C<IO::Socket> will export all functions (and constants) defined by L<Socket>.
-=head2 METHODS
+=head1 CONSTRUCTOR
=over 4
-=item sockaddr ()
-
-Return the address part of the sockaddr structure for the socket
-
-=item sockport ()
-
-Return the port number that the socket is using on the local host
-
-=item sockhost ()
-
-Return the address part of the sockaddr structure for the socket in a
-text form xx.xx.xx.xx
-
-=item peeraddr ()
-
-Return the address part of the sockaddr structure for the socket on
-the peer host
+=item new ( [ARGS] )
-=item peerport ()
+Creates an C<IO::Socket>, which is a reference to a
+newly created symbol (see the C<Symbol> package). C<new>
+optionally takes arguments, these arguments are in key-value pairs.
+C<new> only looks for one key C<Domain> which tells new which domain
+the socket will be in. All other arguments will be passed to the
+configuration method of the package for that domain, See below.
-Return the port number for the socket on the peer host.
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
-=item peerhost ()
+As of VERSION 1.18 all IO::Socket objects have autoflush turned on
+by default. This was not the case with earlier releases.
-Return the address part of the sockaddr structure for the socket on the
-peer host in a text form xx.xx.xx.xx
+ NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE
=back
-=cut
-
-sub new
-{
- my $class = shift;
- unshift(@_, "PeerAddr") if @_ == 1;
- return $class->SUPER::new(@_);
-}
-
-sub _sock_info {
- my($addr,$port,$proto) = @_;
- my @proto = ();
- my @serv = ();
-
- $port = $1
- if(defined $addr && $addr =~ s,:([\w\(\)/]+)$,,);
-
- if(defined $proto) {
- @proto = $proto =~ m,\D, ? getprotobyname($proto)
- : getprotobynumber($proto);
-
- $proto = $proto[2] || undef;
- }
-
- if(defined $port) {
- $port =~ s,\((\d+)\)$,,;
-
- my $defport = $1 || undef;
- my $pnum = ($port =~ m,^(\d+)$,)[0];
-
- @serv= getservbyname($port, $proto[0] || "")
- if($port =~ m,\D,);
-
- $port = $pnum || $serv[2] || $defport || undef;
-
- $proto = (getprotobyname($serv[3]))[2] || undef
- if @serv && !$proto;
- }
-
- return ($addr || undef,
- $port || undef,
- $proto || undef
- );
-}
-
-sub _error {
- my $fh = shift;
- $@ = join("",ref($fh),": ",@_);
- carp $@ if $^W;
- close($fh)
- if(defined fileno($fh));
- return undef;
-}
-
-sub configure {
- my($fh,$arg) = @_;
- my($lport,$rport,$laddr,$raddr,$proto,$type);
-
-
- ($laddr,$lport,$proto) = _sock_info($arg->{LocalAddr},
- $arg->{LocalPort},
- $arg->{Proto});
+=head1 METHODS
- $laddr = defined $laddr ? inet_aton($laddr)
- : INADDR_ANY;
+See L<perlfunc> for complete descriptions of each of the following
+supported C<IO::Socket> methods, which are just front ends for the
+corresponding built-in functions:
- return _error($fh,"Bad hostname '",$arg->{LocalAddr},"'")
- unless(defined $laddr);
+ socket
+ socketpair
+ bind
+ listen
+ accept
+ send
+ recv
+ peername (getpeername)
+ sockname (getsockname)
+ shutdown
- unless(exists $arg->{Listen}) {
- ($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
- $arg->{PeerPort},
- $proto);
- }
+Some methods take slightly different arguments to those defined in L<perlfunc>
+in attempt to make the interface more flexible. These are
- if(defined $raddr) {
- $raddr = inet_aton($raddr);
- return _error($fh,"Bad hostname '",$arg->{PeerAddr},"'")
- unless(defined $raddr);
- }
+=over 4
- $proto ||= (getprotobyname "tcp")[2];
- return _error($fh,'Cannot determine protocol')
- unless($proto);
+=item accept([PKG])
- my $pname = (getprotobynumber($proto))[0];
- $type = $arg->{Type} || $socket_type{$pname};
+perform the system call C<accept> on the socket and return a new
+object. The new object will be created in the same class as the listen
+socket, unless C<PKG> is specified. This object can be used to
+communicate with the client that was trying to connect.
- $fh->socket(AF_INET, $type, $proto) or
- return _error($fh,"$!");
+In a scalar context the new socket is returned, or undef upon
+failure. In a list context a two-element array is returned containing
+the new socket and the peer address; the list will be empty upon
+failure.
- if ($arg->{Reuse}) {
- $fh->sockopt(SO_REUSEADDR,1) or
- return _error($fh);
- }
+The timeout in the [PKG] can be specified as zero to effect a "poll",
+but you shouldn't do that because a new IO::Select object will be
+created behind the scenes just to do the single poll. This is
+horrendously inefficient. Use rather true select() with a zero
+timeout on the handle, or non-blocking IO.
- $fh->bind($lport || 0, $laddr) or
- return _error($fh,"$!");
+=item socketpair(DOMAIN, TYPE, PROTOCOL)
- if(exists $arg->{Listen}) {
- $fh->listen($arg->{Listen} || 5) or
- return _error($fh,"$!");
- }
- else {
- return _error($fh,'Cannot determine remote port')
- unless($rport || $type == SOCK_DGRAM || $type == SOCK_RAW);
+Call C<socketpair> and return a list of two sockets created, or an
+empty list on failure.
- if($type == SOCK_STREAM || defined $raddr) {
- return _error($fh,'Bad peer address')
- unless(defined $raddr);
+=back
- $fh->connect($rport,$raddr) or
- return _error($fh,"$!");
- }
- }
+Additional methods that are provided are:
- $fh;
-}
+=over 4
-sub sockaddr {
- @_ == 1 or croak 'usage: $fh->sockaddr()';
- my($fh) = @_;
- (sockaddr_in($fh->sockname))[1];
-}
+=item atmark
-sub sockport {
- @_ == 1 or croak 'usage: $fh->sockport()';
- my($fh) = @_;
- (sockaddr_in($fh->sockname))[0];
-}
+True if the socket is currently positioned at the urgent data mark,
+false otherwise.
-sub sockhost {
- @_ == 1 or croak 'usage: $fh->sockhost()';
- my($fh) = @_;
- inet_ntoa($fh->sockaddr);
-}
+ use IO::Socket;
-sub peeraddr {
- @_ == 1 or croak 'usage: $fh->peeraddr()';
- my($fh) = @_;
- (sockaddr_in($fh->peername))[1];
-}
+ my $sock = IO::Socket::INET->new('some_server');
+ $sock->read(1024,$data) until $sock->atmark;
-sub peerport {
- @_ == 1 or croak 'usage: $fh->peerport()';
- my($fh) = @_;
- (sockaddr_in($fh->peername))[0];
-}
+Note: this is a reasonably new addition to the family of socket
+functions, so all systems may not support this yet. If it is
+unsupported by the system, an attempt to use this method will
+abort the program.
-sub peerhost {
- @_ == 1 or croak 'usage: $fh->peerhost()';
- my($fh) = @_;
- inet_ntoa($fh->peeraddr);
-}
+The atmark() functionality is also exportable as sockatmark() function:
-##
-## AF_UNIX
-##
+ use IO::Socket 'sockatmark';
-package IO::Socket::UNIX;
+This allows for a more traditional use of sockatmark() as a procedural
+socket function. If your system does not support sockatmark(), the
+C<use> declaration will fail at compile time.
-use strict;
-use vars qw(@ISA $VERSION);
-use Socket;
-use Carp;
-use Exporter;
+=item connected
-@ISA = qw(IO::Socket);
+If the socket is in a connected state the peer address is returned.
+If the socket is not in a connected state then undef will be returned.
-IO::Socket::UNIX->register_domain( AF_UNIX );
+=item protocol
-=head2 IO::Socket::UNIX
+Returns the numerical number for the protocol being used on the socket, if
+known. If the protocol is unknown, as with an AF_UNIX socket, zero
+is returned.
-C<IO::Socket::UNIX> provides a constructor to create an AF_UNIX domain socket
-and some related methods. The constructor can take the following options
+=item sockdomain
- Type Type of socket (eg SOCK_STREAM or SOCK_DGRAM)
- Local Path to local fifo
- Peer Path to peer fifo
- Listen Create a listen socket
+Returns the numerical number for the socket domain type. For example, for
+an AF_INET socket the value of &AF_INET will be returned.
-=head2 METHODS
+=item sockopt(OPT [, VAL])
-=over 4
+Unified method to both set and get options in the SOL_SOCKET level. If called
+with one argument then getsockopt is called, otherwise setsockopt is called.
-=item hostpath()
+=item socktype
-Returns the pathname to the fifo at the local end
+Returns the numerical number for the socket type. For example, for
+a SOCK_STREAM socket the value of &SOCK_STREAM will be returned.
-=item peerpath()
+=item timeout([VAL])
-Returns the pathanme to the fifo at the peer end
+Set or get the timeout value associated with this socket. If called without
+any arguments then the current setting is returned. If called with an argument
+the current setting is changed and the previous value returned.
=back
-=cut
-
-sub configure {
- my($fh,$arg) = @_;
- my($bport,$cport);
-
- my $type = $arg->{Type} || SOCK_STREAM;
-
- $fh->socket(AF_UNIX, $type, 0) or
- return undef;
-
- if(exists $arg->{Local}) {
- my $addr = sockaddr_un($arg->{Local});
- $fh->bind($addr) or
- return undef;
- }
- if(exists $arg->{Listen}) {
- $fh->listen($arg->{Listen} || 5) or
- return undef;
- }
- elsif(exists $arg->{Peer}) {
- my $addr = sockaddr_un($arg->{Peer});
- $fh->connect($addr) or
- return undef;
- }
-
- $fh;
-}
-
-sub hostpath {
- @_ == 1 or croak 'usage: $fh->hostpath()';
- my $n = $_[0]->sockname || return undef;
- (sockaddr_un($n))[0];
-}
-
-sub peerpath {
- @_ == 1 or croak 'usage: $fh->peerpath()';
- my $n = $_[0]->peername || return undef;
- (sockaddr_un($n))[0];
-}
-
=head1 SEE ALSO
-L<Socket>, L<IO::Handle>
+L<Socket>, L<IO::Handle>, L<IO::Socket::INET>, L<IO::Socket::UNIX>
=head1 AUTHOR
-Graham Barr E<lt>F<Graham.Barr@tiuk.ti.com>E<gt>
+Graham Barr. atmark() by Lincoln Stein. Currently maintained by the
+Perl Porters. Please report all bugs to <perl5-porters@perl.org>.
=head1 COPYRIGHT
-Copyright (c) 1996 Graham Barr. All rights reserved. This program is free
-software; you can redistribute it and/or modify it under the same terms
-as Perl itself.
+Copyright (c) 1997-8 Graham Barr <gbarr@pobox.com>. All rights reserved.
+This program is free software; you can redistribute it and/or
+modify it under the same terms as Perl itself.
-=cut
+The atmark() implementation: Copyright 2001, Lincoln Stein <lstein@cshl.org>.
+This module is distributed under the same terms as Perl itself.
+Feel free to use, modify and redistribute it as long as you retain
+the correct attribution.
-1; # Keep require happy
+=cut
projects / p5sagit/p5-mst-13.2.git / blobdiff