File Coverage

blib/lib/AnyEvent/FTP/Server/Role/TransferPrep.pm
Criterion Covered Total %
statement 61 75 81.3
branch 5 8 62.5
condition n/a
subroutine 17 17 100.0
pod 1 7 14.2
total 84 107 78.5


line stmt bran cond sub pod time code
1             package AnyEvent::FTP::Server::Role::TransferPrep;
2              
3 23     23   266361 use strict;
  23         95  
  23         792  
4 23     23   153 use warnings;
  23         143  
  23         673  
5 23     23   551 use 5.010;
  23         91  
6 23     23   726 use Moo::Role;
  23         18239  
  23         166  
7 23     23   13254 use AnyEvent;
  23         23717  
  23         1136  
8 23     23   2890 use AnyEvent::Socket qw( tcp_server tcp_connect );
  23         111492  
  23         1950  
9 23     23   3530 use AnyEvent::Handle;
  23         33664  
  23         22153  
10              
11             # ABSTRACT: Interface for PASV, PORT and REST commands
12             our $VERSION = '0.17'; # VERSION
13              
14              
15             has data => (
16             is => 'rw',
17             );
18              
19              
20             has restart_offset => (
21             is => 'rw',
22             );
23              
24              
25             sub clear_data
26             {
27 70     70 1 271 my($self) = @_;
28 70         316 $self->data(undef);
29 70         376 $self->restart_offset(undef);
30             }
31              
32              
33 6     6 0 29 sub help_pasv { 'PASV (returns address/port)' }
34              
35             sub cmd_pasv
36             {
37 43     43 0 155 my($self, $con, $req) = @_;
38              
39 43         109 my $count = 0;
40              
41             tcp_server undef, undef, sub {
42 41     41   4887 my($fh, $host, $port) = @_;
43 41 50       195 return close $fh if ++$count > 1;
44              
45 41         93 my $handle;
46             $handle = AnyEvent::Handle->new(
47             fh => $fh,
48             on_error => sub {
49 0         0 $_[0]->destroy;
50 0         0 undef $handle;
51             },
52             on_eof => sub {
53 0         0 $handle->destroy;
54 0         0 undef $handle;
55             },
56 41         545 autocork => 1,
57             );
58              
59 41         4353 $self->data($handle);
60             # TODO this should be with the 227 message below.
61             # demoting this to a TODO (was a F-I-X-M-E)
62             # since I can't remember why I thought it needed
63             # doing. plicease 12-05-2014
64 41         178 $self->done;
65              
66             }, sub {
67 43     43   11806 my($fh, $host, $port) = @_;
68 43         605 my $ip_and_port = join(',', split(/\./, $con->ip), $port >> 8, $port & 0xff);
69              
70 43         143 my $w;
71             $w = AnyEvent->timer(after => 0, cb => sub {
72 43         2962 $con->send_response(227 => "Entering Passive Mode ($ip_and_port)");
73 43         684 undef $w;
74 43         649 });
75              
76 43         765 };
77              
78 43         2992 return;
79             }
80              
81              
82 6     6 0 43 sub help_port { 'PORT h1,h2,h3,h4,p1,p2' }
83              
84             sub cmd_port
85             {
86 29     29 0 82 my($self, $con, $req) = @_;
87              
88 29 50       103 if($req->args =~ /(\d+,\d+,\d+,\d+),(\d+),(\d+)/)
89             {
90 29         340 my $ip = join '.', split /,/, $1;
91 29         183 my $port = $2*256 + $3;
92              
93             tcp_connect $ip, $port, sub {
94 29     29   3315 my($fh) = @_;
95 29 50       219 unless($fh)
96             {
97 0         0 $con->send_response(500 => "Illegal PORT command");
98 0         0 $self->done;
99 0         0 return;
100             }
101              
102 29         71 my $handle;
103             $handle = AnyEvent::Handle->new(
104             fh => $fh,
105             on_error => sub {
106 0         0 $_[0]->destroy;
107 0         0 undef $handle;
108             },
109             on_eof => sub {
110 0         0 $handle->destroy;
111 0         0 undef $handle;
112             },
113 29         460 );
114              
115 29         3626 $self->data($handle);
116 29         153 $con->send_response(200 => "Port command successful");
117 29         155 $self->done;
118              
119 29         391 };
120              
121             }
122             else
123             {
124 0         0 $con->send_response(500 => "Illegal PORT command");
125 0         0 $self->done;
126 0         0 return;
127             }
128             }
129              
130              
131 6     6 0 113 sub help_rest { 'REST byte-count' }
132              
133             sub cmd_rest
134             {
135 10     10 0 49 my($self, $con, $req) = @_;
136              
137 10 100       54 if($req->args =~ /^\s*(\d+)\s*$/)
138             {
139 8         39 my $offset = $1;
140 8         61 $con->send_response(350 => "Restarting at $offset. Send STORE or RETRIEVE to initiate transfer");
141 8         55 $self->restart_offset($offset);
142             }
143             else
144             {
145 2         7 $con->send_response(501 => "REST requires a value greater than or equal to 0");
146             }
147 10         50 $self->done;
148             }
149              
150             1;
151              
152             __END__