1package ProFTPD::TestSuite::FTP;
2
3use strict;
4
5use Carp;
6use Net::FTP;
7use POSIX qw(:sys_wait_h);
8
9my $conn_ex;
10
11sub new {
12  my $class = shift;
13  my ($addr, $port, $use_port, $conn_timeout, $cmd_timeout) = @_;
14  $use_port = 0 unless defined($use_port);
15  $conn_timeout = 2 unless defined($conn_timeout);
16
17  my $ftp;
18
19  my $now = time();
20
21  # Creating a Net::FTP object involves attempting to connect to the given
22  # address/port.  So handle the test cases where the server process may
23  # not yet be completely up, retry this connect, once a second, up to the
24  # given timeout.
25
26  my %opts = (
27    Port => $port,
28  );
29
30  if ($use_port) {
31    $opts{Passive} = 0;
32
33  } else {
34    $opts{Passive} = 1;
35  }
36
37  if ($ENV{TEST_VERBOSE}) {
38    $opts{Debug} = 10;
39  }
40
41  if (defined($cmd_timeout)) {
42    $opts{Timeout} = $cmd_timeout;
43  }
44
45  while (1) {
46    if (time() - $now > $conn_timeout) {
47      croak("Unable to connect to $addr:$port: Timed out after $conn_timeout secs");
48    }
49
50    $ftp = Net::FTP->new($addr, %opts);
51    if ($ftp) {
52      last;
53    }
54
55    $conn_ex = $@;
56    chomp($conn_ex);
57    sleep(1);
58  }
59
60  # Naughtily invade the Net::FTP internals; it makes for less confusion
61  # when writing the unit tests.
62  if (exists($ENV{FTP_FIREWALL})) {
63    ${*$ftp}{net_ftp_firewall} = $ENV{FTP_FIREWALL};
64  }
65
66  if (exists($ENV{FTP_FIREWALL_TYPE})) {
67    ${*$ftp}{net_ftp_firewall_type} = $ENV{FTP_FIREWALL_TYPE};
68  }
69
70  my $self = {
71    addr => $addr,
72    ftp => $ftp,
73    port => $port,
74  };
75
76  $conn_ex = undef;
77
78  bless($self, $class);
79  return $self;
80}
81
82sub response_code {
83  my $self = shift;
84  return $self->{ftp}->code;
85}
86
87sub response_msg {
88  my $self = shift;
89  my $req_index = shift;
90
91  my $index = 1;
92  if (defined($req_index)) {
93    $index = $req_index;
94  }
95
96  if (defined($self->{mesg})) {
97    my $msg = $self->{mesg};
98    delete($self->{mesg});
99    chomp($msg);
100    return $msg;
101  }
102
103  my @msgs = $self->{ftp}->message;
104  my $nmsgs = scalar(@msgs);
105  if ($nmsgs > 1) {
106    if ($index > ($nmsgs - 1)) {
107      return undef;
108    }
109
110    chomp($msgs[$index]);
111    return $msgs[$index];
112
113  } else {
114    if (defined($req_index)) {
115      if ($index > 0) {
116        return undef;
117      }
118    }
119  }
120
121  if (defined($msgs[0])) {
122    chomp($msgs[0]);
123  }
124
125  return $msgs[0];
126}
127
128sub response_msgs {
129  my $self = shift;
130
131  my @msgs = $self->{ftp}->message;
132  my $msgs = [];
133  foreach my $msg (@msgs) {
134    chomp($msg);
135    push(@$msgs, $msg);
136  }
137
138  return $msgs;
139}
140
141sub response_uniq {
142  my $self = shift;
143
144  my $uniq;
145  if (defined($self->{uniq})) {
146    $uniq = $self->{uniq};
147    delete($self->{uniq});
148
149  } else {
150    $uniq = $self->{ftp}->unique_name();
151    unless ($uniq) {
152      my @msgs = $self->{ftp}->message;
153      if (scalar(@msgs) > 1) {
154        my $tmp = $msgs[0];
155
156        if ($tmp =~ /^FILE:\s+(\S+)$/) {
157          $uniq = $1;
158        }
159      }
160    }
161  }
162
163  if ($uniq) {
164    chomp($uniq);
165  }
166
167  return $uniq;
168}
169
170my $login_timeout = 0;
171sub login_alarm {
172  croak("Login timed out after $login_timeout secs");
173}
174
175sub login {
176  my $self = shift;
177  my $user = shift;
178  croak("Missing required user argument") unless defined($user);
179  my $pass = shift;
180  croak("Missing required password argument") unless defined($pass);
181  $login_timeout = shift;
182  $login_timeout = 30 unless defined($login_timeout);
183
184  $SIG{ALRM} = \&login_alarm;
185  alarm($login_timeout);
186
187  # Work around some (strange? broken?) ness in Net::FTP's handling of
188  # the destination server in the login() method for "firewalls"
189  # (i.e. proxying).
190
191  my $ftp = $self->{ftp};
192  my $net_ftp_host = ${*$ftp}{net_ftp_host};
193
194  if (exists($ENV{FTP_FIREWALL})) {
195    ${*$ftp}{net_ftp_host} = $ENV{FTP_FIREWALL};
196  }
197
198  unless ($self->{ftp}->login($user, $pass)) {
199    if (exists($ENV{FTP_FIREWALL})) {
200      ${*$ftp}{net_ftp_host} = $net_ftp_host;
201    }
202
203    alarm(0);
204    $SIG{ALRM} = 'DEFAULT';
205
206    croak("Failed to login to $self->{addr}:$self->{port}: " .
207      $self->{ftp}->code . ' ' . $self->{ftp}->message);
208  }
209
210  alarm(0);
211  $SIG{ALRM} = 'DEFAULT';
212
213  my $msg = $self->response_msg();
214  if (wantarray()) {
215    return ($self->{ftp}->code, $msg);
216
217  } else {
218    return $msg;
219  }
220}
221
222sub user {
223  my $self = shift;
224  my $user = shift;
225  $user = '' unless defined($user);
226  my $code;
227
228  $code = $self->{ftp}->quot('USER', $user);
229  unless ($code) {
230    croak("USER command failed: " .  $self->{ftp}->code . ' ' .
231      $self->response_msg());
232  }
233
234  if ($code == 4 || $code == 5) {
235    croak("USER command failed: " .  $self->{ftp}->code . ' ' .
236      $self->response_msg());
237  }
238
239  my $msg = $self->response_msg();
240  if (wantarray()) {
241    return ($self->{ftp}->code, $msg);
242
243  } else {
244    return $msg;
245  }
246}
247
248sub pass {
249  my $self = shift;
250  my $passwd = shift;
251  $passwd = '' unless defined($passwd);
252  my $code;
253
254  $code = $self->{ftp}->quot('PASS', $passwd);
255  unless ($code) {
256    croak("PASS command failed: " .  $self->{ftp}->code . ' ' .
257      $self->response_msg());
258  }
259
260  if ($code == 4 || $code == 5) {
261    croak("PASS command failed: " .  $self->{ftp}->code . ' ' .
262      $self->response_msg());
263  }
264
265  my $msg = $self->response_msg();
266  if (wantarray()) {
267    return ($self->{ftp}->code, $msg);
268
269  } else {
270    return $msg;
271  }
272}
273
274sub pwd {
275  my $self = shift;
276
277  unless ($self->{ftp}->pwd()) {
278    croak("PWD command failed: " .  $self->{ftp}->code . ' ' .
279      $self->response_msg());
280  }
281
282  my $msg = $self->response_msg();
283  if (wantarray()) {
284    return ($self->{ftp}->code, $msg);
285
286  } else {
287    return $msg;
288  }
289}
290
291sub xpwd {
292  my $self = shift;
293  my $code;
294
295  $code = $self->{ftp}->quot('XPWD');
296  unless ($code) {
297    croak("XPWD command failed: " .  $self->{ftp}->code . ' ' .
298      $self->response_msg());
299  }
300
301  if ($code == 4 || $code == 5) {
302    croak("XPWD command failed: " .  $self->{ftp}->code . ' ' .
303      $self->response_msg());
304  }
305
306  my $msg = $self->response_msg();
307  if (wantarray()) {
308    return ($self->{ftp}->code, $msg);
309
310  } else {
311    return $msg;
312  }
313}
314
315sub cwd {
316  my $self = shift;
317  my $dir = shift;
318
319  unless ($self->{ftp}->cwd($dir)) {
320    croak("CWD command failed: " .  $self->{ftp}->code . ' ' .
321      $self->response_msg());
322  }
323
324  my $msg = $self->response_msg();
325  if (wantarray()) {
326    return ($self->{ftp}->code, $msg);
327
328  } else {
329    return $msg;
330  }
331}
332
333sub xcwd {
334  my $self = shift;
335  my $dir = shift;
336  my $code;
337
338  $code = $self->{ftp}->quot('XCWD', $dir);
339  unless ($code) {
340    croak("XCWD command failed: " .  $self->{ftp}->code . ' ' .
341      $self->response_msg());
342  }
343
344  if ($code == 4 || $code == 5) {
345    croak("XCWD command failed: " .  $self->{ftp}->code . ' ' .
346      $self->response_msg());
347  }
348
349  my $msg = $self->response_msg();
350  if (wantarray()) {
351    return ($self->{ftp}->code, $msg);
352
353  } else {
354    return $msg;
355  }
356}
357
358sub cdup {
359  my $self = shift;
360  my $dir = shift;
361
362  unless ($self->{ftp}->cdup()) {
363    croak("CDUP command failed: " .  $self->{ftp}->code . ' ' .
364      $self->response_msg());
365  }
366
367  my $msg = $self->response_msg();
368  if (wantarray()) {
369    return ($self->{ftp}->code, $msg);
370
371  } else {
372    return $msg;
373  }
374}
375
376sub xcup {
377  my $self = shift;
378  my $code;
379
380  $code = $self->{ftp}->quot('XCUP');
381  unless ($code) {
382    croak("XCUP command failed: " .  $self->{ftp}->code . ' ' .
383      $self->response_msg());
384  }
385
386  if ($code == 4 || $code == 5) {
387    croak("XCUP command failed: " .  $self->{ftp}->code . ' ' .
388      $self->response_msg());
389  }
390
391  my $msg = $self->response_msg();
392  if (wantarray()) {
393    return ($self->{ftp}->code, $msg);
394
395  } else {
396    return $msg;
397  }
398}
399
400sub syst {
401  my $self = shift;
402  my $code;
403
404  $code = $self->{ftp}->quot('SYST');
405  unless ($code) {
406    croak("SYST command failed: " .  $self->{ftp}->code . ' ' .
407      $self->response_msg());
408  }
409
410  if ($code == 4 || $code == 5) {
411    croak("SYST command failed: " .  $self->{ftp}->code . ' ' .
412      $self->response_msg());
413  }
414
415  my $msg = $self->response_msg();
416  if (wantarray()) {
417    return ($self->{ftp}->code, $msg);
418
419  } else {
420    return $msg;
421  }
422}
423
424sub mkd {
425  my $self = shift;
426  my $dir = shift;
427
428  unless ($self->{ftp}->mkdir($dir)) {
429    croak("MKD command failed: " .  $self->{ftp}->code . ' ' .
430      $self->response_msg());
431  }
432
433  my $msg = $self->response_msg();
434  if (wantarray()) {
435    return ($self->{ftp}->code, $msg);
436
437  } else {
438    return $msg;
439  }
440}
441
442sub xmkd {
443  my $self = shift;
444  my $dir = shift;
445  my $code;
446
447  $code = $self->{ftp}->quot('XMKD', $dir);
448  unless ($code) {
449    croak("XMKD command failed: " .  $self->{ftp}->code . ' ' .
450      $self->response_msg());
451  }
452
453  if ($code == 4 || $code == 5) {
454    croak("XMKD command failed: " .  $self->{ftp}->code . ' ' .
455      $self->response_msg());
456  }
457
458  my $msg = $self->response_msg();
459  if (wantarray()) {
460    return ($self->{ftp}->code, $msg);
461
462  } else {
463    return $msg;
464  }
465}
466
467sub rmd {
468  my $self = shift;
469  my $dir = shift;
470
471  unless ($self->{ftp}->rmdir($dir)) {
472    croak("RMD command failed: " .  $self->{ftp}->code . ' ' .
473      $self->response_msg());
474  }
475
476  my $msg = $self->response_msg();
477  if (wantarray()) {
478    return ($self->{ftp}->code, $msg);
479
480  } else {
481    return $msg;
482  }
483}
484
485sub xrmd {
486  my $self = shift;
487  my $dir = shift;
488  my $code;
489
490  $code = $self->{ftp}->quot('XRMD', $dir);
491  unless ($code) {
492    croak("XRMD command failed: " .  $self->{ftp}->code . ' ' .
493      $self->response_msg());
494  }
495
496  if ($code == 4 || $code == 5) {
497    croak("XRMD command failed: " .  $self->{ftp}->code . ' ' .
498      $self->response_msg());
499  }
500
501  my $msg = $self->response_msg();
502  if (wantarray()) {
503    return ($self->{ftp}->code, $msg);
504
505  } else {
506    return $msg;
507  }
508}
509
510sub dele {
511  my $self = shift;
512  my $path = shift;
513
514  unless ($self->{ftp}->delete($path)) {
515    croak("DELE command failed: " .  $self->{ftp}->code . ' ' .
516      $self->response_msg());
517  }
518
519  my $msg = $self->response_msg();
520  if (wantarray()) {
521    return ($self->{ftp}->code, $msg);
522
523  } else {
524    return $msg;
525  }
526}
527
528sub type {
529  my $self = shift;
530  my $type = shift;
531
532  if ($type =~ /^ascii$/i) {
533    unless ($self->{ftp}->ascii()) {
534      croak("TYPE command failed: " .  $self->{ftp}->code . ' ' .
535        $self->response_msg());
536    }
537
538  } elsif ($type =~ /^binary$/i) {
539    unless ($self->{ftp}->binary()) {
540      croak("TYPE command failed: " .  $self->{ftp}->code . ' ' .
541        $self->response_msg());
542    }
543
544  } else {
545    my $code;
546
547    $code = $self->{ftp}->quot('TYPE', $type);
548    unless ($code) {
549      croak("TYPE command failed: " .  $self->{ftp}->code . ' ' .
550        $self->response_msg());
551    }
552
553    if ($code == 4 || $code == 5) {
554      croak("TYPE command failed: " .  $self->{ftp}->code . ' ' .
555        $self->response_msg());
556    }
557  }
558
559  my $msg = $self->response_msg();
560  if (wantarray()) {
561    return ($self->{ftp}->code, $msg);
562
563  } else {
564    return $msg;
565  }
566}
567
568sub mdtm {
569  my $self = shift;
570  my $path = shift;
571
572  unless ($self->{ftp}->mdtm($path)) {
573    croak("MDTM command failed: " .  $self->{ftp}->code . ' ' .
574      $self->response_msg());
575  }
576
577  my $msg = $self->response_msg();
578  if (wantarray()) {
579    return ($self->{ftp}->code, $msg);
580
581  } else {
582    return $msg;
583  }
584}
585
586sub size {
587  my $self = shift;
588  my $path = shift;
589
590  unless ($self->{ftp}->size($path)) {
591    croak("SIZE command failed: " .  $self->{ftp}->code . ' ' .
592      $self->response_msg());
593  }
594
595  my $msg = $self->response_msg();
596  if (wantarray()) {
597    return ($self->{ftp}->code, $msg);
598
599  } else {
600    return $msg;
601  }
602}
603
604sub pasv {
605  my $self = shift;
606
607  unless ($self->{ftp}->pasv()) {
608    croak("PASV command failed: " .  $self->{ftp}->code . ' ' .
609      $self->response_msg());
610  }
611
612  # Naughtily invade the Net::FTP internals; it makes for less confusion
613  # when writing the unit tests.
614  my $ftp = $self->{ftp};
615  ${*$ftp}{net_ftp_passive} = 1;
616
617  my $msg = $self->response_msg();
618  if (wantarray()) {
619    return ($self->{ftp}->code, $msg);
620
621  } else {
622    return $msg;
623  }
624}
625
626sub epsv {
627  my $self = shift;
628  my $proto = shift;
629  $proto = '' unless defined($proto);
630  my $code;
631
632  $code = $self->{ftp}->quot('EPSV', $proto);
633  unless ($code) {
634    croak("EPSV command failed: " .  $self->{ftp}->code . ' ' .
635      $self->response_msg());
636  }
637
638  if ($code == 4 || $code == 5) {
639    croak("EPSV command failed: " .  $self->{ftp}->code . ' ' .
640      $self->response_msg());
641  }
642
643  # Naughtily invade the Net::FTP internals; it makes for less confusion
644  # when writing the unit tests.
645  my $ftp = $self->{ftp};
646  ${*$ftp}{net_ftp_passive} = 1;
647
648  my $msg = $self->response_msg();
649  if (wantarray()) {
650    return ($self->{ftp}->code, $msg);
651
652  } else {
653    return $msg;
654  }
655}
656
657sub port {
658  my $self = shift;
659  my $port = shift;
660
661  unless ($self->{ftp}->port($port)) {
662    croak("PORT command failed: " .  $self->{ftp}->code . ' ' .
663      $self->response_msg());
664  }
665
666  # Naughtily invade the Net::FTP internals; it makes for less confusion
667  # when writing the unit tests.
668  my $ftp = $self->{ftp};
669
670  if ($port) {
671    # Determine the local port from the given argument.
672
673    my $numbers = [split(',', $port)];
674    my $local_port = ($numbers->[4] * 256) + $numbers->[5];
675
676    # If the caller provided an explicit PORT argument, then we need to
677    # open the listening socket ourselves.  Net::FTP is braindead that way.
678    #
679    # The code below is copied from Net::FTP::port().
680
681    ${*$ftp}{net_ftp_listen} ||= IO::Socket::INET->new(
682      Listen => 5,
683      Proto => 'tcp',
684      Timeout => $ftp->timeout,
685      LocalAddr => $ftp->sockhost,
686      LocalPort => $local_port,
687    );
688
689    ${*$ftp}{net_ftp_intern_port} = 1;
690  }
691
692  delete(${*$ftp}{net_ftp_passive});
693
694  my $msg = $self->response_msg();
695  if (wantarray()) {
696    return ($self->{ftp}->code, $msg);
697
698  } else {
699    return $msg;
700  }
701}
702
703sub eprt {
704  my $self = shift;
705  my $port = shift;
706  $port = '' unless defined($port);
707  my $code;
708
709  $code = $self->{ftp}->quot('EPRT', $port);
710  unless ($code) {
711    croak("EPRT command failed: " .  $self->{ftp}->code . ' ' .
712      $self->response_msg());
713  }
714
715  if ($code == 4 || $code == 5) {
716    croak("EPRT command failed: " .  $self->{ftp}->code . ' ' .
717      $self->response_msg());
718  }
719
720  # Naughtily invade the Net::FTP internals; it makes for less confusion
721  # when writing the unit tests.
722  my $ftp = $self->{ftp};
723  delete(${*$ftp}{net_ftp_passive});
724
725  my $msg = $self->response_msg();
726  if (wantarray()) {
727    return ($self->{ftp}->code, $msg);
728
729  } else {
730    return $msg;
731  }
732}
733
734sub mode {
735  my $self = shift;
736  my $mode = shift;
737
738  if ($mode =~ /^stream$/i) {
739    my $code;
740
741    $code = $self->{ftp}->quot('MODE', 'S');
742    unless ($code) {
743      croak("MODE command failed: " .  $self->{ftp}->code . ' ' .
744        $self->response_msg());
745    }
746
747    if ($code == 4 || $code == 5) {
748      croak("MODE command failed: " .  $self->{ftp}->code . ' ' .
749        $self->response_msg());
750    }
751
752  } elsif ($mode =~ /^block$/i) {
753    my $code;
754
755    $code = $self->{ftp}->quot('MODE', 'B');
756    unless ($code) {
757      croak("MODE command failed: " .  $self->{ftp}->code . ' ' .
758        $self->response_msg());
759    }
760
761    if ($code == 4 || $code == 5) {
762      croak("MODE command failed: " .  $self->{ftp}->code . ' ' .
763        $self->response_msg());
764    }
765
766  } elsif ($mode =~ /^compress(ed)?$/i) {
767    my $code;
768
769    $code = $self->{ftp}->quot('MODE', 'C');
770    unless ($code) {
771      croak("MODE command failed: " .  $self->{ftp}->code . ' ' .
772        $self->response_msg());
773    }
774
775    if ($code == 4 || $code == 5) {
776      croak("MODE command failed: " .  $self->{ftp}->code . ' ' .
777        $self->response_msg());
778    }
779
780  } else {
781    my $code;
782
783    $code = $self->{ftp}->quot('MODE', $mode);
784    unless ($code) {
785      croak("MODE command failed: " .  $self->{ftp}->code . ' ' .
786        $self->response_msg());
787    }
788
789    if ($code == 4 || $code == 5) {
790      croak("MODE command failed: " .  $self->{ftp}->code . ' ' .
791        $self->response_msg());
792    }
793  }
794
795  my $msg = $self->response_msg();
796  if (wantarray()) {
797    return ($self->{ftp}->code, $msg);
798
799  } else {
800    return $msg;
801  }
802}
803
804sub stru {
805  my $self = shift;
806  my $stru = shift;
807
808  if ($stru =~ /^file$/i) {
809    my $code;
810
811    $code = $self->{ftp}->quot('STRU', 'F');
812    unless ($code) {
813      croak("STRU command failed: " .  $self->{ftp}->code . ' ' .
814        $self->response_msg());
815    }
816
817    if ($code == 4 || $code == 5) {
818      croak("STRU command failed: " .  $self->{ftp}->code . ' ' .
819        $self->response_msg());
820    }
821
822  } elsif ($stru =~ /^record$/i) {
823    my $code;
824
825    $code = $self->{ftp}->quot('STRU', 'R');
826    unless ($code) {
827      croak("STRU command failed: " .  $self->{ftp}->code . ' ' .
828        $self->response_msg());
829    }
830
831    if ($code == 4 || $code == 5) {
832      croak("STRU command failed: " .  $self->{ftp}->code . ' ' .
833        $self->response_msg());
834    }
835
836  } elsif ($stru =~ /^page$/i) {
837    my $code;
838
839    $code = $self->{ftp}->quot('STRU', 'P');
840    unless ($code) {
841      croak("STRU command failed: " .  $self->{ftp}->code . ' ' .
842        $self->response_msg());
843    }
844
845    if ($code == 4 || $code == 5) {
846      croak("STRU command failed: " .  $self->{ftp}->code . ' ' .
847        $self->response_msg());
848    }
849
850  } else {
851    my $code;
852
853    $code = $self->{ftp}->quot('STRU', $stru);
854    unless ($code) {
855      croak("STRU command failed: " .  $self->{ftp}->code . ' ' .
856        $self->response_msg());
857    }
858
859    if ($code == 4 || $code == 5) {
860      croak("STRU command failed: " .  $self->{ftp}->code . ' ' .
861        $self->response_msg());
862    }
863  }
864
865  my $msg = $self->response_msg();
866  if (wantarray()) {
867    return ($self->{ftp}->code, $msg);
868
869  } else {
870    return $msg;
871  }
872}
873
874sub allo {
875  my $self = shift;
876  my $size = shift;
877
878  # XXX Net::FTP has a bug with its alloc() method, where a 202 response
879  # code is incorrectly handled as an error.
880  my $code = 0;
881
882  $self->{ftp}->alloc($size);
883
884  if ($self->{ftp}->code =~ /^(\d)/) {
885    $code = $1;
886  }
887
888  if ($code == 4 || $code == 5) {
889    croak("ALLO command failed: " .  $self->{ftp}->code . ' ' .
890      $self->response_msg());
891  }
892
893  my $msg = $self->response_msg();
894  if (wantarray()) {
895    return ($self->{ftp}->code, $msg);
896
897  } else {
898    return $msg;
899  }
900}
901
902sub noop {
903  my $self = shift;
904  my $code;
905
906  $code = $self->{ftp}->quot('NOOP');
907  unless ($code) {
908    croak("NOOP command failed: " .  $self->{ftp}->code . ' ' .
909      $self->response_msg());
910  }
911
912  if ($code == 4 || $code == 5) {
913    croak("NOOP command failed: " .  $self->{ftp}->code . ' ' .
914      $self->response_msg());
915  }
916
917  my $msg = $self->response_msg();
918  if (wantarray()) {
919    return ($self->{ftp}->code, $msg);
920
921  } else {
922    return $msg;
923  }
924}
925
926sub rnfr {
927  my $self = shift;
928  my $path = shift;
929  my $code;
930
931  $code = $self->{ftp}->quot('RNFR', $path);
932  unless ($code) {
933    croak("RNFR command failed: " .  $self->{ftp}->code . ' ' .
934      $self->response_msg());
935  }
936
937  if ($code == 4 || $code == 5) {
938    croak("RNFR command failed: " .  $self->{ftp}->code . ' ' .
939      $self->response_msg());
940  }
941
942  my $msg = $self->response_msg();
943  if (wantarray()) {
944    return ($self->{ftp}->code, $msg);
945
946  } else {
947    return $msg;
948  }
949}
950
951sub rnto {
952  my $self = shift;
953  my $path = shift;
954  my $code;
955
956  $code = $self->{ftp}->quot('RNTO', $path);
957  unless ($code) {
958    croak("RNTO command failed: " .  $self->{ftp}->code . ' ' .
959      $self->response_msg());
960  }
961
962  if ($code == 4 || $code == 5) {
963    croak("RNTO command failed: " .  $self->{ftp}->code . ' ' .
964      $self->response_msg());
965  }
966
967  my $msg = $self->response_msg();
968  if (wantarray()) {
969    return ($self->{ftp}->code, $msg);
970
971  } else {
972    return $msg;
973  }
974}
975
976sub quit {
977  my $self = shift;
978
979  unless ($self->{ftp}->quit()) {
980    croak("QUIT command failed: " .  $self->{ftp}->code . ' ' .
981      $self->response_msg());
982  }
983
984  my $msg = $self->response_msg();
985  if (wantarray()) {
986    return ($self->{ftp}->code, $msg);
987
988  } else {
989    return $msg;
990  }
991}
992
993sub rang {
994  my $self = shift;
995  my $range_start = shift;
996  croak("Missing range start") unless defined($range_start);
997  my $range_end = shift;
998  croak("Missing range end") unless defined($range_end);
999  my $code;
1000
1001  $code = $self->{ftp}->quot('RANG', $range_start, $range_end);
1002  unless ($code) {
1003    croak("RANG command failed: " .  $self->{ftp}->code . ' ' .
1004      $self->response_msg());
1005  }
1006
1007  if ($code == 4 || $code == 5) {
1008    croak("RANG command failed: " .  $self->{ftp}->code . ' ' .
1009      $self->response_msg());
1010  }
1011
1012  my $msg = $self->response_msg();
1013  if (wantarray()) {
1014    return ($self->{ftp}->code, $msg);
1015  }
1016
1017  return $msg;
1018}
1019
1020sub rest {
1021  my $self = shift;
1022  my $offset = shift;
1023  $offset = '' unless defined($offset);
1024  my $code;
1025
1026  $code = $self->{ftp}->quot('REST', $offset);
1027  unless ($code) {
1028    croak("REST command failed: " .  $self->{ftp}->code . ' ' .
1029      $self->response_msg());
1030  }
1031
1032  if ($code == 4 || $code == 5) {
1033    croak("REST command failed: " .  $self->{ftp}->code . ' ' .
1034      $self->response_msg());
1035  }
1036
1037  my $msg = $self->response_msg();
1038  if (wantarray()) {
1039    return ($self->{ftp}->code, $msg);
1040
1041  } else {
1042    return $msg;
1043  }
1044}
1045
1046sub nlst {
1047  my $self = shift;
1048  my $path = shift;
1049  $path = '' unless defined($path);
1050
1051  my $res;
1052
1053  $res = $self->{ftp}->nlst($path);
1054  unless ($res) {
1055    croak("NLST command failed: " .  $self->{ftp}->code . ' ' .
1056      $self->response_msg());
1057  }
1058
1059  if (ref($res)) {
1060    my $buf;
1061    while ($res->read($buf, 8192) > 0) {
1062    }
1063
1064    $res->close();
1065  }
1066
1067  my $msg = $self->response_msg();
1068  if (wantarray()) {
1069    return ($self->{ftp}->code, $msg);
1070
1071  } else {
1072    return $msg;
1073  }
1074}
1075
1076sub nlst_raw {
1077  my $self = shift;
1078  my $path = shift;
1079  $path = '' unless defined($path);
1080
1081  return $self->{ftp}->nlst($path);
1082}
1083
1084sub list {
1085  my $self = shift;
1086  my $path = shift;
1087  $path = '' unless defined($path);
1088
1089  my $res;
1090
1091  $res = $self->{ftp}->list($path);
1092  unless ($res) {
1093    croak("LIST command failed: " .  $self->{ftp}->code . ' ' .
1094      $self->response_msg());
1095  }
1096
1097  if (ref($res)) {
1098    my $buf;
1099    while ($res->read($buf, 8192) > 0) {
1100    }
1101
1102    $res->close();
1103  }
1104
1105  # XXX Work around bug in Net::FTP which fails to handle the case where,
1106  # for data transfers, a 150 response code may be sent (to open the data
1107  # connection), followed by an error response code.
1108  my $code = 0;
1109
1110  if ($self->{ftp}->code =~ /^(\d)/) {
1111    $code = $1;
1112  }
1113
1114  if ($code == 4 || $code == 5) {
1115    my $msg = $self->response_msg();
1116    $self->{mesg} = $msg;
1117
1118    croak("LIST command failed: " .  $self->{ftp}->code . ' ' . $msg);
1119  }
1120
1121  my $msg = $self->response_msg();
1122  if (wantarray()) {
1123    return ($self->{ftp}->code, $msg);
1124
1125  } else {
1126    return $msg;
1127  }
1128}
1129
1130sub list_raw {
1131  my $self = shift;
1132  my $path = shift;
1133  $path = '' unless defined($path);
1134
1135  return $self->{ftp}->list($path);
1136}
1137
1138sub retr {
1139  my $self = shift;
1140  my $src_path = shift;
1141  $src_path = '' unless defined($src_path);
1142  my $dst_path = shift;
1143  $dst_path = '/dev/null' unless defined($dst_path);
1144
1145  my $res;
1146
1147  $res = $self->{ftp}->get($src_path, $dst_path);
1148  unless ($res) {
1149    croak("RETR command failed: " .  $self->{ftp}->code . ' ' .
1150      $self->response_msg());
1151  }
1152
1153  if (ref($res)) {
1154    my $buf;
1155    while ($res->read($buf, 8192) > 0) {
1156    }
1157
1158    $res->close();
1159  }
1160
1161  # XXX Work around bug in Net::FTP which fails to handle the case where,
1162  # for data transfers, a 150 response code may be sent (to open the data
1163  # connection), followed by an error response code.
1164  my $code = 0;
1165
1166  if ($self->{ftp}->code =~ /^(\d)/) {
1167    $code = $1;
1168  }
1169
1170  if ($code == 4 || $code == 5) {
1171    my $msg = $self->response_msg();
1172    $self->{mesg} = $msg;
1173
1174    croak("RETR command failed: " .  $self->{ftp}->code . ' ' . $msg);
1175  }
1176
1177  my $msg = $self->response_msg();
1178  if (wantarray()) {
1179    return ($self->{ftp}->code, $msg);
1180
1181  } else {
1182    return $msg;
1183  }
1184}
1185
1186sub retr_raw {
1187  my $self = shift;
1188  my $path = shift;
1189  $path = '' unless defined($path);
1190
1191  return $self->{ftp}->retr($path);
1192}
1193
1194sub stor {
1195  my $self = shift;
1196  my $src_path = shift;
1197  $src_path = '' unless defined($src_path);
1198  my $dst_path = shift;
1199  $dst_path = '/dev/null' unless defined($dst_path);
1200
1201  my $res;
1202
1203  $res = $self->{ftp}->put($src_path, $dst_path);
1204  unless ($res) {
1205    croak("STOR command failed: " .  $self->{ftp}->code . ' ' .
1206      $self->response_msg());
1207  }
1208
1209  # XXX Work around bug in Net::FTP which fails to handle the case where,
1210  # for data transfers, a 150 response code may be sent (to open the data
1211  # connection), followed by an error response code.
1212  my $code = 0;
1213
1214  if ($self->{ftp}->code =~ /^(\d)/) {
1215    $code = $1;
1216  }
1217
1218  if ($code == 4 || $code == 5) {
1219    my $msg = $self->response_msg();
1220    $self->{mesg} = $msg;
1221
1222    croak("STOR command failed: " .  $self->{ftp}->code . ' ' . $msg);
1223  }
1224
1225  my $msg = $self->response_msg();
1226  if (wantarray()) {
1227    return ($self->{ftp}->code, $msg);
1228
1229  } else {
1230    return $msg;
1231  }
1232}
1233
1234sub stor_raw {
1235  my $self = shift;
1236  my $path = shift;
1237  $path = '' unless defined($path);
1238
1239  return $self->{ftp}->stor($path);
1240}
1241
1242sub stou {
1243  my $self = shift;
1244  my $src_path = shift;
1245  $src_path = '' unless defined($src_path);
1246  my $dst_path = shift;
1247  $dst_path = '' unless defined($dst_path);
1248
1249  my $res;
1250
1251  $res = $self->{ftp}->put_unique($src_path, $dst_path);
1252  unless ($res) {
1253    croak("STOU command failed: " .  $self->{ftp}->code . ' ' .
1254      $self->response_msg());
1255  }
1256
1257  $self->{uniq} = $res;
1258
1259  # XXX Work around bug in Net::FTP which fails to handle the case where,
1260  # for data transfers, a 150 response code may be sent (to open the data
1261  # connection), followed by an error response code.
1262  my $code = 0;
1263
1264  if ($self->{ftp}->code =~ /^(\d)/) {
1265    $code = $1;
1266  }
1267
1268  if ($code == 4 || $code == 5) {
1269    my $msg = $self->response_msg();
1270    $self->{mesg} = $msg;
1271
1272    croak("STOU command failed: " .  $self->{ftp}->code . ' ' . $msg);
1273  }
1274
1275  my $msg = $self->response_msg();
1276  if (wantarray()) {
1277    return ($self->{ftp}->code, $msg);
1278
1279  } else {
1280    return $msg;
1281  }
1282}
1283
1284sub stou_raw {
1285  my $self = shift;
1286  my $path = shift;
1287  $path = '' unless defined($path);
1288
1289  return $self->{ftp}->stou($path);
1290}
1291
1292sub appe {
1293  my $self = shift;
1294  my $src_path = shift;
1295  $src_path = '' unless defined($src_path);
1296  my $dst_path = shift;
1297  $dst_path = '/dev/null' unless defined($dst_path);
1298
1299  my $res;
1300
1301  $res = $self->{ftp}->append($src_path, $dst_path);
1302  unless ($res) {
1303    croak("APPE command failed: " .  $self->{ftp}->code . ' ' .
1304      $self->response_msg());
1305  }
1306
1307  # XXX Work around bug in Net::FTP which fails to handle the case where,
1308  # for data transfers, a 150 response code may be sent (to open the data
1309  # connection), followed by an error response code.
1310  my $code = 0;
1311
1312  if ($self->{ftp}->code =~ /^(\d)/) {
1313    $code = $1;
1314  }
1315
1316  if ($code == 4 || $code == 5) {
1317    my $msg = $self->response_msg();
1318    $self->{mesg} = $msg;
1319
1320    croak("APPE command failed: " .  $self->{ftp}->code . ' ' . $msg);
1321  }
1322
1323  my $msg = $self->response_msg();
1324  if (wantarray()) {
1325    return ($self->{ftp}->code, $msg);
1326
1327  } else {
1328    return $msg;
1329  }
1330}
1331
1332sub appe_raw {
1333  my $self = shift;
1334  my $path = shift;
1335  $path = '' unless defined($path);
1336
1337  return $self->{ftp}->appe($path);
1338}
1339
1340sub feat {
1341  my $self = shift;
1342  my $code;
1343
1344  $code = $self->{ftp}->quot('FEAT');
1345  unless ($code) {
1346    croak("FEAT command failed: " .  $self->{ftp}->code . ' ' .
1347      $self->response_msg());
1348  }
1349
1350  if ($code == 4 || $code == 5) {
1351    croak("FEAT command failed: " .  $self->{ftp}->code . ' ' .
1352      $self->response_msg());
1353  }
1354
1355  my $msg = $self->response_msg();
1356  if (wantarray()) {
1357    return ($self->{ftp}->code, $msg);
1358
1359  } else {
1360    return $msg;
1361  }
1362}
1363
1364sub help {
1365  my $self = shift;
1366  my $code;
1367
1368  $code = $self->{ftp}->quot('HELP');
1369  unless ($code) {
1370    croak("HELP command failed: " .  $self->{ftp}->code . ' ' .
1371      $self->response_msg());
1372  }
1373
1374  if ($code == 4 || $code == 5) {
1375    croak("HELP command failed: " .  $self->{ftp}->code . ' ' .
1376      $self->response_msg());
1377  }
1378
1379  my $msg = $self->response_msg();
1380  if (wantarray()) {
1381    return ($self->{ftp}->code, $msg);
1382
1383  } else {
1384    return $msg;
1385  }
1386}
1387
1388sub site {
1389  my $self = shift;
1390  my $cmd = shift;
1391  $cmd = '' unless defined($cmd);
1392  my $code;
1393
1394  $code = $self->{ftp}->quot('SITE', $cmd, @_);
1395  unless ($code) {
1396    croak("SITE command failed: " .  $self->{ftp}->code . ' ' .
1397      $self->response_msg());
1398  }
1399
1400  if ($code == 4 || $code == 5) {
1401    croak("SITE command failed: " .  $self->{ftp}->code . ' ' .
1402      $self->response_msg());
1403  }
1404
1405  my $msg = $self->response_msg();
1406  if (wantarray()) {
1407    return ($self->{ftp}->code, $msg);
1408
1409  } else {
1410    return $msg;
1411  }
1412}
1413
1414sub quote {
1415  my $self = shift;
1416  my $cmd = shift;
1417  $cmd = '' unless defined($cmd);
1418  my $code;
1419
1420  $code = $self->{ftp}->quot($cmd, @_);
1421  unless ($code) {
1422    croak("Raw command '$cmd' failed: " .  $self->{ftp}->code . ' ' .
1423      $self->response_msg());
1424  }
1425
1426  if ($code == 4 || $code == 5) {
1427    croak("Raw command '$cmd' failed: " .  $self->{ftp}->code . ' ' .
1428      $self->response_msg());
1429  }
1430
1431  my $msg = $self->response_msg();
1432  if (wantarray()) {
1433    return ($self->{ftp}->code, $msg);
1434
1435  } else {
1436    return $msg;
1437  }
1438}
1439
1440sub quote_raw {
1441  my $self = shift;
1442  my $cmd = shift;
1443  $cmd = '' unless defined($cmd);
1444  my $code;
1445
1446  # Net::FTP::quot() calls uc() on the command; we want to send the "raw"
1447  # command here.
1448  $self->{ftp}->command($cmd, @_);
1449  $code = $self->{ftp}->response();
1450  unless ($code) {
1451    croak("Raw command '$cmd' failed: " .  $self->{ftp}->code . ' ' .
1452      $self->response_msg());
1453  }
1454
1455  if ($code == 4 || $code == 5) {
1456    croak("Raw command '$cmd' failed: " .  $self->{ftp}->code . ' ' .
1457      $self->response_msg());
1458  }
1459
1460  my $msg = $self->response_msg();
1461  if (wantarray()) {
1462    return ($self->{ftp}->code, $msg);
1463
1464  } else {
1465    return $msg;
1466  }
1467}
1468
1469sub mlsd {
1470  my $self = shift;
1471  my $path = shift;
1472  $path = '' unless defined($path);
1473
1474  my $res;
1475
1476  $res = $self->{ftp}->_data_cmd('MLSD', $path);
1477  unless ($res) {
1478    croak("MLSD command failed: " .  $self->{ftp}->code . ' ' .
1479      $self->response_msg());
1480  }
1481
1482  if (ref($res)) {
1483    my $buf;
1484    while ($res->read($buf, 8192) > 0) {
1485    }
1486
1487    $res->close();
1488  }
1489
1490  # XXX Work around bug in Net::FTP which fails to handle the case where,
1491  # for data transfers, a 150 response code may be sent (to open the data
1492  # connection), followed by an error response code.
1493  my $code = 0;
1494
1495  if ($self->{ftp}->code =~ /^(\d)/) {
1496    $code = $1;
1497  }
1498
1499  if ($code == 4 || $code == 5) {
1500    my $msg = $self->response_msg();
1501    $self->{mesg} = $msg;
1502
1503    croak("MLSD command failed: " .  $self->{ftp}->code . ' ' . $msg);
1504  }
1505
1506  my $msg = $self->response_msg();
1507  if (wantarray()) {
1508    return ($self->{ftp}->code, $msg);
1509
1510  } else {
1511    return $msg;
1512  }
1513}
1514
1515sub mlsd_raw {
1516  my $self = shift;
1517  my $path = shift;
1518  $path = '' unless defined($path);
1519  my $conn;
1520
1521  $conn = $self->{ftp}->_data_cmd('MLSD', $path);
1522  return $conn;
1523}
1524
1525sub mlst {
1526  my $self = shift;
1527  my $path = shift;
1528  $path = '' unless defined($path);
1529  my $code;
1530
1531  $code = $self->{ftp}->quot('MLST', $path);
1532  unless ($code) {
1533    croak("MLST command failed: " .  $self->{ftp}->code . ' ' .
1534      $self->response_msg());
1535  }
1536
1537  if ($code == 4 || $code == 5) {
1538    croak("MLST command failed: " .  $self->{ftp}->code . ' ' .
1539      $self->response_msg());
1540  }
1541
1542  my $msg = $self->response_msg();
1543  if (wantarray()) {
1544    return ($self->{ftp}->code, $msg);
1545
1546  } else {
1547    return $msg;
1548  }
1549}
1550
1551sub mff {
1552  my $self = shift;
1553  my $facts = shift;
1554  $facts = '' unless defined($facts);
1555  my $path = shift;
1556  $path = '' unless defined($path);
1557  my $code;
1558
1559  $code = $self->{ftp}->quot('MFF', $facts, $path);
1560  unless ($code) {
1561    croak("MFF command failed: " .  $self->{ftp}->code . ' ' .
1562      $self->response_msg());
1563  }
1564
1565  if ($code == 4 || $code == 5) {
1566    croak("MFF command failed: " .  $self->{ftp}->code . ' ' .
1567      $self->response_msg());
1568  }
1569
1570  my $msg = $self->response_msg();
1571  if (wantarray()) {
1572    return ($self->{ftp}->code, $msg);
1573
1574  } else {
1575    return $msg;
1576  }
1577}
1578
1579sub mfmt {
1580  my $self = shift;
1581  my $timestamp = shift;
1582  $timestamp = '' unless defined($timestamp);
1583  my $path = shift;
1584  $path = '' unless defined($path);
1585  my $code;
1586
1587  $code = $self->{ftp}->quot('MFMT', $timestamp, $path);
1588  unless ($code) {
1589    croak("MFMT command failed: " .  $self->{ftp}->code . ' ' .
1590      $self->response_msg());
1591  }
1592
1593  if ($code == 4 || $code == 5) {
1594    croak("MFMT command failed: " .  $self->{ftp}->code . ' ' .
1595      $self->response_msg());
1596  }
1597
1598  my $msg = $self->response_msg();
1599  if (wantarray()) {
1600    return ($self->{ftp}->code, $msg);
1601
1602  } else {
1603    return $msg;
1604  }
1605}
1606
1607sub lang {
1608  my $self = shift;
1609  my $lang = shift;
1610  $lang = '' unless defined($lang);
1611  my $code;
1612
1613  $code = $self->{ftp}->quot('LANG', $lang);
1614  unless ($code) {
1615    croak("LANG command failed: " .  $self->{ftp}->code . ' ' .
1616      $self->response_msg());
1617  }
1618
1619  if ($code == 4 || $code == 5) {
1620    croak("LANG command failed: " .  $self->{ftp}->code . ' ' .
1621      $self->response_msg());
1622  }
1623
1624  my $msg = $self->response_msg();
1625  if (wantarray()) {
1626    return ($self->{ftp}->code, $msg);
1627
1628  } else {
1629    return $msg;
1630  }
1631}
1632
1633sub opts {
1634  my $self = shift;
1635  my $cmd = shift;
1636  $cmd = '' unless defined($cmd);
1637  my $code;
1638
1639  $code = $self->{ftp}->quot('OPTS', $cmd, @_);
1640  unless ($code) {
1641    croak("OPTS command failed: " .  $self->{ftp}->code . ' ' .
1642      $self->response_msg());
1643  }
1644
1645  if ($code == 4 || $code == 5) {
1646    croak("OPTS command failed: " .  $self->{ftp}->code . ' ' .
1647      $self->response_msg());
1648  }
1649
1650  my $msg = $self->response_msg();
1651  if (wantarray()) {
1652    return ($self->{ftp}->code, $msg);
1653
1654  } else {
1655    return $msg;
1656  }
1657}
1658
1659sub get_connect_exception {
1660  return $conn_ex;
1661}
1662
1663sub stat {
1664  my $self = shift;
1665  my $path = shift;
1666  $path = '' unless defined($path);
1667  my $code;
1668
1669  $code = $self->{ftp}->quot('STAT', $path);
1670  unless ($code) {
1671    croak("STAT command failed: " .  $self->{ftp}->code . ' ' .
1672      $self->response_msg());
1673  }
1674
1675  if ($code == 4 || $code == 5) {
1676    croak("STAT command failed: " .  $self->{ftp}->code . ' ' .
1677      $self->response_msg());
1678  }
1679
1680  my $msg = $self->response_msg();
1681  if (wantarray()) {
1682    return ($self->{ftp}->code, $msg);
1683
1684  } else {
1685    return $msg;
1686  }
1687}
1688
1689# From the FTP HOST command RFC 7151
1690sub host {
1691  my $self = shift;
1692  my $host = shift;
1693  $host = '' unless defined($host);
1694  my $code;
1695
1696  $code = $self->{ftp}->quot('HOST', $host);
1697  unless ($code) {
1698    croak("HOST command failed: " .  $self->{ftp}->code . ' ' .
1699      $self->response_msg());
1700  }
1701
1702  if ($code == 4 || $code == 5) {
1703    croak("HOST command failed: " .  $self->{ftp}->code . ' ' .
1704      $self->response_msg());
1705  }
1706
1707  my $msg = $self->response_msg();
1708  if (wantarray()) {
1709    return ($self->{ftp}->code, $msg);
1710
1711  } else {
1712    return $msg;
1713  }
1714}
1715
1716sub clnt {
1717  my $self = shift;
1718  my $info = shift;
1719  $info = 'ProFTPD::TestSuite::FTP' unless defined($info);
1720  my $code;
1721
1722  $code = $self->{ftp}->quot('CLNT', $info);
1723  unless ($code) {
1724    croak("CLNT command failed: " .  $self->{ftp}->code . ' ' .
1725      $self->response_msg());
1726  }
1727
1728  if ($code == 4 || $code == 5) {
1729    croak("CLNT command failed: " .  $self->{ftp}->code . ' ' .
1730      $self->response_msg());
1731  }
1732
1733  my $msg = $self->response_msg();
1734  if (wantarray()) {
1735    return ($self->{ftp}->code, $msg);
1736
1737  } else {
1738    return $msg;
1739  }
1740}
1741
1742sub abort {
1743  my $self = shift;
1744
1745  unless ($self->{ftp}->abort()) {
1746    croak("ABOR command failed: " .  $self->{ftp}->code . ' ' .
1747      $self->response_msg());
1748  }
1749
1750  my $msg = $self->response_msg();
1751  if (wantarray()) {
1752    return ($self->{ftp}->code, $msg);
1753
1754  } else {
1755    return $msg;
1756  }
1757}
1758
17591;
1760