graq has asked for the wisdom of the Perl Monks concerning the following question:

I am experiencing an intermittent problem with a module written to wrap Net::FTP.

The symptoms are that the two machines (between which the ftp connection is established) perform various suceessful TCP hand-shakes. But when it comes to 'put' the file, one machine no longer has the TCP ftp data transfer port connection. The whole process then hangs as one machine waits for the other to supply it data that the other machine doesn't think exists.

The problem does not occur regularly. The files are small. The OS vary (Unix->Linux). All module versions have been checked. And so forth.

Here is a slightly edited version of the module: 
package MyWrapper::FTP;

use vars qw( @ISA );
@ISA = qw( MyWrapper );

require Net::FTP;

use strict;

my $FTP_TIMEOUT = 60;

sub create_connection
{
    my ($self, $connection_string) = @_;

    $connection_string =~ /^(\w+):(\S+)@(\S+)$/;
    my ($login,$password,$host) = ($1,$2,$3);
    my $ftp;
    eval
    {
        $login && $password && $host 
            or die "Can't parse connection string '".$self->connection
+_string."'\n";

        $ftp = new Net::FTP($host, (Timeout=>$FTP_TIMEOUT) );
        die "FTP: failed to connect to $host: $!\n" if not $ftp;

        $ftp->login($login, $password) 
            or die "FTP: Can not login to $login\@$host\n";
        $ftp->binary;
    };
    if ($@)
    {
       # Do some logging.
    }
    $self->set('host', $host);
    return $ftp;
}

sub send_file
{
    my ($self, $file, $outfile) = @_;
    my $host = $self->get('host');
    my $ftp  = $self->ftp;
    my $workfile;

    $workfile = 'test.tst'; # Various unrelated decisions
                            # on what $workfile is occur here.

    if( $ftp->put($file, $workfile) )# <--- This is where it apparentl
+y hangs.
    {
        # Log some intermediary success.

    if( $ftp->rename($workfile,$outfile) )
    {
           # Log some success.
    }
    else
    {
        die( "FTP:  $file -> $host:$outfile - FAILED: $!\n" );
    }
    }
    else
    {
        die( "FTP: $file -> $host:$outfile - FAILED: $!\n" );
    }
}

1;

[download]
- Graq

Replies are listed 'Best First'.
Re: Net::FTP Wrapper: TCP problem
by Brovnik (Hermit) on May 31, 2001 at 15:07 UTC
    Presumably you are setting something so that $self->ftp can return it ?

    Why don't you store this as you are doing with 'host' ? 

    # in create_connection
$self->set('ftp',$ftp);

#in send_file
my $ftp = $self->get('ftp');

    [download]

    --
    Brovnik
[reply]
[d/l]
[select]
      From the same package: 
      sub ftp { return $_[0]->get('connection'); }

      [download]
      Thus I get the current connection or create a new one if I need to.
      So, in essence, I do as you suggest, but I leave it generic - passing the control of the connection details to another object.

      Do you think it is a reason why the TCP connection disappears at one end?
      What really confuses me is that the problem occurs sporadically - and I cannot recreate the error.

      - Graq
[reply]
[d/l]
Re: Net::FTP Wrapper: TCP problem
by petral (Curate) on May 31, 2001 at 16:42 UTC
    One place you can have a problem with Net::FTP is if you somehow have an intermediate copy of the '$ftp' object returned by ``new Net::FTP''.

    When Net::FTP times out or looses a connection, it undefs the object that the method which discovers the broken connection is called on -- that is, the object which is an object method's first arg.

    Your ``$_[0]->get('connection')'' is the right idea; you don't ``my $ftp = shift;'' first, which would leave your caller's obj ($_[0]) still defined. But I can't see if you're doing that for the entire path.

    (I'm sure this is clear as mud, but if you're in this package up to your elbows anyway, maybe you can follow what I'm talking about.)

      p

[reply]
[d/l]
[select]
      Whenever I am finished with the $ftp object, I call 'close' on it.
      There is no evidence of preceding connections failing at all before the connection that hangs.

      This is the base object (re: $_[0]->get('connection'): 

      sub get
{
    my ($self, $property) = @_;

    if ($#_ == 0) {
        return map {$_, $self->{'properties'}->{$_}} $self->properties
+;
    }

    # if $property is an array, return all values
    if ( ref $property eq 'ARRAY') {
        my %retHash = ();
        grep {$retHash{$_} = $self->{'properties'}->{$_}} @$property;
        return \%retHash;
    }

    return $self->{'properties'}->{$property};
}

      [download]
      Are you saying that this will cause the $ftp instance to be recreated?

      If so, why does this cause sporadic failure rather than constant failure or regular failure?
      --
      Graq

[reply]
[d/l]
        Not 'recreated', but what _can_ happen is that you call an ftp command: ``$ftp->cmd(@args);''   which, as you know, is translated by perl as: Package::cmd($ftp, cmd, @args) ((here package is Net::FTP::...)).

        Inside cmd($ftp, ...), it does an ``undef $_[0];'' if, and only if, it discovers a broken connection.

        Next time you want to do an ftp cmd, you retrieve your _stored_ $ftp, (which is still defined and therefore still pointing to the right package::funcs) and send off another command.   ...Result, it hangs...

        For instance, here's the ``put()'', I've used for a couple of years in my wrapper code:
        # put: return ok = '' if 'no permission' error (ie, don't retry)

sub put {
  $_[0]->SUPER::put(@_[1..$#_]) # rtns ok/!ok;$_[0] undef'd if abort
    or check($_[0])            # $_[0] can be undef'd here to hangup
}

        [download]
        (and in ``check()'':)
        . . .

  if ($code == 000 ||                   # got here w/ no resp
      $code == '021' || $code == 421 || # server timeout || abort
      $code == 425 ||      # connection not opened ('out of ports'?)
      $code == 150) {      # intermediate result (never finished)

    $code < 100  and warn " No response (Timeout?).\n";
    150 == $code and warn "\tTimed out in mid-operation.\n";
    421 == $code and warn "\tServer disconnected.\n";
    425 == $code and warn "\tRestarting to clear connections.\n"
                  and sleep 10;
    warn "attempting to reconnect? ...\n";

    undef $_[0];
    return undef;
  }

  if ($code == 530) {     # not logged in! ** needs to croak() **
    die "Can't seem to login!
   (check ~/.netrc file or give name and password on command line?).
          (I'm dieing) \n";
  }

  if ( $code == 550   # dir/file not available (non-exist, no perms)
       || (500 <= $code && $code <= 504)   # syntax errors
       || $code == 553                     # illegal file name
       || $code == 452 || $code == 552 ) { # out of space(552: quota)
    return '';
  }

  if ($code == 426                     # closed early
      || $code == 450 || $code == 451  # file busy, srvr local error
      || $code == '051') {             # added this: local rcv error

    warn "\tTemporary failure, retrying...\n";
    sleep 12;
    return undef;                           # retry
  }

        [download]


          p

[reply]
[d/l]
[select]

Back to Seekers of Perl Wisdom