[ViewVC] Diff of: cvs/AnyEvent-HTTP/HTTP.pm

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.25 by root, Mon Jul 21 05:42:07 2008 UTC vs.
Revision 1.30 by root, Thu Oct 23 02:46:20 2008 UTC

 use AnyEvent::Socket ();
 use AnyEvent::Handle ();
 use base Exporter::;
-our $VERSION = '1.03';
+our $VERSION = '1.05';
 our @EXPORT = qw(http_get http_post http_head http_request);
 our $USERAGENT          = "Mozilla/5.0 (compatible; AnyEvent::HTTP/$VERSION; +http://software.schmorp.de/pkg/AnyEvent)";
 our $MAX_RECURSE        =  10;
 my %CO_SLOT;  # number of open connections, and wait queue, per host
 =item http_get $url, key => value..., $cb->($data, $headers)
 Executes an HTTP-GET request. See the http_request function for details on
-additional parameters.
+additional parameters and the return value.
 =item http_head $url, key => value..., $cb->($data, $headers)
-Executes an HTTP-HEAD request. See the http_request function for details on
+Executes an HTTP-HEAD request. See the http_request function for details
-additional parameters.
+on additional parameters and the return value.
 =item http_post $url, $body, key => value..., $cb->($data, $headers)
-Executes an HTTP-POST request with a request body of C<$bod>. See the
+Executes an HTTP-POST request with a request body of C<$body>. See the
-http_request function for details on additional parameters.
+http_request function for details on additional parameters and the return
+value.
 =item http_request $method => $url, key => value..., $cb->($data, $headers)
 Executes a HTTP request of type C<$method> (e.g. C<GET>, C<POST>). The URL
 must be an absolute http or https URL.
+When called in void context, nothing is returned. In other contexts,
+C<http_request> returns a "cancellation guard" - you have to keep the
+object at least alive until the callback get called. If the object gets
+destroyed before the callbakc is called, the request will be cancelled.
 The callback will be called with the response data as first argument
 (or C<undef> if it wasn't available due to errors), and a hash-ref with
 response headers as second argument.
          my ($body, $hdr) = @_;
          use Data::Dumper;
          print Dumper $hdr;
       }
    ;
+Example: make another simple HTTP GET request, but immediately try to
+cancel it.
+   my $request = http_request GET => "http://www.nethype.de/", sub {
+      my ($body, $hdr) = @_;
+      print "$body\n";
+   };
+   undef $request;
 =cut
 sub _slot_schedule;
 sub _slot_schedule($) {
       %$jar = () if $jar->{version} < 1;
       my @cookie;
       while (my ($chost, $v) = each %$jar) {
+         if ($chost =~ /^\./) {
-         next unless $chost eq substr $uhost, -length $chost;
+            next unless $chost eq substr $uhost, -length $chost;
-         next unless $chost =~ /^\./;
+         } elsif ($chost =~ /\./) {
+            next unless $chost eq $uhost;
+         } else {
+            next;
+         }
          while (my ($cpath, $v) = each %$v) {
             next unless $cpath eq substr $upath, 0, length $cpath;
             while (my ($k, $v) = each %$v) {
             # headers, could be optimized a bit
             $state{handle}->unshift_read (line => qr/\015?\012\015?\012/, sub {
                for ("$_[1]\012") {
                   # we support spaces in field names, as lotus domino
-                  # creates them.
+                  # creates them (actually spaces around seperators
+                  # are strictly allowed in http, they are a security issue).
                   $hdr{lc $1} .= "\x00$2"
                      while /\G
                            ([^:\000-\037]+):
                            [\011\040]*
                            ((?: [^\015\012]+ | \015?\012[\011\040] )*)
                substr $_, 0, 1, ""
                   for values %hdr;
                my $finish = sub {
+                  # TODO: use destroy method, when/if available
+                  #$state{handle}->destroy;
+                  $state{handle}->on_eof   (undef);
+                  $state{handle}->on_error (undef);
                   %state = ();
                   # set-cookie processing
                   if ($arg{cookie_jar} && exists $hdr{"set-cookie"}) {
                      for (split /\x00/, $hdr{"set-cookie"}) {
                         my ($cookie, @arg) = split /;\s*/;
                         my ($name, $value) = split /=/, $cookie, 2;
                         my %kv = (value => $value, map { split /=/, $_, 2 } @arg);
-                        my $cdom  = (delete $kv{domain}) || $uhost;
+                        my $cdom;
                         my $cpath = (delete $kv{path})   || "/";
+                        if (exists $kv{domain}) {
+                           $cdom = delete $kv{domain};
-                        $cdom =~ s/^.?/./; # make sure it starts with a "."
+                           $cdom =~ s/^\.?/./; # make sure it starts with a "."
-                        next if $cdom =~ /\.$/;
+                           next if $cdom =~ /\.$/;
-                        # this is not rfc-like and not netscape-like. go figure.
+                           # this is not rfc-like and not netscape-like. go figure.
-                        my $ndots = $cdom =~ y/.//;
+                           my $ndots = $cdom =~ y/.//;
-                        next if $ndots < ($cdom =~ /\.[^.][^.]\.[^.][^.]$/ ? 3 : 2);
+                           next if $ndots < ($cdom =~ /\.[^.][^.]\.[^.][^.]$/ ? 3 : 2);
+                        } else {
+                           $cdom = $uhost;
+                        }
                         # store it
                         $arg{cookie_jar}{version} = 1;
                         $arg{cookie_jar}{$cdom}{$cpath}{$name} = \%kv;
                      }
                   if ($_[1]{Status} =~ /^30[12]$/ && $recurse && $method ne "POST") {
                      # apparently, mozilla et al. just change POST to GET here
                      # more research is needed before we do the same
                      http_request ($method, $_[1]{location}, %arg, recurse => $recurse - 1, $cb);
                   } elsif ($_[1]{Status} == 303 && $recurse) {
-                     # even http/1.1 is unlear on how to mutate the method
+                     # even http/1.1 is unclear on how to mutate the method
                      $method = "GET" unless $method eq "HEAD";
                      http_request ($method => $_[1]{location}, %arg, recurse => $recurse - 1, $cb);
                   } elsif ($_[1]{Status} == 307 && $recurse && $method =~ /^(?:GET|HEAD)$/) {
                      http_request ($method => $_[1]{location}, %arg, recurse => $recurse - 1, $cb);
                   } else {

Diff Legend

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

Comparing AnyEvent-HTTP/HTTP.pm (file contents): Revision 1.25 by root, Mon Jul 21 05:42:07 2008 UTC vs. Revision 1.30 by root, Thu Oct 23 02:46:20 2008 UTC

Diff Legend

Comparing AnyEvent-HTTP/HTTP.pm (file contents):
Revision 1.25 by root, Mon Jul 21 05:42:07 2008 UTC vs.
Revision 1.30 by root, Thu Oct 23 02:46:20 2008 UTC