Posting Gzipped data with curl - perl

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.

Related

Correct way of rewriting `curl ...` to perl

I wrote a program that requests the source and the response header of a webpage, now I need it to run cross platform. I used the external command curl (in linux) to achieve it. I get the source like this::
#!/usr/bin/perl -w
use strict;
#declaring variables here#
my $result = `curl 'https://$host$request' -H 'Host: $host' -H 'User-Agent: $useragent' -H 'Accept: $accept' -H 'Accept-Language: $acceptlanguage' --compressed -H 'Cookie: $cookie' -H 'DNT: $dnt' -H 'Connection: $connection' -H 'Upgrade-Insecure-Requests: $upgradeinsecure' -H 'Cache-Control: $cachecontrol'`;
print "$result\n";
And the response header like this:
#!/usr/bin/perl -w
use strict;
#declaring variables here#
my $result = `curl -I 'https://$host$request' -H 'Host: $host' -H 'User-Agent: $useragent' -H 'Accept: $accept' -H 'Accept-Language: $acceptlanguage' --compressed -H 'Cookie: $cookie' -H 'DNT: $dnt' -H 'Connection: $connection' -H 'Upgrade-Insecure-Requests: $upgradeinsecure' -H 'Cache-Control: $cachecontrol'`;
print "$result\n";
These work fine, but I need to call these in perl and not as external commands.
I wrote some code using LWP::UserAgent to get the source:
#!/usr/bin/perl -w
use strict;
use LWP::UserAgent;
#declaring variables here#
my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new(GET => "https://$host$request HTTP/1.1");
$req->header('Host' => "$host");
$req->header('User-Agent' => "$useragent");
$req->header('Accept' => "$accept");
$req->header('Accept-Language' => "$acceptlanguage");
$req->header('Accept-Encoding' => "$acceptencoding");
$req->header('Cookie' => "$cookie");
$req->header('DNT' => "$dnt");
$req->header('Connection' => "$connection");
$req->header('Upgrade-Insecure-Requests' => "$upgradeinsecure");
$req->header('Cache-Control' => "$cachecontrol");
my $resp = $ua->request($req);
if ($resp->is_success) {
my $message = $resp->decoded_content;
print "$message\n";
}
This sometimes runs fine, but sometimes decoded_content returns nothing, I do get a response and i can print it using content, but its still encoded.
And requesting response headers using LWP::UserAgent is not possible so I wrote the request using Net::HTTP:
#!/usr/bin/perl -w
use strict;
use Net::HTTP;
#declaring variables here#
my $s = Net::HTTP->new(Host => "$host") || die $#;
$s->write_request(GET => "$request", 'Host' => "$host", 'User-Agent' => "$useragent", 'Accept' => "$accept", 'Accept-Language' => "$acceptlanguage", 'Accept-Encoding' => "$acceptencoding", 'Cookie' => "$cookie", 'DNT' => "$dnt", 'Connection' => "$connection", 'Upgrade-Insecure-Requests' => "$upgradeinsecure", 'Cache-Control' => "$cachecontrol");
my #headers;
while(my $line = <$s>) {
last unless $line =~ /\S/;
push #headers, $line;
}
print #headers;
This returns
HTTP/1.1 302 Found
Content-Type: text/html; charset=UTF-8
Connection: close
Content-Length: 0
Is the problem with my syntax of am I using the wrong tools? I know that WWW::Curl::Easy can request the source and the header at the same time, but I don't know how to pass my variables to its request. Could someone tell me what the problem is or just rewrite these requests correctly using the same variables with WWW:Curl::Easy? I'd appreciate a solution using WWW::Curl::Easy. Thanks in advance.
You can get the response headers in a couple of ways with LWP. Demonstrated here:
use LWP::UserAgent;
my($host,$request) = ('example.com', '/my/request');
my #header=( [Host => $host],
['User-Agent' => 'James Bond 2.0'],
[Accept => 'text/plain'],
[Cookie => 'cookie=x'],
);
my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new(GET => "https://$host$request"); #dont add HTTP/1.1
$req->header(#$_) for #header;
my $resp = $ua->request($req);
if ($resp->is_success) {
my %h; $resp->headers->scan( sub{ $h{shift()}=shift() } );
printf "Header name: %-30s Value: %-30s\n", $_, $h{$_} for sort keys %h;
print "\n<<<".$resp->headers()->as_string.">>>\n\n"; #all header lines in one big string
print $resp->header('Content-Type'),"\n\n"; #get one specific header line
my $content = $resp->decoded_content;
print "$content\n";
}
Note: "HTTP/1.1" should not be a part of the string after GET =>.
And with calling curl as a sub process you don't need to call it twice. You can get both headers and content at once by using -i like this:
my $response = ` curl -s -i "http://somewhere.com/path" -H 'User-Agent: Yes' `;
my($headers,$content) = split /\cM?\cJ\cM?\cJ/, $response, 2;
print "Headers: <<<$headers>>>\n\n";
print "Content: <<<$content>>>\n\n";

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

Send a file with payload using curl in 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");
#########################

Optimization Perl script

Is it possible to make this script faster ?
#!/usr/bin/perl -w
use strict;
use CGI;
package SwitchGUI;
sub new {
my ($classe, $nom, $nbports, $gio) = #_;
my $this = {
"nom" => $nom,
"nbports" => $nbports,
"gio" => $gio
};
bless($this, $classe);
$this->afficher();
return $this;
}
sub afficher {
my ($this) = #_;
my #tab = ( 1 .. $this->{nbports} );
my #odd = grep { $_ % 2 } #tab;
my #even = grep { not $_ % 2 } #tab;
my $cgi = new CGI;
my $i;
my $j;
print "<div id=\"$this->{nom}\" class=\"switch\">\n";
print $cgi->h2("$this->{nom}");
print "<div class=\"ports\">";
for my $port (#odd) {
my $res = `perl ifname-index.pl -h $this->{nom} -i FastEthernet0/$port -c reseau`;
if ($res =~ /^Erreur /) {
print $cgi->img({
src => 'ressources/interface_haut_down.png',
alt => "port n°$port",
}), "\n",
}
else {
print $cgi->a({class=>"tooltip", title=>$res},$cgi->img({
src => 'ressources/interface_haut_up.png',
alt => "port n°$port",
}), "\n",)
}
}
print "<br/>";
for my $port (#even) {
my $res = `perl ifname-index.pl -h $this->{nom} -i FastEthernet0/$port -c reseau`;
if ($res =~ /^Erreur/) {
print $cgi->img({
src => 'ressources/interface_bas_down.png',
alt => "port n°$port",
}), "\n",
}
else {
if ($this->getDuplex($res)!="Full") {
print $cgi->a({class=>"tooltip", title=>$res},$cgi->img({
src => 'ressources/interface_bas_duplex.png',
alt => "port n°$port",
}), "\n",)
}
elsif ($this->getVitesse($res)!="100"){
print $cgi->a({class=>"tooltip", title=>$res},$cgi->img({
src => 'ressources/interface_bas_speed.png',
alt => "port n°$port",
}), "\n",)
}
else {
print $cgi->a({class=>"tooltip", title=>$res},$cgi->img({
src => 'ressources/interface_bas_up.png',
alt => "port n°$port",
}), "\n",)
}
}
}
print "</div>";
print "<div class=\"gio\">";
for ($j=0;$j<$this->{gio};$j++) {
my $req = system("perl ifname-index.pl -h $this->{nom} -i GigabitEthernet0/$j -c reseau &");
print $cgi->img({
src => 'ressources/interface_bas_down.png',
alt => "port",
});
}
print "</div>\n";
print "</div>\n";
}
1;
It executes a perl script (which uses SNMP to query network equipment), and depending of the return of this script, it displays an appropriate image and description. This script is used for ajax call, from another cgi script.
My question is: can I execute multiple script by adding & or something similar
at the end of the following line?
my $res = `perl ifname-index.pl -h $this->{nom} -i FastEthernet0/$port -c reseau`;
While i don't want comment much things like using CGI and "print" (in 2011 is really archaic), I will comment two lines:
my $res = `perl ifname-index.pl -h $this->{nom} -i FastEthernet0/$port -c reseau`;
...
my $req = system("perl ifname-index.pl -h $this->{nom} -i GigabitEthernet0/$j -c reseau &");
Starting another perl-processes really slowing speed down.
You're making package for displaying HTML, but not for polling?
Re-factor ifname-index.pl to subroutine. So,
my $res = get_request_interface(name => $this->{nom}, interface => "FastEthernet0/$port");
or to an package (the right way) - something like...
my $interface = My::Interface::Handler->new();
my $res = $interface->get_request;
...
my $another_result = $interface->get_request;
#etc
And ofc, it is possible start more (multiple) processes and communicate with them, but the solution will be probably more complicated than refactoring ifname-index.pl to subroutine. (read this: http://faq.perl.org/perlfaq8.html#How_do_I_start_a_pro)
Summarization for a "cool" app - based on comments:
build a web page where you list the interfaces, for example N-status lines for N ports
the page will send N ajax (parallel) requests to the server for the status with javascript
the server will execute N parallel SNMP requests, and send N ajax responses
the page will get responses from the server and update the correct divs
With above way:
the user get immediately an web page
the page has a feedback for user - "wait, i'm working on getting status"
the server executing N parallel requests to snmp
ajax responses updating the page as they come from the server
For the web part is the best to use PGSI-type server. Check CPAN, several one exists.
Tatsuhiko Miyagawa is "The Perl Hero" for these days :)
Ps:
http://www.perlcritic.org
http://onyxneon.com/books/modern_perl/