view release on metacpan or  search on metacpan

lib/MHFS/HTTP/Server/Client.pm  view on Meta::CPAN

package MHFS::HTTP::Server::Client v0.7.0;
use 5.014;
use strict; use warnings;
use feature 'say';
use Time::HiRes qw( usleep clock_gettime CLOCK_REALTIME CLOCK_MONOTONIC);
use IO::Socket::INET;
use Errno qw(EINTR EIO :POSIX);
use Fcntl qw(:seek :mode);
use File::stat;
use IO::Poll qw(POLLIN POLLOUT POLLHUP);
use Scalar::Util qw(looks_like_number weaken);
use Data::Dumper;
use Carp;
use MHFS::HTTP::Server::Client::Request;

sub new {
    my ($class, $sock, $server, $serverhostinfo, $ip) = @_;
    $sock->blocking(0);
    my %self = ('sock' => $sock, 'server' => $server, 'time' => clock_gettime(CLOCK_MONOTONIC), 'inbuf' => '', 'serverhostname' => $serverhostinfo->{'hostname'}, 'absurl' => $serverhostinfo->{'absurl'}, 'ip' => $ip, 'X-MHFS-PROXY-KEY' => $serverhosti...
    $self{'CONN-ID'} = int($self{'time'} * rand()); # insecure uid
    $self{'outheaders'}{'X-MHFS-CONN-ID'} = sprintf("%X", $self{'CONN-ID'});
    bless \%self, $class;
    $self{'request'} = MHFS::HTTP::Server::Client::Request->new(\%self);
    return \%self;
}

# add a connection timeout timer
sub AddClientCloseTimer {
    my ($self, $timelength, $id, $is_requesttimeout) = @_;
    weaken($self); #don't allow this timer to keep the client object alive
    my $server = $self->{'server'};
    say "CCT | add timer: $id";
    $server->{'evp'}->add_timer($timelength, 0, sub {
        if(! defined $self) {
            say "CCT | $id self undef";
            return undef;
        }
        # Commented out as with connection reuse on, Apache 2.4.10 seems sometimes
        # pass 408 on to the next client.
        #if($is_requesttimeout) {
        #    say "CCT | \$timelength ($timelength) exceeded, sending 408";
        #    $self->{request}->Send408;
        #    CT_WRITE($self);
        #}
        say "CCT | \$timelength ($timelength) exceeded, closing CONN $id";
        say "-------------------------------------------------";
        $server->{'evp'}->remove($self->{'sock'});
        say "poll has " . scalar ( $server->{'evp'}{'poll'}->handles) . " handles";
        return undef;
    }, $id);
    return $id;
}

sub KillClientCloseTimer {
    my ($self, $id) = @_;
    my $server = $self->{'server'};
    say "CCT | removing timer: $id";
    $server->{'evp'}->remove_timer_by_id($id);
}

sub SetEvents {
    my ($self, $events) = @_;
    $self->{'server'}{'evp'}->set($self->{'sock'}, $self, $events);
}

use constant {
    RECV_SIZE => 65536,
    CT_YIELD => 1,
    CT_DONE  => undef,
    #CT_READ => 1,
    #CT_PROCESS = 2,
    #CT_WRITE => 3
};

# The "client_thread" consists of 5 states, CT_READ, CT_PROCESS, CT_WRITE, CT_YIELD, and CT_DONE
# CT_READ reads input data from the socket
##    on data read transitions to CT_PROCESS
##    on error transitions to CT_DONE
##    otherwise CT_YIELD

# CT_PROCESS processes the input data
##    on processing done, switches to CT_WRITE or CT_READ to read more data to process
##    on error transitions to CT_DONE
##    otherwise CT_YIELD

# CT_WRITE outputs data to the socket
##   on all data written transitions to CT_PROCESS unless Connection: close is set.
##   on error transitions to CT_DONE
##   otherwise CT_YIELD

lib/MHFS/HTTP/Server/Client.pm  view on Meta::CPAN

                say "file read done";
                close($FH);
            }
            else {
                my $readamt = 24000;
                if($req_length) {
                    my $tmpsend = $req_length - $filepos;
                    $readamt = $tmpsend if($tmpsend < $readamt);
                }
                # this is blocking, it shouldn't block for long but it could if it's a pipe especially
                my $bytesRead = read($FH, $newdata, $readamt);
                if(! defined($bytesRead)) {
                    $newdata = undef;
                    say "READ ERROR: $!";
                }
                elsif($bytesRead == 0) {
                    # read EOF, better remove the error
                    if(! $req_length) {
                        say '$req_length not set and read 0 bytes, treating as EOF';
                        $newdata = undef;
                    }
                    else {
                        say 'FH EOF ' .$filepos;
                        seek($FH, 0, 1);
                        _TSRReturnPrint($sentthiscall);
                        return '';
                    }
                }
                else {
                    $dataitem->{'fh_pos'} += $bytesRead;
                }
            }
        }
        elsif(defined $dataitem->{'cb'}) {
            $newdata = $dataitem->{'cb'}->($dataitem);
        }

        my $encode_chunked = $dataitem->{'is_chunked'};
        # if we got to here and there's no data, fetching newdata is done
        if(! $newdata) {
            $dataitem->{'fh'} = undef;
            $dataitem->{'cb'} = undef;
            $dataitem->{'is_chunked'} = undef;
            $newdata = '';
        }

        # encode chunked encoding if needed
        if($encode_chunked) {
            my $sizeline = sprintf "%X\r\n", length($newdata);
            $newdata = $sizeline.$newdata."\r\n";
        }

        # add the new data to the dataitem buffer
        $dataitem->{'buf'} .= $newdata;

    } while(length($dataitem->{'buf'}));
    $client->{'request'}{'response'} = undef;

    _TSRReturnPrint($sentthiscall);
    say "DONE Sending Data";
    return 'RequestDone'; # not undef because keep-alive
}

sub TrySendItem {
    my ($csock, $dataref) = @_;
    my $sret = send($csock, $$dataref, 0);
    if(! defined($sret)) {
        if($!{EAGAIN}) {
            #say "SEND EAGAIN\n";
            return 0;
        }
        elsif($!{ECONNRESET}) {
            print "ECONNRESET\n";
        }
        elsif($!{EPIPE}) {
            print "EPIPE\n";
        }
        else {
            print "send errno $!\n";
        }
        return undef;
    }
    elsif($sret) {
        substr($$dataref, 0, $sret, '');
    }
    return $sret;
}

sub onHangUp {
    my ($client) = @_;
    return undef;
}

sub DESTROY {
    my $self = shift;
    say "$$ MHFS::HTTP::Server::Client destructor: ";
    say "$$ ".'X-MHFS-CONN-ID: ' . $self->{'outheaders'}{'X-MHFS-CONN-ID'};
    if($self->{'sock'}) {
        #shutdown($self->{'sock'}, 2);
        close($self->{'sock'});
    }
}

1;