1package ProFTPD::Tests::Modules::mod_sftp::sql; 2 3use lib qw(t/lib); 4use base qw(ProFTPD::TestSuite::Child); 5use strict; 6 7use File::Path qw(mkpath); 8use File::Spec; 9use IO::Handle; 10use POSIX qw(:fcntl_h); 11 12use ProFTPD::TestSuite::FTP; 13use ProFTPD::TestSuite::Utils qw(:auth :config :running :test :testsuite); 14 15$| = 1; 16 17my $order = 0; 18 19my $TESTS = { 20 sftp_sql_sqllog_var_xfer_status_nonxfer => { 21 order => ++$order, 22 test_class => [qw(forking mod_sql_sqlite)], 23 }, 24 25 sftp_sql_sqllog_var_xfer_status_success_download => { 26 order => ++$order, 27 test_class => [qw(forking mod_sql_sqlite)], 28 }, 29 30 sftp_sql_sqllog_var_xfer_status_success_upload => { 31 order => ++$order, 32 test_class => [qw(forking mod_sql_sqlite)], 33 }, 34 35 sftp_sql_sqllog_var_xfer_status_failed_download => { 36 order => ++$order, 37 test_class => [qw(forking mod_sql_sqlite)], 38 }, 39 40 sftp_sql_sqllog_var_xfer_status_failed_upload => { 41 order => ++$order, 42 test_class => [qw(forking mod_sql_sqlite)], 43 }, 44 45 sftp_sql_sqllog_var_xfer_failure_none => { 46 order => ++$order, 47 test_class => [qw(forking mod_sql_sqlite)], 48 }, 49 50 sftp_sql_sqllog_var_userauth_method => { 51 order => ++$order, 52 test_class => [qw(forking mod_sql_sqlite)], 53 }, 54 55 sftp_sql_sqllog_var_userauth_method_env_var => { 56 order => ++$order, 57 test_class => [qw(forking mod_sql_sqlite)], 58 }, 59 60 # XXX Need to support xfer_status_timeout, xfer_failure_reason 61 62 sftp_sql_sqllog_var_xfer_path_uploads_bug4382 => { 63 order => ++$order, 64 test_class => [qw(bug forking mod_sql_sqlite rootprivs)], 65 }, 66 67 sftp_sql_sqllog_var_filename_uploads_bug4382 => { 68 order => ++$order, 69 test_class => [qw(bug forking mod_sql_sqlite rootprivs)], 70 }, 71 72 sftp_sql_env_var_issue857 => { 73 order => ++$order, 74 test_class => [qw(bug forking mod_sql_sqlite)], 75 }, 76}; 77 78sub new { 79 return shift()->SUPER::new(@_); 80} 81 82sub list_tests { 83 return testsuite_get_runnable_tests($TESTS); 84} 85 86sub set_up { 87 my $self = shift; 88 $self->SUPER::set_up(@_); 89 90 # Make sure that mod_sftp does not complain about permissions on the hostkey 91 # files. 92 93 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 94 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 95 96 unless (chmod(0400, $rsa_host_key, $dsa_host_key)) { 97 die("Can't set perms on $rsa_host_key, $dsa_host_key: $!"); 98 } 99} 100 101sub get_xfer_status { 102 my $db_file = shift; 103 my $where = shift; 104 105 my $sql = "SELECT user, ip_addr, xfer_status, xfer_path FROM ftpsessions"; 106 if ($where) { 107 $sql .= " WHERE $where"; 108 } 109 $sql .= " LIMIT 1"; 110 111 my $cmd = "sqlite3 $db_file \"$sql\""; 112 113 if ($ENV{TEST_VERBOSE}) { 114 print STDERR "Executing sqlite3: $cmd\n"; 115 } 116 117 my $res = join('', `$cmd`); 118 chomp($res); 119 120 # The default sqlite3 delimiter is '|' 121 return split(/\|/, $res); 122} 123 124sub sftp_sql_sqllog_var_xfer_status_nonxfer { 125 my $self = shift; 126 my $tmpdir = $self->{tmpdir}; 127 128 my $config_file = "$tmpdir/sqlite.conf"; 129 my $pid_file = File::Spec->rel2abs("$tmpdir/sqlite.pid"); 130 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sqlite.scoreboard"); 131 132 my $log_file = test_get_logfile(); 133 134 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sqlite.passwd"); 135 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sqlite.group"); 136 137 my $user = 'proftpd'; 138 my $passwd = 'test'; 139 my $group = 'ftpd'; 140 my $home_dir = File::Spec->rel2abs($tmpdir); 141 my $uid = 500; 142 my $gid = 500; 143 144 # Make sure that, if we're running as root, that the home directory has 145 # permissions/privs set for the account we create 146 if ($< == 0) { 147 unless (chmod(0755, $home_dir)) { 148 die("Can't set perms on $home_dir to 0755: $!"); 149 } 150 151 unless (chown($uid, $gid, $home_dir)) { 152 die("Can't set owner of $home_dir to $uid/$gid: $!"); 153 } 154 } 155 156 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 157 '/bin/bash'); 158 auth_group_write($auth_group_file, $group, $gid, $user); 159 160 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 161 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 162 163 my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db"); 164 165 # Build up sqlite3 command to create users, groups tables and populate them 166 my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql"); 167 168 if (open(my $fh, "> $db_script")) { 169 print $fh <<EOS; 170CREATE TABLE ftpsessions ( 171 user TEXT, 172 ip_addr TEXT, 173 xfer_status TEXT, 174 xfer_path TEXT 175); 176EOS 177 178 unless (close($fh)) { 179 die("Can't write $db_script: $!"); 180 } 181 182 } else { 183 die("Can't open $db_script: $!"); 184 } 185 186 my $cmd = "sqlite3 $db_file < $db_script"; 187 188 if ($ENV{TEST_VERBOSE}) { 189 print STDERR "Executing sqlite3: $cmd\n"; 190 } 191 192 my @output = `$cmd`; 193 if (scalar(@output) && 194 $ENV{TEST_VERBOSE}) { 195 print STDERR "Output: ", join('', @output), "\n"; 196 } 197 198 # Make sure that, if we're running as root, the database file has 199 # the permissions/privs set for use by proftpd 200 if ($< == 0) { 201 unless (chmod(0666, $db_file)) { 202 die("Can't set perms on $db_file to 0666: $!"); 203 } 204 } 205 206 my $test_file = File::Spec->rel2abs("$tmpdir/test.txt"); 207 if (open(my $fh, "> $test_file")) { 208 close($fh); 209 210 } else { 211 die("Can't open $test_file: $!"); 212 } 213 214 my $config = { 215 PidFile => $pid_file, 216 ScoreboardFile => $scoreboard_file, 217 SystemLog => $log_file, 218 TraceLog => $log_file, 219 Trace => 'sql:20 command:20 netio:20 ssh2:20 sftp:20', 220 221 AuthUserFile => $auth_user_file, 222 AuthGroupFile => $auth_group_file, 223 224 IfModules => { 225 'mod_delay.c' => { 226 DelayEngine => 'off', 227 }, 228 229 'mod_sftp.c' => [ 230 "SFTPEngine on", 231 "SFTPLog $log_file", 232 "SFTPHostKey $rsa_host_key", 233 "SFTPHostKey $dsa_host_key", 234 ], 235 236 'mod_sql.c' => { 237 SQLEngine => 'log', 238 SQLBackend => 'sqlite3', 239 SQLConnectInfo => $db_file, 240 SQLLogFile => $log_file, 241 SQLNamedQuery => 'xfer_status FREEFORM "INSERT INTO ftpsessions (user, ip_addr, xfer_status, xfer_path) VALUES (\'%u\', \'%L\', \'%{transfer-status}\', \'%f\')"', 242 SQLLog => 'REALPATH xfer_status', 243 }, 244 }, 245 }; 246 247 my ($port, $config_user, $config_group) = config_write($config_file, $config); 248 249 # Open pipes, for use between the parent and child processes. Specifically, 250 # the child will indicate when it's done with its test by writing a message 251 # to the parent. 252 my ($rfh, $wfh); 253 unless (pipe($rfh, $wfh)) { 254 die("Can't open pipe: $!"); 255 } 256 257 require Net::SSH2; 258 259 my $ex; 260 261 # Fork child 262 $self->handle_sigchld(); 263 defined(my $pid = fork()) or die("Can't fork: $!"); 264 if ($pid) { 265 eval { 266 my $ssh2 = Net::SSH2->new(); 267 268 sleep(1); 269 270 unless ($ssh2->connect('127.0.0.1', $port)) { 271 my ($err_code, $err_name, $err_str) = $ssh2->error(); 272 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 273 } 274 275 unless ($ssh2->auth_password($user, $passwd)) { 276 my ($err_code, $err_name, $err_str) = $ssh2->error(); 277 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 278 } 279 280 my $sftp = $ssh2->sftp(); 281 unless ($sftp) { 282 my ($err_code, $err_name, $err_str) = $ssh2->error(); 283 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 284 } 285 286 my $cwd = $sftp->realpath('.'); 287 unless ($cwd) { 288 my ($err_code, $err_name) = $sftp->error(); 289 die("Can't get real path for '.': [$err_name] ($err_code)"); 290 } 291 292 my $expected = $home_dir; 293 294 if ($^O eq 'darwin') { 295 # MacOSX hack 296 $expected = ('/private' . $expected); 297 } 298 299 $self->assert($expected eq $cwd, 300 test_msg("Expected '$expected', got '$cwd'")); 301 302 $sftp = undef; 303 $ssh2->disconnect(); 304 }; 305 if ($@) { 306 $ex = $@; 307 } 308 309 $wfh->print("done\n"); 310 $wfh->flush(); 311 312 } else { 313 eval { server_wait($config_file, $rfh) }; 314 if ($@) { 315 warn($@); 316 exit 1; 317 } 318 319 exit 0; 320 } 321 322 # Stop server 323 server_stop($pid_file); 324 325 $self->assert_child_ok($pid); 326 327 if ($ex) { 328 test_append_logfile($log_file, $ex); 329 unlink($log_file); 330 331 die($ex); 332 } 333 334 my ($login, $ip_addr, $xfer_status, $xfer_path) = get_xfer_status($db_file, "user = \'$user\'"); 335 336 my $expected; 337 338 $expected = $user; 339 $self->assert($expected eq $login, 340 test_msg("Expected user '$expected', got '$login'")); 341 342 $expected = '127.0.0.1'; 343 $self->assert($expected eq $ip_addr, 344 test_msg("Expected IP address '$expected', got '$ip_addr'")); 345 346 $expected = '-'; 347 $self->assert($expected eq $xfer_status, 348 test_msg("Expected transfer status '$expected', got '$xfer_status'")); 349 350 $expected = '-'; 351 $self->assert($expected eq $xfer_path, 352 test_msg("Expected file path '$expected', got '$xfer_path'")); 353 354 unlink($log_file); 355} 356 357sub sftp_sql_sqllog_var_xfer_status_success_download { 358 my $self = shift; 359 my $tmpdir = $self->{tmpdir}; 360 361 my $config_file = "$tmpdir/sqlite.conf"; 362 my $pid_file = File::Spec->rel2abs("$tmpdir/sqlite.pid"); 363 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sqlite.scoreboard"); 364 365 my $log_file = test_get_logfile(); 366 367 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sqlite.passwd"); 368 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sqlite.group"); 369 370 my $user = 'proftpd'; 371 my $passwd = 'test'; 372 my $group = 'ftpd'; 373 my $home_dir = File::Spec->rel2abs($tmpdir); 374 my $uid = 500; 375 my $gid = 500; 376 377 # Make sure that, if we're running as root, that the home directory has 378 # permissions/privs set for the account we create 379 if ($< == 0) { 380 unless (chmod(0755, $home_dir)) { 381 die("Can't set perms on $home_dir to 0755: $!"); 382 } 383 384 unless (chown($uid, $gid, $home_dir)) { 385 die("Can't set owner of $home_dir to $uid/$gid: $!"); 386 } 387 } 388 389 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 390 '/bin/bash'); 391 auth_group_write($auth_group_file, $group, $gid, $user); 392 393 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 394 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 395 396 my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db"); 397 398 # Build up sqlite3 command to create users, groups tables and populate them 399 my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql"); 400 401 if (open(my $fh, "> $db_script")) { 402 print $fh <<EOS; 403CREATE TABLE ftpsessions ( 404 user TEXT, 405 ip_addr TEXT, 406 xfer_status TEXT, 407 xfer_path TEXT 408); 409EOS 410 411 unless (close($fh)) { 412 die("Can't write $db_script: $!"); 413 } 414 415 } else { 416 die("Can't open $db_script: $!"); 417 } 418 419 my $cmd = "sqlite3 $db_file < $db_script"; 420 421 if ($ENV{TEST_VERBOSE}) { 422 print STDERR "Executing sqlite3: $cmd\n"; 423 } 424 425 my @output = `$cmd`; 426 if (scalar(@output) && 427 $ENV{TEST_VERBOSE}) { 428 print STDERR "Output: ", join('', @output), "\n"; 429 } 430 431 # Make sure that, if we're running as root, the database file has 432 # the permissions/privs set for use by proftpd 433 if ($< == 0) { 434 unless (chmod(0666, $db_file)) { 435 die("Can't set perms on $db_file to 0666: $!"); 436 } 437 } 438 439 my $test_file = File::Spec->rel2abs("$tmpdir/test.txt"); 440 if (open(my $fh, "> $test_file")) { 441 close($fh); 442 443 } else { 444 die("Can't open $test_file: $!"); 445 } 446 447 my $config = { 448 PidFile => $pid_file, 449 ScoreboardFile => $scoreboard_file, 450 SystemLog => $log_file, 451 TraceLog => $log_file, 452 Trace => 'sql:20 command:20 netio:20 response:20 ssh2:20 sftp:20', 453 454 AuthUserFile => $auth_user_file, 455 AuthGroupFile => $auth_group_file, 456 457 IfModules => { 458 'mod_delay.c' => { 459 DelayEngine => 'off', 460 }, 461 462 'mod_sftp.c' => [ 463 "SFTPEngine on", 464 "SFTPLog $log_file", 465 "SFTPHostKey $rsa_host_key", 466 "SFTPHostKey $dsa_host_key", 467 ], 468 469 'mod_sql.c' => { 470 SQLEngine => 'log', 471 SQLBackend => 'sqlite3', 472 SQLConnectInfo => $db_file, 473 SQLLogFile => $log_file, 474 SQLNamedQuery => 'xfer_status FREEFORM "INSERT INTO ftpsessions (user, ip_addr, xfer_status, xfer_path) VALUES (\'%u\', \'%L\', \'%{transfer-status}\', \'%f\')"', 475 SQLLog => 'ERR_RETR,RETR xfer_status', 476 }, 477 }, 478 }; 479 480 my ($port, $config_user, $config_group) = config_write($config_file, $config); 481 482 # Open pipes, for use between the parent and child processes. Specifically, 483 # the child will indicate when it's done with its test by writing a message 484 # to the parent. 485 my ($rfh, $wfh); 486 unless (pipe($rfh, $wfh)) { 487 die("Can't open pipe: $!"); 488 } 489 490 require Net::SSH2; 491 492 my $ex; 493 494 # Fork child 495 $self->handle_sigchld(); 496 defined(my $pid = fork()) or die("Can't fork: $!"); 497 if ($pid) { 498 eval { 499 my $ssh2 = Net::SSH2->new(); 500 501 sleep(1); 502 503 unless ($ssh2->connect('127.0.0.1', $port)) { 504 my ($err_code, $err_name, $err_str) = $ssh2->error(); 505 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 506 } 507 508 unless ($ssh2->auth_password($user, $passwd)) { 509 my ($err_code, $err_name, $err_str) = $ssh2->error(); 510 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 511 } 512 513 my $sftp = $ssh2->sftp(); 514 unless ($sftp) { 515 my ($err_code, $err_name, $err_str) = $ssh2->error(); 516 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 517 } 518 519 my $fh = $sftp->open('test.txt', O_RDONLY); 520 unless ($fh) { 521 my ($err_code, $err_name) = $sftp->error(); 522 die("Can't open test.txt: [$err_name] ($err_code)"); 523 } 524 525 my $buf; 526 527 my $res = $fh->read($buf, 8192); 528 while ($res) { 529 $res = $fh->read($buf, 8192); 530 } 531 532 # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle 533 $fh = undef; 534 535 # To close the SFTP channel, we have to explicitly destroy the object 536 $sftp = undef; 537 538 $ssh2->disconnect(); 539 }; 540 541 if ($@) { 542 $ex = $@; 543 } 544 545 $wfh->print("done\n"); 546 $wfh->flush(); 547 548 } else { 549 eval { server_wait($config_file, $rfh) }; 550 if ($@) { 551 warn($@); 552 exit 1; 553 } 554 555 exit 0; 556 } 557 558 # Stop server 559 server_stop($pid_file); 560 561 $self->assert_child_ok($pid); 562 563 if ($ex) { 564 test_append_logfile($log_file, $ex); 565 unlink($log_file); 566 567 die($ex); 568 } 569 570 my ($login, $ip_addr, $xfer_status, $xfer_path) = get_xfer_status($db_file, "user = \'$user\'"); 571 572 my $expected; 573 574 $expected = $user; 575 $self->assert($expected eq $login, 576 test_msg("Expected user '$expected', got '$login'")); 577 578 $expected = '127.0.0.1'; 579 $self->assert($expected eq $ip_addr, 580 test_msg("Expected IP address '$expected', got '$ip_addr'")); 581 582 $expected = 'success'; 583 $self->assert($expected eq $xfer_status, 584 test_msg("Expected transfer status '$expected', got '$xfer_status'")); 585 586 if ($^O eq 'darwin') { 587 # Mac OSX hack 588 $test_file = '/private' . $test_file; 589 } 590 591 $expected = $test_file; 592 $self->assert($expected eq $xfer_path, 593 test_msg("Expected file path '$expected', got '$xfer_path'")); 594 595 unlink($log_file); 596} 597 598sub sftp_sql_sqllog_var_xfer_status_success_upload { 599 my $self = shift; 600 my $tmpdir = $self->{tmpdir}; 601 602 my $config_file = "$tmpdir/sqlite.conf"; 603 my $pid_file = File::Spec->rel2abs("$tmpdir/sqlite.pid"); 604 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sqlite.scoreboard"); 605 606 my $log_file = test_get_logfile(); 607 608 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sqlite.passwd"); 609 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sqlite.group"); 610 611 my $user = 'proftpd'; 612 my $passwd = 'test'; 613 my $group = 'ftpd'; 614 my $home_dir = File::Spec->rel2abs($tmpdir); 615 my $uid = 500; 616 my $gid = 500; 617 618 # Make sure that, if we're running as root, that the home directory has 619 # permissions/privs set for the account we create 620 if ($< == 0) { 621 unless (chmod(0755, $home_dir)) { 622 die("Can't set perms on $home_dir to 0755: $!"); 623 } 624 625 unless (chown($uid, $gid, $home_dir)) { 626 die("Can't set owner of $home_dir to $uid/$gid: $!"); 627 } 628 } 629 630 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 631 '/bin/bash'); 632 auth_group_write($auth_group_file, $group, $gid, $user); 633 634 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 635 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 636 637 my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db"); 638 639 # Build up sqlite3 command to create users, groups tables and populate them 640 my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql"); 641 642 if (open(my $fh, "> $db_script")) { 643 print $fh <<EOS; 644CREATE TABLE ftpsessions ( 645 user TEXT, 646 ip_addr TEXT, 647 xfer_status TEXT, 648 xfer_path TEXT 649); 650EOS 651 652 unless (close($fh)) { 653 die("Can't write $db_script: $!"); 654 } 655 656 } else { 657 die("Can't open $db_script: $!"); 658 } 659 660 my $cmd = "sqlite3 $db_file < $db_script"; 661 662 if ($ENV{TEST_VERBOSE}) { 663 print STDERR "Executing sqlite3: $cmd\n"; 664 } 665 666 my @output = `$cmd`; 667 if (scalar(@output) && 668 $ENV{TEST_VERBOSE}) { 669 print STDERR "Output: ", join('', @output), "\n"; 670 } 671 672 # Make sure that, if we're running as root, the database file has 673 # the permissions/privs set for use by proftpd 674 if ($< == 0) { 675 unless (chmod(0666, $db_file)) { 676 die("Can't set perms on $db_file to 0666: $!"); 677 } 678 } 679 680 my $test_file = File::Spec->rel2abs("$tmpdir/test.txt"); 681 682 my $config = { 683 PidFile => $pid_file, 684 ScoreboardFile => $scoreboard_file, 685 SystemLog => $log_file, 686 TraceLog => $log_file, 687 Trace => 'sql:20 command:20 netio:20 response:20 ssh2:20 sftp:20', 688 689 AuthUserFile => $auth_user_file, 690 AuthGroupFile => $auth_group_file, 691 692 IfModules => { 693 'mod_delay.c' => { 694 DelayEngine => 'off', 695 }, 696 697 'mod_sftp.c' => [ 698 "SFTPEngine on", 699 "SFTPLog $log_file", 700 "SFTPHostKey $rsa_host_key", 701 "SFTPHostKey $dsa_host_key", 702 ], 703 704 'mod_sql.c' => { 705 SQLEngine => 'log', 706 SQLBackend => 'sqlite3', 707 SQLConnectInfo => $db_file, 708 SQLLogFile => $log_file, 709 SQLNamedQuery => 'xfer_status FREEFORM "INSERT INTO ftpsessions (user, ip_addr, xfer_status, xfer_path) VALUES (\'%u\', \'%L\', \'%{transfer-status}\', \'%f\')"', 710 SQLLog => 'ERR_STOR,STOR xfer_status', 711 }, 712 }, 713 }; 714 715 my ($port, $config_user, $config_group) = config_write($config_file, $config); 716 717 # Open pipes, for use between the parent and child processes. Specifically, 718 # the child will indicate when it's done with its test by writing a message 719 # to the parent. 720 my ($rfh, $wfh); 721 unless (pipe($rfh, $wfh)) { 722 die("Can't open pipe: $!"); 723 } 724 725 require Net::SSH2; 726 727 my $ex; 728 729 # Fork child 730 $self->handle_sigchld(); 731 defined(my $pid = fork()) or die("Can't fork: $!"); 732 if ($pid) { 733 eval { 734 my $ssh2 = Net::SSH2->new(); 735 736 sleep(1); 737 738 unless ($ssh2->connect('127.0.0.1', $port)) { 739 my ($err_code, $err_name, $err_str) = $ssh2->error(); 740 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 741 } 742 743 unless ($ssh2->auth_password($user, $passwd)) { 744 my ($err_code, $err_name, $err_str) = $ssh2->error(); 745 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 746 } 747 748 my $sftp = $ssh2->sftp(); 749 unless ($sftp) { 750 my ($err_code, $err_name, $err_str) = $ssh2->error(); 751 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 752 } 753 754 my $fh = $sftp->open('test.txt', O_CREAT|O_WRONLY); 755 unless ($fh) { 756 my ($err_code, $err_name) = $sftp->error(); 757 die("Can't open test.txt: [$err_name] ($err_code)"); 758 } 759 760 my $buf = "Hello, World!\n"; 761 my $res= $fh->write($buf); 762 763 # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle 764 $fh = undef; 765 766 # To close the SFTP channel, we have to explicitly destroy the object 767 $sftp = undef; 768 769 $ssh2->disconnect(); 770 }; 771 772 if ($@) { 773 $ex = $@; 774 } 775 776 $wfh->print("done\n"); 777 $wfh->flush(); 778 779 } else { 780 eval { server_wait($config_file, $rfh) }; 781 if ($@) { 782 warn($@); 783 exit 1; 784 } 785 786 exit 0; 787 } 788 789 # Stop server 790 server_stop($pid_file); 791 792 $self->assert_child_ok($pid); 793 794 if ($ex) { 795 test_append_logfile($log_file, $ex); 796 unlink($log_file); 797 798 die($ex); 799 } 800 801 my ($login, $ip_addr, $xfer_status, $xfer_path) = get_xfer_status($db_file, "user = \'$user\'"); 802 803 my $expected; 804 805 $expected = $user; 806 $self->assert($expected eq $login, 807 test_msg("Expected user '$expected', got '$login'")); 808 809 $expected = '127.0.0.1'; 810 $self->assert($expected eq $ip_addr, 811 test_msg("Expected IP address '$expected', got '$ip_addr'")); 812 813 $expected = 'success'; 814 $self->assert($expected eq $xfer_status, 815 test_msg("Expected transfer status '$expected', got '$xfer_status'")); 816 817 if ($^O eq 'darwin') { 818 # Mac OSX hack 819 $test_file = '/private' . $test_file; 820 } 821 822 $expected = $test_file; 823 $self->assert($expected eq $xfer_path, 824 test_msg("Expected file path '$expected', got '$xfer_path'")); 825 826 unlink($log_file); 827} 828 829sub sftp_sql_sqllog_var_xfer_status_failed_download { 830 my $self = shift; 831 my $tmpdir = $self->{tmpdir}; 832 833 my $config_file = "$tmpdir/sqlite.conf"; 834 my $pid_file = File::Spec->rel2abs("$tmpdir/sqlite.pid"); 835 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sqlite.scoreboard"); 836 837 my $log_file = test_get_logfile(); 838 839 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sqlite.passwd"); 840 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sqlite.group"); 841 842 my $user = 'proftpd'; 843 my $passwd = 'test'; 844 my $group = 'ftpd'; 845 my $home_dir = File::Spec->rel2abs($tmpdir); 846 my $uid = 500; 847 my $gid = 500; 848 849 # Make sure that, if we're running as root, that the home directory has 850 # permissions/privs set for the account we create 851 if ($< == 0) { 852 unless (chmod(0755, $home_dir)) { 853 die("Can't set perms on $home_dir to 0755: $!"); 854 } 855 856 unless (chown($uid, $gid, $home_dir)) { 857 die("Can't set owner of $home_dir to $uid/$gid: $!"); 858 } 859 } 860 861 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 862 '/bin/bash'); 863 auth_group_write($auth_group_file, $group, $gid, $user); 864 865 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 866 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 867 868 my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db"); 869 870 # Build up sqlite3 command to create users, groups tables and populate them 871 my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql"); 872 873 if (open(my $fh, "> $db_script")) { 874 print $fh <<EOS; 875CREATE TABLE ftpsessions ( 876 user TEXT, 877 ip_addr TEXT, 878 xfer_status TEXT, 879 xfer_path TEXT 880); 881EOS 882 883 unless (close($fh)) { 884 die("Can't write $db_script: $!"); 885 } 886 887 } else { 888 die("Can't open $db_script: $!"); 889 } 890 891 my $cmd = "sqlite3 $db_file < $db_script"; 892 893 if ($ENV{TEST_VERBOSE}) { 894 print STDERR "Executing sqlite3: $cmd\n"; 895 } 896 897 my @output = `$cmd`; 898 if (scalar(@output) && 899 $ENV{TEST_VERBOSE}) { 900 print STDERR "Output: ", join('', @output), "\n"; 901 } 902 903 # Make sure that, if we're running as root, the database file has 904 # the permissions/privs set for use by proftpd 905 if ($< == 0) { 906 unless (chmod(0666, $db_file)) { 907 die("Can't set perms on $db_file to 0666: $!"); 908 } 909 } 910 911 my $test_file = File::Spec->rel2abs("$tmpdir/test.txt"); 912 if (open(my $fh, "> $test_file")) { 913 print $fh "ABCDefgh" x 32768; 914 915 unless (close($fh)) { 916 die("Can't write $test_file: $!"); 917 } 918 919 } else { 920 die("Can't open $test_file: $!"); 921 } 922 923 my $config = { 924 PidFile => $pid_file, 925 ScoreboardFile => $scoreboard_file, 926 SystemLog => $log_file, 927 TraceLog => $log_file, 928 Trace => 'sql:20 command:20 netio:20 response:20 ssh2:20 sftp:20', 929 930 AuthUserFile => $auth_user_file, 931 AuthGroupFile => $auth_group_file, 932 933 # This is used to tickle the "failed" transfer status 934 MaxRetrieveFileSize => '12 B', 935 936 IfModules => { 937 'mod_delay.c' => { 938 DelayEngine => 'off', 939 }, 940 941 'mod_sftp.c' => [ 942 "SFTPEngine on", 943 "SFTPLog $log_file", 944 "SFTPHostKey $rsa_host_key", 945 "SFTPHostKey $dsa_host_key", 946 ], 947 948 'mod_sql.c' => { 949 SQLEngine => 'log', 950 SQLBackend => 'sqlite3', 951 SQLConnectInfo => $db_file, 952 SQLLogFile => $log_file, 953 SQLNamedQuery => 'xfer_status FREEFORM "INSERT INTO ftpsessions (user, ip_addr, xfer_status, xfer_path) VALUES (\'%u\', \'%L\', \'%{transfer-status}\', \'%f\')"', 954 SQLLog => 'ERR_RETR,RETR xfer_status', 955 }, 956 }, 957 }; 958 959 my ($port, $config_user, $config_group) = config_write($config_file, $config); 960 961 # Open pipes, for use between the parent and child processes. Specifically, 962 # the child will indicate when it's done with its test by writing a message 963 # to the parent. 964 my ($rfh, $wfh); 965 unless (pipe($rfh, $wfh)) { 966 die("Can't open pipe: $!"); 967 } 968 969 require Net::SSH2; 970 971 my $ex; 972 973 # Fork child 974 $self->handle_sigchld(); 975 defined(my $pid = fork()) or die("Can't fork: $!"); 976 if ($pid) { 977 eval { 978 my $ssh2 = Net::SSH2->new(); 979 980 sleep(1); 981 982 unless ($ssh2->connect('127.0.0.1', $port)) { 983 my ($err_code, $err_name, $err_str) = $ssh2->error(); 984 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 985 } 986 987 unless ($ssh2->auth_password($user, $passwd)) { 988 my ($err_code, $err_name, $err_str) = $ssh2->error(); 989 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 990 } 991 992 my $sftp = $ssh2->sftp(); 993 unless ($sftp) { 994 my ($err_code, $err_name, $err_str) = $ssh2->error(); 995 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 996 } 997 998 my $fh = $sftp->open('test.txt', O_RDONLY); 999 unless ($fh) { 1000 my ($err_code, $err_name) = $sftp->error(); 1001 die("Can't open test.txt: [$err_name] ($err_code)"); 1002 } 1003 1004 # Explicitly close the channel before we have closed the file, to 1005 # simulate an "aborted" transfer. 1006 $sftp = undef; 1007 $ssh2->disconnect(); 1008 1009 # Give the server a little time to do its end-of-session thing. 1010 sleep(1); 1011 }; 1012 1013 if ($@) { 1014 $ex = $@; 1015 } 1016 1017 $wfh->print("done\n"); 1018 $wfh->flush(); 1019 1020 } else { 1021 eval { server_wait($config_file, $rfh) }; 1022 if ($@) { 1023 warn($@); 1024 exit 1; 1025 } 1026 1027 exit 0; 1028 } 1029 1030 # Stop server 1031 server_stop($pid_file); 1032 1033 $self->assert_child_ok($pid); 1034 1035 if ($ex) { 1036 test_append_logfile($log_file, $ex); 1037 unlink($log_file); 1038 1039 die($ex); 1040 } 1041 1042 my ($login, $ip_addr, $xfer_status, $xfer_path) = get_xfer_status($db_file, "user = \'$user\'"); 1043 1044 my $expected; 1045 1046 $expected = $user; 1047 $self->assert($expected eq $login, 1048 test_msg("Expected user '$expected', got '$login'")); 1049 1050 $expected = '127.0.0.1'; 1051 $self->assert($expected eq $ip_addr, 1052 test_msg("Expected IP address '$expected', got '$ip_addr'")); 1053 1054 $expected = 'failed'; 1055 $self->assert($expected eq $xfer_status, 1056 test_msg("Expected transfer status '$expected', got '$xfer_status'")); 1057 1058 if ($^O eq 'darwin') { 1059 # Mac OSX hack 1060 $test_file = '/private' . $test_file; 1061 } 1062 1063 $expected = $test_file; 1064 $self->assert($expected eq $xfer_path, 1065 test_msg("Expected file path '$expected', got '$xfer_path'")); 1066 1067 unlink($log_file); 1068} 1069 1070sub sftp_sql_sqllog_var_xfer_status_failed_upload { 1071 my $self = shift; 1072 my $tmpdir = $self->{tmpdir}; 1073 1074 my $config_file = "$tmpdir/sqlite.conf"; 1075 my $pid_file = File::Spec->rel2abs("$tmpdir/sqlite.pid"); 1076 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sqlite.scoreboard"); 1077 1078 my $log_file = test_get_logfile(); 1079 1080 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sqlite.passwd"); 1081 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sqlite.group"); 1082 1083 my $user = 'proftpd'; 1084 my $passwd = 'test'; 1085 my $group = 'ftpd'; 1086 my $home_dir = File::Spec->rel2abs($tmpdir); 1087 my $uid = 500; 1088 my $gid = 500; 1089 1090 # Make sure that, if we're running as root, that the home directory has 1091 # permissions/privs set for the account we create 1092 if ($< == 0) { 1093 unless (chmod(0755, $home_dir)) { 1094 die("Can't set perms on $home_dir to 0755: $!"); 1095 } 1096 1097 unless (chown($uid, $gid, $home_dir)) { 1098 die("Can't set owner of $home_dir to $uid/$gid: $!"); 1099 } 1100 } 1101 1102 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 1103 '/bin/bash'); 1104 auth_group_write($auth_group_file, $group, $gid, $user); 1105 1106 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 1107 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 1108 1109 my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db"); 1110 1111 # Build up sqlite3 command to create users, groups tables and populate them 1112 my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql"); 1113 1114 if (open(my $fh, "> $db_script")) { 1115 print $fh <<EOS; 1116CREATE TABLE ftpsessions ( 1117 user TEXT, 1118 ip_addr TEXT, 1119 xfer_status TEXT, 1120 xfer_path TEXT 1121); 1122EOS 1123 1124 unless (close($fh)) { 1125 die("Can't write $db_script: $!"); 1126 } 1127 1128 } else { 1129 die("Can't open $db_script: $!"); 1130 } 1131 1132 my $cmd = "sqlite3 $db_file < $db_script"; 1133 1134 if ($ENV{TEST_VERBOSE}) { 1135 print STDERR "Executing sqlite3: $cmd\n"; 1136 } 1137 1138 my @output = `$cmd`; 1139 if (scalar(@output) && 1140 $ENV{TEST_VERBOSE}) { 1141 print STDERR "Output: ", join('', @output), "\n"; 1142 } 1143 1144 # Make sure that, if we're running as root, the database file has 1145 # the permissions/privs set for use by proftpd 1146 if ($< == 0) { 1147 unless (chmod(0666, $db_file)) { 1148 die("Can't set perms on $db_file to 0666: $!"); 1149 } 1150 } 1151 1152 my $test_file = File::Spec->rel2abs("$tmpdir/test.txt"); 1153 if (open(my $fh, "> $test_file")) { 1154 print $fh >> "Hello, World! How are you doing?\n"; 1155 1156 unless (close($fh)) { 1157 die("Can't write $test_file: $!"); 1158 } 1159 1160 } else { 1161 die("Can't open $test_file: $!"); 1162 } 1163 1164 my $config = { 1165 PidFile => $pid_file, 1166 ScoreboardFile => $scoreboard_file, 1167 SystemLog => $log_file, 1168 TraceLog => $log_file, 1169 Trace => 'sql:20 command:20 netio:20 response:20 ssh2:20 sftp:20', 1170 1171 AuthUserFile => $auth_user_file, 1172 AuthGroupFile => $auth_group_file, 1173 1174 AllowOverwrite => 'on', 1175 AllowStoreRestart => 'on', 1176 1177 # This is used to tickle the "failed" transfer status 1178 MaxStoreFileSize => '12 B', 1179 1180 IfModules => { 1181 'mod_delay.c' => { 1182 DelayEngine => 'off', 1183 }, 1184 1185 'mod_sftp.c' => [ 1186 "SFTPEngine on", 1187 "SFTPLog $log_file", 1188 "SFTPHostKey $rsa_host_key", 1189 "SFTPHostKey $dsa_host_key", 1190 ], 1191 1192 'mod_sql.c' => { 1193 SQLEngine => 'log', 1194 SQLBackend => 'sqlite3', 1195 SQLConnectInfo => $db_file, 1196 SQLLogFile => $log_file, 1197 SQLNamedQuery => 'xfer_status FREEFORM "INSERT INTO ftpsessions (user, ip_addr, xfer_status, xfer_path) VALUES (\'%u\', \'%L\', \'%{transfer-status}\', \'%f\')"', 1198 SQLLog => 'ERR_APPE,ERR_STOR,APPE,STOR xfer_status', 1199 }, 1200 }, 1201 }; 1202 1203 my ($port, $config_user, $config_group) = config_write($config_file, $config); 1204 1205 # Open pipes, for use between the parent and child processes. Specifically, 1206 # the child will indicate when it's done with its test by writing a message 1207 # to the parent. 1208 my ($rfh, $wfh); 1209 unless (pipe($rfh, $wfh)) { 1210 die("Can't open pipe: $!"); 1211 } 1212 1213 require Net::SSH2; 1214 1215 my $ex; 1216 1217 # Fork child 1218 $self->handle_sigchld(); 1219 defined(my $pid = fork()) or die("Can't fork: $!"); 1220 if ($pid) { 1221 eval { 1222 my $ssh2 = Net::SSH2->new(); 1223 1224 sleep(1); 1225 1226 unless ($ssh2->connect('127.0.0.1', $port)) { 1227 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1228 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 1229 } 1230 1231 unless ($ssh2->auth_password($user, $passwd)) { 1232 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1233 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 1234 } 1235 1236 my $sftp = $ssh2->sftp(); 1237 unless ($sftp) { 1238 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1239 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 1240 } 1241 1242 my $fh = $sftp->open('test.txt', O_WRONLY|O_APPEND); 1243 unless ($fh) { 1244 my ($err_code, $err_name) = $sftp->error(); 1245 die("Can't open test.txt: [$err_name] ($err_code)"); 1246 } 1247 1248 my $buf = "ABCDefgh" x 16382; 1249 unless ($fh->write($buf)) { 1250 my ($err_code, $err_name) = $sftp->error(); 1251 if ($ENV{TEST_VERBOSE}) { 1252 print STDERR "# Expected error: can't write test.txt: [$err_name] ($err_code)\n"; 1253 } 1254 } 1255 1256 # Explicitly close the channel before we have closed the file, to 1257 # simulate an "aborted" transfer. 1258 $sftp = undef; 1259 $ssh2->disconnect(); 1260 1261 # Give the server a little time to do its end-of-session thing. 1262 sleep(1); 1263 }; 1264 if ($@) { 1265 $ex = $@; 1266 } 1267 1268 $wfh->print("done\n"); 1269 $wfh->flush(); 1270 1271 } else { 1272 eval { server_wait($config_file, $rfh) }; 1273 if ($@) { 1274 warn($@); 1275 exit 1; 1276 } 1277 1278 exit 0; 1279 } 1280 1281 # Stop server 1282 server_stop($pid_file); 1283 1284 $self->assert_child_ok($pid); 1285 1286 if ($ex) { 1287 test_append_logfile($log_file, $ex); 1288 unlink($log_file); 1289 1290 die($ex); 1291 } 1292 1293 my ($login, $ip_addr, $xfer_status, $xfer_path) = get_xfer_status($db_file, "user = \'$user\'"); 1294 1295 my $expected; 1296 1297 $expected = $user; 1298 $self->assert($expected eq $login, 1299 test_msg("Expected user '$expected', got '$login'")); 1300 1301 $expected = '127.0.0.1'; 1302 $self->assert($expected eq $ip_addr, 1303 test_msg("Expected IP address '$expected', got '$ip_addr'")); 1304 1305 $expected = 'failed'; 1306 $self->assert($expected eq $xfer_status, 1307 test_msg("Expected transfer status '$expected', got '$xfer_status'")); 1308 1309 if ($^O eq 'darwin') { 1310 # Mac OSX hack 1311 $test_file = '/private' . $test_file; 1312 } 1313 1314 $expected = $test_file; 1315 $self->assert($expected eq $xfer_path, 1316 test_msg("Expected file path '$expected', got '$xfer_path'")); 1317 1318 unlink($log_file); 1319} 1320 1321sub get_xfer_failure { 1322 my $db_file = shift; 1323 my $where = shift; 1324 1325 my $sql = "SELECT user, ip_addr, xfer_status, xfer_failure, xfer_path FROM ftpsessions"; 1326 if ($where) { 1327 $sql .= " WHERE $where"; 1328 } 1329 $sql .= " LIMIT 1"; 1330 1331 my $cmd = "sqlite3 $db_file \"$sql\""; 1332 1333 if ($ENV{TEST_VERBOSE}) { 1334 print STDERR "Executing sqlite3: $cmd\n"; 1335 } 1336 1337 my $res = join('', `$cmd`); 1338 chomp($res); 1339 1340 # The default sqlite3 delimiter is '|' 1341 return split(/\|/, $res); 1342} 1343 1344sub sftp_sql_sqllog_var_xfer_failure_none { 1345 my $self = shift; 1346 my $tmpdir = $self->{tmpdir}; 1347 1348 my $config_file = "$tmpdir/sqlite.conf"; 1349 my $pid_file = File::Spec->rel2abs("$tmpdir/sqlite.pid"); 1350 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/sqlite.scoreboard"); 1351 1352 my $log_file = test_get_logfile(); 1353 1354 my $auth_user_file = File::Spec->rel2abs("$tmpdir/sqlite.passwd"); 1355 my $auth_group_file = File::Spec->rel2abs("$tmpdir/sqlite.group"); 1356 1357 my $user = 'proftpd'; 1358 my $passwd = 'test'; 1359 my $group = 'ftpd'; 1360 my $home_dir = File::Spec->rel2abs($tmpdir); 1361 my $uid = 500; 1362 my $gid = 500; 1363 1364 # Make sure that, if we're running as root, that the home directory has 1365 # permissions/privs set for the account we create 1366 if ($< == 0) { 1367 unless (chmod(0755, $home_dir)) { 1368 die("Can't set perms on $home_dir to 0755: $!"); 1369 } 1370 1371 unless (chown($uid, $gid, $home_dir)) { 1372 die("Can't set owner of $home_dir to $uid/$gid: $!"); 1373 } 1374 } 1375 1376 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 1377 '/bin/bash'); 1378 auth_group_write($auth_group_file, $group, $gid, $user); 1379 1380 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 1381 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 1382 1383 my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db"); 1384 1385 # Build up sqlite3 command to create users, groups tables and populate them 1386 my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql"); 1387 1388 if (open(my $fh, "> $db_script")) { 1389 print $fh <<EOS; 1390CREATE TABLE ftpsessions ( 1391 user TEXT, 1392 ip_addr TEXT, 1393 xfer_status TEXT, 1394 xfer_failure TEXT, 1395 xfer_path TEXT 1396); 1397EOS 1398 1399 unless (close($fh)) { 1400 die("Can't write $db_script: $!"); 1401 } 1402 1403 } else { 1404 die("Can't open $db_script: $!"); 1405 } 1406 1407 my $cmd = "sqlite3 $db_file < $db_script"; 1408 1409 if ($ENV{TEST_VERBOSE}) { 1410 print STDERR "Executing sqlite3: $cmd\n"; 1411 } 1412 1413 my @output = `$cmd`; 1414 if (scalar(@output) && 1415 $ENV{TEST_VERBOSE}) { 1416 print STDERR "Output: ", join('', @output), "\n"; 1417 } 1418 1419 # Make sure that, if we're running as root, the database file has 1420 # the permissions/privs set for use by proftpd 1421 if ($< == 0) { 1422 unless (chmod(0666, $db_file)) { 1423 die("Can't set perms on $db_file to 0666: $!"); 1424 } 1425 } 1426 1427 my $test_file = File::Spec->rel2abs("$tmpdir/test.txt"); 1428 if (open(my $fh, "> $test_file")) { 1429 close($fh); 1430 1431 } else { 1432 die("Can't open $test_file: $!"); 1433 } 1434 1435 my $config = { 1436 PidFile => $pid_file, 1437 ScoreboardFile => $scoreboard_file, 1438 SystemLog => $log_file, 1439 TraceLog => $log_file, 1440 Trace => 'sql:20 command:20 netio:20 response:20 ssh2:20 sftp:20', 1441 1442 AuthUserFile => $auth_user_file, 1443 AuthGroupFile => $auth_group_file, 1444 1445 IfModules => { 1446 'mod_delay.c' => { 1447 DelayEngine => 'off', 1448 }, 1449 1450 'mod_sftp.c' => [ 1451 "SFTPEngine on", 1452 "SFTPLog $log_file", 1453 "SFTPHostKey $rsa_host_key", 1454 "SFTPHostKey $dsa_host_key", 1455 ], 1456 1457 'mod_sql.c' => { 1458 SQLEngine => 'log', 1459 SQLBackend => 'sqlite3', 1460 SQLConnectInfo => $db_file, 1461 SQLLogFile => $log_file, 1462 SQLNamedQuery => 'xfer_reason FREEFORM "INSERT INTO ftpsessions (user, ip_addr, xfer_status, xfer_failure, xfer_path) VALUES (\'%u\', \'%L\', \'%{transfer-status}\', \'%{transfer-failure}\', \'%f\')"', 1463 SQLLog => 'ERR_RETR,RETR xfer_reason', 1464 }, 1465 }, 1466 }; 1467 1468 my ($port, $config_user, $config_group) = config_write($config_file, $config); 1469 1470 # Open pipes, for use between the parent and child processes. Specifically, 1471 # the child will indicate when it's done with its test by writing a message 1472 # to the parent. 1473 my ($rfh, $wfh); 1474 unless (pipe($rfh, $wfh)) { 1475 die("Can't open pipe: $!"); 1476 } 1477 1478 require Net::SSH2; 1479 1480 my $ex; 1481 1482 # Fork child 1483 $self->handle_sigchld(); 1484 defined(my $pid = fork()) or die("Can't fork: $!"); 1485 if ($pid) { 1486 eval { 1487 my $ssh2 = Net::SSH2->new(); 1488 1489 sleep(1); 1490 1491 unless ($ssh2->connect('127.0.0.1', $port)) { 1492 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1493 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 1494 } 1495 1496 unless ($ssh2->auth_password($user, $passwd)) { 1497 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1498 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 1499 } 1500 1501 my $sftp = $ssh2->sftp(); 1502 unless ($sftp) { 1503 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1504 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 1505 } 1506 1507 my $fh = $sftp->open('test.txt', O_RDONLY); 1508 unless ($fh) { 1509 my ($err_code, $err_name) = $sftp->error(); 1510 die("Can't open test.txt: [$err_name] ($err_code)"); 1511 } 1512 1513 my $buf; 1514 1515 my $res = $fh->read($buf, 8192); 1516 while ($res) { 1517 $res = $fh->read($buf, 8192); 1518 } 1519 1520 # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle 1521 $fh = undef; 1522 1523 # To close the SFTP channel, we have to explicitly destroy the object 1524 $sftp = undef; 1525 1526 $ssh2->disconnect(); 1527 }; 1528 1529 if ($@) { 1530 $ex = $@; 1531 } 1532 1533 $wfh->print("done\n"); 1534 $wfh->flush(); 1535 1536 } else { 1537 eval { server_wait($config_file, $rfh) }; 1538 if ($@) { 1539 warn($@); 1540 exit 1; 1541 } 1542 1543 exit 0; 1544 } 1545 1546 # Stop server 1547 server_stop($pid_file); 1548 1549 $self->assert_child_ok($pid); 1550 1551 if ($ex) { 1552 test_append_logfile($log_file, $ex); 1553 unlink($log_file); 1554 1555 die($ex); 1556 } 1557 1558 my ($login, $ip_addr, $xfer_status, $xfer_failure, $xfer_path) = get_xfer_failure($db_file, "user = \'$user\'"); 1559 1560 my $expected; 1561 1562 $expected = $user; 1563 $self->assert($expected eq $login, 1564 test_msg("Expected user '$expected', got '$login'")); 1565 1566 $expected = '127.0.0.1'; 1567 $self->assert($expected eq $ip_addr, 1568 test_msg("Expected IP address '$expected', got '$ip_addr'")); 1569 1570 $expected = 'success'; 1571 $self->assert($expected eq $xfer_status, 1572 test_msg("Expected transfer status '$expected', got '$xfer_status'")); 1573 1574 $expected = '-'; 1575 $self->assert($expected eq $xfer_failure, 1576 test_msg("Expected transfer failure '$expected', got '$xfer_failure'")); 1577 1578 if ($^O eq 'darwin') { 1579 # Mac OSX hack 1580 $test_file = '/private' . $test_file; 1581 } 1582 1583 $expected = $test_file; 1584 $self->assert($expected eq $xfer_path, 1585 test_msg("Expected file path '$expected', got '$xfer_path'")); 1586 1587 unlink($log_file); 1588} 1589 1590sub get_auth_methods { 1591 my $db_file = shift; 1592 my $where = shift; 1593 1594 my $sql = "SELECT user, ip_addr, auth_method FROM sftpauth"; 1595 if ($where) { 1596 $sql .= " WHERE $where"; 1597 } 1598 $sql .= " LIMIT 1"; 1599 1600 my $cmd = "sqlite3 $db_file \"$sql\""; 1601 1602 if ($ENV{TEST_VERBOSE}) { 1603 print STDERR "Executing sqlite3: $cmd\n"; 1604 } 1605 1606 my $res = join('', `$cmd`); 1607 chomp($res); 1608 1609 # The default sqlite3 delimiter is '|' 1610 return split(/\|/, $res); 1611} 1612 1613sub sftp_sql_sqllog_var_userauth_method { 1614 my $self = shift; 1615 my $tmpdir = $self->{tmpdir}; 1616 my $setup = test_setup($tmpdir, 'sqlite'); 1617 1618 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 1619 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 1620 1621 my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db"); 1622 1623 # Build up sqlite3 command to create users, groups tables and populate them 1624 my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql"); 1625 1626 if (open(my $fh, "> $db_script")) { 1627 print $fh <<EOS; 1628CREATE TABLE sftpauth ( 1629 user TEXT, 1630 ip_addr TEXT, 1631 auth_method TEXT 1632); 1633EOS 1634 unless (close($fh)) { 1635 die("Can't write $db_script: $!"); 1636 } 1637 1638 } else { 1639 die("Can't open $db_script: $!"); 1640 } 1641 1642 my $cmd = "sqlite3 $db_file < $db_script"; 1643 1644 if ($ENV{TEST_VERBOSE}) { 1645 print STDERR "Executing sqlite3: $cmd\n"; 1646 } 1647 1648 my @output = `$cmd`; 1649 if (scalar(@output) && 1650 $ENV{TEST_VERBOSE}) { 1651 print STDERR "Output: ", join('', @output), "\n"; 1652 } 1653 1654 # Make sure that, if we're running as root, the database file has 1655 # the permissions/privs set for use by proftpd 1656 if ($< == 0) { 1657 unless (chmod(0666, $db_file)) { 1658 die("Can't set perms on $db_file to 0666: $!"); 1659 } 1660 } 1661 1662 my $config = { 1663 PidFile => $setup->{pid_file}, 1664 ScoreboardFile => $setup->{scoreboard_file}, 1665 SystemLog => $setup->{log_file}, 1666 TraceLog => $setup->{log_file}, 1667 Trace => 'sql:20 command:20 netio:20 response:20 ssh2:20 sftp:20', 1668 1669 AuthUserFile => $setup->{auth_user_file}, 1670 AuthGroupFile => $setup->{auth_group_file}, 1671 1672 IfModules => { 1673 'mod_delay.c' => { 1674 DelayEngine => 'off', 1675 }, 1676 1677 'mod_sftp.c' => [ 1678 "SFTPEngine on", 1679 "SFTPLog $setup->{log_file}", 1680 "SFTPHostKey $rsa_host_key", 1681 "SFTPHostKey $dsa_host_key", 1682 ], 1683 1684 'mod_sql.c' => { 1685 SQLEngine => 'log', 1686 SQLBackend => 'sqlite3', 1687 SQLConnectInfo => $db_file, 1688 SQLLogFile => $setup->{log_file}, 1689 SQLNamedQuery => 'auth_method FREEFORM "INSERT INTO sftpauth (user, ip_addr, auth_method) VALUES (\'%u\', \'%L\', \'%J\')"', 1690 SQLLog => 'ERR_USERAUTH_REQUEST,USERAUTH_REQUEST auth_method', 1691 }, 1692 }, 1693 }; 1694 1695 my ($port, $config_user, $config_group) = config_write($setup->{config_file}, 1696 $config); 1697 1698 # Open pipes, for use between the parent and child processes. Specifically, 1699 # the child will indicate when it's done with its test by writing a message 1700 # to the parent. 1701 my ($rfh, $wfh); 1702 unless (pipe($rfh, $wfh)) { 1703 die("Can't open pipe: $!"); 1704 } 1705 1706 require Net::SSH2; 1707 1708 my $ex; 1709 1710 # Fork child 1711 $self->handle_sigchld(); 1712 defined(my $pid = fork()) or die("Can't fork: $!"); 1713 if ($pid) { 1714 eval { 1715 my $ssh2 = Net::SSH2->new(); 1716 1717 sleep(1); 1718 1719 unless ($ssh2->connect('127.0.0.1', $port)) { 1720 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1721 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 1722 } 1723 1724 unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) { 1725 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1726 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 1727 } 1728 1729 my $sftp = $ssh2->sftp(); 1730 unless ($sftp) { 1731 my ($err_code, $err_name, $err_str) = $ssh2->error(); 1732 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 1733 } 1734 1735 # To close the SFTP channel, we have to explicitly destroy the object 1736 $sftp = undef; 1737 1738 $ssh2->disconnect(); 1739 }; 1740 if ($@) { 1741 $ex = $@; 1742 } 1743 1744 $wfh->print("done\n"); 1745 $wfh->flush(); 1746 1747 } else { 1748 eval { server_wait($setup->{config_file}, $rfh) }; 1749 if ($@) { 1750 warn($@); 1751 exit 1; 1752 } 1753 1754 exit 0; 1755 } 1756 1757 # Stop server 1758 server_stop($setup->{pid_file}); 1759 $self->assert_child_ok($pid); 1760 1761 if ($ex) { 1762 test_cleanup($setup->{log_file}, $ex); 1763 } 1764 1765 eval { 1766 my ($login, $ip_addr, $auth_method) = get_auth_methods($db_file, 1767 "user = \'$setup->{user}\'"); 1768 1769 my $expected = $setup->{user}; 1770 $self->assert($expected eq $login, 1771 "Expected user '$expected', got '$login'"); 1772 1773 $expected = '127.0.0.1'; 1774 $self->assert($expected eq $ip_addr, 1775 "Expected IP address '$expected', got '$ip_addr'"); 1776 1777 $expected = "$setup->{user} password"; 1778 $self->assert($expected eq $auth_method, 1779 "Expected method '$expected', got '$auth_method'"); 1780 }; 1781 if ($@) { 1782 $ex = $@; 1783 } 1784 1785 test_cleanup($setup->{log_file}, $ex); 1786} 1787 1788sub sftp_sql_sqllog_var_userauth_method_env_var { 1789 my $self = shift; 1790 my $tmpdir = $self->{tmpdir}; 1791 my $setup = test_setup($tmpdir, 'sqlite'); 1792 1793 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 1794 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 1795 1796 my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db"); 1797 1798 # Build up sqlite3 command to create users, groups tables and populate them 1799 my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql"); 1800 1801 if (open(my $fh, "> $db_script")) { 1802 print $fh <<EOS; 1803CREATE TABLE sftpauth ( 1804 user TEXT, 1805 ip_addr TEXT, 1806 auth_method TEXT 1807); 1808EOS 1809 unless (close($fh)) { 1810 die("Can't write $db_script: $!"); 1811 } 1812 1813 } else { 1814 die("Can't open $db_script: $!"); 1815 } 1816 1817 my $cmd = "sqlite3 $db_file < $db_script"; 1818 1819 if ($ENV{TEST_VERBOSE}) { 1820 print STDERR "Executing sqlite3: $cmd\n"; 1821 } 1822 1823 my @output = `$cmd`; 1824 if (scalar(@output) && 1825 $ENV{TEST_VERBOSE}) { 1826 print STDERR "Output: ", join('', @output), "\n"; 1827 } 1828 1829 # Make sure that, if we're running as root, the database file has 1830 # the permissions/privs set for use by proftpd 1831 if ($< == 0) { 1832 unless (chmod(0666, $db_file)) { 1833 die("Can't set perms on $db_file to 0666: $!"); 1834 } 1835 } 1836 1837 my $config = { 1838 PidFile => $setup->{pid_file}, 1839 ScoreboardFile => $setup->{scoreboard_file}, 1840 SystemLog => $setup->{log_file}, 1841 TraceLog => $setup->{log_file}, 1842 Trace => 'sql:20 command:20 netio:20 response:20 ssh2:20 sftp:20', 1843 1844 AuthUserFile => $setup->{auth_user_file}, 1845 AuthGroupFile => $setup->{auth_group_file}, 1846 1847 IfModules => { 1848 'mod_delay.c' => { 1849 DelayEngine => 'off', 1850 }, 1851 1852 'mod_sftp.c' => [ 1853 "SFTPEngine on", 1854 "SFTPLog $setup->{log_file}", 1855 "SFTPHostKey $rsa_host_key", 1856 "SFTPHostKey $dsa_host_key", 1857 ], 1858 1859 'mod_sql.c' => { 1860 SQLEngine => 'log', 1861 SQLBackend => 'sqlite3', 1862 SQLConnectInfo => $db_file, 1863 SQLLogFile => $setup->{log_file}, 1864 SQLNamedQuery => 'auth_method FREEFORM "INSERT INTO sftpauth (user, ip_addr, auth_method) VALUES (\'%u\', \'%L\', \'%{env:SFTP_USER_AUTH_METHOD}\')"', 1865 SQLLog => 'PASS auth_method', 1866 }, 1867 }, 1868 }; 1869 1870 my ($port, $config_user, $config_group) = config_write($setup->{config_file}, 1871 $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($setup->{user}, $setup->{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 # To close the SFTP channel, we have to explicitly destroy the object 1911 $sftp = undef; 1912 1913 $ssh2->disconnect(); 1914 }; 1915 if ($@) { 1916 $ex = $@; 1917 } 1918 1919 $wfh->print("done\n"); 1920 $wfh->flush(); 1921 1922 } else { 1923 eval { server_wait($setup->{config_file}, $rfh) }; 1924 if ($@) { 1925 warn($@); 1926 exit 1; 1927 } 1928 1929 exit 0; 1930 } 1931 1932 # Stop server 1933 server_stop($setup->{pid_file}); 1934 $self->assert_child_ok($pid); 1935 1936 if ($ex) { 1937 test_cleanup($setup->{log_file}, $ex); 1938 } 1939 1940 eval { 1941 my ($login, $ip_addr, $auth_method) = get_auth_methods($db_file, 1942 "user = \'$setup->{user}\'"); 1943 1944 my $expected = $setup->{user}; 1945 $self->assert($expected eq $login, 1946 "Expected user '$expected', got '$login'"); 1947 1948 $expected = '127.0.0.1'; 1949 $self->assert($expected eq $ip_addr, 1950 "Expected IP address '$expected', got '$ip_addr'"); 1951 1952 $expected = 'password'; 1953 $self->assert($expected eq $auth_method, 1954 "Expected method '$expected', got '$auth_method'"); 1955 }; 1956 if ($@) { 1957 $ex = $@; 1958 } 1959 1960 test_cleanup($setup->{log_file}, $ex); 1961} 1962 1963sub get_upload_paths { 1964 my $db_file = shift; 1965 my $where = shift; 1966 1967 my $sql = "SELECT user, ip_addr, path FROM sftplog"; 1968 if ($where) { 1969 $sql .= " WHERE $where"; 1970 } 1971 $sql .= " LIMIT 1"; 1972 1973 my $cmd = "sqlite3 $db_file \"$sql\""; 1974 1975 if ($ENV{TEST_VERBOSE}) { 1976 print STDERR "Executing sqlite3: $cmd\n"; 1977 } 1978 1979 my $res = join('', `$cmd`); 1980 chomp($res); 1981 1982 # The default sqlite3 delimiter is '|' 1983 return split(/\|/, $res); 1984} 1985 1986sub sftp_sql_sqllog_var_xfer_path_uploads_bug4382 { 1987 my $self = shift; 1988 my $tmpdir = $self->{tmpdir}; 1989 my $setup = test_setup($tmpdir, 'sqlite'); 1990 1991 my $expected_path = 'test.txt'; 1992 1993 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 1994 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 1995 1996 my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db"); 1997 1998 # Build up sqlite3 command to create users, groups tables and populate them 1999 my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql"); 2000 2001 if (open(my $fh, "> $db_script")) { 2002 print $fh <<EOS; 2003CREATE TABLE sftplog ( 2004 user TEXT, 2005 ip_addr TEXT, 2006 path TEXT 2007); 2008EOS 2009 unless (close($fh)) { 2010 die("Can't write $db_script: $!"); 2011 } 2012 2013 } else { 2014 die("Can't open $db_script: $!"); 2015 } 2016 2017 my $cmd = "sqlite3 $db_file < $db_script"; 2018 2019 if ($ENV{TEST_VERBOSE}) { 2020 print STDERR "Executing sqlite3: $cmd\n"; 2021 } 2022 2023 my @output = `$cmd`; 2024 if (scalar(@output) && 2025 $ENV{TEST_VERBOSE}) { 2026 print STDERR "Output: ", join('', @output), "\n"; 2027 } 2028 2029 # Make sure that, if we're running as root, the database file has 2030 # the permissions/privs set for use by proftpd 2031 if ($< == 0) { 2032 unless (chmod(0666, $db_file)) { 2033 die("Can't set perms on $db_file to 0666: $!"); 2034 } 2035 } 2036 2037 my $config = { 2038 PidFile => $setup->{pid_file}, 2039 ScoreboardFile => $setup->{scoreboard_file}, 2040 SystemLog => $setup->{log_file}, 2041 TraceLog => $setup->{log_file}, 2042 Trace => 'sql:20 command:20 jot:20 netio:20 response:20 ssh2:20 sftp:20', 2043 2044 AuthUserFile => $setup->{auth_user_file}, 2045 AuthGroupFile => $setup->{auth_group_file}, 2046 DefaultRoot => '~', 2047 2048 IfModules => { 2049 'mod_delay.c' => { 2050 DelayEngine => 'off', 2051 }, 2052 2053 'mod_sftp.c' => [ 2054 "SFTPEngine on", 2055 "SFTPLog $setup->{log_file}", 2056 "SFTPHostKey $rsa_host_key", 2057 "SFTPHostKey $dsa_host_key", 2058 ], 2059 2060 'mod_sql.c' => { 2061 SQLEngine => 'log', 2062 SQLBackend => 'sqlite3', 2063 SQLConnectInfo => "$db_file foo bar PERCONNECTION", 2064 SQLLogFile => $setup->{log_file}, 2065 SQLNamedQuery => 'sftp_upload FREEFORM "INSERT INTO sftplog (user, ip_addr, path) VALUES (\'%u\', \'%L\', \'%F\')"', 2066 SQLLog => 'STOR sftp_upload', 2067 }, 2068 }, 2069 }; 2070 2071 my ($port, $config_user, $config_group) = config_write($setup->{config_file}, 2072 $config); 2073 2074 # Open pipes, for use between the parent and child processes. Specifically, 2075 # the child will indicate when it's done with its test by writing a message 2076 # to the parent. 2077 my ($rfh, $wfh); 2078 unless (pipe($rfh, $wfh)) { 2079 die("Can't open pipe: $!"); 2080 } 2081 2082 require Net::SSH2; 2083 2084 my $ex; 2085 2086 # Fork child 2087 $self->handle_sigchld(); 2088 defined(my $pid = fork()) or die("Can't fork: $!"); 2089 if ($pid) { 2090 eval { 2091 my $ssh2 = Net::SSH2->new(); 2092 2093 sleep(1); 2094 2095 unless ($ssh2->connect('127.0.0.1', $port)) { 2096 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2097 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 2098 } 2099 2100 unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) { 2101 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2102 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 2103 } 2104 2105 my $sftp = $ssh2->sftp(); 2106 unless ($sftp) { 2107 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2108 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 2109 } 2110 2111 my $fh = $sftp->open('test.txt', O_CREAT|O_WRONLY); 2112 unless ($fh) { 2113 my ($err_code, $err_name) = $sftp->error(); 2114 die("Can't open test.txt: [$err_name] ($err_code)"); 2115 } 2116 2117 my $buf = "Hello, World!\n"; 2118 my $res= $fh->write($buf); 2119 2120 # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle 2121 $fh = undef; 2122 2123 # To close the SFTP channel, we have to explicitly destroy the object 2124 $sftp = undef; 2125 2126 $ssh2->disconnect(); 2127 }; 2128 if ($@) { 2129 $ex = $@; 2130 } 2131 2132 $wfh->print("done\n"); 2133 $wfh->flush(); 2134 2135 } else { 2136 eval { server_wait($setup->{config_file}, $rfh) }; 2137 if ($@) { 2138 warn($@); 2139 exit 1; 2140 } 2141 2142 exit 0; 2143 } 2144 2145 # Stop server 2146 server_stop($setup->{pid_file}); 2147 $self->assert_child_ok($pid); 2148 2149 if ($ex) { 2150 test_cleanup($setup->{log_file}, $ex); 2151 } 2152 2153 eval { 2154 my ($login, $ip_addr, $path) = get_upload_paths($db_file, 2155 "user = \'$setup->{user}\'"); 2156 2157 my $expected = $setup->{user}; 2158 $self->assert($expected eq $login, 2159 "Expected user '$expected', got '$login'"); 2160 2161 $expected = '127.0.0.1'; 2162 $self->assert($expected eq $ip_addr, 2163 "Expected IP address '$expected', got '$ip_addr'"); 2164 2165 $expected = $expected_path; 2166 $self->assert($expected eq $path, 2167 "Expected path '$expected', got '$path'"); 2168 }; 2169 if ($@) { 2170 $ex = $@; 2171 } 2172 2173 test_cleanup($setup->{log_file}, $ex); 2174} 2175 2176sub sftp_sql_sqllog_var_filename_uploads_bug4382 { 2177 my $self = shift; 2178 my $tmpdir = $self->{tmpdir}; 2179 my $setup = test_setup($tmpdir, 'sqlite'); 2180 2181 my $expected_path = File::Spec->rel2abs("$tmpdir/test.txt"); 2182 2183 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 2184 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 2185 2186 my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db"); 2187 2188 # Build up sqlite3 command to create users, groups tables and populate them 2189 my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql"); 2190 2191 if (open(my $fh, "> $db_script")) { 2192 print $fh <<EOS; 2193CREATE TABLE sftplog ( 2194 user TEXT, 2195 ip_addr TEXT, 2196 path TEXT 2197); 2198EOS 2199 unless (close($fh)) { 2200 die("Can't write $db_script: $!"); 2201 } 2202 2203 } else { 2204 die("Can't open $db_script: $!"); 2205 } 2206 2207 my $cmd = "sqlite3 $db_file < $db_script"; 2208 2209 if ($ENV{TEST_VERBOSE}) { 2210 print STDERR "Executing sqlite3: $cmd\n"; 2211 } 2212 2213 my @output = `$cmd`; 2214 if (scalar(@output) && 2215 $ENV{TEST_VERBOSE}) { 2216 print STDERR "Output: ", join('', @output), "\n"; 2217 } 2218 2219 # Make sure that, if we're running as root, the database file has 2220 # the permissions/privs set for use by proftpd 2221 if ($< == 0) { 2222 unless (chmod(0666, $db_file)) { 2223 die("Can't set perms on $db_file to 0666: $!"); 2224 } 2225 } 2226 2227 my $config = { 2228 PidFile => $setup->{pid_file}, 2229 ScoreboardFile => $setup->{scoreboard_file}, 2230 SystemLog => $setup->{log_file}, 2231 TraceLog => $setup->{log_file}, 2232 Trace => 'sql:20 command:20 jot:20 netio:20 response:20 ssh2:20 sftp:20', 2233 2234 AuthUserFile => $setup->{auth_user_file}, 2235 AuthGroupFile => $setup->{auth_group_file}, 2236 DefaultRoot => '~', 2237 2238 IfModules => { 2239 'mod_delay.c' => { 2240 DelayEngine => 'off', 2241 }, 2242 2243 'mod_sftp.c' => [ 2244 "SFTPEngine on", 2245 "SFTPLog $setup->{log_file}", 2246 "SFTPHostKey $rsa_host_key", 2247 "SFTPHostKey $dsa_host_key", 2248 ], 2249 2250 'mod_sql.c' => { 2251 SQLEngine => 'log', 2252 SQLBackend => 'sqlite3', 2253 SQLConnectInfo => "$db_file foo bar PERCONNECTION", 2254 SQLLogFile => $setup->{log_file}, 2255 SQLNamedQuery => 'sftp_upload FREEFORM "INSERT INTO sftplog (user, ip_addr, path) VALUES (\'%u\', \'%L\', \'%f\')"', 2256 SQLLog => 'STOR sftp_upload', 2257 }, 2258 }, 2259 }; 2260 2261 my ($port, $config_user, $config_group) = config_write($setup->{config_file}, 2262 $config); 2263 2264 # Open pipes, for use between the parent and child processes. Specifically, 2265 # the child will indicate when it's done with its test by writing a message 2266 # to the parent. 2267 my ($rfh, $wfh); 2268 unless (pipe($rfh, $wfh)) { 2269 die("Can't open pipe: $!"); 2270 } 2271 2272 require Net::SSH2; 2273 2274 my $ex; 2275 2276 # Fork child 2277 $self->handle_sigchld(); 2278 defined(my $pid = fork()) or die("Can't fork: $!"); 2279 if ($pid) { 2280 eval { 2281 my $ssh2 = Net::SSH2->new(); 2282 2283 sleep(1); 2284 2285 unless ($ssh2->connect('127.0.0.1', $port)) { 2286 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2287 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 2288 } 2289 2290 unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) { 2291 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2292 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 2293 } 2294 2295 my $sftp = $ssh2->sftp(); 2296 unless ($sftp) { 2297 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2298 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 2299 } 2300 2301 my $fh = $sftp->open('test.txt', O_CREAT|O_WRONLY); 2302 unless ($fh) { 2303 my ($err_code, $err_name) = $sftp->error(); 2304 die("Can't open test.txt: [$err_name] ($err_code)"); 2305 } 2306 2307 my $buf = "Hello, World!\n"; 2308 my $res= $fh->write($buf); 2309 2310 # To issue the FXP_CLOSE, we have to explicitly destroy the filehandle 2311 $fh = undef; 2312 2313 # To close the SFTP channel, we have to explicitly destroy the object 2314 $sftp = undef; 2315 2316 $ssh2->disconnect(); 2317 }; 2318 if ($@) { 2319 $ex = $@; 2320 } 2321 2322 $wfh->print("done\n"); 2323 $wfh->flush(); 2324 2325 } else { 2326 eval { server_wait($setup->{config_file}, $rfh) }; 2327 if ($@) { 2328 warn($@); 2329 exit 1; 2330 } 2331 2332 exit 0; 2333 } 2334 2335 # Stop server 2336 server_stop($setup->{pid_file}); 2337 $self->assert_child_ok($pid); 2338 2339 if ($ex) { 2340 test_cleanup($setup->{log_file}, $ex); 2341 } 2342 2343 eval { 2344 my ($login, $ip_addr, $path) = get_upload_paths($db_file, 2345 "user = \'$setup->{user}\'"); 2346 2347 my $expected = $setup->{user}; 2348 $self->assert($expected eq $login, 2349 "Expected user '$expected', got '$login'"); 2350 2351 $expected = '127.0.0.1'; 2352 $self->assert($expected eq $ip_addr, 2353 "Expected IP address '$expected', got '$ip_addr'"); 2354 2355 if ($^O eq 'darwin') { 2356 # MacOSX-specific hack 2357 $expected_path = '/private' . $expected_path; 2358 } 2359 2360 $expected = $expected_path; 2361 $self->assert($expected eq $path, 2362 "Expected path '$expected', got '$path'"); 2363 }; 2364 if ($@) { 2365 $ex = $@; 2366 } 2367 2368 test_cleanup($setup->{log_file}, $ex); 2369} 2370 2371sub sftp_sql_env_var_issue857 { 2372 my $self = shift; 2373 my $tmpdir = $self->{tmpdir}; 2374 my $setup = test_setup($tmpdir, 'sqlite'); 2375 2376 my $rsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_rsa_key'); 2377 my $dsa_host_key = File::Spec->rel2abs('t/etc/modules/mod_sftp/ssh_host_dsa_key'); 2378 2379 my $db_file = File::Spec->rel2abs("$tmpdir/proftpd.db"); 2380 2381 # Build up sqlite3 command to create users, groups tables and populate them 2382 my $db_script = File::Spec->rel2abs("$tmpdir/proftpd.sql"); 2383 2384 if (open(my $fh, "> $db_script")) { 2385 print $fh <<EOS; 2386CREATE TABLE sftpauth ( 2387 user TEXT, 2388 ip_addr TEXT, 2389 auth_method TEXT 2390); 2391EOS 2392 unless (close($fh)) { 2393 die("Can't write $db_script: $!"); 2394 } 2395 2396 } else { 2397 die("Can't open $db_script: $!"); 2398 } 2399 2400 my $cmd = "sqlite3 $db_file < $db_script"; 2401 2402 if ($ENV{TEST_VERBOSE}) { 2403 print STDERR "Executing sqlite3: $cmd\n"; 2404 } 2405 2406 my @output = `$cmd`; 2407 if (scalar(@output) && 2408 $ENV{TEST_VERBOSE}) { 2409 print STDERR "Output: ", join('', @output), "\n"; 2410 } 2411 2412 # Make sure that, if we're running as root, the database file has 2413 # the permissions/privs set for use by proftpd 2414 if ($< == 0) { 2415 unless (chmod(0666, $db_file)) { 2416 die("Can't set perms on $db_file to 0666: $!"); 2417 } 2418 } 2419 2420 my $config = { 2421 PidFile => $setup->{pid_file}, 2422 ScoreboardFile => $setup->{scoreboard_file}, 2423 SystemLog => $setup->{log_file}, 2424 TraceLog => $setup->{log_file}, 2425 Trace => 'sql:20 command:20 config:20 netio:20 response:20 ssh2:20 sftp:20', 2426 2427 AuthUserFile => $setup->{auth_user_file}, 2428 AuthGroupFile => $setup->{auth_group_file}, 2429 2430 IfModules => { 2431 'mod_delay.c' => { 2432 DelayEngine => 'off', 2433 }, 2434 2435 'mod_sftp.c' => [ 2436 "SFTPEngine on", 2437 "SFTPLog $setup->{log_file}", 2438 "SFTPHostKey $rsa_host_key", 2439 "SFTPHostKey $dsa_host_key", 2440 ], 2441 2442 'mod_sql.c' => { 2443 SQLLogFile => $setup->{log_file}, 2444 SQLNamedQuery => 'auth_method FREEFORM "INSERT INTO sftpauth (user, ip_addr, auth_method) VALUES (\'%u\', \'%L\', \'%{env:SFTP_USER_AUTH_METHOD}\')"', 2445 SQLLog => 'PASS auth_method', 2446 }, 2447 }, 2448 2449 Global => { 2450 AuthOrder => 'mod_auth_file.c', 2451 SQLBackend => 'sqlite3', 2452 SQLEngine => 'log', 2453 SQLConnectInfo => "%{env:PR_ENV_DB_INFO} %{env:PR_ENV_DB_USERNAME} %{env:PR_ENV_DB_PASSWORD} %{env:PR_ENV_DB_POLICY}" 2454 }, 2455 }; 2456 2457 my ($port, $config_user, $config_group) = config_write($setup->{config_file}, 2458 $config); 2459 2460 # Open pipes, for use between the parent and child processes. Specifically, 2461 # the child will indicate when it's done with its test by writing a message 2462 # to the parent. 2463 my ($rfh, $wfh); 2464 unless (pipe($rfh, $wfh)) { 2465 die("Can't open pipe: $!"); 2466 } 2467 require Net::SSH2; 2468 2469 my $ex; 2470 2471 # Set the required environment variables 2472 $ENV{PR_ENV_DB_INFO} = $db_file; 2473 $ENV{PR_ENV_DB_USERNAME} = 'foo'; 2474 $ENV{PR_ENV_DB_PASSWORD} = 'bar'; 2475 $ENV{PR_ENV_DB_POLICY} = 'PERCONNECTION'; 2476 2477 # Fork child 2478 $self->handle_sigchld(); 2479 defined(my $pid = fork()) or die("Can't fork: $!"); 2480 if ($pid) { 2481 eval { 2482 my $ssh2 = Net::SSH2->new(); 2483 sleep(1); 2484 2485 unless ($ssh2->connect('127.0.0.1', $port)) { 2486 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2487 die("Can't connect to SSH2 server: [$err_name] ($err_code) $err_str"); 2488 } 2489 2490 unless ($ssh2->auth_password($setup->{user}, $setup->{passwd})) { 2491 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2492 die("Can't login to SSH2 server: [$err_name] ($err_code) $err_str"); 2493 } 2494 2495 my $sftp = $ssh2->sftp(); 2496 unless ($sftp) { 2497 my ($err_code, $err_name, $err_str) = $ssh2->error(); 2498 die("Can't use SFTP on SSH2 server: [$err_name] ($err_code) $err_str"); 2499 } 2500 2501 # To close the SFTP channel, we have to explicitly destroy the object 2502 $sftp = undef; 2503 2504 $ssh2->disconnect(); 2505 }; 2506 if ($@) { 2507 $ex = $@; 2508 } 2509 2510 $wfh->print("done\n"); 2511 $wfh->flush(); 2512 2513 } else { 2514 eval { server_wait($setup->{config_file}, $rfh) }; 2515 if ($@) { 2516 warn($@); 2517 exit 1; 2518 } 2519 2520 exit 0; 2521 } 2522 2523 # Stop server 2524 server_stop($setup->{pid_file}); 2525 $self->assert_child_ok($pid); 2526 2527 if ($ex) { 2528 test_cleanup($setup->{log_file}, $ex); 2529 } 2530 2531 eval { 2532 my ($login, $ip_addr, $auth_method) = get_auth_methods($db_file, 2533 "user = \'$setup->{user}\'"); 2534 2535 my $expected = $setup->{user}; 2536 $self->assert($expected eq $login, 2537 "Expected user '$expected', got '$login'"); 2538 2539 $expected = '127.0.0.1'; 2540 $self->assert($expected eq $ip_addr, 2541 "Expected IP address '$expected', got '$ip_addr'"); 2542 2543 $expected = 'password'; 2544 $self->assert($expected eq $auth_method, 2545 "Expected method '$expected', got '$auth_method'"); 2546 }; 2547 if ($@) { 2548 $ex = $@; 2549 } 2550 2551 test_cleanup($setup->{log_file}, $ex); 2552} 2553 25541; 2555