How can I run mojolicious under Win32::Daemon? - perl

I'm trying to run mojolicious as a Windows Service using Win32::Daemon, but I don't know how to return from the start callback after starting the mojo app. The mojo app begins to listen but the Windows Service Controller assumes the start failed because you never reach the return statement.
sub Callback_Start
{
my( $Event, $Context ) = #_;
app->start; # <-- code hangs here
$Context->{last_state} = SERVICE_RUNNING;
Win32::Daemon::State( SERVICE_RUNNING );
return();
}
Is it possible to start the Mojo server in a non-blocking way?

This is what I have finally done:
my $daemon = Mojo::Server::Daemon->new( app => app, listen => ['http://*:3000' ] );
$daemon->prepare_ioloop;
Win32::Daemon::StartService( \%context, 100 );
Win32::Daemon::RegisterCallbacks({
start => \&_start,
running => \&_running,
stop => \&_stop,
pause => \&_pause,
continue => \&_continue,
});
# ...
sub _running {
my( $Event, $context ) = #_;
if( SERVICE_RUNNING == Win32::Daemon::State() ) {
$daemon->ioloop->one_tick;
}
}
sub _start {
my ($event, $context ) = #_;
$context->{last_state} = SERVICE_RUNNING;
$context->{last_event} = $event;
Win32::Daemon::State( SERVICE_RUNNING );
return();
}
# ...
Calling the one_tick method repeteadly allows you to embed the Mojo server (see the doc). With the code above Windows will call the _running sub every 100 milliseconds (second StartService parameter).

What if you'd for a process, run the web app in the child and in the parent let the service controller know everything's running fine. I'm curios about how you'd stop the service in this case :)

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!

Mojolicious Basic Authentication using "under" without Mojolicious::Lite

I am looking for a clean and simple example of how to use the "under" functionality in a "Mojolicious" application. All the examples I find are dealing with "Mojolicious::Lite" (which I don't use).
For example I listened to the screencast here http://mojocasts.com/e3 and I think I understand the concept of the under functionality. But I don't use "Mojolicious::Lite", so it seems that I can't follow the example directly. I keep on failing trying to adopt the Lite-example for non-Lite style. (That's probably also because I'm still kind of new to the framework)
The relevant code looks like this:
# Router
my $r = $self->routes;
# Normal route to controller
$r->get('/') ->to('x#a');
$r->get('/y')->to('y#b');
$r->any('/z')->to('z#c');
So all of this routes need to be protected by user/pass. I tried to do something like this:
$r->under = sub { return 1 if ($auth) };
But this does not compile and I just can't find an example matching this code-style...
Can anybody give me the right hint or link here?
And please forgive me if this is somewhere in the docs... they might be complete, but they lack understandable examples for simple minded guys like me :-P
The analogous code to the Lite-examples looks like this:
# Router
my $r = $self->routes;
# This route is public
$r->any('/login')->to('login#form');
# this sub does the auth-stuff
# you can use stuff like: $self->param('password')
# to check user/pw and return true if fine
my $auth = $r->under( sub { return 1 } );
# This routes are protected
$auth->get ('/') ->to('x#a');
$auth->post('/y')->to('y#b');
$auth->any ('/z')->to('z#c');
Hopes this helps anybody!
(Solution found here: http://mojolicio.us/perldoc/Mojolicious/Routes/Route#under)
I am doing it like this - in a full mojo (not lite) app:
in the startup method
$self->_add_routes_authorization();
# only users of type 'cashier' will have access to routes starting with /cashier
my $cashier_routes = $r->route('/cashier')->over( user_type => 'cashier' );
$cashier_routes->route('/bank')->to('cashier#bank');
# only users of type 'client' will have access to routes starting with /user
my $user_routes = $r->route('/user')->over( user_type => 'client' );
$user_routes->get('/orders')->to('user#orders');
below in the main app file:
sub _add_routes_authorization {
my $self = shift;
$self->routes->add_condition(
user_type => sub {
my ( $r, $c, $captures, $user_type ) = #_;
# Keep the weirdos out!
# $self->user is the current logged in user, as a DBIC instance
return
if ( !defined( $self->user )
|| $self->user->user_type()->type() ne $user_type );
# It's ok, we know him
return 1;
}
);
return;
}
I hope this helps
I use this scenario in my application:
my $guest = $r->under->to( "auth#check_level" );
my $user = $r->under->to( "auth#check_level", { required_level => 100 } );
my $admin = $r->under->to( "auth#check_level", { required_level => 200 } );
$guest->get ( '/login' )->to( 'auth#login' );
$user ->get ( '/users/profile' )->to( 'user#show' );
After this all children routes of $r will go over check_level subroutine:
sub check_level {
my( $self ) = #_;
# GRANT If we do not require any access privilege
my $rl = $self->stash->{ required_level };
return 1 if !$rl;
# GRANT If logged in user has required level OR we raise user level one time
my $sl = $self->session->{ user_level };
my $fl = $self->flash( 'user_level' );
return 1 if $sl >= $rl || $fl && $fl >= $rl;
# RESTRICT
$self->render( 'auth/login', status => 403 );
return 0;
}

How do I add more than one over method to a mojolicious route?

I have the following code:
$r->find('user')->via('post')->over(authenticated => 1);
Given that route I can get to the user route passing through the authenticated check
that is setup using Mojolicious::Plugin::Authentication.
I want add another 'over' to that route.
$r->find('user')->via('post')->over(authenticated => 1)->over(access => 1);
That appears to override authenticated 'over' though.
I tried breaking up the routes with names like:
my $auth = $r->route('/')->over(authenticated => 1)
->name('Authenticated Route');
$access = $auth->route('/user')->over(access => 1)->name('USER_ACCESS');
That didn't work at all though. Neither of the 'over's are being accessed.
My routes are things like /user, /item, set up using MojoX::JSON::RPC::Service.
So, I don't have things like /user/:id to set up sub routes.( not sure that matters )
All routes are like /user, sent with parameters.
I've got a condition like:
$r->add_condition(
access => sub {
# do some stuff
},
);
that is the 'access' in $r->route('/user')->over(access => 1);
In short, the routes work fine when using:
$r->find('user')->via('post')->over(authenticated => 1);
But I'm unable to add a 2nd route.
So, what am I missing in setting up these routes with multiple conditions?
Is it possible to add multiple conditions to a single route /route_name?
You can just use both conditions in over like in this test:
use Mojolicious::Lite;
# dummy conditions storing their name and argument in the stash
for my $name (qw(foo bar)) {
app->routes->add_condition($name => sub {
my ($route, $controller, $to, #args) = #_;
$controller->stash($name => $args[0]);
});
}
# simple foo and bar dump action
sub dump {
my $self = shift;
$self->render_text(join ' ' => map {$self->stash($_)} qw(foo bar));
}
# traditional route with multiple 'over'
app->routes->get('/frst')->over(foo => 'yo', bar => 'works')->to(cb => \&dump);
# lite route with multiple 'over'
get '/scnd' => (foo => 'hey', bar => 'cool') => \&dump;
# test the lite app above
use Test::More tests => 4;
use Test::Mojo;
my $t = Test::Mojo->new;
# test first route
$t->get_ok('/frst')->content_is('yo works');
$t->get_ok('/scnd')->content_is('hey cool');
__END__
1..4
ok 1 - get /frst
ok 2 - exact match for content
ok 3 - get /scnd
ok 4 - exact match for content
Works fine here with Mojolicious 3.38 on perl 5.12.1 - #DavidO is right, maybe bridges can do the job better. :)
In my case I use two under methods:
$r = $app->routes;
$guest = $r->under->to( 'auth#check_level' );
$user = $r->under->to( 'auth#check_level', { required_level => 100 } );
$admin = $r->under->to( 'auth#check_level', { required_level => 200 } );
$guest->get( '/' )->to( 'main#index' );
$user->get( '/user' )->to( 'user#show' );
$super_admin = $admin->under->to( 'manage#check_level', { super_admin => 100 } );
$super_admin->get( '/delete_everything' )->to( 'system#shutdown' );
In this example when any of routes match some under will be called
'/' -> auth#check_level -> main_index
'/user' -> auth#check_level { required_level => 100 } -> 'user#show'
'/delete_everything' -> auth#check_level { required_level => 200 } -> 'manage#check_level', { super_admin => 100 } -> 'system#shutdown'
As you can see before target action in your controller will be run another action called: auth#check_level and manage#check_level
In each those extra actions you just compare stash->{ required_level } with session->{ required_level } you have set when authorize user
package YourApp::Controller::Manage;
sub check_level {
my $self = shift;
my $user_have = $self->session->{ required_level };
my $we_require = $self->stash->{ required_level };
# 'system#shutdown' will be called if user has required level
return 1 if $user_have >= $we_require;
$self->redirect_to( '/you_have_no_access_rights' );
return 0; #This route will not match. 'system#shutdown' will not be called
}
PS Of course I may use cb or just CODEREF which are "close same" to controller action:
$r->under({ cb => \&YourApp::Controller::auth::check_level });
$r->under( \&YourApp::Controller::auth::check_level ); # "same"
But I prefer ->to( 'controller#action' ) syntax. It looks much better
What if we use this approach?
# register condition
$r->add_condition(
chain => sub {
my ($route, $controller, $captures, $checkers) = #_;
for my $checker (#$checkers) {
return 0 unless $checker->($route, $controller, $captures);
}
return 1;
},
);
# ...
# example of using
$r->get('/')->over(chain => [\&checker1, \&checker2])->to(cb => \&foo)->name('bar');

Passing Parameter to Test::Class Setup method

I need to invoke a browser in selenium dynamically.
To achieve this I need to send the browser name as parameter to the set-up or start-up methods in Test::Class. How do I achieve this?
I take it you want to get a browser, then reuse it for some tests, then destroy it later? So just use a global to hold the browser you create. For example:
my $browser = '';
sub b_connect : Test(startup) {
$browser = WWW::Selenium->new( host => "localhost",
port => 4444,
browser => "*iexplore",
browser_url => "http://www.google.com",
);
};
sub b_disconnect : Test(shutdown) {
$browser->close()
};
Just use the $browser var in you tests.
sub startup : Test( startup ) {
my ($self) = #_;
my $arg = shift;
$self->{browser_type} = $arg->{browser};
-------------------------------#some other code for myself
$self->{browser} =
Test::WWW::Selenium->new(
host => $self->{host},
port => $self->{port},
browser => $self->{browser_type},
browser_url => $self->{test_url},
);
In my test script I need it to call using the following
my $t1 = Test::Class::Selenium::TestCases->new(browser=>$browser,);
Test::Class->runtests($t1);

Why does Perl's Net::Msmgr hang when I try to authenticate?

There's Net::Msmgr module on CPAN. It's written clean and the code looks trustworthy at the first glance. However this module seems to be beta and there is little documentation and no tests :-/
Has anyone used this module in production? I haven't managed to make it run by now, because it requires all event loop processing to be done in the application and as I've already said there is little documentation and no working examples to study.
That's where I've gone so far:
#!/usr/bin/perl
use strict;
use warnings;
use Event;
use Net::Msmgr::Object;
use Net::Msmgr::Session;
use Net::Msmgr::User;
use constant DEBUG => 511;
use constant EVENT_TIMEOUT => 5; # seconds
my ($username, $password) = qw/my.username#live.com my.password/;
my $buddy = 'your.username#live.com';
my $user = Net::Msmgr::User->new(user => $username, password => $password);
my $session = Net::Msmgr::Session->new;
$session->debug(DEBUG);
$session->login_handler(\&login_handler);
$session->user($user);
my $conv;
sub login_handler {
my $self = shift;
print "LOGIN\n";
$self->ui_state_nln;
$conv = $session->ui_new_conversation;
$conv->invite($buddy);
}
our %watcher;
sub ConnectHandler {
my ($connection) = #_;
warn "CONNECT\n";
my $socket = $connection->socket;
$watcher{$connection} = Event->io(fd => $socket,
cb => [ $connection, '_recv_message' ],
poll => 're',
desc => 'recv_watcher',
repeat => 1);
}
sub DisconnectHandler {
my $connection = shift;
print "DISCONNECT\n";
$watcher{$connection}->cancel;
}
$session->connect_handler(\&ConnectHandler);
$session->disconnect_handler(\&DisconnectHandler);
$session->Login;
Event::loop();
That's what it outputs:
Dispatch Server connecting to: messenger.hotmail.com:1863
Dispatch Server connected
CONNECT
Dispatch Server >>>VER 1 MSNP2 CVR0
--> VER 1 MSNP2 CVR0
Dispatch Server >>>USR 2 MD5 I my.username#live.com
--> USR 2 MD5 I my.username#live.com
Dispatch Server <<<VER 1 CVR0
<-- VER 1 CVR0
And that's all, here it hangs. The handler on login is not being triggered. What am I doing wrong?
Hope these documents will help you out
1) Net::Msmgr documentation
2) Net::Msmgr::Session