File Coverage

blib/lib/AnyEvent/FTP/Server/Role/Auth.pm
Criterion Covered Total %
statement 43 48 89.5
branch 9 10 90.0
condition 3 3 100.0
subroutine 9 10 90.0
pod 1 5 20.0
total 65 76 85.5


line stmt bran cond sub pod time code
1             package AnyEvent::FTP::Server::Role::Auth;
2              
3 25     25   239843 use strict;
  25         235  
  25         896  
4 25     25   147 use warnings;
  25         57  
  25         664  
5 25     25   453 use 5.010;
  25         96  
6 25     25   612 use Moo::Role;
  25         17555  
  25         175  
7              
8             # ABSTRACT: Authentication role for FTP server
9             our $VERSION = '0.18'; # VERSION
10              
11              
12             has user => (is => 'rw');
13              
14              
15             has authenticated => (is => 'rw', default => sub { 0 } );
16              
17              
18             has authenticator => (
19             is => 'rw',
20             lazy => 1,
21             default => sub { sub { 0 } },
22             );
23              
24              
25             has bad_authentication_delay => (
26             is => 'rw',
27             default => sub { 5 },
28             );
29              
30              
31             has _safe_commands => (
32             is => 'ro',
33             lazy => 1,
34             default => sub {
35             my %h = map { (lc $_ => 1) } @{ shift->unauthenticated_safe_commands };
36             \%h;
37             },
38             );
39              
40             has unauthenticated_safe_commands => (
41             is => 'ro',
42             lazy => 1,
43             default => sub {
44             [qw( USER PASS HELP QUIT )]
45             },
46             );
47              
48              
49             sub auth_command_check_hook
50             {
51 674     674 1 1572 my($self, $con, $command) = @_;
52 674 100 100     7479 return 1 if $self->authenticated || $self->_safe_commands->{$command};
53 24         263 $con->send_response(530 => 'Please login with USER and PASS');
54 24         107 $self->done;
55 24         77 return 0;
56             }
57              
58              
59 6     6 0 27 sub help_user { 'USER username' }
60              
61             sub cmd_user
62             {
63 69     69 0 218 my($self, $con, $req) = @_;
64              
65 69         236 my $user = $req->args;
66 69         256 $user =~ s/^\s+//;
67 69         230 $user =~ s/\s+$//;
68              
69 69 100       274 if($user ne '')
70             {
71 68         324 $self->user($user);
72 68         364 $con->send_response(331 => "Password required for $user");
73             }
74             else
75             {
76 1         4 $con->send_response(530 => "USER requires a parameter");
77             }
78              
79 69         615 $self->done;
80             }
81              
82              
83 6     6 0 25 sub help_pass { 'PASS password' }
84              
85             sub cmd_pass
86             {
87 69     69 0 239 my($self, $con, $req) = @_;
88              
89 69         251 my $user = $self->user;
90 69         210 my $pass = $req->args;
91              
92 69 100       266 unless(defined $user)
93             {
94 1         4 $con->send_response(503 => 'Login with USER first');
95 1         6 $self->done;
96 1         2 return;
97             }
98              
99 68 100       1379 if($self->authenticator->($user, $pass))
100             {
101 64         912 $con->send_response(230 => "User $user logged in");
102 64         205 $self->{authenticated} = 1;
103 64         512 $self->emit(auth => $user);
104 64         319 $self->done;
105             }
106             else
107             {
108 4         77 my $delay = $self->bad_authentication_delay;
109 4 50       21 if($delay > 0)
110             {
111 0         0 my $timer;
112             $timer = AnyEvent->timer( after => 5, cb => sub {
113 0     0   0 $con->send_response(530 => 'Login incorrect');
114 0         0 $self->done;
115 0         0 undef $timer;
116 0         0 });
117             }
118             else
119             {
120 4         20 $con->send_response(530 => 'Login incorrect');
121 4         21 $self->done;
122             }
123             }
124             }
125              
126             1;
127              
128             __END__