summaryrefslogtreecommitdiff
path: root/lib/VNWeb/User/Edit.pm
diff options
context:
space:
mode:
Diffstat (limited to 'lib/VNWeb/User/Edit.pm')
-rw-r--r--lib/VNWeb/User/Edit.pm312
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;