view release on metacpan or  search on metacpan

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

sub getAbsoluteURL {
    my ($self) = @_;
    return $self->{'client'}{'absurl'} // (defined($self->{'header'}{'Host'}) ? 'http://'.$self->{'header'}{'Host'} : undef);
}

sub _ReqDataLength {
    my ($self, $datalength) = @_;
    $datalength //= 99999999999;
    my $end =  $self->{'header'}{'_RangeEnd'} // ($datalength-1);
    my $dl = $end+1;
    say "_ReqDataLength returning: $dl";
    return $dl;
}

sub _SendResponse {
    my ($self, $fileitem) = @_;
    if(Encode::is_utf8($fileitem->{'buf'})) {
        warn "_SendResponse: UTF8 flag is set, turning off";
        Encode::_utf8_off($fileitem->{'buf'});
    }
    if($self->{'outheaders'}{'Transfer-Encoding'} && ($self->{'outheaders'}{'Transfer-Encoding'} eq 'chunked')) {
        say "chunked response";
        $fileitem->{'is_chunked'} = 1;
    }

    $self->{'response'} = $fileitem;
    $self->{'client'}->SetEvents(POLLOUT | MHFS::EventLoop::Poll->ALWAYSMASK );
}

sub _SendDataItem {
    my ($self, $dataitem, $opt) = @_;
    my $size  = $opt->{'size'};
    my $code = $opt->{'code'};

    if(! $code) {
        # if start is defined it's a range request
        if(defined $self->{'header'}{'_RangeStart'}) {
            $code = 206;
        }
        else {
            $code = 200;
        }
    }

    my $contentlength;
    # range request
    if($code == 206) {
        my $start =  $self->{'header'}{'_RangeStart'};
        my $end =  $self->{'header'}{'_RangeEnd'};
        if(defined $end) {
            $contentlength = $end - $start + 1;
        }
        elsif(defined $size) {
            say 'Implicitly setting end to size';
            $end = $size - 1;
            $contentlength = $end - $start + 1;
        }
        # no end and size unknown. we have 4 choices:
        # set end to the current end (the satisfiable range on RFC 7233 2.1). Dumb clients don't attempt to request the rest of the data ...
        # send non partial response (200). This will often disable range requests.
        # send multipart. "A server MUST NOT generate a multipart response to a request for a single range"(RFC 7233 4.1) guess not

        # LIE, use a large value to signify infinite size. RFC 8673 suggests doing so when client signifies it can.
        # Current clients don't however, so lets hope they can.
        else {
            say 'Implicitly setting end to 999999999999 to signify unknown end';
            $end = 999999999999;
        }

        if($end < $start) {
            say "_SendDataItem, end < start";
            $self->Send403();
            return;
        }
        $self->{'outheaders'}{'Content-Range'} = "bytes $start-$end/" . ($size // '*');
    }
    # everybody else
    else {
        $contentlength = $size;
    }

    # if the CL isn't known we need to send chunked
    if(! defined $contentlength) {
        $self->{'outheaders'}{'Transfer-Encoding'} = 'chunked';
    }
    else {
        $self->{'outheaders'}{'Content-Length'} = "$contentlength";
    }



    my %lookup = (
        200 => "HTTP/1.1 200 OK\r\n",
        206 => "HTTP/1.1 206 Partial Content\r\n",
        301 => "HTTP/1.1 301 Moved Permanently\r\n",
        307 => "HTTP/1.1 307 Temporary Redirect\r\n",
        403 => "HTTP/1.1 403 Forbidden\r\n",
        404 => "HTTP/1.1 404 File Not Found\r\n",
        408 => "HTTP/1.1 408 Request Timeout\r\n",
        416 => "HTTP/1.1 416 Range Not Satisfiable\r\n",
        503 => "HTTP/1.1 503 Service Unavailable\r\n"
    );

    my $headtext = $lookup{$code};
    if(!$headtext) {
        say "_SendDataItem, bad code $code";
        $self->Send403();
        return;
    }
    my $mime     = $opt->{'mime'};
    $headtext .=   "Content-Type: $mime\r\n";

    my $filename = $opt->{'filename'};
    my $disposition = 'inline';
    if($opt->{'attachment'}) {
        $disposition = 'attachment';
        $filename = $opt->{'attachment'};
    }
    elsif($opt->{'inline'}) {
        $filename = $opt->{'inline'};
    }