diff options
Diffstat (limited to 'lib')
-rw-r--r-- | lib/Multi/API.pm | 3 | ||||
-rw-r--r-- | lib/PWLookup.pm | 155 | ||||
-rw-r--r-- | lib/VNDB/Handler/Users.pm | 65 | ||||
-rw-r--r-- | lib/VNDB/Util/Auth.pm | 5 |
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; } |