# $Id: Client.pm 1390 2006-06-15 04:43:57Z rvosa $
# Subversion: $Rev: 117 $

# Copyright (c) 1997 Secure Computing Corporation
# See the file "Artistic" in the distribution for licensing and
# (lack of) warranties.
# State of a BOA client connection
# Internal fields in a client are:
# _readBuf - buffer for accumulating read data until an entire request
#           is in
# _writeBuf - buffer for sending out data over a non-blocking TCP channel
# _sock	   - socket for read/write
# _msgHdr  - the decoded MessageHeader while we're reading a request
# _func	   - the "currently active" method
# _timer   - Timeout for the current read/write
# _offset  - current byte offset within read or write buffer
# _profiles - array of IIOP TaggedProfiles to add to IORs for this client
#             (mostly used for IIOP/SSL support)
# User code is free to add state to the client hash, as long as it
# doesn't begin with _
# Clients are implemented as a state machine, looping through the following
# phases:
# read message header
# read message (and invoke when all is read)
# write response
use strict;
use Log::Log4perl;
use COPE::CORBA::ORB;
Log::Log4perl::init( COPE::CORBA::ORB->LOGPERLCONF );

package CORBA::BOA::_Client;
use COPE::GIOP;
use IO::Socket;
use POSIX qw(:errno_h);

my $logger = Log::Log4perl::get_logger('CORBA.BOA.Client');

=pod

=begin testing

ok( CORBA::BOA::_Client::_RWtime == 20, "Testing _RWtime constant" );

=end testing

=cut

# $DB::single = 1;
# Constants
# Reads and writes time out in 20 seconds
sub _RWtime() { $logger->debug(20); 20 }

=pod

=begin testing

ok( CORBA::BOA::_Client::_Idletime == ( 60 * 60 ), "Testing _Idletime constant" );

=end testing

=cut

# Idle connections are dropped in 60 minutes
sub _Idletime() { $logger->debug(60 * 60); 60 * 60 }

=pod

=begin testing

ok( CORBA::BOA::_Client->new->isa('CORBA::BOA::_Client'), "Testing CORBA::BOA::_Client constructor" );

=end testing

=cut

# Create a new client for a given socket
sub new {
    $logger->info("Creating \"CORBA::BOA::_Client\" object");
    my ( $class, $sock, $time, $defaults ) = @_;
    my $peer = $sock->peername;
    my ( $pport, $paddr ) = unpack_sockaddr_in($peer);
    my $addr = $sock->sockname;
    my ( $mport, $maddr ) = unpack_sockaddr_in($addr);
    my $name = inet_ntoa($maddr);
    my $self = {

        # internal stuff
        '_readBuf'    => "",
        '_writeBuf'   => "",
        '_sock'       => $sock,
        '_fd'         => $sock->fileno,
        '_msgHdr'     => undef,
        '_byte_order' => 0,
        '_func'       => "readHdr",
        '_timer'      => $time + _RWtime(),
        '_offset'     => 0,
        '_wanted'     => 12,                  # message header length
        '_localport' => $mport,  # The port and address the client is talking to
        '_localname' => $name,
        '_tag'      => "$name:$mport",    # tag for finding IORs for this client
        '_profiles' => [],

        # external stuff
        'srchost'       => inet_ntoa($paddr),
        'srcport'       => $pport,
        'srcaddr'       => $paddr,
        'username'      => 'Unknown',
        'authenticated' => 0,

        # Now add the user's defaults; these override previous values
        %$defaults
    };

    # TODO Does the connect callback belong here, or in the BOA?
    return bless( $self, $class );
}

=pod

=begin testing

ok( CORBA::BOA::_Client->new->_disconnect, "Testing client's _disconnect method" );

=end testing

=cut

# Disconnect and delete a client session
# TODO the reason is unused for now
sub _disconnect {
    $logger->debug("Disconnecting");
    my ( $self, $reason ) = @_;
    if ( $reason ne "" ) {
        $logger->warn($reason);
        print STDERR $reason, "\n";
    }
    $CORBA::BOA::_The_Boa->_remove_client($self);
    $self->{'_disconnecting'} = 1;

    # TODO Add a disconnect callback here...
}

=pod

=begin testing

ok( CORBA::BOA::_Client->new->DESTROY, "Testing client's DESTROY method" );

=end testing

=cut

# For debugging...
sub DESTROY {
    $logger->debug("Client "
      . $_[0]->{'_tag'} . "("
      . $_[0]->{'username'}
      . ") disconnected.\n");

    printf STDERR "Client "
      . $_[0]->{'_tag'} . "("
      . $_[0]->{'username'}
      . ") disconnected.\n";
}

=pod

=begin testing

ok( CORBA::BOA::_Client->new->readHdr, "Testing client's readHdr method" );

=end testing

=cut

# Read the message header, returning a timeout value
sub readHdr {
    $logger->info("Reading header");
    my ( $self, $inread, $inwrite, $outread, $outwrite, $time ) = @_;
    if ( vec( $$inread, $self->{'_fd'}, 1 ) ) {

        # There's data coming in
        my $bytes =
          $self->{'_sock'}
          ->sysread( $self->{'_readBuf'}, $self->{'_wanted'}, $self->{'_offset'} );
        $logger->debug("Bytes: $bytes");
        if ( defined($bytes) && ( $bytes > 0 ) ) {
            $logger->debug("Got a header");
            $self->{'_timer'} = $time + _RWtime;
            $self->{'_wanted'} -= $bytes;
            if ( ( $self->{'_offset'} += $bytes ) >= 12 ) {

                # got an entire message header
                my $index = 0;
                my $msgh  =
                  GIOP::MessageHeader::_unmarshal( \$self->{'_readBuf'}, \$index,
                    \$self->{'_byte_order'} );
                if (   ( $msgh->{'magic'} ne "GIOP" )
                    || ( $msgh->{'message_size'} > ( 8 * 1024 * 1024 ) ) )
                {
                    $self->_disconnect( "Invalid GIOP header: magic = '"
                          . $msgh->{'magic'}
                          . "', message_size = "
                          . $msgh->{'message_size'} );
                    return undef;
                }
                $self->{'_msgHdr'} = $msgh;
                $self->{'_wanted'} = $msgh->{'message_size'};
                $self->{'_func'}   = "read";
                return $self->read( $inread, $inwrite, $outread, $outwrite,
                    $time );
            }
        }
        elsif ( ( $! != EAGAIN ) )
        { #&& ( $! != EWOULDBLOCK ) ) { # TODO some vendors (=microsoft) don't support POSIX errno EWOULDBLOCK
            $self->_disconnect($!);
            return undef;    # tell the boa we're gone
        }
    }
    elsif ( $time >= $self->{'_timer'} ) {

        # We've been waiting too long - bail out
        if ( $self->{'_offset'} == 0 ) {

            # This was an idle timeout
            $self->_disconnect("Connection idle");
        }
        else {
            $self->_disconnect("Timed out while reading from client");
        }
        return undef;
    }
    else {

        # there was nothing for us
    }
    vec( $$outread, $self->{'_fd'}, 1 ) = 1;
    return $self->{'_timer'};
}

=pod

=begin testing

ok( CORBA::BOA::_Client->new->read, "Testing client's read method" );

=end testing

=cut

# Read the rest of a message
sub read {
    $logger->info("Reading message");
    my ( $self, $inread, $inwrite, $outread, $outwrite, $time ) = @_;
    if ( vec( $$inread, $self->{'_fd'}, 1 ) ) {

        # There's data coming in
        my $bytes =
          $self->{'_sock'}
          ->sysread( $self->{'_readBuf'}, $self->{'_wanted'}, $self->{'_offset'} );
        if ( defined($bytes) && ( $bytes > 0 ) ) {
            $self->{'_timer'} = $time + _RWtime;
            if ( ( $self->{'_wanted'} -= $bytes ) == 0 ) {

                # got the entire message
                # This either returns the byte stream we need to output,
                # or throws
                my $handler =
                  $CORBA::BOA::GIOP_handlers[ $self->{'_msgHdr'}{'message_type'} ];
                $handler = \&CORBA::BOA::bad_GIOP if !$handler;
                $self->{'_writeBuf'} = &$handler($self);
                $self->{'_readBuf'}  = '';
                $self->{'_offset'}   = 0;
                $self->{'_msgHdr'}   = undef;
                if ( $self->{'_wanted'} = length( $self->{'_writeBuf'} ) ) {
                    $self->{'_func'} = 'write';

                    # make the write function think it's OK to go ahead
                    vec( $$inwrite, $self->{'_fd'}, 1 ) = 1;
                    return $self->write( $inread, $inwrite, $outread, $outwrite,
                        $time );
                }
                else {
                    $self->{'_func'}   = 'readHdr';
                    $self->{'_wanted'} = 12;          # message header length
                         # Only go back into the read mask if not disconnecting.
                    if ( !$self->{'_disconnecting'} ) {
                        vec( $$outread, $self->{'_fd'}, 1 ) = 1;
                    }
                    return $self->{'_timer'};
                }
            }
            else {
                $self->{'_offset'} += $bytes;
            }
        }
        elsif ( ( $! != EAGAIN ) && ( $! != EWOULDBLOCK ) ) {
            $self->_disconnect($!);
            return undef;    # tell the boa we're gone
        }
    }
    elsif ( $time >= $self->{'_timer'} ) {
        $self->_disconnect("Timed out while reading from client");
        return undef;        # tell the boa we're gone
    }
    else {

        # there was nothing for us
    }
    vec( $$outread, $self->{'_fd'}, 1 ) = 1;
    return $self->{'_timer'};
}

=pod

=begin testing

ok( CORBA::BOA::_Client->new->write, "Testing client's write method" );

=end testing

=cut

# Write the response to a message
sub write {
    $logger->info("Writing message");
    my ( $self, $inread, $inwrite, $outread, $outwrite, $time ) = @_;
    if ( vec( $$inwrite, $self->{'_fd'}, 1 ) ) {
        $logger->info("Have inmsg: @_");
        # ready to write
        my $bytes =
          $self->{'_sock'}
          ->syswrite( $self->{'_writeBuf'}, $self->{'_wanted'}, $self->{'_offset'} );
        if ( defined($bytes) && ( $bytes > 0 ) ) {
            $logger->info("Bytes: $bytes");
            if ( ( $self->{'_wanted'} -= $bytes ) == 0 ) {
                $logger->info("Bytes - wanted == 0");
                # sent the entire message
                $self->{'_timer'}    = $time + _Idletime;
                $self->{'_writeBuf'} = '';
                $self->{'_offset'}   = 0;
                $self->{'_wanted'}   = 12;                 # message header length
                $self->{'_msgHdr'}   = undef;
                $self->{'_func'}     = 'readHdr';

                # Only go back into the read mask if we haven't disconnected
                if ( !$self->{'_disconnecting'} ) {
                    $logger->info("Not disconnecting");
                    vec( $$outread, $self->{'_fd'}, 1 ) = 1;
                }
                return $self->{'_timer'};
            }
            else {
                $self->{'_timer'} = $time + _RWtime;
                $self->{'_offset'} += $bytes;
            }
        }
        elsif ( ( $! != EAGAIN ) && ( $! != EWOULDBLOCK ) ) {
            $logger->info("Not EAGAIN or EWOULDBLOCK");
            # write failed
            $self->_disconnect($!);
            return undef;    # tell the boa we're gone
        }
    }
    elsif ( $time >= $self->{'_timer'} ) {
        $logger->info("Timed out writing to client");
        # We've been waiting too long - bail out
        $self->_disconnect("Timed out writing to client");
        return undef;        # tell the boa we're gone
    }
    else {
        $logger->info("There was nothing for us");
        # there was nothing for us
    }
    vec( $$outwrite, $self->{'_fd'}, 1 ) = 1;
    return $self->{'_timer'};
}
1;

__END__

=head1 NAME

CORBA::BOA::_Client

A class to ...

=head1 SYNOPSIS

use CORBA::BOA::_Client;

=head1 DESCRIPTION

The CORBA::BOA::_Client class implements ...

=head1 OPTIONS

 -D            - show debugging information
 -h            - show help
 -v            - show version
 Other options ...

=head1 SUBROUTINES

=head2 new (constructor)

Parameters:
    class
    sock
    time
    defaults

Insert description of constructor here...

=head2 _disconnect (method)

Parameters:
    reason

Insert description of method here...

=head2 DESTROY (method)

Parameters:
    none

Arguments:
    $_[0]

Insert description of method here...

=head2 readHdr (method)

Parameters:
    inread
    inwrite
    outread
    outwrite
    time

Insert description of method here...

=head2 read (method)

Parameters:
    inread
    inwrite
    outread
    outwrite
    time

Insert description of method here...

=head2 write (method)

Parameters:
    inread
    inwrite
    outread
    outwrite
    time

Insert description of method here...

=head1 FILES

Files used by the CORBA::BOA::_Client class ...

=head1 SEE ALSO

Related information ...

=head1 WARNINGS

...

=head1 NOTES

...

=head1 BUGS

What?

=cut