Beefy Boxes and Bandwidth Generously Provided by pair Networks
P is for Practical
 
PerlMonks  

Re: LWP is there any way to get "real" outgoing headers?

by Anonymous Monk
on May 24, 2014 at 19:10 UTC ( [id://1087328]=note: print w/replies, xml ) Need Help??


in reply to LWP is there any way to get "real" outgoing headers?

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 ...

Replies are listed 'Best First'.
Re^2: LWP is there any way to get "real" outgoing headers?
by Anonymous Monk on May 24, 2014 at 19:29 UTC

      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.

Re^2: LWP is there any way to get "real" outgoing headers?
by Anonymous Monk on May 25, 2014 at 16:14 UTC

    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";

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

    Any idea how I can do this? :)

      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__

      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 :)

        Thank you very much once again! :)

        I was trying to use something similar, but both my attempt and yours fail :(

        Also I was trying to use Persistent Private Variables (http://perldoc.perl.org/perlsub.html#Persistent-Private-Variables) - but failed as well (with same result - mess).

        My script working in non blocking mode, using Coro::AnyEvent. So, replies could come back in random way (not in the same order I sent them). As result it's turned in complete mess - outgoing headers from one request and incoming from another one :) That's why I need to use only private variables there.

        Looks like patching LWP only one way to achieve what I want, so it will return $response->request()->as_string() - real headers (like you suggest me already). Also I need to do something with internal responses anyway, since most of them will come with SSL/TLS connections.

        Already patched few other modules anyway for my script, just trying to achieve what I need using other ways first. :)

        Another option - switch to something from LWP, but I will need to rewrite way to many code, which already tested and working perfectly (so most likely not worth it).

        Thank you once again for your huge help and for your time spending on me. I learned some new tricks, which I maybe use somewhere else. :)

Log In?
Username:
Password:

What's my password?
Create A New User
Domain Nodelet?
Node Status?
node history
Node Type: note [id://1087328]
help
Chatterbox?
and the web crawler heard nothing...

How do I use this?Last hourOther CB clients
Other Users?
Others drinking their drinks and smoking their pipes about the Monastery: (5)
As of 2024-04-19 02:07 GMT
Sections?
Information?
Find Nodes?
Leftovers?
    Voting Booth?

    No recent polls found