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