view release on metacpan or  search on metacpan

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

    }

    $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}};
            }
            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;
    }

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

        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)) {
        my $start =  $self->{'header'}{'_RangeStart'} // 0;
        my $end   =  $self->{'header'}{'_RangeEnd'}  // $bytesize-1;
        $buf      =  substr($buf, $start, ($end-$start) + 1);
    }

    # Use perlio to read from the buf
    my $fh;
    if(!open($fh, '<', \$buf)) {
        $self->Send404;
        return;
    }
    my %fileitem = (
        'fh' => $fh,
        'get_current_length' => sub { return undef }
    );
    $self->_SendDataItem(\%fileitem, {
        'size'     => $bytesize,
        'mime'     => $mime,
        'filename' => $options->{'filename'},
        'code'     => $options->{'code'}
    });
}

# expects unicode string (not bytes)
sub SendText {
    my ($self, $mime, $buf, $options) = @_;
    @_ = ($self, $mime, encode('UTF-8', $buf), $options);
    goto &SendBytes;
}

# expects unicode string (not bytes)
sub SendHTML {
    my ($self, $buf, $options) = @_;;
    @_ = ($self, 'text/html; charset=utf-8', encode('UTF-8', $buf), $options);
    goto &SendBytes;
}

# expects perl data structure
sub SendAsJSON {
    my ($self, $obj, $options) = @_;
    @_ = ($self, 'application/json', encode_json($obj), $options);
    goto &SendBytes;
}

sub SendCallback {
    my ($self, $callback, $options) = @_;
    my %fileitem;
    $fileitem{'cb'} = $callback;

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

sub SendAsTar {
    my ($self, $requestfile) = @_;

    if(!HAS_Alien_Tar_Size) {
        warn("Cannot send tar without Alien::Tar::Size");
        $self->Send404();
        return;
    }
    my ($libtarsize) = Alien::Tar::Size->dynamic_libs;
    if(!$libtarsize) {
        warn("Cannot find libtarsize");
        $self->Send404();
        return;
    }

    # HACK, use LD_PRELOAD to hook tar to calculate the size quickly
    my @tarcmd = ('tar', '-C', dirname($requestfile), basename($requestfile), '-c', '--owner=0', '--group=0');
    $self->{'process'} =  MHFS::Process->new(\@tarcmd, $self->{'client'}{'server'}{'evp'}, {
        'SIGCHLD' => sub {
            my $out = $self->{'process'}{'fd'}{'stdout'}{'fd'};
            my $size;
            read($out, $size, 50);
            chomp $size;
            say "size: $size";
            $self->{'process'} = MHFS::Process->new(\@tarcmd, $self->{'client'}{'server'}{'evp'}, {
                'STDOUT' => sub {
                    my($out) = @_;
                    say "tar sending response";
                    $self->{'outheaders'}{'Accept-Ranges'} = 'none';
                    my %fileitem = ('fh' => $out, 'get_current_length' => sub { return undef });
                    $self->_SendDataItem(\%fileitem, {
                        'size' => $size,
                        'mime' => 'application/x-tar',
                        'code' => 200,
                        'attachment' => basename($requestfile).'.tar'