1 | # Net::FTP.pm
|
---|
2 | #
|
---|
3 | # Copyright (c) 1995-2004 Graham Barr <[email protected]>. All rights reserved.
|
---|
4 | # This program is free software; you can redistribute it and/or
|
---|
5 | # modify it under the same terms as Perl itself.
|
---|
6 | #
|
---|
7 | # Documentation (at end) improved 1996 by Nathan Torkington <[email protected]>.
|
---|
8 |
|
---|
9 | package Net::FTP;
|
---|
10 |
|
---|
11 | require 5.001;
|
---|
12 |
|
---|
13 | use strict;
|
---|
14 | use vars qw(@ISA $VERSION);
|
---|
15 | use Carp;
|
---|
16 |
|
---|
17 | use Socket 1.3;
|
---|
18 | use IO::Socket;
|
---|
19 | use Time::Local;
|
---|
20 | use Net::Cmd;
|
---|
21 | use Net::Config;
|
---|
22 | use Fcntl qw(O_WRONLY O_RDONLY O_APPEND O_CREAT O_TRUNC);
|
---|
23 | # use AutoLoader qw(AUTOLOAD);
|
---|
24 |
|
---|
25 | $VERSION = "2.75";
|
---|
26 | @ISA = qw(Exporter Net::Cmd IO::Socket::INET);
|
---|
27 |
|
---|
28 | # Someday I will "use constant", when I am not bothered to much about
|
---|
29 | # compatability with older releases of perl
|
---|
30 |
|
---|
31 | use vars qw($TELNET_IAC $TELNET_IP $TELNET_DM);
|
---|
32 | ($TELNET_IAC,$TELNET_IP,$TELNET_DM) = (255,244,242);
|
---|
33 |
|
---|
34 | # Name is too long for AutoLoad, it clashes with pasv_xfer
|
---|
35 | sub pasv_xfer_unique {
|
---|
36 | my($sftp,$sfile,$dftp,$dfile) = @_;
|
---|
37 | $sftp->pasv_xfer($sfile,$dftp,$dfile,1);
|
---|
38 | }
|
---|
39 |
|
---|
40 | BEGIN {
|
---|
41 | # make a constant so code is fast'ish
|
---|
42 | my $is_os390 = $^O eq 'os390';
|
---|
43 | *trEBCDIC = sub () { $is_os390 }
|
---|
44 | }
|
---|
45 |
|
---|
46 | 1;
|
---|
47 | # Having problems with AutoLoader
|
---|
48 | #__END__
|
---|
49 |
|
---|
50 | sub new
|
---|
51 | {
|
---|
52 | my $pkg = shift;
|
---|
53 | my ($peer,%arg);
|
---|
54 | if (@_ % 2) {
|
---|
55 | $peer = shift ;
|
---|
56 | %arg = @_;
|
---|
57 | } else {
|
---|
58 | %arg = @_;
|
---|
59 | $peer=delete $arg{Host};
|
---|
60 | }
|
---|
61 |
|
---|
62 | my $host = $peer;
|
---|
63 | my $fire = undef;
|
---|
64 | my $fire_type = undef;
|
---|
65 |
|
---|
66 | if(exists($arg{Firewall}) || Net::Config->requires_firewall($peer))
|
---|
67 | {
|
---|
68 | $fire = $arg{Firewall}
|
---|
69 | || $ENV{FTP_FIREWALL}
|
---|
70 | || $NetConfig{ftp_firewall}
|
---|
71 | || undef;
|
---|
72 |
|
---|
73 | if(defined $fire)
|
---|
74 | {
|
---|
75 | $peer = $fire;
|
---|
76 | delete $arg{Port};
|
---|
77 | $fire_type = $arg{FirewallType}
|
---|
78 | || $ENV{FTP_FIREWALL_TYPE}
|
---|
79 | || $NetConfig{firewall_type}
|
---|
80 | || undef;
|
---|
81 | }
|
---|
82 | }
|
---|
83 |
|
---|
84 | my $ftp = $pkg->SUPER::new(PeerAddr => $peer,
|
---|
85 | PeerPort => $arg{Port} || 'ftp(21)',
|
---|
86 | LocalAddr => $arg{'LocalAddr'},
|
---|
87 | Proto => 'tcp',
|
---|
88 | Timeout => defined $arg{Timeout}
|
---|
89 | ? $arg{Timeout}
|
---|
90 | : 120
|
---|
91 | ) or return undef;
|
---|
92 |
|
---|
93 | ${*$ftp}{'net_ftp_host'} = $host; # Remote hostname
|
---|
94 | ${*$ftp}{'net_ftp_type'} = 'A'; # ASCII/binary/etc mode
|
---|
95 | ${*$ftp}{'net_ftp_blksize'} = abs($arg{'BlockSize'} || 10240);
|
---|
96 |
|
---|
97 | ${*$ftp}{'net_ftp_localaddr'} = $arg{'LocalAddr'};
|
---|
98 |
|
---|
99 | ${*$ftp}{'net_ftp_firewall'} = $fire
|
---|
100 | if(defined $fire);
|
---|
101 | ${*$ftp}{'net_ftp_firewall_type'} = $fire_type
|
---|
102 | if(defined $fire_type);
|
---|
103 |
|
---|
104 | ${*$ftp}{'net_ftp_passive'} = int
|
---|
105 | exists $arg{Passive}
|
---|
106 | ? $arg{Passive}
|
---|
107 | : exists $ENV{FTP_PASSIVE}
|
---|
108 | ? $ENV{FTP_PASSIVE}
|
---|
109 | : defined $fire
|
---|
110 | ? $NetConfig{ftp_ext_passive}
|
---|
111 | : $NetConfig{ftp_int_passive}; # Whew! :-)
|
---|
112 |
|
---|
113 | $ftp->hash(exists $arg{Hash} ? $arg{Hash} : 0, 1024);
|
---|
114 |
|
---|
115 | $ftp->autoflush(1);
|
---|
116 |
|
---|
117 | $ftp->debug(exists $arg{Debug} ? $arg{Debug} : undef);
|
---|
118 |
|
---|
119 | unless ($ftp->response() == CMD_OK)
|
---|
120 | {
|
---|
121 | $ftp->close();
|
---|
122 | $@ = $ftp->message;
|
---|
123 | undef $ftp;
|
---|
124 | }
|
---|
125 |
|
---|
126 | $ftp;
|
---|
127 | }
|
---|
128 |
|
---|
129 | ##
|
---|
130 | ## User interface methods
|
---|
131 | ##
|
---|
132 |
|
---|
133 |
|
---|
134 | sub host {
|
---|
135 | my $me = shift;
|
---|
136 | ${*$me}{'net_ftp_host'};
|
---|
137 | }
|
---|
138 |
|
---|
139 |
|
---|
140 | sub hash {
|
---|
141 | my $ftp = shift; # self
|
---|
142 |
|
---|
143 | my($h,$b) = @_;
|
---|
144 | unless($h) {
|
---|
145 | delete ${*$ftp}{'net_ftp_hash'};
|
---|
146 | return [\*STDERR,0];
|
---|
147 | }
|
---|
148 | ($h,$b) = (ref($h)? $h : \*STDERR, $b || 1024);
|
---|
149 | select((select($h), $|=1)[0]);
|
---|
150 | $b = 512 if $b < 512;
|
---|
151 | ${*$ftp}{'net_ftp_hash'} = [$h, $b];
|
---|
152 | }
|
---|
153 |
|
---|
154 | sub quit
|
---|
155 | {
|
---|
156 | my $ftp = shift;
|
---|
157 |
|
---|
158 | $ftp->_QUIT;
|
---|
159 | $ftp->close;
|
---|
160 | }
|
---|
161 |
|
---|
162 | sub DESTROY {}
|
---|
163 |
|
---|
164 | sub ascii { shift->type('A',@_); }
|
---|
165 | sub binary { shift->type('I',@_); }
|
---|
166 |
|
---|
167 | sub ebcdic
|
---|
168 | {
|
---|
169 | carp "TYPE E is unsupported, shall default to I";
|
---|
170 | shift->type('E',@_);
|
---|
171 | }
|
---|
172 |
|
---|
173 | sub byte
|
---|
174 | {
|
---|
175 | carp "TYPE L is unsupported, shall default to I";
|
---|
176 | shift->type('L',@_);
|
---|
177 | }
|
---|
178 |
|
---|
179 | # Allow the user to send a command directly, BE CAREFUL !!
|
---|
180 |
|
---|
181 | sub quot
|
---|
182 | {
|
---|
183 | my $ftp = shift;
|
---|
184 | my $cmd = shift;
|
---|
185 |
|
---|
186 | $ftp->command( uc $cmd, @_);
|
---|
187 | $ftp->response();
|
---|
188 | }
|
---|
189 |
|
---|
190 | sub site
|
---|
191 | {
|
---|
192 | my $ftp = shift;
|
---|
193 |
|
---|
194 | $ftp->command("SITE", @_);
|
---|
195 | $ftp->response();
|
---|
196 | }
|
---|
197 |
|
---|
198 | sub mdtm
|
---|
199 | {
|
---|
200 | my $ftp = shift;
|
---|
201 | my $file = shift;
|
---|
202 |
|
---|
203 | # Server Y2K bug workaround
|
---|
204 | #
|
---|
205 | # sigh; some idiotic FTP servers use ("19%d",tm.tm_year) instead of
|
---|
206 | # ("%d",tm.tm_year+1900). This results in an extra digit in the
|
---|
207 | # string returned. To account for this we allow an optional extra
|
---|
208 | # digit in the year. Then if the first two digits are 19 we use the
|
---|
209 | # remainder, otherwise we subtract 1900 from the whole year.
|
---|
210 |
|
---|
211 | $ftp->_MDTM($file) && $ftp->message =~ /((\d\d)(\d\d\d?))(\d\d)(\d\d)(\d\d)(\d\d)(\d\d)/
|
---|
212 | ? timegm($8,$7,$6,$5,$4-1,$2 eq '19' ? $3 : ($1-1900))
|
---|
213 | : undef;
|
---|
214 | }
|
---|
215 |
|
---|
216 | sub size {
|
---|
217 | my $ftp = shift;
|
---|
218 | my $file = shift;
|
---|
219 | my $io;
|
---|
220 | if($ftp->supported("SIZE")) {
|
---|
221 | return $ftp->_SIZE($file)
|
---|
222 | ? ($ftp->message =~ /(\d+)\s*(bytes?\s*)?$/)[0]
|
---|
223 | : undef;
|
---|
224 | }
|
---|
225 | elsif($ftp->supported("STAT")) {
|
---|
226 | my @msg;
|
---|
227 | return undef
|
---|
228 | unless $ftp->_STAT($file) && (@msg = $ftp->message) == 3;
|
---|
229 | my $line;
|
---|
230 | foreach $line (@msg) {
|
---|
231 | return (split(/\s+/,$line))[4]
|
---|
232 | if $line =~ /^[-rwxSsTt]{10}/
|
---|
233 | }
|
---|
234 | }
|
---|
235 | else {
|
---|
236 | my @files = $ftp->dir($file);
|
---|
237 | if(@files) {
|
---|
238 | return (split(/\s+/,$1))[4]
|
---|
239 | if $files[0] =~ /^([-rwxSsTt]{10}.*)$/;
|
---|
240 | }
|
---|
241 | }
|
---|
242 | undef;
|
---|
243 | }
|
---|
244 |
|
---|
245 | sub login {
|
---|
246 | my($ftp,$user,$pass,$acct) = @_;
|
---|
247 | my($ok,$ruser,$fwtype);
|
---|
248 |
|
---|
249 | unless (defined $user) {
|
---|
250 | require Net::Netrc;
|
---|
251 |
|
---|
252 | my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'});
|
---|
253 |
|
---|
254 | ($user,$pass,$acct) = $rc->lpa()
|
---|
255 | if ($rc);
|
---|
256 | }
|
---|
257 |
|
---|
258 | $user ||= "anonymous";
|
---|
259 | $ruser = $user;
|
---|
260 |
|
---|
261 | $fwtype = ${*$ftp}{'net_ftp_firewall_type'}
|
---|
262 | || $NetConfig{'ftp_firewall_type'}
|
---|
263 | || 0;
|
---|
264 |
|
---|
265 | if ($fwtype && defined ${*$ftp}{'net_ftp_firewall'}) {
|
---|
266 | if ($fwtype == 1 || $fwtype == 7) {
|
---|
267 | $user .= '@' . ${*$ftp}{'net_ftp_host'};
|
---|
268 | }
|
---|
269 | else {
|
---|
270 | require Net::Netrc;
|
---|
271 |
|
---|
272 | my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'});
|
---|
273 |
|
---|
274 | my($fwuser,$fwpass,$fwacct) = $rc ? $rc->lpa() : ();
|
---|
275 |
|
---|
276 | if ($fwtype == 5) {
|
---|
277 | $user = join('@',$user,$fwuser,${*$ftp}{'net_ftp_host'});
|
---|
278 | $pass = $pass . '@' . $fwpass;
|
---|
279 | }
|
---|
280 | else {
|
---|
281 | if ($fwtype == 2) {
|
---|
282 | $user .= '@' . ${*$ftp}{'net_ftp_host'};
|
---|
283 | }
|
---|
284 | elsif ($fwtype == 6) {
|
---|
285 | $fwuser .= '@' . ${*$ftp}{'net_ftp_host'};
|
---|
286 | }
|
---|
287 |
|
---|
288 | $ok = $ftp->_USER($fwuser);
|
---|
289 |
|
---|
290 | return 0 unless $ok == CMD_OK || $ok == CMD_MORE;
|
---|
291 |
|
---|
292 | $ok = $ftp->_PASS($fwpass || "");
|
---|
293 |
|
---|
294 | return 0 unless $ok == CMD_OK || $ok == CMD_MORE;
|
---|
295 |
|
---|
296 | $ok = $ftp->_ACCT($fwacct)
|
---|
297 | if defined($fwacct);
|
---|
298 |
|
---|
299 | if ($fwtype == 3) {
|
---|
300 | $ok = $ftp->command("SITE",${*$ftp}{'net_ftp_host'})->response;
|
---|
301 | }
|
---|
302 | elsif ($fwtype == 4) {
|
---|
303 | $ok = $ftp->command("OPEN",${*$ftp}{'net_ftp_host'})->response;
|
---|
304 | }
|
---|
305 |
|
---|
306 | return 0 unless $ok == CMD_OK || $ok == CMD_MORE;
|
---|
307 | }
|
---|
308 | }
|
---|
309 | }
|
---|
310 |
|
---|
311 | $ok = $ftp->_USER($user);
|
---|
312 |
|
---|
313 | # Some dumb firewalls don't prefix the connection messages
|
---|
314 | $ok = $ftp->response()
|
---|
315 | if ($ok == CMD_OK && $ftp->code == 220 && $user =~ /\@/);
|
---|
316 |
|
---|
317 | if ($ok == CMD_MORE) {
|
---|
318 | unless(defined $pass) {
|
---|
319 | require Net::Netrc;
|
---|
320 |
|
---|
321 | my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_host'}, $ruser);
|
---|
322 |
|
---|
323 | ($ruser,$pass,$acct) = $rc->lpa()
|
---|
324 | if ($rc);
|
---|
325 |
|
---|
326 | $pass = '-anonymous@'
|
---|
327 | if (!defined $pass && (!defined($ruser) || $ruser =~ /^anonymous/o));
|
---|
328 | }
|
---|
329 |
|
---|
330 | $ok = $ftp->_PASS($pass || "");
|
---|
331 | }
|
---|
332 |
|
---|
333 | $ok = $ftp->_ACCT($acct)
|
---|
334 | if (defined($acct) && ($ok == CMD_MORE || $ok == CMD_OK));
|
---|
335 |
|
---|
336 | if ($fwtype == 7 && $ok == CMD_OK && defined ${*$ftp}{'net_ftp_firewall'}) {
|
---|
337 | my($f,$auth,$resp) = _auth_id($ftp);
|
---|
338 | $ftp->authorize($auth,$resp) if defined($resp);
|
---|
339 | }
|
---|
340 |
|
---|
341 | $ok == CMD_OK;
|
---|
342 | }
|
---|
343 |
|
---|
344 | sub account
|
---|
345 | {
|
---|
346 | @_ == 2 or croak 'usage: $ftp->account( ACCT )';
|
---|
347 | my $ftp = shift;
|
---|
348 | my $acct = shift;
|
---|
349 | $ftp->_ACCT($acct) == CMD_OK;
|
---|
350 | }
|
---|
351 |
|
---|
352 | sub _auth_id {
|
---|
353 | my($ftp,$auth,$resp) = @_;
|
---|
354 |
|
---|
355 | unless(defined $resp)
|
---|
356 | {
|
---|
357 | require Net::Netrc;
|
---|
358 |
|
---|
359 | $auth ||= eval { (getpwuid($>))[0] } || $ENV{NAME};
|
---|
360 |
|
---|
361 | my $rc = Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'}, $auth)
|
---|
362 | || Net::Netrc->lookup(${*$ftp}{'net_ftp_firewall'});
|
---|
363 |
|
---|
364 | ($auth,$resp) = $rc->lpa()
|
---|
365 | if ($rc);
|
---|
366 | }
|
---|
367 | ($ftp,$auth,$resp);
|
---|
368 | }
|
---|
369 |
|
---|
370 | sub authorize
|
---|
371 | {
|
---|
372 | @_ >= 1 || @_ <= 3 or croak 'usage: $ftp->authorize( [AUTH [, RESP]])';
|
---|
373 |
|
---|
374 | my($ftp,$auth,$resp) = &_auth_id;
|
---|
375 |
|
---|
376 | my $ok = $ftp->_AUTH($auth || "");
|
---|
377 |
|
---|
378 | $ok = $ftp->_RESP($resp || "")
|
---|
379 | if ($ok == CMD_MORE);
|
---|
380 |
|
---|
381 | $ok == CMD_OK;
|
---|
382 | }
|
---|
383 |
|
---|
384 | sub rename
|
---|
385 | {
|
---|
386 | @_ == 3 or croak 'usage: $ftp->rename(FROM, TO)';
|
---|
387 |
|
---|
388 | my($ftp,$from,$to) = @_;
|
---|
389 |
|
---|
390 | $ftp->_RNFR($from)
|
---|
391 | && $ftp->_RNTO($to);
|
---|
392 | }
|
---|
393 |
|
---|
394 | sub type
|
---|
395 | {
|
---|
396 | my $ftp = shift;
|
---|
397 | my $type = shift;
|
---|
398 | my $oldval = ${*$ftp}{'net_ftp_type'};
|
---|
399 |
|
---|
400 | return $oldval
|
---|
401 | unless (defined $type);
|
---|
402 |
|
---|
403 | return undef
|
---|
404 | unless ($ftp->_TYPE($type,@_));
|
---|
405 |
|
---|
406 | ${*$ftp}{'net_ftp_type'} = join(" ",$type,@_);
|
---|
407 |
|
---|
408 | $oldval;
|
---|
409 | }
|
---|
410 |
|
---|
411 | sub alloc
|
---|
412 | {
|
---|
413 | my $ftp = shift;
|
---|
414 | my $size = shift;
|
---|
415 | my $oldval = ${*$ftp}{'net_ftp_allo'};
|
---|
416 |
|
---|
417 | return $oldval
|
---|
418 | unless (defined $size);
|
---|
419 |
|
---|
420 | return undef
|
---|
421 | unless ($ftp->_ALLO($size,@_));
|
---|
422 |
|
---|
423 | ${*$ftp}{'net_ftp_allo'} = join(" ",$size,@_);
|
---|
424 |
|
---|
425 | $oldval;
|
---|
426 | }
|
---|
427 |
|
---|
428 | sub abort
|
---|
429 | {
|
---|
430 | my $ftp = shift;
|
---|
431 |
|
---|
432 | send($ftp,pack("CCC", $TELNET_IAC, $TELNET_IP, $TELNET_IAC),MSG_OOB);
|
---|
433 |
|
---|
434 | $ftp->command(pack("C",$TELNET_DM) . "ABOR");
|
---|
435 |
|
---|
436 | ${*$ftp}{'net_ftp_dataconn'}->close()
|
---|
437 | if defined ${*$ftp}{'net_ftp_dataconn'};
|
---|
438 |
|
---|
439 | $ftp->response();
|
---|
440 |
|
---|
441 | $ftp->status == CMD_OK;
|
---|
442 | }
|
---|
443 |
|
---|
444 | sub get
|
---|
445 | {
|
---|
446 | my($ftp,$remote,$local,$where) = @_;
|
---|
447 |
|
---|
448 | my($loc,$len,$buf,$resp,$data);
|
---|
449 | local *FD;
|
---|
450 |
|
---|
451 | my $localfd = ref($local) || ref(\$local) eq "GLOB";
|
---|
452 |
|
---|
453 | ($local = $remote) =~ s#^.*/##
|
---|
454 | unless(defined $local);
|
---|
455 |
|
---|
456 | croak("Bad remote filename '$remote'\n")
|
---|
457 | if $remote =~ /[\r\n]/s;
|
---|
458 |
|
---|
459 | ${*$ftp}{'net_ftp_rest'} = $where if defined $where;
|
---|
460 | my $rest = ${*$ftp}{'net_ftp_rest'};
|
---|
461 |
|
---|
462 | delete ${*$ftp}{'net_ftp_port'};
|
---|
463 | delete ${*$ftp}{'net_ftp_pasv'};
|
---|
464 |
|
---|
465 | $data = $ftp->retr($remote) or
|
---|
466 | return undef;
|
---|
467 |
|
---|
468 | if($localfd)
|
---|
469 | {
|
---|
470 | $loc = $local;
|
---|
471 | }
|
---|
472 | else
|
---|
473 | {
|
---|
474 | $loc = \*FD;
|
---|
475 |
|
---|
476 | unless(sysopen($loc, $local, O_CREAT | O_WRONLY | ($rest ? O_APPEND : O_TRUNC)))
|
---|
477 | {
|
---|
478 | carp "Cannot open Local file $local: $!\n";
|
---|
479 | $data->abort;
|
---|
480 | return undef;
|
---|
481 | }
|
---|
482 | }
|
---|
483 |
|
---|
484 | if($ftp->type eq 'I' && !binmode($loc))
|
---|
485 | {
|
---|
486 | carp "Cannot binmode Local file $local: $!\n";
|
---|
487 | $data->abort;
|
---|
488 | close($loc) unless $localfd;
|
---|
489 | return undef;
|
---|
490 | }
|
---|
491 |
|
---|
492 | $buf = '';
|
---|
493 | my($count,$hashh,$hashb,$ref) = (0);
|
---|
494 |
|
---|
495 | ($hashh,$hashb) = @$ref
|
---|
496 | if($ref = ${*$ftp}{'net_ftp_hash'});
|
---|
497 |
|
---|
498 | my $blksize = ${*$ftp}{'net_ftp_blksize'};
|
---|
499 | local $\; # Just in case
|
---|
500 |
|
---|
501 | while(1)
|
---|
502 | {
|
---|
503 | last unless $len = $data->read($buf,$blksize);
|
---|
504 |
|
---|
505 | if (trEBCDIC && $ftp->type ne 'I')
|
---|
506 | {
|
---|
507 | $buf = $ftp->toebcdic($buf);
|
---|
508 | $len = length($buf);
|
---|
509 | }
|
---|
510 |
|
---|
511 | if($hashh) {
|
---|
512 | $count += $len;
|
---|
513 | print $hashh "#" x (int($count / $hashb));
|
---|
514 | $count %= $hashb;
|
---|
515 | }
|
---|
516 | unless(print $loc $buf)
|
---|
517 | {
|
---|
518 | carp "Cannot write to Local file $local: $!\n";
|
---|
519 | $data->abort;
|
---|
520 | close($loc)
|
---|
521 | unless $localfd;
|
---|
522 | return undef;
|
---|
523 | }
|
---|
524 | }
|
---|
525 |
|
---|
526 | print $hashh "\n" if $hashh;
|
---|
527 |
|
---|
528 | unless ($localfd)
|
---|
529 | {
|
---|
530 | unless (close($loc))
|
---|
531 | {
|
---|
532 | carp "Cannot close file $local (perhaps disk space) $!\n";
|
---|
533 | return undef;
|
---|
534 | }
|
---|
535 | }
|
---|
536 |
|
---|
537 | unless ($data->close()) # implied $ftp->response
|
---|
538 | {
|
---|
539 | carp "Unable to close datastream";
|
---|
540 | return undef;
|
---|
541 | }
|
---|
542 |
|
---|
543 | return $local;
|
---|
544 | }
|
---|
545 |
|
---|
546 | sub cwd
|
---|
547 | {
|
---|
548 | @_ == 1 || @_ == 2 or croak 'usage: $ftp->cwd( [ DIR ] )';
|
---|
549 |
|
---|
550 | my($ftp,$dir) = @_;
|
---|
551 |
|
---|
552 | $dir = "/" unless defined($dir) && $dir =~ /\S/;
|
---|
553 |
|
---|
554 | $dir eq ".."
|
---|
555 | ? $ftp->_CDUP()
|
---|
556 | : $ftp->_CWD($dir);
|
---|
557 | }
|
---|
558 |
|
---|
559 | sub cdup
|
---|
560 | {
|
---|
561 | @_ == 1 or croak 'usage: $ftp->cdup()';
|
---|
562 | $_[0]->_CDUP;
|
---|
563 | }
|
---|
564 |
|
---|
565 | sub pwd
|
---|
566 | {
|
---|
567 | @_ == 1 || croak 'usage: $ftp->pwd()';
|
---|
568 | my $ftp = shift;
|
---|
569 |
|
---|
570 | $ftp->_PWD();
|
---|
571 | $ftp->_extract_path;
|
---|
572 | }
|
---|
573 |
|
---|
574 | # rmdir( $ftp, $dir, [ $recurse ] )
|
---|
575 | #
|
---|
576 | # Removes $dir on remote host via FTP.
|
---|
577 | # $ftp is handle for remote host
|
---|
578 | #
|
---|
579 | # If $recurse is TRUE, the directory and deleted recursively.
|
---|
580 | # This means all of its contents and subdirectories.
|
---|
581 | #
|
---|
582 | # Initial version contributed by Dinkum Software
|
---|
583 | #
|
---|
584 | sub rmdir
|
---|
585 | {
|
---|
586 | @_ == 2 || @_ == 3 or croak('usage: $ftp->rmdir( DIR [, RECURSE ] )');
|
---|
587 |
|
---|
588 | # Pick off the args
|
---|
589 | my ($ftp, $dir, $recurse) = @_ ;
|
---|
590 | my $ok;
|
---|
591 |
|
---|
592 | return $ok
|
---|
593 | if $ok = $ftp->_RMD( $dir ) or !$recurse;
|
---|
594 |
|
---|
595 | # Try to delete the contents
|
---|
596 | # Get a list of all the files in the directory
|
---|
597 | my @filelist = grep { !/^\.{1,2}$/ } $ftp->ls($dir);
|
---|
598 |
|
---|
599 | return undef
|
---|
600 | unless @filelist; # failed, it is probably not a directory
|
---|
601 |
|
---|
602 | # Go thru and delete each file or the directory
|
---|
603 | my $file;
|
---|
604 | foreach $file (map { m,/, ? $_ : "$dir/$_" } @filelist)
|
---|
605 | {
|
---|
606 | next # successfully deleted the file
|
---|
607 | if $ftp->delete($file);
|
---|
608 |
|
---|
609 | # Failed to delete it, assume its a directory
|
---|
610 | # Recurse and ignore errors, the final rmdir() will
|
---|
611 | # fail on any errors here
|
---|
612 | return $ok
|
---|
613 | unless $ok = $ftp->rmdir($file, 1) ;
|
---|
614 | }
|
---|
615 |
|
---|
616 | # Directory should be empty
|
---|
617 | # Try to remove the directory again
|
---|
618 | # Pass results directly to caller
|
---|
619 | # If any of the prior deletes failed, this
|
---|
620 | # rmdir() will fail because directory is not empty
|
---|
621 | return $ftp->_RMD($dir) ;
|
---|
622 | }
|
---|
623 |
|
---|
624 | sub restart
|
---|
625 | {
|
---|
626 | @_ == 2 || croak 'usage: $ftp->restart( BYTE_OFFSET )';
|
---|
627 |
|
---|
628 | my($ftp,$where) = @_;
|
---|
629 |
|
---|
630 | ${*$ftp}{'net_ftp_rest'} = $where;
|
---|
631 |
|
---|
632 | return undef;
|
---|
633 | }
|
---|
634 |
|
---|
635 |
|
---|
636 | sub mkdir
|
---|
637 | {
|
---|
638 | @_ == 2 || @_ == 3 or croak 'usage: $ftp->mkdir( DIR [, RECURSE ] )';
|
---|
639 |
|
---|
640 | my($ftp,$dir,$recurse) = @_;
|
---|
641 |
|
---|
642 | $ftp->_MKD($dir) || $recurse or
|
---|
643 | return undef;
|
---|
644 |
|
---|
645 | my $path = $dir;
|
---|
646 |
|
---|
647 | unless($ftp->ok)
|
---|
648 | {
|
---|
649 | my @path = split(m#(?=/+)#, $dir);
|
---|
650 |
|
---|
651 | $path = "";
|
---|
652 |
|
---|
653 | while(@path)
|
---|
654 | {
|
---|
655 | $path .= shift @path;
|
---|
656 |
|
---|
657 | $ftp->_MKD($path);
|
---|
658 |
|
---|
659 | $path = $ftp->_extract_path($path);
|
---|
660 | }
|
---|
661 |
|
---|
662 | # If the creation of the last element was not successful, see if we
|
---|
663 | # can cd to it, if so then return path
|
---|
664 |
|
---|
665 | unless($ftp->ok)
|
---|
666 | {
|
---|
667 | my($status,$message) = ($ftp->status,$ftp->message);
|
---|
668 | my $pwd = $ftp->pwd;
|
---|
669 |
|
---|
670 | if($pwd && $ftp->cwd($dir))
|
---|
671 | {
|
---|
672 | $path = $dir;
|
---|
673 | $ftp->cwd($pwd);
|
---|
674 | }
|
---|
675 | else
|
---|
676 | {
|
---|
677 | undef $path;
|
---|
678 | }
|
---|
679 | $ftp->set_status($status,$message);
|
---|
680 | }
|
---|
681 | }
|
---|
682 |
|
---|
683 | $path;
|
---|
684 | }
|
---|
685 |
|
---|
686 | sub delete
|
---|
687 | {
|
---|
688 | @_ == 2 || croak 'usage: $ftp->delete( FILENAME )';
|
---|
689 |
|
---|
690 | $_[0]->_DELE($_[1]);
|
---|
691 | }
|
---|
692 |
|
---|
693 | sub put { shift->_store_cmd("stor",@_) }
|
---|
694 | sub put_unique { shift->_store_cmd("stou",@_) }
|
---|
695 | sub append { shift->_store_cmd("appe",@_) }
|
---|
696 |
|
---|
697 | sub nlst { shift->_data_cmd("NLST",@_) }
|
---|
698 | sub list { shift->_data_cmd("LIST",@_) }
|
---|
699 | sub retr { shift->_data_cmd("RETR",@_) }
|
---|
700 | sub stor { shift->_data_cmd("STOR",@_) }
|
---|
701 | sub stou { shift->_data_cmd("STOU",@_) }
|
---|
702 | sub appe { shift->_data_cmd("APPE",@_) }
|
---|
703 |
|
---|
704 | sub _store_cmd
|
---|
705 | {
|
---|
706 | my($ftp,$cmd,$local,$remote) = @_;
|
---|
707 | my($loc,$sock,$len,$buf);
|
---|
708 | local *FD;
|
---|
709 |
|
---|
710 | my $localfd = ref($local) || ref(\$local) eq "GLOB";
|
---|
711 |
|
---|
712 | unless(defined $remote)
|
---|
713 | {
|
---|
714 | croak 'Must specify remote filename with stream input'
|
---|
715 | if $localfd;
|
---|
716 |
|
---|
717 | require File::Basename;
|
---|
718 | $remote = File::Basename::basename($local);
|
---|
719 | }
|
---|
720 | if( defined ${*$ftp}{'net_ftp_allo'} )
|
---|
721 | {
|
---|
722 | delete ${*$ftp}{'net_ftp_allo'};
|
---|
723 | } else
|
---|
724 | {
|
---|
725 | # if the user hasn't already invoked the alloc method since the last
|
---|
726 | # _store_cmd call, figure out if the local file is a regular file(not
|
---|
727 | # a pipe, or device) and if so get the file size from stat, and send
|
---|
728 | # an ALLO command before sending the STOR, STOU, or APPE command.
|
---|
729 | my $size = do { local $^W; -f $local && -s _ }; # no ALLO if sending data from a pipe
|
---|
730 | $ftp->_ALLO($size) if $size;
|
---|
731 | }
|
---|
732 | croak("Bad remote filename '$remote'\n")
|
---|
733 | if $remote =~ /[\r\n]/s;
|
---|
734 |
|
---|
735 | if($localfd)
|
---|
736 | {
|
---|
737 | $loc = $local;
|
---|
738 | }
|
---|
739 | else
|
---|
740 | {
|
---|
741 | $loc = \*FD;
|
---|
742 |
|
---|
743 | unless(sysopen($loc, $local, O_RDONLY))
|
---|
744 | {
|
---|
745 | carp "Cannot open Local file $local: $!\n";
|
---|
746 | return undef;
|
---|
747 | }
|
---|
748 | }
|
---|
749 |
|
---|
750 | if($ftp->type eq 'I' && !binmode($loc))
|
---|
751 | {
|
---|
752 | carp "Cannot binmode Local file $local: $!\n";
|
---|
753 | return undef;
|
---|
754 | }
|
---|
755 |
|
---|
756 | delete ${*$ftp}{'net_ftp_port'};
|
---|
757 | delete ${*$ftp}{'net_ftp_pasv'};
|
---|
758 |
|
---|
759 | $sock = $ftp->_data_cmd($cmd, $remote) or
|
---|
760 | return undef;
|
---|
761 |
|
---|
762 | $remote = ($ftp->message =~ /FILE:\s*(.*)/)[0]
|
---|
763 | if 'STOU' eq uc $cmd;
|
---|
764 |
|
---|
765 | my $blksize = ${*$ftp}{'net_ftp_blksize'};
|
---|
766 |
|
---|
767 | my($count,$hashh,$hashb,$ref) = (0);
|
---|
768 |
|
---|
769 | ($hashh,$hashb) = @$ref
|
---|
770 | if($ref = ${*$ftp}{'net_ftp_hash'});
|
---|
771 |
|
---|
772 | while(1)
|
---|
773 | {
|
---|
774 | last unless $len = read($loc,$buf="",$blksize);
|
---|
775 |
|
---|
776 | if (trEBCDIC && $ftp->type ne 'I')
|
---|
777 | {
|
---|
778 | $buf = $ftp->toascii($buf);
|
---|
779 | $len = length($buf);
|
---|
780 | }
|
---|
781 |
|
---|
782 | if($hashh) {
|
---|
783 | $count += $len;
|
---|
784 | print $hashh "#" x (int($count / $hashb));
|
---|
785 | $count %= $hashb;
|
---|
786 | }
|
---|
787 |
|
---|
788 | my $wlen;
|
---|
789 | unless(defined($wlen = $sock->write($buf,$len)) && $wlen == $len)
|
---|
790 | {
|
---|
791 | $sock->abort;
|
---|
792 | close($loc)
|
---|
793 | unless $localfd;
|
---|
794 | print $hashh "\n" if $hashh;
|
---|
795 | return undef;
|
---|
796 | }
|
---|
797 | }
|
---|
798 |
|
---|
799 | print $hashh "\n" if $hashh;
|
---|
800 |
|
---|
801 | close($loc)
|
---|
802 | unless $localfd;
|
---|
803 |
|
---|
804 | $sock->close() or
|
---|
805 | return undef;
|
---|
806 |
|
---|
807 | if ('STOU' eq uc $cmd and $ftp->message =~ m/unique\s+file\s*name\s*:\s*(.*)\)|"(.*)"/)
|
---|
808 | {
|
---|
809 | require File::Basename;
|
---|
810 | $remote = File::Basename::basename($+)
|
---|
811 | }
|
---|
812 |
|
---|
813 | return $remote;
|
---|
814 | }
|
---|
815 |
|
---|
816 | sub port
|
---|
817 | {
|
---|
818 | @_ == 1 || @_ == 2 or croak 'usage: $ftp->port([PORT])';
|
---|
819 |
|
---|
820 | my($ftp,$port) = @_;
|
---|
821 | my $ok;
|
---|
822 |
|
---|
823 | delete ${*$ftp}{'net_ftp_intern_port'};
|
---|
824 |
|
---|
825 | unless(defined $port)
|
---|
826 | {
|
---|
827 | # create a Listen socket at same address as the command socket
|
---|
828 |
|
---|
829 | ${*$ftp}{'net_ftp_listen'} ||= IO::Socket::INET->new(Listen => 5,
|
---|
830 | Proto => 'tcp',
|
---|
831 | Timeout => $ftp->timeout,
|
---|
832 | LocalAddr => $ftp->sockhost,
|
---|
833 | );
|
---|
834 |
|
---|
835 | my $listen = ${*$ftp}{'net_ftp_listen'};
|
---|
836 |
|
---|
837 | my($myport, @myaddr) = ($listen->sockport, split(/\./,$listen->sockhost));
|
---|
838 |
|
---|
839 | $port = join(',', @myaddr, $myport >> 8, $myport & 0xff);
|
---|
840 |
|
---|
841 | ${*$ftp}{'net_ftp_intern_port'} = 1;
|
---|
842 | }
|
---|
843 |
|
---|
844 | $ok = $ftp->_PORT($port);
|
---|
845 |
|
---|
846 | ${*$ftp}{'net_ftp_port'} = $port;
|
---|
847 |
|
---|
848 | $ok;
|
---|
849 | }
|
---|
850 |
|
---|
851 | sub ls { shift->_list_cmd("NLST",@_); }
|
---|
852 | sub dir { shift->_list_cmd("LIST",@_); }
|
---|
853 |
|
---|
854 | sub pasv
|
---|
855 | {
|
---|
856 | @_ == 1 or croak 'usage: $ftp->pasv()';
|
---|
857 |
|
---|
858 | my $ftp = shift;
|
---|
859 |
|
---|
860 | delete ${*$ftp}{'net_ftp_intern_port'};
|
---|
861 |
|
---|
862 | $ftp->_PASV && $ftp->message =~ /(\d+(,\d+)+)/
|
---|
863 | ? ${*$ftp}{'net_ftp_pasv'} = $1
|
---|
864 | : undef;
|
---|
865 | }
|
---|
866 |
|
---|
867 | sub unique_name
|
---|
868 | {
|
---|
869 | my $ftp = shift;
|
---|
870 | ${*$ftp}{'net_ftp_unique'} || undef;
|
---|
871 | }
|
---|
872 |
|
---|
873 | sub supported {
|
---|
874 | @_ == 2 or croak 'usage: $ftp->supported( CMD )';
|
---|
875 | my $ftp = shift;
|
---|
876 | my $cmd = uc shift;
|
---|
877 | my $hash = ${*$ftp}{'net_ftp_supported'} ||= {};
|
---|
878 |
|
---|
879 | return $hash->{$cmd}
|
---|
880 | if exists $hash->{$cmd};
|
---|
881 |
|
---|
882 | return $hash->{$cmd} = 0
|
---|
883 | unless $ftp->_HELP($cmd);
|
---|
884 |
|
---|
885 | my $text = $ftp->message;
|
---|
886 | if($text =~ /following\s+commands/i) {
|
---|
887 | $text =~ s/^.*\n//;
|
---|
888 | while($text =~ /(\*?)(\w+)(\*?)/sg) {
|
---|
889 | $hash->{"\U$2"} = !length("$1$3");
|
---|
890 | }
|
---|
891 | }
|
---|
892 | else {
|
---|
893 | $hash->{$cmd} = $text !~ /unimplemented/i;
|
---|
894 | }
|
---|
895 |
|
---|
896 | $hash->{$cmd} ||= 0;
|
---|
897 | }
|
---|
898 |
|
---|
899 | ##
|
---|
900 | ## Deprecated methods
|
---|
901 | ##
|
---|
902 |
|
---|
903 | sub lsl
|
---|
904 | {
|
---|
905 | carp "Use of Net::FTP::lsl deprecated, use 'dir'"
|
---|
906 | if $^W;
|
---|
907 | goto &dir;
|
---|
908 | }
|
---|
909 |
|
---|
910 | sub authorise
|
---|
911 | {
|
---|
912 | carp "Use of Net::FTP::authorise deprecated, use 'authorize'"
|
---|
913 | if $^W;
|
---|
914 | goto &authorize;
|
---|
915 | }
|
---|
916 |
|
---|
917 |
|
---|
918 | ##
|
---|
919 | ## Private methods
|
---|
920 | ##
|
---|
921 |
|
---|
922 | sub _extract_path
|
---|
923 | {
|
---|
924 | my($ftp, $path) = @_;
|
---|
925 |
|
---|
926 | # This tries to work both with and without the quote doubling
|
---|
927 | # convention (RFC 959 requires it, but the first 3 servers I checked
|
---|
928 | # didn't implement it). It will fail on a server which uses a quote in
|
---|
929 | # the message which isn't a part of or surrounding the path.
|
---|
930 | $ftp->ok &&
|
---|
931 | $ftp->message =~ /(?:^|\s)\"(.*)\"(?:$|\s)/ &&
|
---|
932 | ($path = $1) =~ s/\"\"/\"/g;
|
---|
933 |
|
---|
934 | $path;
|
---|
935 | }
|
---|
936 |
|
---|
937 | ##
|
---|
938 | ## Communication methods
|
---|
939 | ##
|
---|
940 |
|
---|
941 | sub _dataconn
|
---|
942 | {
|
---|
943 | my $ftp = shift;
|
---|
944 | my $data = undef;
|
---|
945 | my $pkg = "Net::FTP::" . $ftp->type;
|
---|
946 |
|
---|
947 | eval "require " . $pkg;
|
---|
948 |
|
---|
949 | $pkg =~ s/ /_/g;
|
---|
950 |
|
---|
951 | delete ${*$ftp}{'net_ftp_dataconn'};
|
---|
952 |
|
---|
953 | if(defined ${*$ftp}{'net_ftp_pasv'})
|
---|
954 | {
|
---|
955 | my @port = map { 0+$_ } split(/,/,${*$ftp}{'net_ftp_pasv'});
|
---|
956 |
|
---|
957 | $data = $pkg->new(PeerAddr => join(".",@port[0..3]),
|
---|
958 | PeerPort => $port[4] * 256 + $port[5],
|
---|
959 | LocalAddr => ${*$ftp}{'net_ftp_localaddr'},
|
---|
960 | Proto => 'tcp'
|
---|
961 | );
|
---|
962 | }
|
---|
963 | elsif(defined ${*$ftp}{'net_ftp_listen'})
|
---|
964 | {
|
---|
965 | $data = ${*$ftp}{'net_ftp_listen'}->accept($pkg);
|
---|
966 | close(delete ${*$ftp}{'net_ftp_listen'});
|
---|
967 | }
|
---|
968 |
|
---|
969 | if($data)
|
---|
970 | {
|
---|
971 | ${*$data} = "";
|
---|
972 | $data->timeout($ftp->timeout);
|
---|
973 | ${*$ftp}{'net_ftp_dataconn'} = $data;
|
---|
974 | ${*$data}{'net_ftp_cmd'} = $ftp;
|
---|
975 | ${*$data}{'net_ftp_blksize'} = ${*$ftp}{'net_ftp_blksize'};
|
---|
976 | }
|
---|
977 |
|
---|
978 | $data;
|
---|
979 | }
|
---|
980 |
|
---|
981 | sub _list_cmd
|
---|
982 | {
|
---|
983 | my $ftp = shift;
|
---|
984 | my $cmd = uc shift;
|
---|
985 |
|
---|
986 | delete ${*$ftp}{'net_ftp_port'};
|
---|
987 | delete ${*$ftp}{'net_ftp_pasv'};
|
---|
988 |
|
---|
989 | my $data = $ftp->_data_cmd($cmd,@_);
|
---|
990 |
|
---|
991 | return
|
---|
992 | unless(defined $data);
|
---|
993 |
|
---|
994 | require Net::FTP::A;
|
---|
995 | bless $data, "Net::FTP::A"; # Force ASCII mode
|
---|
996 |
|
---|
997 | my $databuf = '';
|
---|
998 | my $buf = '';
|
---|
999 | my $blksize = ${*$ftp}{'net_ftp_blksize'};
|
---|
1000 |
|
---|
1001 | while($data->read($databuf,$blksize)) {
|
---|
1002 | $buf .= $databuf;
|
---|
1003 | }
|
---|
1004 |
|
---|
1005 | my $list = [ split(/\n/,$buf) ];
|
---|
1006 |
|
---|
1007 | $data->close();
|
---|
1008 |
|
---|
1009 | if (trEBCDIC)
|
---|
1010 | {
|
---|
1011 | for (@$list) { $_ = $ftp->toebcdic($_) }
|
---|
1012 | }
|
---|
1013 |
|
---|
1014 | wantarray ? @{$list}
|
---|
1015 | : $list;
|
---|
1016 | }
|
---|
1017 |
|
---|
1018 | sub _data_cmd
|
---|
1019 | {
|
---|
1020 | my $ftp = shift;
|
---|
1021 | my $cmd = uc shift;
|
---|
1022 | my $ok = 1;
|
---|
1023 | my $where = delete ${*$ftp}{'net_ftp_rest'} || 0;
|
---|
1024 | my $arg;
|
---|
1025 |
|
---|
1026 | for $arg (@_) {
|
---|
1027 | croak("Bad argument '$arg'\n")
|
---|
1028 | if $arg =~ /[\r\n]/s;
|
---|
1029 | }
|
---|
1030 |
|
---|
1031 | if(${*$ftp}{'net_ftp_passive'} &&
|
---|
1032 | !defined ${*$ftp}{'net_ftp_pasv'} &&
|
---|
1033 | !defined ${*$ftp}{'net_ftp_port'})
|
---|
1034 | {
|
---|
1035 | my $data = undef;
|
---|
1036 |
|
---|
1037 | $ok = defined $ftp->pasv;
|
---|
1038 | $ok = $ftp->_REST($where)
|
---|
1039 | if $ok && $where;
|
---|
1040 |
|
---|
1041 | if($ok)
|
---|
1042 | {
|
---|
1043 | $ftp->command($cmd,@_);
|
---|
1044 | $data = $ftp->_dataconn();
|
---|
1045 | $ok = CMD_INFO == $ftp->response();
|
---|
1046 | if($ok)
|
---|
1047 | {
|
---|
1048 | $data->reading
|
---|
1049 | if $data && $cmd =~ /RETR|LIST|NLST/;
|
---|
1050 | return $data
|
---|
1051 | }
|
---|
1052 | $data->_close
|
---|
1053 | if $data;
|
---|
1054 | }
|
---|
1055 | return undef;
|
---|
1056 | }
|
---|
1057 |
|
---|
1058 | $ok = $ftp->port
|
---|
1059 | unless (defined ${*$ftp}{'net_ftp_port'} ||
|
---|
1060 | defined ${*$ftp}{'net_ftp_pasv'});
|
---|
1061 |
|
---|
1062 | $ok = $ftp->_REST($where)
|
---|
1063 | if $ok && $where;
|
---|
1064 |
|
---|
1065 | return undef
|
---|
1066 | unless $ok;
|
---|
1067 |
|
---|
1068 | $ftp->command($cmd,@_);
|
---|
1069 |
|
---|
1070 | return 1
|
---|
1071 | if(defined ${*$ftp}{'net_ftp_pasv'});
|
---|
1072 |
|
---|
1073 | $ok = CMD_INFO == $ftp->response();
|
---|
1074 |
|
---|
1075 | return $ok
|
---|
1076 | unless exists ${*$ftp}{'net_ftp_intern_port'};
|
---|
1077 |
|
---|
1078 | if($ok) {
|
---|
1079 | my $data = $ftp->_dataconn();
|
---|
1080 |
|
---|
1081 | $data->reading
|
---|
1082 | if $data && $cmd =~ /RETR|LIST|NLST/;
|
---|
1083 |
|
---|
1084 | return $data;
|
---|
1085 | }
|
---|
1086 |
|
---|
1087 |
|
---|
1088 | close(delete ${*$ftp}{'net_ftp_listen'});
|
---|
1089 |
|
---|
1090 | return undef;
|
---|
1091 | }
|
---|
1092 |
|
---|
1093 | ##
|
---|
1094 | ## Over-ride methods (Net::Cmd)
|
---|
1095 | ##
|
---|
1096 |
|
---|
1097 | sub debug_text { $_[2] =~ /^(pass|resp|acct)/i ? "$1 ....\n" : $_[2]; }
|
---|
1098 |
|
---|
1099 | sub command
|
---|
1100 | {
|
---|
1101 | my $ftp = shift;
|
---|
1102 |
|
---|
1103 | delete ${*$ftp}{'net_ftp_port'};
|
---|
1104 | $ftp->SUPER::command(@_);
|
---|
1105 | }
|
---|
1106 |
|
---|
1107 | sub response
|
---|
1108 | {
|
---|
1109 | my $ftp = shift;
|
---|
1110 | my $code = $ftp->SUPER::response();
|
---|
1111 |
|
---|
1112 | delete ${*$ftp}{'net_ftp_pasv'}
|
---|
1113 | if ($code != CMD_MORE && $code != CMD_INFO);
|
---|
1114 |
|
---|
1115 | $code;
|
---|
1116 | }
|
---|
1117 |
|
---|
1118 | sub parse_response
|
---|
1119 | {
|
---|
1120 | return ($1, $2 eq "-")
|
---|
1121 | if $_[1] =~ s/^(\d\d\d)(.?)//o;
|
---|
1122 |
|
---|
1123 | my $ftp = shift;
|
---|
1124 |
|
---|
1125 | # Darn MS FTP server is a load of CRAP !!!!
|
---|
1126 | return ()
|
---|
1127 | unless ${*$ftp}{'net_cmd_code'} + 0;
|
---|
1128 |
|
---|
1129 | (${*$ftp}{'net_cmd_code'},1);
|
---|
1130 | }
|
---|
1131 |
|
---|
1132 | ##
|
---|
1133 | ## Allow 2 servers to talk directly
|
---|
1134 | ##
|
---|
1135 |
|
---|
1136 | sub pasv_xfer {
|
---|
1137 | my($sftp,$sfile,$dftp,$dfile,$unique) = @_;
|
---|
1138 |
|
---|
1139 | ($dfile = $sfile) =~ s#.*/##
|
---|
1140 | unless(defined $dfile);
|
---|
1141 |
|
---|
1142 | my $port = $sftp->pasv or
|
---|
1143 | return undef;
|
---|
1144 |
|
---|
1145 | $dftp->port($port) or
|
---|
1146 | return undef;
|
---|
1147 |
|
---|
1148 | return undef
|
---|
1149 | unless($unique ? $dftp->stou($dfile) : $dftp->stor($dfile));
|
---|
1150 |
|
---|
1151 | unless($sftp->retr($sfile) && $sftp->response == CMD_INFO) {
|
---|
1152 | $sftp->retr($sfile);
|
---|
1153 | $dftp->abort;
|
---|
1154 | $dftp->response();
|
---|
1155 | return undef;
|
---|
1156 | }
|
---|
1157 |
|
---|
1158 | $dftp->pasv_wait($sftp);
|
---|
1159 | }
|
---|
1160 |
|
---|
1161 | sub pasv_wait
|
---|
1162 | {
|
---|
1163 | @_ == 2 or croak 'usage: $ftp->pasv_wait(NON_PASV_FTP)';
|
---|
1164 |
|
---|
1165 | my($ftp, $non_pasv) = @_;
|
---|
1166 | my($file,$rin,$rout);
|
---|
1167 |
|
---|
1168 | vec($rin='',fileno($ftp),1) = 1;
|
---|
1169 | select($rout=$rin, undef, undef, undef);
|
---|
1170 |
|
---|
1171 | $ftp->response();
|
---|
1172 | $non_pasv->response();
|
---|
1173 |
|
---|
1174 | return undef
|
---|
1175 | unless $ftp->ok() && $non_pasv->ok();
|
---|
1176 |
|
---|
1177 | return $1
|
---|
1178 | if $ftp->message =~ /unique file name:\s*(\S*)\s*\)/;
|
---|
1179 |
|
---|
1180 | return $1
|
---|
1181 | if $non_pasv->message =~ /unique file name:\s*(\S*)\s*\)/;
|
---|
1182 |
|
---|
1183 | return 1;
|
---|
1184 | }
|
---|
1185 |
|
---|
1186 | sub cmd { shift->command(@_)->response() }
|
---|
1187 |
|
---|
1188 | ########################################
|
---|
1189 | #
|
---|
1190 | # RFC959 commands
|
---|
1191 | #
|
---|
1192 |
|
---|
1193 | sub _ABOR { shift->command("ABOR")->response() == CMD_OK }
|
---|
1194 | sub _ALLO { shift->command("ALLO",@_)->response() == CMD_OK}
|
---|
1195 | sub _CDUP { shift->command("CDUP")->response() == CMD_OK }
|
---|
1196 | sub _NOOP { shift->command("NOOP")->response() == CMD_OK }
|
---|
1197 | sub _PASV { shift->command("PASV")->response() == CMD_OK }
|
---|
1198 | sub _QUIT { shift->command("QUIT")->response() == CMD_OK }
|
---|
1199 | sub _DELE { shift->command("DELE",@_)->response() == CMD_OK }
|
---|
1200 | sub _CWD { shift->command("CWD", @_)->response() == CMD_OK }
|
---|
1201 | sub _PORT { shift->command("PORT",@_)->response() == CMD_OK }
|
---|
1202 | sub _RMD { shift->command("RMD", @_)->response() == CMD_OK }
|
---|
1203 | sub _MKD { shift->command("MKD", @_)->response() == CMD_OK }
|
---|
1204 | sub _PWD { shift->command("PWD", @_)->response() == CMD_OK }
|
---|
1205 | sub _TYPE { shift->command("TYPE",@_)->response() == CMD_OK }
|
---|
1206 | sub _RNTO { shift->command("RNTO",@_)->response() == CMD_OK }
|
---|
1207 | sub _RESP { shift->command("RESP",@_)->response() == CMD_OK }
|
---|
1208 | sub _MDTM { shift->command("MDTM",@_)->response() == CMD_OK }
|
---|
1209 | sub _SIZE { shift->command("SIZE",@_)->response() == CMD_OK }
|
---|
1210 | sub _HELP { shift->command("HELP",@_)->response() == CMD_OK }
|
---|
1211 | sub _STAT { shift->command("STAT",@_)->response() == CMD_OK }
|
---|
1212 | sub _APPE { shift->command("APPE",@_)->response() == CMD_INFO }
|
---|
1213 | sub _LIST { shift->command("LIST",@_)->response() == CMD_INFO }
|
---|
1214 | sub _NLST { shift->command("NLST",@_)->response() == CMD_INFO }
|
---|
1215 | sub _RETR { shift->command("RETR",@_)->response() == CMD_INFO }
|
---|
1216 | sub _STOR { shift->command("STOR",@_)->response() == CMD_INFO }
|
---|
1217 | sub _STOU { shift->command("STOU",@_)->response() == CMD_INFO }
|
---|
1218 | sub _RNFR { shift->command("RNFR",@_)->response() == CMD_MORE }
|
---|
1219 | sub _REST { shift->command("REST",@_)->response() == CMD_MORE }
|
---|
1220 | sub _USER { shift->command("user",@_)->response() } # A certain brain dead firewall :-)
|
---|
1221 | sub _PASS { shift->command("PASS",@_)->response() }
|
---|
1222 | sub _ACCT { shift->command("ACCT",@_)->response() }
|
---|
1223 | sub _AUTH { shift->command("AUTH",@_)->response() }
|
---|
1224 |
|
---|
1225 | sub _SMNT { shift->unsupported(@_) }
|
---|
1226 | sub _MODE { shift->unsupported(@_) }
|
---|
1227 | sub _SYST { shift->unsupported(@_) }
|
---|
1228 | sub _STRU { shift->unsupported(@_) }
|
---|
1229 | sub _REIN { shift->unsupported(@_) }
|
---|
1230 |
|
---|
1231 | 1;
|
---|
1232 |
|
---|
1233 | __END__
|
---|
1234 |
|
---|
1235 | =head1 NAME
|
---|
1236 |
|
---|
1237 | Net::FTP - FTP Client class
|
---|
1238 |
|
---|
1239 | =head1 SYNOPSIS
|
---|
1240 |
|
---|
1241 | use Net::FTP;
|
---|
1242 |
|
---|
1243 | $ftp = Net::FTP->new("some.host.name", Debug => 0)
|
---|
1244 | or die "Cannot connect to some.host.name: $@";
|
---|
1245 |
|
---|
1246 | $ftp->login("anonymous",'-anonymous@')
|
---|
1247 | or die "Cannot login ", $ftp->message;
|
---|
1248 |
|
---|
1249 | $ftp->cwd("/pub")
|
---|
1250 | or die "Cannot change working directory ", $ftp->message;
|
---|
1251 |
|
---|
1252 | $ftp->get("that.file")
|
---|
1253 | or die "get failed ", $ftp->message;
|
---|
1254 |
|
---|
1255 | $ftp->quit;
|
---|
1256 |
|
---|
1257 | =head1 DESCRIPTION
|
---|
1258 |
|
---|
1259 | C<Net::FTP> is a class implementing a simple FTP client in Perl as
|
---|
1260 | described in RFC959. It provides wrappers for a subset of the RFC959
|
---|
1261 | commands.
|
---|
1262 |
|
---|
1263 | =head1 OVERVIEW
|
---|
1264 |
|
---|
1265 | FTP stands for File Transfer Protocol. It is a way of transferring
|
---|
1266 | files between networked machines. The protocol defines a client
|
---|
1267 | (whose commands are provided by this module) and a server (not
|
---|
1268 | implemented in this module). Communication is always initiated by the
|
---|
1269 | client, and the server responds with a message and a status code (and
|
---|
1270 | sometimes with data).
|
---|
1271 |
|
---|
1272 | The FTP protocol allows files to be sent to or fetched from the
|
---|
1273 | server. Each transfer involves a B<local file> (on the client) and a
|
---|
1274 | B<remote file> (on the server). In this module, the same file name
|
---|
1275 | will be used for both local and remote if only one is specified. This
|
---|
1276 | means that transferring remote file C</path/to/file> will try to put
|
---|
1277 | that file in C</path/to/file> locally, unless you specify a local file
|
---|
1278 | name.
|
---|
1279 |
|
---|
1280 | The protocol also defines several standard B<translations> which the
|
---|
1281 | file can undergo during transfer. These are ASCII, EBCDIC, binary,
|
---|
1282 | and byte. ASCII is the default type, and indicates that the sender of
|
---|
1283 | files will translate the ends of lines to a standard representation
|
---|
1284 | which the receiver will then translate back into their local
|
---|
1285 | representation. EBCDIC indicates the file being transferred is in
|
---|
1286 | EBCDIC format. Binary (also known as image) format sends the data as
|
---|
1287 | a contiguous bit stream. Byte format transfers the data as bytes, the
|
---|
1288 | values of which remain the same regardless of differences in byte size
|
---|
1289 | between the two machines (in theory - in practice you should only use
|
---|
1290 | this if you really know what you're doing).
|
---|
1291 |
|
---|
1292 | =head1 CONSTRUCTOR
|
---|
1293 |
|
---|
1294 | =over 4
|
---|
1295 |
|
---|
1296 | =item new ([ HOST ] [, OPTIONS ])
|
---|
1297 |
|
---|
1298 | This is the constructor for a new Net::FTP object. C<HOST> is the
|
---|
1299 | name of the remote host to which an FTP connection is required.
|
---|
1300 |
|
---|
1301 | C<HOST> is optional. If C<HOST> is not given then it may instead be
|
---|
1302 | passed as the C<Host> option described below.
|
---|
1303 |
|
---|
1304 | C<OPTIONS> are passed in a hash like fashion, using key and value pairs.
|
---|
1305 | Possible options are:
|
---|
1306 |
|
---|
1307 | B<Host> - FTP host to connect to. It may be a single scalar, as defined for
|
---|
1308 | the C<PeerAddr> option in L<IO::Socket::INET>, or a reference to
|
---|
1309 | an array with hosts to try in turn. The L</host> method will return the value
|
---|
1310 | which was used to connect to the host.
|
---|
1311 |
|
---|
1312 |
|
---|
1313 | B<Firewall> - The name of a machine which acts as an FTP firewall. This can be
|
---|
1314 | overridden by an environment variable C<FTP_FIREWALL>. If specified, and the
|
---|
1315 | given host cannot be directly connected to, then the
|
---|
1316 | connection is made to the firewall machine and the string C<@hostname> is
|
---|
1317 | appended to the login identifier. This kind of setup is also refered to
|
---|
1318 | as an ftp proxy.
|
---|
1319 |
|
---|
1320 | B<FirewallType> - The type of firewall running on the machine indicated by
|
---|
1321 | B<Firewall>. This can be overridden by an environment variable
|
---|
1322 | C<FTP_FIREWALL_TYPE>. For a list of permissible types, see the description of
|
---|
1323 | ftp_firewall_type in L<Net::Config>.
|
---|
1324 |
|
---|
1325 | B<BlockSize> - This is the block size that Net::FTP will use when doing
|
---|
1326 | transfers. (defaults to 10240)
|
---|
1327 |
|
---|
1328 | B<Port> - The port number to connect to on the remote machine for the
|
---|
1329 | FTP connection
|
---|
1330 |
|
---|
1331 | B<Timeout> - Set a timeout value (defaults to 120)
|
---|
1332 |
|
---|
1333 | B<Debug> - debug level (see the debug method in L<Net::Cmd>)
|
---|
1334 |
|
---|
1335 | B<Passive> - If set to a non-zero value then all data transfers will be done
|
---|
1336 | using passive mode. This is not usually required except for some I<dumb>
|
---|
1337 | servers, and some firewall configurations. This can also be set by the
|
---|
1338 | environment variable C<FTP_PASSIVE>.
|
---|
1339 |
|
---|
1340 | B<Hash> - If given a reference to a file handle (e.g., C<\*STDERR>),
|
---|
1341 | print hash marks (#) on that filehandle every 1024 bytes. This
|
---|
1342 | simply invokes the C<hash()> method for you, so that hash marks
|
---|
1343 | are displayed for all transfers. You can, of course, call C<hash()>
|
---|
1344 | explicitly whenever you'd like.
|
---|
1345 |
|
---|
1346 | B<LocalAddr> - Local address to use for all socket connections, this
|
---|
1347 | argument will be passed to L<IO::Socket::INET>
|
---|
1348 |
|
---|
1349 | If the constructor fails undef will be returned and an error message will
|
---|
1350 | be in $@
|
---|
1351 |
|
---|
1352 | =back
|
---|
1353 |
|
---|
1354 | =head1 METHODS
|
---|
1355 |
|
---|
1356 | Unless otherwise stated all methods return either a I<true> or I<false>
|
---|
1357 | value, with I<true> meaning that the operation was a success. When a method
|
---|
1358 | states that it returns a value, failure will be returned as I<undef> or an
|
---|
1359 | empty list.
|
---|
1360 |
|
---|
1361 | =over 4
|
---|
1362 |
|
---|
1363 | =item login ([LOGIN [,PASSWORD [, ACCOUNT] ] ])
|
---|
1364 |
|
---|
1365 | Log into the remote FTP server with the given login information. If
|
---|
1366 | no arguments are given then the C<Net::FTP> uses the C<Net::Netrc>
|
---|
1367 | package to lookup the login information for the connected host.
|
---|
1368 | If no information is found then a login of I<anonymous> is used.
|
---|
1369 | If no password is given and the login is I<anonymous> then I<anonymous@>
|
---|
1370 | will be used for password.
|
---|
1371 |
|
---|
1372 | If the connection is via a firewall then the C<authorize> method will
|
---|
1373 | be called with no arguments.
|
---|
1374 |
|
---|
1375 | =item authorize ( [AUTH [, RESP]])
|
---|
1376 |
|
---|
1377 | This is a protocol used by some firewall ftp proxies. It is used
|
---|
1378 | to authorise the user to send data out. If both arguments are not specified
|
---|
1379 | then C<authorize> uses C<Net::Netrc> to do a lookup.
|
---|
1380 |
|
---|
1381 | =item site (ARGS)
|
---|
1382 |
|
---|
1383 | Send a SITE command to the remote server and wait for a response.
|
---|
1384 |
|
---|
1385 | Returns most significant digit of the response code.
|
---|
1386 |
|
---|
1387 | =item ascii
|
---|
1388 |
|
---|
1389 | Transfer file in ASCII. CRLF translation will be done if required
|
---|
1390 |
|
---|
1391 | =item binary
|
---|
1392 |
|
---|
1393 | Transfer file in binary mode. No transformation will be done.
|
---|
1394 |
|
---|
1395 | B<Hint>: If both server and client machines use the same line ending for
|
---|
1396 | text files, then it will be faster to transfer all files in binary mode.
|
---|
1397 |
|
---|
1398 | =item rename ( OLDNAME, NEWNAME )
|
---|
1399 |
|
---|
1400 | Rename a file on the remote FTP server from C<OLDNAME> to C<NEWNAME>. This
|
---|
1401 | is done by sending the RNFR and RNTO commands.
|
---|
1402 |
|
---|
1403 | =item delete ( FILENAME )
|
---|
1404 |
|
---|
1405 | Send a request to the server to delete C<FILENAME>.
|
---|
1406 |
|
---|
1407 | =item cwd ( [ DIR ] )
|
---|
1408 |
|
---|
1409 | Attempt to change directory to the directory given in C<$dir>. If
|
---|
1410 | C<$dir> is C<"..">, the FTP C<CDUP> command is used to attempt to
|
---|
1411 | move up one directory. If no directory is given then an attempt is made
|
---|
1412 | to change the directory to the root directory.
|
---|
1413 |
|
---|
1414 | =item cdup ()
|
---|
1415 |
|
---|
1416 | Change directory to the parent of the current directory.
|
---|
1417 |
|
---|
1418 | =item pwd ()
|
---|
1419 |
|
---|
1420 | Returns the full pathname of the current directory.
|
---|
1421 |
|
---|
1422 | =item restart ( WHERE )
|
---|
1423 |
|
---|
1424 | Set the byte offset at which to begin the next data transfer. Net::FTP simply
|
---|
1425 | records this value and uses it when during the next data transfer. For this
|
---|
1426 | reason this method will not return an error, but setting it may cause
|
---|
1427 | a subsequent data transfer to fail.
|
---|
1428 |
|
---|
1429 | =item rmdir ( DIR [, RECURSE ])
|
---|
1430 |
|
---|
1431 | Remove the directory with the name C<DIR>. If C<RECURSE> is I<true> then
|
---|
1432 | C<rmdir> will attempt to delete everything inside the directory.
|
---|
1433 |
|
---|
1434 | =item mkdir ( DIR [, RECURSE ])
|
---|
1435 |
|
---|
1436 | Create a new directory with the name C<DIR>. If C<RECURSE> is I<true> then
|
---|
1437 | C<mkdir> will attempt to create all the directories in the given path.
|
---|
1438 |
|
---|
1439 | Returns the full pathname to the new directory.
|
---|
1440 |
|
---|
1441 | =item alloc ( SIZE [, RECORD_SIZE] )
|
---|
1442 |
|
---|
1443 | The alloc command allows you to give the ftp server a hint about the size
|
---|
1444 | of the file about to be transfered using the ALLO ftp command. Some storage
|
---|
1445 | systems use this to make intelligent decisions about how to store the file.
|
---|
1446 | The C<SIZE> argument represents the size of the file in bytes. The
|
---|
1447 | C<RECORD_SIZE> argument indicates a mazimum record or page size for files
|
---|
1448 | sent with a record or page structure.
|
---|
1449 |
|
---|
1450 | The size of the file will be determined, and sent to the server
|
---|
1451 | automatically for normal files so that this method need only be called if
|
---|
1452 | you are transfering data from a socket, named pipe, or other stream not
|
---|
1453 | associated with a normal file.
|
---|
1454 |
|
---|
1455 | =item ls ( [ DIR ] )
|
---|
1456 |
|
---|
1457 | Get a directory listing of C<DIR>, or the current directory.
|
---|
1458 |
|
---|
1459 | In an array context, returns a list of lines returned from the server. In
|
---|
1460 | a scalar context, returns a reference to a list.
|
---|
1461 |
|
---|
1462 | =item dir ( [ DIR ] )
|
---|
1463 |
|
---|
1464 | Get a directory listing of C<DIR>, or the current directory in long format.
|
---|
1465 |
|
---|
1466 | In an array context, returns a list of lines returned from the server. In
|
---|
1467 | a scalar context, returns a reference to a list.
|
---|
1468 |
|
---|
1469 | =item get ( REMOTE_FILE [, LOCAL_FILE [, WHERE]] )
|
---|
1470 |
|
---|
1471 | Get C<REMOTE_FILE> from the server and store locally. C<LOCAL_FILE> may be
|
---|
1472 | a filename or a filehandle. If not specified, the file will be stored in
|
---|
1473 | the current directory with the same leafname as the remote file.
|
---|
1474 |
|
---|
1475 | If C<WHERE> is given then the first C<WHERE> bytes of the file will
|
---|
1476 | not be transfered, and the remaining bytes will be appended to
|
---|
1477 | the local file if it already exists.
|
---|
1478 |
|
---|
1479 | Returns C<LOCAL_FILE>, or the generated local file name if C<LOCAL_FILE>
|
---|
1480 | is not given. If an error was encountered undef is returned.
|
---|
1481 |
|
---|
1482 | =item put ( LOCAL_FILE [, REMOTE_FILE ] )
|
---|
1483 |
|
---|
1484 | Put a file on the remote server. C<LOCAL_FILE> may be a name or a filehandle.
|
---|
1485 | If C<LOCAL_FILE> is a filehandle then C<REMOTE_FILE> must be specified. If
|
---|
1486 | C<REMOTE_FILE> is not specified then the file will be stored in the current
|
---|
1487 | directory with the same leafname as C<LOCAL_FILE>.
|
---|
1488 |
|
---|
1489 | Returns C<REMOTE_FILE>, or the generated remote filename if C<REMOTE_FILE>
|
---|
1490 | is not given.
|
---|
1491 |
|
---|
1492 | B<NOTE>: If for some reason the transfer does not complete and an error is
|
---|
1493 | returned then the contents that had been transfered will not be remove
|
---|
1494 | automatically.
|
---|
1495 |
|
---|
1496 | =item put_unique ( LOCAL_FILE [, REMOTE_FILE ] )
|
---|
1497 |
|
---|
1498 | Same as put but uses the C<STOU> command.
|
---|
1499 |
|
---|
1500 | Returns the name of the file on the server.
|
---|
1501 |
|
---|
1502 | =item append ( LOCAL_FILE [, REMOTE_FILE ] )
|
---|
1503 |
|
---|
1504 | Same as put but appends to the file on the remote server.
|
---|
1505 |
|
---|
1506 | Returns C<REMOTE_FILE>, or the generated remote filename if C<REMOTE_FILE>
|
---|
1507 | is not given.
|
---|
1508 |
|
---|
1509 | =item unique_name ()
|
---|
1510 |
|
---|
1511 | Returns the name of the last file stored on the server using the
|
---|
1512 | C<STOU> command.
|
---|
1513 |
|
---|
1514 | =item mdtm ( FILE )
|
---|
1515 |
|
---|
1516 | Returns the I<modification time> of the given file
|
---|
1517 |
|
---|
1518 | =item size ( FILE )
|
---|
1519 |
|
---|
1520 | Returns the size in bytes for the given file as stored on the remote server.
|
---|
1521 |
|
---|
1522 | B<NOTE>: The size reported is the size of the stored file on the remote server.
|
---|
1523 | If the file is subsequently transfered from the server in ASCII mode
|
---|
1524 | and the remote server and local machine have different ideas about
|
---|
1525 | "End Of Line" then the size of file on the local machine after transfer
|
---|
1526 | may be different.
|
---|
1527 |
|
---|
1528 | =item supported ( CMD )
|
---|
1529 |
|
---|
1530 | Returns TRUE if the remote server supports the given command.
|
---|
1531 |
|
---|
1532 | =item hash ( [FILEHANDLE_GLOB_REF],[ BYTES_PER_HASH_MARK] )
|
---|
1533 |
|
---|
1534 | Called without parameters, or with the first argument false, hash marks
|
---|
1535 | are suppressed. If the first argument is true but not a reference to a
|
---|
1536 | file handle glob, then \*STDERR is used. The second argument is the number
|
---|
1537 | of bytes per hash mark printed, and defaults to 1024. In all cases the
|
---|
1538 | return value is a reference to an array of two: the filehandle glob reference
|
---|
1539 | and the bytes per hash mark.
|
---|
1540 |
|
---|
1541 | =back
|
---|
1542 |
|
---|
1543 | The following methods can return different results depending on
|
---|
1544 | how they are called. If the user explicitly calls either
|
---|
1545 | of the C<pasv> or C<port> methods then these methods will
|
---|
1546 | return a I<true> or I<false> value. If the user does not
|
---|
1547 | call either of these methods then the result will be a
|
---|
1548 | reference to a C<Net::FTP::dataconn> based object.
|
---|
1549 |
|
---|
1550 | =over 4
|
---|
1551 |
|
---|
1552 | =item nlst ( [ DIR ] )
|
---|
1553 |
|
---|
1554 | Send an C<NLST> command to the server, with an optional parameter.
|
---|
1555 |
|
---|
1556 | =item list ( [ DIR ] )
|
---|
1557 |
|
---|
1558 | Same as C<nlst> but using the C<LIST> command
|
---|
1559 |
|
---|
1560 | =item retr ( FILE )
|
---|
1561 |
|
---|
1562 | Begin the retrieval of a file called C<FILE> from the remote server.
|
---|
1563 |
|
---|
1564 | =item stor ( FILE )
|
---|
1565 |
|
---|
1566 | Tell the server that you wish to store a file. C<FILE> is the
|
---|
1567 | name of the new file that should be created.
|
---|
1568 |
|
---|
1569 | =item stou ( FILE )
|
---|
1570 |
|
---|
1571 | Same as C<stor> but using the C<STOU> command. The name of the unique
|
---|
1572 | file which was created on the server will be available via the C<unique_name>
|
---|
1573 | method after the data connection has been closed.
|
---|
1574 |
|
---|
1575 | =item appe ( FILE )
|
---|
1576 |
|
---|
1577 | Tell the server that we want to append some data to the end of a file
|
---|
1578 | called C<FILE>. If this file does not exist then create it.
|
---|
1579 |
|
---|
1580 | =back
|
---|
1581 |
|
---|
1582 | If for some reason you want to have complete control over the data connection,
|
---|
1583 | this includes generating it and calling the C<response> method when required,
|
---|
1584 | then the user can use these methods to do so.
|
---|
1585 |
|
---|
1586 | However calling these methods only affects the use of the methods above that
|
---|
1587 | can return a data connection. They have no effect on methods C<get>, C<put>,
|
---|
1588 | C<put_unique> and those that do not require data connections.
|
---|
1589 |
|
---|
1590 | =over 4
|
---|
1591 |
|
---|
1592 | =item port ( [ PORT ] )
|
---|
1593 |
|
---|
1594 | Send a C<PORT> command to the server. If C<PORT> is specified then it is sent
|
---|
1595 | to the server. If not, then a listen socket is created and the correct information
|
---|
1596 | sent to the server.
|
---|
1597 |
|
---|
1598 | =item pasv ()
|
---|
1599 |
|
---|
1600 | Tell the server to go into passive mode. Returns the text that represents the
|
---|
1601 | port on which the server is listening, this text is in a suitable form to
|
---|
1602 | sent to another ftp server using the C<port> method.
|
---|
1603 |
|
---|
1604 | =back
|
---|
1605 |
|
---|
1606 | The following methods can be used to transfer files between two remote
|
---|
1607 | servers, providing that these two servers can connect directly to each other.
|
---|
1608 |
|
---|
1609 | =over 4
|
---|
1610 |
|
---|
1611 | =item pasv_xfer ( SRC_FILE, DEST_SERVER [, DEST_FILE ] )
|
---|
1612 |
|
---|
1613 | This method will do a file transfer between two remote ftp servers. If
|
---|
1614 | C<DEST_FILE> is omitted then the leaf name of C<SRC_FILE> will be used.
|
---|
1615 |
|
---|
1616 | =item pasv_xfer_unique ( SRC_FILE, DEST_SERVER [, DEST_FILE ] )
|
---|
1617 |
|
---|
1618 | Like C<pasv_xfer> but the file is stored on the remote server using
|
---|
1619 | the STOU command.
|
---|
1620 |
|
---|
1621 | =item pasv_wait ( NON_PASV_SERVER )
|
---|
1622 |
|
---|
1623 | This method can be used to wait for a transfer to complete between a passive
|
---|
1624 | server and a non-passive server. The method should be called on the passive
|
---|
1625 | server with the C<Net::FTP> object for the non-passive server passed as an
|
---|
1626 | argument.
|
---|
1627 |
|
---|
1628 | =item abort ()
|
---|
1629 |
|
---|
1630 | Abort the current data transfer.
|
---|
1631 |
|
---|
1632 | =item quit ()
|
---|
1633 |
|
---|
1634 | Send the QUIT command to the remote FTP server and close the socket connection.
|
---|
1635 |
|
---|
1636 | =back
|
---|
1637 |
|
---|
1638 | =head2 Methods for the adventurous
|
---|
1639 |
|
---|
1640 | C<Net::FTP> inherits from C<Net::Cmd> so methods defined in C<Net::Cmd> may
|
---|
1641 | be used to send commands to the remote FTP server.
|
---|
1642 |
|
---|
1643 | =over 4
|
---|
1644 |
|
---|
1645 | =item quot (CMD [,ARGS])
|
---|
1646 |
|
---|
1647 | Send a command, that Net::FTP does not directly support, to the remote
|
---|
1648 | server and wait for a response.
|
---|
1649 |
|
---|
1650 | Returns most significant digit of the response code.
|
---|
1651 |
|
---|
1652 | B<WARNING> This call should only be used on commands that do not require
|
---|
1653 | data connections. Misuse of this method can hang the connection.
|
---|
1654 |
|
---|
1655 | =back
|
---|
1656 |
|
---|
1657 | =head1 THE dataconn CLASS
|
---|
1658 |
|
---|
1659 | Some of the methods defined in C<Net::FTP> return an object which will
|
---|
1660 | be derived from this class.The dataconn class itself is derived from
|
---|
1661 | the C<IO::Socket::INET> class, so any normal IO operations can be performed.
|
---|
1662 | However the following methods are defined in the dataconn class and IO should
|
---|
1663 | be performed using these.
|
---|
1664 |
|
---|
1665 | =over 4
|
---|
1666 |
|
---|
1667 | =item read ( BUFFER, SIZE [, TIMEOUT ] )
|
---|
1668 |
|
---|
1669 | Read C<SIZE> bytes of data from the server and place it into C<BUFFER>, also
|
---|
1670 | performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
|
---|
1671 | given, the timeout value from the command connection will be used.
|
---|
1672 |
|
---|
1673 | Returns the number of bytes read before any <CRLF> translation.
|
---|
1674 |
|
---|
1675 | =item write ( BUFFER, SIZE [, TIMEOUT ] )
|
---|
1676 |
|
---|
1677 | Write C<SIZE> bytes of data from C<BUFFER> to the server, also
|
---|
1678 | performing any <CRLF> translation necessary. C<TIMEOUT> is optional, if not
|
---|
1679 | given, the timeout value from the command connection will be used.
|
---|
1680 |
|
---|
1681 | Returns the number of bytes written before any <CRLF> translation.
|
---|
1682 |
|
---|
1683 | =item bytes_read ()
|
---|
1684 |
|
---|
1685 | Returns the number of bytes read so far.
|
---|
1686 |
|
---|
1687 | =item abort ()
|
---|
1688 |
|
---|
1689 | Abort the current data transfer.
|
---|
1690 |
|
---|
1691 | =item close ()
|
---|
1692 |
|
---|
1693 | Close the data connection and get a response from the FTP server. Returns
|
---|
1694 | I<true> if the connection was closed successfully and the first digit of
|
---|
1695 | the response from the server was a '2'.
|
---|
1696 |
|
---|
1697 | =back
|
---|
1698 |
|
---|
1699 | =head1 UNIMPLEMENTED
|
---|
1700 |
|
---|
1701 | The following RFC959 commands have not been implemented:
|
---|
1702 |
|
---|
1703 | =over 4
|
---|
1704 |
|
---|
1705 | =item B<SMNT>
|
---|
1706 |
|
---|
1707 | Mount a different file system structure without changing login or
|
---|
1708 | accounting information.
|
---|
1709 |
|
---|
1710 | =item B<HELP>
|
---|
1711 |
|
---|
1712 | Ask the server for "helpful information" (that's what the RFC says) on
|
---|
1713 | the commands it accepts.
|
---|
1714 |
|
---|
1715 | =item B<MODE>
|
---|
1716 |
|
---|
1717 | Specifies transfer mode (stream, block or compressed) for file to be
|
---|
1718 | transferred.
|
---|
1719 |
|
---|
1720 | =item B<SYST>
|
---|
1721 |
|
---|
1722 | Request remote server system identification.
|
---|
1723 |
|
---|
1724 | =item B<STAT>
|
---|
1725 |
|
---|
1726 | Request remote server status.
|
---|
1727 |
|
---|
1728 | =item B<STRU>
|
---|
1729 |
|
---|
1730 | Specifies file structure for file to be transferred.
|
---|
1731 |
|
---|
1732 | =item B<REIN>
|
---|
1733 |
|
---|
1734 | Reinitialize the connection, flushing all I/O and account information.
|
---|
1735 |
|
---|
1736 | =back
|
---|
1737 |
|
---|
1738 | =head1 REPORTING BUGS
|
---|
1739 |
|
---|
1740 | When reporting bugs/problems please include as much information as possible.
|
---|
1741 | It may be difficult for me to reproduce the problem as almost every setup
|
---|
1742 | is different.
|
---|
1743 |
|
---|
1744 | A small script which yields the problem will probably be of help. It would
|
---|
1745 | also be useful if this script was run with the extra options C<Debug => 1>
|
---|
1746 | passed to the constructor, and the output sent with the bug report. If you
|
---|
1747 | cannot include a small script then please include a Debug trace from a
|
---|
1748 | run of your program which does yield the problem.
|
---|
1749 |
|
---|
1750 | =head1 AUTHOR
|
---|
1751 |
|
---|
1752 | Graham Barr <[email protected]>
|
---|
1753 |
|
---|
1754 | =head1 SEE ALSO
|
---|
1755 |
|
---|
1756 | L<Net::Netrc>
|
---|
1757 | L<Net::Cmd>
|
---|
1758 |
|
---|
1759 | ftp(1), ftpd(8), RFC 959
|
---|
1760 | http://www.cis.ohio-state.edu/htbin/rfc/rfc959.html
|
---|
1761 |
|
---|
1762 | =head1 USE EXAMPLES
|
---|
1763 |
|
---|
1764 | For an example of the use of Net::FTP see
|
---|
1765 |
|
---|
1766 | =over 4
|
---|
1767 |
|
---|
1768 | =item http://www.csh.rit.edu/~adam/Progs/
|
---|
1769 |
|
---|
1770 | C<autoftp> is a program that can retrieve, send, or list files via
|
---|
1771 | the FTP protocol in a non-interactive manner.
|
---|
1772 |
|
---|
1773 | =back
|
---|
1774 |
|
---|
1775 | =head1 CREDITS
|
---|
1776 |
|
---|
1777 | Henry Gabryjelski <[email protected]> - for the suggestion of creating directories
|
---|
1778 | recursively.
|
---|
1779 |
|
---|
1780 | Nathan Torkington <[email protected]> - for some input on the documentation.
|
---|
1781 |
|
---|
1782 | Roderick Schertler <[email protected]> - for various inputs
|
---|
1783 |
|
---|
1784 | =head1 COPYRIGHT
|
---|
1785 |
|
---|
1786 | Copyright (c) 1995-2004 Graham Barr. All rights reserved.
|
---|
1787 | This program is free software; you can redistribute it and/or modify it
|
---|
1788 | under the same terms as Perl itself.
|
---|
1789 |
|
---|
1790 | =cut
|
---|