# ==================================================================
# Gossamer Threads Module Library - http://gossamer-threads.com/
#
#   GT::Socket
#   Author  : Aki Mimoto
#   CVS Info :                          
#   $Id: Socket.pm,v 1.43 2004/08/23 20:07:44 jagerman Exp $
#
# Copyright (c) 2000 Gossamer Threads Inc.  All Rights Reserved.
# ==================================================================
#
# Description:
#   Handles stuff related to INET connections
#

package GT::Socket;
# ===============================================================
use strict;
use GT::Base;
use vars qw/$ATTRIBS $VERSION $ERRORS @ISA $ERRORS $DEBUG $SHUTDOWN/;
use Symbol;
use Socket;
use Config;

@ISA     = qw/GT::Base/;
$DEBUG   = 0;
$VERSION = sprintf "%d.%03d", q$Revision: 1.43 $ =~ /(\d+)\.(\d+)/;
$ERRORS = {
    NO_HOST  => 'No host specified',
    NO_PORT  => 'No port specified',
    UNRESOLV => 'IP of Host: %s is unresolveable. System Error: (%s)',
    SOCKET   => 'Socket error: %s',
    SOCKOPTS => 'Error setting socket options: %s',
    BIND     => 'Bind error onto port(%i): %s',
    LISTEN   => 'Listen call file: ',
    UNKNOWN_HOST => 'Host: %s is unknown',
    UNKNOWN_PORT => 'Port: %s is unknown',
    TIMEOUT  => 'Host %s connect timed out',
    CONNECT  => 'Cant connect to host: %s (%s)',
    MAX_DOWN => 'Maximum number of bytes (%i) received',
    MAX_UP   => 'Maximum number of bytes (%i) sent'
};

$ATTRIBS = {
    host     => undef,
    port     => 23,
    sock     => undef,
    max_down => 0,
    max_up   => 0,
    received => 0,
    sent     => 0,
    server   => 0,
    timeout  => 40
};

sub DESTROY {
#-------------------------------------------------------------------------------
# Make sure we close the connection.
#
    $_[0]->close if $_[0]->{sock};
}

sub init {
#-------------------------------------------------------------------------------
# Called on new() from GT::Base.
#
    my $self = shift;

    $self->close() if $self->{sock}; # If there is an existing socket, close it
    $self->_set_options(@_) if @_;

# If host and port were provided, open the new socket
    $self->_open() if $self->{host} and $self->{port} and not $self->{sock};

    return $self;
}

sub open {
#-------------------------------------------------------------------------------
# Open a new connection to the host. Returns undef if the connection failed, or
# the GT::Socket object if the connection was established.
#
    my $self = shift;

# Create a new GT::Socket object if called as a class method
    $self = UNIVERSAL::isa($self, __PACKAGE__) ? $self->new() : __PACKAGE__->new()
        unless ref $self and UNIVERSAL::isa($self, __PACKAGE__);

    $self->close() if $self->{sock}; # if there is an existing socket, close it
    $self->_set_options(@_) if @_;

    $self->_open() or return; # open the new socket

    return $self;
}

sub server {
#-------------------------------------------------------------------------------
# Create a server socket.
#
    my $self = shift;

# Create a new GT::Socket object if called as a class method
    $self = UNIVERSAL::isa($self, __PACKAGE__) ? $self->new() : __PACKAGE__->new()
        unless ref $self and UNIVERSAL::isa($self, __PACKAGE__);

    $self->close() if $self->{sock}; # If there is an existing socket, close it
    $self->{server} = 1;

    $self->_set_options(@_) if @_;

    $self->_server() or return; # open the new socket

    return $self;
}

sub close {
#-------------------------------------------------------------------------------
# closes the socket if it is open
#
    close $_[0]->{sock} if $_[0]->{sock};
}

sub _open {
#-------------------------------------------------------------------------------
# this does the real opening of the socket
#
# IN: host to connect to, and port to connect to (names such as "ftp" allowed)
#
    my $self = shift;
    my $host = $self->{host} or return $self->error(NO_HOST => 'WARN');
    my $port = $self->{port} or return $self->error(NO_PORT => 'WARN');

    if ($port =~ /\D/) { # Port is a name, such as "ftp". Get the port number.
        $port = getservbyname($port, 'tcp');
    }
    int $port or return $self->error(NO_PORT => 'WARN');

# get the packed ip address
    my $iaddr = inet_aton($host) or return $self->error(UNRESOLV => 'WARN', $host, "$!");
    my $paddr = sockaddr_in($port, $iaddr);

# connect with timeout
    my $fh    = gensym();
    my $proto = getprotobyname('tcp');
    socket($fh, PF_INET, SOCK_STREAM, $proto) or return $self->error(SOCKET => 'WARN', "$!");

    if ($Config{d_alarm} and $self->{timeout}) {
        {
            local $SIG{__DIE__};
            eval {
                local $SIG{ALRM} = sub { undef $fh };
                alarm($self->{timeout});
                connect($fh, $paddr) or die 'CONNECT';
            };
        }
        alarm(0);
        if (not defined $fh) {
            return $self->error(TIMEOUT => 'WARN', $host, "$!");
        }
        elsif ($@) {
            return $self->error(CONNECT => 'WARN', $host, "$!");
        }
    }
    else {
        connect($fh, $paddr) or return $self->error(CONNECT => 'WARN', $host, $!);
    }

    $self->{sock} = $fh;
    $self->autoflush();

    1;
}

sub _server {
#-------------------------------------------------------------------------------
# creates the required server ports
#
    my $self = shift;
    my $port = $self->{port} or return $self->error(NO_PORT => 'WARN');
    my $host = inet_aton($self->{host}) || INADDR_ANY;

    my $fh = gensym();
    my $proto = getprotobyname('tcp');

    socket($fh, PF_INET, SOCK_STREAM, $proto)               or return $self->error(SOCKET   => 'WARN', "$!"); 
    setsockopt($fh, SOL_SOCKET, SO_REUSEADDR, pack("l", 1)) or return $self->error(SOCKOPTS => 'WARM', "$!");
    bind($fh, sockaddr_in($port, $host))                    or return $self->error(BIND     => 'WARN', $port, "$!");
    listen($fh, SOMAXCONN)                                  or return $self->error(LISTEN   => 'WARN', "$!");

# get a ref to the connect
    $self->{sock} = $fh;

    $self->autoflush();

    1;
}

sub accept {
#-------------------------------------------------------------------------------
# accepts a server's tcpip connection from a client
#
    my $self = shift;
    my $sock = $self->{sock};

    if ($self->pending() and $self->{server}) {
        my $ch = gensym();
        accept($ch, $sock);

        my $client = new GT::Socket(
            max_down => $self->{max_down} || undef,
            max_up   => $self->{max_up}   || undef,
            server   => $self->{server},
            timeout  => $self->{timeout},
            port     => $self->{port},
            host     => $self->{host},
            sock     => $ch
        );

        return $client;
    }
    return;
}

sub autoflush {
#-------------------------------------------------------------------------------
# turns on auto flushing of socket handles.
#
    my $self   = shift;
    my $status = defined($_[0]) ? $_[0] : 1;
    my $sock   = $self->{sock};

    select((select($sock), $| = $status)[0]) if $sock;

    1;
}

sub vec {
#-------------------------------------------------------------------------------
# IN: clean or partially preped $bits for select
# OUT: the $bits
#
    my ($self, $bits) = @_;
    $bits ||= '';

# setup the filehandle vecs
    my $sock = $self->{sock} or return $bits;
    CORE::vec($bits, fileno($sock), 1) = 1;

    return $bits;
}

sub pending {
#-------------------------------------------------------------------------------
# returns non-zero if data is pending
# IN: <0       : value for blocking
#     non zero : wait for N seconds
#     0        : don't wait (nonblocking)
# OUT: non-zero if data is pending
#
    my $self = shift;
    my $tics = defined $_[0] ? ($_[0] < 0 ? undef : shift) : 0;

# if the sock has closed we have no data pending
    return 0 if $self->{closed};

    my $bits = $self->vec() or return;

# find out the number of bytes to read
    return select($bits, undef, undef, $tics);
}

sub EOF {
#-------------------------------------------------------------------------------
# returns number of bytes to be read if there is input pending
# IN: nothing
# OUT: number of bytes
#
    my $self = shift;

# if the sock has closed we have no data pending
    return 1 if $self->{closed};

# setup the filehandle vecs
    my $sock = $self->{sock} or return;
    CORE::vec(my $bits = '', fileno($sock), 1) = 1;

# find out if the socket is closed
    return select(undef, undef, my $ebits = $bits, 0);
}

sub read {
#-------------------------------------------------------------------------------
# reads a certain number of bytes from the socket
#
    my $self  = shift;
    my $bytes = int(shift) or return;
    my $max   = $self->{max_down} || 0;
    my $buf;

# find out how many bytes to read
    if ($max) {
        my $received = $self->{received};

        if ($received == $max) {
            return $self->error('MAX_DOWN', 'WARN', $self->{received});
        }

# Lower the number of bytes requested if that would push us over the max byte limit
        elsif (($max - $received) < $bytes) {
            if (($bytes = $max - $received) < 0) {
                return $self->error('MAX_DOWN', 'WARN', $self->{received});
            }
        }
    }

# Attempt to read the requested amount of data.
# If sysread returns 0, it means that there is no more data to be read
    my $b_read = sysread($self->{'sock'}, $buf, $bytes);
    unless ($b_read) {
        $self->{closed} = 1;
        return $buf;
    }

# Finish up the read
    if ((($self->{received} += $b_read) >= $max) and $max) {
        $self->{closed} = 1;
        $self->close();
    }

    return $buf;
}

sub gulpread {
#-------------------------------------------------------------------------------
# reads a certain number of bytes from the socket
#
    my $self     = shift;
    my $tics     = shift || 0;
    my $max_tics = time + $tics;
    my $max      = $self->{max_down};
    my $sock     = $self->{sock};
    my $buf;

# if there's data pending
    while ($tics
        ? ($max_tics >= time and not $self->EOF() and $self->pending($max_tics - time))
        : ($self->pending() and not $self->EOF())
    ) {
        my $bytes  = 4096;

# Find out how many bytes to read
        if ($max) {
            my $received = $self->{received};

            if ($received == $max) {
                $self->error('MAX_DOWN', 'WARN', $self->{received});
                return $buf;
            }
            elsif (($max - $received) < $bytes) {
                if (($bytes = $max - $received) < 0) {
                    $self->error('MAX_DOWN', 'WARN', $self->{received});
                    return $buf;
                }
            }
        }

# Attempt to read the requested amount of data.
# If sysread returns 0, it means that there is no more data to be read
        my $tmp;
        my $b_read = sysread($sock, $tmp, $bytes);
        unless ($b_read) {
            $self->{closed} = 1;
            return $buf . $tmp;
        }

# Finish up the read
        if ((($self->{received} += $b_read ) >= $max ) and $max) {
            $self->{closed} = 1;
            $self->close();
        }

        $buf .= $tmp;
        return $buf;
    }

    return $buf;
}

sub write {
#-------------------------------------------------------------------------------
# writes a certain number of bytes to the socket
#
    my $self       = shift;
    my $buf        = shift;
    my $bytes      = length( $buf );
    my $max        = $self->{max_up};

# if we're using limit caps on the number of bytes that the service can send out
# tweak the buf to make sure we can!
    if ($max) {
# the current buffer would throw us over the top, fix it
        if ((my $len = $max - $self->{'sent'}) < $bytes) {

# check the vector
            if (($bytes = $len) > 0) {
                $buf = substr($buf, 0, $len);
            }
            else {
                return $buf = undef;
            }
        }
    }

# now with all the tweaked values, send off the information
    my $sock   = $self->{sock};
    my $b_sent = syswrite($sock, $buf, length $buf);

    $self->{sent} = $b_sent;
}

sub fh {
#-------------------------------------------------------------------------------
# returns the file handle associated
    my $self = shift;
    return $self->{sock};
}

################################################################################
# PRIVATE PARTS
################################################################################

sub _set_options {
#-------------------------------------------------------------------------------
# cleverly tries to set the options for connection
#
    my $self = shift;

# called with { host => HOST, port => PORT }
    if (ref $_[0]) {
        $self->set($_[0]);
    }

# called with HOST,PORT
    elsif (@_ == 2) {
        $self->set({
            host => $_[0],
            port => $_[1]
        });
    }

# called with ( host => HOST, port => PORT )
    elsif (!(@_ % 2)) {
        $self->set(@_);
    }

# called with "HOST:PORT" or just "PORT"
    elsif (@_ == 1) {
        if ($_[0] =~ /(.*)\:(.*)/) {
            $self->set({
                host => $1,
                port => $2
            });
        }
        else {
            $self->set( {
                host => 'localhost',
                port => int($_[0])
            });
        }
    }
}

1;

__END__

=head1 NAME

GT::Socket - A simple internet socket handling interface

=head1 SYNOPSIS

    use GT::Socket;

    my $sock = GT::Socket->open({
        host => 'www.gossamer-threads.com',
        port => 80
    });

    $sock->write("GET / HTTP/1.0\n\n");

    print "REQUEST RETURNED:\n\n", $sock->gulpread(-1);

=head1 DESCRIPTION

GT::Socket provides a simple interface for tcp client/server socket services.

=head2 Method List

Object Creation

    open()        Creates a new client socket
    server()      Creates a new server socket

Reading and Writing

    write()       Sends all or up to max_up bytes of data to remote
    read()        Receives an amount or max_down bytes of data from remote
    gulpread()    Gets all or up to max_down bytes of data from remote

Socket Administration

    close()       Closes the socket
    EOF()         Returns open/closed status of socket
    autoflush()   Sets the socket so that no data is buffered
    vec()         Sets bits in a bitmask for select calls
    pending()     Returns true if data/clients awaiting
    fh()          Returns the raw socket handle

Server Handling

    accept()      Accepts a incoming client request

=head2 Creating a new Client Socket

To instantiate a new Client Socket connection, the open() method must be
called.

    my $sock = GT::Socket->open({
        host => 'hostname', # hostname/ip to connect to
        port => 1234,       # port to connect to
        max_down => 0,      # maximum number of bytes to download (optional)
        max_up => 0,        # maximum number of bytes to upload (optional)
        timeout => 10       # maximum time to wait for host connect (optional)
    });

The parameters are somewhat flexible, to connect to www.gossamer-threads.com on
port 80, any of the following calling methods can be used.

    my $sock = GT::Socket->open({
        host => 'www.gossamer-threads.com', 
        port => 80  
    });

    my $sock = GT::Socket->open(
        host => 'www.gossamer-threads.com', 
        port => 80 
    );

    my $sock = GT::Socket->open('www.gossamer-threads.com', 80);

    my $sock = GT::Socket->open('www.gossamer-threads.com:80');

Note that as port 80 is the HTTP port, and port gets tested and handled with
the getservbyname function, the following can be done:

    # 'http' here but can be 'pop3', 'telnet', etc. depending on service wanted
    my $sock = GT::Socket->open('www.gossamer-threads.com', 'http');

Note that if the value passed to open() is a hash ref, with a host and port, a
handful of other options may be set.

=head2 Limiting maximum amount of data downloaded

This affects the $sock->read() and the $sock->gulpread() methods.

The option 'max_down' can be used to put a cap on the number of bytes recieved
through the socket. 

For example to limit the number of bytes downloaded to 2k, set max_down to 2048

    my $sock = GT::Socket->open(
        host => 'www.gossamer-threads.com',
        port => 80,
        max_down => 2048
    );

WARNING, once the download maximum has been reached, the socket is closed. Then
no more information can be uploaded to the remote host.

=head2 Limiting maximum amount of data uploaded

The option 'max_up' is used to limit the number of bytes that can be sent to
the remote host.

After the maximum number of bytes is hit, the object will no longer carry out
$sock->write() requests.

This does not affect the number of bytes that can be downloaded. Until max_down
is hit or the remote host finishes the transmission, the socket will keep
listening. 

In the following example. The maximum number of bytes for both download and
upload have been set to 2K. 

Keep in mind, with this example, if the maximum download limit is reached
before the maximum upload, the socket will be closed so the remote server will
stop responding to $sock->write() as well!

    my $sock = GT::Socket->open(
        host => 'www.gossamer-threads.com',
        port => 80,
        max_down => 2048,
        max_up => 2048
    );

=head2 Limiting time taken to connect to a host

When the module tries to connect to a host, if the host is not running or
simply not present, it may take over 30 seconds for the connect call to give
up. 

The 'timout' option allows the forcing the waiting period to be a certain
number of seconds. By default, the value is set to 10 seconds.

Since this uses alarm, it will not function on Win32 machines.

With the following example, the module will spend a maximum of 3 seconds trying
to connect to www.gossamer-threads.com.

    my $sock = GT::Socket->open( 
        host => 'www.gossamer-threads.com', 
        port => 80,
        timeout => 3
    );


=head2 Methods

The following methods are available to the Client object

=head2 autoflush ( flag BOOLEAN )

    $sock->autoflush(1) # turn on flushing
    $sock->autoflush(0) # turn off flushing

Turns off buffering for the socket. By default, the socket is
autoflushed/buffering turned off. 

This prevents peculiar errors like stalling when trying to communicate with
http servers.

=head2 close

Closes the socket if open.

=head2 EOF

Returns true of the socket is closed.

=head2 fh

Returns the filehandle. 

The return value is file glob, because of this, the upload/download limits
cannot be enforced and the accounting can fall to bits of both the object and
the file glob are being used simultaneously. 

=head2 gulpread ( tics INTEGER )

Attempts to read all the data it can into a buffer and return. If max_down is
non zero, it will read till the remote closes or the limit has been reached and
returns.

Tics is a non-zero value that will determine how long the function will run for
or wait:

    $tics     Action
    ----------------------------------------
    >0        Wait $tics seconds till returning with results
    0         Don't wait, simply get what's there and return
    <0        Block, wait until all the data (up to max_down) has been received

=head2 pending ( tics INTEGER )

Returns true if socket has data pending to be received. Usually this would be
followed with a call to $sock->gulpread() or $sock->read()

    $tics     Action
    ----------------------------------------
    >0        Wait $tics seconds till returning with results
    0         Don't wait, simply get what's there and return
    <0        Block, wait until all the data (up to max_down) has been received

=head2 read ( number_bytes INTEGER )

Reads a max of number_bytes from the socket or up to max_down and returns the
result. This is nonblocking so it is possible to get no data or less than the
requested amount.

=head2 vec ( [ bits SCALAR ] )

Sets the bits appropriate for the object's socket handle. The returned value
can be used in select(RBITS,WBITS,EBITS,TIMEOUT) function calls.

To test a series of socket handles, vec accepts an already set bit list from
another vec call.

    $bits = $sock1->vec();
    $bits = $sock2->vec($bits);
    $bits = $sock3->vec($bits);

And $bits can now be used to test on all three handles.

=head2 write ( buffer SCALAR )

Takes the buffer and send it into the socket or up to the max_up limit. 

Returns the number of bytes sent.

=head2 Creating a new Server Socket

Creating a server socket is almost identical to creating a client socket except
no hostname is specified.
 
    my $server = GT::Socket->server({
        port => 1234,  # port to host services
        max_down => 0, # maximum number of bytes to download (optional)
        max_up => 0,   # maximum number of bytes to upload (optional)
        timeout => 10  # maximum time to wait for host connect (optional)
    });

The only option that affects the server directly is the port. The optional
values, max_down, max_up, and timeout are passed on to the child socket when
the server accepts a new connection. 

=head2 Methods

The following methods are available to the Client object

=head2 accept

Accepts an incoming connection and returns a GT::Socket client object for
further interations with the client.

=head2 fh

Returns the filehandle.

=head2 pending ( tics INTEGER )

Returns true if server has awaiting connections. Usually this would be followed
with a call to $server->accept();

    $tics     Action
    ----------------------------------------
    >0        Wait $tics seconds till returning with results
    0         Don't wait, simply get what's there and return
    <0        Block, wait until all the data (up to max_down) has been received

=head2 vec ( [ bits SCALAR ] )

Sets the bits appropriate for the object's socket handle. The returned value
can be used in select(RBITS,WBITS,EBITS,TIMEOUT) function calls.

To test a series of socket handles, vec accepts an already set bit list from
another vec call.

    $bits = $sock1->vec();
    $bits = $sock2->vec($bits);
    $bits = $sock3->vec($bits);

And $bits can now be used to test on all three handles. 

=head1 EXAMPLES

=head2 Server 

    use GT::Socket;

    my $server = GT::Socket->server({
        port => 7890
    });

    while (1) {
        if ($server->pending(-1)) {
            print "Accepting a connection\n";
            my $sock = $server->accept();
            $sock->write("The time is: " . localtime() . "\n");
        }
    }

=head2 Client for Server

    use GT::Socket;

    my $client = GT::Socket->open("localhost:7890");
    print "Server Said: ", $client->gulpread(-1);

=head1 COPYRIGHT

Copyright (c) 2000 Gossamer Threads Inc.  All Rights Reserved.
http://www.gossamer-threads.com/

=head1 VERSION

Revision: $Id: Socket.pm,v 1.43 2004/08/23 20:07:44 jagerman Exp $

=cut