How do I create a gzip compressed HTTP::Response? - perl

I need to create an HTTP::Response with compressed data. How do I go about making the content gzipped? Do I just add the appropriate headers and compress it myself using Compress::Zlib? Or does any of the LWP modules provide a method for handling this?

Is this what you need? You gzip the data, set the Content-encoding header, and send it off.
use strict;
use warnings;
use HTTP::Response;
use IO::Compress::Gzip qw(gzip);
my $data = q(My cat's name is Buster);
my $gzipped_data;
my $gzip = gzip \$data => \$gzipped_data;
print STDERR $gzipped_data;
my $response = HTTP::Response->new;
$response->code( 200 );
$response->header( 'Content-type' => 'text/plain' );
$response->header( 'Content-encoding' => 'gzip' );
$response->header( 'Content-length' => length $gzipped_data );
$response->content( $gzipped_data );
print $response->as_string;

Related

Perl JIRA POST error "headers must be presented as a hashref"

I am writing a Perl script to POST an attachment to JIRA using
REST::Client to access the API
but I am getting an error.
use REST::Client;
use warnings;
use strict;
use File::Slurp;
use MIME::Base64;
my $user = 'user';
my $pass = 'pass';
my $url = "http://******/rest/api/2/issue/BugID/attachments";
my $client = REST::Client->new();
$client->addHeader( 'Authorization', 'Basic' . encode_base64( $user . ':' . $pass ) );
$client->addHeader( 'X-Atlassian-Token', 'no-check' );
$client->setHost( $url );
# my %header = ('Authorization' => 'Basic'. encode_base64($user . ':' . $pass),'X-Atlassian-Token' => 'no-check');
my $attachment = "C:\\Folder\\Test.txt";
$client->POST(
$url,
'Content_Type' => 'form-data',
'Content' => [ 'file' => [$attachment] ]
);
if ( $client->responseCode() eq '200' ) {
print "Updated\n";
}
# print the result
print $client->responseContent() . "\n";
The error I get is
REST::Client exception: headers must be presented as a hashref at C:\Users\a\filename.pl line 24.
As shown in the code, I have tried setting headers in different ways but I still get same error.
Please suggest if there is any other method.
I have tried using JIRA module but it gives error too.
According to the documentation, the POST method:
Takes an optional body content and hashref of custom request headers.
You need to put your headers in a hashref, e.g.:
$client->POST($url, $content, {
foo => 'bar',
baz => 'qux'
});
But...it looks like you're expecting REST::Client to use HTTP::Request::Common to construct a multipart/form-data request. Unfortunately, that's not the case, so you'll have to build the content by hand.
You could use HTTP::Request::Common directly like this:
use strict;
use warnings 'all';
use 5.010;
use HTTP::Request::Common;
use REST::Client;
my $client = REST::Client->new;
my $url = 'http://www.example.com';
my $req = POST($url,
Content_Type => 'form-data',
Content => [ file => [ 'foo.txt' ] ]
);
$client->POST($url, $req->content(), {
$req->headers->flatten()
});
But this is a bit convoluted; I would recommend dropping REST::Client and using LWP::UserAgent instead. REST::Client is just a thin wrapper for LWP::UserAgent with a few convenience features, like prepending a default host to all requests. In this case, it's just getting in the way and I don't think the conveniences are worth the trouble.
From the documentation:
POST ( $url, [$body_content, %$headers] )
And you're doing:
$client->POST(
$url,
'Content_Type' => 'form-data',
'Content' => [ 'file' => [$attachment] ]
);
So - passing a list of scalars, with an arrayref at the end.
Perhaps you want something like:
$client->POST(
$url,
$attachment,
{ 'Content-Type' => 'form-data' }
);
Note the {} to construct an anonymous hash for the headers.
Although you probably want to open and include the 'attachment', because there's nothing in REST::Client about opening files and sending them automagically.

Perl LWP::UserAgent only reading first line of posted jpg file

I'm sure this has been asked but I could not find a good question to my answer. I've got two scripts, one makes a post using LWP::UserAgent and the other basically receives the data, in this case I'm just looking to write a file. The file does get written but it can't be opened and the size is 1262 which leads me to believe only some of it is being read.
Here's what I'm doing (It's worth noting, I was uri/base64 encoding the file and passing everything via json, which was working, but my new task is the split the files out and pass everything as form params):
post script:
open (IMAGE, "./flower.jpg") or die "$!";
$raw_string1 = do{ local $/ = undef; <IMAGE>; };
my $req = HTTP::Request->new(POST => $url);
$req->content_type("application/x-www-form-urlencoded");
$req->content("json_string=$json&file_1=$raw_string1");
my $ua = LWP::UserAgent->new;
$res = $ua->request($req);
print $res->content;
Receiver script:
$cgi = CGI->new;
my $json_post = $cgi->param('json_string');
my $file_1 = $cgi->param('file_1');
open my $fh, '>', "$path/flower.jpg" or die $!;
binmode $fh;
print $fh $file_1;
close $fh;
Thanks for help in advance!
As previously mentioned, you have an encoding problem. The solution is simple:
my $req = HTTP::Request->new(POST => $url, [
json_string => $json,
file_1 => $raw_string1,
]);
which is short for
my $req = HTTP::Request->new(POST => $url,
Content_Type => 'application/x-www-form-urlencoded',
Content => [
json_string => $json,
file_1 => $raw_string1,
]
);
It's far more typical to use multipart/form-data to upload files, though. And if you do, you can even let HTTP::Request load the file for you!
my $req = HTTP::Request->new(POST => $url,
Content_Type => 'multipart/form-data',
Content => [
json_string => $json,
file_1 => [ 'flower.jpg' ],
]
);
CGI.pm will handle that no problem. See the section of the docs titled "PROCESSING A FILE UPLOAD FIELD".
You're not encoding the $raw_string1 data before sticking it into the HTTP POST body. That means that if the data in flower.jpg includes a hex 0x26 byte (the & char) -- at position 1263, let's say -- then the POST data will look like this:
json_string={ ... JSON data ... }&file_1=...1262 bytes of raw JPEG data...&...more JPEG data...
... which means that anything parsing the form body for form variables will truncate file_1 after 1262 bytes.
I'd recommend continuing to encode the $raw_string1 data with base64 or something similar, even if you pass it through as its own POST variable rather than adding it to the JSON data.

set http header in perl to force download the content

I am trying to force download a file by sending http headers via perl. the current code is as follow:
#!/usr/bin/perl
use strict;
use Session;
use CGI::Carp qw(fatalsToBrowser);
use HTTP::Headers;
HTTP::Headers->new(
Content_type => 'text/plain',
Content_disposition => 'attachment; filename=export.txt',
);
print 'just some text';
exit;
I have also included HTTP::Headers however when I run this, it prints out the text instead of downloading the content...
You're just constructing the HTTP::Headers, but it's never printed to stdout. So you have to call also the as_string method:
my $h = HTTP::Headers->new(
Content_type => 'text/plain',
Content_disposition => 'attachment; filename=export.txt',
);
print $h->as_string;
But this is just printing the HTTP header without the separator between header and body. If you want to let libwww-perl to do this for you, you can also use HTTP::Message:
use HTTP::Headers;
use HTTP::Message;
my $h = HTTP::Headers->new(
Content_type => 'text/plain',
Content_disposition => 'attachment; filename=export.txt',
);
my $content = 'just some text';
my $msg = HTTP::Message->new($h, $content);
print $msg->as_string;
To be more correct, you should probably use "\r\n" as line terminators:
print $msg->as_string("\015\012");
Another alternative is to use CGI.pm, and use the header method, which can be used to set response HTTP headers. Actually, using CGI.pm is more common than using the HTTP::* classes. The latter are more common in use when dealing with dealing with LWP::UserAgent to fetch web pages.
When you are using CGI, you can set it when printing the header via CGI that way:
my $q = CGI->new();
print $q->header(
-type => 'text/plain',
-charset => 'iso-8859-1',
-attachment => 'filename.txt',
);
ok I figured out a simpler way...
instead of using HTTP::Headers I simply printed out the following lines:
print"Content-type:text/plain\n";
print"Content-disposition:attachment; filename=export.txt\n\n";
which did the trick...
This is the code using the CGI module:
use CGI qw(:standard);
print header(-type => "text/plain", -content_disposition => "attachment; filename=filename=export.txt");
print "just some text";

Perl post request to send zip file as base64?

I have a Perl script trying to send a zip file like so with LWP UserAgent module
my $req = POST $url, Content_Type => 'form-data',
Content => [
submit => 1,
upfile => [ $fname ]
];
where $fname is the path of the file. On the server side though it seems my POST array only has "submit".
Should I base64 encode the file and assign it to a variable? What's the best way to do this?
Make sure the filename can be resolved. You should get an error if it cannot be, though. At least I do in my version of HTTP::Request::Common.
You don't have to encode the binary content as Base64. (Unless, of course, the server-side app happens to expect that format.)
Here's a complete sample script:
use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Request::Common 'POST';
my $ua = LWP::UserAgent->new;
my $url = 'http://localhost:8888'; # Fiddler
my $req = POST $url,
Content_Type => 'form-data',
Content => [
submit => 1,
upfile => [ 'C:\temp\bla.zip' ],
];
my $line = '=' x 78 . "\n";
print $line, $req->as_string;
my $rsp = $ua->request( $req );
print $line, $rsp->as_string;

Clone request headers in Vanilla Perl CGI to LWP UserAgent

I have a perl CGI application that I want to take the users request headers, and turn those around into an LWP::UserAgent get request. Basically the goal is to replicate the incoming users headers and use those to make a separate request.
I've tried to create the headers myself but when I attempt to display the CGI headers and then my clone UserAgent headers, they aren't exactly the same. Here's what I got:
my $cgi = new CGI;
my %headers = map { $_ => $cgi->http($_) } $cgi->http;
my $req_headers = HTTP::Headers->new( %headers );
my $ua = LWP::UserAgent->new( default_headers => $req_headers );
print Dumper $ua->default_headers;
Basically, %headers and $ua->default_headers are not identical. $ua->default_headers has an agent that identifies itself as a perl script. I can manually set $ua->agent("") but there are other imperfections and the headers still aren't identical.
What's the best way to do what I want? There's got to be an easier solution...
It looks like the problem has to do with naming of incoming http headers compared to what HTTP::Headers uses.
The incoming parameters all have HTTP_ prefix in them where HTTP::Headers doesn't use that naming convention (which makes sense). Plus it looks like (a quick read in the code) that HTTP::Headers does the right thing in converting '-' into '_' for its own use.
I would recommended changing your map to following that removes the prefix:
# remove leading HTTP_ from keys, note: this assumes all keys have pattern
# HTTP_*
%headers = map { ( /^HTTP_(.*?)$/ ) => $cgi->http($_) } $cgi->http;
Here is the debugging script I used:
my $cgi = CGI->new;
my %headers = map { $_ => $cgi->http($_) } $cgi->http;
my $req_headers = HTTP::Headers->new( %headers );
my $ua = LWP::UserAgent->new( default_headers => $req_headers );
print "Content-type: text/plain\n\n";
print Dumper($ua->default_headers);
print Dumper( \%headers );
# remove HTTP_ from $_
%headers = map { ( /^HTTP_(.*?)$/ ) => $cgi->http($_) } $cgi->http;
$req_headers = HTTP::Headers->new( %headers );
$ua = LWP::UserAgent->new( default_headers => $req_headers );
print "headers part deux:\n";
print Dumper( $ua );
Hope that Helps