转储 WWW::Curl::Easy 请求

Question

我使用包 WWW::Curl::Easy 进行 API 调用，这是我的示例代码：

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();

我能以某种方式转储来自 $curl 的整个请求吗？

我尝试了 main::_log(Dumper($curl)); 但它没有给我任何有用的东西。

我希望看到整个请求，例如真实的 headers、方法、请求的 body、post 数据等。我知道我可以在代码中看到这些信息，因为我例如在 CURLOPT_HTTPHEADER 中设置它，但我想转储将要发送的“真实”请求（来自 curl）。

Answer 1

最简单的方法是在您的程序中打开 CURLOPT_VERBOSE。

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;

输出：

*   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

如果你想要更花哨的东西，你必须自己动手。您可以通过将 CURLOPT_DEBUGFUNCTION 设置为 Perl 代码引用来覆盖 CURLOPT_VERBOSE 所做的事情。每行调试输出都会调用它。

签名似乎与 libcurl 文档中的不同，但可以推断出发生了什么。

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

此集合的前几行输出如下所示。

[
    [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
]

第一个参数似乎是文本。

根据文档，调试数据有几种类型。

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;

鉴于我的最后一个示例有一个 2 并且所有其他示例都有一个 0 作为它们的第三个参数，我们可以假设这一定是类型。

我还没弄明白第二个参数是什么。

这给我们留下了：

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

    # ...
});

碰巧，这些类型已被 WWW::Curl::Easy 作为常量导入。所以我们可以做这样的事情来只得到传出的 header.

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

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

这将输出：

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

Transfer went ok

传入的 header 似乎一次只有一个，因此您可以过滤。

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

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

一个更复杂的例子是获取整个调试输出并将其转换为 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, , );
                $hdr[-1] =~ s/\r\z//;
            }
            elsif (@hdr && $text =~ s/^([ \t].*)\n?//) {
                $hdr[-1] .= "\n";
                $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
});

这将为您提供一个 HTTP::Request 和一个 HTTP::Response object，每个都包含所有 header 和内容。不确定这是否有用，但它很好地演示了此功能的可能性。

免责声明：我是 libwww-perl.

的维护者

转储 WWW::Curl::Easy 请求

Dump WWW::Curl::Easy request

perl

curl

request