AnyEvent-FTP
view release on metacpan or search on metacpan
lib/AnyEvent/FTP/Client.pm view on Meta::CPAN
$host = URI->new($host);
}
my $uri;
if(ref($host) && eval { $host->isa('URI') })
{
$uri = $host;
$host = $uri->host;
$port = $uri->port;
}
else
{
$port //= 21;
}
croak "Tried to reconnect while connected" if $self->_connected;
my $cv = AnyEvent->condvar;
$self->_connected(1);
tcp_connect $host, $port, sub {
my($fh) = @_;
unless($fh)
{
$cv->croak("unable to connect: $!");
$self->_connected(0);
$self->clear_command;
return;
}
# Get the IP address we are sending from for when
# we use the PORT command (passive=0).
$self->{my_ip} = do {
my($port, $addr) = unpack_sockaddr_in getsockname $fh;
inet_ntoa $addr;
};
$self->{handle} = AnyEvent::Handle->new(
fh => $fh,
on_error => sub {
my ($hdl, $fatal, $msg) = @_;
$_[0]->destroy;
$self->emit('error', $msg);
$self->emit('close');
},
on_eof => sub {
$self->{handle}->destroy;
$self->emit('close');
},
);
$self->on_next_response(sub {
my $res = shift;
return $cv->croak($res) unless $res->is_success;
$self->emit(greeting => $res);
if(defined $uri)
{
my @start_commands = (
[USER => $uri->user],
[PASS => $uri->password],
);
push @start_commands, [CWD => $uri->path] if $uri->path ne '';
$self->unshift_command(@start_commands, $cv);
}
else
{
$cv->send($res);
$self->pop_command;
}
});
$self->{handle}->on_read(sub {
$self->{handle}->push_read( line => sub {
my($handle, $line) = @_;
$self->process_message_line($line);
});
});
}, sub {
$self->timeout;
};
return $cv;
}
sub login
{
my($self, $user, $pass) = @_;
$self->push_command(
[ USER => $user ],
[ PASS => $pass ]
);
}
sub retr
{
my($self, $filename, $local) = (shift, shift, shift);
my $args = ref $_[0] eq 'HASH' ? (\%{$_[0]}) : ({@_});
$self->_fetch->new({
command => [ RETR => $filename ],
local => $local,
client => $self,
restart => $args->{restart},
});
}
sub stor
{
my($self, $filename, $local) = @_;
$self->_store->new(
command => [STOR => $filename],
local => $local,
client => $self,
);
}
lib/AnyEvent/FTP/Client.pm view on Meta::CPAN
Same, but using recv to wait for each command to complete (not supported in all event loops):
use strict;
use warnings;
use AnyEvent;
use AnyEvent::FTP::Client;
my $client = AnyEvent::FTP::Client->new( passive => 1);
my $done = AnyEvent->condvar;
# connect to CPAN ftp server
$client->connect('ftp://ftp.cpan.org/pub/CPAN/src')->recv;
# use binary mode
$client->type('I')->recv;
# download the file directly into a filehandle
open my $fh, '>', 'perl-5.16.3.tar.gz';
$client->retr('perl-5.16.3.tar.gz', $fh)->recv;
=head1 DESCRIPTION
This class provides an AnyEvent client interface to the File
Transfer Protocol (FTP).
=head1 ROLES
This class consumes these roles:
=over 4
=item *
L<AnyEvent::FTP::Role::Event>
=item *
L<AnyEvent::FTP::Client::Role::ResponseBuffer>
=item *
L<AnyEvent::FTP::Client::Role::RequestBuffer>
=back
=head1 EVENTS
For details on the event interface see L<AnyEvent::FTP::Role::Event>.
=head2 send
This event gets fired on every command sent to the remote server. Keep
in mind that some methods of L<AnyEvent::FTP> may make multiple FTP commands
in order to implement their functionality (for example, C<recv>, C<stor>, etc).
One use of this event is to print out commands as they are sent for debugging:
$client->on_send(sub {
my($cmd, $arguments) = @_;
$arguments //= '';
# hide passwords
$arguments = 'XXXX' if $cmd =~ /^pass$/i;
say "CLIENT: $cmd $arguments";
});
=head2 error
This event is emitted when there is a network error with the remote server.
It passes in a string which describes in human readable description of what
went wrong.
$client->on_error(sub {
my($message) = @_;
warn "network error: $message";
});
=head2 close
This event is emitted when the connection with the remote server is closed,
either due to an error, or when you send the FTP C<QUIT> command using the
C<quid> method.
$client->on_close(sub {
# called when connection closed
});
=head2 greeting
This event gets fired on the first response returned from the server. This
is usually a C<220> message which may or may not reveal the server software.
$client->on_greeting(sub {
# $res is a AnyEvent::FTP::Client::Response
my($res) = @_;
if($res->message->[0] =~ /ProFTPD/)
{
# detected a ProFTPD server
}
});
=head2 each_response
This event gets fired for each response returned from the server. This can
be useful for printing the responses for debugging.
$client->on_each_response(sub {
# $res isa AnyEvent::FTP::Client::Response
my($res) = @_;
print "SERVER: $res\n";
});
=head2 next_response
Works just like C<each_response> event, but only gets fired for the next response
received.
=head1 ATTRIBUTES
=head2 timeout
Timeout for the initial connection to the FTP server. The default
lib/AnyEvent/FTP/Client.pm view on Meta::CPAN
for the server to send to.
=head1 METHODS
Unless otherwise specified, these methods will return an AnyEvent condition variable
(AnyEvent->condvar) or an object that implements its interface (methods C<recv>, C<cb>).
On success the C<send> will be used on the condition variable, on failure C<croak> will be
used instead. Unless otherwise specified the object sent (for both success and failure)
will be an instance of L<AnyEvent::FTP::Client::Response>.
As an example, here is a fairly thorough handling of a response to the standard FTP C<HELP>
command:
$client->help->cb(sub {
my $res = eval { shift->recv };
if(my $error = $@)
{
# $error isa AnyEvent::FTP::Client::Response with a 4xx or 5xx
# code
my $code = $error->code;
# the message component is always a list ref, even if
# the response had just one message line
my @msg = @{ $error->message };
# $error is stringified into something human readable when
# it is streated as a string
warn "error trying FTP HELP command: $error";
}
else
{
# $res isa AnyEvent::FTP::Client::Response with a 2xx or 3xx
# code
my $code = $res->code;
# the message component is always a list ref, even if
# the response had just one message line
my @msg = @{ $res->message };
# $res is stringified into something human readable when
# it is streated as a string
print "help message: $res";
}
});
=head2 connect
$client->connect(@remote_host);
Connect to the FTP server. The remote host may be specified in one
of these ways:
=over 4
=item $client-E<gt>connect($host, [ $port ])
The host and port of the remote server. If not specified, the default FTP port will be used (21).
=item $client-E<gt>connect($uri)
The URI of the remote FTP server. C<$uri> must be either an instance of L<URI> with the C<ftp>
scheme, or a string with an FTP URL.
If you use this method to connect to the FTP server, connect will also attempt to login with
the username and password specified in the URL (or anonymous FTP if no credentials are
specified).
If there is a path included in the URL, then connect will also do a C<CWD> so that you start
in that directory.
=back
=head2 login
$client->login($user, $pass);
Attempt to login to the FTP server which has already been connected to using
the C<connect> method. This is not necessary if you used C<connect> with a URI.
=head2 retr
$client->retr($filename, $local, %options)
Retrieve the given file from the server and use C<$local> to store the results.
Returns an instance of L<AnyEvent::FTP::Client::Transfer>, which supports the
AnyEvent condition variable interface (that is it has C<cb> and C<recv> methods).
Its callback will be called when the transfer is complete.
C<$local> may be one of
=over 4
=item scalar reference
The contents of the file will be stored in the scalar referred to by the reference.
my $local;
$client->retr('foo.txt', \$local);
=item file handle
The content of the remote file will be written into the local file handle as it is
received
open my $fh, '>', 'foo.txt';
binmode $fh;
$client->retr('foo.txt', $fh);
=item the name of the local file
If C<$local> is just a regular non reference scalar, then it will be treated as the
local filename, which will be created and written to as data is received from the
server.
$client->retr('foo.txt', 'foo.txt');
=item subroutine reference / callback reference
The contents of the file will be passed to the callback as they are received.
$client->retr('foo.txt', sub {
my ($data) = @_;
# Do something with $data
},
lib/AnyEvent/FTP/Client.pm view on Meta::CPAN
=head2 rnfr
$client->rnfr;
Specify the old name for renaming a file. See C<rename> method for a shortcut.
=head2 rnto
$client->rnto;
Specify the new name for renaming a file. See C<rename> method for a shortcut.
=head2 noop
$client->noop;
Don't do anything. The server will send an OK reply.
=head2 allo
$client->allo( $size );
Send the FTP C<ALLO> command. Is not used by modern FTP servers. See RFC959 for details.
=head2 syst
$client->syst;
Returns the type of operating system used by the server.
=head2 stru
$client->stru;
Specify the file structure mode. This is not used by modern FTP servers. See RFC959 for details.
=head2 mode
$client->mode
Specify the transfer mode. This is not used by modern FTP servers. See RFC959 for details.
=head2 stat
$client->stat;
$client->stat($path);
Get information about a file or directory on the remote server. The actual format is totally
server dependent.
=head2 user
$client->user( $username );
Specify the user to login as. See C<connect> or C<login> methods for a shortcut.
=head2 pass
$client->pass( $pass );
Specify the password to use for login. See C<connect> or C<login> methods for a shortcut.
=head2 acct
$client->acct( $acct );
Specify user's account. This is sometimes used for authentication and authorization when you login
to some servers, but is seldom used today in practice. See RFC959 for details.
=head2 size
$client->size( $path );
Get the size of the remote file specified by C<$path>. This is an extension to the FTP
standard specified in RFC3659, and may not be implemented by older (or even newer)
servers.
Send the size of the file on success, instead of the response object.
=head2 mdtm
$client->mdtm( $path );
Get the modification time of the remote file specified by C<$path>. This is an extension to the FTP standard
specified in RFC3659, and may not be implemented by older (or even newer) servers.
=head2 quit
$client->quit;
Send the FTP C<QUIT> command and close the connection to the remote server.
=head2 site
$client->site;
The C<site> method provides an interface to site specific FTP commands. Many
FTP servers will support an extended set of commands using the standard FTP
C<SITE> command. This command will not check to see if the site commands are
supported by the remote server, so it is up to you to determine if you can
really use these interfaces yourself.
=over 4
=item $client-E<gt>site-E<gt>microsoft
For commands specific to Microsoft's IIS FTP server.
See L<AnyEvent::FTP::Client::Site::Microsoft>.
=item $client-E<gt>site-E<gt>net_ftp_server
For commands specific to L<Net::FTPServer>.
See L<AnyEvent::FTP::Client::Site::NetFtpServer>.
=item $client-E<gt>site-E<gt>proftpd
For commands specific to proftpd.
See L<AnyEvent::FTP::Client::Site::Proftpd>.
=back
=head1 EXAMPLES
Here are some longer examples. They are also included with the
L<AnyEvent::FTP> distribution in its C<example> directory.
=head2 fget.pl
Given a URL to a file, this script will fetch the file and store it
on your local machine. If you use the C<-d> option you can see the
FTP commands and their responses as they happen.
#!/usr/bin/perl
use strict;
use warnings;
use autodie;
use 5.010;
use AnyEvent::FTP::Client;
use URI;
use URI::file;
use Term::ProgressBar;
use Term::Prompt qw( prompt );
use Getopt::Long qw( GetOptions );
use Path::Class qw( file );
my $debug = 0;
my $progress = 0;
my $active = 0;
GetOptions(
'd' => \$debug,
'p' => \$progress,
'a' => \$active,
);
my $remote = shift;
unless(defined $remote)
{
say STDERR "usage: perl fget.pl [ -d | -p ] [ -a ] remote";
say STDERR " where remote is a URL for a file on an FTP server";
say STDERR " and local is a local filename (optional) where to transfer it to";
say STDERR " -d (optional) prints FTP commands and responses";
say STDERR " -p (optional) displays a progress bar as the file uploads";
say STDERR " -a (optional) use active mode transfer";
exit 2;
}
$remote = URI->new($remote);
unless($remote->scheme eq 'ftp')
{
say STDERR "only FTP URLs are supported";
exit 2;
}
unless(defined $remote->password)
{
$remote->password(prompt('p', 'Password: ', '', ''));
say '';
}
do {
my $from = $remote->clone;
$from->password(undef);
say "SRC: ", $from;
};
my @path = split /\//, $remote->path;
my $fn = pop @path;
if(-e $fn)
{
say STDERR "local file already exists";
exit 2;
}
my $ftp = AnyEvent::FTP::Client->new( passive => $active ? 0 : 1 );
$ftp->on_send(sub {
my($cmd, $arguments) = @_;
$arguments //= '';
$arguments = 'XXXX' if $cmd eq 'PASS';
say "CLIENT: $cmd $arguments"
if $debug;
});
$ftp->on_each_response(sub {
my $res = shift;
if($debug)
{
say sprintf "SERVER: [ %d ] %s", $res->code, $_ for @{ $res->message };
}
});
$ftp->connect($remote->host, $remote->port)->recv;
$ftp->login($remote->user, $remote->password)->recv;
$ftp->type('I')->recv;
$ftp->cwd(join '/', '', @path)->recv;
my $remote_size;
if($progress)
{
my $listing = $ftp->list($fn)->recv;
foreach my $class (qw( File::Listing File::Listing::Ftpcopy ))
{
my $parsed_listing = eval qq{ use $class; ${class}::parse_dir(\$listing->[0]) };
next if $@;
my ($name, $type, $size, $mtime, $mode) = @{ $parsed_listing->[0] };
$remote_size = $size;
last;
}
if(defined $remote_size)
{
}
else
{
say STDERR "could not determine size of remote file, cannot provide progress bar";
$progress = 0;
}
}
open my $fh, '>', $fn;
my $xfer = $ftp->retr($fn);
my $pb;
my $count = 0;
$xfer->on_open(sub {
my $handle = shift;
$pb = Term::ProgressBar->new({ count => $remote_size })
if $progress;
$handle->on_read(sub {
$handle->push_read(sub {
print $fh $_[0]{rbuf};
$pb->update($count += length($_[0]{rbuf})) if $pb;
$_[0]{rbuf} = '';
});
});
});
$xfer->recv;
close $fh;
$ftp->quit->recv;
=head2 fls.pl
Here is a similar example, which does a directory listing on a FTP
directory URL. If you use the C<-d> option to see the FTP commands
and their responses as they happen. You can use the C<-l> option
to see the long form of the file listing.
use strict;
use warnings;
use 5.010;
use URI;
use AnyEvent::FTP::Client;
use Term::Prompt qw( prompt );
use Getopt::Long qw( GetOptions );
my $debug = 0;
my $method = 'nlst';
GetOptions(
'd' => \$debug,
'l' => sub { $method = 'list' },
);
my $ftp = AnyEvent::FTP::Client->new;
if($debug)
{
$ftp->on_send(sub {
my($cmd, $arguments) = @_;
$arguments //= '';
$arguments = 'XXXX' if $cmd eq 'PASS';
say "CLIENT: $cmd $arguments";
});
$ftp->on_each_response(sub {
my $res = shift;
say sprintf "SERVER: [ %d ] %s", $res->code, $_ for @{ $res->message };
});
}
my $uri = shift;
unless(defined $uri)
{
say STDERR "usage: perl fls.pl URL\n";
exit 2;
}
$uri = URI->new($uri);
unless($uri->scheme eq 'ftp')
{
say STDERR "only FTP URL accpeted";
exit 2;
}
unless(defined $uri->password)
{
$uri->password(prompt('p', 'Password: ', '', ''));
say '';
}
my $path = $uri->path;
$uri->path('');
$ftp->connect($uri);
say $_ for @{ $ftp->$method($path)->recv };
=head2 fput.pl
This script uploads a local file to the remote given a local filename
and a remote FTP URL.
#!/usr/bin/perl
use strict;
use warnings;
use autodie;
use 5.010;
use AnyEvent::FTP::Client;
use URI;
use URI::file;
use Term::ProgressBar;
use Term::Prompt qw( prompt );
use Getopt::Long qw( GetOptions );
use Path::Class qw( file );
my $debug = 0;
my $progress = 0;
my $active = 0;
GetOptions(
'd' => \$debug,
'p' => \$progress,
'a' => \$active,
);
my $local = shift;
my $remote = shift;
unless(defined $local && defined $remote)
{
say STDERR "usage: perl fput.pl [ -d | -p ] [ -a ] local remote";
say STDERR " where local is a local file";
say STDERR " and remote is a URL for a FTP server";
say STDERR " -d (optional) prints FTP commands and responses";
say STDERR " -p (optional) displays a progress bar as the file uploads";
say STDERR " -a (optional) use an active transfer instead of passive";
exit 2;
}
$local = file($local);
$remote = URI->new($remote);
unless($remote->scheme eq 'ftp')
{
say STDERR "only FTP URLs are supported";
exit 2;
}
unless(defined $remote->password)
{
$remote->password(prompt('p', 'Password: ', '', ''));
say '';
}
do {
my $from = URI::file->new_abs($local);
my $to = $remote->clone;
$to->password(undef);
say "SRC: ", $from;
say "DST: ", $to;
};
my $ftp = AnyEvent::FTP::Client->new( passive => $active ? 0 : 1 );
$ftp->on_send(sub {
my($cmd, $arguments) = @_;
$arguments //= '';
$arguments = 'XXXX' if $cmd eq 'PASS';
say "CLIENT: $cmd $arguments"
if $debug;
});
$ftp->on_each_response(sub {
my $res = shift;
if($debug)
{
say sprintf "SERVER: [ %d ] %s", $res->code, $_ for @{ $res->message };
}
});
$ftp->connect($remote->host, $remote->port)->recv;
$ftp->login($remote->user, $remote->password)->recv;
$ftp->type('I')->recv;
if(defined $remote->path)
{
$ftp->cwd($remote->path)->recv;
}
open my $fh, '<', $local;
binmode $fh;
my $buffer;
my $count;
my $pb;
my $xfer = $ftp->stor($local->basename);
$xfer->on_open(sub {
my $whandle = shift;
$pb = Term::ProgressBar->new({ count => -s $fh })
if $progress;
$whandle->on_drain(sub {
$pb->update($count) if $pb;
my $ret = read $fh, $buffer, 1024 * 512;
$count += $ret;
if($ret > 0)
{
$whandle->push_write($buffer);
}
else
{
$pb->update($count) if $pb;
$whandle->push_shutdown;
close $fh;
}
});
});
$xfer->recv;
$ftp->quit->recv;
=head1 SEE ALSO
=over 4
=item *
L<AnyEvent::FTP>
=item *
L<AnyEvent::FTP::Server>
=back
=head1 AUTHOR
Author: Graham Ollis E<lt>plicease@cpan.orgE<gt>
( run in 1.918 second using v1.01-cache-2.11-cpan-39bf76dae61 )