in reply to first steps with Mojolicious::Lite

#!/usr/bin/env perl
#server.pl
use strict;
use warnings;

use Mojolicious::Lite;

plugin 'ClientIP';
plugin 'basic_auth_plus';

# sample data for authentication
my %accepted_IPs = ( '10.0.0.3' => 1 );
my %users        = ( usr1      => 'pwd1', usr2 => 'pwd2' );

# sample data to send back to client
my $text_a = 'Né più mai toccherò le sacre sponde';
my $text_b = 'ove il mio corpo fanciulletto giacque,';

# I expect all non specified routes to answer 404, right?

sub checkUserPW {
    my $self = shift;
    my ($href, $auth_ok) = $self->basic_auth(
        realm => sub { 
            if ( exists $users{$_[0]} and  $users{$_[0]} eq $_[1]){
                return 1;
            }
            return 0;
    });
}

sub checkIP {
    my $c = shift;
    my $remote_IP = $c->client_ip;
    if (exists $accepted_IPs{$remote_IP}) {
        return 1;
    }
    return 0;
}

sub checkCreds {
    my $c = shift;
    return 1 if ( checkIP($c) && checkUserPW($c) );
    return 0;
}

under sub {
    my $c = shift;
    return 1 if checkCreds($c);
    $c->render(status => 401, text => 'not ok');
    return undef;
};

get 'get_first' => sub {
    my $c = shift;
    return $c->render(text => $text_a);
};

get 'get_second' => sub {
    my $c = shift;
    return $c->render(text => $text_b);
};

app->start;

[download]
./client.pl
FIRST REQUEST

[2020-06-16 22:30:43.75375] [7657] [debug] [siQnjFJG] GET "/get_first"
[2020-06-16 22:30:43.75403] [7657] [debug] [siQnjFJG] Routing to a cal
+lback
[2020-06-16 22:30:43.75436] [7657] [debug] [siQnjFJG] Routing to a cal
+lback
[2020-06-16 22:30:43.75466] [7657] [debug] [siQnjFJG] 200 OK (0.000877
+s, 1140.251/s)
HTTP/1.1 200 OK
Date: Wed, 17 Jun 2020 03:30:43 GMT
Server: Mojolicious (Perl)
Content-Length: 38
Content-Type: text/html;charset=UTF-8
Client-Date: Wed, 17 Jun 2020 03:30:43 GMT
Client-Peer: 10.0.0.3:3000
Client-Response-Num: 1

Né più mai toccherò le sacre sponde
SECOND REQUEST

[2020-06-16 22:30:46.76167] [7657] [debug] [rq4czVSf] GET "/get_second
+"
[2020-06-16 22:30:46.76195] [7657] [debug] [rq4czVSf] Routing to a cal
+lback
[2020-06-16 22:30:46.76231] [7657] [debug] [rq4czVSf] 401 Unauthorized
+ (0.000614s, 1628.664/s)
HTTP/1.1 401 Unauthorized
Date: Wed, 17 Jun 2020 03:30:46 GMT
Server: Mojolicious (Perl)
WWW-Authenticate: Basic realm="realm"
Content-Length: 6
Content-Type: text/html;charset=UTF-8
Client-Date: Wed, 17 Jun 2020 03:30:46 GMT
Client-Peer: 10.0.0.3:3000
Client-Response-Num: 1

not ok

ATTENTION: next should fail..

[2020-06-16 22:30:49.77717] [7657] [debug] [DknpCqhV] GET "/get_second
+"
[2020-06-16 22:30:49.77744] [7657] [debug] [DknpCqhV] Routing to a cal
+lback
[2020-06-16 22:30:49.77780] [7657] [debug] [DknpCqhV] 401 Unauthorized
+ (0.000613s, 1631.321/s)
HTTP/1.1 401 Unauthorized
Date: Wed, 17 Jun 2020 03:30:49 GMT
Server: Mojolicious (Perl)
WWW-Authenticate: Basic realm="realm"
Content-Length: 6
Content-Type: text/html;charset=UTF-8
Client-Date: Wed, 17 Jun 2020 03:30:49 GMT
Client-Peer: 10.0.0.3:3000
Client-Response-Num: 1

not ok

[download]

I tested with  morbo server.pl. A small prod deployment server.pl daemon -m production -l http://ip:port. The string MfmL-Zeg is per HTTP request I believe. So you can track through a complicated HTTP session that spawns a bunch of requests.

Replies are listed 'Best First'.
Re^2: first steps with Mojolicious::Lite -- under again
by Discipulus (Canon) on Jun 17, 2020 at 07:07 UTC
    Hello trippledubs and many thanks for your full, tested example,

    it is not exactly the cleaner replication of mine: infact i suspect that you used the client I proposed in the original post, and if so, the client does not send username and password in the second request because it received back a valid cookie. You never get ove il mio corpo fanciulletto giacque, printed. My get_second only checks this cookie, not credentials. The third request made by the client was there only to check the cookie corectly expired, so it has to fail. But these are details and your code is clean and a good example to show.

    About under : it shows to be a powerful tecnique but, if I'm permitted, even too much. I mean: the code will result shorter and cleaner and very DRY, but imagine what happens if you have two or three screenful of routes: then after one month you get back at the code to review route_105 which is affected by under one but you dont see it.. Is the typical situation I will hate, like a no warnings put in the middle of a long code, with global effect..

    So I'd probably go for something like (DRY code at the cost of WET comments.. ;) 

    
# see UNDER above
get 'get_first' => sub {
    my $c = shift;
    return $c->render(text => $text_a);
};

# see UNDER above
get 'get_second' => sub {
    my $c = shift;
    return $c->render(text => $text_b);
};

    [download]

    Or put them in a group like shown in the tutorial:

    
# Admin section
group {

  # Local logic shared only by routes in this group
  under '/admin' => sub {
    my $c = shift;
    return 1 if $c->req->headers->header('X-Awesome');
    $c->render(text => "You're not awesome enough.");
    return undef;
  };

  # GET /admin/dashboard
  get '/dashboard' => {text => 'Nothing to see here yet.'};
};

    [download]

    But the last example raise another question in my mind: why the comment # GET /admin/dashboard ?? Is not /dashboard the route defined? Or... under means: all routes logically under the specified one ( like in under '/admin' ) and, if not specified logically under the root like under '/'?

    If the above assumption is correct I'd really like to know where it is explained.

    L*

    There are no rules, there are no thumbs..
    Reinvent the wheel, then learn The Wheel; may be one day you reinvent one of THE WHEELS.
[reply]
[d/l]
[select]
      why the comment # GET /admin/dashboard ??
      Under is a superset of nested routing. Nested routes create prefixes (with / prefix implicit), but under also runs code after matching the prefix but before dispatching the request further down the chain.
[reply]
[d/l]
[select]

In Section Seekers of Perl Wisdom