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   206287 use strict;
  23         77  
  23         558  
4 23     23   96 use warnings;
  23         55  
  23         460  
5 23     23   339 use 5.010;
  23         65  
6 23     23   465 use Moo::Role;
  23         15305  
  23         122  
7 23     23   9194 use AnyEvent;
  23         17165  
  23         730  
8 23     23   2386 use AnyEvent::Socket qw( tcp_server tcp_connect );
  23         83313  
  23         1586  
9 23     23   2754 use AnyEvent::Handle;
  23         24847  
  23         15428  
10              
11             # ABSTRACT: Interface for PASV, PORT and REST commands
12             our $VERSION = '0.19'; # 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 225 my($self) = @_;
28 70         210 $self->data(undef);
29 70         255 $self->restart_offset(undef);
30             }
31              
32              
33 6     6 0 24 sub help_pasv { 'PASV (returns address/port)' }
34              
35             sub cmd_pasv
36             {
37 43     43 0 108 my($self, $con, $req) = @_;
38              
39 43         88 my $count = 0;
40              
41             tcp_server undef, undef, sub {
42 41     41   3178 my($fh, $host, $port) = @_;
43 41 50       172 return close $fh if ++$count > 1;
44              
45 41         71 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         327 autocork => 1,
57             );
58              
59 41         2729 $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         136 $self->done;
65              
66             }, sub {
67 43     43   8129 my($fh, $host, $port) = @_;
68 43         347 my $ip_and_port = join(',', split(/\./, $con->ip), $port >> 8, $port & 0xff);
69              
70 43         109 my $w;
71             $w = AnyEvent->timer(after => 0, cb => sub {
72 43         1829 $con->send_response(227 => "Entering Passive Mode ($ip_and_port)");
73 43         433 undef $w;
74 43         437 });
75              
76 43         549 };
77              
78 43         1870 return;
79             }
80              
81              
82 6     6 0 26 sub help_port { 'PORT h1,h2,h3,h4,p1,p2' }
83              
84             sub cmd_port
85             {
86 29     29 0 71 my($self, $con, $req) = @_;
87              
88 29 50       70 if($req->args =~ /(\d+,\d+,\d+,\d+),(\d+),(\d+)/)
89             {
90 29         257 my $ip = join '.', split /,/, $1;
91 29         149 my $port = $2*256 + $3;
92              
93             tcp_connect $ip, $port, sub {
94 29     29   2052 my($fh) = @_;
95 29 50       135 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         45 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         302 );
114              
115 29         2303 $self->data($handle);
116 29         120 $con->send_response(200 => "Port command successful");
117 29         99 $self->done;
118              
119 29         272 };
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 105 sub help_rest { 'REST byte-count' }
132              
133             sub cmd_rest
134             {
135 10     10 0 43 my($self, $con, $req) = @_;
136              
137 10 100       40 if($req->args =~ /^\s*(\d+)\s*$/)
138             {
139 8         25 my $offset = $1;
140 8         55 $con->send_response(350 => "Restarting at $offset. Send STORE or RETRIEVE to initiate transfer");
141 8         53 $self->restart_offset($offset);
142             }
143             else
144             {
145 2         6 $con->send_response(501 => "REST requires a value greater than or equal to 0");
146             }
147 10         53 $self->done;
148             }
149              
150             1;
151              
152             __END__