package WWW::Suffit::AuthDB::User; use strict; use utf8; =encoding utf8 =head1 NAME WWW::Suffit::AuthDB::User - WWW::Suffit::AuthDB user class =head1 SYNOPSIS use WWW::Suffit::AuthDB::User; =head1 DESCRIPTION This module provides AuthDB user methods =head1 ATTRIBUTES This class implements the following attributes =head2 address address => '127.0.0.1' The remote client IP address (IPv4 or IPv6) $user = $user->address("::1"); my $address = $user->address; Default: '127.0.0.1' =head2 algorithm $user = $user->algorithm( 'SHA256' ); my $algorithm = $user->algorithm; Sets or returns algorithm of hash function for password store. See L attribute Default: 'SHA256' =head2 attributes $user = $user->attributes( '{"foo": 123, "disabled": 0}' ); my $attributes = $user->attributes; Sets or returns additional attributes of the user in JSON format Default: none =head2 cached $user = $user->cached( 12345.123456789 ); my $cached = $user->cached; Sets or returns time of caching user data Default: 0 =head2 cachekey $user = $user->cachekey( 'abcdef1234567890' ); my $cachekey = $user->cachekey; Sets or returns the cache key string =head2 comment $user = $user->comment( 'Blah-Blah-Blah' ); my $comment = $user->comment; Sets or returns comment for selected user Default: undef =head2 created $user = $user->created( time() ); my $comment = $user->created; Sets or returns time of user create Default: 0 =head2 disabled $user = $user->disabled( 1 ); my $disabled = $user->disabled; Sets and returns boolean ban-status of the user Since C<1.01> this method is deprecated! See L =head2 email $user = $user->email('alice@example.com'); my $email = $user->email; Sets and returns email address of user =head2 error $user = $user->error( 'Oops' ); my $error = $user->error; Sets or returns error string =head2 expires $user = $user->expires( 300 ); my $expires = $user->expires; Sets or returns cache/object expiration time in seconds Default: 300 (5 min) =head2 flags $user = $user->flags( 123 ); my $flags = $user->flags; Sets or returns flags of user Default: 0 =head2 groups $user = $user->groups([qw/ administrator wheel /]); my $groups = $user->groups; # ['administrator', 'wheel'] Sets and returns groups of user (array of groups) =head2 id $user = $user->id( 2 ); my $id = $user->id; Sets or returns id of user Default: 0 =head2 is_authorized This attribute returns true if the user is authorized Default: false =head2 is_cached This attribute returns true if the user data was cached Default: false =head2 name $user = $user->name('Mark Miller'); my $name = $user->name; Sets and returns full name of user =head2 not_after $user = $user->not_after( time() ); my $not_after = $user->not_after; Sets or returns the time after which user data is considered invalid =head2 not_before $user = $user->not_before( time() ); my $not_before = $user->not_before; Sets or returns the time before which user data is considered invalid =head2 password $user = $user->password(sha256_hex('MyNewPassphrase')); my $password = $user->password; Sets and returns hex notation of user password digest (sha256, eg.). See L attribute =head2 private_key $user = $user->private_key('...'); my $private_key = $user->private_key; Sets and returns private key of user =head2 public_key $user = $user->public_key('...'); my $public_key = $user->public_key; Sets and returns public key of user =head2 role $user = $user->role('Regular user'); my $role = $user->role; Sets and returns role of user =head2 username $user = $user->username('new_username'); my $username = $user->username; Sets and returns username =head1 METHODS This class inherits all methods from L and implements the following new ones =head2 allow_ext say "yes" if $user->allow_ext; Returns true if user has access to external routes =head2 allow_int say "yes" if $user->allow_int; Returns true if user has access to internal routes =head2 forever say "yes" if $user->forever; Returns true if user can use endless API tokens =head2 is_admin say "yes" if $user->is_admin; If user is admin then returns true =head2 is_enabled say "yes" if $user->is_enabled; Returns status of user - enabled (true) or disabled (false) =head2 is_valid $user->is_valid or die "Incorrect user"; Returns boolean status of user's data =head2 mark Marks object as cached =head2 to_hash my $short = $user->to_hash(); my $full = $user->to_hash(1); Returns user data as hash in short or full view =head2 use_flags say "yes" if $user->use_flags; This method returns a binary indicator - whether flags should be used or not =head1 HISTORY See C file =head1 TO DO See C file =head1 SEE ALSO L, L =head1 AUTHOR Serż Minus (Sergey Lepenkov) L Eabalama@cpan.orgE =head1 COPYRIGHT Copyright (C) 1998-2025 D&D Corporation. All Rights Reserved =head1 LICENSE This program is free software; you can redistribute it and/or modify it under the same terms as Perl itself. See C file and L =cut use Mojo::Base -base; use Mojo::Util qw/md5_sum deprecated steady_time/; use constant { # User Flags (See main.js too!) # Set: VAL = VAL | UFLAG_* # Get: VAL & UFLAG_* DEFAULT_ADDRESS => '127.0.0.1', UFLAG_USING => 1, # 0 Use rules of flags UFLAG_ENABLED => 2, # 1 User is enabled UFLAG_IS_ADMIN => 4, # 2 User is admin UFLAG_ALLOW_INT => 8, # 3 User has access to internal routes UFLAG_ALLOW_EXT => 16, # 4 User has access to external routes UFLAG_FOREVER => 32, # 5 User can use endless tokens }; has address => DEFAULT_ADDRESS; has algorithm => 'SHA256'; has attributes => ''; has comment => ''; has created => 0; has disabled => sub { deprecated 'The "disabled" method is deprecated! Use "is_enabled"'; 0; }; has email => ''; has error => ''; has expires => 0; has flags => 0; has groups => sub { return [] }; has id => 0; has name => ''; has not_after => undef; has not_before => undef; has password => ''; has private_key => ''; has public_key => ''; has role => 'Regular user'; has username => undef; has is_cached => 0; # 0 or 1 has cached => 0; # steady_time() of cached has cachekey => ''; has is_authorized => 0; sub is_valid { my $self = shift; unless ($self->id) { $self->error("E1310: User not found"); return 0; } unless (defined($self->username) && length($self->username)) { $self->error("E1311: Incorrect username stored"); return 0; } unless (defined($self->password) && length($self->password)) { $self->error("E1312: Incorrect password stored"); return 0; } if ($self->expires && $self->expires < time) { $self->error("E1313: The user data is expired"); return 0; } return 1; } sub mark { my $self = shift; return $self->is_cached(1)->cached(shift || steady_time); } sub to_hash { my $self = shift; my $all = shift || 0; return ( uid => $self->id || 0, username => $self->username // '', name => $self->name // '', email => $self->email // '', email_md5=> $self->email ? md5_sum(lc($self->email)) : '', role => $self->role // '', groups => $self->groups || [], expires => $self->expires || 0, $all ? ( algorithm => $self->algorithm // '', attributes => $self->attributes // '', comment => $self->comment // '', created => $self->created || 0, flags => $self->flags || 0, not_after => $self->not_after || 0, not_before => $self->not_before || 0, public_key => $self->public_key // '', ) : (), ); } sub use_flags { my $self = shift; my $flags = ($self->flags || 0) * 1; return ($flags & UFLAG_USING) ? 1 : 0; } sub is_enabled { my $self = shift; my $flags = ($self->flags || 0) * 1; my $now = time; # Check dates first my $not_before = ($self->not_before || 0) * 1; my $not_after = ($self->not_after || 0) * 1; my $status = ( ($not_before ? (($not_before >= $now) ? 0 : 1) : 1) && ($not_after ? (($not_after <= $now) ? 0 : 1) : 1) ) ? 1 : 0; return 0 unless $status; # Disabled by dates # Check flags? return $status unless $self->use_flags; return ($flags & UFLAG_ENABLED) ? 1 : 0; } sub is_admin { my $self = shift; return 1 unless $self->use_flags; # Returns true by default if not using flags my $flags = ($self->flags || 0) * 1; return ($flags & UFLAG_IS_ADMIN) ? 1 : 0; } sub allow_int { my $self = shift; return 1 unless $self->use_flags; # Returns true by default if not using flags my $flags = ($self->flags || 0) * 1; return ($flags & UFLAG_ALLOW_INT) ? 1 : 0; } sub allow_ext { my $self = shift; return 1 unless $self->use_flags; # Returns true by default if not using flags my $flags = ($self->flags || 0) * 1; return ($flags & UFLAG_ALLOW_EXT) ? 1 : 0; } sub forever { my $self = shift; return 1 unless $self->use_flags; # Returns true by default if not using flags my $flags = ($self->flags || 0) * 1; return ($flags & UFLAG_FOREVER) ? 1 : 0; } 1; __END__