Less verbose debug screen in Catalyst? - perl

in my stage server I would like to activate the debug so the clients can find errors for themselves before the app goes to the production server.
BUT I only want the first part of the message, not the Request, or the Session Data.
For example: Couldn't render template "templates/home.tt2: file error - templates/inc/heater: not found".
The message is enough for me and for my client to see that the "header" call is misspelled.
The Request has a lot of irrelevant information for the client, but also has A LOT of internal developing information that should be hidden all the time!!
Regards

What you want is to override Catalyst's dump_these method. This returns a list of things to display on Catalyst's error debugging page.
The default implementation looks like:
sub dump_these {
my $c = shift;
[ Request => $c->req ],
[ Response => $c->res ],
[ Stash => $c->stash ],
[ Config => $c->config ];
}
but you can make it more restrictive, for example
sub dump_these {
my $c = shift;
return [ Apology => "We're sorry that you encountered a problem" ],
[ Response => substr($c->res->body, 0, 512) ];
}
You would define dump_these in your app's main module -- the one where you use Catalyst.

I had a similar problem that I solved by overriding the Catalyst method log_request_parameters.
Something like this (as #mob said, put it in your main module):
sub log_request_parameters {
my $c = shift;
my %all_params = #_;
my $copy = Clone::clone(\%all_params); # don't change the 'real' request params
# Then, do anything you want to only print what matters to you,
# for example, to hide some POST parameters:
my $body = $copy->{body} || {};
foreach my $key (keys %$body) {
$body->{$key} = '****' if $key =~ /password/;
}
return $c->SUPER::log_request_parameters( %$copy );
}
But you could also simply return at the beginning, if you don't want any GET/POST parameters displayed.

Well, I didn't think of the more obvious solution, in your case: you could simply set your log level to something higher than debug, which would prevent these debug logs from being displayed, but would keep the error logs:
# (or a similar condition to check you are not on the production server)
if ( !__PACKAGE__->config->{dev} ) {
__PACKAGE__->log->levels( 'warn', 'error', 'fatal' ) if ref __PACKAGE__->log;
}

Related

Delayed response to slash command with Mojolicious in Perl

I am trying to create a slack application in Perl with mojolicious and I am having the following use case:
Slack sends a request to my API from a slash command and needs a response in a 3 seconds timeframe. However, Slack also gives me the opportunity to send up to 5 more responses in a 30 minute timeframe but still needs an initial response in 3 seconds (it just sends a "late_response_url" in the initial call back so that I could POST something to that url later on). In my case I would like to send an initial response to slack to inform the user that the operation is "running" and after a while send the actual outcome of my slow function to Slack.
Currently, I can do this by spawning a second process using fork() and using one process to respond imidiately as Slack dictates and the second to do the rest of the work and respond later on.
I am trying to do this with Mojolicious' subprocesses to avoid using fork(). However I can't find a way to get this to work....
a sample code of what I am already doing with fork is like this:
sub withpath
{
my $c = shift;
my $user = $c->param('user_name');
my $response_body = {
response_type => "ephemeral",
text => "Running for $user:",
attachments => [
{ text => 'analyze' },
],
};
my $pid = fork();
if($pid != 0){
$c->render( json => $response_body );
}else{
$output = do_time_consuming_things()
$response_body = {
response_type => "in-channel",
text => "Result for $user:",
attachments => [
{ text => $output },
],
};
my $ua = Mojo::UserAgent->new;
my $tx = $ua->post(
$response_url,
{ Accept => '*/*' },
json => $response_body,
);
if( my $res = $tx->success )
{
print "\n success \n";
}
else
{
my $err = $tx->error;
print "$err->{code} response: $err->{message}\n" if $err->{code};
print "Connection error: $err->{message}\n";
}
}
}
So the problem is that no matter how I tried I couldn't replicate the exact same code with Mojolicious' subproccesses. Any ideas?
Thanks in advance!
Actually I just found a solution to my problem!
So here is my solution:
my $c = shift; #receive request
my $user = $c->param('user_name'); #get parameters
my $response_url = $c->param('response_url');
my $text = $c->param('text');
my $response_body = { #create the imidiate response that Slack is waiting for
response_type => "ephemeral",
text => "Running for $user:",
attachments => [
{ text => 'analyze' },
],
};
my $subprocess = Mojo::IOLoop::Subprocess->new; #create the subprocesses
$subprocess->run(
sub {do_time_consuming_things($user,$response_url,$text)}, #this callback is the
#actuall subprocess that will run in background and contains the POST request
#from my "fork" code (with the output) that should send a late response to Slack
sub {# this is a dummy subprocess doing nothing as this is needed by Mojo.
my ($subprocess, $err, #results) = #_;
say $err if $err;
say "\n\nok\n\n";
}
);
#and here is the actual imidiate response outside of the subprocesses in order
#to avoid making the server wait for the subprocess to finish before responding!
$c->render( json => $response_body );
So I actually simply had to put my code of do_time_consuming_things in the first callback (in order for it to run as a subprocess) and use the second callback (that is actually linked to the parent process) as a dummy one and keep my "imidiate" response in the main body of the whole function instead of putting it inside one of the subprocesses. See code comments for more information!

How to access session data from test?

The Mojolicious framework states next:
Any aspect of the application (helpers, plugins, routes, etc.) can be introspected from Test::Mojo through the application object.
But when helper, for example, $c->current_user deals with session it fails.
The session data is not available and I can not access it from test:
$t->app->session # {}
Thus $t->app->current_user fails too.
How to access session data from test?
UPD The test
use Mojo::Base -strict;
use Mojolicious::Lite;
use Test::More;
use Test::Mojo;
get '/set_session' => sub {
my $c = shift;
$c->session->{ user_id } = 1;
$c->render( text => $c->session->{ user_id } );
};
get '/get_session' => sub {
my $c = shift;
$c->render( text => $c->session->{ user_id } );
};
my $t = Test::Mojo->new;
$t->get_ok( '/set_session' )->status_is(200);
is $t->app->session->{ user_id }, 1, 'Session available from test script';
$t->get_ok( '/get_session' )->status_is(200)
->content_is( 1 );
done_testing();
UPD test result
ok 1 - GET /set_session
ok 2 - 200 OK
not ok 3 - Session available from test script
# Failed test 'Session available from test script'
# at t/session.t line 22.
# got: undef
# expected: '1'
ok 4 - GET /get_session
ok 5 - 200 OK
ok 6 - exact match for content
1..6
# Looks like you failed 1 test of 6.
UPD
It seems that Mojo::Test object should save session object in addition to the request and response objects from the previous transaction
To test helpers in context of last request I write next role:
package Test::Mojo::Role::Helper;
use Mojo::Base -role;
sub helper {
my( $t ) = #_;
$t->tx->req->cookies( #{ $t->tx->res->cookies } );
$t->app->build_controller( $t->tx );
}
1;
Then use it as next:
use Test::Mojo;
my $t = Test::Mojo->with_roles( '+Helper' )->new( 'MyApp' );
$t->post_ok( '/login', json => { contact => $user_c, password => $user_p } )
->status_is( 200 );
is $t->helper->uid, 1, "Authorized user has identificator";
is $t->helper->role, 'user', "Authorized user has 'user' privilege";
UPD More robust solution
package Test::Mojo::Role::Helper;
use Mojo::Base -role;
my $req_context; # Here is controller object
sub helper { $req_context }
sub hook_context {
my( $t ) = #_;
$t->app->hook( after_dispatch => sub{ $req_context = shift });
$t;
}
1;
The testing is same with next small difference. When application is constructed we should hook to after_dispatch event:
my $t = Test::Mojo
->with_roles( '+Helper' )
->new( 'App' )
->hook_context;
The Test::Mojo class does not give you direct access to the session contents. The test class represents a client of your Mojolicious application, and the client does not have direct access to the session cookie either (well, it's just base64-encoded JSON so it's not exactly secret, but still …).
The “proper” way to test the session is to check that the app behaves correctly regarding the session, not just to check that the session was set to some value. That's effectively what your /get_session endpoint does. Of course you shouldn't just add such an endpoint for testing, but consider how the session fits into your requirements. E.g. as a BDD-style scenario:
Feature: the secret page
there is a secret page that should be only visible to logged-in users.
Background:
Given a user "test:test123"
Given a new client
Scenario: users cannot see the page when they are not logged in
When I visit the /secret page
Then I get a 404 response
Scenario: users can see the page after logging in
Given I log in as "test:test123"
When I visit the /secret page
Then I see "this is the secret"
The $t->app->session does not contain the session because the session data is loaded into the controller's stash. This only exists for the duration of the request. In particular app->session is merely a helper that delegates to the current controller, not a primary method of the application.
If you really need to peek into the session cookie, this might be the least insane way to do it, short of inflating a controller object:
my ($session) = grep { $_->name eq $t->app->sessions->cookie_name } $t->ua->cookie_jar->all->#*;
$session = $session->value =~ s/--[^-]+$//r; # strip signature
$session =~ tr/-/=/;
$session = $t->app->sessions->deserialize->(Mojo::Util::b64_decode $session);

Perl -- 'Not a HASH reference' error when using JSON::RPC::Client

I'm a newbie in Perl.
I have a JSON-RPC server running at http://localhost:19000 and I need to call checkEmail() method.
use JSON::RPC::Client;
my $client = new JSON::RPC::Client;
my $url = 'http://localhost:19000';
my $callobj = {
method => 'checkEmail',
params => [ 'rprikhodchenko#gmail.com' ],
};
my $res = $client->call($url, $callobj);
if($res) {
if ($res->is_error) {
print "Error : ", $res->error_message;
}
else {
print $res->result;
}
}
else {
print $client->status_line;
}
When I try to launch it it tells following:
perl ./check_ac.pl
Not a HASH reference at /usr/local/share/perl/5.10.1/JSON/RPC/Client.pm line 193.
UPD:
Full stack-trace:
perl -MCarp::Always ./check_ac.pl
Not a HASH reference at /usr/local/share/perl/5.10.1/JSON/RPC/Client.pm line 193
JSON::RPC::ReturnObject::new('JSON::RPC::ReturnObject', 'HTTP::Response=HASH(0x9938d48)', 'JSON=SCALAR(0x96f1518)') called at /usr/local/share/perl/5.10.1/JSON/RPC/Client.pm line 118
JSON::RPC::Client::call('JSON::RPC::Client=HASH(0x944a818)', 'http://localhost:19000', 'HASH(0x96f1578)') called at ./check_ac.pl line 11
This error means that your JSON-RPC server is not actually one, inasmuch as it does not satisfy requirement 7.3. The error is triggered when JSON::RPC::Client assumes the document returned by the JSON-RPC service is well-formed (i.e., a JSON Object), and this assumptions turns out to have been in error. A bug report to the author of JSON::RPC::Client would be an appropriate way to request better error messaging.
I would attack this sort of problem by finding out what the server was returning that was causing JSON::RPC::Client to choke. Unfortunately, JRC fails to provide adequate hookpoints for finding this out, so you'll have to be a little bit tricky.
I don't like editing external libraries, so I recommend an extend-and-override approach to instrumenting traffic with the JSON-RPC server. Something like this (in check_ac.pl):
use Data::Dumper qw();
package JSON::RPC::InstrumentedClient;
use base 'JSON::RPC::Client';
# This would be better done with Module::Install, but I'm limiting dependencies today.
sub _get {
my ($self, #args) = #_;
return $self->_dump_response($self->SUPER::_get(#args));
}
sub _post {
my ($self, #args) = #_;
return $self->_dump_response($self->SUPER::_post(#args));
}
sub _dump_response {
my ($self, $response) = #_;
warn Data::Dumper::Dump([$response->decoded_content], [qw(content)]);
return $response;
}
package main;
my $client = JSON::RPC::InstrumentedClient->new();
my $url = 'http://localhost:19000';
... # rest of check_ac.pl
This wraps the calls to _get and _post that JSON::RPC::Client makes internally in such a way as to let you examine what the web server actually said in response to the request we made. The above code dumps the text content of the page; this might not be the right thing in your case and will blow up if an error is encountered. It's a debugging aid only, to help you figure out from the client code side what is wrong with the server.
That's enough caveats for now, I think. Good luck.
It seems to be a bug in method new of JSON::RPC::ReturnObject.
sub new {
my ($class, $obj, $json) = #_;
my $content = ( $json || JSON->new->utf8 )->decode( $obj->content );
#...
# line 193
$content->{error} ? $self->is_success(0) : $self->is_success(1);
#...
}
$content's value will be something returned from a JSON::decode() call. But looking at the documentation, it seems that JSON->decode() returns a scalar which could be a number, a string, an array reference, or a hash reference.
Unfortunately, JSON::RPC::ReturnObject->new() doesn't check what sort of thing JSON->decode() returned before trying to access it as a hashref. Given your error, I'm going to go ahead and assume what it got in your case was not one. :-)
I don't know if there's a way to force a fix from your code. I'd recommend contacting the author and letting him know about the issue, and/or filing a bug.

How to remove login form from this CGI::Application example?

In this tutorial he creates a custom login form, just to show how it is done. Please search for
How do I remove the custom login and fall back to the default?
To code looks like this
sub cgiapp_init {
my $self = shift;
my %CFG = $self->cfg;
# ...
$self->authen->config(
DRIVER => [ 'Authen::Simple::LDAP',
host => '',
basedn => '',
],
STORE => 'Session',
LOGOUT_RUNMODE => 'logout',
LOGIN_RUNMODE => 'login',
POST_LOGIN_RUNMODE => 'okay',
RENDER_LOGIN => \&my_login_form,
);
$self->authen->protected_runmodes(
'mustlogin',
);
}
sub login : Runmode {
my $self = shift;
my $url = $self->query->url;
my $user = $self->authen->username;
if ($user) {
my $message = "User $user is already logged in!";
my $template = $self->load_tmpl('default.html');
$template->param(MESSAGE => $message);
$template->param(MYURL => $url);
return $template->output;
} else {
my $url = $self->query->self_url;
unless ($url =~ /^https/) {
$url =~ s/^http/https/;
return $self->redirect($url);
}
return $self->my_login_form;
}
}
Update
Here is mentions that CGI::Application have a default login that looks better than his.
Line 159 specifies a subroutine to use
to generate a login form. Note that
the Authentication plugin comes with a
default form that you can use. I'm
including this one just to demonstrate
how to go about creating one of your
own, in case you really want to. The
default one actually looks much better
than mine, so you might wish to
comment out line 159!
I'm the author of that tutorial. Sorry for the confusion!
What I should have said is "comment out lines 157, 158, and 159 of Login.pm".
To use the default form that's built in to the CGI::Application::Plugin::Authentication module, you don't need to specify LOGIN_RUNMODE, POST_LOGIN_RUNMODE, or RENDER_LOGIN.
Those are all provided just to help you customize your login page. I included a customized
version in the tutorial thinking that most people would need to know how to do so.
The default one actually looks much better than mine, so you might wish to comment out line 159!
Comment out line 159.

How do I stack Plack authentication handlers?

I would like to have my Plack app try several different means of authorizing the user. Specifically, check if the user is already authorized via a session cookie, then check for Digest authentication and then fall back to Basic.
I figured I could just enable a bunch of Auth handlers in the order I wanted them to be checked (Session, Digest, Basic). Unfortunately, the way that Plack::Middleware::Auth::Digest and Plack::Middleware::Auth::Basic are written they both return 401 if digest or basic auth doesn't exist, respectively.
How is this normally dealt with in Plack?
I do not have an implementation but I think I have the approach. You can do this "in-line" with Plack::Middleware::Conditional. So it would look like this but you'll have to fill in the missing conditions/tests. I didn't see an easy/obvious way but I suspect you might. Since you have the $env to pass around you should be able to set/check HTTP_/session stuff in the order you want and keep the state for the next handler to know if it should be enabled or not.
use Plack::Builder;
my $app = sub {
[ 200,
[ "Content-Type" => "text/plain" ],
[ "O HAI, PLAK!" ]
];
};
builder {
enable "Session::Cookie";
enable_if { my $env = shift;
# I don't know...
} "Auth::Digest",
realm => "Secured", secret => "BlahBlah",
authenticator => sub { $_[0] eq $_[1] };
enable_if { my $env = shift;
# I don't know...
} "Auth::Basic",
authenticator => sub { $_[0] eq $_[1] };
$app;
};
I think you are going to need to write your own middleware, since ideally (based on a very quick read of RFC 2617) when not authenticated you would return a WWW-Authenticate header with both Basic and Digest challenges (with Basic first, for user agents that only understand Basic).