750 lines
23 KiB
Perl
750 lines
23 KiB
Perl
# ====================================================================
|
|
# Gossamer Threads Module Library - http://gossamer-threads.com/
|
|
#
|
|
# GT::Socket::Client
|
|
# Author: Jason Rhinelander
|
|
# CVS Info :
|
|
# $Id: Client.pm,v 1.15 2004/02/17 01:33:07 jagerman Exp $
|
|
#
|
|
# Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
# ====================================================================
|
|
#
|
|
# Description:
|
|
# Client socket module that handles TCP client functionality, including
|
|
# SSL capabilities (via GT::Socket::Client::SSLHandle and Net::SSLeay).
|
|
#
|
|
|
|
# Perl 5.004 doesn't like: $$$self{foo} mixed with a tied filehandle (as used
|
|
# by the SSL capabilities) - it confuses Perl into thinking we have a tied
|
|
# scalar. Unfortunately, this means the rather more ugly ${*$self}{foo} syntax
|
|
# has to be used instead.
|
|
|
|
package GT::Socket::Client;
|
|
use strict;
|
|
use vars qw/$ERROR @ISA $MAX_READALL @EXPORT_OK %EXPORT_TAGS $CR $LF $CRLF $VERSION/;
|
|
use Carp;
|
|
use Net::servent;
|
|
use Socket;
|
|
use POSIX qw/:fcntl_h EINTR EAGAIN EWOULDBLOCK BUFSIZ/;
|
|
require Exporter;
|
|
@ISA = 'Exporter';
|
|
use constants
|
|
CR => "\015",
|
|
LF => "\012",
|
|
CRLF => "\015\012",
|
|
LINE_SAFETY => 100_000,
|
|
READALL_MAX => 20 * 1024 * 1024; # Default 20 MB max, but you can pass something larger to readall()
|
|
|
|
$CR = CR; $LF = LF; $CRLF = CRLF;
|
|
@EXPORT_OK = qw/CR LF CRLF $CR $LF $CRLF/;
|
|
%EXPORT_TAGS = (
|
|
crlf => [qw/CR LF CRLF $CR $LF $CRLF/]
|
|
);
|
|
$VERSION = sprintf "%d.%03d", q$Revision: 1.15 $ =~ /(\d+)\.(\d+)/;
|
|
|
|
sub open {
|
|
my $class = ref($_[0]) || $_[0]; shift;
|
|
|
|
my $self = \do { local *GLOB; *GLOB };
|
|
|
|
if (!@_ or @_ % 2) {
|
|
croak('Invalid options: Usage: ' . __PACKAGE__ . '->new(HASH)');
|
|
}
|
|
my %opts = @_;
|
|
|
|
$opts{host} or croak 'No host entered';
|
|
$opts{port} or croak 'No port entered';
|
|
|
|
if ($opts{port} =~ /\D/) { # Port is a name such as 'ftp' - get the port number
|
|
my $serv = getservbyname($opts{port});
|
|
if (!$serv) {
|
|
$ERROR = "Invalid port entered: $opts{port}";
|
|
carp $ERROR if $opts{debug};
|
|
return undef;
|
|
}
|
|
$opts{port} = $serv->port;
|
|
}
|
|
|
|
my $iaddr = inet_aton($opts{host});
|
|
if (!$iaddr) {
|
|
$ERROR = "Unresolvable host entered: $opts{host}";
|
|
carp $ERROR if $opts{debug};
|
|
return undef;
|
|
}
|
|
my $paddr = pack_sockaddr_in($opts{port}, $iaddr);
|
|
|
|
not $opts{timeout} or $opts{timeout} > 0 or croak "Invalid timeout specified";
|
|
|
|
my $use_alarm;
|
|
if ($opts{timeout} and $^O ne 'MSWin32') { # Perl on Win32 doesn't support alarm
|
|
require Config;
|
|
$use_alarm = !!$Config::Config{d_alarm};
|
|
}
|
|
|
|
unless (socket($self, PF_INET, SOCK_STREAM, scalar getprotobyname('tcp'))) {
|
|
$ERROR = "Socket error: $!";
|
|
carp $ERROR if $opts{debug};
|
|
return undef;
|
|
}
|
|
|
|
my ($connected, $timeout);
|
|
if ($use_alarm) { # This OS supports alarm
|
|
local $SIG{__DIE__};
|
|
local $SIG{ALRM} = sub { $timeout = 1; die "timeout\n" };
|
|
|
|
alarm($opts{timeout});
|
|
|
|
eval { $connected = connect($self, $paddr) };
|
|
|
|
alarm(0);
|
|
}
|
|
else {
|
|
$connected = connect($self, $paddr);
|
|
}
|
|
unless ($connected) {
|
|
if ($timeout) {
|
|
$ERROR = "Unable to connect: Connection timed out";
|
|
}
|
|
else {
|
|
$ERROR = "Unable to connect: $!";
|
|
}
|
|
carp $ERROR if $opts{debug};
|
|
return undef;
|
|
}
|
|
|
|
${*$self}{timeout} = $opts{timeout};
|
|
|
|
if ($opts{ssl}) {
|
|
require GT::Socket::Client::SSLHandle;
|
|
my $sock = $self;
|
|
$self = \do { local *SSL; *SSL };
|
|
tie *$self, "GT::Socket::Client::SSLHandle", \*$sock;
|
|
%{*$self} = %{*$sock}; # Copy the hash options
|
|
${*$self}{ssl} = 1; # Keep track of this being an SSL socket
|
|
bless $self, $class;
|
|
}
|
|
else {
|
|
bless $self, $class;
|
|
}
|
|
|
|
if (not exists $opts{autoflush} or $opts{autoflush}) {
|
|
select((select($self), $|++)[0]);
|
|
${*$self}{autoflush} = 1;
|
|
}
|
|
if ($opts{non_blocking}) {
|
|
${*$self}{ssl} and croak "Unable to use non_blocking with ssl sockets";
|
|
$self->_non_blocking;
|
|
}
|
|
|
|
${*$self}{host} = $opts{host};
|
|
${*$self}{iaddr} = $iaddr;
|
|
${*$self}{port} = $opts{port};
|
|
${*$self}{debug} = $opts{debug};
|
|
${*$self}{eol} = LF; # Set the default EOL, for ->readline()
|
|
|
|
if (${*$self}{non_blocking}) {
|
|
my %default = (read_wait => 5, select_time => 0.05, read_size => BUFSIZ);
|
|
# These options do nothing on blocking GT::Socket::Client objects:
|
|
for (qw/read_wait select_time read_size/) {
|
|
if (exists $opts{$_}) {
|
|
$self->$_($opts{$_});
|
|
}
|
|
else {
|
|
${*$self}{$_} = $default{$_};
|
|
}
|
|
}
|
|
}
|
|
|
|
$self;
|
|
}
|
|
|
|
sub _non_blocking {
|
|
$ERROR = undef;
|
|
my $self = shift;
|
|
|
|
if ($] >= 5.006) {
|
|
# Using IO::Handle is much easier for 5.6.x and above; previous
|
|
# versions need the two (Windows/non-Windows) code below.
|
|
require IO::Handle;
|
|
$self->IO::Handle::blocking(0);
|
|
}
|
|
else {
|
|
if ($^O eq 'MSWin32') {
|
|
# 126 is FIONBIO (some docs say 0x7F << 16)
|
|
ioctl(
|
|
$self,
|
|
0x80000000 | (4 << 16) | (ord('f') << 8) | 126,
|
|
1
|
|
) or die "ioctl: $^E";
|
|
}
|
|
else {
|
|
my $flags = fcntl($self, F_GETFL, 0) or die "getfl: $!";
|
|
$flags |= O_NONBLOCK;
|
|
fcntl($self, F_SETFL, $flags) or die "setfl: $!";
|
|
}
|
|
}
|
|
|
|
${*$self}{non_blocking} = 1;
|
|
|
|
return 1;
|
|
}
|
|
|
|
sub eol {
|
|
$ERROR = undef;
|
|
my $self = shift;
|
|
if (@_) {
|
|
${*$self}{eol} = shift;
|
|
defined ${*$self}{eol} and length ${*$self}{eol} or croak "No valid EOL character entered";
|
|
return 1;
|
|
}
|
|
return ${*$self}{eol};
|
|
}
|
|
|
|
sub readline {
|
|
$ERROR = undef;
|
|
my $self = shift;
|
|
if (not ${*$self}{non_blocking} or ${*$self}{ssl}) {
|
|
local $/ = ${*$self}{eol};
|
|
$_[0] = <$self>;
|
|
}
|
|
else {
|
|
$_[0] = '';
|
|
require POSIX;
|
|
local $!;
|
|
vec(my $rin = '', fileno($self), 1) = 1;
|
|
local $SIG{PIPE} = 'IGNORE';
|
|
my $safety;
|
|
|
|
my $select_time = ${*$self}{select_time};
|
|
while () {
|
|
if ($safety++ >= LINE_SAFETY) {
|
|
$ERROR = 'Line reads exceeded safety line cutoff (' . LINE_SAFETY . ')';
|
|
carp $ERROR if ${*$self}{debug};
|
|
return undef;
|
|
}
|
|
my $nfound;
|
|
my $rout = $rin;
|
|
do {
|
|
$! = 0;
|
|
$nfound = select($rout, undef, undef, $select_time);
|
|
} while $! == EINTR;
|
|
if ($nfound > 0) {
|
|
my $ret = sysread($self, my $buff, 1);
|
|
unless ($ret) {
|
|
next if $! == EAGAIN or $! == EWOULDBLOCK;
|
|
|
|
$ERROR = "Unable to read from socket: $!. Read: $_[0]";
|
|
carp $ERROR if ${*$self}{debug};
|
|
return undef;
|
|
}
|
|
$_[0] .= $buff;
|
|
last if length($_[0]) >= length(${*$self}{eol}) and
|
|
rindex($_[0], ${*$self}{eol}) == (length($_[0]) - length(${*$self}{eol}))
|
|
}
|
|
elsif ($nfound < 0) {
|
|
$ERROR = "Socket error: $!";
|
|
carp $ERROR if ${*$self}{debug};
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
return 1;
|
|
}
|
|
|
|
sub select_time {
|
|
$ERROR = undef;
|
|
my $self = shift;
|
|
if (@_) {
|
|
my $select_time = shift;
|
|
unless ($select_time > 0) {
|
|
croak 'Usage: $obj->select_time(SELECT_TIME)';
|
|
}
|
|
${*$self}{select_time} = $select_time;
|
|
return 1;
|
|
}
|
|
|
|
return ${*$self}{select_time};
|
|
}
|
|
|
|
sub read_wait {
|
|
$ERROR = undef;
|
|
my $self = shift;
|
|
if (@_) {
|
|
my $read_wait = shift;
|
|
unless ($read_wait eq '0' or $read_wait > 0) {
|
|
croak 'Usage: $obj->read_wait(READ_WAIT)';
|
|
}
|
|
${*$self}{read_wait} = $read_wait;
|
|
return 1;
|
|
}
|
|
|
|
return ${*$self}{read_wait};
|
|
}
|
|
|
|
sub read_size {
|
|
$ERROR = undef;
|
|
my $self = shift;
|
|
if (@_) {
|
|
my $read_size = shift;
|
|
unless ($read_size >= 1) {
|
|
croak 'Usage: $obj->read_size(READ_SIZE)';
|
|
}
|
|
${*$self}{read_size} = $read_size;
|
|
return 1;
|
|
}
|
|
|
|
return ${*$self}{read_size};
|
|
}
|
|
|
|
# Reads all (allowing for a timeout of read_wait, if non-blocking) data from the socket
|
|
sub readall {
|
|
my $self = shift;
|
|
$self->readblock($_[0], -1);
|
|
}
|
|
|
|
sub readblock {
|
|
$ERROR = undef;
|
|
my $self = shift;
|
|
$_[0] = '';
|
|
my $read_wait = ${*$self}{read_wait};
|
|
my $select_time = ${*$self}{select_time};
|
|
|
|
my $max_size = pop;
|
|
unless (@_ == 1 and int($max_size) != 0) {
|
|
croak 'Usage: $obj->readblock($scalar, BLOCK_SIZE)';
|
|
}
|
|
|
|
unless (fileno $self) {
|
|
$ERROR = "Socket closed";
|
|
carp $ERROR if ${*$self}{debug};
|
|
# Don't return undef - there could still be something waiting on the
|
|
# socket.
|
|
}
|
|
|
|
local $!;
|
|
|
|
if (not ${*$self}{non_blocking} or ${*$self}{ssl}) {
|
|
if ($max_size > 0) {
|
|
read($self, $_[0], $max_size);
|
|
}
|
|
else {
|
|
local $/;
|
|
$_[0] = <$self>;
|
|
}
|
|
if (not defined $_[0] and $!) {
|
|
$ERROR = "Blocking block read failed: $!";
|
|
carp $ERROR if ${*$self}{debug};
|
|
return undef unless length($_[0]);
|
|
}
|
|
}
|
|
else {
|
|
my $read_size = ${*$self}{read_size};
|
|
|
|
vec(my $rin = '', fileno($self), 1) = 1;
|
|
local $SIG{PIPE} = 'IGNORE';
|
|
my $try = 0;
|
|
|
|
while () {
|
|
my $nfound;
|
|
my $rout = $rin;
|
|
do {
|
|
$! = 0;
|
|
$nfound = select($rout, undef, undef, $select_time);
|
|
} while $! == EINTR;
|
|
if ($nfound > 0) {
|
|
my $read_size = $read_size;
|
|
if ($max_size > 0 and length($_[0]) + $read_size > $max_size) {
|
|
$read_size = $max_size - length($_[0]);
|
|
}
|
|
my $ret = sysread($self, my $buff, $read_size);
|
|
unless ($ret) {
|
|
if ($! == EAGAIN or $! == EWOULDBLOCK) {
|
|
if (++$try * $select_time > $read_wait) {
|
|
last;
|
|
}
|
|
}
|
|
elsif ($! == 0) {
|
|
$ERROR = "Connection closed";
|
|
carp $ERROR if ${*$self}{debug};
|
|
close $self;
|
|
length($_[0]) ? last : undef;
|
|
}
|
|
else {
|
|
$ERROR = "Socket error: $!";
|
|
carp $ERROR if ${*$self}{debug};
|
|
close $self;
|
|
return undef;
|
|
}
|
|
}
|
|
else {
|
|
$try = 0;
|
|
$_[0] .= $buff;
|
|
undef $buff;
|
|
last if $max_size > 0 and length($_[0]) >= $max_size;
|
|
}
|
|
}
|
|
elsif ($nfound < 0) {
|
|
$ERROR = "Socket error: $!";
|
|
carp $ERROR if ${*$self}{debug};
|
|
return undef;
|
|
}
|
|
elsif (++$try * $select_time > $read_wait) {
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
return length($_[0]);
|
|
}
|
|
|
|
sub readalluntil {
|
|
$ERROR = undef;
|
|
my $self = shift;
|
|
my $until = shift;
|
|
$until = [$until] unless ref $until;
|
|
@_ or croak 'Usage: $obj->readalluntil($string-or-\@strings, $scalar[, $scalar])';
|
|
|
|
my $initial;
|
|
$initial = pop if @_ > 1;
|
|
|
|
return $self->readblock($_[0], -1) if not ${*$self}{non_blocking} or ${*$self}{ssl};
|
|
|
|
$_[0] = '';
|
|
|
|
my $read_wait = ${*$self}{read_wait};
|
|
my $select_time = ${*$self}{select_time};
|
|
my $read_size = ${*$self}{read_size};
|
|
|
|
unless (fileno $self) {
|
|
$ERROR = "Socket closed";
|
|
carp $ERROR if ${*$self}{debug};
|
|
# Don't return undef - there could still be something waiting on the socket.
|
|
}
|
|
|
|
local $!;
|
|
|
|
vec(my $rin = '', fileno($self), 1) = 1;
|
|
local $SIG{PIPE} = 'IGNORE';
|
|
my ($try, $first) = (0);
|
|
|
|
UNTIL: while () {
|
|
my $nfound;
|
|
my $rout = $rin;
|
|
do {
|
|
$! = 0;
|
|
$nfound = select($rout, undef, undef, $select_time);
|
|
} while $! == EINTR;
|
|
if ($nfound > 0) {
|
|
my $ret = sysread($self, my $buff, $read_size);
|
|
unless ($ret) {
|
|
if ($! == EAGAIN or $! == EWOULDBLOCK) {
|
|
if (++$try * $select_time > $read_wait) {
|
|
last;
|
|
}
|
|
}
|
|
elsif ($! == 0) {
|
|
$ERROR = "Connection closed";
|
|
carp $ERROR if ${*$self}{debug};
|
|
close $self;
|
|
length($_[0]) ? last : undef;
|
|
}
|
|
else {
|
|
$ERROR = "Socket error: $!";
|
|
carp $ERROR if ${*$self}{debug};
|
|
close $self;
|
|
return undef;
|
|
}
|
|
}
|
|
else {
|
|
$try = 0;
|
|
$_[0] .= $buff;
|
|
undef $buff;
|
|
|
|
if (defined $initial and length($_[0]) >= length($initial) and not $first++) {
|
|
last if $_[0] eq $initial;
|
|
}
|
|
for (@$until) {
|
|
last UNTIL if rindex($_[0], $_) == length($_[0]) - length($_);
|
|
}
|
|
}
|
|
}
|
|
elsif ($nfound < 0) {
|
|
$ERROR = "Socket error: $!";
|
|
carp $ERROR if ${*$self}{debug};
|
|
return undef;
|
|
}
|
|
elsif (++$try * $select_time > $read_wait) {
|
|
last;
|
|
}
|
|
}
|
|
return length($_[0]);
|
|
}
|
|
|
|
sub write {
|
|
my ($self, $msg) = @_;
|
|
|
|
unless (fileno $self) {
|
|
$ERROR = "Socket closed";
|
|
carp $ERROR if ${*$self}{debug};
|
|
}
|
|
|
|
return unless defined $msg and length $msg;
|
|
if (not ${*$self}{non_blocking} or ${*$self}{ssl}) {
|
|
unless (print $self $msg) {
|
|
$ERROR = "print failed: $!";
|
|
carp $ERROR if ${*$self}{debug};
|
|
return undef;
|
|
}
|
|
}
|
|
else {
|
|
for (1 .. 10) { # Maximum 10 "EAGAIN" tries
|
|
my $rv = syswrite $self, $msg, length $msg;
|
|
if (!defined $rv and $! == EAGAIN) {
|
|
next;
|
|
}
|
|
elsif (!defined $rv or $rv != length $msg) {
|
|
$ERROR = "Could not write to socket: $!";
|
|
carp $ERROR if ${*$self}{debug};
|
|
return undef;
|
|
}
|
|
else {
|
|
last;
|
|
}
|
|
}
|
|
}
|
|
|
|
1;
|
|
}
|
|
|
|
# Returns the IP that we ended up connecting to.
|
|
# This is the value returned from Socket.pm's inet_aton function.
|
|
sub iaddr {
|
|
my $self = shift;
|
|
${*$self}{iaddr};
|
|
}
|
|
|
|
# This is the _numeric_ port that was connected to, regardless of whether or
|
|
# not you passed a number or string port.
|
|
sub port {
|
|
my $self = shift;
|
|
${*$self}{port};
|
|
}
|
|
|
|
sub error { $ERROR }
|
|
|
|
1;
|
|
|
|
__END__
|
|
|
|
=head1 NAME
|
|
|
|
GT::Socket::Client - Socket module designed for TCP clients
|
|
|
|
=head1 SYNOPSIS
|
|
|
|
use GT::Socket::Client qw/:crlf/;
|
|
|
|
my $socket = GT::Socket::Client->open(
|
|
host => "gossamer-threads.com",
|
|
port => "shell", # AKA port 514
|
|
timeout => 10
|
|
) or die GT::Socket::Client->error;
|
|
|
|
# $socket is now a socket connected to the host. Use
|
|
# it as you would use any socket.
|
|
$sock->readline(my $line);
|
|
print "Read this line from the socket: $line";
|
|
print $sock "That line" . CRLF;
|
|
|
|
$sock->readblock(my $block, 4096);
|
|
print "Read 4KB from the socket: $block";
|
|
print $sock "QUIT" . CRLF;
|
|
|
|
$sock->readall(my $all);
|
|
print "Everything else from the socket: $all";
|
|
print $sock "Something else" . CRLF;
|
|
|
|
|
|
=head1 DESCRIPTION
|
|
|
|
This module is a basic socket module that is designed to only handle basic
|
|
socket connection and simple read capabilities. Anything else that you want to
|
|
do with the socket is entirely up to you - this doesn't try to support
|
|
superfluous options that only a few connections will ever use, or options that
|
|
should be done in the code using this module instead of the module itself. See
|
|
the GT::WWW::http and GT::WWW::https modules for a good working example.
|
|
|
|
By default, GT::Socket::Client exports nothing, however it can export the LF,
|
|
CR, CRLF, $LF, $CR, and $CRLF constants, individually, or together via the
|
|
':crlf' export tag.
|
|
|
|
=head1 METHODS
|
|
|
|
=head2 open
|
|
|
|
Takes a hash (not hash reference) of socket options, as follows:
|
|
|
|
=over 4
|
|
|
|
=item host
|
|
|
|
[REQUIRED] The name or IP of the host to connect to.
|
|
|
|
=item port
|
|
|
|
[REQUIRED] The numeric value (25) or service name ("smtp") of the port to
|
|
connect to.
|
|
|
|
=item ssl
|
|
|
|
[OPTIONAL] If this option is provided, the connection will use SSL. Note that
|
|
this requires the Net::SSLeay module.
|
|
|
|
=item timeout
|
|
|
|
[OPTIONAL] A connection timeout period, in integral seconds. Note that this is
|
|
only supported on systems that support the alarm() function; on other systems
|
|
(such as Windows), this argument has no effect.
|
|
|
|
=item non_blocking
|
|
|
|
[OPTIONAL] Before returning it to you, the connected socket will be set up as
|
|
non-blocking if this option is enabled. Note that this option B<DOES NOT WORK>
|
|
with the ssl option, due to the Net::SSLeay interface.
|
|
|
|
=item autoflush
|
|
|
|
[OPTIONAL] Before returning to you, the connected socket will be made non-
|
|
buffering. If you want your socket to be buffered, pass in autoflush with a
|
|
false value.
|
|
|
|
=item ssl
|
|
|
|
[OPTIONAL] GT::Socket::Client has the ability to establish an SSL connection to
|
|
a server for protocols such as HTTPS, SMTPS, POP3S, IMAPS, etc. Note that it
|
|
currently has a limitation of not being able to change to or from an SSL
|
|
connection once the connection is established, for protocols like FTPS.
|
|
|
|
=item debug
|
|
|
|
[OPTIONAL] If debugging is enabled, internal warnings (such as invalid port,
|
|
unresolvable host, connection failure, etc.) will be warn()ed. This does not
|
|
affect the error() method, which will always be set to the error message when
|
|
a problem occurs. Provide a true value if you want the warn()s to appear.
|
|
|
|
=back
|
|
|
|
=head2 readline
|
|
|
|
This method reads a single line from the socket. It takes one argument, which
|
|
must be a scalar which will be set to the line read. See the eol() method,
|
|
which allows you to specify an EOL character other than "\012". Note that on a
|
|
blocking socket, this will block until it can read a full line (or the server
|
|
closes the connection). On a non-blocking socket, the amount of time it will
|
|
wait for input is dependent on the value of the read_wait() method.
|
|
|
|
1 is returned on success, undef on failure.
|
|
|
|
=head2 readblock
|
|
|
|
This method attempts to read a certain number of bytes from the server. This
|
|
takes two arguments: like readline(), the first argument is a scalar that will
|
|
be set to the data read. The second argument is the amount of data that may be
|
|
read. Note that on a blocking socket, this will block until the required
|
|
amount of data is read, or the socket is closed. On a non-blocking socket, this
|
|
will return once the requested amount of data is read, the socket closes, or
|
|
there is no input for C<read_wait> seconds (See L</read_wait>).
|
|
|
|
Note that a block size of -1 makes the socket read until the connection is
|
|
closed, in the case of blocking sockets, or until the read_wait() is hit.
|
|
|
|
The number of bytes read is returned on success, undef on failure.
|
|
|
|
=head2 readall
|
|
|
|
A synonym for C<$obj-E<gt>readblock($_[0], -1)> - in other words, it reads all
|
|
available data (waiting for up to C<read_wait> seconds, if non-blocking).
|
|
|
|
=head2 readalluntil
|
|
|
|
A useful function for non-blocking sockets (completely useless for blocking
|
|
sockets, on which it simply becomes a readall call). Basically, this works
|
|
like readall(), above, but it will terminate immediately if it encounters a
|
|
pattern that you provide on the end of the data read. Note that this does NOT
|
|
work as a delimiter, but is useful for protocols such as POP3 when you want to
|
|
read as much as you can, but know what should be at the end of what you read.
|
|
The sole advantage of this is that it allows you to avoid the read_wait timeout
|
|
that would otherwise be required at the end of a data stream.
|
|
|
|
It takes two arguments - the first is a string or array reference of strings
|
|
containing the trailing string data. The second is a scalar that will be set
|
|
to the data read. For example, for POP3 you might use: C<"\n.\r\n">. You can
|
|
optionally pass in a third argument, which is used during the first read - if
|
|
the result of the first read is equal to the string passed in, it's returned.
|
|
Using the POP3 example again, this might be C<".\r\n"> - to handle an empty
|
|
response.
|
|
|
|
=head2 select_time
|
|
|
|
[Non-blocking sockets only] This adjusts the number of seconds passed to
|
|
select() to poll the socket for available data. The default value is 0.05,
|
|
which should work in most situations.
|
|
|
|
=head2 read_wait
|
|
|
|
[Non-blocking sockets only] This method is used to set the wait time for reads.
|
|
On a local or very fast connection, this can be set to a low value (i.e. 0.1
|
|
seconds), but on a typical slower internet connection, longer wait times for
|
|
reading are usually necessary. Hence, the default is a wait time of 5 seconds.
|
|
In effect, an attempt to read all data will end after nothing has been received
|
|
for this many seconds.
|
|
|
|
=head2 write
|
|
|
|
Sends data to the server. Takes the data to send. This does The Right Thing
|
|
for either non-blocking or blocking sockets.
|
|
|
|
=head2 eol
|
|
|
|
This method takes one or more character, and uses it for the EOL character(s)
|
|
used by readline. If called without any argument, the EOL character for the
|
|
current object is returned.
|
|
|
|
=head2 error
|
|
|
|
If an error (such as connection, socket, etc.) occurs, you can access it via
|
|
the error() method. This can be called as either a class or instance method,
|
|
since open() return C<undef> instead of an object if the connection fails.
|
|
|
|
=head2 iaddr
|
|
|
|
Once a connection has been established, you can call this method to get the
|
|
iaddr value for the connection. This value is as returned by
|
|
L<Socket.pm|Socket>'s inet_aton function.
|
|
|
|
=head2 port
|
|
|
|
Once a connection has been established, this method can be used to determine
|
|
the port connected to. Note that this is not necessarily the same as the value
|
|
of the C<port> option passed to open() - the return value of this function will
|
|
always be numeric (e.g. C<25>), even if a service name (e.g. C<"smtp">) was
|
|
passed to open().
|
|
|
|
=head1 SEE ALSO
|
|
|
|
L<GT::Socket> - A socket module made for Links SQL.
|
|
|
|
=head1 MAINTAINER
|
|
|
|
Jason Rhinelander
|
|
|
|
=head1 COPYRIGHT
|
|
|
|
Copyright (c) 2004 Gossamer Threads Inc. All Rights Reserved.
|
|
http://www.gossamer-threads.com/
|
|
|
|
=head1 VERSION
|
|
|
|
Revision: $Id: Client.pm,v 1.15 2004/02/17 01:33:07 jagerman Exp $
|
|
|
|
=cut
|