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