[dancer-users] 2018 Dancer Advent Calendar

[John Stoffel]

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