view release on metacpan or  search on metacpan

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

    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'
                    });
                    return 0;
                }