Turns out I couldn't use ExtUtils::MakeMaker's prompt() function since
it wouldn't display the prompts during "make test" for the non-smoke
testers, so I cloned it into my test code to use diag() instead of
print.
Can you please see if the 2 attached test files will allow v0.18 to
pass your smoke testing without any more issues?
Setting the environment variable PERL_MM_USE_DEFAULT to 1
or
make test < /dev/null
Both methods should force both test scripts to use their defaults.
If there are any other tests I should be doing to allow smoother
testing of my module by the smoke testers, please advise & I'll put it
into place.
Curtis
On Wed Aug 03 11:47:11 2011, CLEACH wrote:
Show quoted text> Thanks for the update & suggestion on how to fix it. This is the
1st
Show quoted text> I've heard of this issue. I thought you just answered "No" to the
> deaper test question.
>
> I'll look into using the prompt function you suggested with my next
> release.
>
> By the way, as of v0.18, there were 2 types of deaper tests, so
there
Show quoted text> are 2 places to ansewr No at. (Or just return, since No is the
> default.)
>
> Curtis
>
> On Wed Aug 03 09:12:31 2011, BINGOS wrote:
> > One of the tests asks a question of the user.
> >
> > Unfortunately this is done in such a way that automated CPAN
testers
Show quoted text> > just 'hang' on the question (on my CPAN smokers a timeout hits on
15
Show quoted text> > minutes of inactivity and the job is killed).
> >
> > I would suggest using ExtUtils::MakeMaker's prompt() function.
>
Message body is not shown because it is too large.
# Before `make install' is performed this script should be runnable with
# `make test'. After `make install' it should work as `perl ./t/10-complex.t'
#########################
# Goal here is to give as many success messagse as possible.
# Especially when not all FTP servers support all functions.
# So the logic here can be a bit convoluted.
use strict;
use warnings;
# Uncomment if you need to trace issues with IO::Socket:SSL methods as well.
# Proper values are: debug0, debug1, debug2 & debug3. 3 is the most verbose!
use IO::Socket::SSL qw(debug3);
use Test::More tests => 11; # Also update skipper (one less)
use File::Copy;
my $skipper = 10;
# plan tests => 10; # Can't use due to BEGIN block
BEGIN { use_ok('Net::FTPSSL') } # Test # 1
sleep (1); # So test 1 completes before the message prints!
# -----------------------------------------------------------
# This section initializes an unsupported feature to Net::FTPSSL.
# But it's required in order to implement Client Certificates.
# -----------------------------------------------------------
my %advanced_hash = ( SSL_version => "SSLv23",
SSL_use_cert => 1,
SSL_server => 0,
SSL_key_file => "$ENV{HOME}/Certificate/private.pem",
SSL_cert_file => "$ENV{HOME}/Certificate/pubkey.pem",
SSL_passwd_cb => sub { return ("my_password") },
Timeout => 60 );
# -----------------------------------------------------------
diag( "\nYou can also perform a certificate test." );
diag( "Some information will be required for this test:" );
diag( "A secure ftp server expecting a client certificate,");
diag( "a user, a password and a directory where the user");
diag( "has permissions to read and write." );
my $more_test = ask_yesno("Do you want to do a certificate test");
SKIP: {
skip ( "Certificate tests skipped for some reason ...", $skipper ) unless $more_test;
unless (-f $advanced_hash{SSL_key_file} && -f $advanced_hash{SSL_cert_file} ) {
skip ( "Deeper test skipped due to no client certificate defined ...", $skipper );
}
my( $address, $server, $port, $user, $pass, $dir, $mode, $data, $encrypt_mode, $psv_mode );
$address = ask2("Server address ( host[:port] )", undef, undef, $ENV{FTPSSL_SERVER});
( $server, $port ) = split( /:/, $address );
# $port = 21 unless $port; # Let FTPSSL provide the default port.
$user = ask2("\tUser", "anonymous", undef, $ENV{FTPSSL_USER});
$pass = ask2("\tPassword [a space for no password]", "user\@localhost", undef, $ENV{FTPSSL_PWD});
$dir = ask2("\tDirectory", "<HOME>", undef, $ENV{FTPSSL_DIR});
$dir = "" if ($dir eq "<HOME>"); # Will ask server for it later on.
$mode = ask("\tConnection mode (I)mplicit or (E)xplicit.",
EXP_CRYPT, "(I|E)");
if ( $mode eq CLR_CRYPT ) {
$data = $encrypt_mode = ""; # Make sure not undef ...
} else {
$data = ask("\tData Connection mode (C)lear or (P)rotected.",
DATA_PROT_PRIVATE, "(C|S|E|P)");
$encrypt_mode = ask("\tUse (T)LS or (S)SL encryption", "T", "(T|S)");
}
$encrypt_mode = ($encrypt_mode eq "S") ? 1 : 0;
$psv_mode = ask("\tUse (P)ASV or (E)PSV for data connections", "P", "(P|E)");
# The main certificate log file ...
my $log_file = "./t/test_certificate.txt";
# -----------------------------------------------------------
# End of user interaction ...
# -----------------------------------------------------------
# Delete test files from previous run
unlink ($log_file);
# So we can save the Debug trace in a file from this test.
# We don't use DebugLogFile for this on purpose so that everything
# written to STDERR is in the log file, including msgs from this test!
# But doing it this way is very undesireable in a real program!
open (OLDERR, ">&STDERR");
open (STDERR, "> $log_file");
$advanced_hash{SSL_version} = ($encrypt_mode ? "SSLv23" : "TLSv1");
# My Net::FTPSSL connection options ...
my %ftps_opts = ( Port => $port, Encryption => $mode,
DataProtLevel => $data, useSSL => $encrypt_mode,
SSL_Client_Certificate => \%advanced_hash,
Croak => 1,
Timeout => 121, Debug => 1, Trace => 1 );
print STDERR "\n**** Starting the Certificate server test ****\n";
# Writes logs to STDERR which this script redirects to a file ...
my $ftp = Net::FTPSSL->new( $server, \%ftps_opts );
isa_ok( $ftp, 'Net::FTPSSL', 'Net::FTPSSL object creation' );
ok( $ftp->login ($user, $pass), "Login to $server" );
# Turning off croak now that our environment is correct!
$ftp->set_croak (0);
if ( $psv_mode eq "P" ) {
ok ( 1, "Using PASV mode for data connections" );
} else {
my $t = $ftp->force_epsv (1);
$psv_mode = $t ? "1" : "2";
$t = $ftp->force_epsv (2) unless ( $t );
ok ( $t, "Force Extended Passive Mode (EPSV $psv_mode)" );
unless ( $t ) {
--$skipper;
skip ( "EPSV not supported, please rerun test using PASV instead!", $skipper );
}
}
# Ask for the user's HOME dir if it's not provided!
$dir = $ftp->pwd () unless ($dir);
# -------------------------------------------------------------------------
# Back to processing the real test cases ...
# -------------------------------------------------------------------------
ok( $ftp->cwd( $dir ), "Changed the dir to $dir" );
my $pwd = $ftp->pwd();
ok( defined $pwd, "Getting the directory: ($pwd)" );
$dir = $pwd if (defined $pwd); # Convert relative to absolute path.
my $res = $ftp->cdup ();
$pwd = $ftp->pwd();
ok ( $res, "Going up one level: ($pwd)" );
# $res = $ftp->cwd ( $dir );
# $pwd = $ftp->pwd();
# ok ( $res, "Returning to proper dir: ($pwd)" );
ok( $ftp->noop(), "Noop test" );
my @lst;
@lst = $ftp->nlst ();
ok( scalar @lst != 0, 'nlst() command' );
print_result (\@lst);
@lst = $ftp->list ();
ok( scalar @lst != 0, 'list() command' );
print_result (\@lst);
# -----------------------------------------
# Closing the connection ...
# -----------------------------------------
ok( $ftp->quit(), 'quit() command' );
# Free so any context messages will still appear in the log file.
$ftp = undef;
# Restore STDERR now that the tests are done!
open (STDERR, ">&OLDERR");
if (1 == 2) {
print OLDERR "\n"; # Perl gives warning if not present! (Not executed)
}
}
# =====================================================================
# Start of subroutines ...
# =====================================================================
# Does an automatic shift to upper case for all answers
sub ask {
my $question = shift;
my $default = uc (shift);
my $values = uc (shift);
my $answer = uc (prompt ($question, $default, $values));
if ( $values && $answer !~ m/^$values$/ ) {
$answer = $default; # Change invalid value to default answer!
}
# diag ("ANS: [$answer]");
return $answer;
}
# This version doesn't do an automatic upshift
# Also provides a way to enter "" as a valid value!
# The Alternate Default is from an optional environment variable
sub ask2 {
my $question = shift;
my $default = shift || "";
my $values = shift || "";
my $altdef = shift || $default;
my $answer = prompt ($question, $altdef, $values);
if ( $answer =~ m/^\s+$/ ) {
$answer = ""; # Overriding any defaults ...
} elsif ( $values && $answer !~ m/^$values$/ ) {
$answer = $altdef; # Change invalid value to default answer!
}
# diag ("ANS2: [$answer]");
return $answer;
}
sub ask_yesno {
my $question = shift;
my $answer = prompt ($question, "N", "(Y|N)");
# diag ("ANS-YN: [$answer]");
return $answer =~ /^y(es)*$/i ? 1 : 0;
}
# Save the results from the list() & nlst() calls.
# Remember that STDERR should be redirected to a log file by now.
sub print_result {
my $lst = shift;
# Tell the max number of entries you may print out.
# Just in case the list is huge!
my $cnt = 5;
my $max = scalar (@{$lst});
print STDERR "------------- Found $max file(s) -----------------\n";
foreach (@{$lst}) {
if ($cnt <= 0) {
print STDERR "...\n";
print STDERR "($lst->[-1])\n";
last;
}
print STDERR "($_)\n";
--$cnt;
}
print STDERR "-----------------------------------------------\n";
}
# Based on ExtUtils::MakeMaker::prompt
# (can't use since "make test" doesn't display questions!)
sub prompt {
my ($question, $def, $opts) = (shift, shift, shift);
my $isa_tty = -t STDIN && (-t STDOUT || !(-f STDOUT || -c STDOUT));
my $dispdef = defined $def ? "[$def] " : " ";
$def = defined $def ? $def : "";
if (defined $opts && $opts !~ m/^\s*$/) {
diag ("\n$question ? $opts $dispdef");
} else {
diag ("\n$question ? $dispdef");
}
my $ans;
if ( $ENV{PERL_MM_USE_DEFAULT} || (!$isa_tty && eof STDIN)) {
diag ("$def\n");
} else {
$ans = <STDIN>;
chomp ($ans);
unless (defined $ans) {
diag ("\n");
}
}
$ans = $def unless ($ans);
return ( $ans );
}
# vim:ft=perl:
RT for rt.cpan.org