start of work on mire's testcase
Apocalypse
13 years ago
| 0 | 0 | #!/usr/bin/perl |
| 1 | ||
| 2 | # Test contributed by mire@irc which used this to hit the WRITE_WANTS_READ case | |
| 3 | # mire created package Ub because he couldn't reproduce it with poco-cl-http :( | |
| 4 | # tweaked slightly to turn it into a real testcase ( not done yet ) | |
| 1 | 5 | |
| 2 | 6 | BEGIN { |
| 3 | 7 | # sub POE::Kernel::ASSERT_DEFAULT () { 1 } |
| 8 | 12 | |
| 9 | 13 | use strict; |
| 10 | 14 | use warnings; |
| 11 | use Data::Dumper; | |
| 12 | use Time::HiRes qw|time sleep|; | |
| 13 | use POE; | |
| 15 | use POE 1.310; | |
| 14 | 16 | |
| 15 | 17 | use Test::More; |
| 16 | plan skip_all => "AUTHOR TEST"; | |
| 18 | BEGIN { | |
| 19 | plan skip_all => "AUTHOR TEST"; | |
| 20 | } | |
| 17 | 21 | |
| 18 | 22 | our $DEBUG=0; |
| 19 | 23 | |
| 20 | 24 | package Ub; |
| 21 | 25 | use strict; |
| 22 | 26 | use warnings; |
| 23 | use Data::Dumper; | |
| 24 | use HTTP::Parser; | |
| 25 | use HTTP::Response; | |
| 26 | use Time::HiRes qw|time sleep|; | |
| 27 | use POE qw(Component::Client::TCP Filter::Stream Filter::HTTPChunk); | |
| 27 | use POE qw( Component::Client::TCP Filter::Stream ); | |
| 28 | 28 | use POE::Component::SSLify qw( Client_SSLify ); |
| 29 | ||
| 30 | # non-core deps | |
| 31 | BEGIN { | |
| 32 | eval "use POE::Filter::HTTPChunk; use HTTP::Parser; use HTTP::Response;"; | |
| 33 | if ( $@ ) { | |
| 34 | use Test::More; | |
| 35 | plan skip_all => "Unable to load deps: $@"; | |
| 36 | } | |
| 37 | } | |
| 38 | ||
| 29 | 39 | sub new { |
| 30 | 40 | my $this = shift; |
| 31 | 41 | my %p = @_; |
| 103 | 113 | |
| 104 | 114 | # Disconnect if SSL failed. |
| 105 | 115 | if ($@) { |
| 106 | print Dumper [$@] | |
| 107 | if $main::DEBUG; | |
| 116 | warn $@ if $main::DEBUG; | |
| 108 | 117 | return; |
| 109 | 118 | } |
| 110 | 119 | # Return the SSL-ified socket. |
| 222 | 231 | $port = 443; |
| 223 | 232 | $do_ssl = 1; |
| 224 | 233 | |
| 225 | $cont = <<'EOE' | |
| 234 | $cont = <<'EOF'; | |
| 226 | 235 | GET /get.php HTTP/1.1 |
| 227 | 236 | Host: osadmin.com |
| 228 | 237 | User-Agent: proba 123 |
| 229 | 238 | Connection: close |
| 230 | 239 | |
| 231 | 240 | |
| 232 | EOE | |
| 233 | ; | |
| 241 | EOF | |
| 242 | ||
| 234 | 243 | } |
| 235 | 244 | $kernel->post('ub', 'r', 'test_res', \$cont, $host, $port, $do_ssl); |
| 236 | 245 | |
| 240 | 249 | $kernel->refcount_decrement($_[SESSION]->ID, 'test'); |
| 241 | 250 | my $cont = ${$dat->{'content'}}; |
| 242 | 251 | chomp $cont; |
| 243 | print Dumper $cont; | |
| 252 | warn $cont; | |
| 244 | 253 | die "HIT BUG" if length $cont == 0; |
| 245 | $kernel->yield('test'); return; | |
| 246 | print "test_res has " . Dumper $dat; | |
| 254 | $kernel->yield('test'); | |
| 255 | return; | |
| 247 | 256 | }, |
| 248 | 257 | },)->ID; |
| 249 | 258 | |