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.31 by root, Fri Oct 24 01:25:54 2008 UTC vs.
Revision 1.35 by root, Thu Oct 30 03:47:01 2008 UTC

… …
48use AnyEvent::Socket (); 48use AnyEvent::Socket ();
49use AnyEvent::Handle (); 49use AnyEvent::Handle ();
50 50
51use base Exporter::; 51use base Exporter::;
52 52
53our $VERSION = '1.05'; 53our $VERSION = '1.1';
54 54
55our @EXPORT = qw(http_get http_post http_head http_request); 55our @EXPORT = qw(http_get http_post http_head http_request);
56 56
57our $USERAGENT = "Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)"; 57our $USERAGENT = "Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)";
58our $MAX_RECURSE = 10; 58our $MAX_RECURSE = 10;
… …
104headers, the "pseudo-headers" C<HTTPVersion>, C<Status> and C<Reason> 104headers, the "pseudo-headers" C<HTTPVersion>, C<Status> and C<Reason>
105contain the three parts of the HTTP Status-Line of the same name. The 105contain the three parts of the HTTP Status-Line of the same name. The
106pseudo-header C<URL> contains the original URL (which can differ from the 106pseudo-header C<URL> contains the original URL (which can differ from the
107requested URL when following redirects). 107requested URL when following redirects).
108 108
109If the server sends a header multiple lines, then their contents will be 109If the server sends a header multiple times, then their contents will be
110joined together with a command (C<,>). 110joined together with a comma (C<,>), as per the HTTP spec.
111 111
112If an internal error occurs, such as not being able to resolve a hostname, 112If an internal error occurs, such as not being able to resolve a hostname,
113then C<$data> will be C<undef>, C<< $headers->{Status} >> will be C<599> 113then C<$data> will be C<undef>, C<< $headers->{Status} >> will be C<599>
114and the C<Reason> pseudo-header will contain an error message. 114and the C<Reason> pseudo-header will contain an error message.
115 115
… …
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
… …
420 426
421 substr $_, 0, 1, "" 427 substr $_, 0, 1, ""
422 for values %hdr; 428 for values %hdr;
423 429
424 my $finish = sub { 430 my $finish = sub {
425 # TODO: use destroy method, when/if available
426 #$state{handle}->destroy; 431 $state{handle}->destroy;
427 $state{handle}->on_eof (undef);
428 $state{handle}->on_error (undef);
429 %state = (); 432 %state = ();
430 433
431 # set-cookie processing 434 # set-cookie processing
432 if ($arg{cookie_jar}) { 435 if ($arg{cookie_jar}) {
433 for ($hdr{"set-cookie"}) { 436 for ($hdr{"set-cookie"}) {
… …
538 if ($proxy && $uscheme eq "https") { 541 if ($proxy && $uscheme eq "https") {
539 # oh dear, we have to wrap it into a connect request 542 # oh dear, we have to wrap it into a connect request
540 543
541 # maybe re-use $uauthority with patched port? 544 # 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"); 545 $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 { 546 $state{handle}->push_read (line => $qr_nlnl, sub {
544 $_[1] =~ /^HTTP\/([0-9\.]+) \s+ ([0-9]{3}) (?: \s+ ([^\015\012]*) )?/ix 547 $_[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 })); 548 or return (%state = (), $cb->(undef, { Status => 599, Reason => "invalid proxy connect response ($_[1])", URL => $url }));
546 549
547 if ($2 == 200) { 550 if ($2 == 200) {
548 $rpath = $upath; 551 $rpath = $upath;

Diff Legend

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