summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
authorYorhel <git@yorhel.nl>2008-10-31 12:04:08 +0100
committerYorhel <git@yorhel.nl>2008-10-31 12:04:08 +0100
commitd5bc5cf2169116a9a4b30377ef2e28603fc4e3ea (patch)
treec79c61fbee5376ef9919e3ea671680ab0afa5e29 /lib
parentf266cd214111a1c71f705edbc9243d8625693003 (diff)
Added some authentication and user functions
Diffstat (limited to 'lib')
-rw-r--r--lib/VNDB/DB/Misc.pm1
-rw-r--r--lib/VNDB/DB/Users.pm44
-rw-r--r--lib/VNDB/Util/Auth.pm96
3 files changed, 141 insertions, 0 deletions
diff --git a/lib/VNDB/DB/Misc.pm b/lib/VNDB/DB/Misc.pm
index 50a12a4b..61b1223c 100644
--- a/lib/VNDB/DB/Misc.pm
+++ b/lib/VNDB/DB/Misc.pm
@@ -13,6 +13,7 @@ our @EXPORT = qw|
# Arguments: array of elements to get stats from, options:
# vn, producers, releases, users, threads, posts
# Returns: hashref, key = element, value = number of entries
+# TODO: caching, see http://www.varlena.com/GeneralBits/120.php
sub dbStats {
my $s = shift;
return { map {
diff --git a/lib/VNDB/DB/Users.pm b/lib/VNDB/DB/Users.pm
new file mode 100644
index 00000000..9e83ea2b
--- /dev/null
+++ b/lib/VNDB/DB/Users.pm
@@ -0,0 +1,44 @@
+
+package VNDB::DB::Users;
+
+use Exporter 'import';
+
+our @EXPORT = 'dbUserGet';
+
+
+# %options->{ username passwd order uid results page }
+sub dbUserGet {
+ my $s = shift;
+ my %o = (
+ order => 'username ASC',
+ page => 1,
+ results => 10,
+ what => '',
+ @_
+ );
+
+ my %where = (
+ $o{username} ? (
+ 'username = ?' => $o{username} ) : (),
+ $o{passwd} ? (
+ 'passwd = decode(?, \'hex\')' => $o{passwd} ) : (),
+ $o{uid} ? (
+ 'id = ?' => $o{uid} ) : (),
+ !$o{uid} && !$o{username} ? (
+ 'id > 0' => 1 ) : (),
+ );
+
+ my($r, $np) = $s->dbPage(\%o, q|
+ SELECT *
+ FROM users u
+ !W
+ ORDER BY !s|,
+ \%where,
+ $o{order}
+ );
+
+ return wantarray ? ($r, $np) : $r;
+}
+
+
+1;
diff --git a/lib/VNDB/Util/Auth.pm b/lib/VNDB/Util/Auth.pm
new file mode 100644
index 00000000..5ac9218f
--- /dev/null
+++ b/lib/VNDB/Util/Auth.pm
@@ -0,0 +1,96 @@
+
+package VNDB::Util::Auth;
+
+# This module is just a small improvement of the 1.x equivalent
+# and is designed to work with the cookies and database of VNDB 1.x
+# without modifications. A proper and more secure (incompatible)
+# implementation should be written at some point.
+
+use strict;
+use warnings;
+use Exporter 'import';
+use Digest::MD5 'md5_hex';
+use Crypt::Lite;
+
+
+our @EXPORT = qw| authInit authLogin authLogout authInfo authCan |;
+
+
+# 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;
+ my $str = Crypt::Lite->new()->decrypt($cookie, md5_hex($self->{cookie_key}));
+ return 0 if length($str) < 36;
+ my $pass = substr($str, 4, 32);
+ my $user = substr($str, 36);
+ _authCheck($self, $user, $pass);
+}
+
+
+# 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 = md5_hex(shift);
+ my $to = shift;
+
+ if(_authCheck($self, $user, $pass)) {
+ (my $cookie = Crypt::Lite->new()->encrypt("VNDB$pass$user", md5_hex($self->{cookie_key}))) =~ s/\r?\n//g;
+ $self->resRedirect($to, 'post');
+ $self->resHeader('Set-Cookie', "vndb_auth=$cookie; expires=Sat, 01-Jan-2030 00:00:00 GMT; path=/; domain=$self->{cookie_domain}");
+ return 1;
+ }
+ return 0;
+}
+
+
+# clears authentication cookie and redirects to /
+sub authLogout {
+ my $self = shift;
+ $self->resRedirect('/', 'temp');
+ $self->resAddHeader('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, md5_hex(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 || length($pass) != 32;
+
+ my $d = $self->dbUserGet(username => $user, passwd => $pass)->[0];
+ return 0 if !defined $d->{id} || !$d->{rank};
+
+ $self->{_auth} = $d;
+ return 1;
+}
+
+
+1;
+