diff options
Diffstat (limited to 'lib/VNWeb/Auth.pm')
-rw-r--r-- | lib/VNWeb/Auth.pm | 206 |
1 files changed, 154 insertions, 52 deletions
diff --git a/lib/VNWeb/Auth.pm b/lib/VNWeb/Auth.pm index d93faa33..442d46f4 100644 --- a/lib/VNWeb/Auth.pm +++ b/lib/VNWeb/Auth.pm @@ -7,7 +7,7 @@ # ..user is logged in # } # -# my $success = auth->login($user, $pass); +# my $success = auth->login($uid, $pass); # auth->logout; # # my $uid = auth->uid; @@ -23,13 +23,14 @@ use warnings; use TUWF; use Exporter 'import'; +use Carp 'croak'; use Digest::SHA qw|sha1 sha1_hex|; use Crypt::URandom 'urandom'; use Crypt::ScryptKDF 'scrypt_raw'; -use Encode 'encode_utf8'; use MIME::Base64 'encode_base64url'; +use POSIX 'strftime'; -use VNDBUtil 'norm_ip'; +use VNDB::Func 'norm_ip'; use VNDB::Config; use VNWeb::DB; @@ -37,14 +38,24 @@ our @EXPORT = ('auth'); sub auth { tuwf->req->{auth} ||= do { - my $cookie = tuwf->reqCookie('auth')||''; - my($uid, $token_e) = $cookie =~ /^([a-fA-F0-9]{40})\.?(\d+)$/ ? ($2, sha1_hex pack 'H*', $1) : (0, ''); - my $auth = __PACKAGE__->new(); - $auth->_load_session($uid, $token_e); + if(config->{read_only}) { + # Account functionality disabled in read-only mode. + + # API requests have two authentication methods: + # - If the origin equals the site, use the same Cookie auth as the rest of the site (handy for userscripts) + # - Otherwise, a custom token-based auth, but this hasn't been implemented yet + } elsif(VNWeb::Validation::is_api() && (tuwf->reqHeader('Origin')//'_') ne config->{url}) { + # XXX: User prefs and permissions are not loaded in this case - they're not used. + $auth->_load_api2(tuwf->reqHeader('authorization')); + + } else { + my $cookie = tuwf->reqCookie('auth')||''; + my($uid, $token_e) = $cookie =~ /^([a-fA-F0-9]{40})\.?u?(\d+)$/ ? ('u'.$2, sha1_hex pack 'H*', $1) : (0, ''); + $auth->_load_session($uid, $token_e); + } $auth }; - tuwf->req->{auth}; } @@ -52,7 +63,7 @@ sub auth { # have a lot of influence in this) TUWF::set log_format => sub { my(undef, $uri, $msg) = @_; - sprintf "[%s] %s %s: %s\n", scalar localtime(), $uri, auth ? 'u'.auth->uid : '-', $msg; + sprintf "[%s UTC] %s %s: %s\n", strftime('%Y-%m-%d %H:%M:%S', gmtime), $uri, tuwf->req && tuwf->req->{auth} ? auth->uid : '-', $msg; }; @@ -62,10 +73,11 @@ use overload bool => sub { defined shift->{user}{user_id} }; sub uid { shift->{user}{user_id} } sub user { shift->{user} } sub token { shift->{token} } +sub isMod { auth->permUsermod || auth->permDbmod || auth->permBoardmod || auth->permTagmod } -my @perms = qw/board boardmod edit imgvote imgmod tag dbmod tagmod usermod/; +my @perms = qw/board boardmod edit imgvote tag dbmod tagmod usermod review lengthvote/; sub listPerms { @perms } @@ -77,6 +89,19 @@ for my $perm (@perms) { } + +# Pref(erences) are like permissions, we load these columns eagerly so they can +# be accessed through auth->pref(). +my @pref_columns = qw/ + timezone skin customcss_csum titles + notify_dbedit notify_post notify_comment + tags_all tags_cont tags_ero tags_tech + spoilers traits_sexual max_sexual max_violence + tableopts_c tableopts_v tableopts_vt + nodistract_can nodistract_noads nodistract_nofancy +/; + + sub _randomascii { return join '', map chr($_%92+33), unpack 'C*', urandom shift; } @@ -89,7 +114,8 @@ sub _preparepass { my($self, $pass, $salt, $N, $r, $p) = @_; ($N, $r, $p) = @{$self->{scrypt_args}} if !$N; $salt ||= urandom(8); - unpack 'H*', pack 'NCCa8a*', $N, $r, $p, $salt, scrypt_raw(encode_utf8($pass), $self->{scrypt_salt} . $salt, $N, $r, $p, 32); + utf8::encode(my $utf8pass = $pass); + unpack 'H*', pack 'NCCa8a*', $N, $r, $p, $salt, scrypt_raw($utf8pass, $self->{scrypt_salt} . $salt, $N, $r, $p, 32); } @@ -106,23 +132,23 @@ sub _encpass { # Arguments: self, uid, encpass -# Returns: 0 on error, 1 on success +# Returns: 0 on error, 1 on success, token on !pretend && deleted account sub _create_session { my($self, $uid, $encpass, $pretend) = @_; my $token = urandom 20; my $token_db = sha1_hex $token; return 0 if !tuwf->dbVali('SELECT ', - sql_func(user_login => \$uid, sql_fromhex($encpass), sql_fromhex $token_db) + sql_func(user_login => \$uid, \'web', sql_fromhex($encpass), sql_fromhex $token_db) ); if($pretend) { tuwf->dbExeci('SELECT', sql_func user_logout => \$uid, sql_fromhex $token_db); + return 1; } else { tuwf->resCookie(auth => unpack('H*', $token).'.'.$uid, httponly => 1, expires => time + 31536000); - $self->_load_session($uid, $token_db); + return $self->_load_session($uid, $token_db) ? 1 : $token_db; } - return 1; } @@ -130,10 +156,13 @@ sub _load_session { my($self, $uid, $token_db) = @_; my $user = $uid ? tuwf->dbRowi( - 'SELECT ', sql_user(), ',', sql_comma(map "perm_$_", @perms), ' + 'SELECT ', sql_user(), ',', sql_comma(@pref_columns, map "perm_$_", @perms), ' FROM users u - WHERE id = ', \$uid, - 'AND', sql_func(user_isvalidsession => 'id', sql_fromhex($token_db), \'web') + JOIN users_shadow us ON us.id = u.id + JOIN users_prefs up ON up.id = u.id + WHERE u.id = ', \$uid, ' + AND us.delete_at IS NULL + AND', sql_func(user_validate_session => 'u.id', sql_fromhex($token_db), \'web'), 'IS DISTINCT FROM NULL' ) : {}; # Drop the cookie if it's not valid @@ -141,7 +170,7 @@ sub _load_session { $self->{user} = $user; $self->{token} = $token_db; - delete $self->{pref}; + $user->{user_id}; } @@ -150,19 +179,17 @@ sub new { scrypt_salt => config->{scrypt_salt}||die(), scrypt_args => config->{scrypt_args}||[ 65536, 8, 1 ], csrf_key => config->{form_salt}||die(), + user => {}, }, shift; } # Returns 1 on success, 0 on failure -# When $pretend is true, it only tests if the user/pass combination is correct, +# When $pretend is true, it only tests if the uid/pass combination is correct, # but doesn't actually create a session. sub login { - my($self, $user, $pass, $pretend) = @_; - return 0 if $self->uid || !$user || !$pass; - - my $uid = tuwf->dbVali('SELECT id FROM users WHERE username =', \$user); - return 0 if !$uid; + my($self, $uid, $pass, $pretend) = @_; + return 0 if $self->uid || !$uid || !$pass; my $encpass = $self->_encpass($uid, $pass); return 0 if !$encpass; $self->_create_session($uid, $encpass, $pretend); @@ -177,24 +204,28 @@ sub logout { } +sub wasteTime { + my $self = shift; + $self->_preparepass(urandom(20)); +} + + # Create a random token that can be used to reset the password. -# Returns ($uid, $token) if the email address is found in the DB, () otherwise. +# Returns ($uid, $email, $token) if the email address is found in the DB, () otherwise. sub resetpass { my(undef, $mail) = @_; my $token = unpack 'H*', urandom(20); - my $id = tuwf->dbVali( - select => sql_func(user_resetpass => \$mail, sql_fromhex sha1_hex lc $token) + my $u = tuwf->dbRowi( + 'SELECT uid, mail FROM', sql_func(user_resetpass => \$mail, sql_fromhex sha1_hex lc $token), 'x(uid, mail)' ); - return $id ? ($id, $token) : (); + return $u->{uid} ? ($u->{uid}, $u->{mail}, $token) : (); } # Checks if the password reset token is valid sub isvalidtoken { my(undef, $uid, $token) = @_; - tuwf->dbVali( - select => sql_func(user_isvalidsession => \$uid, sql_fromhex(sha1_hex lc $token), \'pass') - ); + tuwf->dbVali('SELECT', sql_func(user_validate_session => \$uid, sql_fromhex(sha1_hex lc $token), \'pass'), 'IS DISTINCT FROM NULL'); } @@ -257,31 +288,22 @@ sub csrfcheck { } -# TODO: Measure global usage of the pref() and prefSet() calls to see if this cache is actually necessary. - -my @pref_columns = qw/ - email_confirmed skin customcss filter_vn filter_release show_nsfw notify_dbedit notify_announce - vn_list_own vn_list_wish tags_all tags_cont tags_ero tags_tech spoilers traits_sexual - max_sexual max_violence nodistract_can nodistract_noads nodistract_nofancy -/; - -# Returns a user preference column for the current user. Lazily loads all -# preferences to speed of subsequent calls. sub pref { my($self, $key) = @_; return undef if !$self->uid; - - $self->{pref} ||= tuwf->dbRowi('SELECT', sql_comma(map "\"$_\"", @pref_columns), 'FROM users WHERE id =', \$self->uid); - $self->{pref}{$key}; + croak "Pref key not loaded: $key" if !exists $self->{user}{$key}; + $self->{user}{$key}; } -sub prefSet { - my($self, $key, $value, $uid) = @_; - die "Unknown pref key: $_" if !grep $key eq $_, @pref_columns; - $uid //= $self->uid; - $self->{pref}{$key} = $value; - tuwf->dbExeci(qq{UPDATE users SET "$key" =}, \$value, 'WHERE id =', \$self->uid); +# Mark any notifications for a particular item for the current user as read. +# Arguments: $vndbid, $num||[@nums]||<missing> +sub notiRead { + my($self, $id, $num) = @_; + tuwf->dbExeci(' + UPDATE notifications SET read = NOW() WHERE read IS NULL AND uid =', \$self->uid, 'AND iid =', \$id, + @_ == 2 ? () : !defined $num ? 'AND num IS NULL' : !ref $num ? sql 'AND num =', \$num : sql 'AND num IN', $num + ) if $self->uid; } @@ -291,7 +313,7 @@ sub audit { tuwf->dbExeci('INSERT INTO audit_log', { by_uid => $self->uid(), by_name => $self->{user}{user_name}, - by_ip => tuwf->reqIP(), + by_ip => VNWeb::Validation::ipinfo(), affected_uid => $affected_uid||undef, affected_name => $affected_uid ? sql('(SELECT username FROM users WHERE id =', \$affected_uid, ')') : undef, action => $action, @@ -299,4 +321,84 @@ sub audit { }); } + + +my $api2_alpha = "ybndrfg8ejkmcpqxot1uwisza345h769"; # z-base-32 + +# Converts from hex to encoded form +sub _api2_encode { + state %l = map +(substr(unpack('B*', chr $_), 3, 8), substr($api2_alpha, $_, 1)), 0..(length($api2_alpha)-1); + (unpack('B*', pack('H*', $_[0])) =~ s/(.....)/$l{$1}/erg) + =~ s/(....)(.....)(.....)(....)(.....)(.....)(....)/$1-$2-$3-$4-$5-$6-$7/r; +} +# Converts from encoded form to hex +sub _api2_decode { + state %l = ('-', '', map +(substr($api2_alpha, $_, 1), substr unpack('B*', chr $_), 3, 8), 0..(length($api2_alpha)-1)); + unpack 'H*', pack 'B*', $_[0] =~ s{(.)}{$l{$1} // return}erg +} + +# Takes a UID, returns hex value +sub _api2_gen_token { + # Scramble for cosmetic reasons. This bytewise scramble still leaves an obvious pattern, but w/e. + unpack 'H*', (pack('N', $_[0] =~ s/^u//r).urandom(16)) + =~ s/^(.)(.)(.)(.)(..)(....)(....)(....)(..)$/$5$1$6$2$7$3$8$4$9/sr; +} + +# Extract UID from hex-encoded token +sub _api2_get_uid { + 'u'.unpack 'N', pack('H*', $_[0]) =~ s/^..(.)....(.)....(.)....(.)..$/$1$2$3$4/sr; +} + + +sub _load_api2 { + my($self, $header) = @_; + return if !$header; + return VNWeb::API::err(401, 'Invalid Authorization header format.') if $header !~ /^(?i:Token) +([-$api2_alpha]+)$/; + my $token_enc = $1; + return VNWeb::API::err(401, 'Invalid token format.') if length($token_enc =~ s/-//rg) != 32 || !length(my $token = _api2_decode $token_enc); + my $uid = _api2_get_uid $token; + my $user = tuwf->dbRowi( + 'SELECT ', sql_user(), ', x.listread, x.listwrite + FROM users u, users_shadow us, ', sql_func(user_validate_session => \$uid, sql_fromhex($token), \'api2'), 'x + WHERE u.id = ', \$uid, 'AND x.uid = u.id AND us.id = u.id AND us.delete_at IS NULL' + ); + return VNWeb::API::err(401, 'Invalid token.') if !$user->{user_id}; + $self->{token} = $token; + $self->{user} = $user; + $self->{api2} = 1; +} + +sub api2_tokens { + my($self, $uid) = @_; + return [] if !$self; + my $r = tuwf->dbAlli(" + SELECT coalesce(notes, '') AS notes, listread, listwrite, added::date,", sql_tohex('token'), "AS token + , (CASE WHEN expires = added THEN '' ELSE expires::date::text END) AS lastused + FROM", sql_func(user_api2_tokens => \$uid, \$self->uid, sql_fromhex($self->{token})), ' + ORDER BY added'); + $_->{token} = _api2_encode($_->{token}) for @$r; + $r; +} + +sub api2_set_token { + my($self, $uid, %o) = @_; + return if !auth; + my $token = $o{token} ? _api2_decode($o{token}) : _api2_gen_token($uid); + tuwf->dbExeci(select => sql_func user_api2_set_token => \$uid, \$self->uid, sql_fromhex($self->{token}), + sql_fromhex($token), \$o{notes}, \($o{listread}//0), \($o{listwrite}//0)); + _api2_encode($token); +} + +sub api2_del_token { + my($self, $uid, $token) = @_; + return if !$self; + tuwf->dbExeci(select => sql_func user_api2_del_token => \$uid, \$self->uid, sql_fromhex($self->{token}), sql_fromhex(_api2_decode($token))); +} + + +# API-specific permission checks +# (Always return true for cookie-based auth) +sub api2Listread { $_[0]{user}{user_id} && (!$_[1] || $_[0]{user}{user_id} eq $_[1]) && (!$_[0]{api2} || $_[0]{user}{listread}) } +sub api2Listwrite { $_[0]{user}{user_id} && (!$_[1] || $_[0]{user}{user_id} eq $_[1]) && (!$_[0]{api2} || $_[0]{user}{listwrite}) } + 1; |