socket.pm

perl 解释器

=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);

IO::Socket::INET->register_domain( AF_INET );

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.

If the constructor is only passed a single argument, it is assumed to
be a C<PeerAddr> specification.

Examples:

   $sock = IO::Socket::INET->new(PeerAddr => 'www.perl.org',
                                 PeerPort => 'http(80)',
                                 Proto    => 'tcp');

   $sock = IO::Socket::INET->new(PeerAddr => 'localhost:smtp(25)');

   $sock = IO::Socket::INET->new(Listen    => 5,
                                 LocalAddr => 'localhost',
                                 LocalPort => 9000,
                                 Proto     => 'tcp');

   $sock = IO::Socket::INET->new('127.0.0.1:25');


=head2 METHODS

=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 peerport ()

Return the port number for the socket on the peer host.

=item peerhost ()

Return the address part of the sockaddr structure for the socket on the
peer host in a text form xx.xx.xx.xx

=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});

    $laddr = defined $laddr ? inet_aton($laddr)
			    : INADDR_ANY;

    return _error($fh,"Bad hostname '",$arg->{LocalAddr},"'")
	unless(defined $laddr);

    unless(exists $arg->{Listen}) {
	($raddr,$rport,$proto) = _sock_info($arg->{PeerAddr},
					    $arg->{PeerPort},
					    $proto);
    }

    if(defined $raddr) {
	$raddr = inet_aton($raddr);
	return _error($fh,"Bad hostname '",$arg->{PeerAddr},"'")
		unless(defined $raddr);
    }

    $proto ||= (getprotobyname "tcp")[2];
    return _error($fh,'Cannot determine protocol')
	unless($proto);

    my $pname = (getprotobynumber($proto))[0];
    $type = $arg->{Type} || $socket_type{$pname};

    $fh->socket(AF_INET, $type, $proto) or
	return _error($fh,"$!");

    if ($arg->{Reuse}) {
	$fh->sockopt(SO_REUSEADDR,1) or
		return _error($fh);
    }

    $fh->bind($lport || 0, $laddr) or
	return _error($fh,"$!");

    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);

	if($type == SOCK_STREAM || defined $raddr) {
	    return _error($fh,'Bad peer address')
	    	unless(defined $raddr);

	    $fh->connect($rport,$raddr) or
		return _error($fh,"$!");
	}
    }

    $fh;
}

sub sockaddr {
    @_ == 1 or croak 'usage: $fh->sockaddr()';
    my($fh) = @_;
    (sockaddr_in($fh->sockname))[1];
}

sub sockport {
    @_ == 1 or croak 'usage: $fh->sockport()';
    my($fh) = @_;
    (sockaddr_in($fh->sockname))[0];
}

sub sockhost {
    @_ == 1 or croak 'usage: $fh->sockhost()';
    my($fh) = @_;
    inet_ntoa($fh->sockaddr);
}

sub peeraddr {
    @_ == 1 or croak 'usage: $fh->peeraddr()';
    my($fh) = @_;
    (sockaddr_in($fh->peername))[1];
}

sub peerport {
    @_ == 1 or croak 'usage: $fh->peerport()';
    my($fh) = @_;
    (sockaddr_in($fh->peername))[0];
}

sub peerhost {
    @_ == 1 or croak 'usage: $fh->peerhost()';
    my($fh) = @_;
    inet_ntoa($fh->peeraddr);
}

##
## AF_UNIX
##

package IO::Socket::UNIX;

use strict;
use vars qw(@ISA $VERSION);
use Socket;
use Carp;
use Exporter;

@ISA = qw(IO::Socket);

IO::Socket::UNIX->register_domain( AF_UNIX );

=head2 IO::Socket::UNIX

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

    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

=head2 METHODS

=over 4

=item hostpath()

Returns the pathname to the fifo at the local end

=item peerpath()

Returns the pathanme to the fifo at the peer end

=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>

=head1 AUTHOR

Graham Barr E<lt>F<[e-mail]>E<gt>

=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.

=cut

1; # Keep require happy