Send a file with payload using curl in Perl - perl

I am trying to post an image to tinyping.com, but I need this to be done inside PERL without shelling out to curl. This command works great.
curl -i --user api:****** --data-binary #myImage.png https://api.tinypng.com/shrink
How would I express this using LWP library in Perl? I am very basic in Perl.
So far I have:
use LWP::UserAgent;
use MIME::Base64;
my $img_target_dir = ...;
my $imgname = ...;
####
#not sure if i need to convert to BASE64
open (IMAGE, "$img_target_dir$imgname") or die "$!";
$raw_string = do{ local $/ = undef; <IMAGE>; };
$encoded = MIME::Base64::encode_base64( $raw_string );
####
my $content = post(
"https://api:***************************\#api.tinypng.com/shrink",
Content_Type => 'image/png',
Content =>[
]
) or die print "failure\n";

I ended up just shelling out to curl. Works great.
###### tinyPNG.com ######
my #file = "$img_target_dir$imgname";
print "Sending the PNG for compression at tinyPNG.com\n";
my $curl = `/usr/local/bin/curl -ki --user api:**************** --data-binary #"#file" https://api.tinypng.com/shrink`;
$curl=~ /Location: (.*)/;
my $url = "$1";
print "Image Compressed At: $url</b>\n";
my $curl2 = `/usr/local/bin/curl -k "$url" > "#file"`;
chmod(0775, "#file");
#########################

Related

Uploading a file with perl LWP PUT method silency fails

I am trying to upload a file to a public API with a code similar to this:
my $ua = LWP::UserAgent->new;
sub uploadbox {
my $url = "http://host/token";
my $response = $ua->put($url,
'Content_Type' => 'form-data',
'Content' => [
Filedata => [ "$codename.box", "$codename.box", Content_type => 'application/octet-stream' ]
]
);
}
uploadbox();
This code runs, and exits without uploading anything ( the uploaded files are 300MB big, so it shoud take time).
Am I passing the right parameters to the put subroutine ?
How to further debug this ?
I like to debug LWP::UserAgent scripts using LWP::ConsoleLogger::Easy. (Disclaimer: this is one of my own modules).
use LWP::ConsoleLogger::Easy qw( debug_ua );
my $ua = LWP::UserAgent->new;
debug_ua( $ua );
# insert the rest of your code here
You'll now get a huge amount of debugging information from both the request and the response printed to your terminal. That should hopefully give you a good starting point to figure out what's going on.
In the end I just decided to use curl, and I get a dynamic status line for free
sub uploadbox {
my ($url) = #_;
my $curl = "curl -X PUT $url --upload-file $codename.box";
$OUTPUT_AUTOFLUSH = 1;
open(CURL, '-|', $curl,) or die "error: $ERRNO";
while (<CURL>) { say; }
}
not the code I am most proud of but ...

Get access token in perl

There is a working sample of getting token in bash
response=$(curl --fail --silent --insecure --data "username=test&password=test" \
--header "Authorization: Basic Y2xvdWQtYmVzcG9rZTo=" \
-X POST "https://lab7.local:8071/auth/token?grant_type=password")
token=`echo "$response" | awk '/access_token/{print $NF}' |sed 's/\"//g'`
echo $token
I'm trying to translate it in perl, but getting code 400
#!/usr/bin/env perl
use strict;
use warnings;
use HTTP::Request;
use LWP::UserAgent;
use LWP::Simple;
use JSON::XS;
use Try::Tiny;
my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new(POST => "https://lab7.local:8071/auth/token?grant_type=password");
my $post_data = "username=test&password=test";
$req->content($post_data);
my $resp = $ua->request($req);
if ($resp->is_success) {
my $mess = $resp->decoded_content;
print "$mess\n";
} else {
my $code = $resp->code;
print $code;
}
Your curl version is sending an Authentication header that is missing from the Perl version. You should add that.
$req->header(Authorization => 'Basic Y2xvdWQtYmVzcG9rZTo=');
You're adding a basic auth header, with a username. That string is just the base 64 encoded equivalent.
So you should probably include this in your LWP:
$req -> authorization_basic ( 'cloud-bespoke' );
And it should work.

Perl SVN hook with czech characters

I downloaded the sample SVN post-commit hook provided by Slack integration.
#!/usr/bin/perl
use warnings;
use strict;
use HTTP::Request::Common qw(POST);
use HTTP::Status qw(is_client_error);
use LWP::UserAgent;
use JSON;
my $repository = "myrepo";
my $websvn = "websvn.mydomain.com";
my $opt_domain = "myteam.slack.com";
my $opt_token = "mytoken";
my $log = qx|export LC_ALL="cs_CZ.UTF-8"; /usr/bin/svnlook log -r $ARGV[1] $ARGV[0]|;
my $log = $log." ".unpack('H*',$log);
my $who = `/usr/bin/svnlook author -r $ARGV[1] $ARGV[0]`;
my $url = "http://${websvn}/revision.php?repname=${repository}&rev=$ARGV[1]";
chomp $who;
my $payload = {
'revision' => $ARGV[1],
'url' => $url,
'author' => $who,
'log' => $log,
};
my $ua = LWP::UserAgent->new;
$ua->timeout(15);
my $req = POST( "https://${opt_domain}/services/hooks/subversion?token=${opt_token}", ['payload' => encode_json($payload)] );
my $s = $req->as_string;
print STDERR "Request:\n$s\n";
my $resp = $ua->request($req);
$s = $resp->as_string;
print STDERR "Response:\n$s\n";
(full file here: https://github.com/tinyspeck/services-examples/blob/master/subversion.pl)
Now the problem is, that if I want to commit message containing special characters (Czech), the string is unable to translate properly and the resulting message in slack channel looks like this:
25: falnyr - ÅeÅicha
c59865c5996963686120746573746f766163c3ad20636f6d6d69740a
I have read about the isolated (vacuum) SVN hook environment, so I assume I need to declare the locale inside the script, but since I am untouched by Perl, I really don`t know how.
My commit attempt:
falnyr#cap:test $ export LC_ALL="cs_CZ.UTF-8"
falnyr#cap:test $ touch file.txt
falnyr#cap:test $ svn add file.txt
A file.txt
falnyr#cap:test $ svn commit -m "Řeřicha"
Store password unencrypted (yes/no)? no
Adding file.txt
Transmitting file data .
Committed revision x.
falnyr#cap:test $
Add the following lines to your hook. Slack should now be able to talk Czech. :)
use Encode qw(decode_utf8);
...
my $log = qx|export LC_ALL="cs_CZ.UTF-8"; /usr/bin/svnlook log -r $ARGV[1] $ARGV[0]|;
$log = decode_utf8($log);

Perl script gives different results for HTTP/POST when run from command line and server

I'm trying to write a proxy that takes a POST request in UTF-8, converts the request to TIS-620 (Thai language) and submits it to a server. It then takes the TIS-620 server response and converts it to UTF-8.
The problem I'm having is that everything works fine when I run from the command line. I get back a page of HTML as expected. When I run the same script from my webserver I get a HTTP/200 OK response, but there's nothing in the body.
I'm absolutely stumped as to why this is happening. I'm also at a loss as to how to go about debugging this. Any thoughts much appreciated.
This is a stripped down version of the program:
#!/usr/bin/perlml -w -T
use strict;
use CGI qw(:standard);
use CGI::Carp qw(warningsToBrowser fatalsToBrowser);
use Encode qw(decode encode);
use LWP::UserAgent;
use URI::Escape;
use utf8;
# Print Headers
print "Content-Type: text/html; charset=utf-8\n\n";
my $postData = "word=กระคน";
# Convert to TIS-620
my $post = encode("iso-8859-11", "$postData");
# URI Escape it
$post = uri_escape($post, "\x00-\x1f\x7f-\xff");
# Prepare POST
my $ua = LWP::UserAgent->new;
my $server_endpoint = "http://rirs3.royin.go.th/new-search/word-search-all-x.asp";
my $req = HTTP::Request->new(POST => $server_endpoint);
# Set header fields and POST data
$req->header('CONTENT_TYPE' => 'application/x-www-form-urlencoded');
my $postLength;
{use bytes; my $postLength = length($post);}
$req->header('Content-Length' => $postLength);
$req->content($post);
# Get & print response
my $resp = $ua->request($req);
my $respCode = $resp->code();
print("Response Code = $respCode<br>\n");
$resp = $resp->decoded_content;
my $respUTF = decode("iso-8859-11", $resp);
print ("Response:<br>\n$respUTF\n");
The script can be run at http://thai-notes.com/cgi-bin/test2.pl

Posting Gzipped data with curl

im trying to use the system curl to post gzipped data to a server but i keep ending up with strange errors
`curl -sS -X POST -H "Content-Type: application/gzip" --data-binary $data $url`
gives
curl: no URL specified!
and
`curl -sS -X POST -H "Content-Type: application/gzip" --data-binary "$data" $url`
gives
sh: -c: line 0: unexpected EOF while looking for matching `"'
sh: -c: line 1: syntax error: unexpected end of file
Adding the " is a step in the right direction, but you didn't consider that $data might contains ", $, etc. You could use String::ShellQuote to address the issue.
use String::ShellQuote qw( shell_quote );
my $cmd = shell_quote(
curl => (
'-sS',
'-X' => 'POST',
'-H' => 'Content-Type: application/gzip',
'--data-binary' => $data,
$url,
),
);
my $output = `$cmd`;
Or you could avoid the shell entirely.
my #cmd = (
curl => (
'-sS',
'-X' => 'POST',
'-H' => 'Content-Type: application/gzip',
'--data-binary' => $data,
$url,
),
);
open(my $pipe, '-|', #cmd) or die $!;
my $output = do { local $/; <$pipe> };
close($pipe);
Or if you didn't actually need to capture the output, the following also avoids the shell entirely:
system(
curl => (
'-sS',
'-X' => 'POST',
'-H' => 'Content-Type: application/gzip',
'--data-binary' => $data,
$url,
),
);
That said, I don't see how you can possibly send strings containing NUL bytes, something a gzipped file is likely to have. I think your approach is inherently flawed.
Do you know that libcurl (the guts of curl) can be accessed via Net::Curl::Easy?
I did not succeed in getting curl to read the data straight from stdin, but process substitution did work, for example:
curl -sS -X POST -H "Content-Type: application/gzip" --data-binary #<(echo "Uncompressed data" | gzip) $url
This technique removes any need to having to write to a temporary file first.
This is because your binary data contains all kind of trash, including quotes and null bytes, which confuse the shell. Try putting your data into some file and post that file.