1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138
|
package ProFTPD::Tests::Commands::HELP;
use lib qw(t/lib);
use base qw(ProFTPD::TestSuite::Child);
use strict;
use File::Spec;
use IO::Handle;
use ProFTPD::TestSuite::FTP;
use ProFTPD::TestSuite::Utils qw(:auth :config :features :running :test :testsuite);
$| = 1;
my $order = 0;
my $TESTS = {
help_ok => {
order => ++$order,
test_class => [qw(forking)],
},
};
sub new {
return shift()->SUPER::new(@_);
}
sub list_tests {
return testsuite_get_runnable_tests($TESTS);
}
sub help_ok {
my $self = shift;
my $tmpdir = $self->{tmpdir};
my $setup = test_setup($tmpdir, 'cmds');
my $config = {
PidFile => $setup->{pid_file},
ScoreboardFile => $setup->{scoreboard_file},
SystemLog => $setup->{log_file},
AuthUserFile => $setup->{auth_user_file},
AuthGroupFile => $setup->{auth_group_file},
AuthOrder => 'mod_auth_file.c',
IfModules => {
'mod_delay.c' => {
DelayEngine => 'off',
},
},
};
my ($port, $config_user, $config_group) = config_write($setup->{config_file},
$config);
my $auth_helps = [
' NOOP FEAT OPTS HOST CLNT AUTH* CCC* CONF* ',
' ENC* MIC* PBSZ* PROT* TYPE STRU MODE RETR ',
];
# Open pipes, for use between the parent and child processes. Specifically,
# the child will indicate when it's done with its test by writing a message
# to the parent.
my ($rfh, $wfh);
unless (pipe($rfh, $wfh)) {
die("Can't open pipe: $!");
}
my $ex;
# Fork child
$self->handle_sigchld();
defined(my $pid = fork()) or die("Can't fork: $!");
if ($pid) {
eval {
# Allow for server startup
sleep(2);
my $client = ProFTPD::TestSuite::FTP->new('127.0.0.1', $port);
$client->help();
my $resp_code = $client->response_code();
my $resp_msgs = $client->response_msgs();
my $expected = 214;
$self->assert($expected == $resp_code,
test_msg("Expected response code $expected, got $resp_code"));
$expected = 9;
my $nhelp = scalar(@$resp_msgs);
$self->assert($expected == $nhelp,
test_msg("Expected $expected lines, got $nhelp"));
my $helps = [(
'The following commands are recognized (* =>\'s unimplemented):',
' CWD XCWD CDUP XCUP SMNT* QUIT PORT PASV ',
' EPRT EPSV ALLO RNFR RNTO DELE MDTM RMD ',
' XRMD MKD XMKD PWD XPWD SIZE SYST HELP ',
@$auth_helps,
' STOR STOU APPE REST ABOR RANG USER PASS ',
' ACCT* REIN* LIST NLST STAT SITE MLSD MLST ',
'Direct comments to root@127.0.0.1',
)];
for (my $i = 0; $i < $nhelp; $i++) {
$expected = $helps->[$i];
$self->assert($expected eq $resp_msgs->[$i],
test_msg("Expected '$expected', got '$resp_msgs->[$i]'"));
}
$client->quit();
};
if ($@) {
$ex = $@;
}
$wfh->print("done\n");
$wfh->flush();
} else {
eval { server_wait($setup->{config_file}, $rfh) };
if ($@) {
warn($@);
exit 1;
}
exit 0;
}
# Stop server
server_stop($setup->{pid_file});
$self->assert_child_ok($pid);
test_cleanup($setup->{log_file}, $ex);
}
1;
|