view release on metacpan or  search on metacpan

t/bin/ftpd  view on Meta::CPAN

use AnyEvent; ## no critic
use AnyEvent::FTP::Server;
use JSON::PP qw( encode_json decode_json );
use Path::Tiny qw( path );
use Getopt::Long qw( GetOptions );

my $daemon = 0;
my $kill   = 0;
my $host   = 'localhost';

GetOptions(
  "d"       => \$daemon,
  "k"       => \$kill,
  "hosth=s" => \$host,
);

my $bindir    = path(__FILE__)->parent->absolute;
my $distdir   = $bindir->parent->parent;

my $config_file = $bindir->child('ftpd.json');

if(-r $config_file)
{
  my $config = decode_json($config_file->slurp);
  my $pid = $config->{pid};
  if(defined $pid)
  {
    kill 'KILL', $pid;
  }
}

exit if $kill;

if($daemon)
{
  require Proc::Daemon;
  my $daemon = Proc::Daemon->new(
    child_STDOUT => $bindir->child('ftpd.log')->stringify,
    child_STDERR => $bindir->child('ftpd.log')->stringify,
  );
  $daemon->Init;
}

my $server = AnyEvent::FTP::Server->new(
  host            => $host,
  port            => 0,
  default_context => 'AnyEvent::FTP::Server::Context::FSRO',
);

my %config = (
  user => join('', map { chr(ord('a') + int rand(26)) } (1..10)),
  pass => join('', map { chr(ord('a') + int rand(26)) } (1..10)),
  root => $distdir->child('corpus/dist')->stringify,
  pid             => $$,
);

my $url = URI->new("ftp://localhost");
$url->host($host);
$url->path($config{root});
$url->user($config{user});
$url->password($config{pass});

$server->on_bind(sub {
  my $port = shift;
  $url->port($port);
});

$server->on_connect(sub {
  my $con = shift;
  $con->context->authenticator(sub {
    my($user, $pass) = @_;
    $user eq $config{user} && $pass eq $config{pass} ? 1 : 0;
  });
  $con->context->bad_authentication_delay(0);
});


$server->start;

$config{url} = $url->as_string;
$config_file->spew(encode_json(\%config));

print "$url\n";

AnyEvent->condvar->recv;