view release on metacpan or  search on metacpan

lib/AnyEvent/FTP/Server/Role/Auth.pm  view on Meta::CPAN

  my($self, $con, $command) = @_;
  return 1 if $self->authenticated || $self->_safe_commands->{$command};
  $con->send_response(530 => 'Please login with USER and PASS');
  $self->done;
  return 0;
}


sub help_user { 'USER <sp> username' }

sub cmd_user
{
  my($self, $con, $req) = @_;

  my $user = $req->args;
  $user =~ s/^\s+//;
  $user =~ s/\s+$//;

  if($user ne '')
  {
    $self->user($user);
    $con->send_response(331 => "Password required for $user");
  }
  else
  {
    $con->send_response(530 => "USER requires a parameter");
  }

  $self->done;
}


sub help_pass { 'PASS <sp> password' }

sub cmd_pass
{
  my($self, $con, $req) = @_;

  my $user = $self->user;
  my $pass = $req->args;

  unless(defined $user)
  {
    $con->send_response(503 => 'Login with USER first');
    $self->done;
    return;
  }

  if($self->authenticator->($user, $pass))
  {
    $con->send_response(230 => "User $user logged in");
    $self->{authenticated} = 1;
    $self->emit(auth => $user);
    $self->done;
  }
  else
  {
    my $delay = $self->bad_authentication_delay;
    if($delay > 0)
    {
      my $timer;
      $timer = AnyEvent->timer( after => 5, cb => sub {
        $con->send_response(530 => 'Login incorrect');
        $self->done;
        undef $timer;
      });
    }
    else
    {
      $con->send_response(530 => 'Login incorrect');
      $self->done;
    }
  }
}

1;

__END__

=pod

=encoding UTF-8

=head1 NAME

AnyEvent::FTP::Server::Role::Auth - Authentication role for FTP server

=head1 VERSION

version 0.20

=head1 SYNOPSIS

In your context:

 package AnyEvent::FTP::Server::Context::MyContext;
 
 use Moo;
 extends 'AnyEvent::FTP::Server::Context';
 with 'AnyEvent::FTP::Server::Role::Auth';
 
 has '+unauthenticated_safe_commands' => (
   default => sub { [ qw( USER PASS HELP QUIT FOO ) ] },
 );
 
 # this command is deemed safe pre auth by
 # unauthenticated_safe_commands
 sub cmd_foo
 {
   my($self, $con, $req) = @_;
   $con->send_response(211 => 'Here to stay');
   $self->done;
 }
 
 # this command can pnly be executed after
 # authentication
 sub cmd_bar
 {
   my($self, $con, $req) = @_;
   $con->send_response(211 => 'And another thing');
   $self->done;
 }

Then when you create your server object: