summaryrefslogtreecommitdiff
path: root/lib/VNDB/Util/Auth.pm
blob: 00700e6eb77efce80c58d08ddd3dd6e51d81d057 (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136

package VNDB::Util::Auth;


use strict;
use warnings;
use Exporter 'import';
use Digest::MD5 'md5';
use Digest::SHA qw|sha1_hex sha256 sha256_hex|;
use Time::HiRes;
use POSIX 'strftime';


our @EXPORT = qw| authInit authLogin authLogout authInfo authCan authPreparePass |;


# initializes authentication information and checks the vndb_auth cookie
sub authInit {
  my $self = shift;
  $self->{_auth} = undef;

  my $cookie = $self->reqCookie('vndb_auth');
  return 0 if !$cookie || length($cookie) < 41;
  my $token = substr($cookie, 0, 40);
  my $uid  = substr($cookie, 40);
  $self->{_auth} = $self->dbUserGet(uid => $uid, what => 'mymessages')->[0] if $self->dbSessionCheck($uid, $token);
}


# login, arguments: user, password, url-to-redirect-to-on-success
# returns 1 on success (redirected), 0 otherwise (no reply sent)
sub authLogin {
  my $self = shift;
  my $user = lc(scalar shift);
  my $pass = shift;
  my $to = shift;

  if(_authCheck($self, $user, $pass)) {
    my $token = sha1_hex(join('', Time::HiRes::gettimeofday()) . join('', map chr(rand(93)+33), 1..9));
    my $expiration = time + 31536000;  # 1yr
    my $cookie = $token . $self->{_auth}{id};
    $self->dbSessionAdd($self->{_auth}{id}, $token);

    my $expstr = strftime("%a, %d %b %Y %H:%M:%S GMT", gmtime($expiration));
    $self->resRedirect($to, 'post');
    $self->resHeader('Set-Cookie', "vndb_auth=$cookie; expires=$expstr; path=/; domain=$self->{cookie_domain}");
    return 1;
  }

  return 0;
}


# clears authentication cookie and redirects to /
sub authLogout {
  my $self = shift;

  my $cookie = $self->reqCookie('vndb_auth');
  if ($cookie && length($cookie) >= 41) {
    my $token = substr($cookie, 0, 40);
    my $uid  = substr($cookie, 40);
    $self->dbSessionDel($uid, $token);
  }

  $self->resRedirect('/', 'temp');
  $self->resHeader('Set-Cookie', "vndb_auth= ; expires=Sat, 01-Jan-2000 00:00:00 GMT; path=/; domain=$self->{cookie_domain}");
}


# 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} || {};
}


# returns whether the currently loggedin or anonymous user can perform
# a certain action. Argument is the action name as defined in global.pl
sub authCan {
  my($self, $act) = @_;
  my $r = $self->{_auth}{rank}||0;
  return scalar grep $_ eq $act, @{$self->{user_ranks}[$r]}[1..$#{$self->{user_ranks}[$r]}];
}


# Checks for a valid login and writes information in _auth
# Arguments: user, pass
# Returns: 1 if login is valid, 0 otherwise
sub _authCheck {
  my($self, $user, $pass) = @_;

  return 0 if !$user || length($user) > 15 || length($user) < 2 || !$pass;

  my $d = $self->dbUserGet(username => $user, what => 'mymessages')->[0];
  return 0 if !defined $d->{id} || !$d->{rank};

  if (_authEncryptPass($self, $pass, $d->{salt}, 1) eq $d->{passwd}) {
    $self->{_auth} = $d;
    return 1;
  }
  if (md5($pass) eq $d->{passwd}) {
    $self->{_auth} = $d;
    my %o;
    ($o{passwd}, $o{salt}) = authPreparePass($self, $pass);
    $self->dbUserEdit($d->{id}, %o);
    return 1;
  }

  return 0;
}


# Encryption algorithm for user passwords
# Arguments: self, pass, salt, binary mode
# Returns: encrypted password
sub _authEncryptPass{
  my ($self, $pass, $salt, $bin) = @_;
  return sha256($self->{global_salt} . $pass . $salt) if $bin;
  return sha256_hex($self->{global_salt} . $pass . $salt);
}


# Prepares a plaintext password for database storage
# Arguments: pass
# Returns: list (pass, salt)
sub authPreparePass{
  my($self, $pass) = @_;
  my $salt = join '', map chr(rand(93)+33), 1..9;
  my $hash = _authEncryptPass($self, $pass, $salt);
  return ($hash, $salt);
}


1;