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.

4 files changed, 46 insertions, 181 deletions

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;