diff options
Diffstat (limited to 'lib/VNWeb/User/Edit.pm')
-rw-r--r-- | lib/VNWeb/User/Edit.pm | 312 |
1 files changed, 188 insertions, 124 deletions
diff --git a/lib/VNWeb/User/Edit.pm b/lib/VNWeb/User/Edit.pm index ad74088f..a4e42ad8 100644 --- a/lib/VNWeb/User/Edit.pm +++ b/lib/VNWeb/User/Edit.pm @@ -2,58 +2,88 @@ package VNWeb::User::Edit; use VNWeb::Prelude; use VNDB::Skins; +use VNWeb::TitlePrefs '/./'; +use VNWeb::TimeZone; + +use Digest::SHA 'sha1'; my $FORM = { id => { vndbid => 'u' }, - title => { _when => 'out' }, - username => { username => 1 }, # Can only be modified with perm_usermod - - opts => { _when => 'out', type => 'hash', keys => { - # Supporter options available to this user - nodistract_can => { _when => 'out', anybool => 1 }, - support_can => { _when => 'out', anybool => 1 }, - uniname_can => { _when => 'out', anybool => 1 }, - pubskin_can => { _when => 'out', anybool => 1 }, - - # Permissions of the user editing this account - perm_dbmod => { _when => 'out', anybool => 1 }, - perm_usermod => { _when => 'out', anybool => 1 }, - perm_tagmod => { _when => 'out', anybool => 1 }, - perm_boardmod => { _when => 'out', anybool => 1 }, + username => { username => 1 }, + username_throttled => { _when => 'out', anybool => 1 }, + email => { email => 1 }, + password => { default => undef, type => 'hash', keys => { + old => { password => 1 }, + new => { password => 1 } + } }, + + # Supporter options available to this user + editor_usermod => { anybool => 1 }, + nodistract_can => { _when => 'out', anybool => 1 }, + support_can => { _when => 'out', anybool => 1 }, + uniname_can => { _when => 'out', anybool => 1 }, + pubskin_can => { _when => 'out', anybool => 1 }, + # Supporter options + nodistract_noads => { anybool => 1 }, + nodistract_nofancy => { anybool => 1 }, + support_enabled => { anybool => 1 }, + uniname => { default => '', sl => 1, length => [2,15] }, + pubskin_enabled => { anybool => 1 }, + + traits => { sort_keys => 'tid', maxlength => 100, aoh => { + tid => { vndbid => 'i' }, + name => { _when => 'out' }, + group => { _when => 'out', default => undef }, } }, - # Settings that require at least one perm_*mod - admin => { required => 0, type => 'hash', keys => { - ign_votes => { anybool => 1 }, - map +("perm_$_" => { anybool => 1 }), VNWeb::Auth::listPerms + timezone => { default => '', enum => \%ZONES }, + max_sexual => { int => 1, range => [-1, 2 ] }, + max_violence => { uint => 1, range => [ 0, 2 ] }, + spoilers => { uint => 1, range => [ 0, 2 ] }, + titles => { titleprefs => 1 }, + alttitles => { titleprefs => 1 }, + tags_all => { anybool => 1 }, + tags_cont => { anybool => 1 }, + tags_ero => { anybool => 1 }, + tags_tech => { anybool => 1 }, + vnrel_langs => { default => undef, type => 'array', values => { enum => \%LANGUAGE }, sort => 'str', unique => 1 }, + vnrel_olang => { anybool => 1 }, + vnrel_mtl => { anybool => 1 }, + staffed_langs => { default => undef, type => 'array', values => { enum => \%LANGUAGE }, sort => 'str', unique => 1 }, + staffed_olang => { anybool => 1 }, + staffed_unoff => { anybool => 1 }, + traits_sexual => { anybool => 1 }, + prodrelexpand => { anybool => 1 }, + skin => { enum => skins }, + customcss => { default => '', maxlength => 256*1024 }, + customcss_csum => { anybool => 1 }, + + tagprefs => { sort_keys => 'tid', maxlength => 500, aoh => { + tid => { vndbid => 'g' }, + spoil => { default => undef, int => 1, range => [ 0, 3 ] }, + color => { default => undef, regex => qr/^(standout|grayedout|#[a-fA-F0-9]{6})$/ }, + childs => { anybool => 1 }, + name => {}, } }, - # Settings that can only be read/modified by the user itself or a perm_usermod - prefs => { required => 0, type => 'hash', keys => { - email => { email => 1 }, - max_sexual => { int => 1, range => [-1, 2 ] }, - max_violence => { uint => 1, range => [ 0, 2 ] }, - traits_sexual => { anybool => 1 }, - tags_all => { anybool => 1 }, - tags_cont => { anybool => 1 }, - tags_ero => { anybool => 1 }, - tags_tech => { anybool => 1 }, - spoilers => { uint => 1, range => [ 0, 2 ] }, - skin => { enum => skins }, - customcss => { required => 0, default => '', maxlength => 2000 }, - - # Supporter options - nodistract_noads => { anybool => 1 }, - nodistract_nofancy => { anybool => 1 }, - support_enabled => { anybool => 1 }, - uniname => { required => 0, default => '', regex => qr/^.{2,15}$/ }, # Use regex to check length, HTML5 `maxlength` attribute counts UTF-16 code units... - pubskin_enabled => { anybool => 1 }, + traitprefs => { sort_keys => 'tid', maxlength => 500, aoh => { + tid => { vndbid => 'i' }, + spoil => { default => undef, int => 1, range => [ 0, 3 ] }, + color => { default => undef, regex => qr/^(standout|grayedout|#[a-fA-F0-9]{6})$/ }, + childs => { anybool => 1 }, + name => {}, + group => { default => undef }, } }, - password => { _when => 'in', required => 0, type => 'hash', keys => { - old => { password => 1 }, - new => { password => 1 } + api2 => { maxlength => 64, aoh => { + token => {}, + added => {}, + lastused => { default => '' }, + notes => { default => '', sl => 1, maxlength => 200 }, + listread => { anybool => 1 }, + listwrite => { anybool => 1 }, + delete => { anybool => 1 }, } }, }; @@ -61,106 +91,111 @@ my $FORM_IN = form_compile in => $FORM; my $FORM_OUT = form_compile out => $FORM; - sub _getmail { my $uid = shift; tuwf->dbVali(select => sql_func user_getmail => \$uid, \auth->uid, sql_fromhex auth->token); } +sub _namethrottled { + my($uid) = @_; + !auth->permUsermod && tuwf->dbVali('SELECT 1 FROM users_username_hist WHERE id =', \$uid, 'AND date > NOW()-\'1 day\'::interval') +} + TUWF::get qr{/$RE{uid}/edit}, sub { - my $u = tuwf->dbRowi('SELECT id, username FROM users WHERE id =', \tuwf->capture('id')); + my $u = tuwf->dbRowi( + 'SELECT u.id, username, max_sexual, max_violence, traits_sexual, tags_all, tags_cont, tags_ero, tags_tech, prodrelexpand + , vnrel_langs::text[], vnrel_olang, vnrel_mtl, staffed_langs::text[], staffed_olang, staffed_unoff + , spoilers, skin, customcss, customcss_csum, timezone, titles + , nodistract_can, support_can, uniname_can, pubskin_can + , nodistract_noads, nodistract_nofancy, support_enabled, uniname, pubskin_enabled + FROM users u JOIN users_prefs up ON up.id = u.id WHERE u.id =', \tuwf->capture('id') + ); return tuwf->resNotFound if !$u->{id} || !can_edit u => $u; - $u->{opts} = tuwf->dbRowi('SELECT nodistract_can, support_can, uniname_can, pubskin_can FROM users WHERE id =', \$u->{id}); - $u->{opts}{perm_dbmod} = auth->permDbmod; - $u->{opts}{perm_usermod} = auth->permUsermod; - $u->{opts}{perm_tagmod} = auth->permTagmod; - $u->{opts}{perm_boardmod} = auth->permBoardmod; + $u->{editor_usermod} = auth->permUsermod; + $u->{username_throttled} = _namethrottled $u->{id}; + $u->{email} = _getmail $u->{id}; + $u->{password} = undef; - $u->{prefs} = $u->{id} eq auth->uid || auth->permUsermod ? - tuwf->dbRowi( - 'SELECT max_sexual, max_violence, traits_sexual, tags_all, tags_cont, tags_ero, tags_tech, spoilers, skin, customcss - , nodistract_noads, nodistract_nofancy, support_enabled, uniname, pubskin_enabled - FROM users WHERE id =', \$u->{id} - ) : undef; - $u->{prefs}{email} = _getmail $u->{id} if $u->{prefs}; - $u->{prefs}{skin} ||= config->{skin_default} if $u->{prefs}; + $u->{traits} = tuwf->dbAlli('SELECT u.tid, t.name, g.name AS "group" FROM users_traits u JOIN traits t ON t.id = u.tid LEFT JOIN traits g ON g.id = t.gid WHERE u.id =', \$u->{id}, 'ORDER BY g.gorder, t.name'); + $u->{timezone} ||= 'UTC'; + @{$u}{'titles','alttitles'} = @{ titleprefs_parse($u->{titles}) // $DEFAULT_TITLE_PREFS }; + $u->{skin} ||= config->{skin_default}; - $u->{admin} = auth->permDbmod || auth->permUsermod || auth->permTagmod || auth->permBoardmod ? - tuwf->dbRowi('SELECT ign_votes, ', sql_comma(map "perm_$_", auth->listPerms), 'FROM users u JOIN users_shadow us ON us.id = u.id WHERE u.id =', \$u->{id}) : undef; + $u->{tagprefs} = tuwf->dbAlli('SELECT u.tid, u.spoil, u.color, u.childs, t.name FROM users_prefs_tags u JOIN tags t ON t.id = u.tid WHERE u.id =', \$u->{id}, 'ORDER BY t.name'); + $u->{traitprefs} = tuwf->dbAlli('SELECT u.tid, u.spoil, u.color, u.childs, t.name, g.name as "group" FROM users_prefs_traits u JOIN traits t ON t.id = u.tid LEFT JOIN traits g ON g.id = t.gid WHERE u.id =', \$u->{id}, 'ORDER BY g.gorder, t.name'); - $u->{password} = undef; + $u->{api2} = auth->api2_tokens($u->{id}); - $u->{title} = $u->{id} eq auth->uid ? 'My Account' : "Edit $u->{username}"; - framework_ title => $u->{title}, dbobj => $u, tab => 'edit', + my $title = $u->{id} eq auth->uid ? 'My Account' : "Edit $u->{username}"; + framework_ title => $title, dbobj => $u, tab => 'edit', sub { - elm_ 'User.Edit', $FORM_OUT, $u; + article_ sub { + h1_ $title; + }; + div_ widget(UserEdit => $FORM_OUT, $u), ''; }; }; -elm_api UserEdit => $FORM_OUT, $FORM_IN, sub { +js_api UserEdit => $FORM_IN, sub { my $data = shift; - my $username = tuwf->dbVali('SELECT username FROM users WHERE id =', \$data->{id}); - return tuwf->resNotFound if !$username; - return elm_Unauth if !can_edit u => $data; + my $u = tuwf->dbRowi('SELECT id, username FROM users WHERE id =', \$data->{id}); + return tuwf->resNotFound if !$u->{id}; + return tuwf->resDenied if !can_edit u => $u; - my $own = $data->{id} eq auth->uid || auth->permUsermod; - my %set; + my(%set, %setp); - if($own) { - my $p = $data->{prefs}; - $p->{skin} = '' if $p->{skin} eq config->{skin_default}; - $p->{uniname} = '' if $p->{uniname} eq $username; - return elm_Taken if $p->{uniname} && tuwf->dbVali('SELECT 1 FROM users WHERE id <>', \$data->{id}, 'AND username =', \lc($p->{uniname})); + $data->{uniname} = '' if $data->{uniname} eq $u->{username}; + return +{ code => 'uniname', _err => 'Display name already taken.' } + if $data->{uniname} && tuwf->dbVali('SELECT 1 FROM users WHERE id <>', \$data->{id}, 'AND lower(username) =', \lc($data->{uniname})); - $set{$_} = $p->{$_} for qw/ - max_sexual max_violence traits_sexual tags_all tags_cont tags_ero tags_tech spoilers skin customcss - nodistract_noads nodistract_nofancy support_enabled uniname pubskin_enabled - /; - } + $data->{skin} = '' if $data->{skin} eq config->{skin_default}; + $data->{timezone} = '' if $data->{timezone} eq 'UTC'; + $data->{titles} = titleprefs_fmt [ $data->{titles}, delete $data->{alttitles} ]; + $data->{titles} = undef if $data->{titles} eq titleprefs_fmt $DEFAULT_TITLE_PREFS; + + $data->{vnrel_langs} = !$data->{vnrel_langs} || $data->{vnrel_langs}->@* == keys %LANGUAGE ? undef : '{'.join(',',$data->{vnrel_langs}->@*).'}'; + $data->{staffed_langs} = !$data->{staffed_langs} || $data->{staffed_langs}->@* == keys %LANGUAGE ? undef : '{'.join(',',$data->{staffed_langs}->@*).'}'; + + $set{$_} = $data->{$_} for qw/nodistract_noads nodistract_nofancy support_enabled uniname pubskin_enabled/; + $setp{$_} = $data->{$_} for qw/ + tags_all tags_cont tags_ero tags_tech + vnrel_langs vnrel_olang vnrel_mtl staffed_langs staffed_olang staffed_unoff + skin customcss timezone max_sexual max_violence spoilers traits_sexual prodrelexpand titles + /; + $setp{customcss_csum} = $data->{customcss_csum} && length $data->{customcss} ? unpack 'q', sha1 do { utf8::encode(local $_=$data->{customcss}); $_ } : 0; + + $set{email_confirmed} = 1 if auth->permUsermod; - if(auth->permUsermod) { + if($data->{username} ne $u->{username}) { + return +{ _err => 'You can only change your username once a day.' } if _namethrottled $data->{id}; + return +{ code => 'username_taken', _err => 'Username already taken.' } if !is_unique_username $data->{username}, $data->{id}; $set{username} = $data->{username}; - $set{ign_votes} = $data->{admin}{ign_votes}; - $set{email_confirmed} = 1; - tuwf->dbExeci(select => sql_func user_setperm_usermod => \$data->{id}, \auth->uid, sql_fromhex(auth->token), \$data->{admin}{perm_usermod}); - $set{"perm_$_"} = $data->{admin}{"perm_$_"} for grep $_ ne 'usermod', auth->listPerms; + auth->audit($data->{id}, 'username change', "old=$u->{username}; new=$data->{username}"); + tuwf->dbExeci('INSERT INTO users_username_hist', { id => $data->{id}, old => $u->{username}, new => $data->{username} }); } - $set{perm_board} = $data->{admin}{perm_board} if auth->permBoardmod; - $set{perm_review} = $data->{admin}{perm_review} if auth->permBoardmod; - $set{perm_edit} = $data->{admin}{perm_edit} if auth->permDbmod; - $set{perm_imgvote} = $data->{admin}{perm_imgvote} if auth->permDbmod; - $set{perm_lengthvote} = $data->{admin}{perm_lengthvote} if auth->permDbmod; - $set{perm_tag} = $data->{admin}{perm_tag} if auth->permTagmod; - - if($own && $data->{password}) { - return elm_InsecurePass if is_insecurepass $data->{password}{new}; - - my $ok = 1; - if(auth->uid eq $data->{id}) { - $ok = 0 if !auth->setpass($data->{id}, undef, $data->{password}{old}, $data->{password}{new}); - } else { - tuwf->dbExeci(select => sql_func user_admin_setpass => \$data->{id}, \auth->uid, - sql_fromhex(auth->token), sql_fromhex auth->_preparepass($data->{password}{new}) - ); - } + + if($data->{password}) { + return +{ code => 'npass', _err => 'Your new password is in a public database of leaked passwords, please choose a different password.' } + if is_insecurepass $data->{password}{new}; + my $ok = auth->setpass($data->{id}, undef, $data->{password}{old}, $data->{password}{new}); auth->audit($data->{id}, $ok ? 'password change' : 'bad password', 'at user edit form'); - return elm_BadCurPass if !$ok; + return +{ code => 'opass', _err => 'Incorrect password' } if !$ok; } - my $ret = \&elm_Success; + my $ret = {ok=>1}; - my $newmail = $own && $data->{prefs}{email}; - my $oldmail = $own && _getmail $data->{id}; - if($own && $newmail ne $oldmail) { - return elm_DoubleEmail if tuwf->dbVali('SELECT 1 FROM user_emailtoid(', \$newmail, ') x(id) WHERE id <>', \$data->{id}); - auth->audit($data->{id}, 'email change', "old=$oldmail; new=$newmail"); + my $oldmail = _getmail $data->{id}; + if ($oldmail ne $data->{email}) { + return +{ code => 'email_taken', _err => 'E-Mail address already in use by another account' } + if tuwf->dbVali('SELECT 1 FROM user_emailtoid(', \$data->{email}, ') x(id) WHERE id <>', \$data->{id}); + auth->audit($data->{id}, 'email change', "old=$oldmail; new=$data->{email}"); if(auth->permUsermod) { - tuwf->dbExeci(select => sql_func user_admin_setmail => \$data->{id}, \auth->uid, sql_fromhex(auth->token), \$newmail); + tuwf->dbExeci(select => sql_func user_admin_setmail => \$data->{id}, \auth->uid, sql_fromhex(auth->token), \$data->{email}); } else { - my $token = auth->setmail_token($newmail); + my $token = auth->setmail_token($data->{email}); my $body = sprintf "Hello %s," ."\n\n" @@ -169,27 +204,51 @@ elm_api UserEdit => $FORM_OUT, $FORM_IN, sub { ."%s" ."\n\n" ."vndb.org", - $username, $oldmail, $newmail, tuwf->reqBaseURI()."/$data->{id}/setmail/$token"; + $u->{username}, $oldmail, $data->{email}, tuwf->reqBaseURI()."/$data->{id}/setmail/$token"; tuwf->mail($body, - To => $newmail, + To => $data->{email}, From => 'VNDB <noreply@vndb.org>', - Subject => "Confirm e-mail change for $username", + Subject => "Confirm e-mail change for $u->{username}", ); - $ret = \&elm_MailChange; + $ret = {email=>1}; } } - my $old = tuwf->dbRowi('SELECT', sql_comma(keys %set), 'FROM users WHERE id =', \$data->{id}); - tuwf->dbExeci('UPDATE users SET', \%set, 'WHERE id =', \$data->{id}); - my $new = tuwf->dbRowi('SELECT', sql_comma(keys %set), 'FROM users WHERE id =', \$data->{id}); + tuwf->dbExeci('DELETE FROM users_traits WHERE id =', \$data->{id}); + tuwf->dbExeci('INSERT INTO users_traits', { id => $data->{id}, tid => $_->{tid} }) for $data->{traits}->@*; + + tuwf->dbExeci('DELETE FROM users_prefs_tags WHERE id =', \$data->{id}); + tuwf->dbExeci('INSERT INTO users_prefs_tags', { id => $data->{id}, %{$_}{qw|tid spoil color childs|} }) for $data->{tagprefs}->@*; + + tuwf->dbExeci('DELETE FROM users_prefs_traits WHERE id =', \$data->{id}); + tuwf->dbExeci('INSERT INTO users_prefs_traits', { id => $data->{id}, %{$_}{qw|tid spoil color childs|} }) for $data->{traitprefs}->@*; + + my %tokens = map +($_->{token},$_), $data->{api2}->@*; + for (auth->api2_tokens($data->{id})->@*) { + my $t = $tokens{$_->{token}} // next; + $t->{listwrite} = 0 if !$t->{listread}; + if($t->{delete}) { + auth->api2_del_token($data->{id}, $t->{token}); + } elsif($t->{notes} ne $_->{notes} + || !$t->{listread} ne !$_->{listread} + || !$t->{listwrite} ne !$_->{listwrite}) { + auth->api2_set_token($data->{id}, %$t); + } + } - $_ = JSON::XS->new->allow_nonref->encode($_) for values %$old, %$new; - my @diff = grep $old->{$_} ne $new->{$_}, keys %set; - auth->audit($data->{id}, 'user edit', join '; ', map "$_: $old->{$_} -> $new->{$_}", @diff) - if @diff && (auth->uid ne $data->{id} || grep /^(perm_|ign_votes|username)/, @diff); + my $old = tuwf->dbRowi('SELECT', sql_comma(keys %set, keys %setp), 'FROM users u JOIN users_prefs up ON up.id = u.id WHERE u.id =', \$data->{id}); + tuwf->dbExeci('UPDATE users SET', \%set, 'WHERE id =', \$data->{id}) if keys %set; + tuwf->dbExeci('UPDATE users_prefs SET', \%setp, 'WHERE id =', \$data->{id}) if keys %setp; + my $new = tuwf->dbRowi('SELECT', sql_comma(keys %set, keys %setp), 'FROM users u JOIN users_prefs up ON up.id = u.id WHERE u.id =', \$data->{id}); - $ret->(); + if (auth->uid ne $data->{id}) { + $_ = JSON::XS->new->allow_nonref->encode($_) for values %$old, %$new; + my @diff = grep $old->{$_} ne $new->{$_}, keys %set, keys %setp; + auth->audit($data->{id}, 'user edit', join '; ', map "$_: $old->{$_} -> $new->{$_}", @diff) if @diff; + } + + return $ret; }; @@ -197,7 +256,7 @@ TUWF::get qr{/$RE{uid}/setmail/(?<token>[a-f0-9]{40})}, sub { my $success = auth->setmail_confirm(tuwf->capture('id'), tuwf->capture('token')); my $title = $success ? 'E-mail confirmed' : 'Error confirming email'; framework_ title => $title, sub { - div_ class => 'mainbox', sub { + article_ sub { h1_ $title; div_ class => $success ? 'notice' : 'warning', sub { p_ "Your e-mail address has been updated!" if $success; @@ -207,4 +266,9 @@ TUWF::get qr{/$RE{uid}/setmail/(?<token>[a-f0-9]{40})}, sub { }; }; + +js_api UserApi2New => { id => { vndbid => 'u' }}, sub { + +{ token => auth->api2_set_token($_[0]{id}), added => strftime '%Y-%m-%d', localtime } +}; + 1; |