Anonymous Monk has asked for the wisdom of the Perl Monks concerning the following question:

Hello.

I'm looking for a way to get "real" outgoing headers, generated by LWP (I need them for logging/debugging purpose).

I already read few articles about related questions here, but that's not solve my issue, including this one:
http://www.perlmonks.org/?node_id=464442 - how to validate lwp::useragent request?


lwp_test_v1.pl 
#!/usr/bin/env perl -w

use strict;
use warnings;
$| = 1;    


my $url = 'http://example.com/';

use LWP::UserAgent;

{
    no warnings 'once';
    @LWP::Protocol::http::EXTRA_SOCK_OPTS = ( SendTE => 0, KeepAlive =
+> 1, PeerHTTPVersion => "1.1" );
}

my $ua = new LWP::UserAgent;
my $response = $ua->get("http://example.com");

warn "[Headers Out v1]\n", $response->request()->as_string(), "\n\n";
warn "[Headers In]:\n", $response->headers()->as_string, "\n\n";

[download]

lwp_test_v2.pl 
#!/usr/bin/env perl -w

use strict;
use warnings;
$| = 1;    


my $url = 'http://example.com/';

use LWP::UserAgent;
use HTTP::Request::Common;

{
    no warnings 'once';
    @LWP::Protocol::http::EXTRA_SOCK_OPTS = ( SendTE => 0, KeepAlive =
+> 1, PeerHTTPVersion => "1.1" );
}

my $ua = new LWP::UserAgent;

my $request = HTTP::Request::Common::GET($url);
$ua->prepare_request($request);

warn "[Headers Out v2]\n", $request->as_string, "\n\n";

my $response = $ua->send_request($request);

warn "[Headers Out v2]\n", $response->request()->as_string(), "\n\n";
warn "[Headers In]:\n", $response->headers()->as_string, "\n\n";

[download]

Both produce exactly same result for Headers Out:

GET http://example.com/
User-Agent: libwww-perl/6.05

[download]

But not "real" one, which looks like this:

GET / HTTP/1.1
Host: example.com
User-Agent: libwww-perl/6.05
Connection: keep-alive

[download]

Thanks in advance for any help.

Replies are listed 'Best First'.
Re: LWP is there any way to get "real" outgoing headers?
by InfiniteSilence (Curate) on May 24, 2014 at 03:56 UTC
    Edit

    My previous response was wrong -- I had not read your question correctly. You want the complete request. 

      DB<3> p $req->as_string()
GET http://search.cpan.org/dist/libwww%E2%88%92perl/
Accept: text/html

    [download]

    nope.. 

     p $req->dump
GET http://search.cpan.org/dist/libwww%E2%88%92perl/
Accept: text/html

(no content)

    [download]

    Not there either...

    If you debug waaaay down into the code you'll find it in an object stored in a variable but nothing you can access externally: 

    LWP::Protocol::http::request(/usr/lib/perl5/site_perl/5.10.0/LWP/Proto
+col/http.pm:226):
226:        if (!$has_content || $write_wait || $has_content > 8*1024)
+ {
  DB<17> p $req_buf
GET /dist/libwww%E2%88%92perl/ HTTP/1.1
TE: deflate,gzip;q=0.3
Connection: TE, close
Accept: text/html
Host: search.cpan.org
User-Agent: lwpcooktest.pl/0.1 libwww-perl/6.03

    [download]

    The previous response about capturing the request with an echo server of some kind is the safest way to go.

    Celebrate Intellectual Diversity

[reply]
[d/l]
[select]
      Thank you, yep, exactly :( I spend few hours trying various ways... I read somewhere in man long time ago - it don't give full control on outgoing headers. So that behavior predictable. But since I'm not looking to get any additional control and just want to get headers, which was already sent I hope there is some way to achieve that. So that's why I'm seeking for Perl wisdom here :)
[reply]
Re: LWP is there any way to get "real" outgoing headers?
by 2teez (Vicar) on May 24, 2014 at 04:19 UTC

    Oops! I misunderstood what the OP wanted. My answer below works for Incoming headers not Outgoing*

    The following works: 

    use warnings;
use strict;

use LWP::UserAgent;

my $ua = LWP::UserAgent->new;

my $url = 'http://www.google.com';

print $ua->head($url)->as_string;

    [download]
    OUTPUT: 
    HTTP/1.1 200 OK
Cache-Control: private, max-age=0
Connection: close
Date: Sat, 24 May 2014 04:17:59 GMT
Server: gws
Content-Type: text/html; charset=ISO-8859-1
Expires: -1
Alternate-Protocol: 80:quic
Client-Date: Sat, 24 May 2014 04:16:04 GMT
Client-Peer: 174.194.08.94:80
Client-Response-Num: 1
P3P: CP="This is not a P3P policy! See http://www.google.com/support/a
+ccounts/bin/answer.py?hl=en&answer=151657 for more info."
Set-Cookie: PREF=ID=6be73c938c0eb2c2:FF=0:TM=1400905079:LM=1400905079:
+S=d_WzZRSOQ6IZBvFA; expires=Mon, 23-May-2016 04:17:59 GMT; path=/; do
+main=.google.com.ng
Set-Cookie: NID=67=bU9SctXcLKJvZuBUQclTeWSIIJPWwD579z8_VsFNdP9AtU2dVx_
+5_rpEj_AGQIvcXVqeV3xka5H9aGSX_SN62h-bQ70smhmQ77HRB3o0uTsdUFnNeNU0u--x
+2IYvBj8c; expires=Sun, 23-Nov-2014 04:17:59 GMT; path=/; domain=.goog
+le.com.ng; HttpOnly
X-Frame-Options: SAMEORIGIN
X-XSS-Protection: 1; mode=block

    [download]

    * Update

    If you tell me, I'll forget.
    If you show me, I'll remember.
    if you involve me, I'll understand.
    --- Author unknown to me
[reply]
[d/l]
[select]
      Thank you, but I guess, you don't understand my question or didn't read it :(
      I can't get outgoing headers, not incoming. My code I posted above (and actually almost any code) perfectly catch incoming headers.
[reply]
        YOU control OUTGOING headers. There's NO guesswork involved. Just send what you damn well please. It's as simple as that.
        I even illustrated that in my first response to you.

        Your question makes no sense.

        ¡λɐp ʇɑəɹ⅁ ɐ əʌɐɥ puɐ ʻꜱdləɥ ꜱᴉɥʇ ədoH

[reply]
Re: LWP is there any way to get "real" outgoing headers?
by taint (Chaplain) on May 24, 2014 at 03:34 UTC
    Greetings.

    Have you taken the time to read the man pages (perldoc) that comes with the module?
    I actually created an online application, simply by modifying, and expanding on the examples given in the pod.

    Perhaps the following will be enough to get you going: 

    #!/usr/bin/perl -w

use Modern::Perl;
use strict;
use CGI qw/:standard/;
use LWP;

my $opt = ('http://');
my $url = param('url') || '';
my $product_id = ('MS-DOS/3.2');
my $agent    = LWP::UserAgent->new(agent=> $product_id);
my $ua = 'MS-DOS/3.2';
my $request  = HTTP::Request->new(HEAD => $opt.$url);
my $response = $agent->request($request);

if($url) {
&resp2;
} else {
&resp1;
}

    [download]
    Mind you. This is part of an online Perl script I use. So I haven't included the HTML form stuff, just the routines, and functions for the form input, and all else. But what I've omitted should be trivial for anyone even slightly familiar with form handling, and basic HTML skills. :)

    Best wishes.

    --Chris

    ¡λɐp ʇɑəɹ⅁ ɐ əʌɐɥ puɐ ʻꜱdləɥ ꜱᴉɥʇ ədoH

[reply]
[d/l]
      Thank you, but I guess, you don't understand my question or didn't read it :(
      Yes, of course I read man.
      I omit all extra code (including generating of extra headers from code, I posted in question).
      LWP generating correct headers, which I could check using any sniffer (I posted them in my question).
      My problem is how I can catch them using LWP itself, to be able to save them in logs, since it giving me out different headers (I posted them as well).
      And unless I'm complete idiot I don't understand how your code could help me :(
[reply]
        Oh. I deffinately read the question. I also took the time to read the link you cited in your OP. The question I now have is; What's your question?

        If I understood what was being attempted here, was that you're looking to make the HTTP (0.9|1.0|1.1) HEAD request. (RFC2616 && RFC2616 HTTP-1.0)

        It also appears that you need to send a specialized UA response?

        I know I can easily prepare a complete script in response to your question, in these regards. But I grow weary of attempting to provide you a solution. Only to be told I didn't even bother to read your OP.
        Insults are not the best way to solicit help from anyone -- anywhere.

        l8r

        --Chris

        ¡λɐp ʇɑəɹ⅁ ɐ əʌɐɥ puɐ ʻꜱdləɥ ꜱᴉɥʇ ədoH

[reply]
Re: LWP is there any way to get "real" outgoing headers?
by lancer (Scribe) on Jul 10, 2019 at 21:49 UTC
    This won't help with logging as you mentioned, but for debugging you could try this on Linux: 

    nc -v -l -p 3000

    [download]

    Then you send the request to "http://localhost:3000" , or to your server's hostname if it's not on localhost.

    This will show the entire request. You need to Ctrl-C out of it.

    Google took me to this page for showing the full request headers with LWP::UserAgent and this was the actual answer I used.
[reply]
[d/l]
Re: LWP is there any way to get "real" outgoing headers?
by Anonymous Monk on May 24, 2014 at 19:10 UTC
    LWP::Protocol::PSGI turned out to be a bust, so some more reading of of LWP::Protocol::http and LWP::Protocol::https revealed Net::HTTP::Methods::format_request 
    #!/usr/bin/perl --
use strict; use warnings;
use LWP;

sub LWP::Protocol::http::SocketMethods::format_request {
    package LWP::Protocol::http::SocketMethods;
    my( $socket, $method, $fullpath, @h ) = @_;
    my $req_buf = $socket->Net::HTTP::Methods::format_request($method,
+ $fullpath, @h);
    Data::Dump::dd( $req_buf );
    return $req_buf;
}
LWP::UserAgent->new->get( q{http://example.com/} )->dump;
__END__
"GET / HTTP/1.1\r\nTE: deflate,gzip;q=0.3\r\nConnection: TE, close\r\n
+Host: example.com\r\nUser-Agent: libwww-perl/6.05\r\n\r\n"
HTTP/1.1 200 OK
Cache-Control: max-age=604800
Connection: close
Date: Sat, 24 May 2014 19:06:51 GMT
Accept-Ranges: bytes
ETag: "359670651"
Server: ECS (sjc/4FCE)
Content-Length: 1270
Content-Type: text/html
Expires: Sat, 31 May 2014 19:06:51 GMT
Last-Modified: Fri, 09 Aug 2013 23:54:35 GMT
Client-Date: Sat, 24 May 2014 19:13:24 GMT
Client-Peer: 93.184.216.119:80
Client-Response-Num: 1
Title: Example Domain
X-Cache: HIT
X-Ec-Custom-Error: 1
X-Meta-Charset: utf-8
X-Meta-Viewport: width=device-width, initial-scale=1
...

    [download]
[reply]
[d/l]
[reply]

        Thank you very much for your huge help! :)

        That's _exactly_ what I was looking to get and achieve.
        Thank you for both great code example and for very useful links.

        I really appreciate that. :)
        P.S. Very beautiful and elegant hack IMHO.

[reply]

      I changed you code a bit to be able to use it with both HTTP and SSL/TLS requests, so it's looks like this now:

      #!/usr/bin/env perl -w

use strict; use warnings;
use LWP;

my $outgoing_headers = '';
sub LWP::Protocol::http::Socket::format_request { return main::format_
+request(@_); }
sub LWP::Protocol::https::Socket::format_request { return main::format
+_request(@_); }
sub format_request {
    my( $socket, $method, $fullpath, @h ) = @_;
    my $req_buf = $socket->Net::HTTP::Methods::format_request($method,
+ $fullpath, @h);
    $outgoing_headers = $req_buf;
    return $req_buf;
}

my $ua = new LWP::UserAgent;
my $response = $ua->get("http://example.com");
#my $response = $ua->get("https://google.com");

warn "[Headers Out Real]\n", $outgoing_headers, "\n\n";
warn "[Headers Out]\n", $response->request()->as_string(), "\n\n";
warn "[Headers In]:\n", $response->headers()->as_string, "\n\n";

      [download]

      It working great for test purpose. :)
      But of course I can't use global variables in my real code, since it will end with complete mess. So I have another problem - I have no idea how to put "$outgoing_headers" in private variable (I'll post my pseudo code with sub below): 

      #!/usr/bin/env perl -w

use strict; use warnings;
use LWP;

sub LWP::Protocol::http::Socket::format_request { return main::format_
+request(@_); }
sub LWP::Protocol::https::Socket::format_request { return main::format
+_request(@_); }
sub format_request {
    my( $socket, $method, $fullpath, @h ) = @_;
    my $req_buf = $socket->Net::HTTP::Methods::format_request($method,
+ $fullpath, @h);
    # $outgoing_headers = $req_buf;
    return $req_buf;
}


sub make_request {
    my ($url) = @_;

    my $outgoing_headers = '';    # the question is - how to put them 
+here?

    my $ua = new LWP::UserAgent;
    my $response = $ua->get($url);

    warn "[Headers Out Real]\n", $outgoing_headers, "\n\n";
    warn "[Headers Out]\n", $response->request()->as_string(), "\n\n";
    warn "[Headers In]:\n", $response->headers()->as_string, "\n\n";
}

make_request('http://example.com');

      [download]

      Any idea how I can do this? :)

[reply]
[d/l]
[select]

        But of course I can't use global variables in my real code, since it will end with complete mess. So I have another problem - I have no idea how to put "$outgoing_headers" in private variable (I'll post my pseudo code with sub below):

        You can't get away from global variables, you're monkeypatching :) but ok 

        #!/usr/bin/perl --
use strict; use warnings;
use LWP;
Main( @ARGV );
exit( 0 );

sub snoop {
    use Net::HTTP::Methods; ## important
    my( $url ) = @_;
    no warnings 'redefine';
    my $original = \&Net::HTTP::Methods::format_request;
    my $outgoing_headers = '';
    local *Net::HTTP::Methods::format_request = sub {
        $outgoing_headers = $original->(@_);
    };;
    my $ua = LWP::UserAgent->new;
    my $response = $ua->get($url);
    warn "[Headers Out Real]\n", $outgoing_headers, "\n\n";
    warn "[Headers Out]\n", $response->request()->as_string(), "\n\n";
    warn "[Headers In]:\n", $response->headers()->as_string, "\n\n";
}

sub Main {
    snoop( 'http://example.com' );
#~     snoop( 'https://example.com' );## duh, internal response doesn'
+t trigger format_request
    snoop( 'https://google.com' );
}
__END__

        [download]

        To not monkey patch you can always implement your own LWP::Protocol::Ahttp and LWP::Protocol::Ahttps where you save the format_request somewhere in the request/response/or/lwp object , and register them, but that's just a different kind of global :)

[reply]
[d/l]
Re: LWP is there any way to get "real" outgoing headers?
by Anonymous Monk on May 24, 2014 at 03:54 UTC
[reply]
      Thank you, I know how to get anything using external sniffer or proxy server (that's how I got real headers I posted in my question).
      My problem is - how to get them using LWP itself, not using any external program, including sniffers, proxy etc.
[reply]

        Thank you, I know how to get anything using external sniffer or proxy server (that's how I got real headers I posted in my question). My problem is - how to get them using LWP itself, not using any external program, including sniffers, proxy etc.

        Hmm, have you ever looked inside of LWP?

        Since LWP doesn't give you that, the only way you do it by editing the many modules that comprise LWP :)

        I prefer simple solutions, speaking of which, you could start a socket server, then hijack/redirect connections with EXTRA_SOCK_OPTS... but you probably thought of that and don't like it for some reason (i don't like to write that much code :)

        OTOH, I just looked and saw LWP::Protocol::nogo / LWP::Protocol::PSGI - Override LWP's HTTP/HTTPS backend with your own PSGI applciation

        I think this is as close as you can get :)

[reply]

Back to Seekers of Perl Wisdom