view release on metacpan or  search on metacpan

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

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

# CT_YIELD just returns control to the poll loop to wait for IO or allow another client thread to run

# CT_DONE also returns control to the poll loop, it is called on error or when the client connection should be closed or is closed

sub CT_READ {
    my ($self) = @_;
    my $tempdata;
    if(!defined($self->{'sock'}->recv($tempdata, RECV_SIZE))) {
        if(! ($!{EAGAIN} || $!{EWOULDBLOCK})) {
            print ("CT_READ RECV errno: $!\n");
            return CT_DONE;
        }
        say "CT_YIELD: $!";
        return CT_YIELD;
    }
    if(length($tempdata) == 0) {
        say 'Server::Client read 0 bytes, client read closed';
        return CT_DONE;
    }
    $self->{'inbuf'} .= $tempdata;
    goto &CT_PROCESS;
}

sub CT_PROCESS {
    my ($self) = @_;
    $self->{'request'} //= MHFS::HTTP::Server::Client::Request->new($self);
    if(!defined($self->{'request'}{'on_read_ready'})) {
        die("went into CT_PROCESS in bad state");
        return CT_YIELD;
    }
    my $res = $self->{'request'}{'on_read_ready'}->($self->{'request'});
    if(!$res) {
        return $res;
    }
    if(defined $self->{'request'}{'response'}) {
        goto &CT_WRITE;
    }
    elsif(defined $self->{'request'}{'on_read_ready'}) {
        goto &CT_READ;
    }
    return $res;
}

sub CT_WRITE {
    my ($self) = @_;
    if(!defined $self->{'request'}{'response'}) {
        die("went into CT_WRITE in bad state");
        return CT_YIELD;
    }
    # TODO only TrySendResponse if there is data in buf or to be read
    my $tsrRet = $self->TrySendResponse;
    if(!defined($tsrRet)) {
        say "-------------------------------------------------";
        return CT_DONE;
    }
    elsif($tsrRet ne '') {
        if($self->{'request'}{'outheaders'}{'Connection'} && ($self->{'request'}{'outheaders'}{'Connection'} eq 'close')) {
            say "Connection close header set closing conn";
            say "-------------------------------------------------";
            return CT_DONE;
        }