ViewVC Help
View File | Revision Log | Show Annotations | Download File
/cvs/AnyEvent-HTTP/HTTP.pm
(Generate patch)

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.33 by root, Mon Oct 27 11:09:54 2008 UTC vs.
Revision 1.34 by root, Wed Oct 29 14:51:07 2008 UTC

… …
236sub _get_slot($$) { 236sub _get_slot($$) {
237 push @{ $CO_SLOT{$_[0]}[1] }, $_[1]; 237 push @{ $CO_SLOT{$_[0]}[1] }, $_[1];
238 238
239 _slot_schedule $_[0]; 239 _slot_schedule $_[0];
240} 240}
241
242our $qr_nl = qr<\015?\012>;
243our $qr_nlnl = qr<\015?\012\015?\012>;
241 244
242sub http_request($$@) { 245sub http_request($$@) {
243 my $cb = pop; 246 my $cb = pop;
244 my ($method, $url, %arg) = @_; 247 my ($method, $url, %arg) = @_;
245 248
… …
339 return unless $state{connect_guard}; 342 return unless $state{connect_guard};
340 343
341 $state{connect_guard} = AnyEvent::Socket::tcp_connect $rhost, $rport, sub { 344 $state{connect_guard} = AnyEvent::Socket::tcp_connect $rhost, $rport, sub {
342 $state{fh} = shift 345 $state{fh} = shift
343 or return $cb->(undef, { Status => 599, Reason => "$!", URL => $url }); 346 or return $cb->(undef, { Status => 599, Reason => "$!", URL => $url });
347 pop; # free memory, save a tree
344 348
345 delete $state{connect_guard}; # reduce memory usage, save a tree 349 return unless delete $state{connect_guard};
346 350
347 # get handle 351 # get handle
348 $state{handle} = new AnyEvent::Handle 352 $state{handle} = new AnyEvent::Handle
349 fh => $state{fh}; 353 fh => $state{fh},
354 timeout => $timeout;
350 355
351 # limit the number of persistent connections 356 # limit the number of persistent connections
357 # keepalive not yet supported
352 if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) { 358 if ($KA_COUNT{$_[1]} < $MAX_PERSISTENT_PER_HOST) {
353 ++$KA_COUNT{$_[1]}; 359 ++$KA_COUNT{$_[1]};
354 $state{handle}{ka_count_guard} = AnyEvent::Util::guard { --$KA_COUNT{$_[1]} }; 360 $state{handle}{ka_count_guard} = AnyEvent::Util::guard {
361 --$KA_COUNT{$_[1]}
362 };
355 $hdr{connection} = "keep-alive"; 363 $hdr{connection} = "keep-alive";
356 delete $hdr{connection}; # keep-alive not yet supported
357 } else { 364 } else {
358 delete $hdr{connection}; 365 delete $hdr{connection};
359 } 366 }
360 367
361 # (re-)configure handle 368 # (re-)configure handle
362 $state{handle}->timeout ($timeout);
363 $state{handle}->on_error (sub { 369 $state{handle}->on_error (sub {
364 my $errno = "$!"; 370 my $errno = "$!";
365 %state = (); 371 %state = ();
366 $cb->(undef, { Status => 599, Reason => $errno, URL => $url }); 372 $cb->(undef, { Status => 599, Reason => $errno, URL => $url });
367 }); 373 });
… …
372 378
373 $state{handle}->starttls ("connect") if $rscheme eq "https"; 379 $state{handle}->starttls ("connect") if $rscheme eq "https";
374 380
375 # handle actual, non-tunneled, request 381 # handle actual, non-tunneled, request
376 my $handle_actual_request = sub { 382 my $handle_actual_request = sub {
377 $state{handle}->starttls ("connect") if $uscheme eq "https"; 383 $state{handle}->starttls ("connect") if $uscheme eq "https" && !exists $state{handle}{tls};
378 384
379 # send request 385 # send request
380 $state{handle}->push_write ( 386 $state{handle}->push_write (
381 "$method $rpath HTTP/1.0\015\012" 387 "$method $rpath HTTP/1.0\015\012"
382 . (join "", map "\u$_: $hdr{$_}\015\012", keys %hdr) 388 . (join "", map "\u$_: $hdr{$_}\015\012", keys %hdr)
… …
385 ); 391 );
386 392
387 %hdr = (); # reduce memory usage, save a kitten 393 %hdr = (); # reduce memory usage, save a kitten
388 394
389 # status line 395 # status line
390 $state{handle}->push_read (line => qr/\015?\012/, sub { 396 $state{handle}->push_read (line => $qr_nl, sub {
391 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix 397 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix
392 or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid server response ($_[1])", URL => $url })); 398 or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid server response ($_[1])", URL => $url }));
393 399
394 my %hdr = ( # response headers 400 my %hdr = ( # response headers
395 HTTPVersion => ",$1", 401 HTTPVersion => ",$1",
… …
397 Reason => ",$3", 403 Reason => ",$3",
398 URL => ",$url" 404 URL => ",$url"
399 ); 405 );
400 406
401 # headers, could be optimized a bit 407 # headers, could be optimized a bit
402 $state{handle}->unshift_read (line => qr/\015?\012\015?\012/, sub { 408 $state{handle}->unshift_read (line => $qr_nlnl, sub {
403 for ("$_[1]\012") { 409 for ("$_[1]\012") {
404 y/\015//d; # weed out any \015, as they show up in the weirdest of places. 410 y/\015//d; # weed out any \015, as they show up in the weirdest of places.
405 411
406 # we support spaces in field names, as lotus domino 412 # we support spaces in field names, as lotus domino
407 # creates them (actually spaces around seperators 413 # creates them (actually spaces around seperators
… …
538 if ($proxy && $uscheme eq "https") { 544 if ($proxy && $uscheme eq "https") {
539 # oh dear, we have to wrap it into a connect request 545 # oh dear, we have to wrap it into a connect request
540 546
541 # maybe re-use $uauthority with patched port? 547 # maybe re-use $uauthority with patched port?
542 $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012Host: $uhost\015\012\015\012"); 548 $state{handle}->push_write ("CONNECT $uhost:$uport HTTP/1.0\015\012Host: $uhost\015\012\015\012");
543 $state{handle}->push_read (line => qr/\015?\012\015?\012/, sub { 549 $state{handle}->push_read (line => $qr_nlnl, sub {
544 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix 550 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix
545 or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid proxy connect response ($_[1])", URL => $url })); 551 or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid proxy connect response ($_[1])", URL => $url }));
546 552
547 if ($2 == 200) { 553 if ($2 == 200) {
548 $rpath = $upath; 554 $rpath = $upath;

Diff Legend

– Removed lines
+ Added lines
< Changed lines
> Changed lines