| line |
stmt |
bran |
cond |
sub |
pod |
time |
code |
|
1
|
|
|
|
|
|
|
package AnyEvent::FTP::Server::Context; |
|
2
|
|
|
|
|
|
|
|
|
3
|
25
|
|
|
25
|
|
16401
|
use strict; |
|
|
25
|
|
|
|
|
67
|
|
|
|
25
|
|
|
|
|
835
|
|
|
4
|
25
|
|
|
25
|
|
140
|
use warnings; |
|
|
25
|
|
|
|
|
58
|
|
|
|
25
|
|
|
|
|
736
|
|
|
5
|
25
|
|
|
25
|
|
499
|
use 5.010; |
|
|
25
|
|
|
|
|
89
|
|
|
6
|
25
|
|
|
25
|
|
140
|
use Moo; |
|
|
25
|
|
|
|
|
172
|
|
|
|
25
|
|
|
|
|
169
|
|
|
7
|
|
|
|
|
|
|
|
|
8
|
|
|
|
|
|
|
# ABSTRACT: FTP Server client context class |
|
9
|
|
|
|
|
|
|
our $VERSION = '0.18'; # VERSION |
|
10
|
|
|
|
|
|
|
|
|
11
|
|
|
|
|
|
|
with 'AnyEvent::FTP::Role::Event'; |
|
12
|
|
|
|
|
|
|
with 'AnyEvent::FTP::Server::Role::Context'; |
|
13
|
|
|
|
|
|
|
|
|
14
|
|
|
|
|
|
|
__PACKAGE__->define_events(qw( auth )); |
|
15
|
|
|
|
|
|
|
|
|
16
|
|
|
|
|
|
|
has ready => ( |
|
17
|
|
|
|
|
|
|
is => 'rw', |
|
18
|
|
|
|
|
|
|
default => sub { 1 }, |
|
19
|
|
|
|
|
|
|
); |
|
20
|
|
|
|
|
|
|
|
|
21
|
|
|
|
|
|
|
has ascii_layer => ( |
|
22
|
|
|
|
|
|
|
is => 'rw', |
|
23
|
|
|
|
|
|
|
default => ':raw:eol(CRLF-Native)' |
|
24
|
|
|
|
|
|
|
); |
|
25
|
|
|
|
|
|
|
|
|
26
|
|
|
|
|
|
|
sub push_request |
|
27
|
|
|
|
|
|
|
{ |
|
28
|
674
|
|
|
674
|
1
|
1599
|
my($self, $con, $req) = @_; |
|
29
|
|
|
|
|
|
|
|
|
30
|
674
|
|
|
|
|
1136
|
push @{ $self->{request_queue} }, [ $con, $req ]; |
|
|
674
|
|
|
|
|
2498
|
|
|
31
|
|
|
|
|
|
|
|
|
32
|
674
|
100
|
|
|
|
3688
|
$self->process_queue if $self->ready; |
|
33
|
|
|
|
|
|
|
|
|
34
|
674
|
|
|
|
|
1495
|
$self; |
|
35
|
|
|
|
|
|
|
} |
|
36
|
|
|
|
|
|
|
|
|
37
|
|
|
|
|
|
|
sub process_queue |
|
38
|
|
|
|
|
|
|
{ |
|
39
|
1264
|
|
|
1264
|
1
|
2228
|
my($self) = @_; |
|
40
|
|
|
|
|
|
|
|
|
41
|
1264
|
100
|
|
|
|
1944
|
return $self unless @{ $self->{request_queue} } > 0; |
|
|
1264
|
|
|
|
|
4283
|
|
|
42
|
|
|
|
|
|
|
|
|
43
|
674
|
|
|
|
|
1696
|
$self->ready(0); |
|
44
|
|
|
|
|
|
|
|
|
45
|
674
|
|
|
|
|
1067
|
my($con, $req) = @{ shift @{ $self->{request_queue} } }; |
|
|
674
|
|
|
|
|
1014
|
|
|
|
674
|
|
|
|
|
1679
|
|
|
46
|
|
|
|
|
|
|
|
|
47
|
674
|
|
|
|
|
2356
|
my $command = lc $req->command; |
|
48
|
|
|
|
|
|
|
|
|
49
|
674
|
50
|
|
|
|
3729
|
if($self->can('auth_command_check_hook')) |
|
50
|
|
|
|
|
|
|
{ |
|
51
|
674
|
100
|
|
|
|
2517
|
return unless $self->auth_command_check_hook($con, $command); |
|
52
|
|
|
|
|
|
|
} |
|
53
|
|
|
|
|
|
|
|
|
54
|
650
|
|
|
|
|
2687
|
my $method = join '_', 'cmd', $command; |
|
55
|
|
|
|
|
|
|
|
|
56
|
650
|
100
|
|
|
|
3122
|
if($self->can($method)) |
|
57
|
|
|
|
|
|
|
{ |
|
58
|
649
|
|
|
|
|
3151
|
$self->$method($con, $req); |
|
59
|
|
|
|
|
|
|
} |
|
60
|
|
|
|
|
|
|
else |
|
61
|
|
|
|
|
|
|
{ |
|
62
|
1
|
|
|
|
|
8
|
$self->invalid_command($con, $req); |
|
63
|
|
|
|
|
|
|
} |
|
64
|
|
|
|
|
|
|
|
|
65
|
650
|
|
|
|
|
14937
|
$self; |
|
66
|
|
|
|
|
|
|
} |
|
67
|
|
|
|
|
|
|
|
|
68
|
|
|
|
|
|
|
sub invalid_command |
|
69
|
|
|
|
|
|
|
{ |
|
70
|
1
|
|
|
1
|
1
|
5
|
my($self, $con, $req) = @_; |
|
71
|
1
|
|
|
|
|
6
|
$con->send_response(500 => $req->command . ' not understood'); |
|
72
|
1
|
|
|
|
|
5
|
$self->done; |
|
73
|
|
|
|
|
|
|
} |
|
74
|
|
|
|
|
|
|
|
|
75
|
|
|
|
|
|
|
sub invalid_syntax |
|
76
|
|
|
|
|
|
|
{ |
|
77
|
0
|
|
|
0
|
1
|
0
|
my($self, $con, $raw) = @_; |
|
78
|
0
|
|
|
|
|
0
|
$con->send_response(500 => 'Command not understood'); |
|
79
|
0
|
|
|
|
|
0
|
$self->done; |
|
80
|
|
|
|
|
|
|
} |
|
81
|
|
|
|
|
|
|
|
|
82
|
1
|
|
|
1
|
1
|
5
|
sub help_quit { "QUIT" } |
|
83
|
|
|
|
|
|
|
|
|
84
|
|
|
|
|
|
|
sub cmd_quit |
|
85
|
|
|
|
|
|
|
{ |
|
86
|
41
|
|
|
41
|
1
|
136
|
my($self, $con, $req) = @_; |
|
87
|
41
|
|
|
|
|
209
|
$con->send_response(221 => 'Goodbye'); |
|
88
|
41
|
|
|
|
|
177
|
$con->close; |
|
89
|
41
|
|
|
|
|
130
|
$self; |
|
90
|
|
|
|
|
|
|
} |
|
91
|
|
|
|
|
|
|
|
|
92
|
|
|
|
|
|
|
sub done |
|
93
|
|
|
|
|
|
|
{ |
|
94
|
631
|
|
|
631
|
1
|
1525
|
my($self) = @_; |
|
95
|
631
|
|
|
|
|
1998
|
$self->ready(1); |
|
96
|
631
|
|
|
|
|
1957
|
$self->process_queue; |
|
97
|
631
|
|
|
|
|
1871
|
$self; |
|
98
|
|
|
|
|
|
|
} |
|
99
|
|
|
|
|
|
|
|
|
100
|
|
|
|
|
|
|
1; |
|
101
|
|
|
|
|
|
|
|
|
102
|
|
|
|
|
|
|
__END__ |