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