1package ProFTPD::Tests::HTTP; 2 3use lib qw(t/lib); 4use base qw(ProFTPD::TestSuite::Child); 5use strict; 6 7use File::Spec; 8use IO::Handle; 9 10use ProFTPD::TestSuite::FTP; 11use ProFTPD::TestSuite::Utils qw(:auth :config :running :test :testsuite); 12 13$| = 1; 14 15my $order = 0; 16 17my $TESTS = { 18 http_connect => { 19 order => ++$order, 20 test_class => [qw(bug forking)], 21 }, 22 23 http_delete => { 24 order => ++$order, 25 test_class => [qw(bug forking)], 26 }, 27 28 http_get => { 29 order => ++$order, 30 test_class => [qw(bug forking)], 31 }, 32 33 http_head => { 34 order => ++$order, 35 test_class => [qw(bug forking)], 36 }, 37 38 http_options => { 39 order => ++$order, 40 test_class => [qw(bug forking)], 41 }, 42 43 http_patch => { 44 order => ++$order, 45 test_class => [qw(bug forking)], 46 }, 47 48 http_post => { 49 order => ++$order, 50 test_class => [qw(bug forking)], 51 }, 52 53 http_put => { 54 order => ++$order, 55 test_class => [qw(bug forking)], 56 }, 57 58}; 59 60sub new { 61 return shift()->SUPER::new(@_); 62} 63 64sub list_tests { 65 # Check for the required Perl modules: 66 # 67 # HTTP-Request 68 # LWP-UserAgent 69 70 my $required = [qw( 71 HTTP::Request 72 LWP::UserAgent 73 )]; 74 75 foreach my $req (@$required) { 76 eval "use $req"; 77 if ($@) { 78 print STDERR "\nWARNING:\n + Module '$req' not found, skipping all tests\n"; 79 80 if ($ENV{TEST_VERBOSE}) { 81 print STDERR "Unable to load $req: $@\n"; 82 } 83 84 return qw(testsuite_empty_test); 85 } 86 } 87 88 return testsuite_get_runnable_tests($TESTS); 89} 90 91sub test_http_req { 92 my $self = shift; 93 my $tmpdir = shift; 94 my $req = shift; 95 96 my $config_file = "$tmpdir/http.conf"; 97 my $pid_file = File::Spec->rel2abs("$tmpdir/http.pid"); 98 my $scoreboard_file = File::Spec->rel2abs("$tmpdir/http.scoreboard"); 99 100 my $log_file = test_get_logfile(); 101 102 my $auth_user_file = File::Spec->rel2abs("$tmpdir/http.passwd"); 103 my $auth_group_file = File::Spec->rel2abs("$tmpdir/http.group"); 104 105 my $user = 'proftpd'; 106 my $passwd = 'test'; 107 my $group = 'ftpd'; 108 my $home_dir = File::Spec->rel2abs($tmpdir); 109 my $uid = 500; 110 my $gid = 500; 111 112 # Make sure that, if we're running as root, that the home directory has 113 # permissions/privs set for the account we create 114 if ($< == 0) { 115 unless (chmod(0755, $home_dir)) { 116 die("Can't set perms on $home_dir to 0755: $!"); 117 } 118 119 unless (chown($uid, $gid, $home_dir)) { 120 die("Can't set owner of $home_dir to $uid/$gid: $!"); 121 } 122 } 123 124 auth_user_write($auth_user_file, $user, $passwd, $uid, $gid, $home_dir, 125 '/bin/bash'); 126 auth_group_write($auth_group_file, $group, $gid, $user); 127 128 my $config = { 129 PidFile => $pid_file, 130 ScoreboardFile => $scoreboard_file, 131 SystemLog => $log_file, 132 133 AuthUserFile => $auth_user_file, 134 AuthGroupFile => $auth_group_file, 135 136 IfModules => { 137 'mod_delay.c' => { 138 DelayEngine => 'off', 139 }, 140 }, 141 }; 142 143 my ($port, $config_user, $config_group) = config_write($config_file, $config); 144 145 # Open pipes, for use between the parent and child processes. Specifically, 146 # the child will indicate when it's done with its test by writing a message 147 # to the parent. 148 my ($rfh, $wfh); 149 unless (pipe($rfh, $wfh)) { 150 die("Can't open pipe: $!"); 151 } 152 153 require LWP::UserAgent; 154 require HTTP::Request; 155 156 my $ex; 157 158 # Fork child 159 $self->handle_sigchld(); 160 defined(my $pid = fork()) or die("Can't fork: $!"); 161 if ($pid) { 162 eval { 163 sleep(1); 164 165 # To reproduce Bug#4143, we only need to connect to the server, 166 # then issue an HTTP request. 167 168 my $client = LWP::UserAgent->new( 169 keep_alive => 1, 170 timeout => 10, 171 ); 172 $client->default_header('Host' => "127.0.0.1:$port"); 173 174 my $req = HTTP::Request->new($req => "http://127.0.0.1:$port/path/to/some/file"); 175 my $resp = $client->request($req); 176 177 if ($ENV{TEST_VERBOSE}) { 178 print STDERR "# response: ", $resp->as_string, "\n"; 179 } 180 181 my $conn_count = $client->conn_cache->get_connections(); 182 183 $self->assert($conn_count == 0, 184 test_msg("Expected connection cache count 0, got $conn_count")); 185 }; 186 187 if ($@) { 188 $ex = $@; 189 } 190 191 $wfh->print("done\n"); 192 $wfh->flush(); 193 194 } else { 195 eval { server_wait($config_file, $rfh) }; 196 if ($@) { 197 warn($@); 198 exit 1; 199 } 200 201 exit 0; 202 } 203 204 # Stop server 205 server_stop($pid_file); 206 207 $self->assert_child_ok($pid); 208 209 if ($ex) { 210 test_append_logfile($log_file, $ex); 211 unlink($log_file); 212 213 die($ex); 214 } 215 216 unlink($log_file); 217} 218 219sub http_connect { 220 my $self = shift; 221 my $tmpdir = $self->{tmpdir}; 222 test_http_req($self, $tmpdir, 'CONNECT'); 223} 224 225sub http_delete { 226 my $self = shift; 227 my $tmpdir = $self->{tmpdir}; 228 test_http_req($self, $tmpdir, 'DELETE'); 229} 230 231sub http_get { 232 my $self = shift; 233 my $tmpdir = $self->{tmpdir}; 234 test_http_req($self, $tmpdir, 'GET'); 235} 236 237sub http_head { 238 my $self = shift; 239 my $tmpdir = $self->{tmpdir}; 240 test_http_req($self, $tmpdir, 'HEAD'); 241} 242 243sub http_options { 244 my $self = shift; 245 my $tmpdir = $self->{tmpdir}; 246 test_http_req($self, $tmpdir, 'OPTIONS'); 247} 248 249sub http_patch { 250 my $self = shift; 251 my $tmpdir = $self->{tmpdir}; 252 test_http_req($self, $tmpdir, 'PATCH'); 253} 254 255sub http_post { 256 my $self = shift; 257 my $tmpdir = $self->{tmpdir}; 258 test_http_req($self, $tmpdir, 'POST'); 259} 260 261sub http_put { 262 my $self = shift; 263 my $tmpdir = $self->{tmpdir}; 264 test_http_req($self, $tmpdir, 'PUT'); 265} 266 2671; 268