view release on metacpan or  search on metacpan

inc/bundle/File/Fetch.pm  view on Meta::CPAN

    my $normal = 0;
    while ( $select->can_read( $TIMEOUT || 60 ) ) {
      my $ret = $sock->sysread( $resp, 4096, length($resp) );
      if ( !defined $ret or $ret == 0 ) {
        $select->remove( $sock );
        $normal++;
      }
    }
    close $sock;

    unless ( $normal ) {
        return $self->_error(loc("Socket timed out after '%1' seconds", ( $TIMEOUT || 60 )));
    }

    # Check the "response"
    # Strip preceding blank lines apparently they are allowed (RFC 2616 4.1)
    $resp =~ s/^(\x0d?\x0a)+//;
    # Check it is an HTTP response
    unless ( $resp =~ m!^HTTP/(\d+)\.(\d+)!i ) {
        return $self->_error(loc("Did not get a HTTP response from '%1'",$self->host));
    }

    # Check for OK
    my ($code) = $resp =~ m!^HTTP/\d+\.\d+\s+(\d+)!i;
    unless ( $code eq '200' ) {
        return $self->_error(loc("Got a '%1' from '%2' expected '200'",$code,$self->host));
    }

    {
      local $\;
      print $fh +($resp =~ m/\x0d\x0a\x0d\x0a(.*)$/s )[0];
    }
    close $fh;
    return $to;
}

### Net::FTP fetching
sub _netftp_fetch {
    my $self = shift;
    my %hash = @_;

    my ($to);
    my $tmpl = {
        to  => { required => 1, store => \$to }
    };
    check( $tmpl, \%hash ) or return;

    ### required modules ###
    my $use_list = { 'Net::FTP' => 0 };

    ### Fix CVE-2016-1238 ###
    local $Module::Load::Conditional::FORCE_SAFE_INC = 1;
    unless( can_load( modules => $use_list ) ) {
        $METHOD_FAIL->{'netftp'} = 1;
        return;
    }

    ### make connection ###
    my $ftp;
    my @options = ($self->host);
    push(@options, Timeout => $TIMEOUT) if $TIMEOUT;
    unless( $ftp = Net::FTP->new( @options ) ) {
        return $self->_error(loc("Ftp creation failed: %1",$@));
    }

    ### login ###
    unless( $ftp->login( anonymous => $FROM_EMAIL ) ) {
        return $self->_error(loc("Could not login to '%1'",$self->host));
    }

    ### set binary mode, just in case ###
    $ftp->binary;

    ### create the remote path
    ### remember remote paths are unix paths! [#11483]
    my $remote = File::Spec::Unix->catfile( $self->path, $self->file );

    ### fetch the file ###
    my $target;
    unless( $target = $ftp->get( $remote, $to ) ) {
        return $self->_error(loc("Could not fetch '%1' from '%2'",
                    $remote, $self->host));
    }

    ### log out ###
    $ftp->quit;

    return $target;

}

### /bin/wget fetch ###
sub _wget_fetch {
    my $self = shift;
    my %hash = @_;

    my ($to);
    my $tmpl = {
        to  => { required => 1, store => \$to }
    };
    check( $tmpl, \%hash ) or return;

    my $wget;
    ### see if we have a wget binary ###
    unless( $wget = can_run('wget') ) {
        $METHOD_FAIL->{'wget'} = 1;
        return;
    }

    ### no verboseness, thanks ###
    my $cmd = [ $wget, '--quiet' ];

    ### if a timeout is set, add it ###
    push(@$cmd, '--timeout=' . $TIMEOUT) if $TIMEOUT;

    ### run passive if specified ###
    push @$cmd, '--passive-ftp' if $self->scheme eq 'ftp' && $FTP_PASSIVE;

    ### set the output document, add the uri ###
    push @$cmd, '--output-document', $to, $self->uri;