summaryrefslogtreecommitdiff
path: root/lib
diff options
context:
space:
mode:
Diffstat (limited to 'lib')
-rw-r--r--lib/Multi/API.pm3
-rw-r--r--lib/PWLookup.pm155
-rw-r--r--lib/VNDB/Handler/Users.pm65
-rw-r--r--lib/VNDB/Util/Auth.pm5
4 files changed, 213 insertions, 15 deletions
diff --git a/lib/Multi/API.pm b/lib/Multi/API.pm
index 585c3d2c..aa767fb2 100644
--- a/lib/Multi/API.pm
+++ b/lib/Multi/API.pm
@@ -17,6 +17,7 @@ use Crypt::URandom 'urandom';
use Crypt::ScryptKDF 'scrypt_raw';;
use VNDBUtil 'normalize_query', 'norm_ip';
use JSON::XS;
+use PWLookup;
# Linux-specific, not exported by the Socket module.
sub TCP_KEEPIDLE () { 4 }
@@ -274,6 +275,8 @@ sub login {
return;
} else {
$arg->{username} = lc $arg->{username};
+ return cerr $c, auth => "Password too weak, please log in on the site and change your password"
+ if $VNDB::S{password_db} && PWLookup::lookup($VNDB::S{password_db}, $arg->{password});
}
login_auth($c, $arg);
diff --git a/lib/PWLookup.pm b/lib/PWLookup.pm
new file mode 100644
index 00000000..bf4ea96b
--- /dev/null
+++ b/lib/PWLookup.pm
@@ -0,0 +1,155 @@
+#!/usr/bin/perl
+
+# This script is based on the btree.pl that I wrote as part of a little
+# experiment: https://dev.yorhel.nl/doc/pwlookup
+#
+# It is hardcoded to use gzip (because that's available in a standard Perl
+# distribution) compression level 9 (saves a few MiB with no noticable impact
+# on lookup performance) with 4k block sizes (because that is fast enough and
+# offers good compression).
+#
+# Creating the database:
+#
+# perl PWlookup.pm create <sorted-dictionary >dbfile
+#
+# Extracting all passwords from the database:
+#
+# perl PWLookup.pm extract dbfile >sorted-dictionary
+#
+# Performing lookups (from the CLI):
+#
+# perl PWLookup.pm lookup dbfile query
+#
+# Performing lookups (from Perl):
+#
+# use PWLookup;
+# my $pw_exists = PWLookup::lookup($dbfile, $query);
+
+package PWLookup;
+
+use strict;
+use warnings;
+use v5.10;
+use Compress::Zlib qw/compress uncompress/;
+use Encode qw/encode_utf8 decode_utf8/;
+
+my $blocksize = 4096;
+
+# Encode/decode a block reference, [ leaf, length, offset ]. Encoded in a single 64bit integer as (leaf | length << 1 | offset << 16)
+sub eref($) { pack 'Q', ($_[0][0]?1:0) | $_[0][1]<<1 | $_[0][2]<<16 }
+sub dref($) { my $v = unpack 'Q', $_[0]; [$v&1, ($v>>1)&((1<<15)-1), $v>>16] }
+
+# Write a block and return its reference.
+sub writeblock {
+ state $off = 0;
+ my $buf = compress($_[0], 9);
+ my $len = length $buf;
+ print $buf;
+ my $oldoff = $off;
+ $off += $len;
+ [$_[1], $len, $oldoff]
+}
+
+# Read a block given a file handle and a reference.
+sub readblock {
+ my($F, $ref) = @_;
+ die $! if !sysseek $F, $ref->[2], 0;
+ die $! if $ref->[1] != sysread $F, (my $buf), $ref->[1];
+ uncompress($buf)
+}
+
+sub encode {
+ my $leaf = "\0";
+ my @nodes = ('');
+ my $ref;
+
+ my $flush = sub {
+ my $minsize = $_[0];
+ return if $minsize > length $leaf;
+
+ my $str = $leaf =~ /^\x00([^\x00]*)/ && $1;
+ $ref = writeblock $leaf, 1;
+ $leaf = "\0";
+ $nodes[0] .= "$str\x00".eref($ref);
+
+ for(my $i=0; $i <= $#nodes && $minsize < length $nodes[$i]; $i++) {
+ my $str = $nodes[$i] =~ s/^([^\x00]*)\x00// && $1;
+ $ref = writeblock $nodes[$i], 0;
+ $nodes[$i] = '';
+ if($minsize || $nodes[$i+1]) {
+ $nodes[$i+1] ||= '';
+ $nodes[$i+1] .= "$str\x00".eref($ref);
+ }
+ }
+ };
+
+ my $last;
+ while((my $p = <STDIN>)) {
+ chomp($p);
+ # No need to store passwords that are rejected by form validation
+ if(!length($p) || length($p) > 500 || !eval { decode_utf8((local $_=$p), Encode::FB_CROAK); 1 }) {
+ warn sprintf "Rejecting: %s\n", ($p =~ s/([^\x21-\x7e])/sprintf '%%%02x', ord $1/ger);
+ next;
+ }
+ # Extra check to make sure the input is unique and sorted according to Perl's string comparison
+ if(defined($last) && $last ge $p) {
+ warn "Rejecting due to uniqueness or incorrect sorting: $p\n";
+ next;
+ }
+ $leaf .= "$p\0";
+ $flush->($blocksize);
+ }
+ $flush->(0);
+ print eref $ref;
+}
+
+
+sub lookup_rec {
+ my($F, $q, $ref) = @_;
+ my $buf = readblock $F, $ref;
+ if($ref->[0]) {
+ return $buf =~ /\x00\Q$q\E\x00/;
+ } else {
+ while($buf =~ /(.{8})([^\x00]+)\x00/sg) {
+ return lookup_rec($F, $q, dref $1) if $q lt $2;
+ }
+ return lookup_rec($F, $q, dref substr $buf, -8)
+ }
+}
+
+sub lookup {
+ my($f, $q) = @_;
+ open my $F, '<', $f or die $!;
+ sysseek $F, -8, 2 or die $!;
+ die $! if 8 != sysread $F, (my $buf), 8;
+ lookup_rec($F, encode_utf8($q), dref $buf)
+}
+
+
+sub extract_rec {
+ my($F, $ref) = @_;
+ my $buf = readblock $F, $ref;
+ if($ref->[0]) {
+ print "$1\n" while $buf =~ /\x00([^\x00]+)/g;
+ } else {
+ extract_rec($F, dref $1) while $buf =~ /(.{8})[^\x00]+\x00/sg;
+ extract_rec($F, dref substr $buf, -8)
+ }
+}
+
+sub extract {
+ my($f) = @_;
+ open my $F, '<', $f or die $!;
+ sysseek $F, -8, 2 or die $!;
+ die $! if 8 != sysread $F, (my $buf), 8;
+ extract_rec($F, dref $buf)
+}
+
+
+if(!caller) {
+ encode() if $ARGV[0] eq 'create';
+ extract($ARGV[1]) if $ARGV[0] eq 'extract';
+ printf "%s\n", lookup($ARGV[1], decode_utf8 $ARGV[2]) ? 'Found' : 'Not found' if $ARGV[0] eq 'lookup';
+}
+
+1;
diff --git a/lib/VNDB/Handler/Users.pm b/lib/VNDB/Handler/Users.pm
index 56664443..0177e4aa 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 POSIX 'floor';
+use PWLookup;
TUWF::register(
@@ -142,11 +143,8 @@ sub userpage {
}
-sub login {
+sub _check_throttle {
my $self = shift;
-
- return $self->resRedirect('/', 'temp') if $self->authInfo->{id};
-
my $tm = $self->dbThrottleGet(norm_ip($self->reqIP));
if($tm-time() > $self->{login_throttle}[1]) {
$self->htmlHeader(title => 'Login');
@@ -165,8 +163,19 @@ sub login {
end;
end 'div';
$self->htmlFooter;
- return;
+ return undef;
}
+ $tm
+}
+
+
+sub login {
+ my $self = shift;
+
+ return $self->resRedirect('/', 'temp') if $self->authInfo->{id};
+
+ my $tm = _check_throttle($self);
+ return if !defined $tm;
my $ref = $self->formValidate({ param => 'ref', required => 0, default => '/'})->{ref};
@@ -180,7 +189,16 @@ sub login {
if(!$frm->{_err}) {
$frm->{usrname} = lc $frm->{usrname};
- return if $self->authLogin($frm->{usrname}, $frm->{usrpass}, $ref);
+
+ my $ok = $self->authLogin($frm->{usrname}, $frm->{usrpass}, $ref);
+
+ if($ok && $self->{password_db} && PWLookup::lookup($self->{password_db}, $frm->{usrpass})) {
+ my $u = $self->dbUserGet(username => $frm->{usrname})->[0];
+ $self->dbUserLogout($u->{id}, $ok); # Make sure to throw away the session we just created
+ return $self->resRedirect("/u$u->{id}/setpass", 'post');
+ }
+ return if $ok;
+
$frm->{_err} = [ 'Invalid username or password' ];
$self->dbThrottleSet(norm_ip($self->reqIP), $tm+$self->{login_throttle}[0]);
}
@@ -262,36 +280,55 @@ sub newpass_sent {
}
+# /u+/setpass has two modes: With a token (?t=xxx), to set the password after a
+# 'register' or 'newpass', or without a token, after the user tried to log in
+# with a weak password.
sub setpass {
my($self, $uid) = @_;
return $self->resRedirect('/', 'temp') if $self->authInfo->{id};
- my $t = $self->formValidate({get => 't', regex => qr/^[a-f0-9]{40}$/i });
+ my $t = $self->formValidate({param => 't', required => 0, regex => qr/^[a-f0-9]{40}$/i });
return $self->resNotFound if $t->{_err};
$t = $t->{t};
my $u = $self->dbUserGet(uid => $uid)->[0];
- return $self->resNotFound if !$u || !$self->authIsValidToken($u->{id}, $t);
+ return $self->resNotFound if !$u || ($t && !$self->authIsValidToken($u->{id}, $t));
+
+ my $tm = !$t && _check_throttle($self);
+ return if !$t && !defined $tm;
my $frm;
if($self->reqMethod eq 'POST') {
- return if !$self->authCheckCode("/u$u->{id}/setpass?t=$t");
+ return if !$self->authCheckCode("/u$u->{id}/setpass");
$frm = $self->formValidate(
+ $t ? () : (
+ { post => 'curpass', minlength => 4, maxlength => 500 },
+ ),
{ post => 'usrpass', minlength => 4, maxlength => 500 },
{ post => 'usrpass2', minlength => 4, maxlength => 500 },
);
push @{$frm->{_err}}, 'Passwords do not match' if $frm->{usrpass} ne $frm->{usrpass2};
+ push @{$frm->{_err}}, 'The chosen password is too weak, please choose a stronger password'
+ if $self->{password_db} && PWLookup::lookup($self->{password_db}, $frm->{usrpass});
if(!$frm->{_err}) {
$self->dbUserEdit($uid, email_confirmed => 1);
- return $self->authSetPass($uid, $frm->{usrpass}, "/u$uid", token => $t)
+ return if $self->authSetPass($uid, $frm->{usrpass}, "/u$uid", $t ? (token => $t) : (pass => $frm->{curpass}));
+ $self->dbThrottleSet(norm_ip($self->reqIP), $tm+$self->{login_throttle}[0]);
+ push @{$frm->{_err}}, 'Invalid password';
}
}
$self->htmlHeader(title => "Set password for $u->{username}", noindex => 1);
- $self->htmlForm({ frm => $frm, action => "/u$u->{id}/setpass?t=$t" }, setpass => [ "Set password for $u->{username}",
- [ static => nolabel => 1, content => 'Now you can set a password for your account.'
- .' You will be logged in automatically after your password has been saved.' ],
+ $self->htmlForm({ frm => $frm, action => "/u$u->{id}/setpass" }, setpass => [ "Set password for $u->{username}",
+ [ hidden => short => 't', value => $t||'' ],
+ $t ? (
+ [ static => nolabel => 1, content => 'Now you can set a password for your account.'
+ .' You will be logged in automatically after your password has been saved.' ],
+ ) : (
+ [ static => nolabel => 1, content => "Your current password is too weak, please change your password to continue.<br><br>" ],
+ [ passwd => short => 'curpass', name => 'Current password' ],
+ ),
[ passwd => short => 'usrpass', name => 'Password' ],
[ passwd => short => 'usrpass2', name => 'Confirm password' ],
]);
@@ -411,6 +448,8 @@ sub edit {
);
push @{$frm->{_err}}, 'Passwords do not match'
if ($frm->{usrpass} || $frm->{usrpass2}) && (!$frm->{usrpass} || !$frm->{usrpass2} || $frm->{usrpass} ne $frm->{usrpass2});
+ push @{$frm->{_err}}, 'The chosen password is too weak, please choose a stronger password'
+ if $self->{password_db} && PWLookup::lookup($self->{password_db}, $frm->{usrpass});
if(!$frm->{_err}) {
$frm->{skin} = '' if $frm->{skin} eq $self->{skin_default};
diff --git a/lib/VNDB/Util/Auth.pm b/lib/VNDB/Util/Auth.pm
index e3ee20eb..bda13158 100644
--- a/lib/VNDB/Util/Auth.pm
+++ b/lib/VNDB/Util/Auth.pm
@@ -81,11 +81,12 @@ sub _createsession {
my($self, $uid, $encpass, $url) = @_;
my $token = urandom(20);
- return 0 if !$self->dbUserLogin($uid, $encpass, sha1 $token);
+ 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 1;
+ return $token_e;
}