File Coverage

blib/lib/Connector/Proxy/Net/FTP.pm
Criterion Covered Total %
statement 30 130 23.0
branch 0 46 0.0
condition 0 15 0.0
subroutine 10 17 58.8
pod 5 5 100.0
total 45 213 21.1


line stmt bran cond sub pod time code
1              
2             use strict;
3 1     1   133202 use warnings;
  1         14  
  1         25  
4 1     1   5 use English;
  1         2  
  1         19  
5 1     1   4 use File::Spec;
  1         2  
  1         6  
6 1     1   380 use File::Temp qw(tempfile tempdir);
  1         3  
  1         22  
7 1     1   626 use File::Basename;
  1         16451  
  1         60  
8 1     1   9 use Net::FTP;
  1         2  
  1         58  
9 1     1   2275 use Data::Dumper;
  1         92296  
  1         56  
10 1     1   11 use Template;
  1         2  
  1         42  
11 1     1   456  
  1         15961  
  1         29  
12             use Moose;
13 1     1   443 extends 'Connector::Proxy';
  1         383112  
  1         7  
14             with 'Connector::Role::LocalPath';
15              
16             has port => (
17             is => 'rw',
18             isa => 'Int',
19             default => 21,
20             );
21              
22             has basedir => (
23             is => 'rw',
24             isa => 'Str',
25             );
26              
27             has content => (
28             is => 'rw',
29             isa => 'Str',
30             );
31              
32             has username => (
33             is => 'rw',
34             isa => 'Str',
35             );
36              
37             has password => (
38             is => 'rw',
39             isa => 'Str',
40             );
41              
42             has timeout => (
43             is => 'rw',
44             isa => 'Int',
45             default => 30
46             );
47              
48             has debug => (
49             is => 'rw',
50             isa => 'Bool',
51             default => 0,
52             );
53              
54             has active => (
55             is => 'rw',
56             isa => 'Bool',
57             default => 0,
58             );
59              
60             has binary => (
61             is => 'rw',
62             isa => 'Bool',
63             default => 1,
64             );
65              
66             # return the content of the file
67              
68             my $self = shift;
69             my $path = shift;
70 0     0 1    
71 0           my $source = $self->_sanitize_path( $path );
72              
73 0            
74             my $tmpdir = tempdir( CLEANUP => 1 );
75             my ($fh, $target) = tempfile( DIR => $tmpdir );
76 0            
77 0           my $ftp = $self->_client();
78              
79 0           my ($dirname, $filename) = $self->_sanitize_path( $path );
80              
81 0           if ($dirname && $dirname ne '.') {
82             $self->log()->debug('Change dir to ' . $dirname );
83 0 0 0       if (!$ftp->cwd($dirname)) {
84 0           $self->log()->info("Cannot change working directory $dirname");
85 0 0         return $self->_die_on_undef();
86 0           }
87 0           }
88              
89             $self->log()->debug('Send get '. $filename . ' => ' . $target );
90             if (!$ftp->get( $filename, $target )) {
91 0           $self->log()->info("Cannot read file $filename");
92 0 0         return $self->_die_on_undef();
93 0           }
94 0            
95             $ftp->quit;
96              
97 0           # read the content from temporary file
98             my $content = do {
99             local $INPUT_RECORD_SEPARATOR;
100 0           open my $fh, '<', $target;
101 0           <$fh>;
102 0           };
103 0            
104             unlink $target;
105              
106 0           return $content;
107             }
108 0            
109              
110             my $self = shift;
111             my $path = shift;
112              
113 0     0 1   my $dirname = $self->_sanitize_path( $path );
114 0            
115             my $ftp = $self->_client();
116 0            
117             if ($dirname && $dirname ne '.') {
118 0           $self->log()->debug('Change dir to ' . $dirname );
119             if (!$ftp->cwd($dirname)) {
120 0 0 0       $self->log()->info("Cannot change working directory $dirname");
121 0           return $self->_die_on_undef();
122 0 0         }
123 0           }
124 0            
125             my @files = $ftp->ls();
126             $self->log()->debug('List content of directory ' . (join "|", @files));
127             return map { $_ unless ($_ =~ /\A\.\.?\z/) } @files;
128 0            
129 0           }
130 0 0          
  0            
131             my $self = shift;
132             return {TYPE => "scalar" };
133             }
134              
135 0     0 1    
136 0            
137             my $self = shift;
138              
139             # No path = connector root which always exists
140             my @path = $self->_build_path_with_prefix( shift );
141             if (scalar @path == 0) {
142 0     0 1   return 1;
143             }
144              
145 0           return 1;
146 0 0          
147 0           }
148              
149              
150 0           # return the content of the file
151              
152             my $self = shift;
153             my $file = shift;
154             my $data = shift;
155              
156             my $content;
157             if ($self->content()) {
158 0     0 1   $self->log()->debug('Process template for content ' . $self->content());
159 0           my $template = Template->new({});
160 0            
161             $data = { DATA => $data } if (ref $data eq '');
162 0            
163 0 0         $template->process( \$self->content(), $data, \$content) || $self->_log_and_die("Error processing content template.");
164 0           } else {
165 0           if (ref $data ne '') {
166             $self->_log_and_die("You need to define a content template if data is not a scalar");
167 0 0         }
168             $content = $data;
169 0 0         }
170              
171 0 0         my $tmpdir = tempdir( CLEANUP => 1 );
172 0           my ($fh, $source) = tempfile( DIR => $tmpdir );
173              
174 0           open FILE, ">$source" || $self->_log_and_die("Unable to open file for writing");
175             print FILE $content;
176             close FILE;
177 0            
178 0           my $ftp = $self->_client();
179              
180 0   0       my ($dirname, $filename) = $self->_sanitize_path( $file, $data );
181 0            
182 0           if ($dirname && $dirname ne '.') {
183             $self->log()->debug('Change dir to ' . $dirname );
184 0           $ftp->cwd($dirname) or
185             $self->_log_and_die('Cannot change working directory: ' . $ftp->message);
186 0           }
187              
188 0 0 0        
189 0           $self->log()->debug('Send put '. $source . ' => ' . $filename );
190 0 0         $ftp->put( $source, $filename)
191             or $self->_log_and_die('put failed: ' . $ftp->message);
192              
193             $ftp->quit;
194              
195 0           return 1;
196 0 0         }
197              
198              
199 0           my $self = shift;
200             my $inargs = shift;
201 0           my $data = shift;
202              
203             my @args = $self->_build_path_with_prefix( $inargs );
204              
205              
206 0     0     my $file;
207 0           my $template = Template->new({});
208 0            
209             if ($self->path() || $self->file()) {
210 0           $file = $self->_render_local_path( \@args, $data );
211             } else {
212             $self->log()->debug('Neither target pattern nor file set, join arguments');
213 0           map {
214 0           if ($_ =~ /\.\.|\//) {
215             $self->_log_and_die("args contains invalid characters (double dot or slash)");
216 0 0 0       }
217 0           } @args;
218             $file = join("/", @args);
219 0           $file =~ s/[^\s\w\.\-\\\/]//g;
220             }
221 0 0          
  0            
222 0           $self->log()->debug('Filename evaluated to ' . $file);
223              
224             if (wantarray) {
225 0           return (dirname($file), basename($file));
226 0           } else {
227             return $file;
228             }
229 0            
230             }
231 0 0          
232 0            
233             my $self = shift;
234 0            
235             my $ftp = Net::FTP->new( $self->LOCATION(),
236             'Passive' => (not $self->active()),
237             'Debug' => $self->debug(),
238             'Port' => $self->port(),
239             ) or $self->_log_and_die(sprintf("Cannot connect to %s (%s)", $self->LOCATION(), $@));
240              
241 0     0     if ($self->username()) {
242             $ftp->login($self->username(),$self->password())
243 0 0         or $self->_log_and_die("Cannot login " . $ftp->message);
244              
245             }
246              
247             if ($self->basedir()) {
248             $self->log()->debug('Change basedir to ' . $self->basedir());
249 0 0         $ftp->cwd($self->basedir()) or $self->_log_and_die("Cannot change base directory " . $ftp->message);
250 0 0         }
251              
252             if ($self->binary()) {
253             $ftp->binary();
254             $self->log()->trace('Set binary transfer mode');
255 0 0         } else {
256 0           $ftp->ascii();
257 0 0         $self->log()->trace('Set ascii transfer mode');
258             }
259              
260 0 0         return $ftp;
261 0            
262 0           }
263              
264 0           1;
265 0            
266             =head1 Name
267              
268 0           Connector::Proxy::Net::FTP
269              
270             =head1 Description
271              
272             Read/Write files to/from a remote host using FTP.
273              
274             LOCATION is the only mandatory parameter, if neither file nor path is
275             set, the file is constructed from the arguments given to the method call.
276              
277             =head1 Parameters
278              
279             =over
280              
281             =item LOCATION
282              
283             The DNS name or IP of the target host.
284              
285             =item port
286              
287             Port number (Integer), default is 21.
288              
289             =item file
290              
291             Pattern for Template Toolkit to build the filename. The connector path
292             components are available in the key ARGS. In set mode the unfiltered
293             data is also available in key DATA.
294             For security reasons, only word, space, dash, underscore and dot are
295             allowed in the filename. If you want to include a directory, add the path
296             parameter instead!
297              
298             =item path
299              
300             Same as file, but allows the directory seperator (slash and backslash)
301             in the resulting filename. Use this for the full path including the
302             filename as the file parameter is not used, when path is set!
303              
304             =item basedir
305              
306             A basedir which is always prepended to the path.
307              
308             =item content
309              
310             Pattern for Template Toolkit to build the content. The data is passed
311             "as is". If data is a scalar, it is wrapped into a hash using DATA as key.
312              
313             =item username
314              
315             FTP username
316              
317             =item password
318              
319             FTP password
320              
321             =item timeout
322              
323             FTP connection timeout, default is 30 seconds
324              
325             =item debug (Boolean)
326              
327             Set the debug flag for Net::FTP
328              
329             =item active (Boolean)
330              
331             Use FTP active transfer. The default is to use passive transfer mode.
332              
333             =item binary (Boolean)
334              
335             Use binary or ascii transfer mode. Note that binary is the default!
336              
337             =back
338              
339             =head1 Supported Methods
340              
341             =head2 set
342              
343             Write data to a file.
344              
345             $conn->set('filename', { NAME => 'John Doe', 'ROLE' => 'Administrator' });
346              
347             See the file parameter how to control the filename.
348              
349             =head2 get
350              
351             Fetch data from a file. See the file parameter how to control the filename.
352              
353             my $data = $conn->set('filename');
354              
355             =head2 get_keys
356              
357             Return the file names in the given directory.
358              
359             =head1 Example
360              
361             my $conn = Connector::Proxy::Net::FTP->new({
362             LOCATION => 'localhost',
363             file => '[% ARGS.0 %].txt',
364             basedir => '/var/data/',
365             content => ' Hello [% NAME %]',
366             });
367              
368             $conn->set('test', { NAME => 'John Doe' });
369              
370             Results in a file I</var/data/test.txt> with the content I<Hello John Doe>.
371              
372             =head1 A note on security
373              
374             To enable the scp transfer, the file is created on the local disk using
375             tempdir/tempfile. The directory is created with permissions only for the
376             current user, so no other user than root and yourself is able to see the
377             content. The tempfile is cleaned up immediatly, the directory is handled
378             by the internal garbage collection.
379              
380