HTTP::Proxy in Perl - perl

I need show the "content" that is in the hash , i test with : $c->header("content") , but but shows nothing , but in the content hash value if this.
as I can show _content?
The hash
<pre>
$VAR1 = bless(
{
'_protocol' => 'HTTP/1.1',
'_content' => '-----------------------------8283483225031
Content-Disposition: form-data; name="archivo"; filename="GFWLIVESetupLog.txt"
Content-Type: text/plain
l i v e R e d i s t : 0
G F W L C l i e n t : 0
-----------------------------8283483225031
Content-Disposition: form-data; name="destino"
C:/perl/test.txt
-----------------------------8283483225031--
',
'_uri' => bless(
do {
\(
my $o =
'http://localhost/shell.php?uploa
d='
);
},
'URI::http'
),
'_headers' => bless(
{
'user-agent' => 'Mozilla/5.0 (Windows NT
5.1; rv:19.0) Gecko/20100101 Firefox/19.0',
'accept' => 'text/html,application/xhtml
+xml,application/xml;q=0.9,*/*;q=0.8',
'accept-language' => 'es-ar,es;q=0.8,en-
us;q=0.5,en;q=0.3',
'cookie' => 'PHPSESSID=a8bkktvsripf6agpi
fnma61qq4',
'content-length' => '378',
'host' => 'localhost',
'via' => '1.1 doddy-701c8cb49 (HTTP::Pro
xy/0.20)',
'content-type' => 'multipart/form-data;
boundary=---------------------------8283483225031',
'x-forwarded-for' => '127.0.0.1',
'referer' => 'http://localhost/shell.php
?upload='
},
'HTTP::Headers'
),
'_method' => 'POST'
},
'HTTP::Request'
);
</pre>
The source :
use HTTP::Proxy;
use HTTP::Proxy::BodyFilter::simple;
use HTTP::Proxy::BodyFilter::complete;
use Data::Dumper;
my $server = HTTP::Proxy->new(port=>8080);
$server->host();
$server->push_filter(mime=>undef,response => HTTP::Proxy::BodyFilter::complete->new());
$server->push_filter(
mime=>undef,
request=>HTTP::Proxy::BodyFilter::simple->new(\&enable),
response => HTTP::Proxy::BodyFilter::simple->new(\&enable2));
$server->start();
sub enable {
my($a,$b,$c,$d,$e) = #_;
print $c->header("content");
#print Dumper $c;
}
sub enable2 {
my ($j,$k,$l,$m,$n) = #_;
print $$k;
}
pd : excuse my bad English

The content is not in the headers. In your dumper output, the headers is the HTTP::Headers object denoted by the _headers key. You want to call the content method.
$c->content;
See the HTTP::Request documentation for a full list of available methods.

Related

How do I unittest CGI.pm's file upload?

I have a CGI which gets a File uploaded and does something with it.
I would like a Unittest for the fileupload functionality
After reading http://www.perlmonks.org/?node_id=249917
I tried to adapt the code in CGI.pm's t/upload.t
{
%ENV = (
%ENV,
'SCRIPT_NAME' => '/data.cgi',
'SERVER_NAME' => 'localhost',
'HTTP_CONNECTION' => 'TE, close',
'REQUEST_METHOD' => 'POST',
'SCRIPT_URI' => 'http://localhost/data.cgi',
'CONTENT_LENGTH' => '160',
'SCRIPT_FILENAME' => '/var/www/cgi-bin/data.cgi',
'SERVER_SOFTWARE' => 'Apache/1.3.27 (Unix) ',
'HTTP_TE' => 'deflate,gzip;q=0.3',
'QUERY_STRING' => '',
'REMOTE_PORT' => '1855',
'HTTP_USER_AGENT' => 'libwww-perl/5.69',
'SERVER_PORT' => '80',
'REMOTE_ADDR' => '127.0.0.1',
'CONTENT_TYPE' => 'multipart/form-data; boundary=xYzZY',
'SERVER_PROTOCOL' => 'HTTP/1.1',
'PATH' => '/usr/local/bin:/usr/bin:/bin',
'REQUEST_URI' => '/data.cgi',
'GATEWAY_INTERFACE' => 'CGI/1.1',
'SCRIPT_URL' => '/data.cgi',
'SERVER_ADDR' => '127.0.0.1',
'DOCUMENT_ROOT' => '/var/www/html',
'HTTP_HOST' => 'localhost'
);
local *STDIN;
open STDIN, '<test.txt' or die 'argh';
binmode STDIN;
$cgi = new CGI;
run()
}
test.txt:
--xYzZY
Content-Disposition: form-data; name="hello_world"; filename="goodbye_world.txt"
Content-Length: 13
Content-Type: text/plain
Goodbye World!
--xYzZY--
Now i get "400 Bad request (malformed multipart POST)" in cgi_error when i try to access the filehandle with
our $cgi;
sub run() {
$cgi = new CGI unless $cgi;
my $upload_fh = $cgi->upload('upload');
}

Parsing this kind of data

I have written a wrapper for an API. Previously I'd worked on simple string-based GET requests to PHP scripts using Perl.
As part of analysing the response, I have to analyse the following data which appears to be an object. Unfortunately, I'm not sure how to extract usable data from this.
print Dumper on the data returns this:
$VAR1 = bless( {
'_rc' => '200',
'_request' => bless( {
'_uri_canonical' => bless( do{\(my $o = 'http://example.com/?list=1&token=h_DQ-3lru6uy_Zy0w-KXGbPm_b9llY3LAAAAALSF1roAAAAANxAtg49JqlUAAAAA')}, 'URI::http' ),
'_content' => '',
'_uri' => $VAR1->{'_request'}{'_uri_canonical'},
'_method' => 'GET',
'_headers' => bless( {
'accept-charset' => 'iso-8859-1,*,utf-8',
'accept' => 'image/gif, image/x-xbitmap, image/jpeg, image/pjpeg, image/png, */*',
'cookie' => 'GUID=cHoW3DLOljP4K9LzposM',
'user-agent' => 'Mozilla/5.0 (Windows; U; Windows NT 5.1; en-US; rv:1.7) Gecko/20041107 Firefox/1.0',
'authorization' => 'Basic YWRtaW46bmljb2xl',
'cookie2' => '$Version="1"',
'::std_case' => {
'cookie' => 'Cookie',
'cookie2' => 'Cookie2'
},
'accept-language' => 'en-US'
}, 'HTTP::Headers' )
}, 'HTTP::Request' ),
'_headers' => bless( {
'client-peer' => 'myip:8085',
'content-type' => 'text/plain',
'cache-control' => 'no-cache',
'connection' => 'keep-alive',
'client-date' => 'Sat, 18 Jul 2015 12:41:00 GMT',
'::std_case' => {
'client-response-num' => 'Client-Response-Num',
'set-cookie2' => 'Set-Cookie2',
'client-date' => 'Client-Date',
'client-peer' => 'Client-Peer',
'set-cookie' => 'Set-Cookie'
},
'client-response-num' => 1,
'content-length' => '8684'
}, 'HTTP::Headers' ),
'_msg' => 'OK',
'_protocol' => 'HTTP/1.1',
'_content' => '{"build":30470,"torrents": [
["043CC5FA0C741CDAD9D2E5CC20DF64A4A400FA34",136,"Epi.S01E03.720p.HDTV.x264-IMMERSE[rarbg]",690765843,39,26951680,671744,24,0,0,0,"",0,1454,0,114,2436,1,663814163,"","","Stopped","512840d7",1437022635,0,"","/mydir/Epi.S01E03.720p.HDTV.x264-IMMERSE[rarbg]",0,"0368737A",false],
["097AA60280AE3E4BA8741192CB015EE06BD9F992",200,"Epi.S01E04.HDTV.x264-KILLERS[ettv]",221928759,1000,221928759,8890308649,40059,0,0,0,"",0,1461,0,4395,65536,-1,0,"","","Queued Seed","512840d8",1437022635,1437023190,"","/mydir/Epi.S01E04.HDTV.x264-KILLERS[ettv]",0,"8F52310A",false]],
"label": [],"torrentc": "350372445"
,"rssfeeds": []
,"rssfilters": []
}
',
'_msg' => 'OK',
'_protocol' => 'HTTP/1.1'
}, 'HTTP::Response' );
I would like to extract each of the following strings from the returned object
097AA60280AE3E4BA8741192CB015EE06BD9F992
200
Epi.S01E04.HDTV.x264-KILLERS[ettv]
Unfortunately, my understanding of objects in Perl is very elementary.
The original code which returns this data looks like this:
my $ua = LWP::UserAgent->new();
my $response = $ua->get( $url, #ns_headers );
print Dumper($response);
How can I work on the strings that of interest?
If you read the documentation for HTTP::Response, you will see that there is a content method, which will return the content of your HTTP message, and a decoded_content method that does the same but also decompresses the data if it happens to be compressed (in your case the data is uncompressed.)
In this case it looks like the content is encoded as JSON data, so you will also need to load the JSON module to decode it into a Perl data structure
For example
use JSON 'from_json';
my $content = from_json $response->decoded_content;
my $torrents = $content->{torrents};
for my $torrent ( #$torrents ) {
say for #$torrent[0,1,2];
say '';
}
output
043CC5FA0C741CDAD9D2E5CC20DF64A4A400FA34
136
Epi.S01E03.720p.HDTV.x264-IMMERSE[rarbg]
097AA60280AE3E4BA8741192CB015EE06BD9F992
200
Epi.S01E04.HDTV.x264-KILLERS[ettv]

LWP Get Large File Download Headers Missing

This post is follow on work related to LWP GET large file download. That post was regarding an error from LWP when trying to pass arguments in the header incorrectly. Now I am posting the changes I made and how I am trying to debug the approach. This discussion should be very informative for those interested in POST vs GET header formation, and what the server receives while using the CGI package. It is not information easily found on the net.
Here is my client code snip:
my $bytes_received = 0; # vars used below are set prior to this point
my $filename = $opt{t}."/$srcfile";
open (FH, ">", "$filename") or $logger->error( "Couldn't open $filename for writing: $!" );
my $ua = LWP::UserAgent->new();
my $target = $srcfile;
my $res = $ua->get(
$url,
':content_cb' => \&callback,
'api' => 'olfs', # Note attempted use of different types of quotes had no impact
"cmd" => 'rfile',
"target" => $target,
"bs" => $bs
);
print $logger->info("$bytes_received bytes received");
sub callback{
my($chunk, $res) = #_;
$bytes_received += length($chunk);
print FH $chunk;
}
Here is the server snip (cgi script):
my $query = new CGI;
my $rcvd_data = Dumper($query);
print $rcvd_data;
Here is the output from a GET:
$VAR1 = bless( {
'.parameters' => [],
'use_tempfile' => 1,
'.charset' => 'ISO-8859-1',
'.fieldnames' => {},
'param' => {},
'.header_printed' => 1,
'escape' => 1
}, 'CGI' );
Here is a client with a POST request:
my $ua = new LWP::UserAgent();
local $HTTP::Request::Common::DYNAMIC_FILE_UPLOAD = 1;
my $req =
POST
$url,
'Content_Type' => 'form-data',
'Content' => {
"api" => 'olfs',
"cmd" => 'wfile',
"target" => $target,
"tsize" => $file_size,
"bs" => $bs,
"filename" => [ $file ] };
# HTTP::Message calls set_content, which appears to set the subroutine for content
# LWP::UserAgent
# LWP::Protocol::file::request sends content in chunks
#
$req->content( $req->content() );
$logger->info("Uploading: $file");
my $resp = $ua->request($req);
Here is the output on the server, just like before but now from the POST:
'.parameters' => [
'cmd',
'bs',
'api',
'target',
'filename',
'tsize'
],
'use_tempfile' => 1,
'.tmpfiles' => {
'*Fh::fh00001random23' => {
'info' => {
'Content-Type' => 'text/plain',
'Content-Disposition' => 'form-data; name="filename"; filename="random23"'
},
'name' => bless( do{\(my $o = '/usr/tmp/CGItemp33113')}, 'CGITempFile' ),
'hndl' => bless( \*Fh::fh00001random23, 'Fh' )
}
},
'.charset' => 'ISO-8859-1',
'.fieldnames' => {},
'param' => {
'cmd' => [
'wfile'
],
'bs' => [
'buffer1'
],
'api' => [
'olfs'
],
'target' => [
'random23'
],
'tsize' => [
'1073741824'
],
'filename' => [
$VAR1->{'.tmpfiles'}{'*Fh::fh00001random23'}{'hndl'}
},
'escape' => 1,
'.header_printed' => 1
}, 'CGI' );
In short, you can see in the POST dump the "key" / "value" pairs, ie "target => random23". In the GET dump I do not find any keys or values from what I submitted on the client side. Can that be explained, or what do I need to do so as to extract key / value pairs in the CGI script?
You're passing your form variables as HTTP headers.
Like I previously mentioned, if you want to build a url, you can use URI.
$url = URI->new($url);
$url->query_form(
api => 'olfs',
cmd => 'rfile',
target => $target,
bs => $bs,
);

Cookies in perl lwp

I once wrote a simple 'crawler' to download http pages for me in JAVA.
Now I'm trying to rewrite to same thing to Perl, using LWP module.
This is my Java code (which works fine):
String referer = "http://example.com";
String url = "http://example.com/something/cgi-bin/something.cgi";
String params= "a=0&b=1";
HttpState initialState = new HttpState();
HttpClient httpclient = new HttpClient();
httpclient.setState(initialState);
httpclient.getParams().setCookiePolicy(CookiePolicy.NETSCAPE);
PostMethod postMethod = new PostMethod(url);
postMethod.addRequestHeader("Referer", referer);
postMethod.addRequestHeader("User-Agent", " Mozilla/5.0 (Windows; U; Windows NT 6.1; pl; rv:1.9.2.13) Gecko/20101203 Firefox/3.6.13");
postMethod.addRequestHeader("Accept", "text/html,application/xhtml+xml,application/xml;q=0.9,/;q=0.8");
postMethod.addRequestHeader("Content-Type", "application/x-www-form-urlencoded");
String length = String.valueOf(params.length());
postMethod.addRequestHeader("Content-Length", length);
postMethod.setRequestBody(params);
httpclient.executeMethod(postMethod);
And this is the Perl version:
my $referer = "http://example.com/something/cgi-bin/something.cgi?module=A";
my $url = "http://example.com/something/cgi-bin/something.cgi";
my #headers = (
'User-Agent' => 'Mozilla/5.0 (Windows; U; Windows NT 6.1; pl; rv:1.9.2.13) Gecko/20101203 Firefox/3.6.13',
'Accept' => 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
'Referer' => $referer,
'Content-Type' => 'application/x-www-form-urlencoded',
);
my #params = (
'a' => '0',
'b' => '1',
);
my $browser = LWP::UserAgent->new( );
$browser->cookie_jar({});
$response = $browser->post($url, #params, #headers);
print $response->content;
The post request executes correctly, but I get another (main) webpage. As if cookies were not working properly...
Any guesses what is wrong?
Why I'm getting different result from JAVA and perl programs?
You can also use WWW::Mechanize, which is a wrapper around LWP::UserAgent. It gives you the cookie jar automatically.
You want to be creating hashes, not arrays - e.g. instead of:
my #params = (
'a' => '0',
'b' => '1',
);
You should use:
my %params = (
a => 0,
b => 1,
);
When passing the params to the LWP::UserAgent post method, you need to pass a reference to the hash, e.g.:
$response = $browser->post($url, \%params, %headers);
You could also look at the request you're sending to the server with:
print $response->request->as_string;
You can also use a handler to automatically dump requests and responses for debugging purposes:
$ua->add_handler("request_send", sub { shift->dump; return });
$ua->add_handler("response_done", sub { shift->dump; return });
I believe it has to do with $response = $browser->post($url, #params, #headers);
From the doc of LWP::UserAgent
$ua->post( $url, \%form )
$ua->post( $url, \#form )
$ua->post( $url, \%form, $field_name => $value, ... )
$ua->post( $url, $field_name => $value,... Content => \%form )
$ua->post( $url, $field_name => $value,... Content => \#form )
$ua->post( $url, $field_name => $value,... Content => $content )
Since your params and headers are as hashes, I would try this:
my $referer = "http://example.com/something/cgi-bin/something.cgi?module=A";
my $url = "http://example.com/something/cgi-bin/something.cgi";
my %headers = (
'User-Agent' => 'Mozilla/5.0 (Windows; U; Windows NT 6.1; pl; rv:1.9.2.13) Gecko/20101203 Firefox/3.6.13',
'Accept' => 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
'Referer' => $referer,
'Content-Type' => 'application/x-www-form-urlencoded',
);
my %params = (
'a' => '0',
'b' => '1',
);
my $browser = LWP::UserAgent->new( );
$browser->cookie_jar({});
$response = $browser->post($url, \%params, %headers);

How do I access a value of a nested Perl hash?

I am new to Perl and I have a problem that's very simple but I cannot find the answer when consulting my Perl book.
When printing the result of
Dumper($request);
I get the following result:
$VAR1 = bless( {
'_protocol' => 'HTTP/1.1',
'_content' => '',
'_uri' => bless( do{\(my $o = 'http://myawesomeserver.org:8081/counter/')}, 'URI::http' ),
'_headers' => bless( {
'user-agent' => 'Mozilla/5.0 (X11; U; Linux i686; en; rv:1.9.0.4) Gecko/20080528 Epiphany/2.22 Firefox/3.0',
'connection' => 'keep-alive',
'cache-control' => 'max-age=0',
'keep-alive' => '300',
'accept' => 'text/html,application/xhtml+xml,application/xml;q=0.9,*/*;q=0.8',
'accept-language' => 'en-us,en;q=0.5',
'accept-encoding' => 'gzip,deflate',
'host' => 'localhost:8081',
'accept-charset' => 'ISO-8859-1,utf-8;q=0.7,*;q=0.7'
}, 'HTTP::Headers' ),
'_method' => 'GET',
'_handle' => bless( \*Symbol::GEN0, 'FileHandle' )
}, 'HTTP::Server::Simple::Dispatched::Request' );
How can I access the values of '_method' ('GET') or of 'host' ('localhost:8081').
I know that's an easy question, but Perl is somewhat cryptic at the beginning.
Narthring has it right as far as the brute force method. Nested hashes are addressed by chaining the keys like so:
$hash{top_key}{next_key}{another_key}; # for %hash
# OR
$hash_ref->{top_key}{next_key}{another_key}; # for refs.
However since both of these "hashes" are blessed objects. It might help reading up on HTTP::Server::Simple::Dispatched::Request, which can tell you that it's a HTTP::Request object and looking at HTTP::Request section on the header and method methods, tells you that the following do the trick:
my $method = $request->method();
my $host = $request->header( 'host' );
Really, I recommend you get the firefox search plugin called Perldoc Module::Name and when you encounter Dumper output that says "bless ... 'Some::Module::Name'" you can just copy and paste it into the search plugin and read the documentation on CPAN.