Debugging HTTP::Tiny - perl

I am using HTTP::Tiny to interact with rest api below an example :
my $req = $ua->get('https://myapi.com/user?xyz', {headers =>
{token => 'xyzzz',
data => '5343'.
}});
i am using Data::Dumper to see the response header and body
print Dumper($req); -#i can see the response
is there an option to see also the HTTP request i am sending using HTTP::Tiny ,without the need of other tool like wireshark etc..
something like what mojo::useragent achieve with MOJO_CLIENT_DEBUG=1 any idea?

I don't see such a feature mentioned in the HTTP::Tiny documentation, nor do I see it facilitated in the source code for the module. However, you can use a module such as Test::MockModule to get a closer look at what is going on. Here is an example:
#!/usr/bin/env perl
use strict;
use warnings;
use HTTP::Tiny;
use Test::MockModule;
use Data::Dumper;
my $t = HTTP::Tiny->new();
my $mock = Test::MockModule->new('HTTP::Tiny');
$mock->redefine('_request' => sub {
warn "In _request: ", Dumper {self => $_[0], method => $_[1], url => $_[2], args => $_[3]};
return $mock->original('_request')->(#_);
});
print "Response: ", Dumper $t->get('http://localhost:3000');
So in this snippet we are mocking _request, but the mock method we install in behalf of _request calls out to the original _request method, so our mocked method becomes a wrapper around the original method, and we can dump the underlying object and args passed into the method. I'm doing the dump prior to the request being made, but I could have done the initial dump, captured the return value of the real request, and then dump the object again afterward if I thought it might contain additional useful information. So long as we return the actual response, the calling code is none the wiser.
Here's an example of the output. The URL I'm hitting is just a default Mojolicious::Lite app.
In _request: $VAR1 = {
'method' => 'GET',
'self' => bless( {
'agent' => 'HTTP-Tiny/0.076',
'no_proxy' => [],
'max_redirect' => 5,
'keep_alive' => 1,
'verify_SSL' => 0,
'timeout' => 60
}, 'HTTP::Tiny' ),
'args' => {},
'url' => 'http://localhost:3000'
};
Response: $VAR1 = {
'headers' => {
'content-length' => '146',
'content-type' => 'text/html;charset=UTF-8',
'server' => 'Mojolicious (Perl)',
'date' => 'Sun, 26 May 2019 03:19:57 GMT'
},
'protocol' => 'HTTP/1.1',
'reason' => 'OK',
'url' => 'http://localhost:3000',
'success' => 1,
'status' => '200',
'content' => '<!DOCTYPE html>
<html>
<head><title>Welcome</title></head>
<body><h1>Welcome to the Mojolicious real-time web framework!</h1>
</body>
</html>
'
};
Before I was able to know that _request was where I wanted to target my mock, I had to look at the source code for HTTP::Tiny. Fortunately the ::Tiny part of the module means there's not a whole lot to look at. It's really a relatively simple module.
You may decide that for your own purposes it makes more sense to introduce your wrapper at some other point in HTTP::Tiny, but wrapping _request seems like a pretty good choice for most cases.

Related

mojo::useragent and Get Request Parameters

Let's Say I have this Mojo::UserAgent get request :
use Mojo::UserAgent;
my $ua = Mojo::UserAgent->new;
print $ua->get('https://google.com?q=mojolicious&format=json');
on the above example the get parameters provided as part of the url itself , I am asking if there are an option to separate the request parameters from the url
I tried form but its not achieving the same result like using this directly as url 'https://google.com?q=mojolicious&format=json'
print $ua->get('https://google.com' => form => {q= > 'mojolicious' ,format='json'});
any idea how to achieve the above ?
Your code has some formatting issues:
q= > 'mojolicious should read q => 'mojolicious'
format='json' should read format => 'json'
and you are missing a closing curly }
So all in all your line should look like this:
$ua->get('https://google.com' => form => {q => 'mojolicious', format => 'json' });
This method returns an instance Mojo::Transaction::HTTP which you can use like this:
my $tx = $ua->get('https://google.com' => form => { q => 'mojolicious', format => 'json' });
print $tx->res->body;
For further reading please consult https://metacpan.org/pod/Mojo::Transaction::HTTP

How can I send mail in a Perl script?

I have adapted a script from the Perl Cookbook. I am testing it to send mail to myself in gmail.
#!/usr/bin/perl
use strict;
use warnings;
use MIME::Lite;
my $msg;
$msg = MIME::Lite->new(From => 'zmumba#gmail.com',
To => 'zmumba#gmail.com',
Subject => 'My office photo',
Type => 'multipart/mixed');
$msg->attach(Type => 'image/png',
Path => '/home/zmumba/ZMD_Proj/Docs/Reporting',
Filename => 'office_lyout.png');
$msg->attach(Type => 'TEXT',
Data => 'I hope you can use this!');
$msg->send( );
When I run this script, I get the message "/home/zmumba/ZMD_Proj/Docs/Reporting" not readable.
From here How can I send mail through Gmail with Perl? , I now understand that I have to send mail through a mailserver to use MIME::Lite. So I replaced
$msg = MIME::Lite->new(From => 'zmumba#gmail.com
with
$msg = Email::Send::Gmail->new(From => 'zmumba#gmail.com
and I get the error "Can't locate object method "new" via package Email::Send::Gmail".
Then I tried
$msg = Net::IMAP::Simple::SSL->new(From => 'zmumba#gmail.com',
and I get "Odd number of elements in hash assignment at /home/zmumba/perl5/lib/perl5/Net/IMAP/Simple.pm line 25.
Can't call method "attach" on an undefined value at ...".
Any assistance on how to go about it?
Thanks in anticipation.
The Perl Cookbook is 20 years old and its recommendations will be out of date. Using MIME::Lite is discouraged.
MIME::Lite is not recommended by its current maintainer. There are a number of alternatives, like Email::MIME or MIME::Entity and Email::Sender, which you should probably use instead. MIME::Lite continues to accrue weird bug reports, and it is not receiving a large amount of refactoring due to the availability of better alternatives. Please consider using something else.
You should probably follow their recommendation and use Email::Sender.
"Can't locate object method "new" via package Email::Send::Gmail"
You need to load Email::Send::Gmail with use Email::Send::Gmail.
You may need to install the Email::Send::Gmail module. It's simplest to do this using either cpanminus or install a fresh Perl with perlbrew and then use cpanminus.
Then I tried
$msg = Net::IMAP::Simple::SSL->new(From => 'zmumba#gmail.com',
and I get "Odd number of elements in hash assignment at /home/zmumba/perl5/lib/perl5/Net/IMAP/Simple.pm line 25.
MIME::Lite, Email::Send::Gmail, and Net::IMAP::Simple::SSL are different libraries with different interfaces that take different arguments differently. Refer to their documentation for how to use them.
As mentioned before, both MIME::Lite and Email::Send is discouraged -
Email::Send is going away... well, not really going away, but it's
being officially marked "out of favor." It has API design problems
that make it hard to usefully extend and rather than try to deprecate
features and slowly ease in a new interface, we've released
Email::Sender which fixes these problems and others
I have created a script which uses Email::MIME, Email::Sender::Simple, Email::Sender::Transport::SMTP for sending mail. You can take a look at https://github.com/rai-gaurav/perl-toolkit/tree/master/Mail and use it as per your requirement.
Important lines from that code are -
sub create_mail {
my ( $self, $file_attachments, $mail_subject, $mail_body ) = #_;
my #mail_attachments;
if (#$file_attachments) {
foreach my $attachment (#$file_attachments) {
my $single_attachment = Email::MIME->create(
attributes => {
filename => basename($attachment),
content_type => "application/json",
disposition => 'attachment',
encoding => 'base64',
name => basename($attachment)
},
body => io->file($attachment)->all
);
push( #mail_attachments, $single_attachment );
}
}
# Multipart message : It contains attachment as well as html body
my #parts = (
#mail_attachments,
Email::MIME->create(
attributes => {
content_type => 'text/html',
encoding => 'quoted-printable',
charset => 'US-ASCII'
},
body_str => $mail_body,
),
);
my $mail_to_users = join ', ', #{ $self->{config}->{mail_to} };
my $cc_mail_to_users = join ', ', #{ $self->{config}->{mail_cc_to} };
my $email = Email::MIME->create(
header => [
From => $self->{config}->{mail_from},
To => $mail_to_users,
Cc => $cc_mail_to_users,
Subject => $mail_subject,
],
parts => [#parts],
);
return $email;
}
sub send_mail {
my ( $self, $email ) = #_;
my $transport = Email::Sender::Transport::SMTP->new(
{
host => $self->{config}->{smtp_server}
}
);
eval { sendmail( $email, { transport => $transport } ); };
if ($#) {
return 0, $#;
}
else {
return 1;
}
}
Gmail and other mail servers will not allow unauthorized relay. In most cases you will need authorized access.
Here is what I use, after also trying many modules. Maybe this solution seems a little bit overdone, but it's easy to change for HTML with plain text as alternative or other attachments. Parameters of the transport are the most common ones.
#!perl
use strict;
use warnings;
use utf8;
use Email::Sender::Simple qw(sendmail try_to_sendmail);
use Email::Sender::Transport::SMTPS;
use Email::Simple ();
use Email::Simple::Creator ();
use Email::MIME;
send_my_mail('john.doe#hisdomain.com','Test','Test, pls ignore');
sub send_my_mail {
my ($to_mail_address, $subject, $body_text) = #_;
my $smtpserver = 'smtp.mydomain.com';
my $smtpport = 587;
my $smtpuser = 'me#mydomain.com';
my $smtppassword = 'mysecret';
my $transport = Email::Sender::Transport::SMTPS->new({
host => $smtpserver,
ssl => 'starttls',
port => $smtpport,
sasl_username => $smtpuser,
sasl_password => $smtppassword,
#debug => 1,
});
my $text_part = Email::MIME->create(
attributes => {
'encoding' => 'quoted-printable',
'content_type' => 'text/plain',
'charset' => 'UTF-8',
},
'body_str' => $body_text,
);
my $alternative_part = Email::MIME->create(
attributes => {
'content_type' => 'multipart/alternative',
},
parts => [ $text_part, ],
);
my $email = Email::MIME->create(
header_str => [
To => $to_mail_address,
From => "Website <$smtpuser>",
Subject => $subject,
],
attributes => {
'content_type' => 'multipart/mixed',
},
parts => [ $alternative_part ],
);
my $status = try_to_sendmail($email, { transport => $transport });
return $status;
}
Take a look at Email::Send::Gmail module. It might solve your problem.

I can't connect using an api

I'm quite new to API's so I don't know if this should be more straight forward.
I write the following perl script
use strict;
use LWP::UserAgent;
require HTTP::Request;
my $request = HTTP::Request->new(GET => 'http://api.elsevier.com/content/ev/results?apiKey=1234&query=stress&database=c&updateNumber=1&pageSize=1');
my $ua = LWP::UserAgent->new;
my $response = $ua->request($request);
then when I get my response and print it in the debugger I get the following
HTTP::Response=HASH(0x9aedff8)
'_content' => '{"service-error":{"status":{"statusCode":"AUTHENTICATION_ERROR","statusText":"Requestor configuration settings insufficient for access to this resource."}}}'
'_headers' => HTTP::Headers=HASH(0x9aedfe8)
'allow' => 'GET'
'client-date' => 'Wed, 29 Mar 2017 08:08:25 GMT'
'client-peer' => '198.185.19.118:80'
'client-response-num' => 1
'content-length' => 156
'content-type' => 'application/json;charset=UTF-8'
'date' => 'Wed, 29 Mar 2017 08:08:24 GMT'
'p3p' => 'CP="IDC DSP LAW ADM DEV TAI PSA PSD IVA IVD CON HIS TEL OUR DEL SAM OTR IND OTC"'
'server' => 'api.elsevier.com 9999'
'vary' => 'Origin'
'x-cnection' => 'close'
'x-els-apikey' => 'e688c9db4db0386581dbe4c4dda46164'
'x-els-reqid' => '0000015b190d89fe-a0d0'
'x-els-status' => 'AUTHENTICATION_ERROR(Requestor configuration settings insufficient for access to this resource.)'
'x-els-transid' => 'cbf787b4-d171-4e35-8237-8cab3c931205'
'x-re-ref' => '1 1490774904423414'
'_msg' => 'Forbidden'
'_protocol' => 'HTTP/1.1'
'_rc' => 403
'_request' => HTTP::Request=HASH(0x9fc3000)
'_content' => ''
'_headers' => HTTP::Headers=HASH(0x9ae73e0)
'user-agent' => 'libwww-perl/5.831'
'_method' => 'GET'
'_uri' => URI::http=SCALAR(0x9e25188)
-> 'http://api.elsevier.com/content/ev/results?apiKey=e688c9db4db0386581dbe4c4dda46164&query=stress&database=c&updateNumber=1&pageSize=1'
'_uri_canonical' => URI::http=SCALAR(0x9e25188)
-> REUSED_ADDRESS
one of the notable lines is
x-els-status' => 'AUTHENTICATION_ERROR(Requestor configuration settings insufficient for access to this resource.)'
I don't know how to get a proper response text. I tried searching their websites for examples, but I can't seem to get it. as well I'm not sure if the key is only for scopus but not engineering village which I'm trying to use.
There website is here. https://dev.elsevier.com/index.html?utm_expid=89327795-0.AtRZzToKQ2u1mZEyQ3n7OQ.0&utm_referrer=https%3A%2F%2Fdev.elsevier.com%2Ftecdoc_ev_retrieval_request.html
any help would be appreciated
To get the text out of your response, you need to call the $response->decoded_content method. That will give you the JSON string that you can see in _content in your debug output. I've indented it to make it easier to read.
{
"service-error" : {
"status" : {
"statusCode" : "AUTHENTICATION_ERROR",
"statusText" : "Requestor configuration settings insufficient for access to this resource."
}
}
}
You can use the JSON module to decode this into a Perl data structure.
use JSON 'from_json';
my $res = $ua->request($req);
my $json = from_json( $res->decoded_content );
The error message you get back clearly states that you are not authenticated properly. I've looked at this guide from the documentation you mentioned. It seems that the apiKey URL param works, if you have the right type of account. You should check with whoever made that account for you, or if that was you and you're not sure, the account manager at that service that is working with you. They'll tell you if you are using the right API key, and if this method of authentication works for you.
Since this API also offers to use a custom header X-ELS-APIKey: [apikey] for the authentication I would suggest using that. Your API key is a secret, and you shouldn't share it with anyone. It's like a password. If you put it into the URL, it might show up in log files. But as a header, it does usually not.
This is how you add a custom header to an HTTP request. Make sure you don't have the apiKey URL param any more if you do this.
my $req = HTTP::Request->new( GET => $url ); # no apiKey=123 here!
$req->header( 'X-ELS-APIKey' => 123 );
Now as a last step, you should check the HTTP response code of the response. A 200 (or most other codes that start with 2) means the request was successful. The 403 that you are getting back means unauthorized, which also hints at that you are not authenticated correctly.
Since it seems that this API returns JSON in both success and failure cases, you might need to decode it for both. If you care to examine the failure response, that makes sense. If not, you can skip that part. To do this, use $res->is_success, which is also used in the synopsis of the LWP::UserAgent documentation.
use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Request;
use JSON 'from_json';
my $ua = LWP::UserAgent->new;
my $req = HTTP::Request->new( GET => 'http://api.elsevier.com/content/ev/results?query=stress&database=c&updateNumber=1&pageSize=1' );
$req->header( 'X-ELS-APIKey' => 123 );
if ($req->is_success) {
my $json = from_json( $res->decoded_content );
# ... do stuff with the response
} else {
# something went wrong
}

Perl and LWP not authenticating

I'm trying to get an LWP request working to an https server. I have been given a user & pass, advised to use basic authentication. I've tried various chunks of code, and all seem to get an authentication error. My current code is...
use warnings;
use strict;
use Data::Dumper;
use LWP;
my $ua = LWP::UserAgent->new( keep_alive => 1 );
##also tried by $ua->credentials('domain','','user','pass');
##not sure if I need 'realm' or how I get it, as no popup on screen.
my $request = HTTP::Request->new( GET => "https://my.url.com/somepath/" );
$request->authorization_basic('myuser','mypass');
$request->header( 'Cache-Control' => 'no-cache' );
print $response->content;
print Dumper $response;
The server gives a security error, but if I look at a dump of $response, I see the following...
'_rc' => '401',
'_headers' => bless( { .... lots of stuff
'title' => 'Security Exception',
'client-warning' => 'Missing Authenticate header',
'client-ssl-socket-class' => 'IO::Socket::SSL',
...
'expires' => '-1'
}, 'HTTP::Headers' ),
'_msg' => 'Unauthorized',
'_request' => bless( {
'_content' => '',
'_uri' => bless( do{\(my $o = 'https:theurlabove')}, 'URI::https' ),
'_method' => 'GET',
'_uri_canonical' => $VAR1->{'_request'}{'_uri'}
'_headers' => bless( {
'user-agent' => 'libwww-perl/6.04',
'cache-control' => 'no-cache',
'authorization' => 'Basic dzx..........'
}, 'HTTP::Headers' ),
I'm trying to understand whats happening, it looks like in the original request, it has the headers in there, but in the response, its saying I'm 'Missing Authenticate Header'.
Is there something amiss with the code, or something I'm misunderstanding with the request/respinse ?
Thanks.
The "Missing Authenticate header" message is coming from LWP itself. This means that it couldn't find an authenticate header in the target response. This might mean that your proxy settings are misconfigured, if you have anything like that.
I don't know if this is what you are looking for but I came across the same problem trying to authenticate to a webpage and had to solve it with WWW::Mechanize. I had to go to the first page and login then request the page I wanted.
use WWW::Mechanize;
my $loginPage = "http://my.url.com/login.htm"; # Authentication page
my $mech = WWW::Mechanize->new(); # Create new brower object
$mech->get($loginPage); # Go to login page
$mech->form_name('LogonForm'); # Search form named LogonForm
$mech->field("username", myuser); # Fill out username field
$mech->field("password", mypass); # Fill out password field
$mech->click("loginloginbutton"); # submit form
$mech->get("http://my.url.com/somepath/"); # Get webpage
# Some more code here with $mech->content()

Logging into Jenkins via Perl script

I am able to change a build's description with the following program. This will change the build's description to "FOO FOO FOO". Unfortunately, my login doesn't work. Right now, this test Jenkins build server has no security on it. However, on our regular Jenkins server, you need to be logged in to change a build's description.:
#! /usr/bin/env perl
use 5.12.0;
use warnings;
use LWP::UserAgent;
use HTTP::Request::Common qw(POST);
use Data::Dumper;
use constant {
JENKINS_BASE => "http://build.vegibank.com/",
USER_ID => "buildguy",
PASSWORD => "swordfish",
};
use constant {
LOGIN_URL => JENKINS_BASE . '/j_acegi_security_check',
JOB_URL => JENKINS_BASE . '/job',
SUBMIT_DESCRIPTION => 'submitDescription',
};
my $job_number = 4;
my $job_name = "proginator-2.0";
my $description = "FOO FOO FOO";
my $user_agent = LWP::UserAgent->new or die qq(Can't get User Agent);
#
# My Login Stuff (but it doesn't do anything w/ security off
#
my $response = $user_agent->request (
POST LOGIN_URL,
[
j_username => USER_ID,
j_password => PASSWORD,
],
);
$response = $user_agent->request (
POST "#{[JOB_URL]}/$job_name/$job_number/#{[SUBMIT_DESCRIPTION]}",
[
description => "$description",
],
);
I'm trying to connect to the Jenkins login session, but I don't believe I'm doing it quite right. When I attempt to login, I get a 302 response and the following dump of my response object:
$VAR1 = bless( {
'_protocol' => 'HTTP/1.1',
'_content' => '',
'_rc' => '302',
'_headers' => bless( {
'connection' => 'close',
'client-response-num' => 1,
'set-cookie' => 'JSESSIONID=1D5DF6FAF8714B2ACA4D496FBFE6E983; Path=/jenkins/; HttpOnly',
'location' => 'http://build.vegicorp.com/;jsessionid=1D5DF6FAF8714B2ACA4D496FBFE6E983',
'date' => 'Mon, 13 May 2013 20:02:35 GMT',
'client-peer' => '10.10.21.96:80',
'content-length' => '0',
'client-date' => 'Mon, 13 May 2013 20:02:35 GMT',
'content-type' => 'text/plain; charset=UTF-8',
'server' => 'Apache-Coyote/1.1'
}, 'HTTP::Headers' ),
'_msg' => 'Moved Temporarily',
'_request' => bless( {
'_content' => 'j_username=buildguy&j_password=swordfish',
'_uri' => bless( do{\(my $o = 'http://build.vegicorp.com/j_acegi_security_check')}, 'URI::http' ),
'_headers' => bless( {
'user-agent' => 'libwww-perl/6.03',
'content-type' => 'application/x-www-form-urlencoded',
'content-length' => 42
}, 'HTTP::Headers' ),
'_method' => 'POST',
'_uri_canonical' => $VAR1->{'_request'}{'_uri'}
}, 'HTTP::Request' )
}, 'HTTP::Response' );
I figure I must be hitting a valid page since I'm getting a 302 code, but my fields might not be correct (or I'm going to the wrong page).
Can anyone help?
My authorization is failing because ...what is the technical term? Oh yeah... "doing it all wrong."
After Googling and getting a lot of unhelpful junk, I, on a lark, decided to see if the Jenkins website might have something on this. And, it did right under a page called Authenticating scripted clients. In fact, they even give a Perl LWP example for a scripted client.
Ha ha, I was trying too hard. It seems that Jenkins will use the basic HTTP authentication mechanism, and I don't have to go through conniptions trying to figure out how their login form works. Apparently, Jenkins is simplifying the basic authentication mechanism for you even if your authentication mechanism is far from basic -- like a good program should do.
So, all I had to do was use the basic authentication mechanism.
my $browser = LWP::UserAgent->new or die qq(Cannot get User Agent);
my $request = HTTP::Request->new;
$request->authorization_basic(USER_ID, PASSWORD);
$request->method("GET");
$request->url("$jenkins_url");
my $response = $browser->request($request);
if ( not $response->is_success ) {
die qq(Something went horribly wrong...);
}
I've seen the redirect when the login is successful -- it sets the session cookie and redirects you to the main page.
Your post might be failing because the UA object isn't persisting the session cookie. Per the documentation, 'The default is to have no cookie_jar, i.e. never automatically add "Cookie" headers to the requests.' Try:
my $ua = LWP::UserAgent->new( cookie_jar => HTTP::Cookies->new() );
To store and reuse your session for the description change post.
(Also, credentials are visible in your header dump, may want to edit... Edit: I'm an idiot, they're in your constants too and're likely fake.)