summaryrefslogtreecommitdiff
path: root/lib/VNWeb/Auth.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/VNWeb/Auth.pm')
-rw-r--r--lib/VNWeb/Auth.pm208
1 files changed, 154 insertions, 54 deletions
diff --git a/lib/VNWeb/Auth.pm b/lib/VNWeb/Auth.pm
index 907fb2f4..442d46f4 100644
--- a/lib/VNWeb/Auth.pm
+++ b/lib/VNWeb/Auth.pm
@@ -7,7 +7,7 @@
# ..user is logged in
# }
#
-# my $success = auth->login($user, $pass);
+# my $success = auth->login($uid, $pass);
# auth->logout;
#
# my $uid = auth->uid;
@@ -23,13 +23,14 @@ use warnings;
use TUWF;
use Exporter 'import';
+use Carp 'croak';
use Digest::SHA qw|sha1 sha1_hex|;
use Crypt::URandom 'urandom';
use Crypt::ScryptKDF 'scrypt_raw';
-use Encode 'encode_utf8';
use MIME::Base64 'encode_base64url';
+use POSIX 'strftime';
-use VNDBUtil 'norm_ip';
+use VNDB::Func 'norm_ip';
use VNDB::Config;
use VNWeb::DB;
@@ -37,14 +38,24 @@ our @EXPORT = ('auth');
sub auth {
tuwf->req->{auth} ||= do {
- my $cookie = tuwf->reqCookie('auth')||'';
- my($uid, $token_e) = $cookie =~ /^([a-fA-F0-9]{40})\.?(\d+)$/ ? ($2, sha1_hex pack 'H*', $1) : (0, '');
-
my $auth = __PACKAGE__->new();
- $auth->_load_session($uid, $token_e);
+ if(config->{read_only}) {
+ # Account functionality disabled in read-only mode.
+
+ # API requests have two authentication methods:
+ # - If the origin equals the site, use the same Cookie auth as the rest of the site (handy for userscripts)
+ # - Otherwise, a custom token-based auth, but this hasn't been implemented yet
+ } elsif(VNWeb::Validation::is_api() && (tuwf->reqHeader('Origin')//'_') ne config->{url}) {
+ # XXX: User prefs and permissions are not loaded in this case - they're not used.
+ $auth->_load_api2(tuwf->reqHeader('authorization'));
+
+ } else {
+ my $cookie = tuwf->reqCookie('auth')||'';
+ my($uid, $token_e) = $cookie =~ /^([a-fA-F0-9]{40})\.?u?(\d+)$/ ? ('u'.$2, sha1_hex pack 'H*', $1) : (0, '');
+ $auth->_load_session($uid, $token_e);
+ }
$auth
};
- tuwf->req->{auth};
}
@@ -52,7 +63,7 @@ sub auth {
# have a lot of influence in this)
TUWF::set log_format => sub {
my(undef, $uri, $msg) = @_;
- sprintf "[%s] %s %s: %s\n", scalar localtime(), $uri, auth ? 'u'.auth->uid : '-', $msg;
+ sprintf "[%s UTC] %s %s: %s\n", strftime('%Y-%m-%d %H:%M:%S', gmtime), $uri, tuwf->req && tuwf->req->{auth} ? auth->uid : '-', $msg;
};
@@ -62,11 +73,11 @@ use overload bool => sub { defined shift->{user}{user_id} };
sub uid { shift->{user}{user_id} }
sub user { shift->{user} }
sub token { shift->{token} }
-sub isMod { auth->permUsermod || auth->permDbmod || auth->permImgmod || auth->permBoardmod || auth->permTagmod }
+sub isMod { auth->permUsermod || auth->permDbmod || auth->permBoardmod || auth->permTagmod }
-my @perms = qw/board boardmod edit imgvote imgmod tag dbmod tagmod usermod review/;
+my @perms = qw/board boardmod edit imgvote tag dbmod tagmod usermod review lengthvote/;
sub listPerms { @perms }
@@ -78,6 +89,19 @@ for my $perm (@perms) {
}
+
+# Pref(erences) are like permissions, we load these columns eagerly so they can
+# be accessed through auth->pref().
+my @pref_columns = qw/
+ timezone skin customcss_csum titles
+ notify_dbedit notify_post notify_comment
+ tags_all tags_cont tags_ero tags_tech
+ spoilers traits_sexual max_sexual max_violence
+ tableopts_c tableopts_v tableopts_vt
+ nodistract_can nodistract_noads nodistract_nofancy
+/;
+
+
sub _randomascii {
return join '', map chr($_%92+33), unpack 'C*', urandom shift;
}
@@ -90,7 +114,8 @@ sub _preparepass {
my($self, $pass, $salt, $N, $r, $p) = @_;
($N, $r, $p) = @{$self->{scrypt_args}} if !$N;
$salt ||= urandom(8);
- unpack 'H*', pack 'NCCa8a*', $N, $r, $p, $salt, scrypt_raw(encode_utf8($pass), $self->{scrypt_salt} . $salt, $N, $r, $p, 32);
+ utf8::encode(my $utf8pass = $pass);
+ unpack 'H*', pack 'NCCa8a*', $N, $r, $p, $salt, scrypt_raw($utf8pass, $self->{scrypt_salt} . $salt, $N, $r, $p, 32);
}
@@ -107,23 +132,23 @@ sub _encpass {
# Arguments: self, uid, encpass
-# Returns: 0 on error, 1 on success
+# Returns: 0 on error, 1 on success, token on !pretend && deleted account
sub _create_session {
my($self, $uid, $encpass, $pretend) = @_;
my $token = urandom 20;
my $token_db = sha1_hex $token;
return 0 if !tuwf->dbVali('SELECT ',
- sql_func(user_login => \$uid, sql_fromhex($encpass), sql_fromhex $token_db)
+ sql_func(user_login => \$uid, \'web', sql_fromhex($encpass), sql_fromhex $token_db)
);
if($pretend) {
tuwf->dbExeci('SELECT', sql_func user_logout => \$uid, sql_fromhex $token_db);
+ return 1;
} else {
tuwf->resCookie(auth => unpack('H*', $token).'.'.$uid, httponly => 1, expires => time + 31536000);
- $self->_load_session($uid, $token_db);
+ return $self->_load_session($uid, $token_db) ? 1 : $token_db;
}
- return 1;
}
@@ -131,10 +156,13 @@ sub _load_session {
my($self, $uid, $token_db) = @_;
my $user = $uid ? tuwf->dbRowi(
- 'SELECT ', sql_user(), ',', sql_comma(map "perm_$_", @perms), '
+ 'SELECT ', sql_user(), ',', sql_comma(@pref_columns, map "perm_$_", @perms), '
FROM users u
- WHERE id = ', \$uid,
- 'AND', sql_func(user_isvalidsession => 'id', sql_fromhex($token_db), \'web')
+ JOIN users_shadow us ON us.id = u.id
+ JOIN users_prefs up ON up.id = u.id
+ WHERE u.id = ', \$uid, '
+ AND us.delete_at IS NULL
+ AND', sql_func(user_validate_session => 'u.id', sql_fromhex($token_db), \'web'), 'IS DISTINCT FROM NULL'
) : {};
# Drop the cookie if it's not valid
@@ -142,7 +170,7 @@ sub _load_session {
$self->{user} = $user;
$self->{token} = $token_db;
- delete $self->{pref};
+ $user->{user_id};
}
@@ -151,19 +179,17 @@ sub new {
scrypt_salt => config->{scrypt_salt}||die(),
scrypt_args => config->{scrypt_args}||[ 65536, 8, 1 ],
csrf_key => config->{form_salt}||die(),
+ user => {},
}, shift;
}
# Returns 1 on success, 0 on failure
-# When $pretend is true, it only tests if the user/pass combination is correct,
+# When $pretend is true, it only tests if the uid/pass combination is correct,
# but doesn't actually create a session.
sub login {
- my($self, $user, $pass, $pretend) = @_;
- return 0 if $self->uid || !$user || !$pass;
-
- my $uid = tuwf->dbVali('SELECT id FROM users WHERE username =', \$user);
- return 0 if !$uid;
+ my($self, $uid, $pass, $pretend) = @_;
+ return 0 if $self->uid || !$uid || !$pass;
my $encpass = $self->_encpass($uid, $pass);
return 0 if !$encpass;
$self->_create_session($uid, $encpass, $pretend);
@@ -178,24 +204,28 @@ sub logout {
}
+sub wasteTime {
+ my $self = shift;
+ $self->_preparepass(urandom(20));
+}
+
+
# Create a random token that can be used to reset the password.
-# Returns ($uid, $token) if the email address is found in the DB, () otherwise.
+# Returns ($uid, $email, $token) if the email address is found in the DB, () otherwise.
sub resetpass {
my(undef, $mail) = @_;
my $token = unpack 'H*', urandom(20);
- my $id = tuwf->dbVali(
- select => sql_func(user_resetpass => \$mail, sql_fromhex sha1_hex lc $token)
+ my $u = tuwf->dbRowi(
+ 'SELECT uid, mail FROM', sql_func(user_resetpass => \$mail, sql_fromhex sha1_hex lc $token), 'x(uid, mail)'
);
- return $id ? ($id, $token) : ();
+ return $u->{uid} ? ($u->{uid}, $u->{mail}, $token) : ();
}
# Checks if the password reset token is valid
sub isvalidtoken {
my(undef, $uid, $token) = @_;
- tuwf->dbVali(
- select => sql_func(user_isvalidsession => \$uid, sql_fromhex(sha1_hex lc $token), \'pass')
- );
+ tuwf->dbVali('SELECT', sql_func(user_validate_session => \$uid, sql_fromhex(sha1_hex lc $token), \'pass'), 'IS DISTINCT FROM NULL');
}
@@ -258,32 +288,22 @@ sub csrfcheck {
}
-# TODO: Measure global usage of the pref() and prefSet() calls to see if this cache is actually necessary.
-
-my @pref_columns = qw/
- email_confirmed skin customcss filter_vn filter_release
- notify_dbedit notify_announce notify_post notify_comment
- vn_list_own vn_list_wish tags_all tags_cont tags_ero tags_tech spoilers traits_sexual
- max_sexual max_violence nodistract_can nodistract_noads nodistract_nofancy
-/;
-
-# Returns a user preference column for the current user. Lazily loads all
-# preferences to speed of subsequent calls.
sub pref {
my($self, $key) = @_;
return undef if !$self->uid;
-
- $self->{pref} ||= tuwf->dbRowi('SELECT', sql_comma(map "\"$_\"", @pref_columns), 'FROM users WHERE id =', \$self->uid);
- $self->{pref}{$key};
+ croak "Pref key not loaded: $key" if !exists $self->{user}{$key};
+ $self->{user}{$key};
}
-sub prefSet {
- my($self, $key, $value, $uid) = @_;
- die "Unknown pref key: $_" if !grep $key eq $_, @pref_columns;
- $uid //= $self->uid;
- $self->{pref}{$key} = $value;
- tuwf->dbExeci(qq{UPDATE users SET "$key" =}, \$value, 'WHERE id =', \$self->uid);
+# Mark any notifications for a particular item for the current user as read.
+# Arguments: $vndbid, $num||[@nums]||<missing>
+sub notiRead {
+ my($self, $id, $num) = @_;
+ tuwf->dbExeci('
+ UPDATE notifications SET read = NOW() WHERE read IS NULL AND uid =', \$self->uid, 'AND iid =', \$id,
+ @_ == 2 ? () : !defined $num ? 'AND num IS NULL' : !ref $num ? sql 'AND num =', \$num : sql 'AND num IN', $num
+ ) if $self->uid;
}
@@ -293,7 +313,7 @@ sub audit {
tuwf->dbExeci('INSERT INTO audit_log', {
by_uid => $self->uid(),
by_name => $self->{user}{user_name},
- by_ip => tuwf->reqIP(),
+ by_ip => VNWeb::Validation::ipinfo(),
affected_uid => $affected_uid||undef,
affected_name => $affected_uid ? sql('(SELECT username FROM users WHERE id =', \$affected_uid, ')') : undef,
action => $action,
@@ -301,4 +321,84 @@ sub audit {
});
}
+
+
+my $api2_alpha = "ybndrfg8ejkmcpqxot1uwisza345h769"; # z-base-32
+
+# Converts from hex to encoded form
+sub _api2_encode {
+ state %l = map +(substr(unpack('B*', chr $_), 3, 8), substr($api2_alpha, $_, 1)), 0..(length($api2_alpha)-1);
+ (unpack('B*', pack('H*', $_[0])) =~ s/(.....)/$l{$1}/erg)
+ =~ s/(....)(.....)(.....)(....)(.....)(.....)(....)/$1-$2-$3-$4-$5-$6-$7/r;
+}
+# Converts from encoded form to hex
+sub _api2_decode {
+ state %l = ('-', '', map +(substr($api2_alpha, $_, 1), substr unpack('B*', chr $_), 3, 8), 0..(length($api2_alpha)-1));
+ unpack 'H*', pack 'B*', $_[0] =~ s{(.)}{$l{$1} // return}erg
+}
+
+# Takes a UID, returns hex value
+sub _api2_gen_token {
+ # Scramble for cosmetic reasons. This bytewise scramble still leaves an obvious pattern, but w/e.
+ unpack 'H*', (pack('N', $_[0] =~ s/^u//r).urandom(16))
+ =~ s/^(.)(.)(.)(.)(..)(....)(....)(....)(..)$/$5$1$6$2$7$3$8$4$9/sr;
+}
+
+# Extract UID from hex-encoded token
+sub _api2_get_uid {
+ 'u'.unpack 'N', pack('H*', $_[0]) =~ s/^..(.)....(.)....(.)....(.)..$/$1$2$3$4/sr;
+}
+
+
+sub _load_api2 {
+ my($self, $header) = @_;
+ return if !$header;
+ return VNWeb::API::err(401, 'Invalid Authorization header format.') if $header !~ /^(?i:Token) +([-$api2_alpha]+)$/;
+ my $token_enc = $1;
+ return VNWeb::API::err(401, 'Invalid token format.') if length($token_enc =~ s/-//rg) != 32 || !length(my $token = _api2_decode $token_enc);
+ my $uid = _api2_get_uid $token;
+ my $user = tuwf->dbRowi(
+ 'SELECT ', sql_user(), ', x.listread, x.listwrite
+ FROM users u, users_shadow us, ', sql_func(user_validate_session => \$uid, sql_fromhex($token), \'api2'), 'x
+ WHERE u.id = ', \$uid, 'AND x.uid = u.id AND us.id = u.id AND us.delete_at IS NULL'
+ );
+ return VNWeb::API::err(401, 'Invalid token.') if !$user->{user_id};
+ $self->{token} = $token;
+ $self->{user} = $user;
+ $self->{api2} = 1;
+}
+
+sub api2_tokens {
+ my($self, $uid) = @_;
+ return [] if !$self;
+ my $r = tuwf->dbAlli("
+ SELECT coalesce(notes, '') AS notes, listread, listwrite, added::date,", sql_tohex('token'), "AS token
+ , (CASE WHEN expires = added THEN '' ELSE expires::date::text END) AS lastused
+ FROM", sql_func(user_api2_tokens => \$uid, \$self->uid, sql_fromhex($self->{token})), '
+ ORDER BY added');
+ $_->{token} = _api2_encode($_->{token}) for @$r;
+ $r;
+}
+
+sub api2_set_token {
+ my($self, $uid, %o) = @_;
+ return if !auth;
+ my $token = $o{token} ? _api2_decode($o{token}) : _api2_gen_token($uid);
+ tuwf->dbExeci(select => sql_func user_api2_set_token => \$uid, \$self->uid, sql_fromhex($self->{token}),
+ sql_fromhex($token), \$o{notes}, \($o{listread}//0), \($o{listwrite}//0));
+ _api2_encode($token);
+}
+
+sub api2_del_token {
+ my($self, $uid, $token) = @_;
+ return if !$self;
+ tuwf->dbExeci(select => sql_func user_api2_del_token => \$uid, \$self->uid, sql_fromhex($self->{token}), sql_fromhex(_api2_decode($token)));
+}
+
+
+# API-specific permission checks
+# (Always return true for cookie-based auth)
+sub api2Listread { $_[0]{user}{user_id} && (!$_[1] || $_[0]{user}{user_id} eq $_[1]) && (!$_[0]{api2} || $_[0]{user}{listread}) }
+sub api2Listwrite { $_[0]{user}{user_id} && (!$_[1] || $_[0]{user}{user_id} eq $_[1]) && (!$_[0]{api2} || $_[0]{user}{listwrite}) }
+
1;