LWP::Socket - TCP/IP socket interface

LWP-attic documentation Contained in the LWP-attic distribution.

Index

Code Index:

NAME

Top

LWP::Socket - TCP/IP socket interface

SYNOPSIS

Top

 $socket = new LWP::Socket;
 $socket->connect('localhost', 7); # echo
 $quote = 'I dunno, I dream in Perl sometimes...';
 $socket->write("$quote\n");
 $socket->read_until("\n", \$buffer);
 $socket->read(\$buffer);
 $socket = undef;  # close

DESCRIPTION

Top

Beware: New code should not use this module. The IO::Socket::INET module provide the standard Perl interface to OO Internet sockets. Even LWP is now rewritten to use IO::Socket::INET throughout.

This class implements TCP/IP sockets. It groups socket generation, TCP address manipulation and buffered reading. Errors are handled by dying (throws exceptions).

Running this module standalone executes a self test which requires localhost to serve chargen and echo protocols.

The following methods are available:

$sock = new LWP::Socket()

Constructs a new socket object.

$sock->connect($host, $port)

Connect the socket to given host and port.

$sock->shutdown()

Shuts down the connection.

$sock->bind($host, $port)

Binds a name to the socket.

$sock->listen($queuesize)

Set up listen queue for socket.

$sock->accept($timeout)

Accepts a new connection. Returns a new LWP::Socket object if successful. Timeout not implemented yet.

$sock->getsockname()

Returns a 2 element array ($host, $port)

$sock->read_until($delim, $data_ref, $size, $timeout)

Reads data from the socket, up to a delimiter specified by a regular expression. If $delim is undefined all data is read. If $size is defined, data will be read internally in chunks of $size bytes. This does not mean that we will return the data when size bytes are read.

Note that $delim is discarded from the data returned.

$sock->read($bufref, [$size, $timeout])

Reads data of the socket. Not more than $size bytes. Might return less if the data is available. Dies on timeout.

$sock->pushback($data)

Put data back into the socket. Data will returned next time you read(). Can be used if you find out that you have read too much.

$sock->write($data, [$timeout])

Write data to socket. The $data argument might be a scalar or code.

If data is a reference to a subroutine, then we will call this routine to obtain the data to be written. The routine will be called until it returns undef or empty data. Data might be returned from the callback as a scalar or as a reference to a scalar.

Write returns the number of bytes written to the socket.

$sock->_getaddress($h, $p)

Given a host and a port, it will return the address (sockaddr_in) suitable as the name argument for connect() or bind(). Might return several addresses in array context if the hostname is bound to several IP addresses.

SELF TEST

Top

This self test is only executed when this file is run standalone. It tests its functions against some standard TCP services implemented by inetd. If you do not have them around the tests will fail.

LWP-attic documentation Contained in the LWP-attic distribution. 
# $Id: Socket.pm,v 1.24 1998/01/26 11:12:01 aas Exp $

package LWP::Socket;



$VERSION = sprintf("%d.%02d", q$Revision: 1.24 $ =~ /(\d+)\.(\d+)/);
sub Version { $VERSION; }

use Socket qw(pack_sockaddr_in unpack_sockaddr_in
	      PF_INET SOCK_STREAM INADDR_ANY
	      inet_ntoa inet_aton);
Socket->require_version(1.5);

use Carp ();
use Symbol qw(gensym);

use LWP::Debug ();
use LWP::IO ();

my $tcp_proto = (getprotobyname('tcp'))[2];



sub new
{
    my($class, $socket, $host, $port) = @_;

    unless ($socket) {
	$socket = gensym();
	LWP::Debug::debug("Socket $socket");

	socket($socket, PF_INET, SOCK_STREAM, $tcp_proto) or
	  Carp::croak("socket: $!");
    }

    my $self = bless {
	'socket' => $socket,
	'host'   => $host,
	'port'   => $port,
	'buffer' => '',
	'size'   => 4096,
    }, $class;

    $self;
}

sub DESTROY
{
    my $socket = shift->{'socket'};
    close($socket);
}

sub host { shift->{'host'}; }
sub port { shift->{'port'}; }



sub connect
{
    my($self, $host, $port) = @_;
    Carp::croak("no host") unless defined $host && length $host;
    Carp::croak("no port") unless defined $port && $port > 0;

    LWP::Debug::trace("($host, $port)");

    $self->{'host'} = $host;
    $self->{'port'} = $port;

    my @addr = $self->_getaddress($host, $port);
    Carp::croak("Can't resolv address for $host")
      unless @addr;

    LWP::Debug::debug("Connecting to host '$host' on port '$port'...");
    for (@addr) {
	connect($self->{'socket'}, $_) and return;
    }
    Carp::croak("Could not connect to $host:$port");
}



sub shutdown
{
    my($self, $how) = @_;
    $how = 2 unless defined $how;
    shutdown($self->{'socket'}, $how);
    delete $self->{'host'};
    delete $self->{'port'};
}



sub bind
{
    my($self, $host, $port) = @_;
    my $name = $self->_getaddress($host, $port);
    bind($self->{'socket'}, $name);
}



sub listen
{
    listen(shift->{'socket'}, @_);
}



sub accept
{
    my $self = shift;
    my $timeout = shift;
    my $ns = gensym();
    my $addr = accept($ns, $self->{'socket'});
    if ($addr) {
	my($port, $addr) = unpack_sockaddr_in($addr);
	return new LWP::Socket $ns, inet_ntoa($addr), $port;
    } else {
	Carp::croak("Can't accept: $!");
    }
}



sub getsockname
{
    my($port, $addr) = unpack_sockaddr_in(getsockname(shift->{'socket'}));
    (inet_ntoa($addr), $port);
}



sub read_until
{
    my ($self, $delim, $data_ref, $size, $timeout) = @_;

    {
	my $d = $delim;
	$d =~ s/\r/\\r/g;
	$d =~ s/\n/\\n/g;
	LWP::Debug::trace("('$d',...)");
    }

    my $socket = $self->{'socket'};
    $delim = '' unless defined $delim;
    $size ||= $self->{'size'};

    my $buf = \$self->{'buffer'};

    if (length $delim) {
	while ($$buf !~ /$delim/) {
	    LWP::IO::read($socket, $$buf, $size, length($$buf), $timeout)
		or die "Unexpected EOF";
	}
	($$data_ref, $self->{'buffer'}) = split(/$delim/, $$buf, 2);
    } else {
	$data_ref = $buf;
	$self->{'buffer'} = '';
    }

    1;
}



sub read
{
    my($self, $data_ref, $size, $timeout) = @_;
    $size ||= $self->{'size'};

    LWP::Debug::trace('(...)');
    if (length $self->{'buffer'}) {
	# return data from buffer until it is empty
	#print "Returning data from buffer...$self->{'buffer'}\n";
	$$data_ref = substr($self->{'buffer'}, 0, $size);
	substr($self->{'buffer'}, 0, $size) = '';
	return length $$data_ref;
    }
    LWP::IO::read($self->{'socket'}, $$data_ref, $size, undef, $timeout);
}



sub pushback
{
    LWP::Debug::trace('(' . length($_[1]) . ' bytes)');
    my $self = shift;
    substr($self->{'buffer'}, 0, 0) = shift;
}



sub write
{
    my $self = shift;
    my $timeout = $_[1];  # we don't want to copy data in $_[0]
    LWP::Debug::trace('()');
    my $bytes_written = 0;
    if (!ref $_[0]) {
	$bytes_written = LWP::IO::write($self->{'socket'}, $_[0], $timeout);
    } elsif (ref($_[0]) eq 'CODE') {
	# write data until $callback returns empty data '';
	my $callback = shift;
	while (1) {
	    my $data = &$callback;
	    last unless defined $data;
	    my $dataRef = ref($data) ? $data : \$data;
	    my $len = length $$dataRef;
	    last unless $len;
	    my $n = $self->write($$dataRef, $timeout);
	    $bytes_written += $n;
	    last if $n != $len;
	}
    } else {
	Carp::croak('Illegal LWP::Socket->write() argument');
    }
    $bytes_written;
}





sub _getaddress
{
    my($self, $host, $port) = @_;

    my(@addr);
    if (!defined $host) {
	# INADDR_ANY
	$addr[0] = pack_sockaddr_in($port, INADDR_ANY);
    }
    elsif ($host =~ /^(\d+\.\d+\.\d+\.\d+)$/) {
	# numeric IP address
	$addr[0] = pack_sockaddr_in($port, inet_aton($1));
    } else {
	# hostname
	LWP::Debug::debug("resolving host '$host'...");
	(undef,undef,undef,undef,@addr) = gethostbyname($host);
	for (@addr) {
	    LWP::Debug::debug("   ..." . inet_ntoa($_));
	    $_ = pack_sockaddr_in($port, $_);
	}
    }
    wantarray ? @addr : $addr[0];
}


#####################################################################

package main;

eval join('',<DATA>) || die $@ unless caller();


1;

__END__

LWP::Debug::level('+');

&chargen;
&echo;
print "Socket.pm $LWP::Socket::VERSION ok\n";

sub chargen
{
    my $socket = new LWP::Socket;
    $socket->connect('localhost', 19); # chargen
    $socket->read_until('A', \$buffer, 8);

    die 'Read Error' unless $buffer eq ' !"#$%&\'()*+,-./0123456789:;<=>?@';
    $socket->read_until('Z', \$buffer, 8);
    die 'Read Error' unless $buffer eq 'BCDEFGHIJKLMNOPQRSTUVWXY';
}

sub echo
{
    $socket = new LWP::Socket;
    $socket->connect('localhost', 7); # echo
    $quote = 'I dunno, I dream in Perl sometimes...';
	     # --Larry Wall in  <8538@jpl-devvax.JPL.NASA.GOV>
    $socket->write("$quote\n");
    $socket->read_until("\n", \$buffer);
    die 'Read Error' unless $buffer eq $quote;
}