view release on metacpan or  search on metacpan

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

    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}};
            }
            foreach my $value (@values) {
                $url .= uri_escape($key).'='.uri_escape($value) . '&';
            }
        }
        chop $url;
    }

    @_ = ($self, $code, $url);
    goto &SendRedirectRawURL;
}

sub SendLocalFile {
    my ($self, $requestfile) = @_;
    my $start =  $self->{'header'}{'_RangeStart'};
    my $client = $self->{'client'};

    # open the file and get the size
    my %fileitem = ('requestfile' => $requestfile);
    my $currentsize;
    if($self->{'method'} ne 'HEAD') {
        my $FH;
        if(! open($FH, "<", $requestfile)) {
            say "SLF: open failed";
            $self->Send404;
            return;
        }
        binmode($FH);
        my $st = stat($FH);
        if(! $st) {
            $self->Send404();
            return;
        }
        $currentsize = $st->size;
        $fileitem{'fh'} = $FH;
    }
    else {
        $currentsize = (-s $requestfile);
    }

    # seek if a start is specified
    if(defined $start) {
        if($start >= $currentsize) {
            $self->Send416($currentsize);
            return;
        }
        elsif($fileitem{'fh'}) {
            seek($fileitem{'fh'}, $start, 0);
        }
    }

    # get the maximumly possible file size. 99999999999 signfies unknown
    my $get_current_size = sub {
        return $currentsize;
    };
    my $done;
    my $ts;
    my $get_max_size = sub {
        if($done) {
            return $ts;
        }
        my $locksz = LOCK_GET_LOCKDATA($requestfile);
        if(defined($locksz)) {
            $ts = ($locksz || 0);
        }
        else {
            $done = 1;
            $ts = ($get_current_size->() || 0);
        }
    };
    my $filelength = $get_max_size->();

    # truncate to the [potentially] satisfiable end
    if(defined $self->{'header'}{'_RangeEnd'}) {
        $self->{'header'}{'_RangeEnd'} = min($filelength-1,  $self->{'header'}{'_RangeEnd'});
    }

    # setup callback for retrieving current file size if we are following the file
    if($fileitem{'fh'}) {
        if(! $done) {
            $get_current_size = sub {
                return stat($fileitem{'fh'})
            };
        }

        my $get_read_filesize = sub {
            my $maxsize = $get_max_size->();
            if(defined $self->{'header'}{'_RangeEnd'}) {
                my $rangesize = $self->{'header'}{'_RangeEnd'}+1;
                return $rangesize if($rangesize <= $maxsize);
            }
            return $maxsize;
        };
        $fileitem{'get_current_length'} = $get_read_filesize;
    }

    # flag to add SharedArrayBuffer headers
    my @SABwhitelist = ('static/music_worklet_inprogress/index.html');
    my $allowSAB;
    foreach my $allowed (@SABwhitelist) {
        if(index($requestfile, $allowed, length($requestfile)-length($allowed)) != -1) {
            $allowSAB = 1;
            last;
        }
    }

    # finally build headers and send
    if($filelength == 99999999999) {
        $filelength = undef;
    }
    my $mime = getMIME($requestfile);

    my $opt = {
        'size'     => $filelength,
        'mime'     => $mime,
        'allowSAB' => $allowSAB
    };
    if($self->{'responseopt'}{'cd_file'}) {
        $opt->{$self->{'responseopt'}{'cd_file'}} = basename($requestfile);
    }

    $self->_SendDataItem(\%fileitem, $opt);
}

# currently only supports fixed filelength
sub SendPipe {
    my ($self, $FH, $filename, $filelength, $mime) = @_;
    if(! defined $filelength) {
        $self->Send404();
    }

    $mime //= getMIME($filename);
    binmode($FH);
    my %fileitem;
    $fileitem{'fh'} = $FH;
    $fileitem{'get_current_length'} = sub {
        my $tocheck = defined $self->{'header'}{'_RangeEnd'} ? $self->{'header'}{'_RangeEnd'}+1 : $filelength;
        return min($filelength, $tocheck);
    };

    $self->_SendDataItem(\%fileitem, {
        'size'     => $filelength,
        'mime'     => $mime,
        'filename' => $filename
    });
}

# to do get rid of shell escape, launch ssh without blocking
sub SendFromSSH {
    my ($self, $sshsource, $filename, $node) = @_;
    my @sshcmd = ('ssh', $sshsource->{'userhost'}, '-p', $sshsource->{'port'});
    my $fullescapedname = "'" . shell_escape($filename) . "'";
    my $folder = $sshsource->{'folder'};
    my $size = $node->[1];
    my @cmd;
    if(defined $self->{'header'}{'_RangeStart'}) {
        my $start = $self->{'header'}{'_RangeStart'};
        my $end = $self->{'header'}{'_RangeEnd'} // ($size - 1);
        my $bytestoskip =  $start;
        my $count = $end - $start + 1;
        @cmd = (@sshcmd, 'dd', 'skip='.$bytestoskip, 'count='.$count, 'bs=1', 'if='.$fullescapedname);
    }
    else{
        @cmd = (@sshcmd, 'cat', $fullescapedname);
    }
    say "SendFromSSH (BLOCKING)";
    open(my $cmdh, '-|', @cmd) or die("SendFromSSH $!");

    $self->SendPipe($cmdh, basename($filename), $size);
    return 1;
}

# ENOTIMPLEMENTED
sub Proxy {
    my ($self, $proxy, $node) = @_;
    die;
    return 1;
}

# buf is a bytes scalar
sub SendBytes {
    my ($self, $mime, $buf, $options) = @_;

    # we want to sent in increments of bytes not characters
    if(Encode::is_utf8($buf)) {
        warn "SendBytes: UTF8 flag is set, turning off";
        Encode::_utf8_off($buf);
    }

    my $bytesize = length($buf);

    # only truncate buf if responding to a range request
    if((!$options->{'code'}) || ($options->{'code'} == 206)) {