use strict;
use warnings;
use Mojolicious::Lite;
plugin 'ClientIP';
plugin 'basic_auth_plus';
# sample data for authentication
my %accepted_IPs = ( '8.8.8.8' => 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?
# get text_a. Steps 2) and 3) of the above description
get '/get_first' => sub {
my $self = shift;
my $remote_IP = $self->client_ip;
# check username and password
my ($href, $auth_ok) = $self->basic_auth(
realm => sub {
# @_ contains username and password
if ( exists $users{$_[0]} and $users{$_[0]} eq $_[1]){
# log the correct login
$self->log->info( "$_[0] from $remote_IP login OK" );
return 1;
}
}
);
# reject unwanted remote IP
unless ( exists $accepted_IPs{ $remote_IP } ){
# log unwanted IP
$self->log->warn( "$href->{username} logged from unwanted IP: $remote_IP" );
# reject the request
return $self->render(
status => 401,
text => 'unauthorized',
)
}
# process the request..
if ( $auth_ok ) {
# set the session cookie valid for 2 minutes
$self->session( expiration => 120, is_my_user_authenticated => 1 );
# log the action
$self->log->info( "sent TEXT_A to $remote_IP" );
# render TEXT_A
return $self->render(
status => 200,
text => $text_a,
);
}
# .. or reject it
else {
# log a failed attempt
$self->log->warn( "bad login attempt from valid IP $remote_IP using user $href->{username}" );
# reject
return $self->render(
status => 401,
text => 'unauthorized',
);
}
};
# get text_b. Steps 6) and 7) of the above description
get '/get_second' => sub {
my $self = shift;
my $remote_IP = $self->client_ip;
# check the previously set cookie session
if ( $self->session( 'is_my_user_authenticated') == 1 ) {
# expire the session cookie
$self->session( expires => 1, is_my_user_authenticated => 0 );
# log the action
$self->log->info( "sent TEXT_B to $remote_IP" );
# render TEXT_B
return $self->render(
status => 200,
text => $text_b,
);
}
else {
# log the action
$self->log->warn( "unexpected request of TEXT_B from $remote_IP: rejected ".
"authenticated: $self->session( 'is_my_user_authenticated') ".
"expiration: $self->session( 'expiration')");
# reject
return $self->render(
status => 401,
text => 'unauthorized',
);
}
};
app->start;
####
use strict;
use warnings;
use LWP::UserAgent;
use HTTP::Request::Common;
my $ua = LWP::UserAgent->new();
$ua->cookie_jar( {} );
print "FIRST REQUEST\n\n";
my $request = GET 'http://10.0.0.1/get_first';
$request->authorization_basic('usr1', 'pwd1');
my $response = $ua->request($request);
print $response->as_string();
sleep 3;
print "SECOND REQUEST\n\n";
my $request2 = GET 'http://10.0.0.1/get_second';
my $response2 = $ua->request($request2);
print $response2->as_string();
sleep 3;
print "\nATTENTION: next should fail..\n\n";
my $request3 = GET 'http://10.0.0.1/get_second';
my $response3 = $ua->request($request3);
print $response3->as_string();
####
FIRST REQUEST
HTTP/1.0 200 OK
Date: Mon, 15 Jun 2020 11:26:18 GMT
Date: Mon, 15 Jun 2020 11:26:18 GMT
Server: HTTP::Server::PSGI
Content-Length: 38
Content-Type: text/html;charset=UTF-8
Client-Date: Mon, 15 Jun 2020 11:26:20 GMT
Client-Peer: 10.0.0.1:80
Client-Response-Num: 1
Set-Cookie: mojolicious=eyJleHBpcmF0aW9uIjoxMjAsImV4cGlyZXMiOjE1OTIyMjA0OTgsImlzX215X3VzZXJfYXV0aGVudGljYXRlZCI6MX0---d9029065f9456259d6cfdb50c3adee1d4a2f3b65; expires=Mon, 15 Jun 2020 11:28:18 GMT; path=/; HttpOnly; SameSite=Lax
N├® pi├╣ mai toccher├▓ le sacre sponde
SECOND REQUEST
HTTP/1.0 200 OK
Date: Mon, 15 Jun 2020 11:26:21 GMT
Date: Mon, 15 Jun 2020 11:26:21 GMT
Server: HTTP::Server::PSGI
Content-Length: 38
Content-Type: text/html;charset=UTF-8
Client-Date: Mon, 15 Jun 2020 11:26:24 GMT
Client-Peer: 10.0.0.1:80
Client-Response-Num: 1
Set-Cookie: mojolicious=eyJleHBpcmF0aW9uIjoxMjAsImV4cGlyZXMiOjEsImlzX215X3VzZXJfYXV0aGVudGljYXRlZCI6MH0---2f2a402a06de6b37f1eac53b7cbb79d5e08f04e7; expires=Thu, 01 Jan 1970 00:00:01 GMT; path=/; HttpOnly; SameSite=Lax
ove il mio corpo fanciulletto giacque,
ATTENTION: next should fail..
HTTP/1.0 401 Unauthorized
Date: Mon, 15 Jun 2020 11:26:24 GMT
Date: Mon, 15 Jun 2020 11:26:24 GMT
Server: HTTP::Server::PSGI
Content-Length: 12
Content-Type: text/html;charset=UTF-8
Client-Date: Mon, 15 Jun 2020 11:26:27 GMT
Client-Peer: 10.0.0.1:80
Client-Response-Num: 1
Client-Warning: Missing Authenticate header
unauthorized
####
HTTP::Server::PSGI: Accepting connections at http://0:80/
[2020-06-15 13:26:18.41707] [29291] [debug] [MfmL-Zeg] GET "/get_first"
[2020-06-15 13:26:18.41765] [29291] [debug] [MfmL-Zeg] Routing to a callback
[2020-06-15 13:26:18.41810] [29291] [info] [MfmL-Zeg] usr1 from 8.8.8.8 login OK
[2020-06-15 13:26:18.41820] [29291] [debug] Your secret passphrase needs to be changed
[2020-06-15 13:26:18.41832] [29291] [info] [MfmL-Zeg] sent TEXT_A to 8.8.8.8
[2020-06-15 13:26:18.41865] [29291] [debug] [MfmL-Zeg] 200 OK (0.001575s, 634.921/s)
8.8.8.8 - - [15/Jun/2020:13:26:18 +0200] "GET /get_first HTTP/1.1" 200 - "-" "libwww-perl/6.26"
[2020-06-15 13:26:21.60148] [29291] [debug] [cC2TWI3Q] GET "/get_second"
[2020-06-15 13:26:21.60208] [29291] [debug] [cC2TWI3Q] Routing to a callback
[2020-06-15 13:26:21.60249] [29291] [info] [cC2TWI3Q] sent TEXT_B to 8.8.8.8
[2020-06-15 13:26:21.60272] [29291] [debug] [cC2TWI3Q] 200 OK (0.001234s, 810.373/s)
8.8.8.8 - - [15/Jun/2020:13:26:21 +0200] "GET /get_second HTTP/1.1" 200 - "-" "libwww-perl/6.26"
[2020-06-15 13:26:24.68206] [29291] [debug] [jscLU00Y] GET "/get_second"
[2020-06-15 13:26:24.68244] [29291] [debug] [jscLU00Y] Routing to a callback
Use of uninitialized value in numeric eq (==) at /root/srv01/srv01.pl line 74, line 755.
[2020-06-15 13:26:24.68275] [29291] [warn] [jscLU00Y] unexpected request of TEXT_B from 8.8.8.8: rejected authenticated: Mojolicious::Controller=HASH(0x316b0a0)->session( 'is_my_user_authenticated') expiration: Mojolicious::Controller=HASH(0x316b0a0)->session( 'expiration')
[2020-06-15 13:26:24.68341] [29291] [debug] [jscLU00Y] 401 Unauthorized (0.001321s, 757.002/s)
8.8.8.8 - - [15/Jun/2020:13:26:24 +0200] "GET /get_second HTTP/1.1" 401 - "-" "libwww-perl/6.26"