summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2019-09-18 12:38:18 +0200
committerYorhel <git@yorhel.nl>2019-09-18 12:40:20 +0200
commit98c9d95e9b7a1e78f5cda93904c6624d57df4518 (patch)
treec54c17740bd0874a996d520323ebe2e7ed7ef029
parentcc2a1d72e499f7befe1b615a1322952dfb628fab (diff)
v2rw: Convert authentication code to VNWeb::Auth
More churn! Also converted v3 to use VNWeb::Auth, considering the API is pretty much the same. Converted VNWeb::* to use VNDB::Config directly rather than read from tuwf->{}, converted VNWeb::HTML to use VNWeb::Auth, and updated util/vndb.pl with the new code style. I tested as much as I could, but I'm sure I broke something.
-rw-r--r--lib/VN3/DB.pm29
-rw-r--r--lib/VN3/ElmGen.pm4
-rw-r--r--lib/VN3/HTML.pm2
-rw-r--r--lib/VN3/Prelude.pm6
-rw-r--r--lib/VN3/Validation.pm2
-rw-r--r--lib/VNDB/DB/Users.pm46
-rw-r--r--lib/VNDB/Handler/Users.pm18
-rw-r--r--lib/VNDB/Util/Auth.pm161
-rw-r--r--lib/VNDB/Util/CommonHTML.pm2
-rw-r--r--lib/VNWeb/Auth.pm (renamed from lib/VN3/Auth.pm)55
-rw-r--r--lib/VNWeb/HTML.pm38
-rwxr-xr-xutil/vndb.pl86
12 files changed, 144 insertions, 305 deletions
diff --git a/lib/VN3/DB.pm b/lib/VN3/DB.pm
index dbc42b74..35b31660 100644
--- a/lib/VN3/DB.pm
+++ b/lib/VN3/DB.pm
@@ -6,6 +6,7 @@ use warnings;
use TUWF;
use SQL::Interp ':all';
use Carp 'carp';
+use VNWeb::DB (); # For the tuwf->dbVali etc methods
use base 'Exporter';
our @EXPORT = qw/
@@ -17,32 +18,6 @@ our @EXPORT = qw/
-# Test for potential SQL injection and warn about it. This will cause some
-# false positives.
-# The heuristic is pretty simple: Just check if there's an integer in the SQL
-# statement. SQL injection through strings is likely to be caught much earlier,
-# since that will generate a syntax error if the string is not properly escaped
-# (and who'd put effort into escaping strings when placeholders are easier?).
-sub interp_warn {
- my @r = sql_interp @_;
- carp "Possible SQL injection in '$r[0]'" if tuwf->debug && $r[0] =~ /[2-9]/; # 0 and 1 aren't interesting, "SELECT 1" is a common pattern and so is "x > 0"
- return @r;
-}
-
-
-# SQL::Interp wrappers around TUWF's db* methods. These do not work with
-# sql_type(). Proper integration should probably be added directly to TUWF.
-sub TUWF::Object::dbExeci { shift->dbExec(interp_warn @_) }
-sub TUWF::Object::dbVali { shift->dbVal (interp_warn @_) }
-sub TUWF::Object::dbRowi { shift->dbRow (interp_warn @_) }
-sub TUWF::Object::dbAlli { shift->dbAll (interp_warn @_) }
-sub TUWF::Object::dbPagei { shift->dbPage(shift, interp_warn @_) }
-
-# Ugly workaround to ensure that db* method failures are reported at the actual caller.
-$Carp::Internal{ (__PACKAGE__) }++;
-
-
-
# sql_* are macros for SQL::Interp use
# join(), but for sql objects.
@@ -280,7 +255,7 @@ sub update_entry {
tuwf->dbExeci("SELECT edit_${type}_init(", \$id, ', (SELECT MAX(rev) FROM changes WHERE type = ', \$type, ' AND itemid = ', \$id, '))');
tuwf->dbExeci('UPDATE edit_revision SET', {
- requester => $uid // scalar VN3::Auth::auth()->uid(),
+ requester => $uid // scalar VNWeb::Auth::auth()->uid(),
ip => scalar tuwf->reqIP(),
comments => $data->{editsum},
ihid => $data->{hidden},
diff --git a/lib/VN3/ElmGen.pm b/lib/VN3/ElmGen.pm
index 7dc28ff4..fefc154e 100644
--- a/lib/VN3/ElmGen.pm
+++ b/lib/VN3/ElmGen.pm
@@ -9,7 +9,7 @@ use warnings;
use TUWF;
use Exporter 'import';
use List::Util 'max';
-use VN3::Auth;
+use VNWeb::Auth;
use VN3::Types;
use VNDB::Types;
@@ -162,7 +162,7 @@ sub print {
};
-my $perms = VN3::Auth::listPerms();
+my $perms = VNWeb::Auth::listPerms();
def urlStatic => String => string tuwf->conf->{url_static};
def userPerms => 'List (Int, String)' => list map tuple($perms->{$_}, string $_), sort keys %$perms;
diff --git a/lib/VN3/HTML.pm b/lib/VN3/HTML.pm
index ecede245..0dcd7241 100644
--- a/lib/VN3/HTML.pm
+++ b/lib/VN3/HTML.pm
@@ -11,7 +11,7 @@ use v5.10;
use utf8;
use List::Util 'pairs', 'max', 'sum';
use TUWF ':Html5', 'mkclass', 'uri_escape';
-use VN3::Auth;
+use VNWeb::Auth;
use VN3::Types;
use VN3::Validation;
use base 'Exporter';
diff --git a/lib/VN3/Prelude.pm b/lib/VN3/Prelude.pm
index 226c1733..a10a66ac 100644
--- a/lib/VN3/Prelude.pm
+++ b/lib/VN3/Prelude.pm
@@ -11,8 +11,8 @@
#
# use VNDBUtil;
# use VNDB::Types;
+# use VNWeb::Auth;
# use VN3::HTML;
-# use VN3::Auth;
# use VN3::DB;
# use VN3::Types;
# use VN3::Validation;
@@ -29,7 +29,7 @@ use warnings;
use utf8;
use feature ':5.10';
use TUWF;
-use VN3::Auth;
+use VNWeb::Auth;
use VN3::ElmGen;
sub import {
@@ -49,8 +49,8 @@ sub import {
use VNDBUtil;
use VNDB::Types;
+ use VNWeb::Auth;
use VN3::HTML;
- use VN3::Auth;
use VN3::DB;
use VN3::Types;
use VN3::Validation;
diff --git a/lib/VN3/Validation.pm b/lib/VN3/Validation.pm
index 4dca4335..73bf7d62 100644
--- a/lib/VN3/Validation.pm
+++ b/lib/VN3/Validation.pm
@@ -7,8 +7,8 @@ use warnings;
use TUWF;
use VNDBUtil;
use VNDB::Types;
+use VNWeb::Auth;
use VN3::DB;
-use VN3::Auth;
use VN3::Types;
use JSON::XS;
use Exporter 'import';
diff --git a/lib/VNDB/DB/Users.pm b/lib/VNDB/DB/Users.pm
index 84ff10f2..70864fca 100644
--- a/lib/VNDB/DB/Users.pm
+++ b/lib/VNDB/DB/Users.pm
@@ -6,9 +6,8 @@ use warnings;
use Exporter 'import';
our @EXPORT = qw|
- dbUserGet dbUserEdit dbUserAdd dbUserDel dbUserPrefSet dbUserLogin dbUserLogout
- dbUserUpdateLastUsed dbUserEmailExists dbUserGetMail dbUserSetMail dbUserSetPerm dbUserAdminSetPass
- dbUserResetPass dbUserIsValidToken dbUserSetPass
+ dbUserGet dbUserEdit dbUserAdd dbUserDel dbUserPrefSet dbUserLogout
+ dbUserEmailExists dbUserGetMail dbUserSetMail dbUserSetPerm
dbNotifyGet dbNotifyMarkRead dbNotifyRemove
dbThrottleGet dbThrottleSet
|;
@@ -151,64 +150,29 @@ sub dbUserPrefSet {
}
-# uid, encpass, token
-sub dbUserLogin {
- $_[0]->dbRow(
- q|SELECT user_login(?, decode(?, 'hex'), decode(?, 'hex')) AS r|,
- $_[1], unpack('H*', $_[2]), unpack('H*', $_[3])
- )->{r}||0;
-}
-
-
# uid, token
sub dbUserLogout {
$_[0]->dbExec(q|SELECT user_logout(?, decode(?, 'hex'))|, $_[1], unpack 'H*', $_[2]);
}
-# uid, token
-sub dbUserUpdateLastUsed {
- $_[0]->dbExec(q|SELECT user_update_lastused(?, decode(?, 'hex'))|, $_[1], unpack 'H*', $_[2]);
-}
-
-
sub dbUserEmailExists {
$_[0]->dbRow(q|SELECT user_emailexists(?) AS r|, $_[1])->{r};
}
-sub dbUserIsValidToken {
- $_[0]->dbRow(q|SELECT user_isvalidtoken(?, decode(?, 'hex')) AS r|, $_[1], unpack 'H*', $_[2])->{r};
-}
-
-
-sub dbUserResetPass {
- $_[0]->dbRow(q|SELECT user_resetpass(?, decode(?, 'hex')) AS r|, $_[1], unpack 'H*', $_[2])->{r};
-}
-
-
-sub dbUserSetPass {
- $_[0]->dbRow(q|SELECT user_setpass(?, decode(?, 'hex'), decode(?, 'hex')) AS r|, $_[1], unpack('H*', $_[2]), unpack('H*', $_[3]))->{r};
-}
-
-
sub dbUserGetMail {
- $_[0]->dbRow(q|SELECT user_getmail(?, ?, decode(?, 'hex')) AS r|, $_[1], $_[2], unpack 'H*', $_[3])->{r};
+ $_[0]->dbRow(q|SELECT user_getmail(?, ?, decode(?, 'hex')) AS r|, $_[1], $_[2], $_[3])->{r};
}
sub dbUserSetMail {
- $_[0]->dbExec(q|SELECT user_setmail(?, ?, decode(?, 'hex'), ?)|, $_[1], $_[2], unpack('H*', $_[3]), $_[4]);
+ $_[0]->dbExec(q|SELECT user_setmail(?, ?, decode(?, 'hex'), ?)|, $_[1], $_[2], $_[3], $_[4]);
}
sub dbUserSetPerm {
- $_[0]->dbExec(q|SELECT user_setperm(?, ?, decode(?, 'hex'), ?)|, $_[1], $_[2], unpack('H*', $_[3]), $_[4]);
-}
-
-
-sub dbUserAdminSetPass {
- $_[0]->dbExec(q|SELECT user_admin_setpass(?, ?, decode(?, 'hex'), decode(?, 'hex'))|, $_[1], $_[2], unpack('H*', $_[3]), unpack('H*', $_[4]));
+ $_[0]->dbExec(q|SELECT user_setperm(?, ?, decode(?, 'hex'), ?)|, $_[1], $_[2], $_[3], $_[4]);
}
diff --git a/lib/VNDB/Handler/Users.pm b/lib/VNDB/Handler/Users.pm
index 09f148d5..5449669f 100644
--- a/lib/VNDB/Handler/Users.pm
+++ b/lib/VNDB/Handler/Users.pm
@@ -6,6 +6,7 @@ use warnings;
use TUWF ':html', 'xml_escape';
use VNDB::Func;
use VNDB::Types;
+use VNWeb::Auth;
use POSIX 'floor';
use PWLookup;
@@ -421,7 +422,7 @@ sub edit {
return $self->htmlDenied if !$self->authInfo->{id} || $self->authInfo->{id} != $uid && !$self->authCan('usermod');
# fetch user info (cached if uid == loggedin uid)
- my $u = $self->authInfo->{id} == $uid ? $self->authInfo : $self->dbUserGet(uid => $uid, what => 'extended prefs')->[0];
+ my $u = $self->dbUserGet(uid => $uid, what => 'extended prefs')->[0];
return $self->resNotFound if !$u->{id};
# check POST data
@@ -466,9 +467,9 @@ sub edit {
my $perm = 0;
$perm |= $self->{permissions}{$_} for(@{ delete $frm->{perms} });
- $self->dbUserSetPerm($u->{id}, $self->authInfo->{id}, $self->authInfo->{token}, $perm);
+ $self->dbUserSetPerm($u->{id}, $self->authInfo->{id}, auth->token(), $perm);
}
- $self->dbUserSetMail($u->{id}, $self->authInfo->{id}, $self->authInfo->{token}, $frm->{mail});
+ $self->dbUserSetMail($u->{id}, $self->authInfo->{id}, auth->token(), $frm->{mail});
$self->dbUserEdit($uid, %o);
$self->authAdminSetPass($u->{id}, $frm->{usrpass}) if $frm->{usrpass} && $self->authInfo->{id} != $u->{id};
@@ -485,7 +486,7 @@ sub edit {
# fill out default values
$frm->{usrname} ||= $u->{username};
- $frm->{mail} ||= $self->dbUserGetMail($u->{id}, $self->authInfo->{id}, $self->authInfo->{token});
+ $frm->{mail} ||= $self->dbUserGetMail($u->{id}, $self->authInfo->{id}, auth->token);
$frm->{perms} ||= [ grep $u->{perm} & $self->{permissions}{$_}, keys %{$self->{permissions}} ];
$frm->{$_} //= $u->{prefs}{$_} for(qw|skin customcss show_nsfw traits_sexual tags_all hide_list spoilers|);
$frm->{tags_cat} ||= [ split /,/, $u->{prefs}{tags_cat}||$self->{default_tags_cat} ];
@@ -545,8 +546,8 @@ sub edit {
sub posts {
my($self, $uid) = @_;
- # fetch user info (cached if uid == loggedin uid)
- my $u = $self->authInfo->{id} && $self->authInfo->{id} == $uid ? $self->authInfo : $self->dbUserGet(uid => $uid, what => 'hide_list')->[0];
+ # fetch user info
+ my $u = $self->dbUserGet(uid => $uid, what => 'hide_list')->[0];
return $self->resNotFound if !$u->{id};
my $f = $self->formValidate(
@@ -713,8 +714,8 @@ sub list {
sub notifies {
my($self, $uid) = @_;
- my $u = $self->authInfo;
- return $self->htmlDenied if !$u->{id} || $uid != $u->{id};
+ my $u = $self->dbUserGet(uid => $uid)->[0];
+ return $self->htmlDenied if !$u->{id} || $uid != $self->authInfo->{id};
my $f = $self->formValidate(
{ get => 'p', required => 0, default => 1, template => 'page' },
@@ -746,7 +747,6 @@ sub notifies {
my @ids = grep $_, @{$frm->{notifysel}};
$self->dbNotifyMarkRead(@ids) if @ids && $frm->{markread};
$self->dbNotifyRemove(@ids) if @ids && $frm->{remove};
- $self->authInfo->{notifycount} = $self->dbUserGet(uid => $uid, what => 'notifycount')->[0]{notifycount};
}
my($list, $np) = $self->dbNotifyGet(
diff --git a/lib/VNDB/Util/Auth.pm b/lib/VNDB/Util/Auth.pm
index c335041a..91453edf 100644
--- a/lib/VNDB/Util/Auth.pm
+++ b/lib/VNDB/Util/Auth.pm
@@ -1,16 +1,12 @@
-
+# Compatibility shim around VNWeb::Auth, new code should use that instead.
package VNDB::Util::Auth;
use strict;
use warnings;
use Exporter 'import';
-use Digest::SHA qw|sha1 sha1_hex|;
-use Crypt::URandom 'urandom';
-use Crypt::ScryptKDF 'scrypt_raw';
-use Encode 'encode_utf8';
use TUWF ':html';
-use VNDB::Func;
+use VNWeb::Auth;
our @EXPORT = qw|
@@ -19,102 +15,32 @@ our @EXPORT = qw|
|;
-sub randomascii {
- return join '', map chr($_%92+33), unpack 'C*', urandom shift;
-}
-
-
-# Fetches and parses the auth cookie.
-# Returns (uid, encrypted_token) on success, (0, '') on failure.
-sub parsecookie {
- # Earlier versions of the auth cookie didn't have the dot separator, so that's optional.
- return ($_[0]->reqCookie('auth')||'') =~ /^([a-fA-F0-9]{40})\.?(\d+)$/ ? ($2, sha1 pack 'H*', $1) : (0, '');
-}
-
-
-# initializes authentication information and checks the vndb_auth cookie
-sub authInit {
- my $self = shift;
-
- my($uid, $token_e) = parsecookie($self);
- $self->{_auth} = $uid && $self->dbUserGet(uid => $uid, session => $token_e, what => 'extended notifycount prefs')->[0];
- $self->{_auth}{token} = $token_e if $self->{_auth};
-
- # update the sessions.lastused column if lastused < now()-'6 hours'
- $self->dbUserUpdateLastUsed($uid, $token_e) if $self->{_auth} && $self->{_auth}{session_lastused} < time()-6*3600;
-
- # Drop the cookie if it's not valid
- $self->resCookie(auth => undef) if !$self->{_auth} && $self->reqCookie('auth');
-}
-
-
# login, arguments: user, password, url-to-redirect-to-on-success
# returns 1 on success (redirected), 0 otherwise (no reply sent)
sub authLogin {
- my($self, $user, $pass, $to) = @_;
-
- return 0 if !$user || !$pass;
-
- my $d = $self->dbUserGet(username => $user, what => 'scryptargs extended prefs notifycount')->[0];
- return 0 if !$d->{id} || !$d->{scryptargs} || length($d->{scryptargs}) != 14;
-
- my($N, $r, $p, $salt) = unpack 'NCCa8', $d->{scryptargs};
- my $encpass = _preparepass($self, $pass, $salt, $N, $r, $p);
-
- return _createsession($self, $d->{id}, $encpass, $to);
+ my(undef, $user, $pass, $to) = @_;
+ my $success = auth->login($user, $pass);
+ tuwf->resRedirect($to, 'post') if $success;
+ $success
}
-
-# 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(encode_utf8($pass), $self->{scrypt_salt} . $salt, $N, $r, $p, 32);
-}
-
-
-# self, uid, encpass, url-to-redirect-to
-sub _createsession {
- my($self, $uid, $encpass, $url) = @_;
-
- my $token = urandom(20);
- my $token_e = sha1 $token;
- return 0 if !$self->dbUserLogin($uid, $encpass, $token_e);
-
- $self->resRedirect($url, 'post');
- $self->resCookie(auth => unpack('H*', $token).'.'.$uid, httponly => 1, expires => time + 31536000); # keep the cookie for 1 year
- return $token_e;
-}
-
-
# clears authentication cookie and redirects to /
sub authLogout {
- my $self = shift;
-
- my($uid, $token_e) = parsecookie($self);
- $self->dbUserLogout($uid, $token_e) if $uid;
-
- $self->resRedirect('/', 'temp');
- $self->resCookie(auth => undef);
+ auth->logout;
+ tuwf->resRedirect('/', 'temp');
}
# Replaces the user's password with a random token that can be used to reset the password.
sub authResetPass {
- my $self = shift;
- my $mail = shift;
- my $token = unpack 'H*', urandom(20);
- my $id = $self->dbUserResetPass($mail, sha1(lc($token)));
- return $id ? ($id, $token) : ();
+ my(undef, $mail) = @_;
+ auth->resetpass($mail)
}
-# uid, token
sub authIsValidToken {
- $_[0]->dbUserIsValidToken($_[1], sha1(lc($_[2])))
+ my(undef, $uid, $token) = @_;
+ auth->isvalidtoken($uid, $token)
}
@@ -122,44 +48,32 @@ sub authIsValidToken {
# Changes the user's password, invalidates all existing sessions, creates a new
# session and redirects.
sub authSetPass {
- my($self, $uid, $pass, $redir, $oldtype, $oldpass) = @_;
-
- if($oldtype eq 'token') {
- $oldpass = sha1(lc($oldpass));
-
- } elsif($oldtype eq 'pass') {
- my $u = $self->dbUserGet(uid => $uid, what => 'scryptargs')->[0];
- return 0 if !$u->{id} || !$u->{scryptargs} || length($u->{scryptargs}) != 14;
- my($N, $r, $p, $salt) = unpack 'NCCa8', $u->{scryptargs};
- $oldpass = _preparepass($self, $oldpass, $salt, $N, $r, $p);
- }
+ my(undef, $uid, $pass, $redir, $oldtype, $oldpass) = @_;
- $pass = _preparepass($self, $pass);
- return 0 if !$self->dbUserSetPass($uid, $oldpass, $pass);
- return _createsession($self, $uid, $pass, $redir);
+ my $success = auth->setpass($uid, $oldtype eq 'token' ? $oldpass : undef, $oldtype eq 'pass' ? $oldpass : undef, $pass);
+ tuwf->resRedirect($redir, 'post') if $success;
+ $success
}
sub authAdminSetPass {
- my($self, $uid, $pass) = @_;
- $pass = _preparepass($self, $pass);
- $self->dbUserAdminSetPass($uid, $self->authInfo->{id}, $self->authInfo->{token}, $pass);
+ my(undef, $uid, $pass) = @_;
+ auth->admin_setpass($uid, $pass);
}
-# returns a hashref with information about the current loggedin user
-# the hash is identical to the hash returned by dbUserGet
-# returns empty hash if no user is logged in.
sub authInfo {
- return shift->{_auth} || {};
+ # Used to return a lot more, but this was by far the most common use
+ # (code using other fields has been migrated)
+ +{ id => auth->uid, username => auth->username }
}
# returns whether the currently loggedin or anonymous user can perform
# a certain action.
sub authCan {
- my($self, $act) = @_;
- return $self->{_auth} ? $self->{_auth}{perm} & $self->{permissions}{$act} : 0;
+ my(undef, $act) = @_;
+ auth->perm() & auth->listPerms->{$act}
}
@@ -167,14 +81,10 @@ sub authCan {
# submitted from our site and by the same user/visitor. Not limited to
# logged-in users.
# Arguments:
-# form-id (string, can be empty, but makes the validation stronger)
-# time (optional, time() to encode in the code)
+# form-id (ignored nowadyas)
+# time (also ignored)
sub authGetCode {
- my $self = shift;
- my $id = shift;
- my $time = (shift || time)/3600; # accuracy of an hour
- my $uid = encode_utf8($self->{_auth} ? $self->{_auth}{id} : norm_ip($self->reqIP()));
- return lc substr sha1_hex($self->{form_salt} . $uid . encode_utf8($id||'') . pack('N', int $time)), 0, 16;
+ auth->csrftoken;
}
@@ -187,14 +97,10 @@ sub authGetCode {
# form-id is not given, the path of the current requests is used.
sub authCheckCode {
my $self = shift;
- my $id = shift || $self->reqPath();
+ my $id = shift;
my $code = shift || $self->reqParam('formcode');
- return _incorrectcode($self) if !$code || $code !~ qr/^[0-9a-f]{16}$/;
- my $time = time;
- return 1 if $self->authGetCode($id, $time) eq $code;
- return 1 if $self->authGetCode($id, $time-3600) eq $code;
- return 1 if $self->authGetCode($id, $time-2*3600) eq $code;
- return _incorrectcode($self);
+ return _incorrectcode($self) if !auth->csrfcheck($code);
+ 1;
}
@@ -216,13 +122,8 @@ sub _incorrectcode {
sub authPref {
- my($self, $key, $val) = @_;
- my $nfo = $self->authInfo;
- return '' if !$nfo->{id};
- return $nfo->{prefs}{$key}||'' if @_ == 2;
- $nfo->{prefs}{$key} = $val;
- $self->dbUserPrefSet($nfo->{id}, $key, $val);
+ my(undef, $key, $val) = @_;
+ @_ == 2 ? auth->pref($key)||'' : auth->prefSet($key, $val);
}
1;
-
diff --git a/lib/VNDB/Util/CommonHTML.pm b/lib/VNDB/Util/CommonHTML.pm
index 12dee979..3adfe740 100644
--- a/lib/VNDB/Util/CommonHTML.pm
+++ b/lib/VNDB/Util/CommonHTML.pm
@@ -66,7 +66,7 @@ sub htmlMainTabs {
end;
}
- if(($type =~ /[rc]/ && $self->authCan('edit')) && $self->authInfo->{c_changes} > 0) {
+ if($type =~ /[rc]/ && $self->authCan('edit')) {
li $sel eq 'copy' ? (class => 'tabselected') : ();
a href => "/$id/copy", 'copy';
end;
diff --git a/lib/VN3/Auth.pm b/lib/VNWeb/Auth.pm
index 82b080ed..22a96de5 100644
--- a/lib/VN3/Auth.pm
+++ b/lib/VNWeb/Auth.pm
@@ -1,13 +1,11 @@
-# This package provides a 'tuwf->auth' method and a useful object for dealing
-# with VNDB sessions. Usage:
+# This package provides a 'tuwf' function and a useful object for dealing with
+# VNDB sessions. Usage:
#
-# use VN3::Auth;
+# use VNWeb::Auth;
#
# if(auth) {
# ..user is logged in
# }
-# ..or:
-# if(tuwf->auth) { .. }
#
# my $success = auth->login($user, $pass);
# auth->logout;
@@ -17,11 +15,11 @@
# my $wants_spoilers = auth->pref('spoilers');
# ..etc
#
-# die "You're not allowed to post!" if !tuwf->auth->permBoard;
+# die "You're not allowed to post!" if !auth->permBoard;
#
-package VN3::Auth;
+package VNWeb::Auth;
-use strict;
+use v5.24;
use warnings;
use TUWF;
use Exporter 'import';
@@ -31,24 +29,27 @@ use Crypt::URandom 'urandom';
use Crypt::ScryptKDF 'scrypt_raw';
use Encode 'encode_utf8';
-use VN3::DB;
use VNDBUtil 'norm_ip';
+use VNDB::Config;
+use VNWeb::DB;
our @EXPORT = ('auth');
-sub auth { tuwf->{auth} }
+
+my $auth;
+sub auth { $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->{auth}->_load_session($uid, $token_e);
+ $auth = __PACKAGE__->new();
+ $auth->_load_session($uid, $token_e);
1;
};
-TUWF::hook after => sub { tuwf->{auth} = __PACKAGE__->new() };
+TUWF::hook after => sub { $auth = __PACKAGE__->new() };
# log user IDs (necessary for determining performance issues, user preferences
@@ -72,6 +73,7 @@ sub token { shift->{token} }
# 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.
+# Flag 256 was used for 'affiliates', now also free.
my %perms = qw{
board 1
boardmod 2
@@ -80,7 +82,6 @@ my %perms = qw{
dbmod 32
tagmod 64
usermod 128
- affiliate 256
};
sub defaultPerms { $perms{board} + $perms{edit} + $perms{tag} }
@@ -154,7 +155,7 @@ sub _load_session {
);
# update the sessions.lastused column if lastused < now()-'6 hours'
- tuwf->dbExeci('SELECT', sql_func user_update_lastused => \$user->{id}, sql_fromhex $token_db)
+ tuwf->dbExeci(SELECT => sql_func user_update_lastused => \$user->{id}, sql_fromhex $token_db)
if $user->{id} && $user->{lastused} < time()-6*3600;
}
@@ -171,9 +172,9 @@ sub _load_session {
sub new {
bless {
- scrypt_salt => tuwf->conf->{scrypt_salt}||die(),
- scrypt_args => tuwf->conf->{scrypt_args}||[ 65536, 8, 1 ],
- csrf_key => tuwf->conf->{form_salt}||die(),
+ scrypt_salt => config->{scrypt_salt}||die(),
+ scrypt_args => config->{scrypt_args}||[ 65536, 8, 1 ],
+ csrf_key => config->{form_salt}||die(),
}, shift;
}
@@ -208,6 +209,7 @@ sub resetpass {
my $id = tuwf->dbVali(
select => sql_func(user_resetpass => \$mail, sql_fromhex sha1_hex lc $token)
);
+ warn $id;
return $id ? ($id, $token) : ();
}
@@ -223,22 +225,33 @@ sub isvalidtoken {
# Change the users' password, drop all existing sessions and create a new session.
# Requires either the current password or a reset token.
+# Returns 1 on success, 0 on failure.
sub setpass {
my($self, $uid, $token, $oldpass, $newpass) = @_;
my $code = $token
? sha1_hex lc $token
: $self->_encpass($uid, $oldpass);
- return if !$code;
+ return 0 if !$code;
my $encpass = $self->_preparepass($newpass);
- return if !tuwf->dbVali(
+ return 0 if !tuwf->dbVali(
select => sql_func user_setpass => \$uid, sql_fromhex($code), sql_fromhex($encpass)
);
$self->_create_session($uid, $encpass);
}
+# Change a users' password, requires that the current logged in user is an admin.
+sub admin_setpass {
+ my($self, $uid, $pass) = @_;
+ my $encpass = $self->_preparepass($pass);
+ tuwf->dbVali(select =>
+ sql_func user_admin_setpass => \$uid, \$self->{uid}, sql_fromhex($self->{token}), sql_fromhex($encpass)
+ )
+}
+
+
# Generate an CSRF token for this user, also works for anonymous users (albeit
# less secure). The key is only valid for the current hour, tokens for previous
# hours can be generated by passing a negative $hour_offset.
@@ -279,11 +292,13 @@ sub prefSet {
my($self, $key, $value, $uid) = @_;
$uid //= $self->uid;
if($value) {
+ $self->{pref}{$key} = $value;
tuwf->dbExeci(
'INSERT INTO users_prefs', { uid => $uid, key => $key, value => $value },
'ON CONFLICT (uid,key) DO UPDATE SET', { value => $value }
);
} else {
+ delete $self->{pref}{$key};
tuwf->dbExeci('DELETE FROM users_prefs WHERE', { uid => $uid, key => $key });
}
}
diff --git a/lib/VNWeb/HTML.pm b/lib/VNWeb/HTML.pm
index e32af3a9..12ec46ad 100644
--- a/lib/VNWeb/HTML.pm
+++ b/lib/VNWeb/HTML.pm
@@ -5,6 +5,8 @@ use warnings;
use TUWF ':html5_', 'uri_escape';
use Exporter 'import';
use JSON::XS;
+use VNDB::Config;
+use VNWeb::Auth;
our @EXPORT = qw/
clearfloat_
@@ -28,14 +30,14 @@ sub debug_ {
sub _head_ {
my $o = shift;
- my $skin = tuwf->reqGet('skin') || tuwf->authPref('skin') || tuwf->{skin_default};
- $skin = tuwf->{skin_default} if !tuwf->{skins}{$skin};
+ my $skin = tuwf->reqGet('skin') || auth->pref('skin') || config->{skin_default};
+ $skin = config->{skin_default} if !tuwf->{skins}{$skin};
title_ $o->{title}.' | vndb';
link_ rel => 'shortcut icon', href => '/favicon.ico', type => 'image/x-icon';
- link_ rel => 'stylesheet', href => tuwf->{url_static}.'/s/'.$skin.'/style.css?'.tuwf->{version}, type => 'text/css', media => 'all';
+ link_ rel => 'stylesheet', href => config->{url_static}.'/s/'.$skin.'/style.css?'.config->{version}, type => 'text/css', media => 'all';
link_ rel => 'search', type => 'application/opensearchdescription+xml', title => 'VNDB VN Search', href => tuwf->reqBaseURI().'/opensearch.xml';
- style_ type => 'text/css', tuwf->authPref('customcss') =~ s/\n/ /rg if tuwf->authPref('customcss');
+ style_ type => 'text/css', auth->pref('customcss') =~ s/\n/ /rg if auth->pref('customcss');
if($o->{feeds}) {
link_ rel => 'alternate', type => 'application/atom+xml', href => "/feeds/announcements.atom", title => 'Site Announcements';
link_ rel => 'alternate', type => 'application/atom+xml', href => "/feeds/changes.atom", title => 'Recent Changes';
@@ -84,9 +86,9 @@ sub _menu_ {
};
div_ class => 'menubox', sub {
- my $uid = sprintf '/u%d', tuwf->authInfo->{id};
- my $nc = tuwf->authInfo->{notifycount};
- h2_ sub { a_ href => $uid, ucfirst tuwf->authInfo->{username} };
+ my $uid = sprintf '/u%d', auth->uid;
+ my $nc = auth && tuwf->dbVali('SELECT count(*) FROM notifications WHERE uid =', \auth->uid, 'AND read IS NULL');
+ h2_ sub { a_ href => $uid, ucfirst auth->username };
div_ sub {
a_ href => "$uid/edit", 'My Profile'; br_;
a_ href => "$uid/list", 'My Visual Novel List'; br_;
@@ -94,9 +96,9 @@ sub _menu_ {
a_ href => "$uid/wish", 'My Wishlist'; br_;
a_ href => "$uid/notifies", $nc ? (class => 'notifyget') : (), 'My Notifications'.($nc?" ($nc)":''); br_;
a_ href => "$uid/hist", 'My Recent Changes'; br_;
- a_ href => '/g/links?u='.tuwf->authInfo->{id}, 'My Tags'; br_;
+ a_ href => '/g/links?u='.auth->uid, 'My Tags'; br_;
br_;
- if(tuwf->authCan('edit')) {
+ if(auth->permEdit) {
a_ href => '/v/add', 'Add Visual Novel'; br_;
a_ href => '/p/add', 'Add Producer'; br_;
a_ href => '/s/new', 'Add Staff'; br_;
@@ -105,7 +107,7 @@ sub _menu_ {
br_;
a_ href => "$uid/logout", 'Logout';
}
- } if tuwf->authInfo->{id};
+ } if auth;
div_ class => 'menubox', sub {
h2_ 'User menu';
@@ -115,7 +117,7 @@ sub _menu_ {
a_ href => '/u/newpass', 'Password reset'; br_;
a_ href => '/u/register', 'Register'; br_;
}
- } if !tuwf->authInfo->{id};
+ } if !auth;
div_ class => 'menubox', sub {
h2_ 'Database Statistics';
@@ -145,14 +147,14 @@ sub _footer_ {
txt_ '"';
br_;
}
- txt_ sprintf 'vndb %s | ', tuwf->{version};
+ txt_ sprintf 'vndb %s | ', config->{version};
a_ href => '/d7', 'about us';
lit_ ' | ';
a_ href => 'irc://irc.synirc.net/vndb', '#vndb';
lit_ ' | ';
- a_ href => sprintf('mailto:%s', tuwf->{admin_email}), tuwf->{admin_email};
+ a_ href => sprintf('mailto:%s', config->{admin_email}), config->{admin_email};
lit_ ' | ';
- a_ href => tuwf->{source_url}, 'source';
+ a_ href => config->{source_url}, 'source';
if(tuwf->debug) {
lit_ ' | ';
@@ -191,9 +193,11 @@ sub framework_ {
div_ id => 'bgright', ' ';
div_ id => 'header', sub { h1_ sub { a_ href => '/', 'the visual novel database' } };
div_ id => 'menulist', sub { _menu_ \%o };
- div_ id => 'maincontent', $cont;
- div_ id => 'footer', sub { _footer_ };
- };
+ div_ id => 'maincontent', sub {
+ $cont->();
+ div_ id => 'footer', sub { _footer_ };
+ }
+ }
}
}
diff --git a/util/vndb.pl b/util/vndb.pl
index 8ec102e5..d2b1a964 100755
--- a/util/vndb.pl
+++ b/util/vndb.pl
@@ -1,9 +1,9 @@
#!/usr/bin/perl
-use strict;
+use v5.24;
use warnings;
use Cwd 'abs_path';
-use TUWF ':html';
+use TUWF ':html_';
$|=1; # Disable buffering on STDOUT, otherwise vndb-dev-server.pl won't pick up our readyness notification.
@@ -13,6 +13,7 @@ BEGIN { ($ROOT = abs_path $0) =~ s{/util/vndb\.pl$}{}; }
use lib $ROOT.'/lib';
use SkinFile;
use VNDB::Config;
+use VNWeb::HTML ();
# load the skins
@@ -27,60 +28,39 @@ tuwf->{permissions} = {qw| board 1 boardmod 2 edit 4 tag 16 dbmod 32 tagmo
tuwf->{default_perm} = 1+4+16; # Keep synchronised with the default value of users.perm
tuwf->{$_} = config->{$_} for keys %{ config() };
-TUWF::set(
- %{ config->{tuwf} },
- pre_request_handler => \&reqinit,
- error_404_handler => \&handle404,
- log_format => \&logformat,
-);
-TUWF::load_recursive('VNDB::Util', 'VNDB::DB', 'VNDB::Handler', 'VNWeb');
-TUWF::run();
-
+TUWF::set %{ config->{tuwf} };
-sub reqinit {
- my $self = shift;
- # If we're running standalone, serve www/ and static/ too.
- if($TUWF::OBJ->{_TUWF}{http}) {
- if($self->resFile("$ROOT/www", $self->reqPath) || $self->resFile("$ROOT/static", $self->reqPath)) {
- $self->resHeader('Cache-Control' => 'max-age=31536000');
- return 0;
+TUWF::hook before => sub {
+ # If we're running standalone, serve www/ and static/ too.
+ if(tuwf->{_TUWF}{http}) {
+ if(tuwf->resFile("$ROOT/www", tuwf->reqPath) || tuwf->resFile("$ROOT/static", tuwf->reqPath)) {
+ tuwf->resHeader('Cache-Control' => 'max-age=31536000');
+ tuwf->done;
+ }
}
- }
-
- # check authentication cookies
- $self->authInit;
-
- # load some stats (used for about all pageviews, anyway)
- $self->{stats} = $self->dbStats;
- return 1;
-}
-
-
-sub handle404 {
- my $self = shift;
- $self->resStatus(404);
- $self->htmlHeader(title => 'Page Not Found');
- div class => 'mainbox';
- h1 'Page not found';
- div class => 'warning';
- h2 'Oops!';
- p;
- txt 'It seems the page you were looking for does not exist,';
- br;
- txt 'you may want to try using the menu on your left to find what you are looking for.';
- end;
- end;
- end;
- $self->htmlFooter;
-}
+ # load some stats (used for about all pageviews, anyway)
+ tuwf->{stats} = tuwf->dbStats;
+};
+
+
+TUWF::set error_404_handler => sub {
+ tuwf->resStatus(404);
+ VNWeb::HTML::framework_ title => 'Page Not Found', noindex => 1, sub {
+ div_ class => 'mainbox', sub {
+ h1_ 'Page not found';
+ div_ class => 'warning', sub {
+ h2_ 'Oops!';
+ p_;
+ txt_ 'It seems the page you were looking for does not exist,';
+ br_;
+ txt_ 'you may want to try using the menu on your left to find what you are looking for.';
+ }
+ }
+ }
+};
-# log user IDs (necessary for determining performance issues, user preferences
-# have a lot of influence in this)
-sub logformat {
- my($self, $uri, $msg) = @_;
- sprintf "[%s] %s %s: %s\n", scalar localtime(), $uri,
- $self->authInfo->{id} ? 'u'.$self->authInfo->{id} : '-', $msg;
-}
+TUWF::load_recursive('VNDB::Util', 'VNDB::DB', 'VNDB::Handler', 'VNWeb');
+TUWF::run();