summaryrefslogtreecommitdiff
path: root/lib/VNDB/Auth.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/VNDB/Auth.pm')
-rw-r--r--lib/VNDB/Auth.pm181
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;