[dancer-users] 2018 Dancer Advent Calendar
Johannes Hoerburger
info at hoerburger.org
Mon Oct 15 07:50:44 BST 2018
I'll try, if you have some more questions, feel free to ask!
------------------- cut here -------------------------
# -------------
# Main MyFancyApp.pm
# -------------
use utf8;
package MyFancyApp;
use Dancer2;
use Dancer2::Plugin::DBIC;
use Dancer2::Plugin::Auth::Tiny;
use Dancer2::Plugin::Deferred;
use YAML;
use Cache::Memcached;
our $VERSION = '0.1';
prefix undef;
# -------------
# Inside each controller that requires authentication
# (may be better in a Dancer::Plugin::Auth::Tiny::MySpecialAuthExtension?)
# -------------
Dancer2::Plugin::Auth::Tiny->extend(
role => sub {
my ($dsl, $Roles, $coderef) = @_;
# $Roles can be submitted like:
# get '' => needs role => ['Root', 'Admin', ] => sub {
# as well as
# get '' => needs role => 'Root' => sub {
#
# so if just a scalar is submitted,
# make $Roles an ARRAY ref and put the Scalar $Roles as first value in it
if ( ref $Roles eq '' ) {
$Roles = [ $Roles ];
}
return sub {
my $SessionData = $dsl->app->session->read('User');
# if one of the required roles is found in the users' roles,
# access is granted
if ( grep { $SessionData->{'Roles'}->{$_} } @{$Roles} ) {
goto $coderef;
}
# else redirect to auth-login
else {
$dsl->app->redirect('/auth/login');
}
};
}
);
# Paths start that way
get '' => needs role => ['Root', 'Admin', ] => sub {
}
# ---------------
# Authentication part
# ---------------
use utf8;
package MyFancyApp::Auth::Login;
use Dancer2 appname => 'MyFancyApp';
use Dancer2::Plugin::DBIC;
use Dancer2::Plugin::Auth::Tiny;
use Dancer2::Plugin::Deferred;
use Dancer2::Plugin::Passphrase;
prefix '/auth';
post '/login' => sub {
my %Param = params;
my $Login = $Param{login};
# If the login doesn't contain a dot and characters before and after
# Login failed => display username unknown in class alert-warning and redirect to auto login again
# this isn't required for regular usernames, in our case it reduces SQL load
if ( $Login !~ /(.+)\.(.+)/ ) {
deferred error => 'Username unknown.';
deferred class => 'alert-warning';
redirect '/auth/login';
};
my $Ident = $1;
my $User = $2;
my $Password = $Param{password};
my $PasswordHashed = passphrase(
$Password
)->generate;
# Database schema:
# Table company has many
# Table user has many
# Table user_role belongs to
# Table role
# (User -> user_roles <- Roles as many to many relation)
$RS = schema('default')->resultset('User')->search(
{
'company.ident' => $Ident,
'login' => $User,
'password' => $PasswordHashed,
},
{
join => 'company',
},
);
if ( ! $RS ) {
deferred error => 'Username or password incorect.';
deferred class => 'alert-warning';
redirect '/auth/login';
}
my $CompanyID = $RS->company->id;
my $UserID = $RS->id;
my %Roles;
# put all users' roles into his session data
for my $Role ( $RS->user_roles->all ) {
$Roles{$Role->role->name} = 1;
}
# write the session data to memcached
session->write(
'User' , {
User => $Login,
Ident => $Ident,
Login => $User,
Roles => \%Roles,
CompanyID => $CompanyID,
UserID => $UserID,
},
);
# reread sessiondata (not required, but helps in testing if the values are set correctly)
my $SessionData = session->read('User');
return redirect params->{return_url} || '/';
};
post '/logout' => sub {
my %Param = params;
session->delete('User');
deferred error => 'Logout successful.';
deferred class => 'alert-success';
return redirect '/auth/login';
};
# ---------------
# Config
# ---------------
# Inside config.yml
session: Memcached
engines:
session:
Memcached:
memcached_servers:
- 127.0.0.1:11211
- /var/sock/memcached
plugins:
Auth::Tiny:
login_route: /auth/login
------------------- cut here -------------------------
> Am 15.10.2018 um 04:42 schrieb John Stoffel <john at stoffel.org>:
>
>
> Johannes,
> Thanks for posting this, now I hate to be a jerk, but some comments
> inside it would be helpful. You know Dancer much better than I do,
> and what's obvious to you, isn't to those of us who don't use it all
> the time.
>
> For example, the 'if (ref $Roles eq '') { ... }' could use some
> explanation in the code if possible.
>
>
>
> Johannes> Somehing like that?
> Johannes> ------------------- cut here -------------------------
> Johannes> # -------------
> Johannes> # Main MyFancyApp.pm
> Johannes> # -------------
> Johannes> use utf8;
> Johannes> package MyFancyApp;
> Johannes> use Dancer2;
> Johannes> use Dancer2::Plugin::DBIC;
> Johannes> use Dancer2::Plugin::Auth::Tiny;
> Johannes> use Dancer2::Plugin::Deferred;
> Johannes> use YAML;
> Johannes> use Cache::Memcached;
>
> Johannes> our $VERSION = '0.1';
>
> Johannes> prefix undef;
>
> Johannes> # -------------
> Johannes> # Inside each controller that requires authentication
> Johannes> # (may be better in a Dancer::Plugin::Auth::Tiny::MySpecialAuthExtension?)
> Johannes> # -------------
> Johannes> Dancer2::Plugin::Auth::Tiny->extend(
> Johannes> role => sub {
> Johannes> my ($dsl, $Roles, $coderef) = @_;
> Johannes> if ( ref $Roles eq '' ) {
> Johannes> $Roles = [ $Roles ];
> Johannes> }
> Johannes> return sub {
> Johannes> my $SessionData = $dsl->app->session->read('User');
> Johannes> if ( grep { $SessionData->{'Roles'}->{$_} } @{$Roles} ) {
> Johannes> goto $coderef;
> Johannes> }
> Johannes> else {
> Johannes> $dsl->app->redirect('/auth/login');
> Johannes> }
> Johannes> };
> Johannes> }
> Johannes> );
>
> Johannes> # Paths start that way
> Johannes> get '' => needs role => ['Root', 'Admin', ] => sub {
> Johannes> }
> Johannes> # ---------------
> Johannes> # Authentication part
> Johannes> # ---------------
>
> Johannes> use utf8;
> Johannes> package MyFancyApp::Auth::Login;
> Johannes> use Dancer2 appname => 'MyFancyApp';
> Johannes> use Dancer2::Plugin::DBIC;
> Johannes> use Dancer2::Plugin::Auth::Tiny;
> Johannes> use Dancer2::Plugin::Deferred;
> Johannes> use Dancer2::Plugin::Passphrase;
>
> Johannes> prefix '/auth';
>
> Johannes> post '/login' => sub {
>
> Johannes> my %Param = params;
> Johannes> my $Login = $Param{login};
>
>
> Johannes> # If the login doesn't contain a dot and characters before and after
> Johannes> # Login failed => display username unknown in class alert-warning and redirect to auto login again
> Johannes> if ( $Login !~ /(.+)\.(.+)/ ) {
> Johannes> deferred error => 'Username unknown.';
> Johannes> deferred class => 'alert-warning';
> Johannes> redirect '/auth/login';
> Johannes> };
>
> Johannes> my $Ident = $1;
> Johannes> my $User = $2;
>
> Johannes> my $Password = $Param{password};
> Johannes> my $PasswordHashed = passphrase(
> Johannes> $Password
> Johannes> )->generate;
>
> Johannes> $RS = schema('default')->resultset('User')->search(
> Johannes> {
> Johannes> 'company.ident' => $Ident,
> Johannes> 'login' => $User,
> Johannes> 'password' => $PasswordHashed,
> Johannes> },
> Johannes> {
> Johannes> join => 'company',
> Johannes> },
> Johannes> );
>
> Johannes> if ( ! $RS ) {
> Johannes> deferred error => 'Username or password incorect.';
> Johannes> deferred class => 'alert-warning';
> Johannes> redirect '/auth/login';
> Johannes> }
>
> Johannes> my $CompanyID = $RS->company->id;
> Johannes> my $UserID = $RS->id;
> Johannes> my %Roles;
> Johannes> for my $Role ( $RS->user_roles->all ) {
> Johannes> $Roles{$Role->role->name} = 1;
> Johannes> }
>
> session-> write(
> Johannes> 'User' , {
> Johannes> User => $Login,
> Johannes> Ident => $Ident,
> Johannes> Login => $User,
> Johannes> Roles => \%Roles,
> Johannes> CompanyID => $CompanyID,
> Johannes> UserID => $UserID,
> Johannes> },
> Johannes> );
>
> Johannes> my $SessionData = session->read('User');
>
> Johannes> return redirect params->{return_url} || '/';
> Johannes> };
>
> Johannes> post '/logout' => sub {
>
> Johannes> my %Param = params;
> session-> delete('User');
>
> Johannes> deferred error => 'Logout successful.';
> Johannes> deferred class => 'alert-success';
>
> Johannes> return redirect '/auth/login';
> Johannes> };
> Johannes> # ---------------
> Johannes> # Config
> Johannes> # ---------------
> Johannes> # Inside config.yml
> Johannes> session: Memcached
> Johannes> engines:
> Johannes> session:
> Johannes> Memcached:
> Johannes> memcached_servers:
> Johannes> - 127.0.0.1:11211
> Johannes> - /var/sock/memcached
> Johannes> plugins:
> Johannes> Auth::Tiny:
> Johannes> login_route: /auth/login
> Johannes> ------------------- cut here -------------------------
>>> Am 11.10.2018 um 22:31 schrieb John Stoffel <john at stoffel.org>:
>>>
>>>
>>> What I'd love to see if an example of CRUD with Authentication, in a
>>> skeleton format so I can steal it for my own needs. I'm too
>>> dumb/busy/lazy to make it all work myself. *grin*
>>> _______________________________________________
>>> dancer-users mailing list
>>> dancer-users at dancer.pm
>>> http://lists.preshweb.co.uk/mailman/listinfo/dancer-users
>
> Johannes> _______________________________________________
> Johannes> dancer-users mailing list
> Johannes> dancer-users at dancer.pm
> Johannes> http://lists.preshweb.co.uk/mailman/listinfo/dancer-users
> _______________________________________________
> dancer-users mailing list
> dancer-users at dancer.pm
> http://lists.preshweb.co.uk/mailman/listinfo/dancer-users
More information about the dancer-users
mailing list