AnyEvent-FTP
view release on metacpan or search on metacpan
'hostname=s' => \$host,
'inet' => \$inet,
'stderr=s' => \$stderr,
'pam=s' => sub { $simple_auth_class = 'PAM'; push @simple_auth_args, service => $_[1] },
'chroot' => \$chroot,
'verbose' => \$verbose,
'cred=s' => \$cred,
'context=s' => \$default_context,
'auth=s' => sub { $_[1] =~ /^(.*?)=(.*)$/ ? (push @simple_auth_args, $1 => $2) : ($simple_auth_class = $_[1]) },
'help|h' => sub { pod2usage({ -verbose => 2}) },
'version' => sub { say 'aeftp/AnyEvent::FTP version ', ($AnyEvent::FTP::Server::VERSION // 'dev'); exit 1 },
) || pod2usage(1);
$0 = 'aeftpd';
$port //= ($> && $^O !~ /^(cygwin|MSWin32)$/) ? undef : 21;
if($stderr)
{
open STDERR, '>>', $stderr;
}
$cred = {
user => (join '', map { chr(ord('a') + int rand(26)) } (1..10)),
pass => (join '', map { chr(ord('a') + int rand(26)) } (1..10)),
};
}
elsif(defined $cred)
{
my($user,$pass) = split /:/, $cred;
unless(defined $pass)
{
say STDERR "password not provided for --cred option";
exit 2;
}
$cred = {
user => $user,
pass => $pass,
};
}
$default_context = "AnyEvent::FTP::Server::Context::$default_context"
unless $default_context =~ /::/;
);
unless($inet)
{
$server->on_bind(sub {
my $uri = URI->new('ftp:');
$uri->host($host // 'localhost');
$uri->port(shift);
$uri->userinfo(join ':', $cred->{user}, $cred->{pass})
if defined $cred;
say $uri;
});
}
if($verbose)
{
$server->on_connect(sub {
my $con = shift;
$con->on_request(sub {
my $raw = shift;
say STDERR "CLIENT: $raw";
});
$con->on_response(sub {
my $raw = shift;
$raw =~ s/\015?\012$//g;
say STDERR "SERVER: $raw";
});
$con->on_close(sub {
say STDERR "DISCONNECT";
});
say STDERR "CONNECT";
});
}
if($cred)
{
$server->on_connect(sub {
my $con = shift;
$con->context->authenticator(sub {
my($name, $pass) = @_;
return $name eq $cred->{user}
&& $pass eq $cred->{pass};
});
});
}
elsif($simple_auth_class)
{
eval 'use Authen::Simple::' . $simple_auth_class;
if($@)
{
say STDERR "install Authen::Simple::$simple_auth_class in order to use $simple_auth_class authentication";
exit 2;
}
my $pam = "Authen::Simple::$simple_auth_class"->new(
@simple_auth_args,
);
$server->on_connect(sub {
my $con = shift;
example/fget.pl view on Meta::CPAN
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;
example/fget.pl view on Meta::CPAN
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;
example/fls.pl view on Meta::CPAN
);
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 };
example/fput.pl view on Meta::CPAN
'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)
{
lib/AnyEvent/FTP/Client.pm view on Meta::CPAN
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) = @_;
lib/AnyEvent/FTP/Client.pm view on Meta::CPAN
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;
lib/AnyEvent/FTP/Client.pm view on Meta::CPAN
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;
lib/AnyEvent/FTP/Client.pm view on Meta::CPAN
);
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;
lib/AnyEvent/FTP/Client.pm view on Meta::CPAN
'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)
{
lib/AnyEvent/FTP/Server.pm view on Meta::CPAN
my $server = AnyEvent::FTP::Server->new;
$server->start;
AnyEvent->condvar->recv;
=head1 DESCRIPTION
B<CAUTION> L<AnyEvent::FTP::Server> hasn't been audited by anyone, including
its author, in order to ensure that it is secure. It is intended to be used
primarily in testing the companion client L<AnyEvent::FTP::Client>. It can
also be used to write your own context or personality (to use the L<Net::FTPServer>
terminology) that use alternate back ends (say a database or memory store)
that could theoretically be made to be secure, but you will need to carefully
vett both the L<AnyEvent::FTP::Server> code as well as your own customizations
before you deploy on the Internet or on an untrusted network.
This class is used for L<AnyEvent::FTP> server instances.
Each time a client connects to the server a L<AnyEvent::FTP::Server::Connection>
instance is created to manage the TCP connection. Each connection
also has a L<AnyEvent::FTP::Server::Context> which defines the behavior or
personality of the server, and each context instance keeps track of the
current directory, user authentication and authorization status of each
t/anyevent_ftp_client.t view on Meta::CPAN
subtest 'retr' => sub {
reset_timeout;
skip_all 'requires client and server on localhost' if $ENV{AEF_REMOTE};
our $config;
$config->{dir} = tempdir( CLEANUP => 1 );
my $fn = File::Spec->catfile($config->{dir}, 'foo.txt');
do {
open my $fh, '>', $fn;
say $fh "line 1";
say $fh "line 2";
close $fh;
};
foreach my $passive (0,1)
{
my $client = AnyEvent::FTP::Client->new( passive => $passive );
prep_client( $client );
t/anyevent_ftp_client.t view on Meta::CPAN
$client->connect($config->{host}, $config->{port})->recv;
$client->login($config->{user}, $config->{pass})->recv;
$client->type('I')->recv;
$client->cwd(translate_dir($config->{dir}))->recv;
my $fn = File::Spec->catfile($config->{dir}, 'foo.txt');
do {
open my $fh, '>', $fn;
say $fh "line1";
close $fh;
};
do {
my $data = 'line2';
my $ret = eval { $client->appe('foo.txt', \$data)->recv; };
diag $@ if $@;
isa_ok $ret, 'AnyEvent::FTP::Response';
ok -e $fn, 'remote file exists';
my @remote = split /\015?\012/, do {
tools/test_client.pl view on Meta::CPAN
use YAML qw( LoadFile );
use File::Glob qw( bsd_glob );
my @services = do {
open my $fh, '<', '/etc/services';
map { [split /\t/]->[0] } grep /^(..)?ftp\s/, <$fh>;
};
chdir dir($FindBin::Bin)->parent->stringify;
say "[self test]";
system 'prove', '-l', '-j', 3, '-r', 't', ;#'xt';
my @client_tests = map { $_->stringify } grep { $_->basename =~ /^client_.*\.t$/ } dir(File::Spec->curdir)->subdir('t')->children(no_hidden => 1);
foreach my $service (@services)
{
local $ENV{AEF_CONFIG} = File::Spec->catfile(bsd_glob '~/.ftptest/localhost.yml');
local $ENV{AEF_PORT} = $service;
say "[$service]";
system 'prove', '-l', '-j', 3, @client_tests;
}
my @list = do {
my $dir = File::Spec->catdir(bsd_glob '~/.ftptest');
my $dh;
opendir DIR, $dir;
my @list = readdir DIR;
closedir DIR;
map { File::Spec->catfile(bsd_glob('~/.ftptest'), $_) } grep !/^localhost\.yml$/, grep !/^\./, @list;
};
foreach my $config (@list)
{
local $ENV{AEF_REMOTE} = LoadFile($config)->{remote};
local $ENV{AEF_CONFIG} = $config;
say "[$config]";
system 'prove', '-l', '-j', 3, @client_tests;
}
( run in 1.323 second using v1.01-cache-2.11-cpan-483215c6ad5 )