1#!/usr/bin/perl -w 2 3use strict; 4use Test::More tests => 13; 5 6use LWP::UserAgent; 7use HTTP::Request; 8use POE::Kernel; 9use POE::Component::Server::HTTP; 10use YAML; 11 12my $PORT = 2081; 13 14my $pid = fork; 15die "Unable to fork: $!" unless defined $pid; 16 17END { 18 if ($pid) { 19 kill 2, $pid or warn "Unable to kill $pid: $!"; 20 } 21} 22 23$|++; 24 25#################################################################### 26if ($pid) { # we are parent 27 28 # stop kernel from griping 29 ${$poe_kernel->[POE::Kernel::KR_RUN]} |= 30 POE::Kernel::KR_RUN_CALLED; 31 32 print STDERR "$$: Sleep 2..."; 33 sleep 2; 34 print STDERR "continue\n"; 35 36 if(@ARGV) { 37 print STDERR "Please connect to http://localhost:$PORT/ with your browser and make sure everything works\n"; 38 local @ARGV=(); 39 {} while <>; 40 } 41 42 my $UA = LWP::UserAgent->new; 43 44 ##################################### welcome 45 my $req=HTTP::Request->new(GET => "http://localhost:$PORT/"); 46 my $resp=$UA->request($req); 47 48 ok(($resp->is_success and $resp->content_type eq 'text/html'), 49 "got index") or die "resp=", Dump $resp; 50 my $content = $resp->content; 51 ok(($content =~ /multipart.txt/), "proper index") 52 or die "resp=", Dump $content; 53 54 ##################################### last.txt 55 $req=HTTP::Request->new(GET => "http://localhost:$PORT/last.txt"); 56 $resp=$UA->request($req); 57 58 ok(($resp->is_success and $resp->content_type eq 'text/plain'), 59 "got last.txt") or die "resp=", Dump $resp; 60 $content = $resp->content; 61 ok(($content =~ /everything worked/), "everything worked") 62 or die "resp=", Dump $content; 63 64 ##################################### multipart.txt 65 $req=HTTP::Request->new(GET => "http://localhost:$PORT/multipart.txt"); 66 $resp=$UA->request($req); 67 68 ok(($resp->is_success and $resp->content_type =~ m(^multipart/mixed)), 69 "got multipart.txt") or die "resp=", Dump $resp; 70 $content = $resp->content; 71 ok(($content =~ /everything worked/), "everything worked") 72 or die "resp=", Dump $content; 73 74 75 ##################################### last.gif 76 my $last = File::Basename::dirname($0).'/last.gif'; 77 open LAST, $last or die "Unable to open $last: $!"; 78 { 79 local $/; 80 $last = <LAST>; 81 } 82 close LAST; 83 84 ##################################### last.gif 85 $req=HTTP::Request->new(GET => "http://localhost:$PORT/last.gif"); 86 $resp=$UA->request($req); 87 88 ok(($resp->is_success and $resp->content_type eq 'image/gif'), 89 "got last.gif") or die "resp=", Dump $resp; 90 $content = $resp->content; 91 ok(($content eq $last), "everything worked"); 92 93 ##################################### multipart.gif 94 $req=HTTP::Request->new(GET => "http://localhost:$PORT/multipart.gif"); 95 $resp=$UA->request($req); 96 97 ok(($resp->is_success and $resp->content_type =~ m(^multipart/mixed)), 98 "got multipart.txt") or die "resp=", Dump $resp; 99 $content = $resp->content; 100 $last = quotemeta $last; 101 ok(($content =~ /$last/), "everything worked"); 102 103 ##################################### multipart.mixed 104 $req=HTTP::Request->new(GET => "http://localhost:$PORT/multipart.mixed"); 105 $resp=$UA->request($req); 106 107 ok(($resp->is_success and $resp->content_type =~ m(^multipart/mixed)), 108 "got multipart.mixed") or die "resp=", Dump $resp; 109 $content = $resp->content; 110 ok(($content =~ /Please wait/), "first part worked"); 111 ok(($content =~ /$last/), "last part worked"); 112} 113#################################################################### 114else { # we are the child 115 116 Worker->spawn(port => $PORT); 117 $poe_kernel->run(); 118} 119 120########################################################### 121package Worker; 122 123use HTTP::Status; 124use POE::Kernel; 125use POE::Component::Server::HTTP; 126use POE; 127use File::Basename; 128 129sub DEBUG () { 0 } 130 131sub spawn 132{ 133 my($package, %parms)=@_; 134 my $self = bless { dir => dirname($0), 135 delay => 2, 136 stream_todo => []}, $package; 137 138 POE::Component::Server::HTTP->new( 139 Port => $parms{port}, 140 ContentHandler => { 141 '/' => sub { $self->welcome(@_) }, 142 '/favicon.ico' => sub { $self->favicon(@_) }, 143 '/multipart.gif' => sub { $self->multipart(@_) }, 144 '/multipart.mixed' => sub { $self->multipart_mixed(@_) }, 145 '/last.gif' => sub { $self->last(@_) }, 146 '/multipart.txt' => sub { $self->multipart_txt(@_) }, 147 '/last.txt' => sub { $self->last_txt(@_) }, 148 }, 149 StreamHandler => sub { $self->stream_start(@_) } 150 ); 151 152 POE::Session->create( 153 inline_states => { 154 _start => sub { $self->_start() }, 155 _stop => sub { DEBUG and warn "_stop\n" }, 156 wait_start => sub { $self->wait_start(@_[ARG0..$#_])}, 157 wait_done => sub { $self->wait_done(@_[ARG0..$#_])} 158 } 159 ); 160 161 DEBUG and warn "Listening on port $parms{port}\n"; 162} 163 164####################################### 165# POE event 166sub _start 167{ 168 my($self)=@_; 169 $self->{session} = $poe_kernel->get_active_session->ID; 170 171 $poe_kernel->alias_set(ref $self); 172 return; 173} 174 175####################################### 176# Called as ContentHandler 177sub welcome 178{ 179 my($self, $request, $response)=@_; 180 181 DEBUG and warn "Welcome\n"; 182 183 $response->code(RC_OK); 184 $response->content_type('text/html; charset=iso-8859-1'); 185 186 $response->content(<<HTML); 187<html> 188<head> 189<title>Hello world</title> 190</head> 191<body> 192<h1>Hello world from POE::Component::Server::HTTP</h1> 193 194<ul> 195 <li><a href="/last.txt">Text</a></li> 196 <li><a href="/multipart.txt">Multipart text</a></li> 197 <li><a href="/last.gif">Image</a></li> 198 <li><a href="/multipart.gif">Multipart image</a></li> 199 <li><a href="/multipart.mixed">Text, then image</a></li> 200</ul> 201 202 203</body> 204</html> 205HTML 206 return RC_OK; 207} 208 209####################################### 210# Called as ContentHandler 211sub favicon 212{ 213 my($self, $request, $response)=@_; 214 215 DEBUG and warn "favicon\n"; 216 217 $response->code(RC_NOT_FOUND); 218 $response->content_type('text/html; charset=iso-8859-1'); 219 220 $response->content(<<HTML); 221<html> 222<head> 223<title>Go away</title> 224</head> 225<body> 226<h1>Go away</h1> 227</body> 228</html> 229HTML 230 return RC_NOT_FOUND; 231} 232 233 234####################################### 235# Called as ContentHandler 236sub multipart 237{ 238 my($self, $request, $response)=@_; 239 240 DEBUG and warn "multipart\n"; 241 242 # Send an HTTP header and turn streaming on 243 $self->multipart_start($request, $response); 244 # After the HTTP header is sent, our StreamHandler will be called 245 # Save the values that stream_start needs to do its work 246 push @{$self->{stream_todo}}, [$request, $response, 247 'first.gif', 'last.gif']; 248 249 return RC_OK; 250} 251 252####################################### 253# Called as ContentHandler 254sub multipart_mixed 255{ 256 my($self, $request, $response)=@_; 257 258 DEBUG and warn "multipart\n"; 259 260 $self->multipart_start($request, $response); 261 push @{$self->{stream_todo}}, [$request, $response, 262 'first.txt', 'last.gif']; 263 264 return RC_OK; 265} 266 267####################################### 268# Called as ContentHandler 269sub last 270{ 271 my($self, $request, $response)=@_; 272 273 DEBUG and warn "last\n"; 274 $response->code(RC_OK); 275 $response->content_type('image/gif'); 276 $response->content($self->data('last.gif')); 277 return RC_OK; 278} 279 280####################################### 281# Called as ContentHandler 282sub multipart_txt 283{ 284 my($self, $request, $response)=@_; 285 286 DEBUG and warn "multipart_txt\n"; 287 288 $self->multipart_start($request, $response); 289 push @{$self->{stream_todo}}, [$request, $response, 290 'first.txt', 'last.txt']; 291 292 return RC_OK; 293} 294 295####################################### 296# Called as ContentHandler 297sub last_txt 298{ 299 my($self, $request, $response)=@_; 300 301 DEBUG and warn "last_txt\n"; 302 $response->code(RC_OK); 303 $response->content_type('text/plain'); 304 $response->content($self->data('last.txt')); 305 return RC_OK; 306} 307 308####################################### 309# Called as StreamHandler 310sub stream_start 311{ 312 my($self, $request, $response)=@_; 313 314 DEBUG and warn "stream_start\n"; 315 316 foreach my $todo (@{$self->{stream_todo}}) { 317 my($request, $response, $first, $last)=@$todo; 318 319 DEBUG and warn("post to wait_start for $first, $last\n"); 320 $self->multipart_send($response, $first); 321 322 # get into our POE session 323 $poe_kernel->post($self->{session} => 'wait_start', 324 $request, $response, $last); 325 } 326 327 328 329 $self->{stream_todo}=[]; 330 return; 331} 332 333 334####################################### 335# POE event 336sub wait_start 337{ 338 my($self, $request, $response, $next)=@_; 339 DEBUG and warn "Going to wait for $self->{delay} seconds\n"; 340 $poe_kernel->delay_set(wait_done => $self->{delay}, $request, $response, $next); 341 return; 342} 343 344####################################### 345# POE event 346sub wait_done 347{ 348 my($self, $request, $response, $next)=@_; 349 DEBUG and warn "Waiting done, sending $next\n"; 350 351 $self->multipart_send($response, $next); 352 $self->multipart_end($request, $response); 353 354 return; 355} 356 357####################################### 358# Healper 359sub data 360{ 361 my($self, $name)=@_; 362 my $file = "$self->{dir}/$name"; 363 open FILE, $file or die "Can't open $file: $!"; 364 { 365 local $/; 366 $file = <FILE>; 367 } 368 close FILE; 369 return $file; 370} 371 372 373#################################################################### 374 375####################################### 376# This function sends a file over the connection 377# We create a new HTTP response, with content and content_length 378# Because HTTP response->as_string sends HTTP status line, we hide it 379# behind a X-HTTP-Status header, just after the boundary. 380# This means that this part of the response looks like: 381# 382# --BoundaryString 383# X-HTTP-Status: HTTP/1.0 200 (OK) 384# Content-Type: text/plain 385# Content-Length: 13 386# 387# Content here 388# 389# Setting Content-Length is important for images 390sub multipart_send 391{ 392 my($self, $response, $file)=@_; 393 394 DEBUG and warn "multipart_send $file\n"; 395 396 my $ct = 'image/gif'; 397 $ct = 'text/plain' if $file =~ /txt$/; 398 399 my $resp = $self->multipart_response($ct); 400 401 my $data=$self->data($file); 402 $resp->content($data); 403 $resp->content_length(length($data)); 404 405 $response->send("--$self->{boundary}\cM\cJX-HTTP-Status: "); 406 $response->send($resp->as_string); 407 return; 408} 409 410####################################### 411# Create a HTTP::Response object to be sent as a part of the response 412sub multipart_response 413{ 414 my($self, $ct, $resp)=@_; 415 $resp ||= HTTP::Response->new; 416 $resp->content_type($ct||'text/plain'); 417 $resp->code(200); 418 return $resp; 419} 420 421####################################### 422# Send an HTTP header that sets up multipart/mixed response 423# Also turns on streaming. 424# 425# PoCo::Server::HTTP will send the $response object, then run PostHandler 426# then switch to Streaming mode. 427sub multipart_start 428{ 429 my($self, $request, $response)=@_; 430 431 $response->code(RC_OK); 432 $self->{boundary} ||= 'ThisRandomString'; 433 $response->content_type("multipart/mixed;boundary=$self->{boundary}"); 434 435 $response->streaming(1); 436} 437 438####################################### 439# The request is done. Turn off streaming and end the multipart response 440# Setting the header Connection to 'close' forces PoCo::Server::HTTP to 441# close the socket. This is needed so that the browsers stop "twirling". 442sub multipart_end 443{ 444 my($self, $request, $response)=@_; 445 DEBUG and warn "Closing connection\n"; 446 $response->close; 447 $request->header(Connection => 'close'); 448 $response->send("--$self->{boundary}--\cM\cJ"); 449} 450 451