If you want to get rid of ALLO completely, it looks like you just need to
monkeypatch Net::FTP::_ALLO to return 1:

use Net::FTP;
BEGIN {
    no warnings "redefine";
    *Net::FTP::_ALLO = sub { 1 };
}

This replaces the _ALLO method of Net::FTP with a new method that just
returns 1.  I set it up like that because the actual code is:

sub _ALLO { shift->command("ALLO", @_)->response() == CMD_OK }

So it looks like it expects the return value to be either true or false.
None of the calls seemed to check the value, but better to be safe than
sorry.



On Fri, Aug 19, 2016 at 1:13 PM hw <h...@gc-24.de> wrote:

> 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/
> >
> >
>
>

Reply via email to