view release on metacpan or  search on metacpan

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

        }
        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'};
    }
    if($filename) {
        my $sendablebytes = encode('UTF-8', get_printable_utf8($filename));
        $headtext .=   "Content-Disposition: $disposition; filename*=UTF-8''".uri_escape($sendablebytes)."; filename=\"$sendablebytes\"\r\n";
    }

    $self->{'outheaders'}{'Accept-Ranges'} //= 'bytes';
    $self->{'outheaders'}{'Connection'} //= $self->{'header'}{'Connection'};
    $self->{'outheaders'}{'Connection'} //= 'keep-alive';

    # SharedArrayBuffer
    if($opt->{'allowSAB'}) {
        say "sending SAB headers";
        $self->{'outheaders'}{'Cross-Origin-Opener-Policy'} =  'same-origin';
        $self->{'outheaders'}{'Cross-Origin-Embedder-Policy'} = 'require-corp';
    }

    # serialize the outgoing headers
    foreach my $header (keys %{$self->{'outheaders'}}) {
        $headtext .= "$header: " . $self->{'outheaders'}{$header} . "\r\n";
    }

    $headtext .= "\r\n";
    $dataitem->{'buf'} = $headtext;

    if($dataitem->{'fh'}) {
        $dataitem->{'fh_pos'} = tell($dataitem->{'fh'});
        $dataitem->{'get_current_length'} //= sub { return undef };
    }

    $self->_SendResponse($dataitem);
}

sub Send400 {
    my ($self) = @_;
    my $msg = "400 Bad Request\r\n";
    $self->SendHTML($msg, {'code' => 403});
}

sub Send403 {
    my ($self) = @_;
    my $msg = "403 Forbidden\r\n";
    $self->SendHTML($msg, {'code' => 403});
}

sub Send404 {
    my ($self) = @_;
    my $msg = "404 Not Found";
    $self->SendHTML($msg, {'code' => 404});
}

sub Send408 {
    my ($self) = @_;
    my $msg = "408 Request Timeout";
    $self->{'outheaders'}{'Connection'} = 'close';
    $self->SendHTML($msg, {'code' => 408});
}

sub Send416 {
    my ($self, $cursize) = @_;
    $self->{'outheaders'}{'Content-Range'} = "*/$cursize";
    $self->SendHTML('', {'code' => 416});
}

sub Send503 {
    my ($self) = @_;
    $self->{'outheaders'}{'Retry-After'} = 5;
    my $msg = "503 Service Unavailable";
    $self->SendHTML($msg, {'code' => 503});
}

# requires already encoded url
sub SendRedirectRawURL {
    my ($self, $code, $url) = @_;

    $self->{'outheaders'}{'Location'} = $url;
    my $msg = "UNKNOWN REDIRECT MSG";
    if($code == 301) {
        $msg = "301 Moved Permanently";
    }
    elsif($code == 307) {
        $msg = "307 Temporary Redirect";
    }
    $msg .= "\r\n<a href=\"$url\"></a>\r\n";
    $self->SendHTML($msg, {'code' => $code});
}

# encodes path and querystring
# path and query string keys and values must be bytes not unicode string
sub SendRedirect {
    my ($self, $code, $path, $qs) = @_;
    my $url;
    # encode the path component
    while(length($path)) {
        my $slash = index($path, '/');
        my $len = ($slash != -1) ? $slash : length($path);
        my $pathcomponent = substr($path, 0, $len, '');
        $url .= uri_escape($pathcomponent);
        if($slash != -1) {
            substr($path, 0, 1, '');
            $url .= '/';
        }
    }
    # encode the querystring
    if($qs) {
        $url .= '?';
        foreach my $key (keys %{$qs}) {
            my @values;
            if(ref($qs->{$key}) ne 'ARRAY') {
                push @values, $qs->{$key};
            }
            else {
                @values = @{$qs->{$key}};
            }