1package ProFTPD::Tests::Modules::mod_tls_memcache; 2 3use lib qw(t/lib); 4use base qw(ProFTPD::TestSuite::Child); 5use strict; 6 7use Cache::Memcached; 8use Carp; 9use File::Spec; 10use IO::Handle; 11use IPC::Open3; 12use Socket; 13 14use ProFTPD::TestSuite::FTP; 15use ProFTPD::TestSuite::Utils qw(:auth :config :running :test :testsuite); 16 17$| = 1; 18 19my $order = 0; 20 21my $TESTS = { 22 tls_sess_cache_memcache => { 23 order => ++$order, 24 test_class => [qw(forking)], 25 }, 26 27 tls_sess_cache_memcache_json_bug4057 => { 28 order => ++$order, 29 test_class => [qw(bug forking)], 30 }, 31 32 tls_stapling_on_memcache_bug4175 => { 33 order => ++$order, 34 test_class => [qw(bug forking)], 35 }, 36 37}; 38 39sub new { 40 return shift()->SUPER::new(@_); 41} 42 43sub set_up { 44 my $self = shift; 45 $self->SUPER::set_up(@_); 46 47 # Clear the memcached servers before each unit test 48 my $memcached_servers = $ENV{MEMCACHED_SERVERS} ? $ENV{MEMCACHED_SERVERS} : "127.0.0.1:11211"; 49 $memcached_servers = [split(/,?\s+?/, $memcached_servers)]; 50 51 my $mc = Cache::Memcached->new({ 52 servers => $memcached_servers, 53 debug => 0, 54 }); 55 56 # First, make sure that a memcached is running 57 my $stats = $mc->stats('misc'); 58 unless ($stats) { 59 die("Can't obtain stats from memached servers '$memcached_servers'"); 60 } 61 62 $mc->flush_all(); 63 $mc->disconnect_all(); 64} 65 66sub list_tests { 67 # Check for the required Perl modules: 68 # 69 # Net-SSLeay 70 # IO-Socket-SSL 71 # Net-FTPSSL 72 73 my $required = [qw( 74 Net::SSLeay 75 IO::Socket::SSL 76 Net::FTPSSL 77 )]; 78 79 foreach my $req (@$required) { 80 eval "use $req"; 81 if ($@) { 82 print STDERR "\nWARNING:\n + Module '$req' not found, skipping all tests\n"; 83 84 if ($ENV{TEST_VERBOSE}) { 85 print STDERR "Unable to load $req: $@\n"; 86 } 87 88 return qw(testsuite_empty_test); 89 } 90 } 91 92 return testsuite_get_runnable_tests($TESTS); 93} 94 95sub tls_sess_cache_memcache { 96 my $self = shift; 97 my $tmpdir = $self->{tmpdir}; 98 my $setup = test_setup($tmpdir, 'tls_memcache'); 99 100 my $memcached_servers = $ENV{MEMCACHED_SERVERS} ? $ENV{MEMCACHED_SERVERS} : '127.0.0.1:11211'; 101 102 my $cert_file = File::Spec->rel2abs('t/etc/modules/mod_tls/server-cert.pem'); 103 my $ca_file = File::Spec->rel2abs('t/etc/modules/mod_tls/ca-cert.pem'); 104 105 my $sessid_file = File::Spec->rel2abs("$tmpdir/sessid.pem"); 106 107 my $config = { 108 PidFile => $setup->{pid_file}, 109 ScoreboardFile => $setup->{scoreboard_file}, 110 SystemLog => $setup->{log_file}, 111 TraceLog => $setup->{log_file}, 112 Trace => 'tls:20 memcache:30 tls.memcache:20', 113 114 AuthUserFile => $setup->{auth_user_file}, 115 AuthGroupFile => $setup->{auth_group_file}, 116 117 IfModules => { 118 'mod_delay.c' => { 119 DelayEngine => 'off', 120 }, 121 122 'mod_memcache.c' => { 123 MemcacheEngine => 'on', 124 MemcacheLog => $setup->{log_file}, 125 MemcacheServers => $memcached_servers, 126 }, 127 128 'mod_tls.c' => { 129 TLSEngine => 'on', 130 TLSLog => $setup->{log_file}, 131 TLSRequired => 'on', 132 TLSRSACertificateFile => $cert_file, 133 TLSCACertificateFile => $ca_file, 134 TLSVerifyClient => 'off', 135 TLSOptions => 'EnableDiags', 136 }, 137 138 'mod_tls_memcache.c' => { 139 TLSSessionCache => 'memcache:', 140 }, 141 }, 142 }; 143 144 my ($port, $config_user, $config_group) = config_write($setup->{config_file}, 145 $config); 146 147 # Open pipes, for use between the parent and child processes. Specifically, 148 # the child will indicate when it's done with its test by writing a message 149 # to the parent. 150 my ($rfh, $wfh); 151 unless (pipe($rfh, $wfh)) { 152 die("Can't open pipe: $!"); 153 } 154 155 my $ex; 156 157 # Fork child 158 $self->handle_sigchld(); 159 defined(my $pid = fork()) or die("Can't fork: $!"); 160 if ($pid) { 161 eval { 162 # Give the server a chance to start up 163 sleep(2); 164 165 # To test SSL session resumption, we use the command-line 166 # openssl s_client tool, rather than any Perl module. 167 168 # XXX Some OpenSSL versions' of s_client do not support the 'ftp' 169 # parameter for -starttls; in this case, point the openssl binary 170 # to be used to a version which does support this. 171# my $openssl = 'openssl'; 172my $openssl = '/Users/tj/local/openssl-1.0.2d/bin/openssl'; 173 174 my @cmd = ( 175 $openssl, 176 's_client', 177 '-connect', 178 "127.0.0.1:$port", 179 '-starttls', 180 'ftp', 181 '-sess_out', 182 $sessid_file, 183 ); 184 185 my $tls_rh = IO::Handle->new(); 186 my $tls_wh = IO::Handle->new(); 187 my $tls_eh = IO::Handle->new(); 188 189 $tls_wh->autoflush(1); 190 191 local $SIG{CHLD} = 'DEFAULT'; 192 193 if ($ENV{TEST_VERBOSE}) { 194 print STDERR "Executing: ", join(' ', @cmd), "\n"; 195 } 196 197 my $tls_pid = open3($tls_wh, $tls_rh, $tls_eh, @cmd); 198 print $tls_wh "QUIT\r\n"; 199 waitpid($tls_pid, 0); 200 201 my ($res, $cipher_str, $err_str, $out_str); 202 if ($? >> 8) { 203 $err_str = join('', <$tls_eh>); 204 $res = 0; 205 206 } else { 207 my $output = [<$tls_rh>]; 208 209 # Specifically look for the line containing 'Cipher is' 210 foreach my $line (@$output) { 211 if ($line =~ /Cipher is/) { 212 $cipher_str = $line; 213 chomp($cipher_str); 214 } 215 } 216 217 if ($ENV{TEST_VERBOSE}) { 218 $out_str = join('', @$output); 219 print STDERR "Stdout: $out_str\n"; 220 } 221 222 if ($ENV{TEST_VERBOSE}) { 223 $err_str = join('', <$tls_eh>); 224 print STDERR "Stderr: $err_str\n"; 225 } 226 227 $res = 1; 228 } 229 230 unless ($res) { 231 die("Can't talk to server: $err_str"); 232 } 233 234 my $expected = '^New'; 235 $self->assert(qr/$expected/, $cipher_str, 236 test_msg("Expected '$expected', got '$cipher_str'")); 237 238 @cmd = ( 239 $openssl, 240 's_client', 241 '-connect', 242 "127.0.0.1:$port", 243 '-starttls', 244 'ftp', 245 '-sess_in', 246 $sessid_file, 247 ); 248 249 $tls_rh = IO::Handle->new(); 250 $tls_wh = IO::Handle->new(); 251 $tls_eh = IO::Handle->new(); 252 253 $tls_wh->autoflush(1); 254 255 if ($ENV{TEST_VERBOSE}) { 256 print STDERR "Executing: ", join(' ', @cmd), "\n"; 257 } 258 259 $tls_pid = open3($tls_wh, $tls_rh, $tls_eh, @cmd); 260 print $tls_wh "QUIT\r\n"; 261 waitpid($tls_pid, 0); 262 263 $res = 0; 264 $cipher_str = undef; 265 $err_str = undef; 266 $out_str = undef; 267 268 if ($? >> 8) { 269 $err_str = join('', <$tls_eh>); 270 $res = 0; 271 272 } else { 273 my $output = [<$tls_rh>]; 274 275 # Specifically look for the line containing 'Cipher is' 276 foreach my $line (@$output) { 277 if ($line =~ /Cipher is/) { 278 $cipher_str = $line; 279 chomp($cipher_str); 280 } 281 } 282 283 if ($ENV{TEST_VERBOSE}) { 284 $out_str = join('', @$output); 285 print STDERR "Stdout: $out_str\n"; 286 } 287 288 if ($ENV{TEST_VERBOSE}) { 289 $err_str = join('', <$tls_eh>); 290 print STDERR "Stderr: $err_str\n"; 291 } 292 293 $res = 1; 294 } 295 296 unless ($res) { 297 die("Can't talk to server: $err_str"); 298 } 299 300 $expected = '^Reused'; 301 $self->assert(qr/$expected/, $cipher_str, 302 test_msg("Expected '$expected', got '$cipher_str'")); 303 }; 304 305 if ($@) { 306 $ex = $@; 307 } 308 309 $wfh->print("done\n"); 310 $wfh->flush(); 311 312 } else { 313 eval { server_wait($setup->{config_file}, $rfh, 45) }; 314 if ($@) { 315 warn($@); 316 exit 1; 317 } 318 319 exit 0; 320 } 321 322 # Stop server 323 server_stop($setup->{pid_file}); 324 325 $self->assert_child_ok($pid); 326 327 test_cleanup($setup->{log_file}, $ex); 328} 329 330sub tls_sess_cache_memcache_json_bug4057 { 331 my $self = shift; 332 my $tmpdir = $self->{tmpdir}; 333 my $setup = test_setup($tmpdir, 'tls_memcache'); 334 335 my $memcached_servers = $ENV{MEMCACHED_SERVERS} ? $ENV{MEMCACHED_SERVERS} : '127.0.0.1:11211'; 336 337 my $cert_file = File::Spec->rel2abs('t/etc/modules/mod_tls/server-cert.pem'); 338 my $ca_file = File::Spec->rel2abs('t/etc/modules/mod_tls/ca-cert.pem'); 339 340 my $sessid_file = File::Spec->rel2abs("$tmpdir/sessid.pem"); 341 342 my $config = { 343 PidFile => $setup->{pid_file}, 344 ScoreboardFile => $setup->{scoreboard_file}, 345 SystemLog => $setup->{log_file}, 346 TraceLog => $setup->{log_file}, 347 Trace => 'tls:20 memcache:30 tls.memcache:20', 348 349 AuthUserFile => $setup->{auth_user_file}, 350 AuthGroupFile => $setup->{auth_group_file}, 351 352 IfModules => { 353 'mod_delay.c' => { 354 DelayEngine => 'off', 355 }, 356 357 'mod_memcache.c' => { 358 MemcacheEngine => 'on', 359 MemcacheLog => $setup->{log_file}, 360 MemcacheServers => $memcached_servers, 361 }, 362 363 'mod_tls.c' => { 364 TLSEngine => 'on', 365 TLSLog => $setup->{log_file}, 366 TLSRequired => 'on', 367 TLSRSACertificateFile => $cert_file, 368 TLSCACertificateFile => $ca_file, 369 TLSVerifyClient => 'off', 370 TLSOptions => 'EnableDiags', 371 }, 372 373 'mod_tls_memcache.c' => { 374 TLSSessionCache => 'memcache:/json', 375 }, 376 }, 377 }; 378 379 my ($port, $config_user, $config_group) = config_write($setup->{config_file}, 380 $config); 381 382 # Open pipes, for use between the parent and child processes. Specifically, 383 # the child will indicate when it's done with its test by writing a message 384 # to the parent. 385 my ($rfh, $wfh); 386 unless (pipe($rfh, $wfh)) { 387 die("Can't open pipe: $!"); 388 } 389 390 my $ex; 391 392 # Fork child 393 $self->handle_sigchld(); 394 defined(my $pid = fork()) or die("Can't fork: $!"); 395 if ($pid) { 396 eval { 397 # Give the server a chance to start up 398 sleep(2); 399 400 # To test SSL session resumption, we use the command-line 401 # openssl s_client tool, rather than any Perl module. 402 403 # XXX Some OpenSSL versions' of s_client do not support the 'ftp' 404 # parameter for -starttls; in this case, point the openssl binary 405 # to be used to a version which does support this. 406# my $openssl = 'openssl'; 407my $openssl = '/Users/tj/local/openssl-1.0.2d/bin/openssl'; 408 409 my @cmd = ( 410 $openssl, 411 's_client', 412 '-connect', 413 "127.0.0.1:$port", 414 '-starttls', 415 'ftp', 416 '-sess_out', 417 $sessid_file, 418 ); 419 420 my $tls_rh = IO::Handle->new(); 421 my $tls_wh = IO::Handle->new(); 422 my $tls_eh = IO::Handle->new(); 423 424 $tls_wh->autoflush(1); 425 426 local $SIG{CHLD} = 'DEFAULT'; 427 428 if ($ENV{TEST_VERBOSE}) { 429 print STDERR "Executing: ", join(' ', @cmd), "\n"; 430 } 431 432 my $tls_pid = open3($tls_wh, $tls_rh, $tls_eh, @cmd); 433 print $tls_wh "QUIT\r\n"; 434 waitpid($tls_pid, 0); 435 436 my ($res, $cipher_str, $err_str, $out_str); 437 if ($? >> 8) { 438 $err_str = join('', <$tls_eh>); 439 $res = 0; 440 441 } else { 442 my $output = [<$tls_rh>]; 443 444 # Specifically look for the line containing 'Cipher is' 445 foreach my $line (@$output) { 446 if ($line =~ /Cipher is/) { 447 $cipher_str = $line; 448 chomp($cipher_str); 449 } 450 } 451 452 if ($ENV{TEST_VERBOSE}) { 453 $out_str = join('', @$output); 454 print STDERR "Stdout: $out_str\n"; 455 } 456 457 if ($ENV{TEST_VERBOSE}) { 458 $err_str = join('', <$tls_eh>); 459 print STDERR "Stderr: $err_str\n"; 460 } 461 462 $res = 1; 463 } 464 465 unless ($res) { 466 die("Can't talk to server: $err_str"); 467 } 468 469 my $expected = '^New'; 470 $self->assert(qr/$expected/, $cipher_str, 471 test_msg("Expected '$expected', got '$cipher_str'")); 472 473 @cmd = ( 474 $openssl, 475 's_client', 476 '-connect', 477 "127.0.0.1:$port", 478 '-starttls', 479 'ftp', 480 '-sess_in', 481 $sessid_file, 482 ); 483 484 $tls_rh = IO::Handle->new(); 485 $tls_wh = IO::Handle->new(); 486 $tls_eh = IO::Handle->new(); 487 488 $tls_wh->autoflush(1); 489 490 if ($ENV{TEST_VERBOSE}) { 491 print STDERR "Executing: ", join(' ', @cmd), "\n"; 492 } 493 494 $tls_pid = open3($tls_wh, $tls_rh, $tls_eh, @cmd); 495 print $tls_wh "QUIT\r\n"; 496 waitpid($tls_pid, 0); 497 498 $res = 0; 499 $cipher_str = undef; 500 $err_str = undef; 501 $out_str = undef; 502 503 if ($? >> 8) { 504 $err_str = join('', <$tls_eh>); 505 $res = 0; 506 507 } else { 508 my $output = [<$tls_rh>]; 509 510 # Specifically look for the line containing 'Cipher is' 511 foreach my $line (@$output) { 512 if ($line =~ /Cipher is/) { 513 $cipher_str = $line; 514 chomp($cipher_str); 515 } 516 } 517 518 if ($ENV{TEST_VERBOSE}) { 519 $out_str = join('', @$output); 520 print STDERR "Stdout: $out_str\n"; 521 } 522 523 if ($ENV{TEST_VERBOSE}) { 524 $err_str = join('', <$tls_eh>); 525 print STDERR "Stderr: $err_str\n"; 526 } 527 528 $res = 1; 529 } 530 531 unless ($res) { 532 die("Can't talk to server: $err_str"); 533 } 534 535 $expected = '^Reused'; 536 $self->assert(qr/$expected/, $cipher_str, 537 test_msg("Expected '$expected', got '$cipher_str'")); 538 }; 539 540 if ($@) { 541 $ex = $@; 542 } 543 544 $wfh->print("done\n"); 545 $wfh->flush(); 546 547 } else { 548 eval { server_wait($setup->{config_file}, $rfh, 45) }; 549 if ($@) { 550 warn($@); 551 exit 1; 552 } 553 554 exit 0; 555 } 556 557 # Stop server 558 server_stop($setup->{pid_file}); 559 560 $self->assert_child_ok($pid); 561 562 test_cleanup($setup->{log_file}, $ex); 563} 564 565sub starttls_ftp { 566 my $port = shift; 567 my $ssl_opts = shift; 568 569 my $client = IO::Socket::INET->new( 570 PeerHost => '127.0.0.1', 571 PeerPort => $port, 572 Proto => 'tcp', 573 Type => SOCK_STREAM, 574 Timeout => 10 575 ); 576 unless ($client) { 577 croak("Can't connect to 127.0.0.1:$port: $!"); 578 } 579 580 # Read the banner 581 my $banner = <$client>; 582 if ($ENV{TEST_VERBOSE}) { 583 print STDOUT "# Received banner: $banner\n"; 584 } 585 586 # Send the AUTH command 587 my $cmd = "AUTH TLS\r\n"; 588 if ($ENV{TEST_VERBOSE}) { 589 print STDOUT "# Sending command: $cmd"; 590 } 591 592 $client->print($cmd); 593 $client->flush(); 594 595 # Read the AUTH response 596 my $resp = <$client>; 597 if ($ENV{TEST_VERBOSE}) { 598 print STDOUT "# Received response: $resp\n"; 599 } 600 601 my $expected = "234 AUTH TLS successful\r\n"; 602 unless ($expected eq $resp) { 603 croak("Expected response '$expected', got '$resp'"); 604 } 605 606 # Now perform the SSL handshake 607 if ($ENV{TEST_VERBOSE}) { 608 $IO::Socket::SSL::DEBUG = 3; 609 } 610 611 my $res = IO::Socket::SSL->start_SSL($client, $ssl_opts); 612 unless ($res) { 613 croak("Failed SSL handshake: " . IO::Socket::SSL::errstr()); 614 } 615 616 $cmd = "QUIT\r\n"; 617 if ($ENV{TEST_VERBOSE}) { 618 print STDOUT "# Sending command: $cmd"; 619 } 620 621 print $client $cmd; 622 $client->flush(); 623 $client->close(); 624} 625 626sub tls_stapling_on_memcache_bug4175 { 627 my $self = shift; 628 my $tmpdir = $self->{tmpdir}; 629 my $setup = test_setup($tmpdir, 'tls_memcache'); 630 631 my $memcached_servers = $ENV{MEMCACHED_SERVERS} ? $ENV{MEMCACHED_SERVERS} : '127.0.0.1:11211'; 632 633 my $cert_file = File::Spec->rel2abs('t/etc/modules/mod_tls/server-cert.pem'); 634 my $ca_file = File::Spec->rel2abs('t/etc/modules/mod_tls/ca-cert.pem'); 635 636 my $config = { 637 PidFile => $setup->{pid_file}, 638 ScoreboardFile => $setup->{scoreboard_file}, 639 SystemLog => $setup->{log_file}, 640 TraceLog => $setup->{log_file}, 641 Trace => 'tls:20 tls.memcache:20', 642 643 AuthUserFile => $setup->{auth_user_file}, 644 AuthGroupFile => $setup->{auth_group_file}, 645 646 IfModules => { 647 'mod_delay.c' => { 648 DelayEngine => 'off', 649 }, 650 651 'mod_memcache.c' => { 652 MemcacheEngine => 'on', 653 MemcacheLog => $setup->{log_file}, 654 MemcacheServers => $memcached_servers, 655 }, 656 657 'mod_tls.c' => { 658 TLSEngine => 'on', 659 TLSLog => $setup->{log_file}, 660 TLSRequired => 'on', 661 TLSRSACertificateFile => $cert_file, 662 TLSCACertificateFile => $ca_file, 663 TLSOptions => 'EnableDiags', 664 TLSStapling => 'on', 665 TLSStaplingCache => "memcache:/", 666 }, 667 }, 668 }; 669 670 my ($port, $config_user, $config_group) = config_write($setup->{config_file}, 671 $config); 672 673 # Open pipes, for use between the parent and child processes. Specifically, 674 # the child will indicate when it's done with its test by writing a message 675 # to the parent. 676 my ($rfh, $wfh); 677 unless (pipe($rfh, $wfh)) { 678 die("Can't open pipe: $!"); 679 } 680 681 require IO::Socket::INET; 682 require IO::Socket::SSL; 683 684 my $ex; 685 686 # Fork child 687 $self->handle_sigchld(); 688 defined(my $pid = fork()) or die("Can't fork: $!"); 689 if ($pid) { 690 eval { 691 # Give the server a chance to start up 692 sleep(2); 693 694 # Manually simulate the STARTTLS protocol 695 696 my $ssl_opts = { 697 SSL_ocsp_mode => IO::Socket::SSL::SSL_OCSP_TRY_STAPLE(), 698 SSL_verify_mode => IO::Socket::SSL::SSL_VERIFY_NONE(), 699 SSL_alpn_protocols => [qw(ftp)], 700 }; 701 702 starttls_ftp($port, $ssl_opts); 703 704 my $delay = 5; 705 if ($delay > 0) { 706 if ($ENV{TEST_VERBOSE}) { 707 print STDOUT "# Sleeping for $delay seconds\n"; 708 } 709 710 sleep($delay); 711 } 712 713 # Do it again, see if we actually read our our cached OCSP response 714 starttls_ftp($port, $ssl_opts); 715 }; 716 717 if ($@) { 718 $ex = $@; 719 } 720 721 $wfh->print("done\n"); 722 $wfh->flush(); 723 724 } else { 725 eval { server_wait($setup->{config_file}, $rfh) }; 726 if ($@) { 727 warn($@); 728 exit 1; 729 } 730 731 exit 0; 732 } 733 734 # Stop server 735 server_stop($setup->{pid_file}); 736 737 $self->assert_child_ok($pid); 738 739 test_cleanup($setup->{log_file}, $ex); 740} 741 7421; 743