view release on metacpan or  search on metacpan

bin/aeftpd  view on Meta::CPAN

GetOptions(
  'port=i'      => \$port,
  '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 = 'random'
  if ! defined($cred) && ! defined($simple_auth_class);

if(defined $cred && $cred eq 'random')
{
  $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 =~ /::/;

my $server = AnyEvent::FTP::Server->new(
  hostname        => $host,
  port            => $port,
  inet            => $inet,
  default_context => $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;