File Coverage

blib/lib/WWW/Suffit/Plugin/ConfigAuth.pm

Criterion	Covered	Total	%
statement	33	162	20.3
branch	0	64	0.0
condition	0	80	0.0
subroutine	11	19	57.8
pod	1	1	100.0
total	45	326	13.8

package WWW::Suffit::Plugin::ConfigAuth;
use strict;
use warnings;
use utf8;

=encoding utf8

=head1 NAME

WWW::Suffit::Plugin::ConfigAuth - The Suffit plugin for authentication and authorization providing via configuration

=head1 SYNOPSIS

    sub startup {
        my $self = shift->SUPER::startup();
        $self->plugin('ConfigAuth', {
            configsection => 'auth',
        });

        # . . .
    }

... configuration:

    # ConfigAuth configuration

        User            test:5f4dcc3b5aa765d61d8327deb882cf99:role=Regular%20user
        User            admin:5f4dcc3b5aa765d61d8327deb882cf99
        User            foo:bar:status=1&uid=2&name=user


=head1 DESCRIPTION

The Suffit plugin for authentication and authorization providing via configuration

=head1 OPTIONS

This plugin supports the following options

=head2 configsection

    configsection => 'auth'

This option sets a section name of the config file for define
namespace of configuration directives for this plugin

Default: none (without section)

=head1 HELPERS

This plugin provides the following helpers

=head2 configauth.init

    my $init = $self->configauth->init;

This method returns the init object (L)
that contains data of initialization:

    {
        error       => '...',       # Error message
        status      => 500,         # HTTP status code
        code        => 'E7000',     # The Suffit error code
    }

For example (in your controller):

    # Check init status
    my $init = $self->configauth->init;
    if (my $err = $init->get('/error')) {
        $self->reply->error($init->get('/status'),
            $init->get('/code'), $err);
        return;
    }

=head2 configauth.authenticate

    my $auth = $self->configauth->authenticate({
        username    => $username,
        password    => $password,
        loginpage   => 'login', # -- To login-page!!
        expiration  => $remember ? SESSION_EXPIRE_MAX : SESSION_EXPIRATION,
        realm       => "Test zone",
    });
    if (my $err = $auth->get('/error')) {
        if (my $location = $auth->get('/location')) { # Redirect
            $self->flash(message => $err);
            $self->redirect_to($location); # 'login' -- To login-page!!
        } elsif ($auth->get('/status') >= 500) { # Fatal server errors
            $self->reply->error($auth->get('/status'), $auth->get('/code'), $err);
        } else { # User errors (show on login page)
            $self->stash(error => $err);
            return $self->render;
        }
        return;
    }

This helper performs authentication backend subprocess and returns
result object (L) that contains data structure:

    {
        error       => '',          # Error message
        status      => 200,         # HTTP status code
        code        => 'E0000',     # The Suffit error code
        username    => $username,   # User name
        referer     => $referer,    # Referer
        loginpage   => $loginpage,  # Login page for redirects (location)
        location    => undef,       # Location URL for redirects
    }

=head2 configauth.authorize

    my $auth = $self->configauth->authorize({
        referer     => $referer,
        username    => $username,
        loginpage   => 'login', # -- To login-page!!
    });
    if (my $err = $auth->get('/error')) {
        if (my $location = $auth->get('/location')) {
            $self->flash(message => $err);
            $self->redirect_to($location); # 'login' -- To login-page!!
        } else {
            $self->reply->error($auth->get('/status'), $auth->get('/code'), $err);
        }
        return;
    }

This helper performs authorization backend subprocess and returns
result object (L) that contains data structure:

    {
        error       => '',          # Error message
        status      => 200,         # HTTP status code
        code        => 'E0000',     # The Suffit error code
        username    => $username,   # User name
        referer     => $referer,    # Referer
        loginpage   => $loginpage,  # Login page for redirects (location)
        location    => undef,       # Location URL for redirects
        user    => {        # User data
            address     => "127.0.0.1", # User (client) IP address
            base        => "http://localhost:8080", # Base URL of request
            comment     => "No comments", # Comment
            email       => '[e-mail]', # Email address
            email_md5   => "a84450...366", # MD5 hash of email address
            method      => "ANY", # Current method of request
            name        => "Bob Smith", # Full user name
            path        => "/", # Current query-path of request
            role        => "Regular user", # User role
            status      => true, # User status in JSON::PP::Boolean notation
            uid         => 1, # User ID
            username    => $username, # User name
        },
    }

=head1 METHODS

Internal methods

=head2 register

This method register the plugin and helpers in L application

=head1 SEE ALSO

L, L

=head1 AUTHOR

Serż Minus (Sergey Lepenkov) L [e-mail]

=head1 COPYRIGHT

Copyright (C) 1998-2026 D&D Corporation

=head1 LICENSE

This program is distributed under the terms of the Artistic License Version 2.0

See the C file or L for details

=cut

use Mojo::Base 'Mojolicious::Plugin';

our $VERSION = '1.01';

use Digest::SHA qw/sha224_hex sha256_hex sha384_hex sha512_hex/;
use Mojo::File qw/path/;
use Mojo::Util qw/encode md5_sum sha1_sum hmac_sha1_sum secure_compare/;
use Mojo::JSON::Pointer;
use Mojo::Parameters;
use WWW::Suffit::Const qw/ :session /;
use WWW::Suffit::Util qw/json_load json_save/;

sub register {
    my ($plugin, $app, $opts) = @_; # $self = $plugin
    $opts //= {};
    my $configsection = $opts->{configsection};
    my %payload = ( # Ok by default
        error       => '',          # Error message
        status      => 200,         # HTTP status code
        code        => 'E0000',     # The Suffit error code
    );

    # List of users from config
    $app->helper('configauth.users' => sub {
        my $c = shift;
        state $users = $configsection
            ? $c->conf->list("/$configsection/user")
            : $c->conf->list("/user");
    });

    # Auth helpers (methods)
    $app->helper('configauth.authenticate'=> \&_authenticate);
    $app->helper('configauth.authorize'   => \&_authorize);

    # Check users
    my $users = $app->configauth->users;
    unless (scalar @$users) {
        my $err = $configsection
            ? sprintf("No any users found in %s section of configuration", $configsection)
            : "No any users found in configuration";
        $app->log->error(sprintf("[E7010] %s", $err));
        $payload{error}     = $err;
        $payload{status}    = 500;
        $payload{code}      = 'E7010';
        return $app->helper('configauth.init' => sub { Mojo::JSON::Pointer->new({%payload}) });
    }
    #$app->log->error(Mojo::Util::dumper($users));

    # Ok
    return $app->helper('configauth.init' => sub { Mojo::JSON::Pointer->new({%payload}) });
}
sub _authenticate {
    my $self = shift;
    my %args = scalar(@_) ? scalar(@_) % 2 ? ref($_[0]) eq 'HASH' ? (%{$_[0]}) : () : (@_) : ();
    my $cache = $self->app->cache;
    my $now = time();
    my $username = $args{username} || '';
    my $password = $args{password} // '';
       $password = encode('UTF-8', $password) if length $password; # chars to bytes
    my $referer = $args{referer} // $self->req->headers->header("Referer") // '';
    my $loginpage = $args{loginpage} // '';
    my $expiration = $args{expiration} || 0;
    my %payload = ( # Ok by default
        error       => '',          # Error message
        status      => 200,         # HTTP status code
        code        => 'E0000',     # The Suffit error code
        username    => $username,   # User name
        referer     => $referer,    # Referer
        loginpage   => $loginpage,  # Login page for redirects (location)
        location    => undef,       # Location URL for redirects
    );
    my $json_file = path($self->app->datadir, sprintf("u.%s.json", $username));
    my $file = $json_file->to_string;

    # Check username
    unless (length $username) {
        $self->log->error("[E7001] Incorrect username");
        $payload{error}     = "Incorrect username";
        $payload{status}    = 400;
        $payload{code}      = 'E7001';
        return Mojo::JSON::Pointer->new({%payload});
    }

    # Get user key and file
    my $ustat_key = sprintf("auth.ustat.%s", hmac_sha1_sum(sprintf("%s:%s", encode('UTF-8', $username), $password), $self->app->mysecret));
    my $ustat_tm = $cache->get($ustat_key) || 0;
    if ($expiration && (-e $file) && ($ustat_tm + $expiration) > $now) { # Ok!
        $self->log->debug(sprintf("$$: User data is still valid. Expired at %s", scalar(localtime($ustat_tm + $expiration))));
        return Mojo::JSON::Pointer->new({%payload});
    }

    # Get password database from cache
    my $pwdb = $cache->get('auth.pwdb');
    unless ($pwdb) {
        my $users = $self->configauth->users || [];
        $pwdb = { (_parse_pwdb_lines(@$users)) };
        $cache->set('auth.pwdb' => $pwdb); # store whole password database to cache
        #$self->log->error(Mojo::Util::dumper( $pwdb ));
    }

    # Authentication: Check by password database
    my $pw = encode('UTF-8', $pwdb->{$username}->{pwd} // '');
    my $ar = Mojo::Parameters->new($pwdb->{$username}->{arg} // '')->charset('UTF-8');
    unless (_check_pw($password, $pw)) { # Oops. Incorrect username/password
        $self->log->error(sprintf("[%s] %s: %s", 401, 'E7005', 'Incorrect username/password'));
        $payload{error}     = 'Incorrect username/password';
        $payload{status}    = 401;
        $payload{code}      = 'E7005';
        return Mojo::JSON::Pointer->new({%payload});
    }
    #$self->log->error(Mojo::Util::dumper( $ar ));

    # User data with required fields!
    my $data = $ar->to_hash || {};
    $data->{address}    = $self->remote_ip($self->app->trustedproxies);
    $data->{base}       = $args{base_url} || $self->base_url;
    $data->{method}     = $args{method} || $self->req->method || "ANY";
    $data->{path}       = $self->req->url->path->to_string || "/";
    $data->{referer}    = $referer;
    # required fields:
    $data->{status}     = $data->{status} ? \1 : \0;
    $data->{uid}        ||= 0;
    $data->{username}   //= $username;
    $data->{name}       //= $username;
    $data->{role}       //= '';
    $data->{email}      //= '';
    $data->{email_md5}  //= $data->{email} ? md5_sum($data->{email}) : '',
    $data->{comment}    //= '';

    # Save json file with user data
    json_save($file, $data);
    unless (-e $file) {
        $self->log->error(sprintf("[E7007] Can't save file %s", $file));
        $payload{error}     = sprintf("Can't save file DATADIR/u.%s.json", $username);
        $payload{status}    = 500;
        $payload{code}      = 'E7007';
        return Mojo::JSON::Pointer->new({%payload});
    }

    # Fixed to cache
    $cache->set($ustat_key, $now);

    # Ok
    return Mojo::JSON::Pointer->new({%payload});
}
sub _authorize {
    my $self = shift;
    my %args = scalar(@_) ? scalar(@_) % 2 ? ref($_[0]) eq 'HASH' ? (%{$_[0]}) : () : (@_) : ();
    my $username = $args{username} || '';
    my $referer = $args{referer} // $self->req->headers->header("Referer") // '';
    my $loginpage = $args{loginpage} // '';
    my %payload = ( # Ok by default
        error       => '',          # Error message
        status      => 200,         # HTTP status code
        code        => 'E0000',     # The Suffit error code
        username    => $username,   # User name
        referer     => $referer,    # Referer
        loginpage   => $loginpage,  # Login page for redirects (location)
        location    => undef,       # Location URL for redirects
        user        => {            # User data with required fields (defaults)
            status      => \0,          # User status
            uid         => 0,           # User ID
            username    => $username,   # User name
            name        => $username,   # Full name
            role        => "",          # User role
            email       => "",          # Email address
            email_md5   => "",          # MD5 of email address
            comment     => "",          # Comment
        },
    );

    # Check username
    unless (length $username) {
        $self->log->error("[E7009] Incorrect username");
        $payload{error}     = "Incorrect username";
        $payload{status}    = 400;
        $payload{code}      = 'E7009';
        return Mojo::JSON::Pointer->new({%payload});
    }

    # Get user file name
    my $file = path($self->app->datadir, sprintf("u.%s.json", $username))->to_string;

    # Load user file with user data
    my $user = -e $file ? json_load($file) : {};

    # Check user data
    unless ($user->{username}) {
        $self->log->error(sprintf("[E7008] File %s not found or incorrect", $file));
        $payload{error}     = sprintf("File DATADIR/u.%s.json not found or incorrect", $username);
        $payload{status}    = 500;
        $payload{code}      = 'E7008';
        return Mojo::JSON::Pointer->new({%payload});
    }

    # Ok
    $payload{user} = {%{$user}}; # Set user data to pyload hash
    return Mojo::JSON::Pointer->new({%payload});
}

sub _parse_pwdb_lines {
    my @lines = @_;
    my %r = ();
    for (@lines) {
        next unless $_;
        my @line = split ':', $_;
        my ($usr, $pwd, $arg) = ($line[0] // '', $line[1] // '', $line[2] // '');
        next unless length($usr) && length($pwd);
        if (@line == 3) { # username:password:params
            $r{$usr} = {
                pwd => $pwd,
                arg => $arg,
            };
        } elsif (@line == 2) { # username:password
            $r{$usr} = {
                pwd => $pwd
            };
        }
    }
    return %r;
}
sub _check_pw {
    my $pwd = shift // '';
    my $sum = shift // '';
    return 0 unless length($pwd) && length($sum);
    if ($sum =~ /^[0-9a-f]+$/i) {
        if (length($sum) == 32) { # md5: acbd18db4cc2f85cedef654fccc4a4d8
            return secure_compare(md5_sum($pwd), lc($sum));
        } elsif(length($sum) == 40) { # sha1: 0beec7b5ea3f0fdbc95d0dd47f3c5bc275da8a33
            return secure_compare(sha1_sum($pwd), lc($sum));
        } elsif(length($sum) == 56) { # sha224: d63dc919e201d7bc4c825630d2cf25fdc93d4b2f0d46706d29038d01
            return secure_compare(sha224_hex($pwd), lc($sum));
        } elsif(length($sum) == 64) { # sha224: 5e884898da28047151d0e56f8dc6292773603d0d6aabbdd62a11ef721d1542d8
            return secure_compare(sha256_hex($pwd), lc($sum));
        } elsif(length($sum) == 96) { # sha384: a8b64babd0aca91a59bdbb7761b421d4f2bb38280d3a75ba0f21f2bebc45583d446c598660c94ce680c47d19c30783a7
            return secure_compare(sha384_hex($pwd), lc($sum));
        } elsif(length($sum) == 128) { # sha512: b109f3bbbc244eb82441917ed06d618b9008dd09b3befd1b5e07394c706a8bb980b1d7785e5976ec049b46df5f1326af5a2ea6d103fd07c95385ffab0cacbc86
            return secure_compare(sha512_hex($pwd), lc($sum));
        } else { # Plain text (unsafe)
            return secure_compare($pwd, $sum);
        }
    } else { # Plain text (unsafe)
        return secure_compare($pwd, $sum);
    }
    return 0;
}

1;

__END__