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