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