Dump WWW::Curl::Easy request-CodePudding

I use package WWW::Curl::Easy for API calls, and this is my example code:

use WWW::Curl::Easy;

my $curl = WWW::Curl::Easy->new();

$curl->setopt(CURLOPT_POST, 1);
$curl->setopt(CURLOPT_HEADER, 1);
$curl->setopt(CURLOPT_HTTPHEADER, ['Accept: text/xml; charset=utf-8', 'Content-Type:text/xml; charset=utf-8', 'SOAPAction: "importSheet"']);
$curl->setopt(CURLOPT_POSTFIELDS, $requestMessage);
$curl->setopt(CURLOPT_URL, $tom::{'setup'}{'api'}{'carrier'}{'url'});


my $response;
$curl->setopt(CURLOPT_WRITEDATA, \$response);

main::_log(Dumper(\$curl));

my $ret = $curl->perform();

Can I somehow dump whole request from $curl?

I tried main::_log(Dumper(\$curl)); but it didn't give me anything useful.

I would like to see whole request like real headers, method, body of request, post data etc. I know that I can see these information in code because I set it for example in CURLOPT_HTTPHEADER but I would like to dump "real" request (from curl) which is going to be send.

CodePudding user response：

The easiest way is to turn CURLOPT_VERBOSE on in your program.

use WWW::Curl::Easy;

my $curl = WWW::Curl::Easy->new;

$curl->setopt(CURLOPT_HEADER,1);
$curl->setopt(CURLOPT_URL, 'http://example.com');
$curl->setopt(CURLOPT_WRITEDATA,\my $response_body);

# this turns on debugging a la `curl -v http://example.com`
$curl->setopt(CURLOPT_VERBOSE, 1);

my $retcode = $curl->perform;
print("Transfer went ok\n") unless $retcode;

Output:

*   Trying 93.184.216.34:80...
* TCP_NODELAY set
* Connected to example.com (93.184.216.34) port 80 (#0)
> GET / HTTP/1.1
Host: example.com
Accept: */*

* Mark bundle as not supporting multiuse
< HTTP/1.1 200 OK
< Accept-Ranges: bytes
< Age: 543595
< Cache-Control: max-age=604800
< Content-Type: text/html; charset=UTF-8
< Date: Thu, 25 Nov 2021 14:20:18 GMT
< Etag: "3147526947 gzip"
< Expires: Thu, 02 Dec 2021 14:20:18 GMT
< Last-Modified: Thu, 17 Oct 2019 07:18:26 GMT
< Server: ECS (nyb/1D0F)
< Vary: Accept-Encoding
< X-Cache: HIT
< Content-Length: 1256
< 
* Connection #0 to host example.com left intact
Transfer went ok

If you want something more fancy, you would have to roll your own. You can overwrite what CURLOPT_VERBOSE does by setting CURLOPT_DEBUGFUNCTION to a Perl code reference. That gets called for every line of debug output.

The signature seems to be different from what's in the documentation for libcurl, but it's possible to deduct what's going on.

$curl->setopt(CURLOPT_VERBOSE, 1);
$curl->setopt(CURLOPT_DEBUGFUNCTION, sub {
    use Data::Dumper;
    print Dumper \@_;
});

The first few lines of output with this set look as follows.

[
    [0] "  Trying 93.184.216.34:80...
",
    [1] undef,
    [2] 0
]
[
    [0] "TCP_NODELAY set
",
    [1] undef,
    [2] 0
]
[
    [0] "Connected to example.com (93.184.216.34) port 80 (#0)
",
    [1] undef,
    [2] 0
]
[
    [0] "GET / HTTP/1.1
Host: example.com
Accept: */*

",
    [1] undef,
    [2] 2
]

The first argument seems to be the text.

According to the docs, there are a few types of debug data.

typedef enum {
  CURLINFO_TEXT = 0,
  CURLINFO_HEADER_IN,    /* 1 */
  CURLINFO_HEADER_OUT,   /* 2 */
  CURLINFO_DATA_IN,      /* 3 */
  CURLINFO_DATA_OUT,     /* 4 */
  CURLINFO_SSL_DATA_IN,  /* 5 */
  CURLINFO_SSL_DATA_OUT, /* 6 */
  CURLINFO_END
} curl_infotype;

Given that the last of my examples has a 2 and all the others have a 0 as their third argument, we can assume that this must be the type.

I have not figured out what the second argument is.

This leaves us with:

$curl->setopt(CURLOPT_DEBUGFUNCTION, sub {
    my ($text, undef, $type) = @_;

    # ...
});

As it happens, these types have been imported as constants by WWW::Curl::Easy. So we can do something like this to only get the outgoing header.

$curl->setopt(CURLOPT_DEBUGFUNCTION, sub {
    my ($text, undef, $type) = @_;

    print $text if $type == CURLINFO_HEADER_OUT;
});

This'll output:

$ /usr/bin/perl foo.pl
GET / HTTP/1.1
Host: example.com
Accept: */*

Transfer went ok

The incoming headers seem to be one at a time, so you could filter.

$curl->setopt(CURLOPT_DEBUGFUNCTION, sub {
    my ($text, undef, $type) = @_;

    if ($type == CURLINFO_HEADER_IN && $text =~ m/Etag: "(. )"/) {
        print "Etag is $1\n";
    }
});

A more involved example would be to take the entire debug output and convert it to HTTP::Request and HTTP::Response objects.

$curl->setopt(CURLOPT_WRITEDATA,\$response_body);
$curl->setopt(CURLOPT_VERBOSE, 1);

my ($req, $res);
$curl->setopt(CURLOPT_DEBUGFUNCTION, sub {
    my ($text, undef, $type) = @_;

    require HTTP::Request;
    require HTTP::Response;

    if ($type == CURLINFO_HEADER_OUT) {
        $req = HTTP::Request->parse($text);
    } elsif ($type == CURLINFO_DATA_OUT) {
        $req->content($text);
    } elsif ($type == CURLINFO_HEADER_IN) {
        unless ($res) {
            $res = HTTP::Response->parse($text);
            $res->request($req);
            return 0; # this is retcode
        }

        # this is from HTTP::Message
        # (https://metacpan.org/dist/HTTP-Message/source/lib/HTTP/Message.pm#L60)
        my @hdr;
        while (1) {
            if ($text =~ s/^([^\s:] )[ \t]*: ?(.*)\n?//) {
                push(@hdr, $1, $2);
                $hdr[-1] =~ s/\r\z//;
            }
            elsif (@hdr && $text =~ s/^([ \t].*)\n?//) {
                $hdr[-1] .= "\n$1";
                $hdr[-1] =~ s/\r\z//;
            }
            else {
                $text =~ s/^\r?\n//;
                last;
            }
        }
        $res->header(@hdr) if @hdr;
    } elsif ($type == CURLINFO_DATA_IN) {
        $res->content($text);
    }
    return 0; # this is retcode
});

This will give you an HTTP::Request and an HTTP::Response object each containing all headers and content. Not sure if that's useful, but it's a good demo of what is possible with this function.

Disclaimer: I am a maintainer of libwww-perl.