view release on metacpan or  search on metacpan

t/test-helper/helper1234.pm  view on Meta::CPAN

##
## Helper module to do common methods used between test cases ...
## So that the t/*.t programs don't get cluttered with these common functions!
## Also assumes you are not precounting the exact number of tests!
##
## Finally, it assumes your test programs are not changing directories.
## All file paths used are relative, not absolute paths!  So changing
## directories will break a lot of code in this test module!
##

package helper1234;

use strict;
use warnings;

use vars qw( @ISA @EXPORT @EXPORT_OK $VERSION );
use Exporter;

use Test::More 0.88;
use File::Basename;
use File::Spec;

# Uses both IO::Socket::SSL & Net::SSLeay
use Net::FTPSSL;

$VERSION = "1.01";
@ISA = qw( Exporter );

@EXPORT = qw ( stop_testing
               bail_testing
               called_by_make_test
               get_log_name
               are_updates_allowed
               get_opts_set_in_init
               initialize_your_connection
               should_we_ask_1st_question
               should_we_run_test
               ask_config_questions
               write_to_log
               ok2
               add_extra_arguments_to_config
             );

@EXPORT_OK = qw( );


# The global variables ...
my $config_file;        # The name of the config file!
my %FTPSSL_Defaults;    # Matches what's in the config file of previous answers!
my $silent_mode;        # Only true if running via "make test"!
my $debug_log_file;     # What to call the log file ...

my $extra_args = 0;

my %opts_used_in_initialize_func;


# =====================================================================
# Since I don't count the test cases, I must end my test programs
# with a call to one of these 2 methods.
# Can't do any tests in any END blocks!
# ---------------------------------------------------------------------
# When you exit with a status of zero, Test::More overrides the exit
# status with a count of test failure cases.
# If you use an explicit non-zero value, it aborts with that value instead.

sub stop_testing
{
   done_testing ();
   exit (0);        # Always must be 0!
}

# If called, causes "make test" to stop calling test programs.
# The error was just that damming!
sub bail_testing
{
   my $msg = shift || "Uspecified reason!";

   done_testing ();
   BAIL_OUT ( $msg );
   exit (0);
}

t/test-helper/helper1234.pm  view on Meta::CPAN

   diag ( "A secure ftps server address, a user, a password and a directory" );
   diag ( "where the user has permissions to read and/or write files to." );
   diag ( "Hopefully only the Net::FTPSSL tests have access to to this dir." );
   proxy_supported (1);

   my $copy = $silent_mode;
   $silent_mode = 0;
   my $ans = ask_yesno ("Do you want to run the server connectivity tests", 'FTPSSL_RUN_TESTS');
   $silent_mode = $copy;

   unless ( $ans ) {
      diag ( "Skipping all tests per user request ..." );
      write_config_file ();
      stop_testing ();
   }

   return;
}


# =====================================================================
# Asks all the configuration questions required by the test cases ...
# And then saves the answers to disk so that they are available
# as defaults the next time this method is called!
# These defaults can be found in the %FTPSSL_Defaults hash.
# ---------------------------------------------------------------------
# Returns: The options hash to use in call to Net::FTPSSL->new()
#          plus all other items prompted for.

sub ask_config_questions
{
   # The return values ...
   my ( $host, $user, $pass, $dir, %ftps_opts );

   my $p_flag = proxy_supported ();

   my $read_only = ask_yesno ("Are we restricted to read-only tests", 'READ_ONLY');

   my $server = askQW ("\tServer address ( host[:port] )", undef, undef, 'FTPSSL_SERVER');
   if ( $server =~ m/^([^:]+)[:](\d*)$/ ) {
      $host = $1;
      $ftps_opts{Port} = $2  if ( $2 ne "" );
   } else {
      $host = $server;
   }

   $user = askQW ("\tUser", "anonymous", undef, 'FTPSSL_USER');
   $pass = askQW ("\tPassword [a space for no password]", "user\@localhost", undef, 'FTPSSL_PWD', 0, 1);

   $dir = askQW ("\tDirectory", "<HOME>", undef, 'FTPSSL_DIR');
   $dir = "" if ($dir eq "<HOME>");   # Will ask server for it later on

   my $mode = askQW ("\tConnection mode (I)mplicit, (E)xplicit, or (C)lear.", "E", "(I|E|C)", 'FTPSSL_Encryption', 1);
   $ftps_opts{Encryption} = $mode;

   # If the connection is to be encrypted ...
   if ( $mode ne CLR_CRYPT ) {
      my $ans = askQW ("\tData Connection mode (C)lear or (P)rotected.", "P", "(C|S|E|P)", 'FTPSSL_DataProtLevel', 1);
      $ftps_opts{DataProtLevel} = $ans;

      my $ver = $IO::Socket::SSL::VERSION;
      my $opts;
      my $def = "TLSv12";

      # Values from IO::Socket::SSL.pm ...
      # Search for "my %SSL_OP_NO" initialization.
      if ( Net::SSLeay->can ("OP_NO_TLSv1_3") && $ver >= 2.060 ) {
         $opts = "(SSLv23|TLSv1|TLSv11|TLSv12|TLSv13)";
      } else {
         $opts = "(SSLv23|TLSv1|TLSv11|TLSv12)";
      }
      $ans = askQW ("\tWhat encryption protocal to use", $def, $opts, 'FTPSSL_SSL_version');
      $ftps_opts{SSL_version} = $ans;

   } else {
      delete $FTPSSL_Defaults{FTPSSL_DataProtLevel};
      delete $FTPSSL_Defaults{FTPSSL_SSL_version};
      delete $FTPSSL_Defaults{CERTIFICATE_USAGE};
   }

   my $psv_mode = askQW("\tUse (P)ASV or (E)PSV for data connections", "P", "(P|E)", 'FTPSSL_PASIVE', 1);

   if ( $p_flag ) {
      my $res = ask_proxy_questions ();
      $ftps_opts{ProxyArgs} = $res  if ( $res );
   }

   # Certificates require encrypted communication ...
   if ( $mode ne CLR_CRYPT ) {
      my %certificate;
      if ( ask_certificate_questions ( \%certificate ) ) {
         $ftps_opts{SSL_Client_Certificate} = \%certificate;
      }
   }

   # Hard code these options ...
   $ftps_opts{PreserveTimestamp} = 1;
   $ftps_opts{Timeout} = 30;
   $ftps_opts{Debug}   = 1;
   $ftps_opts{Croak}   = 0;
   # $ftps_opts{Trace}   = 1;

   # Assume help is broken for all connections & all FTP commands are supported.
   # If not needed, it will be removed later via an auto-added extra argument!
   # Found a server where HELP is broken for clear FTP as well.
   $ftps_opts{OverrideHELP} = 1;

   # The log file used by the Net::FTPSSL object in the current test program ...
   $ftps_opts{DebugLogFile} = $debug_log_file;

   # Do we keep any auto-added extra options?
   # Always Assume Yes if there are extra arguments!
   # No matter what was said last time!
   $FTPSSL_Defaults{QUESTION_EXTRA} = 1;

   if ( $extra_args ) {
      my $ans = ask_yesno ("Should we keep automatically-added extra Net::FTPSSL options from previous test runs", 'QUESTION_EXTRA');
      foreach my $key ( keys %FTPSSL_Defaults ) {
         next unless ( $key =~ m/^EXTRA_(.+)$/ );
         my $opt = $1;
         unless ( $ans ) {
            diag ("Removing:  $opt = $FTPSSL_Defaults{$key}");
            delete $FTPSSL_Defaults{$key};
         } elsif ( $opt eq "OverrideHELP" && $FTPSSL_Defaults{$key} == 99 ) {
            # diag ("OverrideHELP is no longer needed!");