Chas. Owens schrieb:
Based on a cursory reading of the perldoc, it looks like the ALLO command is 
only sent if you call the Net::FTP::alloc method.  If you aren't calling it, 
can you provide a toy test case for us where the code sends ALLO.  I will try 
to debug why it is sending a command you aren't asking for.

I´ve been looking at the documentation on cpan and found no way to disable the
using of ALLO, and no mention of the alloc method.

I´m not calling the Net::FTP::alloc method[2], only put:


sub update_client_form($cgi, $ftp, $dir, $form_local, $form_remote) {
  unless($ftp->put($form_local, $form_remote)) {
    say $cgi->h1('WARNUNG: das Formular konnte nicht aktualisiert werden');
    return 0;
  }
  unless($ftp->rmdir($dir . 'metadata', 1)) {
    say $cgi->h1('WARNUNG: Metadaten konnten nicht gelöscht werden');
    return 0;
  }

  unless($ftp->rmdir($dir . '.cache', 1)) {
    say $cgi->h1('WARNUNG: der Zwischenspeicher konnte nicht gelöscht werden');
    return 0;
  }

  return 1;
}


my $ftp = Net::FTP->new($client, Port=> $PORT, Timeout => 20, Debug => 1);


The put fails:


Net::FTP>>> Net::FTP(2.79)
Net::FTP>>>   Exporter(5.71)
Net::FTP>>>   Net::Cmd(2.30)
Net::FTP>>>   IO::Socket::INET(1.35)
Net::FTP>>>     IO::Socket(1.37)
Net::FTP>>>       IO::Handle(1.35)
Net::FTP=GLOB(0x2e70a18)<<< 220 FTPServer ready (cwd is /)
Net::FTP=GLOB(0x2e70a18)>>> USER ftp
Net::FTP=GLOB(0x2e70a18)<<< 331 - Login as ftp OK. Send password
Net::FTP=GLOB(0x2e70a18)>>> PASS ....
Net::FTP=GLOB(0x2e70a18)<<< 230 - Password accepted
Net::FTP=GLOB(0x2e70a18)>>> TYPE I
Net::FTP=GLOB(0x2e70a18)<<< 200 Switching to mode TYPE I
Net::FTP=GLOB(0x2e70a18)>>> PORT 192,168,220,192,210,156
Net::FTP=GLOB(0x2e70a18)<<< 200 PORT command successful
Net::FTP=GLOB(0x2e70a18)>>> NLST /storage/sdcard0/odk/instances/
Net::FTP=GLOB(0x2e70a18)<<< 150 Directory listing for 
storage/sdcard0/odk/instances/
Net::FTP=GLOB(0x2e70a18)<<< 226 Directory send OK.
Net::FTP=GLOB(0x2e70a18)>>> PORT 192,168,220,192,203,166
Net::FTP=GLOB(0x2e70a18)<<< 200 PORT command successful
Net::FTP=GLOB(0x2e70a18)>>> ALLO 17017
Net::FTP=GLOB(0x2e70a18)<<< 500 ALLO not understood


If you are calling Net::FTP::alloc (eg $ftp->alloc( -s $file_to_send )), then 
stop calling it and you should not get anymore errors.  If the program connects to 
multiple FTP servers and some want ALLO and some don't then either wrap that code 
in an if statement, or if it is too much code and you don't want to touch it all, 
you can always monkey patch the method.  You could put something like this in your 
script and all calls to Net::FTP::alloc in that script will run your version 
instead of the original (warning untested code):

use Net::FTP
BEGIN {
     no warnings "redefine";
     my %bad_hosts = (
         bad_host_that_does_not_understand_allo => 1,
     );
     my $old_alloc = *Net::FTP::alloc{CODE};
     *Net::FTP::alloc = sub {
         return if $bad_hosts{ $_[0]->host };
         $old_alloc->(@_);
     }
}

That will cause it to do nothing when you call Net::FTP::alloc with on an 
Net::FTP object that is connected to a host in the %bad_hosts hash.

Thank you very much, I could try that out.  Perhaps the ALLO command is
send by default when you call the put method, and advising[1] the method
to do nothing might help.

The hosts are cell phones, and I tried two different FTP servers for
Android, both of which don´t comply to the RFC in that they mistreat the
ALLO command.

My program fetches some files, if there, and attempts to replace another.
It works fine until I call the put method, which sends the ALLO command.
I could just disable the ALLO command for all hosts without exceptions.

Hm ...:


use Net::FTP;
BEGIN {
#  no warnings "redefine";
  my $old_alloc = *Net::FTP::alloc{CODE};
  *Net::FTP::alloc = sub { return };
  $old_alloc->(@_);
}


Subroutine Net::FTP::alloc redefined at [...] line 14.
Can't use an undefined value as a symbol reference at 
/usr/lib64/perl5/vendor_perl/5.20.1/Net/FTP.pm line 415.
BEGIN failed--compilation aborted at [...] line 16.


I´m not sure what this means.  Line 14 is '*Net::FTP::alloc = sub { return; };',
but when I look at /usr/lib64/perl5/vendor_perl/5.20.1/Net/FTP.pm,
'${*$ftp}{'net_ftp_allo'}' seems to be undefined.

This doesn´t work, either:


use Net::FTP;
BEGIN {
  #  no warnings "redefine";

  my $old_alloc = *Net::FTP::alloc{CODE};
  *Net::FTP::alloc =
    sub {
      my $ftp    = shift;
      my $size   = shift;
      my $oldval = ${*$ftp}{'net_ftp_allo'};

      return $oldval
        unless (defined $size);

      # return undef
      #   unless ($ftp->_ALLO($size, @_));

      ${*$ftp}{'net_ftp_allo'} = join(" ", $size, @_);

      $oldval;
    };

  $old_alloc->(@_);
}


So how do you advise functions in perl?

(If anything fails, I guess I could copy the whole module and use
my own, modified version, but that isn´t an elegant solution.)


For reference:

/usr/lib64/perl5/vendor_perl/5.20.1/Net/FTP.pm

    412 sub alloc {
    413   my $ftp    = shift;
    414   my $size   = shift;
    415   my $oldval = ${*$ftp}{'net_ftp_allo'};
    416
    417   return $oldval
    418     unless (defined $size);
    419
    420   return undef
    421     unless ($ftp->_ALLO($size, @_));
    422
    423   ${*$ftp}{'net_ftp_allo'} = join(" ", $size, @_);
    424
    425   $oldval;
    426 }


[1]: 'advising', or 'advise', as one can do in elisp, in lack of
     a better term

[2]: looking at the source: The put method does automatically call
     the alloc method, with no way around that (unless I can somehow
     advise the alloc method or another one).  My approach would be
     to ignore a failure of the ALLO command and try to store anyway.


On Fri, Aug 19, 2016 at 9:20 AM hw <h...@gc-24.de <mailto:h...@gc-24.de>> wrote:


    Hi,

    is there some way to prevent Net::FTP from using the ALLO command or
    to make it ignore failures when this command is used?

    I have to deal with ftp servers that do not understand the ALLO command.

    --
    To unsubscribe, e-mail: beginners-unsubscr...@perl.org 
<mailto:beginners-unsubscr...@perl.org>
    For additional commands, e-mail: beginners-h...@perl.org 
<mailto:beginners-h...@perl.org>
    http://learn.perl.org/




--
To unsubscribe, e-mail: beginners-unsubscr...@perl.org
For additional commands, e-mail: beginners-h...@perl.org
http://learn.perl.org/


Reply via email to