1package ProFTPD::Tests::Modules::mod_sftp::rewrite; 2 3use lib qw(t/lib); 4use base qw(ProFTPD::TestSuite::Child); 5use strict; 6 7use Digest::MD5; 8use File::Copy; 9use File::Path qw(mkpath rmtree); 10use File::Spec; 11use IO::Handle; 12use IPC::Open3; 13use POSIX qw(:fcntl_h); 14use Socket; 15 16use ProFTPD::TestSuite::FTP; 17use ProFTPD::TestSuite::Utils qw(:auth :config :features :running :test :testsuite); 18 19$| = 1; 20 21my $order = 0; 22 23my $TESTS = { 24 ssh2_rewrite_auth => { 25 order => ++$order, 26 test_class => [qw(forking mod_rewrite ssh2)], 27 }, 28 29 sftp_rewrite_stat => { 30 order => ++$order, 31 test_class => [qw(forking mod_rewrite sftp ssh2)], 32 }, 33 34 sftp_rewrite_lstat => { 35 order => ++$order, 36 test_class => [qw(forking mod_rewrite sftp ssh2)], 37 }, 38 39 sftp_rewrite_setstat => { 40 order => ++$order, 41 test_class => [qw(forking mod_rewrite sftp ssh2)], 42 }, 43 44 sftp_rewrite_realpath => { 45 order => ++$order, 46 test_class => [qw(forking mod_rewrite sftp ssh2)], 47 }, 48 49 sftp_rewrite_realpath_backslashes_bug4017 => { 50 order => ++$order, 51 test_class => [qw(bug forking mod_rewrite sftp ssh2)], 52 }, 53 54 sftp_rewrite_upload => { 55 order => ++$order, 56 test_class => [qw(forking mod_rewrite sftp ssh2)], 57 }, 58 59 sftp_rewrite_download => { 60 order => ++$order, 61 test_class => [qw(forking mod_rewrite sftp ssh2)], 62 }, 63 64 sftp_rewrite_readdir => { 65 order => ++$order, 66 test_class => [qw(forking mod_rewrite sftp ssh2)], 67 }, 68 69 sftp_rewrite_mkdir => { 70 order => ++$order, 71 test_class => [qw(forking mod_rewrite sftp ssh2)], 72 }, 73 74 sftp_rewrite_rmdir => { 75 order => ++$order, 76 test_class => [qw(forking mod_rewrite sftp ssh2)], 77 }, 78 79 sftp_rewrite_remove => { 80 order => ++$order, 81 test_class => [qw(forking mod_rewrite sftp ssh2)], 82 }, 83 84 sftp_rewrite_rename => { 85 order => ++$order, 86 test_class => [qw(forking mod_rewrite sftp ssh2)], 87 }, 88 89 sftp_rewrite_rename_file_var_w_bug3643 => { 90 order => ++$order, 91 test_class => [qw(forking mod_rewrite sftp ssh2)], 92 }, 93 94 sftp_rewrite_rename_dir_var_w_bug3643 => { 95 order => ++$order, 96 test_class => [qw(forking mod_rewrite sftp ssh2)], 97 }, 98 99 sftp_rewrite_symlink => { 100 order => ++$order, 101 test_class => [qw(forking mod_rewrite sftp ssh2)], 102 }, 103 104 sftp_rewrite_readlink => { 105 order => ++$order, 106 test_class => [qw(forking mod_rewrite sftp ssh2)], 107 }, 108 109 sftp_rewrite_homedir => { 110 order => ++$order, 111 test_class => [qw(forking mod_rewrite sftp ssh2)], 112 }, 113 114 scp_rewrite_upload => { 115 order => ++$order, 116 test_class => [qw(forking mod_rewrite scp ssh2)], 117 }, 118 119 scp_rewrite_download => { 120 order => ++$order, 121 test_class => [qw(forking mod_rewrite scp ssh2)], 122 }, 123 124}; 125 126sub get_sftplog { 127 my $db_file = shift; 128 129 my $sql = "SELECT user, operation, filename, full_path, filesize, xfertime FROM sftplog"; 130 131 my $cmd = "sqlite3 $db_file \"$sql\""; 132 133 if ($ENV{TEST_VERBOSE}) { 134 print STDERR "Executing sqlite3: $cmd\n"; 135 } 136 137 my $res = join('', `$cmd`); 138 139 # The default sqlite3 delimiter is '|' 140 return split(/\|/, $res); 141} 142 143sub new { 144 return shift()->SUPER::new(@_); 145} 146 147sub list_tests { 148 # Check for the required Perl modules: 149 # 150 # Net-SSH2 151 # Net-SSH2-SFTP 152 153 my $required = [qw( 154 Net::SSH2 155 Net::SSH2::SFTP 156 )]; 157 158 foreach my $req (@$required) { 159 eval "use $req"; 160 if ($@) { 161 print STDERR "\nWARNING:\n + Module '$req' not found, skipping all tests\n"; 162 163 if ($ENV{TEST_VERBOSE}) { 164 print STDERR "Unable to load $req: $@\n"; 165 } 166 167 return qw(testsuite_empty_test); 168 } 169 } 170 171 return testsuite_get_runnable_tests($TESTS); 172} 173 174sub set_up { 175 my $self = shift; 176 $self->SUPER::set_up(@_); 177 178 # Make sure that mod_sftp does not complain about permissions on the hostkey 179 # files. 180 181 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 182 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 183 184 unless (chmod(0400, $rsa_host_key, $dsa_host_key)) { 185 die("Can't set perms on $rsa_host_key, $dsa_host_key: $!"); 186 } 187} 188 189sub ssh2_rewrite_auth { 190 my $self = shift; 191 my $tmpdir = $self->{tmpdir}; 192 193 my $config_file = "$tmpdir/sftp.conf"; 194 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 195 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 196 197 my $log_file = test_get_logfile(); 198 199 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 200 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 201 202 my $user = 'proftpd'; 203 my $passwd = 'test'; 204 my $group = 'ftpd'; 205 my $home_dir = File::Spec->rel2abs($tmpdir); 206 my $uid = 500; 207 my $gid = 500; 208 209 # Make sure that, if we're running as root, that the home directory has 210 # permissions/privs set for the account we create 211 if ($< == 0) { 212 unless (chmod(0755, $home_dir)) { 213 die("Can't set perms on $home_dir to 0755: $!"); 214 } 215 216 unless (chown($uid, $gid, $home_dir)) { 217 die("Can't set owner of $home_dir to $uid/$gid: $!"); 218 } 219 } 220 221 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 222 '/bin/bash'); 223 auth_group_write($auth_group_file, $group, $gid, $user); 224 225 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 226 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 227 228 my $config = { 229 PidFile => $pid_file, 230 ScoreboardFile => $scoreboard_file, 231 SystemLog => $log_file, 232 TraceLog => $log_file, 233 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 234 235 AuthUserFile => $auth_user_file, 236 AuthGroupFile => $auth_group_file, 237 238 IfModules => { 239 'mod_delay.c' => { 240 DelayEngine => 'off', 241 }, 242 243 'mod_rewrite.c' => [ 244 'RewriteEngine on', 245 "RewriteLog $log_file", 246 247 'RewriteMap lowercase int:tolower', 248 'RewriteCondition %m USER', 249 'RewriteRule ^(.*)$ ${lowercase:$1}', 250 ], 251 252 'mod_sftp.c' => [ 253 "SFTPEngine on", 254 "SFTPLog $log_file", 255 "SFTPHostKey $rsa_host_key", 256 "SFTPHostKey $dsa_host_key", 257 ], 258 }, 259 }; 260 261 my ($port, $config_user, $config_group) = config_write($config_file, $config); 262 263 # Open pipes, for use between the parent and child processes. Specifically, 264 # the child will indicate when it's done with its test by writing a message 265 # to the parent. 266 my ($rfh, $wfh); 267 unless (pipe($rfh, $wfh)) { 268 die("Can't open pipe: $!"); 269 } 270 271 require Net::SSH2; 272 273 my $ex; 274 275 # Fork child 276 $self->handle_sigchld(); 277 defined(my $pid = fork()) or die("Can't fork: $!"); 278 if ($pid) { 279 eval { 280 my $ssh2 = Net::SSH2->new(); 281 282 sleep(1); 283 284 unless ($ssh2->connect('127.0.0.1', $port)) { 285 my ($err_code, $err_name, $err_str) = $ssh2->error(); 286 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 287 } 288 289 unless ($ssh2->auth_password(uc($user), $passwd)) { 290 my ($err_code, $err_name, $err_str) = $ssh2->error(); 291 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 292 } 293 294 $ssh2->disconnect(); 295 }; 296 297 if ($@) { 298 $ex = $@; 299 } 300 301 $wfh->print("done\n"); 302 $wfh->flush(); 303 304 } else { 305 eval { server_wait($config_file, $rfh) }; 306 if ($@) { 307 warn($@); 308 exit 1; 309 } 310 311 exit 0; 312 } 313 314 # Stop server 315 server_stop($pid_file); 316 317 $self->assert_child_ok($pid); 318 319 if ($ex) { 320 test_append_logfile($log_file, $ex); 321 unlink($log_file); 322 323 die($ex); 324 } 325 326 unlink($log_file); 327} 328 329sub sftp_rewrite_stat { 330 my $self = shift; 331 my $tmpdir = $self->{tmpdir}; 332 333 my $config_file = "$tmpdir/sftp.conf"; 334 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 335 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 336 337 my $log_file = test_get_logfile(); 338 339 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 340 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 341 342 my $user = 'proftpd'; 343 my $passwd = 'test'; 344 my $group = 'ftpd'; 345 my $home_dir = File::Spec->rel2abs($tmpdir); 346 my $uid = 500; 347 my $gid = 500; 348 349 my $test_file = 'test_file_here.txt'; 350 my $test_path = File::Spec->rel2abs("$tmpdir/$test_file"); 351 352 if (open(my $fh, "> $test_path")) { 353 print $fh "Hello, World!\n"; 354 355 unless (close($fh)) { 356 die("Can't write $test_path: $!"); 357 } 358 359 } else { 360 die("Can't open $test_path: $!"); 361 } 362 363 # Make sure that, if we're running as root, that the home directory has 364 # permissions/privs set for the account we create 365 if ($< == 0) { 366 unless (chmod(0755, $home_dir)) { 367 die("Can't set perms on $home_dir to 0755: $!"); 368 } 369 370 unless (chown($uid, $gid, $home_dir)) { 371 die("Can't set owner of $home_dir to $uid/$gid: $!"); 372 } 373 } 374 375 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 376 '/bin/bash'); 377 auth_group_write($auth_group_file, $group, $gid, $user); 378 379 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 380 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 381 382 my $config = { 383 PidFile => $pid_file, 384 ScoreboardFile => $scoreboard_file, 385 SystemLog => $log_file, 386 TraceLog => $log_file, 387 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 388 389 AuthUserFile => $auth_user_file, 390 AuthGroupFile => $auth_group_file, 391 392 IfModules => { 393 'mod_delay.c' => { 394 DelayEngine => 'off', 395 }, 396 397 'mod_rewrite.c' => [ 398 'RewriteEngine on', 399 "RewriteLog $log_file", 400 401 'RewriteMap replace int:replaceall', 402 'RewriteCondition %m STAT', 403 'RewriteRule ^(.*) "${replace:!$1! !_}"', 404 ], 405 406 'mod_sftp.c' => [ 407 "SFTPEngine on", 408 "SFTPLog $log_file", 409 "SFTPHostKey $rsa_host_key", 410 "SFTPHostKey $dsa_host_key", 411 ], 412 }, 413 }; 414 415 my ($port, $config_user, $config_group) = config_write($config_file, $config); 416 417 my $config_size = (stat($config_file))[7]; 418 419 # Open pipes, for use between the parent and child processes. Specifically, 420 # the child will indicate when it's done with its test by writing a message 421 # to the parent. 422 my ($rfh, $wfh); 423 unless (pipe($rfh, $wfh)) { 424 die("Can't open pipe: $!"); 425 } 426 427 require Net::SSH2; 428 429 my $ex; 430 431 # Fork child 432 $self->handle_sigchld(); 433 defined(my $pid = fork()) or die("Can't fork: $!"); 434 if ($pid) { 435 eval { 436 my $ssh2 = Net::SSH2->new(); 437 438 sleep(1); 439 440 unless ($ssh2->connect('127.0.0.1', $port)) { 441 my ($err_code, $err_name, $err_str) = $ssh2->error(); 442 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 443 } 444 445 unless ($ssh2->auth_password($user, $passwd)) { 446 my ($err_code, $err_name, $err_str) = $ssh2->error(); 447 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 448 } 449 450 my $sftp = $ssh2->sftp(); 451 unless ($sftp) { 452 my ($err_code, $err_name, $err_str) = $ssh2->error(); 453 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 454 } 455 456 my $attrs = $sftp->stat('test file here.txt', 1); 457 unless ($attrs) { 458 my ($err_code, $err_name) = $sftp->error(); 459 die("FXP_STAT failed: [$err_name] ($err_code)"); 460 } 461 462 my $expected; 463 464 $expected = 14; 465 my $file_size = $attrs->{size}; 466 $self->assert($expected == $file_size, 467 test_msg("Expected '$expected', got '$file_size'")); 468 469 $expected = $<; 470 my $file_uid = $attrs->{uid}; 471 $self->assert($expected == $file_uid, 472 test_msg("Expected '$expected', got '$file_uid'")); 473 474 $expected = $(; 475 my $file_gid = $attrs->{gid}; 476 $self->assert($expected == $file_gid, 477 test_msg("Expected '$expected', got '$file_gid'")); 478 479 $ssh2->disconnect(); 480 }; 481 482 if ($@) { 483 $ex = $@; 484 } 485 486 $wfh->print("done\n"); 487 $wfh->flush(); 488 489 } else { 490 eval { server_wait($config_file, $rfh) }; 491 if ($@) { 492 warn($@); 493 exit 1; 494 } 495 496 exit 0; 497 } 498 499 # Stop server 500 server_stop($pid_file); 501 502 $self->assert_child_ok($pid); 503 504 if ($ex) { 505 test_append_logfile($log_file, $ex); 506 unlink($log_file); 507 508 die($ex); 509 } 510 511 unlink($log_file); 512} 513 514sub sftp_rewrite_lstat { 515 my $self = shift; 516 my $tmpdir = $self->{tmpdir}; 517 518 my $config_file = "$tmpdir/sftp.conf"; 519 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 520 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 521 522 my $log_file = test_get_logfile(); 523 524 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 525 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 526 527 my $user = 'proftpd'; 528 my $passwd = 'test'; 529 my $group = 'ftpd'; 530 my $home_dir = File::Spec->rel2abs($tmpdir); 531 my $uid = 500; 532 my $gid = 500; 533 534 # Make sure that, if we're running as root, that the home directory has 535 # permissions/privs set for the account we create 536 if ($< == 0) { 537 unless (chmod(0755, $home_dir)) { 538 die("Can't set perms on $home_dir to 0755: $!"); 539 } 540 541 unless (chown($uid, $gid, $home_dir)) { 542 die("Can't set owner of $home_dir to $uid/$gid: $!"); 543 } 544 } 545 546 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 547 '/bin/bash'); 548 auth_group_write($auth_group_file, $group, $gid, $user); 549 550 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 551 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 552 553 my $config = { 554 PidFile => $pid_file, 555 ScoreboardFile => $scoreboard_file, 556 SystemLog => $log_file, 557 TraceLog => $log_file, 558 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 559 560 AuthUserFile => $auth_user_file, 561 AuthGroupFile => $auth_group_file, 562 563 IfModules => { 564 'mod_delay.c' => { 565 DelayEngine => 'off', 566 }, 567 568 'mod_rewrite.c' => [ 569 'RewriteEngine on', 570 "RewriteLog $log_file", 571 572 'RewriteMap replace int:replaceall', 573 'RewriteCondition %m LSTAT', 574 'RewriteRule ^(.*) "${replace:!$1! !_}"', 575 ], 576 577 'mod_sftp.c' => [ 578 "SFTPEngine on", 579 "SFTPLog $log_file", 580 "SFTPHostKey $rsa_host_key", 581 "SFTPHostKey $dsa_host_key", 582 ], 583 }, 584 }; 585 586 my ($port, $config_user, $config_group) = config_write($config_file, $config); 587 588 my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt"); 589 if (open(my $fh, "> $test_file")) { 590 print $fh "ABCD" x 1024; 591 unless (close($fh)) { 592 die("Can't write $test_file: $!"); 593 } 594 595 } else { 596 die("Can't open $test_file: $!"); 597 } 598 599 my $test_symlink = File::Spec->rel2abs("$tmpdir/test_link"); 600 unless (symlink($test_file, $test_symlink)) { 601 die("Can't symlink $test_symlink to $test_file: $!"); 602 } 603 604 my $test_size = (lstat($test_symlink))[7]; 605 606 # Open pipes, for use between the parent and child processes. Specifically, 607 # the child will indicate when it's done with its test by writing a message 608 # to the parent. 609 my ($rfh, $wfh); 610 unless (pipe($rfh, $wfh)) { 611 die("Can't open pipe: $!"); 612 } 613 614 require Net::SSH2; 615 616 my $ex; 617 618 # Fork child 619 $self->handle_sigchld(); 620 defined(my $pid = fork()) or die("Can't fork: $!"); 621 if ($pid) { 622 eval { 623 my $ssh2 = Net::SSH2->new(); 624 625 sleep(1); 626 627 unless ($ssh2->connect('127.0.0.1', $port)) { 628 my ($err_code, $err_name, $err_str) = $ssh2->error(); 629 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 630 } 631 632 unless ($ssh2->auth_password($user, $passwd)) { 633 my ($err_code, $err_name, $err_str) = $ssh2->error(); 634 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 635 } 636 637 my $sftp = $ssh2->sftp(); 638 unless ($sftp) { 639 my ($err_code, $err_name, $err_str) = $ssh2->error(); 640 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 641 } 642 643 my $attrs = $sftp->stat('test link', 0); 644 unless ($attrs) { 645 my ($err_code, $err_name) = $sftp->error(); 646 die("FXP_LSTAT failed: [$err_name] ($err_code)"); 647 } 648 649 my $expected; 650 651 $expected = $test_size; 652 my $file_size = $attrs->{size}; 653 $self->assert($expected == $file_size, 654 test_msg("Expected '$expected', got '$file_size'")); 655 656 $expected = $<; 657 my $file_uid = $attrs->{uid}; 658 $self->assert($expected == $file_uid, 659 test_msg("Expected '$expected', got '$file_uid'")); 660 661 $expected = $(; 662 my $file_gid = $attrs->{gid}; 663 $self->assert($expected == $file_gid, 664 test_msg("Expected '$expected', got '$file_gid'")); 665 666 $ssh2->disconnect(); 667 }; 668 669 if ($@) { 670 $ex = $@; 671 } 672 673 $wfh->print("done\n"); 674 $wfh->flush(); 675 676 } else { 677 eval { server_wait($config_file, $rfh) }; 678 if ($@) { 679 warn($@); 680 exit 1; 681 } 682 683 exit 0; 684 } 685 686 # Stop server 687 server_stop($pid_file); 688 689 $self->assert_child_ok($pid); 690 691 if ($ex) { 692 test_append_logfile($log_file, $ex); 693 unlink($log_file); 694 695 die($ex); 696 } 697 698 unlink($log_file); 699} 700 701sub sftp_rewrite_setstat { 702 my $self = shift; 703 my $tmpdir = $self->{tmpdir}; 704 705 my $config_file = "$tmpdir/sftp.conf"; 706 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 707 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 708 709 my $log_file = test_get_logfile(); 710 711 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 712 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 713 714 my $user = 'proftpd'; 715 my $passwd = 'test'; 716 my $group = 'ftpd'; 717 my $home_dir = File::Spec->rel2abs($tmpdir); 718 my $uid = 500; 719 my $gid = 500; 720 721 # Make sure that, if we're running as root, that the home directory has 722 # permissions/privs set for the account we create 723 if ($< == 0) { 724 unless (chmod(0755, $home_dir)) { 725 die("Can't set perms on $home_dir to 0755: $!"); 726 } 727 728 unless (chown($uid, $gid, $home_dir)) { 729 die("Can't set owner of $home_dir to $uid/$gid: $!"); 730 } 731 } 732 733 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 734 '/bin/bash'); 735 auth_group_write($auth_group_file, $group, $gid, $user); 736 737 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 738 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 739 740 my $config = { 741 PidFile => $pid_file, 742 ScoreboardFile => $scoreboard_file, 743 SystemLog => $log_file, 744 TraceLog => $log_file, 745 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 746 747 AuthUserFile => $auth_user_file, 748 AuthGroupFile => $auth_group_file, 749 750 IfModules => { 751 'mod_delay.c' => { 752 DelayEngine => 'off', 753 }, 754 755 'mod_rewrite.c' => [ 756 'RewriteEngine on', 757 "RewriteLog $log_file", 758 759 'RewriteMap replace int:replaceall', 760 'RewriteCondition %m ^(STAT|SETSTAT)$', 761 'RewriteRule ^(.*) "${replace:!$1! !_}"', 762 ], 763 764 'mod_sftp.c' => [ 765 "SFTPEngine on", 766 "SFTPLog $log_file", 767 "SFTPHostKey $rsa_host_key", 768 "SFTPHostKey $dsa_host_key", 769 ], 770 }, 771 }; 772 773 my ($port, $config_user, $config_group) = config_write($config_file, $config); 774 775 my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt"); 776 if (open(my $fh, "> $test_file")) { 777 print $fh "ABCD" x 1024; 778 unless (close($fh)) { 779 die("Can't write $test_file: $!"); 780 } 781 782 } else { 783 die("Can't open $test_file: $!"); 784 } 785 786 # Open pipes, for use between the parent and child processes. Specifically, 787 # the child will indicate when it's done with its test by writing a message 788 # to the parent. 789 my ($rfh, $wfh); 790 unless (pipe($rfh, $wfh)) { 791 die("Can't open pipe: $!"); 792 } 793 794 require Net::SSH2; 795 796 my $ex; 797 798 # Fork child 799 $self->handle_sigchld(); 800 defined(my $pid = fork()) or die("Can't fork: $!"); 801 if ($pid) { 802 eval { 803 my $ssh2 = Net::SSH2->new(); 804 805 sleep(1); 806 807 unless ($ssh2->connect('127.0.0.1', $port)) { 808 my ($err_code, $err_name, $err_str) = $ssh2->error(); 809 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 810 } 811 812 unless ($ssh2->auth_password($user, $passwd)) { 813 my ($err_code, $err_name, $err_str) = $ssh2->error(); 814 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 815 } 816 817 my $sftp = $ssh2->sftp(); 818 unless ($sftp) { 819 my ($err_code, $err_name, $err_str) = $ssh2->error(); 820 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 821 } 822 823 my $res = $sftp->setstat('test file.txt', 824 atime => 0, 825 mtime => 0, 826 ); 827 unless ($res) { 828 my ($err_code, $err_name) = $sftp->error(); 829 die("FXP_SETSTAT failed: [$err_name] ($err_code)"); 830 } 831 832 my $attrs = $sftp->stat('test file.txt'); 833 unless ($attrs) { 834 my ($err_code, $err_name) = $sftp->error(); 835 die("FXP_STAT failed: [$err_name] ($err_code)"); 836 } 837 838 $ssh2->disconnect(); 839 840 my $expected; 841 842 $expected = 0; 843 my $file_atime = $attrs->{atime}; 844 $self->assert($expected == $file_atime, 845 test_msg("Expected '$expected', got '$file_atime'")); 846 847 my $file_mtime = $attrs->{mtime}; 848 $self->assert($expected == $file_mtime, 849 test_msg("Expected '$expected', got '$file_mtime'")); 850 }; 851 852 if ($@) { 853 $ex = $@; 854 } 855 856 $wfh->print("done\n"); 857 $wfh->flush(); 858 859 } else { 860 eval { server_wait($config_file, $rfh) }; 861 if ($@) { 862 warn($@); 863 exit 1; 864 } 865 866 exit 0; 867 } 868 869 # Stop server 870 server_stop($pid_file); 871 872 $self->assert_child_ok($pid); 873 874 if ($ex) { 875 test_append_logfile($log_file, $ex); 876 unlink($log_file); 877 878 die($ex); 879 } 880 881 unlink($log_file); 882} 883 884sub sftp_rewrite_realpath { 885 my $self = shift; 886 my $tmpdir = $self->{tmpdir}; 887 888 my $config_file = "$tmpdir/sftp.conf"; 889 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 890 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 891 892 my $log_file = test_get_logfile(); 893 894 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 895 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 896 897 my $user = 'proftpd'; 898 my $passwd = 'test'; 899 my $group = 'ftpd'; 900 my $home_dir = File::Spec->rel2abs($tmpdir); 901 my $uid = 500; 902 my $gid = 500; 903 904 # Make sure that, if we're running as root, that the home directory has 905 # permissions/privs set for the account we create 906 if ($< == 0) { 907 unless (chmod(0755, $home_dir)) { 908 die("Can't set perms on $home_dir to 0755: $!"); 909 } 910 911 unless (chown($uid, $gid, $home_dir)) { 912 die("Can't set owner of $home_dir to $uid/$gid: $!"); 913 } 914 } 915 916 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 917 '/bin/bash'); 918 auth_group_write($auth_group_file, $group, $gid, $user); 919 920 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 921 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 922 923 my $config = { 924 PidFile => $pid_file, 925 ScoreboardFile => $scoreboard_file, 926 SystemLog => $log_file, 927 TraceLog => $log_file, 928 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 929 930 AuthUserFile => $auth_user_file, 931 AuthGroupFile => $auth_group_file, 932 933 IfModules => { 934 'mod_delay.c' => { 935 DelayEngine => 'off', 936 }, 937 938 'mod_rewrite.c' => [ 939 'RewriteEngine on', 940 "RewriteLog $log_file", 941 942 'RewriteMap replace int:replaceall', 943 'RewriteCondition %m REALPATH', 944 'RewriteRule ^(.*) "${replace:!$1! !_}"', 945 ], 946 947 'mod_sftp.c' => [ 948 "SFTPEngine on", 949 "SFTPLog $log_file", 950 "SFTPHostKey $rsa_host_key", 951 "SFTPHostKey $dsa_host_key", 952 ], 953 }, 954 }; 955 956 my ($port, $config_user, $config_group) = config_write($config_file, $config); 957 958 my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt"); 959 if (open(my $fh, "> $test_file")) { 960 unless (close($fh)) { 961 die("Can't write $test_file: $!"); 962 } 963 964 } else { 965 die("Can't open $test_file: $!"); 966 } 967 968 # Open pipes, for use between the parent and child processes. Specifically, 969 # the child will indicate when it's done with its test by writing a message 970 # to the parent. 971 my ($rfh, $wfh); 972 unless (pipe($rfh, $wfh)) { 973 die("Can't open pipe: $!"); 974 } 975 976 require Net::SSH2; 977 978 my $ex; 979 980 # Fork child 981 $self->handle_sigchld(); 982 defined(my $pid = fork()) or die("Can't fork: $!"); 983 if ($pid) { 984 eval { 985 my $ssh2 = Net::SSH2->new(); 986 987 sleep(1); 988 989 unless ($ssh2->connect('127.0.0.1', $port)) { 990 my ($err_code, $err_name, $err_str) = $ssh2->error(); 991 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 992 } 993 994 unless ($ssh2->auth_password($user, $passwd)) { 995 my ($err_code, $err_name, $err_str) = $ssh2->error(); 996 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 997 } 998 999 my $sftp = $ssh2->sftp(); 1000 unless ($sftp) { 1001 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1002 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 1003 } 1004 1005 my $resolved = $sftp->realpath('test file.txt'); 1006 unless ($resolved) { 1007 my ($err_code, $err_name) = $sftp->error(); 1008 die("FXP_REALPATH failed: [$err_name] ($err_code)"); 1009 } 1010 1011 my $expected; 1012 1013 $expected = $test_file; 1014 if ($^O eq 'darwin') { 1015 # Mac OSX hack 1016 $expected = '/private' . $expected; 1017 } 1018 1019 $self->assert($expected eq $resolved, 1020 test_msg("Expected '$expected', got '$resolved'")); 1021 1022 $ssh2->disconnect(); 1023 }; 1024 1025 if ($@) { 1026 $ex = $@; 1027 } 1028 1029 $wfh->print("done\n"); 1030 $wfh->flush(); 1031 1032 } else { 1033 eval { server_wait($config_file, $rfh) }; 1034 if ($@) { 1035 warn($@); 1036 exit 1; 1037 } 1038 1039 exit 0; 1040 } 1041 1042 # Stop server 1043 server_stop($pid_file); 1044 1045 $self->assert_child_ok($pid); 1046 1047 if ($ex) { 1048 test_append_logfile($log_file, $ex); 1049 unlink($log_file); 1050 1051 die($ex); 1052 } 1053 1054 unlink($log_file); 1055} 1056 1057sub sftp_rewrite_realpath_backslashes_bug4017 { 1058 my $self = shift; 1059 my $tmpdir = $self->{tmpdir}; 1060 1061 my $config_file = "$tmpdir/sftp.conf"; 1062 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 1063 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 1064 1065 my $log_file = test_get_logfile(); 1066 1067 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 1068 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 1069 1070 my $user = 'proftpd'; 1071 my $passwd = 'test'; 1072 my $group = 'ftpd'; 1073 my $home_dir = File::Spec->rel2abs($tmpdir); 1074 my $uid = 500; 1075 my $gid = 500; 1076 1077 # Make sure that, if we're running as root, that the home directory has 1078 # permissions/privs set for the account we create 1079 if ($< == 0) { 1080 unless (chmod(0755, $home_dir)) { 1081 die("Can't set perms on $home_dir to 0755: $!"); 1082 } 1083 1084 unless (chown($uid, $gid, $home_dir)) { 1085 die("Can't set owner of $home_dir to $uid/$gid: $!"); 1086 } 1087 } 1088 1089 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 1090 '/bin/bash'); 1091 auth_group_write($auth_group_file, $group, $gid, $user); 1092 1093 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 1094 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 1095 1096 my $config = { 1097 PidFile => $pid_file, 1098 ScoreboardFile => $scoreboard_file, 1099 SystemLog => $log_file, 1100 TraceLog => $log_file, 1101 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 1102 1103 AuthUserFile => $auth_user_file, 1104 AuthGroupFile => $auth_group_file, 1105 1106 IfModules => { 1107 'mod_delay.c' => { 1108 DelayEngine => 'off', 1109 }, 1110 1111 'mod_rewrite.c' => [ 1112 'RewriteEngine on', 1113 "RewriteLog $log_file", 1114 1115 'RewriteMap replace int:replaceall', 1116 'RewriteCondition %m REALPATH', 1117 'RewriteRule (.*) "${replace:!$1!\\\\!/}"', 1118 ], 1119 1120 'mod_sftp.c' => [ 1121 "SFTPEngine on", 1122 "SFTPLog $log_file", 1123 "SFTPHostKey $rsa_host_key", 1124 "SFTPHostKey $dsa_host_key", 1125 ], 1126 }, 1127 }; 1128 1129 my ($port, $config_user, $config_group) = config_write($config_file, $config); 1130 1131 my $test_file = File::Spec->rel2abs("$tmpdir/test.txt"); 1132 if (open(my $fh, "> $test_file")) { 1133 unless (close($fh)) { 1134 die("Can't write $test_file: $!"); 1135 } 1136 1137 } else { 1138 die("Can't open $test_file: $!"); 1139 } 1140 1141 # Open pipes, for use between the parent and child processes. Specifically, 1142 # the child will indicate when it's done with its test by writing a message 1143 # to the parent. 1144 my ($rfh, $wfh); 1145 unless (pipe($rfh, $wfh)) { 1146 die("Can't open pipe: $!"); 1147 } 1148 1149 require Net::SSH2; 1150 1151 my $ex; 1152 1153 # Fork child 1154 $self->handle_sigchld(); 1155 defined(my $pid = fork()) or die("Can't fork: $!"); 1156 if ($pid) { 1157 eval { 1158 my $ssh2 = Net::SSH2->new(); 1159 1160 sleep(1); 1161 1162 unless ($ssh2->connect('127.0.0.1', $port)) { 1163 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1164 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 1165 } 1166 1167 unless ($ssh2->auth_password($user, $passwd)) { 1168 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1169 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 1170 } 1171 1172 my $sftp = $ssh2->sftp(); 1173 unless ($sftp) { 1174 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1175 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 1176 } 1177 1178 my $munged = $test_file; 1179 $munged =~ s/\//\\/g; 1180 1181 my $resolved = $sftp->realpath($munged); 1182 unless ($resolved) { 1183 my ($err_code, $err_name) = $sftp->error(); 1184 die("FXP_REALPATH failed: [$err_name] ($err_code)"); 1185 } 1186 1187 my $expected; 1188 1189 $expected = $test_file; 1190 if ($^O eq 'darwin') { 1191 # Mac OSX hack 1192 $expected = '/private' . $expected; 1193 } 1194 1195 $self->assert($expected eq $resolved, 1196 test_msg("Expected '$expected', got '$resolved'")); 1197 1198 $ssh2->disconnect(); 1199 }; 1200 1201 if ($@) { 1202 $ex = $@; 1203 } 1204 1205 $wfh->print("done\n"); 1206 $wfh->flush(); 1207 1208 } else { 1209 eval { server_wait($config_file, $rfh) }; 1210 if ($@) { 1211 warn($@); 1212 exit 1; 1213 } 1214 1215 exit 0; 1216 } 1217 1218 # Stop server 1219 server_stop($pid_file); 1220 1221 $self->assert_child_ok($pid); 1222 1223 if ($ex) { 1224 test_append_logfile($log_file, $ex); 1225 unlink($log_file); 1226 1227 die($ex); 1228 } 1229 1230 unlink($log_file); 1231} 1232 1233sub sftp_rewrite_upload { 1234 my $self = shift; 1235 my $tmpdir = $self->{tmpdir}; 1236 1237 my $config_file = "$tmpdir/sftp.conf"; 1238 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 1239 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 1240 1241 my $log_file = test_get_logfile(); 1242 1243 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 1244 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 1245 1246 my $user = 'proftpd'; 1247 my $passwd = 'test'; 1248 my $group = 'ftpd'; 1249 my $home_dir = File::Spec->rel2abs($tmpdir); 1250 my $uid = 500; 1251 my $gid = 500; 1252 1253 # Make sure that, if we're running as root, that the home directory has 1254 # permissions/privs set for the account we create 1255 if ($< == 0) { 1256 unless (chmod(0755, $home_dir)) { 1257 die("Can't set perms on $home_dir to 0755: $!"); 1258 } 1259 1260 unless (chown($uid, $gid, $home_dir)) { 1261 die("Can't set owner of $home_dir to $uid/$gid: $!"); 1262 } 1263 } 1264 1265 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 1266 '/bin/bash'); 1267 auth_group_write($auth_group_file, $group, $gid, $user); 1268 1269 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 1270 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 1271 1272 my $config = { 1273 PidFile => $pid_file, 1274 ScoreboardFile => $scoreboard_file, 1275 SystemLog => $log_file, 1276 TraceLog => $log_file, 1277 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 1278 1279 AuthUserFile => $auth_user_file, 1280 AuthGroupFile => $auth_group_file, 1281 1282 IfModules => { 1283 'mod_delay.c' => { 1284 DelayEngine => 'off', 1285 }, 1286 1287 'mod_rewrite.c' => [ 1288 'RewriteEngine on', 1289 "RewriteLog $log_file", 1290 1291 'RewriteMap replace int:replaceall', 1292 'RewriteCondition %m STOR', 1293 'RewriteRule ^(.*) "${replace:!$1! !_}"', 1294 ], 1295 1296 'mod_sftp.c' => [ 1297 "SFTPEngine on", 1298 "SFTPLog $log_file", 1299 "SFTPHostKey $rsa_host_key", 1300 "SFTPHostKey $dsa_host_key", 1301 ], 1302 }, 1303 }; 1304 1305 my ($port, $config_user, $config_group) = config_write($config_file, $config); 1306 1307 my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt"); 1308 1309 # Open pipes, for use between the parent and child processes. Specifically, 1310 # the child will indicate when it's done with its test by writing a message 1311 # to the parent. 1312 my ($rfh, $wfh); 1313 unless (pipe($rfh, $wfh)) { 1314 die("Can't open pipe: $!"); 1315 } 1316 1317 require Net::SSH2; 1318 1319 my $ex; 1320 1321 # Ignore SIGPIPE 1322 local $SIG{PIPE} = sub { }; 1323 1324 # Fork child 1325 $self->handle_sigchld(); 1326 defined(my $pid = fork()) or die("Can't fork: $!"); 1327 if ($pid) { 1328 eval { 1329 my $ssh2 = Net::SSH2->new(); 1330 1331 sleep(1); 1332 1333 unless ($ssh2->connect('127.0.0.1', $port)) { 1334 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1335 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 1336 } 1337 1338 unless ($ssh2->auth_password($user, $passwd)) { 1339 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1340 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 1341 } 1342 1343 my $sftp = $ssh2->sftp(); 1344 unless ($sftp) { 1345 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1346 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 1347 } 1348 1349 my $fh = $sftp->open('test file.txt', O_WRONLY|O_CREAT|O_TRUNC, 0644); 1350 unless ($fh) { 1351 my ($err_code, $err_name) = $sftp->error(); 1352 die("FXP_OPEN failed: [$err_name] ($err_code)"); 1353 } 1354 1355 my $count = 20; 1356 for (my $i = 0; $i < $count; $i++) { 1357 print $fh "ABCD" x 8192; 1358 } 1359 1360 # To issue the FXP_CLOSE, we have to explicit destroy the filehandle 1361 $fh = undef; 1362 1363 $ssh2->disconnect(); 1364 1365 # Make sure that the rewritten file is present 1366 $self->assert(-f $test_file, test_msg("File $test_file unexpectedly missing")); 1367 }; 1368 1369 if ($@) { 1370 $ex = $@; 1371 } 1372 1373 $wfh->print("done\n"); 1374 $wfh->flush(); 1375 1376 } else { 1377 eval { server_wait($config_file, $rfh) }; 1378 if ($@) { 1379 warn($@); 1380 exit 1; 1381 } 1382 1383 exit 0; 1384 } 1385 1386 # Stop server 1387 server_stop($pid_file); 1388 1389 $self->assert_child_ok($pid); 1390 1391 if ($ex) { 1392 test_append_logfile($log_file, $ex); 1393 unlink($log_file); 1394 1395 die($ex); 1396 } 1397 1398 unlink($log_file); 1399} 1400 1401sub sftp_rewrite_download { 1402 my $self = shift; 1403 my $tmpdir = $self->{tmpdir}; 1404 1405 my $config_file = "$tmpdir/sftp.conf"; 1406 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 1407 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 1408 1409 my $log_file = test_get_logfile(); 1410 1411 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 1412 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 1413 1414 my $user = 'proftpd'; 1415 my $passwd = 'test'; 1416 my $group = 'ftpd'; 1417 my $home_dir = File::Spec->rel2abs($tmpdir); 1418 my $uid = 500; 1419 my $gid = 500; 1420 1421 my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt"); 1422 if (open(my $fh, "> $test_file")) { 1423 my $count = 20; 1424 for (my $i = 0; $i < $count; $i++) { 1425 print $fh "ABCD" x 8192; 1426 } 1427 1428 unless (close($fh)) { 1429 die("Can't write $test_file: $!"); 1430 } 1431 1432 } else { 1433 die("Can't open $test_file: $!"); 1434 } 1435 1436 my $test_sz = (stat($test_file))[7]; 1437 1438 # Make sure that, if we're running as root, that the home directory has 1439 # permissions/privs set for the account we create 1440 if ($< == 0) { 1441 unless (chmod(0755, $home_dir)) { 1442 die("Can't set perms on $home_dir to 0755: $!"); 1443 } 1444 1445 unless (chown($uid, $gid, $home_dir)) { 1446 die("Can't set owner of $home_dir to $uid/$gid: $!"); 1447 } 1448 } 1449 1450 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 1451 '/bin/bash'); 1452 auth_group_write($auth_group_file, $group, $gid, $user); 1453 1454 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 1455 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 1456 1457 my $config = { 1458 PidFile => $pid_file, 1459 ScoreboardFile => $scoreboard_file, 1460 SystemLog => $log_file, 1461 TraceLog => $log_file, 1462 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 1463 1464 AuthUserFile => $auth_user_file, 1465 AuthGroupFile => $auth_group_file, 1466 1467 IfModules => { 1468 'mod_delay.c' => { 1469 DelayEngine => 'off', 1470 }, 1471 1472 'mod_rewrite.c' => [ 1473 'RewriteEngine on', 1474 "RewriteLog $log_file", 1475 1476 'RewriteMap replace int:replaceall', 1477 'RewriteCondition %m RETR', 1478 'RewriteRule ^(.*) "${replace:!$1! !_}"', 1479 ], 1480 1481 'mod_sftp.c' => [ 1482 "SFTPEngine on", 1483 "SFTPLog $log_file", 1484 "SFTPHostKey $rsa_host_key", 1485 "SFTPHostKey $dsa_host_key", 1486 ], 1487 }, 1488 }; 1489 1490 my ($port, $config_user, $config_group) = config_write($config_file, $config); 1491 1492 # Open pipes, for use between the parent and child processes. Specifically, 1493 # the child will indicate when it's done with its test by writing a message 1494 # to the parent. 1495 my ($rfh, $wfh); 1496 unless (pipe($rfh, $wfh)) { 1497 die("Can't open pipe: $!"); 1498 } 1499 1500 require Net::SSH2; 1501 1502 my $ex; 1503 1504 # Ignore SIGPIPE 1505 local $SIG{PIPE} = sub { }; 1506 1507 # Fork child 1508 $self->handle_sigchld(); 1509 defined(my $pid = fork()) or die("Can't fork: $!"); 1510 if ($pid) { 1511 eval { 1512 my $ssh2 = Net::SSH2->new(); 1513 1514 sleep(1); 1515 1516 unless ($ssh2->connect('127.0.0.1', $port)) { 1517 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1518 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 1519 } 1520 1521 unless ($ssh2->auth_password($user, $passwd)) { 1522 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1523 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 1524 } 1525 1526 my $sftp = $ssh2->sftp(); 1527 unless ($sftp) { 1528 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1529 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 1530 } 1531 1532 my $fh = $sftp->open('test file.txt', O_RDONLY); 1533 unless ($fh) { 1534 my ($err_code, $err_name) = $sftp->error(); 1535 die("FXP_OPEN failed: [$err_name] ($err_code)"); 1536 } 1537 1538 my $buf; 1539 my $size = 0; 1540 1541 my $res = $fh->read($buf, 8192); 1542 while ($res) { 1543 $size += $res; 1544 1545 $res = $fh->read($buf, 8192); 1546 } 1547 1548 # To issue the FXP_CLOSE, we have to explicit destroy the filehandle 1549 $fh = undef; 1550 1551 $self->assert($test_sz == $size, 1552 test_msg("Expected $test_sz, got $size")); 1553 1554 $ssh2->disconnect(); 1555 }; 1556 1557 if ($@) { 1558 $ex = $@; 1559 } 1560 1561 $wfh->print("done\n"); 1562 $wfh->flush(); 1563 1564 } else { 1565 eval { server_wait($config_file, $rfh) }; 1566 if ($@) { 1567 warn($@); 1568 exit 1; 1569 } 1570 1571 exit 0; 1572 } 1573 1574 # Stop server 1575 server_stop($pid_file); 1576 1577 $self->assert_child_ok($pid); 1578 1579 if ($ex) { 1580 test_append_logfile($log_file, $ex); 1581 unlink($log_file); 1582 1583 die($ex); 1584 } 1585 1586 unlink($log_file); 1587} 1588 1589sub sftp_rewrite_readdir { 1590 my $self = shift; 1591 my $tmpdir = $self->{tmpdir}; 1592 1593 my $config_file = "$tmpdir/sftp.conf"; 1594 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 1595 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 1596 1597 my $log_file = test_get_logfile(); 1598 1599 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 1600 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 1601 1602 my $user = 'proftpd'; 1603 my $passwd = 'test'; 1604 my $group = 'ftpd'; 1605 my $home_dir = File::Spec->rel2abs($tmpdir); 1606 my $uid = 500; 1607 my $gid = 500; 1608 1609 my $sub_dir = File::Spec->rel2abs("$tmpdir/sub_dir"); 1610 mkpath($sub_dir); 1611 1612 my $test_file = File::Spec->rel2abs("$sub_dir/subfile.txt"); 1613 if (open(my $fh, "> $test_file")) { 1614 close($fh); 1615 1616 } else { 1617 die("Can't open $test_file: $!"); 1618 } 1619 1620 # Make sure that, if we're running as root, that the home directory has 1621 # permissions/privs set for the account we create 1622 if ($< == 0) { 1623 unless (chmod(0755, $home_dir)) { 1624 die("Can't set perms on $home_dir to 0755: $!"); 1625 } 1626 1627 unless (chown($uid, $gid, $home_dir)) { 1628 die("Can't set owner of $home_dir to $uid/$gid: $!"); 1629 } 1630 } 1631 1632 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 1633 '/bin/bash'); 1634 auth_group_write($auth_group_file, $group, $gid, $user); 1635 1636 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 1637 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 1638 1639 my $config = { 1640 PidFile => $pid_file, 1641 ScoreboardFile => $scoreboard_file, 1642 SystemLog => $log_file, 1643 TraceLog => $log_file, 1644 Trace => 'auth:10 ssh2:20 sftp:20 scp:20', 1645 1646 AuthUserFile => $auth_user_file, 1647 AuthGroupFile => $auth_group_file, 1648 1649 IfModules => { 1650 'mod_delay.c' => { 1651 DelayEngine => 'off', 1652 }, 1653 1654 'mod_rewrite.c' => [ 1655 'RewriteEngine on', 1656 "RewriteLog $log_file", 1657 1658 'RewriteMap replace int:replaceall', 1659 'RewriteCondition %m OPENDIR', 1660 'RewriteRule ^(.*) "${replace:!$1! !_}"', 1661 ], 1662 1663 'mod_sftp.c' => [ 1664 "SFTPEngine on", 1665 "SFTPLog $log_file", 1666 "SFTPHostKey $rsa_host_key", 1667 "SFTPHostKey $dsa_host_key", 1668 ], 1669 }, 1670 }; 1671 1672 my ($port, $config_user, $config_group) = config_write($config_file, $config); 1673 1674 # Open pipes, for use between the parent and child processes. Specifically, 1675 # the child will indicate when it's done with its test by writing a message 1676 # to the parent. 1677 my ($rfh, $wfh); 1678 unless (pipe($rfh, $wfh)) { 1679 die("Can't open pipe: $!"); 1680 } 1681 1682 require Net::SSH2; 1683 1684 my $ex; 1685 1686 # Fork child 1687 $self->handle_sigchld(); 1688 defined(my $pid = fork()) or die("Can't fork: $!"); 1689 if ($pid) { 1690 eval { 1691 my $ssh2 = Net::SSH2->new(); 1692 1693 sleep(1); 1694 1695 unless ($ssh2->connect('127.0.0.1', $port)) { 1696 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1697 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 1698 } 1699 1700 unless ($ssh2->auth_password($user, $passwd)) { 1701 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1702 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 1703 } 1704 1705 my $sftp = $ssh2->sftp(); 1706 unless ($sftp) { 1707 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1708 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 1709 } 1710 1711 my $dir = $sftp->opendir('sub dir'); 1712 unless ($dir) { 1713 my ($err_code, $err_name) = $sftp->error(); 1714 die("FXP_OPENDIR failed: [$err_name] ($err_code)"); 1715 } 1716 1717 my $res = {}; 1718 1719 my $file = $dir->read(); 1720 while ($file) { 1721 $res->{$file->{name}} = $file; 1722 $file = $dir->read(); 1723 } 1724 1725 my $expected = { 1726 '.' => 1, 1727 '..' => 1, 1728 'subfile.txt' => 1, 1729 }; 1730 1731 # To issue the FXP_CLOSE, we have to explicit destroy the dirhandle 1732 $dir = undef; 1733 1734 $ssh2->disconnect(); 1735 1736 my $ok = 1; 1737 my $mismatch; 1738 1739 my $seen = []; 1740 foreach my $name (keys(%$res)) { 1741 push(@$seen, $name); 1742 1743 unless (defined($expected->{$name})) { 1744 $mismatch = $name; 1745 $ok = 0; 1746 last; 1747 } 1748 } 1749 1750 unless ($ok) { 1751 die("Unexpected name '$mismatch' appeared in READDIR data") 1752 } 1753 1754 # Now remove from $expected all of the paths we saw; if there are 1755 # any entries remaining in $expected, something went wrong. 1756 foreach my $name (@$seen) { 1757 delete($expected->{$name}); 1758 } 1759 1760 my $remaining = scalar(keys(%$expected)); 1761 $self->assert(0 == $remaining, 1762 test_msg("Expected 0, got $remaining")); 1763 }; 1764 1765 if ($@) { 1766 $ex = $@; 1767 } 1768 1769 $wfh->print("done\n"); 1770 $wfh->flush(); 1771 1772 } else { 1773 eval { server_wait($config_file, $rfh) }; 1774 if ($@) { 1775 warn($@); 1776 exit 1; 1777 } 1778 1779 exit 0; 1780 } 1781 1782 # Stop server 1783 server_stop($pid_file); 1784 1785 $self->assert_child_ok($pid); 1786 1787 if ($ex) { 1788 test_append_logfile($log_file, $ex); 1789 unlink($log_file); 1790 1791 die($ex); 1792 } 1793 1794 unlink($log_file); 1795} 1796 1797sub sftp_rewrite_mkdir { 1798 my $self = shift; 1799 my $tmpdir = $self->{tmpdir}; 1800 1801 my $config_file = "$tmpdir/sftp.conf"; 1802 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 1803 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 1804 1805 my $log_file = test_get_logfile(); 1806 1807 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 1808 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 1809 1810 my $user = 'proftpd'; 1811 my $passwd = 'test'; 1812 my $group = 'ftpd'; 1813 my $home_dir = File::Spec->rel2abs($tmpdir); 1814 my $uid = 500; 1815 my $gid = 500; 1816 1817 my $test_dir = File::Spec->rel2abs("$tmpdir/test_dir"); 1818 1819 # Make sure that, if we're running as root, that the home directory has 1820 # permissions/privs set for the account we create 1821 if ($< == 0) { 1822 unless (chmod(0755, $home_dir)) { 1823 die("Can't set perms on $home_dir to 0755: $!"); 1824 } 1825 1826 unless (chown($uid, $gid, $home_dir)) { 1827 die("Can't set owner of $home_dir to $uid/$gid: $!"); 1828 } 1829 } 1830 1831 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 1832 '/bin/bash'); 1833 auth_group_write($auth_group_file, $group, $gid, $user); 1834 1835 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 1836 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 1837 1838 my $config = { 1839 PidFile => $pid_file, 1840 ScoreboardFile => $scoreboard_file, 1841 SystemLog => $log_file, 1842 TraceLog => $log_file, 1843 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 1844 1845 AuthUserFile => $auth_user_file, 1846 AuthGroupFile => $auth_group_file, 1847 1848 IfModules => { 1849 'mod_delay.c' => { 1850 DelayEngine => 'off', 1851 }, 1852 1853 'mod_rewrite.c' => [ 1854 'RewriteEngine on', 1855 "RewriteLog $log_file", 1856 1857 'RewriteMap replace int:replaceall', 1858 'RewriteCondition %m MKDIR', 1859 'RewriteRule ^(.*) "${replace:!$1! !_}"', 1860 ], 1861 1862 'mod_sftp.c' => [ 1863 "SFTPEngine on", 1864 "SFTPLog $log_file", 1865 "SFTPHostKey $rsa_host_key", 1866 "SFTPHostKey $dsa_host_key", 1867 ], 1868 }, 1869 }; 1870 1871 my ($port, $config_user, $config_group) = config_write($config_file, $config); 1872 1873 # Open pipes, for use between the parent and child processes. Specifically, 1874 # the child will indicate when it's done with its test by writing a message 1875 # to the parent. 1876 my ($rfh, $wfh); 1877 unless (pipe($rfh, $wfh)) { 1878 die("Can't open pipe: $!"); 1879 } 1880 1881 require Net::SSH2; 1882 1883 my $ex; 1884 1885 # Fork child 1886 $self->handle_sigchld(); 1887 defined(my $pid = fork()) or die("Can't fork: $!"); 1888 if ($pid) { 1889 eval { 1890 my $ssh2 = Net::SSH2->new(); 1891 1892 sleep(1); 1893 1894 unless ($ssh2->connect('127.0.0.1', $port)) { 1895 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1896 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 1897 } 1898 1899 unless ($ssh2->auth_password($user, $passwd)) { 1900 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1901 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 1902 } 1903 1904 my $sftp = $ssh2->sftp(); 1905 unless ($sftp) { 1906 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1907 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 1908 } 1909 1910 my $res = $sftp->mkdir('test dir'); 1911 unless ($res) { 1912 my ($err_code, $err_name) = $sftp->error(); 1913 die("FXP_MKDIR failed: [$err_name] ($err_code)"); 1914 } 1915 1916 $ssh2->disconnect(); 1917 1918 unless (-d $test_dir) { 1919 die("$test_dir directory does not exist as expected"); 1920 } 1921 }; 1922 1923 if ($@) { 1924 $ex = $@; 1925 } 1926 1927 $wfh->print("done\n"); 1928 $wfh->flush(); 1929 1930 } else { 1931 eval { server_wait($config_file, $rfh) }; 1932 if ($@) { 1933 warn($@); 1934 exit 1; 1935 } 1936 1937 exit 0; 1938 } 1939 1940 # Stop server 1941 server_stop($pid_file); 1942 1943 $self->assert_child_ok($pid); 1944 1945 if ($ex) { 1946 test_append_logfile($log_file, $ex); 1947 unlink($log_file); 1948 1949 die($ex); 1950 } 1951 1952 unlink($log_file); 1953} 1954 1955sub sftp_rewrite_rmdir { 1956 my $self = shift; 1957 my $tmpdir = $self->{tmpdir}; 1958 1959 my $config_file = "$tmpdir/sftp.conf"; 1960 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 1961 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 1962 1963 my $log_file = test_get_logfile(); 1964 1965 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 1966 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 1967 1968 my $user = 'proftpd'; 1969 my $passwd = 'test'; 1970 my $group = 'ftpd'; 1971 my $home_dir = File::Spec->rel2abs($tmpdir); 1972 my $uid = 500; 1973 my $gid = 500; 1974 1975 my $test_dir = File::Spec->rel2abs("$tmpdir/test_dir"); 1976 mkpath($test_dir); 1977 1978 # Make sure that, if we're running as root, that the home directory has 1979 # permissions/privs set for the account we create 1980 if ($< == 0) { 1981 unless (chmod(0755, $home_dir)) { 1982 die("Can't set perms on $home_dir to 0755: $!"); 1983 } 1984 1985 unless (chown($uid, $gid, $home_dir)) { 1986 die("Can't set owner of $home_dir to $uid/$gid: $!"); 1987 } 1988 } 1989 1990 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 1991 '/bin/bash'); 1992 auth_group_write($auth_group_file, $group, $gid, $user); 1993 1994 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 1995 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 1996 1997 my $config = { 1998 PidFile => $pid_file, 1999 ScoreboardFile => $scoreboard_file, 2000 SystemLog => $log_file, 2001 TraceLog => $log_file, 2002 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 2003 2004 AuthUserFile => $auth_user_file, 2005 AuthGroupFile => $auth_group_file, 2006 2007 IfModules => { 2008 'mod_delay.c' => { 2009 DelayEngine => 'off', 2010 }, 2011 2012 'mod_rewrite.c' => [ 2013 'RewriteEngine on', 2014 "RewriteLog $log_file", 2015 2016 'RewriteMap replace int:replaceall', 2017 'RewriteCondition %m RMDIR', 2018 'RewriteRule ^(.*) "${replace:!$1! !_}"', 2019 ], 2020 2021 'mod_sftp.c' => [ 2022 "SFTPEngine on", 2023 "SFTPLog $log_file", 2024 "SFTPHostKey $rsa_host_key", 2025 "SFTPHostKey $dsa_host_key", 2026 ], 2027 }, 2028 }; 2029 2030 my ($port, $config_user, $config_group) = config_write($config_file, $config); 2031 2032 # Open pipes, for use between the parent and child processes. Specifically, 2033 # the child will indicate when it's done with its test by writing a message 2034 # to the parent. 2035 my ($rfh, $wfh); 2036 unless (pipe($rfh, $wfh)) { 2037 die("Can't open pipe: $!"); 2038 } 2039 2040 require Net::SSH2; 2041 2042 my $ex; 2043 2044 # Fork child 2045 $self->handle_sigchld(); 2046 defined(my $pid = fork()) or die("Can't fork: $!"); 2047 if ($pid) { 2048 eval { 2049 my $ssh2 = Net::SSH2->new(); 2050 2051 sleep(1); 2052 2053 unless ($ssh2->connect('127.0.0.1', $port)) { 2054 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2055 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 2056 } 2057 2058 unless ($ssh2->auth_password($user, $passwd)) { 2059 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2060 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 2061 } 2062 2063 my $sftp = $ssh2->sftp(); 2064 unless ($sftp) { 2065 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2066 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 2067 } 2068 2069 my $res = $sftp->rmdir('test dir'); 2070 unless ($res) { 2071 my ($err_code, $err_name) = $sftp->error(); 2072 die("FXP_RMDIR failed: [$err_name] ($err_code)"); 2073 } 2074 2075 $ssh2->disconnect(); 2076 2077 if (-d $test_dir) { 2078 die("$test_dir directory exists unexpectedly"); 2079 } 2080 }; 2081 2082 if ($@) { 2083 $ex = $@; 2084 } 2085 2086 $wfh->print("done\n"); 2087 $wfh->flush(); 2088 2089 } else { 2090 eval { server_wait($config_file, $rfh) }; 2091 if ($@) { 2092 warn($@); 2093 exit 1; 2094 } 2095 2096 exit 0; 2097 } 2098 2099 # Stop server 2100 server_stop($pid_file); 2101 2102 $self->assert_child_ok($pid); 2103 2104 if ($ex) { 2105 test_append_logfile($log_file, $ex); 2106 unlink($log_file); 2107 2108 die($ex); 2109 } 2110 2111 unlink($log_file); 2112} 2113 2114sub sftp_rewrite_remove { 2115 my $self = shift; 2116 my $tmpdir = $self->{tmpdir}; 2117 2118 my $config_file = "$tmpdir/sftp.conf"; 2119 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 2120 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 2121 2122 my $log_file = test_get_logfile(); 2123 2124 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 2125 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 2126 2127 my $user = 'proftpd'; 2128 my $passwd = 'test'; 2129 my $group = 'ftpd'; 2130 my $home_dir = File::Spec->rel2abs($tmpdir); 2131 my $uid = 500; 2132 my $gid = 500; 2133 2134 my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt"); 2135 if (open(my $fh, "> $test_file")) { 2136 print $fh "ABCD" x 8192; 2137 2138 unless (close($fh)) { 2139 die("Can't write $test_file: $!"); 2140 } 2141 2142 } else { 2143 die("Can't open $test_file: $!"); 2144 } 2145 2146 # Make sure that, if we're running as root, that the home directory has 2147 # permissions/privs set for the account we create 2148 if ($< == 0) { 2149 unless (chmod(0755, $home_dir)) { 2150 die("Can't set perms on $home_dir to 0755: $!"); 2151 } 2152 2153 unless (chown($uid, $gid, $home_dir)) { 2154 die("Can't set owner of $home_dir to $uid/$gid: $!"); 2155 } 2156 } 2157 2158 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 2159 '/bin/bash'); 2160 auth_group_write($auth_group_file, $group, $gid, $user); 2161 2162 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 2163 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 2164 2165 my $config = { 2166 PidFile => $pid_file, 2167 ScoreboardFile => $scoreboard_file, 2168 SystemLog => $log_file, 2169 TraceLog => $log_file, 2170 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 2171 2172 AuthUserFile => $auth_user_file, 2173 AuthGroupFile => $auth_group_file, 2174 2175 IfModules => { 2176 'mod_delay.c' => { 2177 DelayEngine => 'off', 2178 }, 2179 2180 'mod_rewrite.c' => [ 2181 'RewriteEngine on', 2182 "RewriteLog $log_file", 2183 2184 'RewriteMap replace int:replaceall', 2185 'RewriteCondition %m REMOVE', 2186 'RewriteRule ^(.*) "${replace:!$1! !_}"', 2187 ], 2188 2189 'mod_sftp.c' => [ 2190 "SFTPEngine on", 2191 "SFTPLog $log_file", 2192 "SFTPHostKey $rsa_host_key", 2193 "SFTPHostKey $dsa_host_key", 2194 ], 2195 }, 2196 }; 2197 2198 my ($port, $config_user, $config_group) = config_write($config_file, $config); 2199 2200 # Open pipes, for use between the parent and child processes. Specifically, 2201 # the child will indicate when it's done with its test by writing a message 2202 # to the parent. 2203 my ($rfh, $wfh); 2204 unless (pipe($rfh, $wfh)) { 2205 die("Can't open pipe: $!"); 2206 } 2207 2208 require Net::SSH2; 2209 2210 my $ex; 2211 2212 # Fork child 2213 $self->handle_sigchld(); 2214 defined(my $pid = fork()) or die("Can't fork: $!"); 2215 if ($pid) { 2216 eval { 2217 my $ssh2 = Net::SSH2->new(); 2218 2219 sleep(1); 2220 2221 unless ($ssh2->connect('127.0.0.1', $port)) { 2222 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2223 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 2224 } 2225 2226 unless ($ssh2->auth_password($user, $passwd)) { 2227 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2228 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 2229 } 2230 2231 my $sftp = $ssh2->sftp(); 2232 unless ($sftp) { 2233 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2234 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 2235 } 2236 2237 my $res = $sftp->unlink('test file.txt'); 2238 unless ($res) { 2239 my ($err_code, $err_name) = $sftp->error(); 2240 die("FXP_REMOVE failed: [$err_name] ($err_code)"); 2241 } 2242 2243 $ssh2->disconnect(); 2244 2245 if (-f $test_file) { 2246 die("$test_file file exists unexpectedly"); 2247 } 2248 }; 2249 2250 if ($@) { 2251 $ex = $@; 2252 } 2253 2254 $wfh->print("done\n"); 2255 $wfh->flush(); 2256 2257 } else { 2258 eval { server_wait($config_file, $rfh) }; 2259 if ($@) { 2260 warn($@); 2261 exit 1; 2262 } 2263 2264 exit 0; 2265 } 2266 2267 # Stop server 2268 server_stop($pid_file); 2269 2270 $self->assert_child_ok($pid); 2271 2272 if ($ex) { 2273 test_append_logfile($log_file, $ex); 2274 unlink($log_file); 2275 2276 die($ex); 2277 } 2278 2279 unlink($log_file); 2280} 2281 2282sub sftp_rewrite_rename { 2283 my $self = shift; 2284 my $tmpdir = $self->{tmpdir}; 2285 2286 my $config_file = "$tmpdir/sftp.conf"; 2287 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 2288 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 2289 2290 my $log_file = test_get_logfile(); 2291 2292 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 2293 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 2294 2295 my $user = 'proftpd'; 2296 my $passwd = 'test'; 2297 my $group = 'ftpd'; 2298 my $home_dir = File::Spec->rel2abs($tmpdir); 2299 my $uid = 500; 2300 my $gid = 500; 2301 2302 my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt"); 2303 if (open(my $fh, "> $test_file")) { 2304 print $fh "ABCD" x 8192; 2305 2306 unless (close($fh)) { 2307 die("Can't write $test_file: $!"); 2308 } 2309 2310 } else { 2311 die("Can't open $test_file: $!"); 2312 } 2313 2314 my $test_file2 = File::Spec->rel2abs("$tmpdir/test_file2.txt"); 2315 2316 # Make sure that, if we're running as root, that the home directory has 2317 # permissions/privs set for the account we create 2318 if ($< == 0) { 2319 unless (chmod(0755, $home_dir)) { 2320 die("Can't set perms on $home_dir to 0755: $!"); 2321 } 2322 2323 unless (chown($uid, $gid, $home_dir)) { 2324 die("Can't set owner of $home_dir to $uid/$gid: $!"); 2325 } 2326 } 2327 2328 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 2329 '/bin/bash'); 2330 auth_group_write($auth_group_file, $group, $gid, $user); 2331 2332 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 2333 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 2334 2335 my $config = { 2336 PidFile => $pid_file, 2337 ScoreboardFile => $scoreboard_file, 2338 SystemLog => $log_file, 2339 TraceLog => $log_file, 2340 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 2341 2342 AuthUserFile => $auth_user_file, 2343 AuthGroupFile => $auth_group_file, 2344 2345 IfModules => { 2346 'mod_delay.c' => { 2347 DelayEngine => 'off', 2348 }, 2349 2350 'mod_rewrite.c' => [ 2351 'RewriteEngine on', 2352 "RewriteLog $log_file", 2353 2354 'RewriteMap replace int:replaceall', 2355 'RewriteCondition %m ^(RNFR|RNTO)$', 2356 'RewriteRule ^(.*)$ "${replace:!$1! !_}"', 2357 ], 2358 2359 'mod_sftp.c' => [ 2360 "SFTPEngine on", 2361 "SFTPLog $log_file", 2362 "SFTPHostKey $rsa_host_key", 2363 "SFTPHostKey $dsa_host_key", 2364 ], 2365 }, 2366 }; 2367 2368 my ($port, $config_user, $config_group) = config_write($config_file, $config); 2369 2370 # Open pipes, for use between the parent and child processes. Specifically, 2371 # the child will indicate when it's done with its test by writing a message 2372 # to the parent. 2373 my ($rfh, $wfh); 2374 unless (pipe($rfh, $wfh)) { 2375 die("Can't open pipe: $!"); 2376 } 2377 2378 require Net::SSH2; 2379 2380 my $ex; 2381 2382 # Fork child 2383 $self->handle_sigchld(); 2384 defined(my $pid = fork()) or die("Can't fork: $!"); 2385 if ($pid) { 2386 eval { 2387 my $ssh2 = Net::SSH2->new(); 2388 2389 sleep(1); 2390 2391 unless ($ssh2->connect('127.0.0.1', $port)) { 2392 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2393 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 2394 } 2395 2396 unless ($ssh2->auth_password($user, $passwd)) { 2397 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2398 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 2399 } 2400 2401 my $sftp = $ssh2->sftp(); 2402 unless ($sftp) { 2403 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2404 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 2405 } 2406 2407 my $res = $sftp->rename('test file.txt', 'test file2.txt'); 2408 unless ($res) { 2409 my ($err_code, $err_name) = $sftp->error(); 2410 die("FXP_RENAME failed: [$err_name] ($err_code)"); 2411 } 2412 2413 $ssh2->disconnect(); 2414 2415 if (-f $test_file) { 2416 die("$test_file file exists unexpectedly"); 2417 } 2418 2419 unless (-f $test_file2) { 2420 die("$test_file2 file does not exist as expected"); 2421 } 2422 }; 2423 2424 if ($@) { 2425 $ex = $@; 2426 } 2427 2428 $wfh->print("done\n"); 2429 $wfh->flush(); 2430 2431 } else { 2432 eval { server_wait($config_file, $rfh) }; 2433 if ($@) { 2434 warn($@); 2435 exit 1; 2436 } 2437 2438 exit 0; 2439 } 2440 2441 # Stop server 2442 server_stop($pid_file); 2443 2444 $self->assert_child_ok($pid); 2445 2446 if ($ex) { 2447 test_append_logfile($log_file, $ex); 2448 unlink($log_file); 2449 2450 die($ex); 2451 } 2452 2453 unlink($log_file); 2454} 2455 2456sub sftp_rewrite_rename_file_var_w_bug3643 { 2457 my $self = shift; 2458 my $tmpdir = $self->{tmpdir}; 2459 2460 my $config_file = "$tmpdir/sftp.conf"; 2461 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 2462 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 2463 2464 my $log_file = test_get_logfile(); 2465 2466 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 2467 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 2468 2469 my $user = 'proftpd'; 2470 my $passwd = 'test'; 2471 my $group = 'ftpd'; 2472 my $home_dir = File::Spec->rel2abs($tmpdir); 2473 my $uid = 500; 2474 my $gid = 500; 2475 2476 my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt"); 2477 if (open(my $fh, "> $test_file")) { 2478 print $fh "ABCD" x 8192; 2479 2480 unless (close($fh)) { 2481 die("Can't write $test_file: $!"); 2482 } 2483 2484 } else { 2485 die("Can't open $test_file: $!"); 2486 } 2487 2488 my $test_file2 = File::Spec->rel2abs("$tmpdir/test_file2.txt"); 2489 2490 # Make sure that, if we're running as root, that the home directory has 2491 # permissions/privs set for the account we create 2492 if ($< == 0) { 2493 unless (chmod(0755, $home_dir)) { 2494 die("Can't set perms on $home_dir to 0755: $!"); 2495 } 2496 2497 unless (chown($uid, $gid, $home_dir)) { 2498 die("Can't set owner of $home_dir to $uid/$gid: $!"); 2499 } 2500 } 2501 2502 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 2503 '/bin/bash'); 2504 auth_group_write($auth_group_file, $group, $gid, $user); 2505 2506 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 2507 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 2508 2509 my $config = { 2510 PidFile => $pid_file, 2511 ScoreboardFile => $scoreboard_file, 2512 SystemLog => $log_file, 2513 TraceLog => $log_file, 2514 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 2515 2516 AuthUserFile => $auth_user_file, 2517 AuthGroupFile => $auth_group_file, 2518 2519 IfModules => { 2520 'mod_delay.c' => { 2521 DelayEngine => 'off', 2522 }, 2523 2524 'mod_rewrite.c' => [ 2525 'RewriteEngine on', 2526 "RewriteLog $log_file", 2527 2528 'RewriteMap lowercase int:tolower', 2529 'RewriteCondition %m ^RNTO$', 2530 'RewriteCondition %w -f', 2531 'RewriteRule ^(.*) ${lowercase:$0}', 2532 ], 2533 2534 'mod_sftp.c' => [ 2535 "SFTPEngine on", 2536 "SFTPLog $log_file", 2537 "SFTPHostKey $rsa_host_key", 2538 "SFTPHostKey $dsa_host_key", 2539 ], 2540 }, 2541 }; 2542 2543 my ($port, $config_user, $config_group) = config_write($config_file, $config); 2544 2545 # Open pipes, for use between the parent and child processes. Specifically, 2546 # the child will indicate when it's done with its test by writing a message 2547 # to the parent. 2548 my ($rfh, $wfh); 2549 unless (pipe($rfh, $wfh)) { 2550 die("Can't open pipe: $!"); 2551 } 2552 2553 require Net::SSH2; 2554 2555 my $ex; 2556 2557 # Fork child 2558 $self->handle_sigchld(); 2559 defined(my $pid = fork()) or die("Can't fork: $!"); 2560 if ($pid) { 2561 eval { 2562 my $ssh2 = Net::SSH2->new(); 2563 2564 sleep(1); 2565 2566 unless ($ssh2->connect('127.0.0.1', $port)) { 2567 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2568 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 2569 } 2570 2571 unless ($ssh2->auth_password($user, $passwd)) { 2572 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2573 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 2574 } 2575 2576 my $sftp = $ssh2->sftp(); 2577 unless ($sftp) { 2578 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2579 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 2580 } 2581 2582 my $res = $sftp->rename('test_file.txt', 'TeST_FiLe2.TxT'); 2583 unless ($res) { 2584 my ($err_code, $err_name) = $sftp->error(); 2585 die("FXP_RENAME failed: [$err_name] ($err_code)"); 2586 } 2587 2588 $ssh2->disconnect(); 2589 2590 if (-f $test_file) { 2591 die("$test_file file exists unexpectedly"); 2592 } 2593 2594 unless (-f $test_file2) { 2595 die("$test_file2 file does not exist as expected"); 2596 } 2597 }; 2598 2599 if ($@) { 2600 $ex = $@; 2601 } 2602 2603 $wfh->print("done\n"); 2604 $wfh->flush(); 2605 2606 } else { 2607 eval { server_wait($config_file, $rfh) }; 2608 if ($@) { 2609 warn($@); 2610 exit 1; 2611 } 2612 2613 exit 0; 2614 } 2615 2616 # Stop server 2617 server_stop($pid_file); 2618 2619 $self->assert_child_ok($pid); 2620 2621 if ($ex) { 2622 test_append_logfile($log_file, $ex); 2623 unlink($log_file); 2624 2625 die($ex); 2626 } 2627 2628 unlink($log_file); 2629} 2630 2631sub sftp_rewrite_rename_dir_var_w_bug3643 { 2632 my $self = shift; 2633 my $tmpdir = $self->{tmpdir}; 2634 2635 my $config_file = "$tmpdir/sftp.conf"; 2636 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 2637 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 2638 2639 my $log_file = test_get_logfile(); 2640 2641 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 2642 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 2643 2644 my $user = 'proftpd'; 2645 my $passwd = 'test'; 2646 my $group = 'ftpd'; 2647 my $home_dir = File::Spec->rel2abs($tmpdir); 2648 my $uid = 500; 2649 my $gid = 500; 2650 2651 my $src_dir = File::Spec->rel2abs("$tmpdir/foo.d"); 2652 mkpath($src_dir); 2653 2654 my $dst_dir = File::Spec->rel2abs("$tmpdir/bar.d"); 2655 2656 # Make sure that, if we're running as root, that the home directory has 2657 # permissions/privs set for the account we create 2658 if ($< == 0) { 2659 unless (chmod(0755, $home_dir)) { 2660 die("Can't set perms on $home_dir to 0755: $!"); 2661 } 2662 2663 unless (chown($uid, $gid, $home_dir)) { 2664 die("Can't set owner of $home_dir to $uid/$gid: $!"); 2665 } 2666 } 2667 2668 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 2669 '/bin/bash'); 2670 auth_group_write($auth_group_file, $group, $gid, $user); 2671 2672 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 2673 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 2674 2675 my $config = { 2676 PidFile => $pid_file, 2677 ScoreboardFile => $scoreboard_file, 2678 SystemLog => $log_file, 2679 TraceLog => $log_file, 2680 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 2681 2682 AuthUserFile => $auth_user_file, 2683 AuthGroupFile => $auth_group_file, 2684 2685 IfModules => { 2686 'mod_delay.c' => { 2687 DelayEngine => 'off', 2688 }, 2689 2690 'mod_rewrite.c' => [ 2691 'RewriteEngine on', 2692 "RewriteLog $log_file", 2693 2694 'RewriteMap lowercase int:tolower', 2695 'RewriteCondition %m ^RNTO$', 2696 'RewriteCondition %w -d', 2697 'RewriteRule ^(.*) ${lowercase:$0}', 2698 ], 2699 2700 'mod_sftp.c' => [ 2701 "SFTPEngine on", 2702 "SFTPLog $log_file", 2703 "SFTPHostKey $rsa_host_key", 2704 "SFTPHostKey $dsa_host_key", 2705 ], 2706 }, 2707 }; 2708 2709 my ($port, $config_user, $config_group) = config_write($config_file, $config); 2710 2711 # Open pipes, for use between the parent and child processes. Specifically, 2712 # the child will indicate when it's done with its test by writing a message 2713 # to the parent. 2714 my ($rfh, $wfh); 2715 unless (pipe($rfh, $wfh)) { 2716 die("Can't open pipe: $!"); 2717 } 2718 2719 require Net::SSH2; 2720 2721 my $ex; 2722 2723 # Fork child 2724 $self->handle_sigchld(); 2725 defined(my $pid = fork()) or die("Can't fork: $!"); 2726 if ($pid) { 2727 eval { 2728 my $ssh2 = Net::SSH2->new(); 2729 2730 sleep(1); 2731 2732 unless ($ssh2->connect('127.0.0.1', $port)) { 2733 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2734 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 2735 } 2736 2737 unless ($ssh2->auth_password($user, $passwd)) { 2738 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2739 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 2740 } 2741 2742 my $sftp = $ssh2->sftp(); 2743 unless ($sftp) { 2744 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2745 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 2746 } 2747 2748 my $res = $sftp->rename('foo.d', 'BaR.D'); 2749 unless ($res) { 2750 my ($err_code, $err_name) = $sftp->error(); 2751 die("FXP_RENAME failed: [$err_name] ($err_code)"); 2752 } 2753 2754 $ssh2->disconnect(); 2755 2756 if (-d $src_dir) { 2757 die("$src_dir directory exists unexpectedly"); 2758 } 2759 2760 unless (-d $dst_dir) { 2761 die("$dst_dir directory does not exist as expected"); 2762 } 2763 }; 2764 2765 if ($@) { 2766 $ex = $@; 2767 } 2768 2769 $wfh->print("done\n"); 2770 $wfh->flush(); 2771 2772 } else { 2773 eval { server_wait($config_file, $rfh) }; 2774 if ($@) { 2775 warn($@); 2776 exit 1; 2777 } 2778 2779 exit 0; 2780 } 2781 2782 # Stop server 2783 server_stop($pid_file); 2784 2785 $self->assert_child_ok($pid); 2786 2787 if ($ex) { 2788 test_append_logfile($log_file, $ex); 2789 unlink($log_file); 2790 2791 die($ex); 2792 } 2793 2794 unlink($log_file); 2795} 2796 2797sub sftp_rewrite_symlink { 2798 my $self = shift; 2799 my $tmpdir = $self->{tmpdir}; 2800 2801 my $config_file = "$tmpdir/sftp.conf"; 2802 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 2803 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 2804 2805 my $log_file = test_get_logfile(); 2806 2807 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 2808 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 2809 2810 my $user = 'proftpd'; 2811 my $passwd = 'test'; 2812 my $group = 'ftpd'; 2813 my $home_dir = File::Spec->rel2abs($tmpdir); 2814 my $uid = 500; 2815 my $gid = 500; 2816 2817 my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt"); 2818 if (open(my $fh, "> $test_file")) { 2819 print $fh "ABCD" x 8192; 2820 2821 unless (close($fh)) { 2822 die("Can't write $test_file: $!"); 2823 } 2824 2825 } else { 2826 die("Can't open $test_file: $!"); 2827 } 2828 2829 my $test_symlink = File::Spec->rel2abs("$tmpdir/test_link"); 2830 2831 # Make sure that, if we're running as root, that the home directory has 2832 # permissions/privs set for the account we create 2833 if ($< == 0) { 2834 unless (chmod(0755, $home_dir)) { 2835 die("Can't set perms on $home_dir to 0755: $!"); 2836 } 2837 2838 unless (chown($uid, $gid, $home_dir)) { 2839 die("Can't set owner of $home_dir to $uid/$gid: $!"); 2840 } 2841 } 2842 2843 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 2844 '/bin/bash'); 2845 auth_group_write($auth_group_file, $group, $gid, $user); 2846 2847 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 2848 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 2849 2850 my $config = { 2851 PidFile => $pid_file, 2852 ScoreboardFile => $scoreboard_file, 2853 SystemLog => $log_file, 2854 TraceLog => $log_file, 2855 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 2856 2857 AuthUserFile => $auth_user_file, 2858 AuthGroupFile => $auth_group_file, 2859 2860 IfModules => { 2861 'mod_delay.c' => { 2862 DelayEngine => 'off', 2863 }, 2864 2865 'mod_rewrite.c' => [ 2866 'RewriteEngine on', 2867 "RewriteLog $log_file", 2868 2869 'RewriteMap replace int:replaceall', 2870 'RewriteCondition %m SYMLINK', 2871 'RewriteRule ^(.*)$ "${replace:!$1! !_}"', 2872 ], 2873 2874 'mod_sftp.c' => [ 2875 "SFTPEngine on", 2876 "SFTPLog $log_file", 2877 "SFTPHostKey $rsa_host_key", 2878 "SFTPHostKey $dsa_host_key", 2879 ], 2880 }, 2881 }; 2882 2883 my ($port, $config_user, $config_group) = config_write($config_file, $config); 2884 2885 # Open pipes, for use between the parent and child processes. Specifically, 2886 # the child will indicate when it's done with its test by writing a message 2887 # to the parent. 2888 my ($rfh, $wfh); 2889 unless (pipe($rfh, $wfh)) { 2890 die("Can't open pipe: $!"); 2891 } 2892 2893 require Net::SSH2; 2894 2895 my $ex; 2896 2897 # Fork child 2898 $self->handle_sigchld(); 2899 defined(my $pid = fork()) or die("Can't fork: $!"); 2900 if ($pid) { 2901 eval { 2902 my $ssh2 = Net::SSH2->new(); 2903 2904 sleep(1); 2905 2906 unless ($ssh2->connect('127.0.0.1', $port)) { 2907 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2908 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 2909 } 2910 2911 unless ($ssh2->auth_password($user, $passwd)) { 2912 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2913 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 2914 } 2915 2916 my $sftp = $ssh2->sftp(); 2917 unless ($sftp) { 2918 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2919 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 2920 } 2921 2922 my $res = $sftp->symlink('test file.txt', 'test link'); 2923 unless ($res) { 2924 my ($err_code, $err_name) = $sftp->error(); 2925 die("FXP_SYMLINK failed: [$err_name] ($err_code)"); 2926 } 2927 2928 # To close the SFTP channel, we have to explicitly destroy the object 2929 $sftp = undef; 2930 2931 $ssh2->disconnect(); 2932 2933 unless (-l $test_symlink) { 2934 die("$test_symlink symlink does not exist as expected"); 2935 } 2936 }; 2937 2938 if ($@) { 2939 $ex = $@; 2940 } 2941 2942 $wfh->print("done\n"); 2943 $wfh->flush(); 2944 2945 } else { 2946 eval { server_wait($config_file, $rfh) }; 2947 if ($@) { 2948 warn($@); 2949 exit 1; 2950 } 2951 2952 exit 0; 2953 } 2954 2955 # Stop server 2956 server_stop($pid_file); 2957 2958 $self->assert_child_ok($pid); 2959 2960 if ($ex) { 2961 test_append_logfile($log_file, $ex); 2962 unlink($log_file); 2963 2964 die($ex); 2965 } 2966 2967 unlink($log_file); 2968} 2969 2970sub sftp_rewrite_readlink { 2971 my $self = shift; 2972 my $tmpdir = $self->{tmpdir}; 2973 2974 my $config_file = "$tmpdir/sftp.conf"; 2975 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 2976 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 2977 2978 my $log_file = test_get_logfile(); 2979 2980 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 2981 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 2982 2983 my $user = 'proftpd'; 2984 my $passwd = 'test'; 2985 my $group = 'ftpd'; 2986 my $home_dir = File::Spec->rel2abs($tmpdir); 2987 my $uid = 500; 2988 my $gid = 500; 2989 2990 my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt"); 2991 if (open(my $fh, "> $test_file")) { 2992 print $fh "ABCD" x 8192; 2993 2994 unless (close($fh)) { 2995 die("Can't write $test_file: $!"); 2996 } 2997 2998 } else { 2999 die("Can't open $test_file: $!"); 3000 } 3001 3002 my $test_symlink = File::Spec->rel2abs("$tmpdir/test_link"); 3003 unless (symlink($test_file, $test_symlink)) { 3004 die("Can't symlink $test_symlink to $test_file: $!"); 3005 } 3006 3007 # Make sure that, if we're running as root, that the home directory has 3008 # permissions/privs set for the account we create 3009 if ($< == 0) { 3010 unless (chmod(0755, $home_dir)) { 3011 die("Can't set perms on $home_dir to 0755: $!"); 3012 } 3013 3014 unless (chown($uid, $gid, $home_dir)) { 3015 die("Can't set owner of $home_dir to $uid/$gid: $!"); 3016 } 3017 } 3018 3019 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 3020 '/bin/bash'); 3021 auth_group_write($auth_group_file, $group, $gid, $user); 3022 3023 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 3024 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 3025 3026 my $config = { 3027 PidFile => $pid_file, 3028 ScoreboardFile => $scoreboard_file, 3029 SystemLog => $log_file, 3030 TraceLog => $log_file, 3031 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 3032 3033 AuthUserFile => $auth_user_file, 3034 AuthGroupFile => $auth_group_file, 3035 3036 IfModules => { 3037 'mod_delay.c' => { 3038 DelayEngine => 'off', 3039 }, 3040 3041 'mod_rewrite.c' => [ 3042 'RewriteEngine on', 3043 "RewriteLog $log_file", 3044 3045 'RewriteMap replace int:replaceall', 3046 'RewriteCondition %m READLINK', 3047 'RewriteRule ^(.*)$ "${replace:!$1! !_}"', 3048 ], 3049 3050 'mod_sftp.c' => [ 3051 "SFTPEngine on", 3052 "SFTPLog $log_file", 3053 "SFTPHostKey $rsa_host_key", 3054 "SFTPHostKey $dsa_host_key", 3055 ], 3056 }, 3057 }; 3058 3059 my ($port, $config_user, $config_group) = config_write($config_file, $config); 3060 3061 # Open pipes, for use between the parent and child processes. Specifically, 3062 # the child will indicate when it's done with its test by writing a message 3063 # to the parent. 3064 my ($rfh, $wfh); 3065 unless (pipe($rfh, $wfh)) { 3066 die("Can't open pipe: $!"); 3067 } 3068 3069 require Net::SSH2; 3070 3071 my $ex; 3072 3073 # Fork child 3074 $self->handle_sigchld(); 3075 defined(my $pid = fork()) or die("Can't fork: $!"); 3076 if ($pid) { 3077 eval { 3078 my $ssh2 = Net::SSH2->new(); 3079 3080 sleep(1); 3081 3082 unless ($ssh2->connect('127.0.0.1', $port)) { 3083 my ($err_code, $err_name, $err_str) = $ssh2->error(); 3084 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 3085 } 3086 3087 unless ($ssh2->auth_password($user, $passwd)) { 3088 my ($err_code, $err_name, $err_str) = $ssh2->error(); 3089 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 3090 } 3091 3092 my $sftp = $ssh2->sftp(); 3093 unless ($sftp) { 3094 my ($err_code, $err_name, $err_str) = $ssh2->error(); 3095 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 3096 } 3097 3098 my $path = $sftp->readlink('test link'); 3099 unless ($path) { 3100 my ($err_code, $err_name) = $sftp->error(); 3101 die("FXP_READLINK failed: [$err_name] ($err_code)"); 3102 } 3103 3104 $ssh2->disconnect(); 3105 3106 $self->assert($test_file eq $path, 3107 test_msg("Expected '$test_file', got '$path'")); 3108 }; 3109 3110 if ($@) { 3111 $ex = $@; 3112 } 3113 3114 $wfh->print("done\n"); 3115 $wfh->flush(); 3116 3117 } else { 3118 eval { server_wait($config_file, $rfh) }; 3119 if ($@) { 3120 warn($@); 3121 exit 1; 3122 } 3123 3124 exit 0; 3125 } 3126 3127 # Stop server 3128 server_stop($pid_file); 3129 3130 $self->assert_child_ok($pid); 3131 3132 if ($ex) { 3133 test_append_logfile($log_file, $ex); 3134 unlink($log_file); 3135 3136 die($ex); 3137 } 3138 3139 unlink($log_file); 3140} 3141 3142sub sftp_rewrite_homedir { 3143 my $self = shift; 3144 my $tmpdir = $self->{tmpdir}; 3145 3146 my $config_file = "$tmpdir/sftp.conf"; 3147 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 3148 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 3149 3150 my $log_file = test_get_logfile(); 3151 3152 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 3153 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 3154 3155 my $user = 'proftpd'; 3156 my $passwd = 'test'; 3157 my $group = 'ftpd'; 3158 my $home_dir = File::Spec->rel2abs("$tmpdir/$user"); 3159 mkpath($home_dir); 3160 my $uid = 500; 3161 my $gid = 500; 3162 3163 my $abs_tmpdir = File::Spec->rel2abs($tmpdir); 3164 3165 # Make sure that, if we're running as root, that the home directory has 3166 # permissions/privs set for the account we create 3167 if ($< == 0) { 3168 unless (chmod(0755, $home_dir)) { 3169 die("Can't set perms on $home_dir to 0755: $!"); 3170 } 3171 3172 unless (chown($uid, $gid, $home_dir)) { 3173 die("Can't set owner of $home_dir to $uid/$gid: $!"); 3174 } 3175 } 3176 3177 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $abs_tmpdir, 3178 '/bin/bash'); 3179 auth_group_write($auth_group_file, $group, $gid, $user); 3180 3181 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 3182 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 3183 3184 my $config = { 3185 PidFile => $pid_file, 3186 ScoreboardFile => $scoreboard_file, 3187 SystemLog => $log_file, 3188 TraceLog => $log_file, 3189 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 3190 3191 AuthUserFile => $auth_user_file, 3192 AuthGroupFile => $auth_group_file, 3193 3194 IfModules => { 3195 'mod_delay.c' => { 3196 DelayEngine => 'off', 3197 }, 3198 3199 'mod_rewrite.c' => [ 3200 'RewriteEngine on', 3201 "RewriteLog $log_file", 3202 'RewriteHome on', 3203 'RewriteCondition %m REWRITE_HOME', 3204 "RewriteRule ^(.*)\$ \$1/%u", 3205 ], 3206 3207 'mod_sftp.c' => [ 3208 "SFTPEngine on", 3209 "SFTPLog $log_file", 3210 "SFTPHostKey $rsa_host_key", 3211 "SFTPHostKey $dsa_host_key", 3212 ], 3213 }, 3214 }; 3215 3216 my ($port, $config_user, $config_group) = config_write($config_file, $config); 3217 3218 # Open pipes, for use between the parent and child processes. Specifically, 3219 # the child will indicate when it's done with its test by writing a message 3220 # to the parent. 3221 my ($rfh, $wfh); 3222 unless (pipe($rfh, $wfh)) { 3223 die("Can't open pipe: $!"); 3224 } 3225 3226 require Net::SSH2; 3227 3228 my $ex; 3229 3230 # Fork child 3231 $self->handle_sigchld(); 3232 defined(my $pid = fork()) or die("Can't fork: $!"); 3233 if ($pid) { 3234 eval { 3235 my $ssh2 = Net::SSH2->new(); 3236 3237 sleep(1); 3238 3239 unless ($ssh2->connect('127.0.0.1', $port)) { 3240 my ($err_code, $err_name, $err_str) = $ssh2->error(); 3241 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 3242 } 3243 3244 unless ($ssh2->auth_password($user, $passwd)) { 3245 my ($err_code, $err_name, $err_str) = $ssh2->error(); 3246 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 3247 } 3248 3249 my $sftp = $ssh2->sftp(); 3250 unless ($sftp) { 3251 my ($err_code, $err_name, $err_str) = $ssh2->error(); 3252 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 3253 } 3254 3255 my $cwd = $sftp->realpath('.'); 3256 unless ($cwd) { 3257 my ($err_code, $err_name) = $sftp->error(); 3258 die("FXP_REALPATH failed: [$err_name] ($err_code)"); 3259 } 3260 3261 $sftp = undef; 3262 $ssh2->disconnect(); 3263 3264 my $expected = $home_dir; 3265 if ($^O eq 'darwin') { 3266 # Mac OSX hack 3267 $expected = '/private' . $expected; 3268 } 3269 3270 $self->assert($expected eq $cwd, 3271 test_msg("Expected '$home_dir', got '$cwd'")); 3272 }; 3273 3274 if ($@) { 3275 $ex = $@; 3276 } 3277 3278 $wfh->print("done\n"); 3279 $wfh->flush(); 3280 3281 } else { 3282 eval { server_wait($config_file, $rfh) }; 3283 if ($@) { 3284 warn($@); 3285 exit 1; 3286 } 3287 3288 exit 0; 3289 } 3290 3291 # Stop server 3292 server_stop($pid_file); 3293 3294 $self->assert_child_ok($pid); 3295 3296 if ($ex) { 3297 test_append_logfile($log_file, $ex); 3298 unlink($log_file); 3299 3300 die($ex); 3301 } 3302 3303 unlink($log_file); 3304} 3305 3306sub scp_rewrite_upload { 3307 my $self = shift; 3308 my $tmpdir = $self->{tmpdir}; 3309 3310 my $config_file = "$tmpdir/sftp.conf"; 3311 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 3312 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 3313 3314 my $log_file = test_get_logfile(); 3315 3316 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 3317 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 3318 3319 my $user = 'proftpd'; 3320 my $passwd = 'test'; 3321 my $group = 'ftpd'; 3322 my $home_dir = File::Spec->rel2abs($tmpdir); 3323 my $uid = 500; 3324 my $gid = 500; 3325 3326 # Make sure that, if we're running as root, that the home directory has 3327 # permissions/privs set for the account we create 3328 if ($< == 0) { 3329 unless (chmod(0755, $home_dir)) { 3330 die("Can't set perms on $home_dir to 0755: $!"); 3331 } 3332 3333 unless (chown($uid, $gid, $home_dir)) { 3334 die("Can't set owner of $home_dir to $uid/$gid: $!"); 3335 } 3336 } 3337 3338 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 3339 '/bin/bash'); 3340 auth_group_write($auth_group_file, $group, $gid, $user); 3341 3342 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 3343 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 3344 3345 my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt"); 3346 3347 my $config = { 3348 PidFile => $pid_file, 3349 ScoreboardFile => $scoreboard_file, 3350 SystemLog => $log_file, 3351 TraceLog => $log_file, 3352 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 3353 3354 AuthUserFile => $auth_user_file, 3355 AuthGroupFile => $auth_group_file, 3356 3357 IfModules => { 3358 'mod_delay.c' => { 3359 DelayEngine => 'off', 3360 }, 3361 3362 'mod_rewrite.c' => [ 3363 'RewriteEngine on', 3364 "RewriteLog $log_file", 3365 3366 'RewriteMap replace int:replaceall', 3367 'RewriteCondition %m STOR', 3368 'RewriteRule ^(.*)$ "${replace:!$1!&!_}"', 3369 ], 3370 3371 'mod_sftp.c' => [ 3372 "SFTPEngine on", 3373 "SFTPLog $log_file", 3374 "SFTPHostKey $rsa_host_key", 3375 "SFTPHostKey $dsa_host_key", 3376 ], 3377 }, 3378 }; 3379 3380 my ($port, $config_user, $config_group) = config_write($config_file, $config); 3381 3382 # Open pipes, for use between the parent and child processes. Specifically, 3383 # the child will indicate when it's done with its test by writing a message 3384 # to the parent. 3385 my ($rfh, $wfh); 3386 unless (pipe($rfh, $wfh)) { 3387 die("Can't open pipe: $!"); 3388 } 3389 3390 require Net::SSH2; 3391 3392 my $ex; 3393 3394 # Ignore SIGPIPE 3395 local $SIG{PIPE} = sub { }; 3396 3397 # Fork child 3398 $self->handle_sigchld(); 3399 defined(my $pid = fork()) or die("Can't fork: $!"); 3400 if ($pid) { 3401 eval { 3402 my $ssh2 = Net::SSH2->new(); 3403 3404 sleep(1); 3405 3406 unless ($ssh2->connect('127.0.0.1', $port)) { 3407 my ($err_code, $err_name, $err_str) = $ssh2->error(); 3408 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 3409 } 3410 3411 unless ($ssh2->auth_password($user, $passwd)) { 3412 my ($err_code, $err_name, $err_str) = $ssh2->error(); 3413 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 3414 } 3415 3416 my $res = $ssh2->scp_put($config_file, 'test&file.txt'); 3417 unless ($res) { 3418 my ($err_code, $err_name, $err_str) = $ssh2->error(); 3419 die("Can't upload $config_file to server: [$err_name] ($err_code) $err_str"); 3420 } 3421 3422 $ssh2->disconnect(); 3423 3424 unless (-f $test_file) { 3425 die("$test_file file does not exist as expected"); 3426 } 3427 }; 3428 3429 if ($@) { 3430 $ex = $@; 3431 } 3432 3433 $wfh->print("done\n"); 3434 $wfh->flush(); 3435 3436 } else { 3437 eval { server_wait($config_file, $rfh) }; 3438 if ($@) { 3439 warn($@); 3440 exit 1; 3441 } 3442 3443 exit 0; 3444 } 3445 3446 # Stop server 3447 server_stop($pid_file); 3448 3449 $self->assert_child_ok($pid); 3450 3451 if ($ex) { 3452 test_append_logfile($log_file, $ex); 3453 unlink($log_file); 3454 3455 die($ex); 3456 } 3457 3458 unlink($log_file); 3459} 3460 3461sub scp_rewrite_download { 3462 my $self = shift; 3463 my $tmpdir = $self->{tmpdir}; 3464 3465 my $config_file = "$tmpdir/sftp.conf"; 3466 my $pid_file = File::Spec->rel2abs("$tmpdir/sftp.pid"); 3467 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sftp.scoreboard"); 3468 3469 my $log_file = test_get_logfile(); 3470 3471 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sftp.passwd"); 3472 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sftp.group"); 3473 3474 my $user = 'proftpd'; 3475 my $passwd = 'test'; 3476 my $group = 'ftpd'; 3477 my $home_dir = File::Spec->rel2abs($tmpdir); 3478 my $uid = 500; 3479 my $gid = 500; 3480 3481 # Make sure that, if we're running as root, that the home directory has 3482 # permissions/privs set for the account we create 3483 if ($< == 0) { 3484 unless (chmod(0755, $home_dir)) { 3485 die("Can't set perms on $home_dir to 0755: $!"); 3486 } 3487 3488 unless (chown($uid, $gid, $home_dir)) { 3489 die("Can't set owner of $home_dir to $uid/$gid: $!"); 3490 } 3491 } 3492 3493 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 3494 '/bin/bash'); 3495 auth_group_write($auth_group_file, $group, $gid, $user); 3496 3497 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 3498 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 3499 3500 my $test_file = File::Spec->rel2abs("$tmpdir/test_file.txt"); 3501 if (open(my $fh, "> $test_file")) { 3502 print $fh "Hello, World!\n"; 3503 unless (close($fh)) { 3504 die("Can't write $test_file: $!"); 3505 } 3506 3507 } else { 3508 die("Can't open $test_file: $!"); 3509 } 3510 3511 my $output_file = File::Spec->rel2abs("$tmpdir/retrieved.txt"); 3512 3513 my $config = { 3514 PidFile => $pid_file, 3515 ScoreboardFile => $scoreboard_file, 3516 SystemLog => $log_file, 3517 TraceLog => $log_file, 3518 Trace => 'DEFAULT:10 ssh2:20 sftp:20 scp:20', 3519 3520 AuthUserFile => $auth_user_file, 3521 AuthGroupFile => $auth_group_file, 3522 3523 IfModules => { 3524 'mod_delay.c' => { 3525 DelayEngine => 'off', 3526 }, 3527 3528 'mod_rewrite.c' => [ 3529 'RewriteEngine on', 3530 "RewriteLog $log_file", 3531 3532 'RewriteMap replace int:replaceall', 3533 'RewriteCondition %m RETR', 3534 'RewriteCondition %F &', 3535 'RewriteRule ^(.*)$ "${replace:!$1!&!_}"', 3536 ], 3537 3538 'mod_sftp.c' => [ 3539 "SFTPEngine on", 3540 "SFTPLog $log_file", 3541 "SFTPHostKey $rsa_host_key", 3542 "SFTPHostKey $dsa_host_key", 3543 ], 3544 }, 3545 }; 3546 3547 my ($port, $config_user, $config_group) = config_write($config_file, $config); 3548 3549 # Open pipes, for use between the parent and child processes. Specifically, 3550 # the child will indicate when it's done with its test by writing a message 3551 # to the parent. 3552 my ($rfh, $wfh); 3553 unless (pipe($rfh, $wfh)) { 3554 die("Can't open pipe: $!"); 3555 } 3556 3557 require Net::SSH2; 3558 3559 my $ex; 3560 3561 # Ignore SIGPIPE 3562 local $SIG{PIPE} = sub { }; 3563 3564 # Fork child 3565 $self->handle_sigchld(); 3566 defined(my $pid = fork()) or die("Can't fork: $!"); 3567 if ($pid) { 3568 eval { 3569 my $ssh2 = Net::SSH2->new(); 3570 3571 sleep(1); 3572 3573 unless ($ssh2->connect('127.0.0.1', $port)) { 3574 my ($err_code, $err_name, $err_str) = $ssh2->error(); 3575 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 3576 } 3577 3578 unless ($ssh2->auth_password($user, $passwd)) { 3579 my ($err_code, $err_name, $err_str) = $ssh2->error(); 3580 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 3581 } 3582 3583 my $res = $ssh2->scp_get('test&file.txt', $output_file); 3584 unless ($res) { 3585 my ($err_code, $err_name, $err_str) = $ssh2->error(); 3586 die("Can't download test&file.txt from server: [$err_name] ($err_code) $err_str"); 3587 } 3588 3589 $ssh2->disconnect(); 3590 3591 unless (-f $output_file) { 3592 die("$output_file file does not exist as expected"); 3593 } 3594 }; 3595 3596 if ($@) { 3597 $ex = $@; 3598 } 3599 3600 $wfh->print("done\n"); 3601 $wfh->flush(); 3602 3603 } else { 3604 eval { server_wait($config_file, $rfh) }; 3605 if ($@) { 3606 warn($@); 3607 exit 1; 3608 } 3609 3610 exit 0; 3611 } 3612 3613 # Stop server 3614 server_stop($pid_file); 3615 3616 $self->assert_child_ok($pid); 3617 3618 if ($ex) { 3619 test_append_logfile($log_file, $ex); 3620 unlink($log_file); 3621 3622 die($ex); 3623 } 3624 3625 unlink($log_file); 3626} 3627 36281; 3629