Perl issues while sending emojis over socket - json

My Perl script sends push notifications to an Apple APNS server. It works except when I try to send emojis (special characters).
My code
use DBI;
use JSON;
use Net::APNS::Persistent;
use Data::Dumper;
use Encode;
my $cfg;
my $apns;
...;
sub connect {
my ($sandbox, $cert, $key, $pass) = $cfg->getAPNSServer();
$apns = Net::APNS::Persistent->new({
sandbox => $sandbox,
cert => $cert,
key => $key,
}) or die("[-] Unable to connect to APNS server");
}
sub push {
my $msg = $_[1];
Logger::log(5, "[APNS Client] Got message ".Dumper($msg));
#Encode::_utf8_off($msg);
utf8::encode($msg);
my $pack = decode_json($msg);
my ($token, $payload) = #{$pack};
Logger::log(5, "Sending push with token: $token and Data: \n".Dumper($payload));
$apns->queue_notification(
$token,
$payload
);
$apns->send_queue;
}
So in the push subroutine I pass JSON data with the format given below. My problem is with the emoji character \x{2460}. You can see I added this line
utf8::encode($msg);
Before decoding the data. If I remove this line I get an error while decoding the JSON data
Wide character in subroutine entry at .....
With the above line added I can decode my JSON data. However when I try to write to the socket in the next line ($apns->send_queue) gives
Cannot decode string with wide characters at /usr/lib/perl/5.10/Encode.pm line 176
How do I solve this?
Message format (JSON)
["token",
{
"aps":{
"alert":"Alert: \x{2460}",
"content-available":1,
"badge":2,
"sound":"default.aiff"
},
"d":"Meta"
}
]
Dumper Output
[-] [ 2015-08-25T20:03:15 ] [APNS Client] Got message $VAR1 = "[\"19c360f37681035730a26cckjgkjgkj58b2d20326986f4265ee802c103f51\",{\"aps\":{\"alert\":\"Alert: \x{24bc}\",\"content-available\":1,\"badge\":2,\"sound\":\"default.aiff\"},\"d\":\"Meta\"}]";
[-] [ 2015-08-25T20:03:15 ] Sending push with token: 119c360f37681035730a26cckjgkjgkj58b2d20326986f4265ee802c103f51 and Data:
$VAR1 = {
'aps' => {
'alert' => "Alert: \x{24bc}",
'content-available' => 1,
'badge' => 2,
'sound' => 'default.aiff'
},
'd' => 'Meta'
};
[x] [ 2015-08-25T20:03:15 ] [APNS Client] Error writing to socket. Reconnecting : Cannot decode string with wide characters at /usr/lib/perl/5.10/Encode.pm line 176.

First of all, decode_json expects JSON encoded using UTF-8, so if you're starting with "decoded" JSON, it is proper to encode it as you did.
utf8::encode( my $json_utf8 = $json_uni );
my $data = decode_json($json_utf8);
However, it would have been simpler to use from_json.
my $data = from_json($json_uni);
Now on to your question. Whoever wrote Net::APNS::Persistent messed up big time. I looked at the source code, and they expect the alert message to be encoded using UTF-8. Adding the following will make your structure conform with the module's wonky expectation:
utf8::encode(
ref($payload->{aps}{alert}) eq 'HASH'
? $payload->{aps}{alert}{body}
: $payload->{aps}{alert}
);
It wouldn't surprise me if you ran into other issues. Notably, the modules uses the bytes module, a sure sign that something is being done incorrectly.

You probably have to UTF-8 encode the alert in $payload before sending it. You can also use from_json instead of decode_json to avoid the first encoding step:
sub push {
my $msg = $_[1];
Logger::log(5, "[APNS Client] Got message ".Dumper($msg));
my $pack = from_json($msg);
my ($token, $payload) = #{$pack};
Logger::log(5, "Sending push with token: $token and Data: \n".Dumper($payload));
# UTF-8 encode before sending.
utf8::encode($payload->{aps}{alert});
$apns->queue_notification(
$token,
$payload
);
$apns->send_queue;
}

Related

500 Can't connect to url with lwp in perl

I'm trying to parse some json data with the fandom wikia API. When I browse to my marvel.fandom.com/api request I get following JSON output: {"batchcomplete":"","query":{"pages":{"45910":{"pageid":45910,"ns":0,"title":"Uncanny X-Men Vol 1 171"}}}}
Nothing to fancy to begin with and running it through a JSON parser online gives following output:
{
"batchcomplete":"",
"query":{
"pages":{
"45910":{
"pageid":45910,
"ns":0,
"title":"Uncanny X-Men Vol 1 171"
}
}
}
}
which seems to be ok as far as I can see
I want to get the pageid for several other requests but I can't seem to get the same output through Perl.
The script:
#!/usr/bin/perl
use strict;
use warnings;
use LWP::Simple;
use JSON;
use Data::Dumper;
my $url = "https://marvel.fandom.com/api.php?action=query&titles=Uncanny%20X-Men%20Vol%201%20171&format=json";
my $json = getprint( $url);
die "Could not get $url!" unless defined $json;
my $decoded_json = decode_json($json);
print Dumper($decoded_json);
but this gives following error:
Could not get https://marvel.fandom.com/api.php?action=query&titles=Uncanny%20X-Men%20Vol%201%20171&format=json! at ./marvelScraper.pl line 11.
When I change the get to getprint for some extra info, I get this:
500 Can't connect to marvel.fandom.com:443
<URL:https://marvel.fandom.com/api.php?action=query&titles=Uncanny%20X-Men%20Vol%201%20171&format=json>
malformed JSON string, neither tag, array, object, number, string or atom, at character offset 0 (before "(end of string)") at ./script.pl line 13.
I tried this on another computer and still get the same errors.
The versions of LWP::Simple and LWP::Protocol::https
/usr/bin/perl -MLWP::Simple -E'say $LWP::Simple::VERSION'
6.15
/usr/bin/perl -MLWP::Protocol::https -E'say $LWP::Protocol::https::VERSION'
6.09
Appearantly it has something to do with the Bash Ubuntu on Windows since on a Ubuntu 18.04 I get (with the same script) following response:
JSON text must be an object or array (but found number, string, true, false or null, use allow_nonref to allow this) at ./test.pl line 13.
{"batchcomplete":"","query":{"pages":{"45910":{"pageid":45910,"ns":0,"title":"Uncanny X-Men Vol 1 171"}}}}
Actually, the very same script works from my Bash Ubuntu on Windows with the get() command instead of the getprint() you gave after editing your question.
orabig#Windows:~/DEV$ ./so.pl
$VAR1 = {
'query' => {
'pages' => {
'45910' => {
'pageid' => 45910,
'ns' => 0,
'title' => 'Uncanny X-Men Vol 1 171'
}
}
},
'batchcomplete' => ''
};
So maybe you have another issue that has nothing to do with Perl or Ubuntu.
Can you try this for example ?
curl -v 'https://marvel.fandom.com/api.php?action=query&titles=Uncanny%20X-Men%20Vol%201%20171&format=json'
Maybe you just hit the site too much, and the 500 error is just a result of some anti-leech protection ?

HTTP request doesn't get Json expression with values contain a dot "."

I have a Json expression that contains values with "." and # like this
{"queued":"C1F","messageid":"dfs.jfdsf#sdf.abc.fr"}
that doesn't get processed by HTTP POST request , and it's give me this result :
"code":400,"message":"Unable to process JSON
PS: my web server is created with dropWizard in Intellij IDEA
how can I resolve this problem
EDIT: this is the code used in perl
my $queued=$1; my $messageid=$2 ;
my $json= "{\"queued\":\"$queued\",\"messageid\":\"$messageid\"}";
$req1->content($json);
my $response=$ua->request($req1);
if ($response->is_success) {
my $message =$response->decoded_content ;
print "resultat : $message \n";
}
else {
print "erreur", $response->code, " ", $response->message, "\n" ;
}
It would be less error-prone to use the JSON library to build your JSON string
use JSON 'to_json';
my $json = to_json({ queued => $queued, messageid => $messageid });

Perl LWP returns JSON output as string

I am using Perl LWP::UserAgent to get response from an API. Everything works good except one issue.
The API that i am using it returns response in JSON format. But I am getting it as string when i get the response through LWP module, Something like below.
$VAR1 = '
{"status":"success","data":[{"empid":"345232","customername":"Lee gates","dynamicid":"2342342332sd32423"},{"empid":"36.VLXP.013727..CBCL..","customername":"Lee subdirectories","dynamicid":"223f3423dsf23423423"}],"message":""}'
I did "print Dumper $response" to get the output.
One more thing, The challenge is that my client do not want to go with Perl module for JSON (use JSON::Parse 'parse_json';).
Any help would be appreciated!
You need to decode the JSON string into a Perl data structure. If your version of perl is 5.14+, JSON::PP is included in core, so nothing to install.
use warnings;
use strict;
use Data::Dumper;
use JSON::PP qw(decode_json);
my $json = '{"status":"success","data":[{"empid":"345232","customername":"Lee gates","dynamicid":"2342342332sd32423"},{"empid":"36.VLXP.013727..CBCL..","customername":"Lee subdirectories","dynamicid":"223f3423dsf23423423"}],"message":""}';
my $perl = decode_json $json;
print Dumper $perl;
Output:
$VAR1 = {
'status' => 'success',
'message' => '',
'data' => [
{
'dynamicid' => '2342342332sd32423',
'customername' => 'Lee gates',
'empid' => '345232'
},
{
'empid' => '36.VLXP.013727..CBCL..',
'customername' => 'Lee subdirectories',
'dynamicid' => '223f3423dsf23423423'
}
]
};

How to send -d flag from curl with Guzzle

I have the following cURL statement
curl http://localhost/ocpu/library/stats/R/t.test -d "x=x0e48e4cb3f&y=x09aaf63ea6"
When I run this in the terminal everything is fine and I get the response I want, a completed calculation.
Now I'm trying to build this into a PHP application with the use of Guzzle. I have the following code.
$result = $this->client->request('POST', 'http://localhost/ocpu/library/stats/R/t.test', ['json' => ["x" => $x, "y" => $y],
'header' => ["content" => "application/x-www-form-urlencoded"]])->getBody();
$x and $y contain strings with the values of x and y in the cURL statement.
This gives me the error "400 Bad Request response:
not enough 'x' observations"
Using the OpenCPU API Explorer I've figured out that I get the same error when trying to add the x and y parameters as primitive strings by adding quotes around them.
So my problem seems to be that Guzzle sends the x and y parameters as strings instead of Temp keys.
How can I get it to send the exact cURL paramater?
Thank you all in advance.
$params = [
'x' => 'value',
'y' => 'value',
];
$response = $client->post($uri, [
'form_params' => $params,
]);
I believe the issue is within the code sample that you have supplied. You are using 'json' when 'form_params' is (what i interpret) you are looking for. When 'form_params' is used, content-type headers are automatically set for form data.
More information can be found within Guzzle 6 Request Options

JSON parsing error in perl

I get the error
EXECUTION FAILED ...malformed JSON string, neither array, object, number, string or atom, at character offset 0 (before "(end of string)")"
when I parse my JSON string from DB to this snippet.
my $json_geno1 = decode_json($geno_set_one);
warn Dumper($json_geno1);
Am I missing something ? The json string is from the Database.
$VAR1 = [
'{"":"No Call","rs1032807":"AG","rs718757":"AG","rs6557634":"CC","rs995553":"CG","rs6166":"AG","rs4925":"AA","rs502843":"GT","rs725029":"No Call","rs3904872":"GG","rs1402695":"TT","rs719601":"AA","rs2374061":"AG","rs952503":"TT","rs1801262":"AG","rs5215":"CT","rs978422":"CC","rs12828016":"GG","rs958388":"AG","rs999072":"CT","rs967344":"AG","rs2207782":"CC","rs349235":"AA","rs1074553":"CT","rs1395936":"AG","GS35220":"CT","rs7627615":"AG","rs727336":"AG","rs2077774":"AC","rs8065080":"CC","rs1131498":"TT","rs2247870":"No Call","rs803172":"TT","rs1541290":"AG","rs1414904":"AA","rs1928045":"No Call","rs2077743":"GT","rs2361128":"No Call","rs3795677":"AG","rs1030687":"CT","rs156318":"GG","rs952768":"CC","rs1363333":"TT","rs7298565":"AG","rs310929":"CC","rs2369898":"CT","rs1327118":"CC","rs4619":"AG","rs965323":"TT","rs2887851":"AG","rs1862456":"GT","rs6759892":"GT","rs753381":"AG","rs1805034":"CC","rs1812642":"AA","rs4075254":"CT","rs1805087":"AA","rs532841":"CT","rs951629":"GG","rs2286963":"GG","rs763553":"CT","rs1074042":"GG","rs2241714":"GG","rs894240":"TT","rs522073":"CT","GS35205":"TC","rs1368136":"TT","rs1426003":"GG","rs2016588":"No Call","rs621277":"No Call","rs727081":"GG","rs1392265":"AC","rs1079820":"No Call","rs4843075":"AG","rs156697":"CC","rs11096957":"AC","rs1952161":"GG","rs1961416":"AG","rs1585676":"GG","rs890910":"TT","rs171953":"AG","rs1843026":"CC","rs1515002":"CC","rs756497":"No Call","rs1293153":"No Call","rs754257":"GT","rs649058":"AG","rs726957":"AG","rs728189":"No Call","GS34251":"TC","rs3742207":"No Call","rs210310":"CT","rs2216629":"AG","rs1541836":"CT","rs722952":"CT","rs1105176":"GG"}'
];
Thanks
You should probably use:
my $json_geno1 = decode_json($VAR1[0]);
because $VAR1 is now an array.
This JSON is valid (I've tested it in PHP) and I get object from this string without a problem.
I got exactly same error. Which got resolved by removing for below code
my $json;
{
local $/;
open ($fh, "+<temp.json") or die $!;
my $json = <$fh>;
close $fh;
}
and got resolved by removing the my from line number 5.
my $json;
{
local $/;
open ($fh, "+<temp.json") or die $!;
$json = <$fh>;
close $fh;
}
I got this* msg too, when i tried to call the read function like this:
perl json_read_test.pl /server/lib/Schema/user_data.schema.json
When I used it with ./ or without / or with full path name, that solved the problem.
**
"malformed JSON string, neither tag, array, object, number, string or atom, at character offset 0 (before "(end of string)") at /usr/share/perl5/JSON.pm line 190."
my $json_geno1 = decode_json($geno_set_one->[0]);
warn Dumper($json_geno1);