Adding authHeader to Perl SOAP::Lite request - perl

I am having some trouble creating a request to this WSDL that works; it requires authHeaders and I am not having much luck adding them. This is what I am trying:
# make proxy for the service
my $soap = SOAP::Lite->service($wsdl);
# add fault hanlder
$soap->on_fault(
sub { # SOAP fault handler
my $soap = shift;
my $res = shift;
# Map faults to exceptions
if(ref($res) eq '') {
die($res);
}
else {
die($res->faultstring);
}
return new SOAP::SOM;
}
);
# authentication request headers
my #headers = (
SOAP::Header->name('user')->value('myemail#whatever.com')->uri($apins),
SOAP::Header->name('password')->value('mypassword')->uri($apins),
SOAP::Header->name('appName')->value('TestApp')->uri($apins),
SOAP::Header->name('appVersion')->value('0.02')->uri($apins)
);
# request method
print $soap->getCompanyInfo('NB', #headers);
The response I get when doing this is:
String value expected instead of SOAP::Header reference
The method I am requesting has two string parameters, both optional. And suggestions?

I was able to get help form the SOAP::Lite mailing list. If I want to pass my own headers, I have to use the call method instead of the actually method name.
# create header for requests
my $authHeader = SOAP::Header->name("xsd:authHeader" =>
\SOAP::Header->value(
SOAP::Header->name('xsd:user')->value($s7user)->type(''),
SOAP::Header->name('xsd:password')->value($s7pass)->type(''),
SOAP::Header->name('xsd:appName')->value('TestApp')->type(''),
SOAP::Header->name('xsd:appVersion')->value('0.03')->type('')
));
# create data to pass as method paramaters
my $params = SOAP::Data->name('ns:email')->value($s7user)->type('');
# request method
$soap->call('checkLogin', $params, $authHeader);
In order to use the call method, you will need to define a proxy (endpoint) on your soap object. Hope this is helpful for someone else down the road.

Related

POST API in Perl using LWP::UserAgent with authentication

I am trying to use POST method in perl to send information to an API.
I would like to call the below api which requires following inputs:
URI: https://www.cryptopia.co.nz/api/SubmitTrade
Input Parameters are:-
Market: The market symbol of the trade e.g. 'DOT/BTC' (not required if 'TradePairId' supplied)
TradePairId: The Cryptopia tradepair identifier of trade e.g. '100' (not required if 'Market' supplied)
Type: the type of trade e.g. 'Buy' or 'Sell'
Rate: the rate or price to pay for the coins e.g. 0.00000034
Amount: the amount of coins to buy e.g. 123.00000000
Please can you tell me how I can call this api from perl ?
Request Structure:
REQUEST_SIGNATURE: API_KEY + "POST" + URI + NONCE + HASHED_POST_PARAMS
API_KEY: Your Cryptopia api key
URI: the request uri. e.g. https://www.cryptopia.co.nz/Api/SubmitTrade
HASHED_POST_PARAMS: Base64 encoded MD5 hash of the post parameters
NONCE: unique indicator for each request.
So question is how do I join this api https://www.cryptopia.co.nz/api/SubmitTrade and pass the arguments to it with authentication and check if returned result is success?
Result Example:
{
"Success":true,
"Error":null,
"Data":
{
"OrderId": 23467,
"FilledOrders": [44310,44311]
}
}
I don't have a Cryptopia account to test this, but this might at least get you closer to a working prototype.
Setup
Load the required modules and create a LWP::UserAgent object.
use strict;
use warnings;
use LWP::UserAgent;
use JSON;
use Digest::MD5 qw(md5);
use Digest::SHA qw(hmac_sha256);
use MIME::Base64;
use URI::Encode qw(uri_encode);
my $api_key = 'PUBLIC KEY';
my $api_private_key = 'PRIVATE KEY';
my $ua = LWP::UserAgent->new;
Generating the request
The tricky part is generating the authorization header. The API keys for your account will be base64-encoded - hence the call to decode_base64() when using it to sign the request.
my $url = "https://www.cryptopia.co.nz/api/GetTradeHistory";
my %req = (
Market => 'DOT/BTC',
);
my $nonce = int(rand(1000000));
my $post_data = encode_json(\%req);
my $post_data_enc = encode_base64(md5($post_data), "");
my $encoded_url = lc(uri_encode($url, encode_reserved => 1));
my $req_signature = sprintf("%sPOST%s%s%s", $api_key, $encoded_url, $nonce, $post_data_enc);
# Sign request signature with private key.
my $req_signature_hmac = encode_base64(hmac_sha256($req_signature, decode_base64($api_private_key)));
# Generate value for 'Authorization' header field.
my $auth_header_value = sprintf("amx %s:%s:%s", $api_key, $req_signature_hmac, $nonce);
Notes ...
An empty string is passed as the second argument to encode_base64() - to prevent it from appending a new-line to the output.
uri_encode() from the URI::Encode module is used the encode the URL.
You might want to use an alternative source or random generator for the nonce.
Sending the request
You could create a HTTP::Request object explicitly and pass that to LWP::UserAgent's request() method, but there is a post() convenience method which does all this for you.
The example here uses the Content parameter to set the content of the post body, and sets the Authorization and Content-Type headers at the same time.
my $response = $ua->post($url,
Content => $post_data,
'Content-Type' => 'application/json',
Authorization => $auth_header_value
);
die "Request failed: ", $response->content unless $response->is_success();
print $response->content, $/;
Checking the response
It may be enough to check the LWP Response object as above - by invoking the $response->is_success() method. Nonetheless, if you want to explicitly check for success, just decode the JSON response - using $resp = decode_json($response->decoded_content). Then examine the relevant keys in the resulting hash.

Using variable for HTTP request headers with Perl

I am trying to write a function to create HTTP requests (POST and GET mostly) in Perl. I am keeping everything generic by using variables so that I don't have to worry about the type of request, the payload, headers, etc, however HTTP::Request->header() doesn't seem to like my variable:
my($req_type, $headers, $endpoint, $args, $request, $jsonfile) = #_;
my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new($req_type => $endpoint);
$req->content_type('application/json');
foreach (#$headers) {
$req->push_header($_);
}
$req->content($args);
$req->content($request);
print "request : ".$req->as_string;
I tried a few different approches, and using push_header got me the closest, but I realize it may not be the best solution. I think it might have something to do with single quotes getting passed in:
#headers = "'x-auth-token' => '$_token'";
I can post more of the code if it is helpful. I'm hoping some Perl guru will know exactly what I'm doing wrong. I'm sure it's something to do with the format of the string I'm passing in.
#headers = "'x-auth-token' => '$_token'";
The header function expects to be passed two arguments. The header name and the header value.
You are passing it one argument: a string containing a fragment of Perl code.
You need to format your data more sensibly.
my %headers = (
"x-auth-token" => $_token;
);
and
foreach my $header_name (keys %headers) {
$req->push_header($header_name => $headers{$header_name});
}

Posting to a WEB API from Perl results in a null value in [FromBody]

We have created a WEB API (in .NET framework 4.0) and gave the endpoint info to one of our clients. They created a program in Perl that posts to our endpoint.
Every post they have made so far arrives into our endpoint as null. When we initially started programming, we had that same issue in JQuery when posting by means of $.ajax. We solved it by adding a '=' at the beginning of the post data.
The Perl code they have submitted is the following:
sub _postPackages {
my ($self,$dataToSend) = #_;
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->agent("integrationapp/1.0 ");
# Create a request
my $req = HTTP::Request->new(POST => $self->{postAddress} );
$req->content_type("application/json;charset=utf-8");
$req->content($dataToSend->{data});
#print Data::Dumper->Dump([$req]);
# Pass request to the user agent and get a response back
my $res = $ua->request($req);
where postAddress is our endpoint and $dataToSend is the message data. Is it possible that they need to add the '=' at the beginning of the $dataToSend message.
Any help will be greatly appreciated.
This is a bit of pseudo code here..
But I'm guessing you want to do something like this:
# some post sub
my ($self, $data) = #_;
my $ua = $self->get_user_agent();
my $json_xs = $self->get_json_xs();
my $json_encoded = $json_xs->utf8->encode($data);
$self->set_post_data($json_encoded);
$self->set_api_call();
my $response_body = $ua->post(
$self->get_api_call(),
'Content' => $self->get_post_data(),
'Content-type' => "application/json;charset=UTF-8"
);
print STDERR "POSTING NEW RESOURCE: " . Dumper($self);

Can't use object methods of SOAP object with SOAP::Lite

I am reading data from our Jira via SOAP and recieve an array of RemoteIssue-Objects. Now I want to iterate over these and get the status of each ticket. The documentation of RemoteIssue says that there is a getStatus()-Method. When I call it on the objects my program throws an error.
Some code:
my $soap = SOAP::Lite->uri($soap_uri)->proxy($soap_proxy);
my $login = $soap->login( $soap_user, $soap_password)->result;
if ($login) {
# This works
my $issues = $soap->getIssuesFromJqlSearch( $login, "project = \"$project\" AND fixVersion = \"$project_version\"", 500 );
if ($issues) {
foreach my $issue (#{$issues->result}) {
my $foo = $issue->getStatus(); # This doesn't work
print Dumper $foo;
}
}
}
$soap->logout();
The thrown error:
Can't locate object method "getStatus" via package "RemoteIssue" at D:\ZeuS\lib/ZeuS.pm line 81
Every other object method doesn't work either.
Does anyone know what I am doing wrong?
From what I gather, you're under the impression that you're receiving the Java object that you would manipulate on a Java consumer.
Unless $issue->getStatus() is a SOAP call (which I don't think it is) you're not dealing with the API, you're dealing with SOAP::Lite's representation in Perl of the response in XML.
getIssuesFromJqlSearch seems to be the remote call. From that, you should get $issues as a SOAP::SOM object. Which you then properly address with the result method.
This will have whatever methods are defined for the class this object is blessed into.
To see what all this object responds to try this:
use mro ();
use Scalar::Util qw<blessed>;
...
foreach my $issue (#{$issues->result}) {
say '$issue ISA ('
. join( ',', #{ mro::get_linear_isa( blessed( $issue )) } )
. ')'
;
...
}
$issue will only have those methods that have been defined for it on the Perl side.
NOTE: It is not clear from your code where ZeuS.pm comes into this thing.

Can I pass GET string in UserAgent post method

I call in this mode:
my $ua = new LWP::UserAgent;
my $response= $ua->post('www.example.com', {param1=>'val1',param2=>'val2'...} );
Can I call the above in the same way passing the values in GET form?:
my $response= $ua->post('www.example.com?param=val1&param2=val2' );
It is because I'm using Firebug and when I go to Net tab under the "POST" tab it shows individual parameters as well as a GET string for POST submitted requests.
So I was wondering if I use GET string in this function call.
Parametersapplication/x-www-form-urlencoded
Itemid 4 option com_search
searchword dsd task search Source
Content-Type:
application/x-www-form-urlencoded
Content-Length: 53
searchword=dsd&task=search&option=com_search&Itemid=4
In short you can pass GET strings yes, but if your end code does not accept GET METHOD it will fail.
Also you might still need to specify some parameters since the post method asks for post(url,array_with_parameters).
sub post {
require HTTP::Request::Common;
my($self, #parameters) = #_;
my #suff = $self->_process_colonic_headers(\#parameters, (ref($parameters[1]) ? 2 : 1));
return $self->request( HTTP::Request::Common::POST( #parameters ), #suff );
}
Using along with HTTP::Request you can specify it at the content in the way you prefer:
# Create a user agent object
use LWP::UserAgent;
my $ua = LWP::UserAgent->new;
$ua->agent("MyApp/0.1 ");
# Create a request
my $req = HTTP::Request->new(POST => 'http://www.example.com');
$req->content_type('application/x-www-form-urlencoded');
$req->content('searchword=dsd&task=search&option=com_search&Itemid=4');
# Pass request to the user agent and get a response back
my $res = $ua->request($req);
# Check the outcome of the response
if ($res->is_success) {
print $res->content;
} else {
print $res->status_line, "\n";
}
Read more...