diff options
Diffstat (limited to 'lib/VNDB/Auth.pm')
-rw-r--r-- | lib/VNDB/Auth.pm | 181 |
1 files changed, 181 insertions, 0 deletions
diff --git a/lib/VNDB/Auth.pm b/lib/VNDB/Auth.pm new file mode 100644 index 00000000..ca0e785e --- /dev/null +++ b/lib/VNDB/Auth.pm @@ -0,0 +1,181 @@ +# This package provides a 'tuwf->auth' method and a useful object for dealing +# with VNDB sessions. Usage: +# +# use VNDB::Auth; +# +# if(auth) { +# ..user is logged in +# } +# ..or: +# if(tuwf->auth) { .. } +# +# my $success = auth->login($user, $pass); +# auth->logout; +# +# my $uid = auth->uid; +# my $username = auth->username; +# ..etc +# +# die "You're not allowed to post!" if !tuwf->auth->permBoard; +# +package VNDB::Auth; + +use strict; +use warnings; +use Moo; +use TUWF; +use SQL::Yapp dbh => sub { tuwf->dbh }; +use Exporter 'import'; + +use Digest::SHA qw|sha1 sha1_hex|; +use Crypt::URandom 'urandom'; +use Crypt::ScryptKDF 'scrypt_raw'; +use Encode 'encode_utf8'; + +our @EXPORT = ('auth'); +sub auth { tuwf->{auth} } + + +TUWF::hook before => sub { + my $cookie = tuwf->reqCookie('auth')||''; + my($uid, $token_e) = $cookie =~ /^([a-fA-F0-9]{40})\.?(\d+)$/ ? ($2, sha1_hex pack 'H*', $1) : (0, ''); + + tuwf->{auth} = __PACKAGE__->new(%{ tuwf->conf->{auth} || {} }); + tuwf->{auth}->_load_session($uid, $token_e); + 1; +}; + + +TUWF::hook after => sub { tuwf->{auth} = __PACKAGE__->new }; + + +# log user IDs (necessary for determining performance issues, user preferences +# have a lot of influence in this) +TUWF::set log_format => sub { + my($self, $uri, $msg) = @_; + sprintf "[%s] %s %s: %s\n", scalar localtime(), $uri, $self->auth ? $self->auth->uid : '-', $msg; +}; + + + +use overload bool => sub { defined shift->uid }; + +has uid => (is => 'ro'); +has token => (is => 'ro'); +has username => (is => 'ro'); +has perm => (is => 'ro', default => 0); + + + +# The 'perm' field is a bit field, with the following bits. +# The 'usermod' flag is hardcoded in sql/func.sql for the user_* functions. +# Flag 8 was used for 'staffedit', but is now free for re-use. +my %perms = qw{ + 1 board + 2 boardmod + 4 edit + 16 tag + 32 dbmod + 64 tagmod + 128 usermod + 256 affiliate +}; + + +# Create a read-only accessor to check if the current user is authorized to +# perform a particular action. +for my $perm (keys %perms) { + has 'perm'.ucfirst($perm), + is => 'ro', + lazy => 1, + builder => sub { (shift->perm() & $perms{$perm}) > 0 }; +} + + +sub _randomascii { + return join '', map chr($_%92+33), unpack 'C*', urandom shift; +} + + +# Prepares a plaintext password for database storage +# Arguments: pass, optionally: salt, N, r, p +# Returns: encrypted password (as a binary string) +sub _preparepass { + my($self, $pass, $salt, $N, $r, $p) = @_; + ($N, $r, $p) = @{$self->{scrypt_args}} if !$N; + $salt ||= urandom(8); + return pack 'NCCa8a*', $N, $r, $p, $salt, scrypt_raw($pass, $self->{scrypt_salt} . $salt, $N, $r, $p, 32); +} + + +# Arguments: self, uid, encpass +# Returns: 0 on error, 1 on success +sub _create_session { + my($self, $uid, $encpass) = @_; + + my $token = urandom 20; + my $token_db = sha1_hex $token; + return 0 if !sqlFetch{SELECT USER_LOGIN($uid, DECODE({unpack 'H*', $encpass}, 'hex'), DECODE($token_db, 'hex'))}; + + tuwf->resCookie(auth => unpack('H*', $token).'.'.$uid, httponly => 1, expires => time + 31536000); + $self->_load_session($uid, $token_db); + return 1; +} + + +sub _load_session { + my($self, $uid, $token_db) = @_; + + my $user = {}; + if($uid) { + my $loggedin = sqlExpr{USER_ISLOGGEDIN(id, DECODE($token_db, 'hex'))}; + $user = sqlFetch{ + SELECT id, username, perm, EXTRACT('epoch' FROM $loggedin) AS lastused + FROM users + WHERE (id = $uid) + AND ($loggedin IS NOT NULL) + LIMIT 1 + }; + + # update the sessions.lastused column if lastused < now()-'6 hours' + sqlDo{SELECT USER_UPDATE_LASTUSED($user->{id}, DECODE($token_db, 'hex'))} + if $user->{id} && $user->{lastused} < time()-6*3600; + } + + # Drop the cookie if it's not valid + tuwf->resCookie(auth => undef) if !$user->{id} && tuwf->reqCookie('auth'); + + $self->{uid} = $user->{id}; + $self->{username} = $user->{username}; + $self->{perm} = $user->{perm}||0; + $self->{token} = $token_db; +} + + +# Returns 1 on success, 0 on failure +sub login { + my($self, $user, $pass) = @_; + return 0 if $self->uid || !$user || !$pass; + + my $u = sqlFetch{SELECT id, USER_GETSCRYPTARGS(id) AS args FROM users WHERE username = $user}; + return 0 if !$u->{id} || !$u->{args} || length($u->{args}) != 14; + + my($N, $r, $p, $salt) = unpack 'NCCa8', $u->{args}; + my $encpass = $self->_preparepass($pass, $salt, $N, $r, $p); + $self->_create_session($u->{id}, $encpass); +} + + +sub logout { + my $self = shift; + return if !$self->uid; + sqlDo{SELECT USER_LOGOUT($self->uid, DECODE($self->token, 'hex'))}; + $self->_load_session(); +} + + +# TODO: Password reset API +# TODO: Preferences API +# TODO: XSRF token handling + +1; |