I want use shuttlecloud for import contacts from services. When i try make request like described here, i receive response
{"error": {"msg": "Missing parameter: timestamp", "id": "400"}}
Here me code:
my $ua = LWP::UserAgent->new;
my $url = 'https://demo.api.shuttlecloud.com/beta/load';
my $appid = 'some_app_id';
my $ts = int(time);
my $secret = 'some_secret';
my $sig = sha256_hex("{".$appid.":".$secret.":".$ts."}");
my $data = '{
"userid": {
"email": "admin#gypost.com"
}
}';
my $json = decode_json($data);
$url = $url."?appid=".$appid."&ts=".$ts."&sig=".$sig.;
my $req = HTTP::Request->new(POST => $url);
$req->content($json);
my $resp = $ua->request($req);
my $res = $resp->decoded_content;
print "Resp $res\n";
What i do wrong?
Related
I have tried to add a proxy server to the following perl script:
#!/usr/bin/perl
TO='list of email adresses here';
require "/usr/local/SCRIPTS/www-tools/service-name/jcode.pl";
use LWP::UserAgent;
$sendmail = '/usr/lib/sendmail -t -oi';
######################
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$year = $year+1900;
$mon = $mon+1;
$MMDD = sprintf("%02d/%02d",$mon,$mday);
$HHMM = sprintf("%02d:%02d",$hour,$min);
$err = 0;
#Ph.1 WebAccess-1stServer(VIP)
#ret = &SiteAccess( 'http://IP:PORT/hostname/' ,
'http://IP:PORT/hostname/Login.do' );
if( $ret[0] != 200 || $ret[2] != 200 ){
$err = 1;
}
$body = &jcode::euc($ret[1]);
if( $body !~ m#<title>ServiceName<\/title># ){
$err = 2;
}
$title = &jcode::euc('<title>web$BO"7H(J</title>');
$body = &jcode::euc($ret[3]);
if( $body !~ m#$title# ){
$err = 3;
}
&MailSend('Web') if( $err > 0 );
$err=0;
#Ph.2 WebAccess-2ndServer(Direct)
#ret = &SiteAccess( 'http://2ndServerIP:PORT/hostname/' ,
'http://2ndServerIP:PORT/hostname/Login.do' );
if( $ret[0] != 200 || $ret[2] != 200 ){
$err = 4;
}
$body = &jcode::euc($ret[1]);
if( $body !~ m#<title>ServiceName<\/title># ){
$err = 5;
}
$title = &jcode::euc('<title>web$BO"7H(J</title>');
$body = &jcode::euc($ret[3]);
if( $body !~ m#$title# ){
$err = 6;
}
&MailSend('Web2nd') if( $err > 0);
$err=0;
#Ph.3 POP
#ret = &SiteAccess( 'http://IP:PORT/hostname/' ,
'http://IP:PORT/hostname/Login.do' );
if( $ret[0] != 200 || $ret[2] != 200 ){
$err = 7;
}
$body = &jcode::euc($ret[1]);
if( $body !~ m#<title>ServiceName</title># ){
$err = 8;
}
$title = &jcode::euc('<title>TitleJapanese<(J</title>');
$body = &jcode::euc($ret[3]);
if( $body !~ m#$title# ){
$err = 9;
}
&MailSend('POP') if( $err > 0);
$err=0;
#Ph.4 Exchange(EWS)
#ret = &SiteAccess( 'http://IP:PORT/hostname/' ,
'http://IP:PORT/hostname/Login.do' );
if( $ret[0] != 200 || $ret[2] != 200 ){
$err = 10;
}
$body = &jcode::euc($ret[1]);
if( $body !~ m#<title>ServiceName</title># ){
$err = 11;
}
$title = &jcode::euc('<title>TitleJapanese<(J</title>');
$body = &jcode::euc($ret[3]);
if( $body !~ m#$title# ){
$err = 12;
}
&MailSend('Exchange-EWS') if( $err > 0);
$err=0;
sub SiteAccess{
my $url1 = shift;
my $url2 = shift;
# $ua,$req,$res;i
my #r;
if($url1 ne ''){
$ua = LWP::UserAgent->new;
$req = HTTP::Request->new(GET => $url1);
$res = $ua->request($req);
$r[0] = $res->code;
$r[1] = $res->content;
}
if($url2 ne ''){
$ua = LWP::UserAgent->new;
$res = $ua->post( $url2,
{
"c" => "don't knwo what that is",
"u" => "users ldap",
"p" => "password"
},
"Content-Type" => "application/x-www-form-urlencoded",
"User-Agent" => "DoCoMo/2.0 N901iS(c100;TB;W24H12;ser123445654654645;icc898114564645667716666f)");
$r[2] = $res->code;
$r[3] = $res->content;
}
return #r;
}
sub MailSend{
my $title = shift;
my $body;
my $from;
my #message;
#the following lines need another file name jcode to display properly. It just means error code or auth error.
$message[1] = &jcode::jis('[Web]$B%(%i!<%3!<%I(J');
$message[4] = &jcode::jis('[Web2nd]$B%(%i!<%3!<%I(J');
$message[7] = &jcode::jis('[POP]$B%(%i!<%3!<%I(J');
$message[10] = &jcode::jis('[EWS]$B%(%i!<%3!<%I(J');
$message[2] = &jcode::jis('[Web]$B%m%0%$%s2hLL(J');
$message[5] = &jcode::jis('[Web2nd]$B%m%0%$%s2hLL(J');
$message[8] = &jcode::jis('[POP]$B%m%0%$%s2hLL(J');
$message[11] = &jcode::jis('[EWS]$B%m%0%$%s2hLL(J');
$message[3] = &jcode::jis('[Web]auth$B%(%i!<(J');
$message[6] = &jcode::jis('[Web2nd]auth$B%(%i!<(J');
$message[9] = &jcode::jis('[POP]auth$B%(%i!<(J');
$message[12] = &jcode::jis('[EWS]auth$B%(%i!<(J');
$from = 'mail#abc.com';
$title = '['.$title.']cnct1 err';
# $title = $title.'['.$MMDD.$HHMM.']';
$body =<<END_OF_BODY;
To: $TO
Subject: $title
From: $from
ConnectOneCheck Error
Date : $MMDD $HHMM
ErrorStatus: $err
ErrorMsg : $message[$err]
END_OF_BODY
open(ML,"| $sendmail") || &error("Can't execute sendmail : $sendmail\n");
print ML $body;
close(ML);
}
So now here's the part where I tried to add the usage of a proxy. Most parts are commented out, except for the last function:
!/usr/bin/perl
TO='list of email adresses here';
require "/usr/local/SCRIPTS/www-tools/service-name/jcode.pl";
use LWP::UserAgent;
$sendmail = '/usr/lib/sendmail -t -oi';
######################
($sec,$min,$hour,$mday,$mon,$year,$wday,$yday,$isdst) = localtime(time);
$year = $year+1900;
$mon = $mon+1;
$MMDD = sprintf("%02d/%02d",$mon,$mday);
$HHMM = sprintf("%02d:%02d",$hour,$min);
$err = 0;
The next part is commented out because it is not in use.
#ret = &SiteAccess( 'http://IP:PORT/hostname/' ,
'http://IP:PORT/hostname/Login.do' );
if( $ret[0] != 200 || $ret[2] != 200 ){
$err = 10;
}
$body = &jcode::euc($ret[1]);
if( $body !‾ m#<title>ConnectONE</title># ){
$err = 11;
}
$title = &jcode::euc('<title>TitleJapanese</title>');
$body = &jcode::euc($ret[3]);
if( $body !‾ m#$title# ){
$err = 12;
}
&MailSend('Exchange-EWS') if( $err > 0);
$err=0;
sub SiteAccess{
my $url1 = shift;
my $url2 = shift;
# $ua,$req,$res;i
my #r;
if($url1 ne ''){
$ua = LWP::UserAgent->new;
$ENV{HTTP_proxy} = "proxy fqdn here";
$ua->env_proxy
$req = HTTP::Request->new(GET => $url1);
$res = $ua->request($req);
$r[0] = $res->code;
$r[1] = $res->content;
}
if($url2 ne ''){
$ua = LWP::UserAgent->new;
$ENV{HTTP_proxy} = "proxy fqdn here";
$ua->env_proxy
$res = $ua->post( $url2,
{
"c" => "don't knwo what that is",
"u" => "users ldap",
"p" => "password"
},
"Content-Type" => "application/x-www-form-urlencoded",
"User-Agent" => "DoCoMo/2.0 N901iS(c100;TB;W24H12;ser123445654654645;icc898114564645667716666f)");
$r[2] = $res->code;
$r[3] = $res->content;
}
return #r;
}
sub MailSend{
my $title = shift;
my $body;
my $from;
my #message;
#the following lines need another file name jcode to display properly. It just means error code or auth error.
#$message[1] = &jcode::jis('[Web]$B%(%i!<%3!<%I(J');
#$message[4] = &jcode::jis('[Web2nd]$B%(%i!<%3!<%I(J');
#$message[7] = &jcode::jis('[POP]$B%(%i!<%3!<%I(J');
$message[10] = &jcode::jis('[EWS]$B%(%i!<%3!<%I(J');
#$message[2] = &jcode::jis('[Web]$B%m%0%$%s2hLL(J');
#$message[5] = &jcode::jis('[Web2nd]$B%m%0%$%s2hLL(J');
#$message[8] = &jcode::jis('[POP]$B%m%0%$%s2hLL(J');
$message[11] = &jcode::jis('[EWS]$B%m%0%$%s2hLL(J');
#$message[3] = &jcode::jis('[Web]auth$B%(%i!<(J');
#$message[6] = &jcode::jis('[Web2nd]auth$B%(%i!<(J');
#$message[9] = &jcode::jis('[POP]auth$B%(%i!<(J');
$message[12] = &jcode::jis('[EWS]auth$B%(%i!<(J');
$from = 'mail#abc.com';
$title = '['.$title.']cnct1 err';
# $title = $title.'['.$MMDD.$HHMM.']';
$body =<<END_OF_BODY;
To: $TO
Subject: $title
From: $from
ConnectOneCheck Error
Date : $MMDD $HHMM
ErrorStatus: $err
ErrorMsg : $message[$err]
END_OF_BODY
open(ML,"| $sendmail") || &error("Can't execute sendmail : $sendmail\n");
print ML $body;
close(ML);
}
OK so I have added a proxy using this function
$ua = LWP::UserAgent->new;
$ENV{HTTP_proxy} = "here is the FQDN of the proxy";
$ua->env_proxy
But it doesn't compile well. It gives me this error:
syntax error at /usr/local/SCRIPTS/www-tools/connectone/ConnectOneCheck.pl line 93, near "$body !"
Unrecognized character \xE2; marked by <-- HERE after f( $body !<-- HERE near column 12 at /usr/local/SCRIPTS/www-tools/connectone/ConnectOneCheck.pl line 93.
Is here someone who can get this script running?
Your script does not compile as it is presented here. In Line 3 where it says
TO='list of
it needs to be changed to
$TO='list of
...and then it compiles for me. Without the error you are getting in line 93.
From my limited viewpoint this means there may actually be some misprint in your code line 93 that did not make it to the code on this side.
If you erase your line 93 in your script and copy the line 93 back into your code, you might be settled.
You have a non-ASCII character OVERLINE (U+203E) (‾) in your source code, and that is the cause of the error you have shown.
The first code point of Unicode characters in the U+2000–206F "General Punctuation" block is \xE2. That was the first clue. The overline is 0xE2 0x80 0xBE in hex.
Perhaps there was some encoding problem that translated the tildes (~) in those few places in your original source into these overlines.
You may also see errors like this when “curly” quotes, en (–) and em (—) dashes, and the like have crept into your source code. Sometimes it's due to well-meaning software such as WordPress or MS Word automatically substituting, for example, straight for curly quotes, which you in turn copy-pasted into your source code.
It's difficult to spot these visually (I didn't notice the overline at first), but this shell one-liner strips characters in the non-ASCII range and then compares side-by-side with the original file on the left:
# assumes Bash shell
sdiff --suppress-common-lines script.pl <(tr -cd '\11\12\15\40-\176' <script.pl)
A similar encoding problem in a Python context, with an error message about \xE2, is described in this SO question. This gave me the idea to look for non-ASCII characters in your source code.
I'm trying to make an HTTP GET request with Cisco Prime:
#!/opt/local/bin/perl -w
use strict;
use JSON-support_by_pp;
use LWP 5.64;
use LWP::UserAgent;
$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0;
my $ua = LWP::UserAgent->new;
my $BASE_URL = 'https://Host_name/webacs/api/v1/';
my $UN = "Username";
my $PW = "Password";
sub fetch ($) {
my ( $url ) = #_;
my $req = HTTP::Request->new( GET => $BASE_URL . $url );
$req->authorization_basic( $UN, $PW );
return $ua->request( $req )->content or die( "Cannot read from " . $BASE_URL . $url );
}
my $content = fetch( 'data/AccessPoints.json?.full=true' );
my $json = new JSON;
# these are some nice json options to relax restrictions a bit:
my $json_text =
$json->allow_nonref->utf8->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode( $content );
foreach my $ap ( #{ $json_text->{queryResponse}->{'entity'} } ) {
print "------------------------\nAccess Point " . $ap->{'accessPointsDTO'}->{'#id'} . "\n";
print "Model:" . $ap->{'accessPointsDTO'}->{'model'} . "\n";
print "MAC Address:" . $ap->{'accessPointsDTO'}->{'macAddress'} . "\n";
print "Serial Number:" . $ap->{'accessPointsDTO'}->{'serialNumber'} . "\n";
print "Software Version:" . $ap->{'accessPointsDTO'}->{'softwareVersion'} . "\n";
print "Status:" . $ap->{'accessPointsDTO'}->{'status'} . "\n";
print "Location:" . $ap->{'accessPointsDTO'}->{'location'} . "\n";
What do I do wrong? I have already tried with curl in shell and it works:
curl --tlsv1 --user USER:PASSWORD--insecure https://Host_name/webacs/api/v1/data/AccessPoints.json?.full=true
but my Perl script doesn't work.
I have this error:
malformed JSON string, neither array, object, number, string or atom, at character offset 0 (before "Can't connect to 10....") at ersteProbe.pl line 28.
Fix already. Thank you Borodin :)
New question:
I need authentication for Cisco Prime.
Code works already, but authentication doesn't work.
I have with error
500 Can't connect to 10.10.10.10:443 (certificate verify failed) at ersteProbeAuth.pl line 27.
Line 27:
die $res->status_line unless $res->is_success;
I'm rather new in Perl und cann't fix this myself. If you have Idee, I'll be happy :)
#!/opt/local/bin/perl -w
use strict;
use warnings;
use JSON -support_by_pp;
use LWP 5.64;
use LWP::UserAgent;
use MIME::Base64;
use REST::Client;
$ENV{PERL_LWP_SSL_VERIFY_HOSTNAME} = 0;
my $ua = LWP::UserAgent->new;
my $BASE_URL = 'https://10.10.10.10/webacs/api/v1/';
my $UN='admin';
my $PW='admin';
# coding with Base 64
my $sys_id='Balalalalalal';
my $encoded_auth = encode_base64("$UN:$PW", '');
sub fetch {
my ($url) = #_;
my $res = $ua->get($BASE_URL . $url,
{'Authorization' => "Basic $encoded_auth",
'Accept' => 'application/json'});
die $res->status_line unless $res->is_success;
my $json = $res->decoded_content;
return $json
}
my $content = fetch('data/AccessPoints.json?.full=true/$sys_id');
my $json = new JSON;
# these are some nice json options to relax restrictions a bit: my$json_text=$json->allow_nonref->utf8->relaxed->escape_slash->loose->allow_singlequote->allow_barekey->decode($content);
foreach my $ap (#{$json_text->{queryResponse}->{'entity'}}){
print "------------------------\nAccess Point ".$ap->{'accessPointsDTO'}->{'#id'}."\n";
print "Model:".$ap->{'accessPointsDTO'}->{'model'}."\n";
print "MAC Address:".$ap->{'accessPointsDTO'}->{'macAddress'}."\n";
print "Serial Number:".$ap->{'accessPointsDTO'}->{'serialNumber'}."\n";
print "Software Version:".$ap->{'accessPointsDTO'}->{'softwareVersion'}."\n";
print "Status:".$ap->{'accessPointsDTO'}->{'status'}."\n";
print "Location:".$ap->{'accessPointsDTO'}->{'location'}."\n";
}
It's hard to tell what's wrong without access to the web page, but almost certainly your request has failed
I suggest you replace your fetch subroutine with this
sub fetch {
my ( $url ) = #_;
my $res = $ua->get( $BASE_URL . $url );
die $res->status_line unless $res->is_success;
my $json = $res->decoded_content;
return $json;
}
Print your raw answer from server in console.
malformed JSON string, neither array, object, number, string or atom, at character offset 0 (before "Can't connect to 10....")
"Can't connect to 10...."
Maybe, your code is not have connect
How can I set $PageData to a error message like "$PageData=Page not found" if $URL is non extant or not responding? I cant seem to get it to work.
use LWP::UserAgent;
use HTTP::Request;
my $URL = "http://www.MyDomain.com/;
my $Request = HTTP::Request->new("GET", $URL);
my $UserAgent = LWP::UserAgent->new(timeout => 5);
my $Result = $UserAgent->request($Request);
return unless $Result->is_success;
$PageData = $Result->content;
print $PageData;
Try use library HTTP::Status with the following code:
use ...
use HTTP::Status qw(:constants :is status_message);
my $url = ...
my $request = HTTP::Request->new(GET => $url);
my $ua = LWP::UserAgent->new;
my $response = $ua->request($request);
if ($response->is_error) {
print STDERR $response->status_line, "\n";
print STDERR status_message($response->status_line), "\n";
print STDERR $response->error_as_HTML, "\n";
}
else {
print $response->decoded_content;
}
I am creating a free forwarding email address system and asked a little while ago about this. What I would like to do is forward an email to the persons real email address while keeping the headers intact. Is there any reason why the below code would not work:
#!/usr/bin/php -q
<?php
$fd = fopen("php://stdin", "r");
$email = "";
while (!feof($fd)) {
$email .= fread($fd, 1024);
}
fclose($fd);
$lines = explode("\n", $email);
$to = "";
$from = "";
$subject = "";
$headers = "";
$message = "";
$splittingheaders = true;
$beforecheck = str_ireplace("to:", "", $to);
$checkdatabase = str_ireplace("#virtualparalegal.com", "", $beforecheck);
mysql_connect("localhost", "virtucb3_admin", "Instant11!") or
die("Could not connect to the Database, the Database returned this error: " . mysql_error());
mysql_select_db("virtucb3_wordpress");
$result = mysql_query("SELECT user_nicename, user_email FROM wp_users WHERE `user_nicename` = $checkdatabase");
while ($row = mysql_fetch_array($result, MYSQL_ASSOC)) {
if ( $row["user_nicename"] == "$checkdatabase") {
$to = ($row["user_email"]);
}
else {
$to = "info#virtualparalegal.com";
}
}
for ($i=0; $i<count($lines); $i++) {
if ($splittingheaders) {
$headers .= $lines[$i]."\n";
if (preg_match("/^Subject: (.*)/", $lines[$i], $matches)) {
$subject = $matches[1];
}
if (preg_match("/^From: (.*)/", $lines[$i], $matches)) {
$from = $matches[1];
}
} else {
$message .= $lines[$i]."\n";
}
if (trim($lines[$i])=="") {
$splittingheaders = false;
}
}
mail($to, $subject, $message, $headers);
?>
Thank you all in advance.
my $Parser = new MIME::Parser;
my $entity = $Parser->parse_data( $body );
my #parts = $entity->parts;
for $part(#parts){
my $type=$part->mime_type;
my $bhandle=$part->bodyhandle;
$header = $part->head();
$content_disp = $header->get('Content-Disposition');
if ($type =~ /text/i){
$bodydata = "";
if (my $io = $part->open("r")) {
while (defined($_ = $io->getline)) {
$bodydata .= $_;
}
$io->close;
print $bodydata;
}
}
}
I think you're looking for the recommended_filename method:
$header = $part->head();
$filename = $header->recommended_filename;
Be sure to check the return value for sanity. Note that it can also be undef.