PciIds/Html/Users.pm

   1 #       PciIds web database
   2 #       Copyright (C) 2008 Michal Vaner (vorner@ucw.cz)
   3 #
   4 #       This program is free software; you can redistribute it and/or modify
   5 #       it under the terms of the GNU General Public License as published by
   6 #       he Free Software Foundation; either version 2 of the License, or
   7 #       (at your option) any later version.
   8 #
   9 #       This program is distributed in the hope that it will be useful,
  10 #       but WITHOUT ANY WARRANTY; without even the implied warranty of
  11 #       MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  12 #
  13 #       GNU General Public License for more details.
  14 #
  15 #       You should have received a copy of the GNU General Public License
  16 #       along with this program; if not, write to the Free Software
  17 #       Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA
  18
  19 package PciIds::Html::Users;
  20 use strict;
  21 use warnings;
  22 use PciIds::Html::Util;
  23 use PciIds::Html::Forms;
  24 use PciIds::Email;
  25 use PciIds::Users;
  26 use PciIds::Address;
  27 use CGI;
  28 use CGI::Cookie;
  29 use Apache2::Const qw(:common);
  30 use Apache2::SubRequest;
  31 use APR::Table;
  32
  33 use base 'Exporter';
  34
  35 our @EXPORT = qw(&checkLogin &notLoggedComplaint);
  36
  37 sub genRegisterForm( $$$$ ) {
  38         my( $req, $args, $error, $values ) = @_;
  39         genHtmlHead( $req, 'Register a new user', undef );
  40         genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Register a new user', [ [ 'Help', 'help', 'account' ] ], [ [ 'Log in', 'login' ] ] );
  41         print '<div class="error">'.$error.'</div>' if( defined $error );
  42         print '<form name="register" id="register" method="POST" action="">
  43                 <table>';
  44         genForm( [ [ 'Email:', 'text', 'email', 'maxlength="255"' ],
  45                 [ '', 'submit', 'register', 'value="Register"' ] ], $values );
  46         print '</table></form>';
  47         genHtmlFooter( 0, undef, undef );
  48         return OK;
  49 }
  50
  51 sub registerForm( $$ ) {#Form for registering a new user
  52         my( $req, $args ) = @_;
  53         return genRegisterForm( $req, $args, undef, {} );
  54 }
  55
  56 sub loginCheck( $$ ) {
  57         my( $login, $tables ) = @_;
  58         return undef if( ( not defined $login ) || ( $login eq '' ) );#empty login is ok
  59         return 'Login too long' if( ( length $login ) > 50 );
  60         return 'Login contains invalid characters' unless( $login =~ /^[-_a-zA-Z0-9]+$/ );
  61         return 'This login already exists' if( $tables->hasLogin( $login ) );
  62         return undef;
  63 }
  64
  65 sub registerSubmit( $$$ ) {#A registration form has been submited
  66         my( $req, $args, $tables ) = @_;
  67         my( $data, $error ) = getForm( {
  68                 'email' => sub {
  69                         return emailCheck( shift, $tables );
  70                 }
  71         }, [] );
  72         return genRegisterForm( $req, $args, $error, $data ) if( defined $error );
  73         my $site = $req->hostname();
  74         my $url = 'https://'.$req->hostname().setAddrPrefix( $req->uri(), 'mods' );
  75         sendMail( $data->{'email'}, 'Confirm registration', "Someone, probably you, requested registration of this address\n".
  76                 "for the $site site. If it wasn't you, please ignore this email message.\n".
  77                 "\nOtherwise, please continue by filling in the form at this address:".
  78                 "\n".$url.'?action=register-confirm?email='.$data->{'email'}.'?confirm='.emailConfirm( $data->{'email'} )."\n".
  79                 "\nThank you\n".
  80                 "\n(This is an autogenerated email, do not respond to it)" );
  81         genHtmlHead( $req, 'Registration email sent', undef );
  82         genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Registration email sent', [ [ 'Help', 'help', 'account' ] ], [ [ 'Log in', 'login' ] ] );
  83         print "<div class='clear'></div></div>\n";
  84         print '<p>
  85                         An email containing further information has been sent to you.
  86                         Please follow these instruction to finish the registration process.';
  87         genHtmlFooter( 0, undef, undef );
  88         return OK;
  89 }
  90
  91 sub genConfirmForm( $$$$ ) {
  92         my( $req, $args, $error, $values ) = @_;
  93         genHtmlHead( $req, 'Confirm registration', undef );
  94         genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Confirm registration', [ [ 'Help', 'help', 'account' ] ], [ [ 'Register', 'register' ] ] );
  95         print '<div class="error">'.$error.'</div>' if( defined $error );
  96         print '<p>Email address: '.encode( $values->{'email'} );
  97         print '<form name="register-confirm" id="register-confirm" method="POST" action="">';
  98         print '<div class="hidden"><p><input type="hidden" value="'.encode( $values->{'email'} ).'" name="email"><input type="hidden" value="'.encode( $values->{'confirm'} ).'" name="confirm"></div>';
  99         print '<table>';
 100         genForm( [ [ 'Login (Optional):', 'text', 'login', 'maxlength="50"' ],
 101                 [ 'Password:', 'password', 'password' ],
 102                 [ 'Confirm password:', 'password', 'confirm_password' ],
 103                 [ '', 'submit', 'register', 'value=Register' ] ], $values );
 104         print '</table></form>';
 105         genHtmlFooter( 0, undef, undef );
 106         return OK;
 107 }
 108
 109 sub usedAddress( $$ ) {
 110         my( $req, $args ) = @_;
 111         genHtmlHead( $req, 'Used address', undef );
 112         genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Used address', [ [ 'Help', 'help', 'account' ] ], [ [ 'Log in', 'login' ], [ 'Reset password', 'respass' ], [ 'Register', 'register' ] ] );
 113         print '<div class="error">
 114                 <p>
 115                         An account for this address is already registered.
 116                         Please, reset or remember your password or start again with a different address.
 117                 </div>';
 118         genHtmlFooter( 0, undef, undef );
 119         return 0;
 120 }
 121
 122 sub checkRegHash( $$$$$ ) {
 123         my( $req, $args, $tables, $email, $hash ) = @_;
 124         if( ! checkConfirmHash( $email, $hash ) ) {
 125                 genHtmlHead( $req, 'Invalid registration request', undef );
 126                 print '<h1>Invalid registration request</h1>
 127                         <div class="error">
 128                         <p>
 129                                 This registration request is invalid.
 130                                 Are you sure you got it from the registration email?
 131                         </div>';
 132                 genHtmlFooter( 0, undef, undef );
 133                 return 0;
 134         } elsif( $tables->hasEmail( $email ) ) {
 135                 return usedAddress( $req, $args );
 136         } else {
 137                 return 1;
 138         }
 139 }
 140
 141 sub confirmForm( $$$$ ) {
 142         my( $req, $args, $tables, $auth ) = @_;
 143         return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'};
 144         if( ! checkRegHash( $req, $args, $tables, $args->{'email'}, $args->{'confirm'} ) ) {
 145                 return OK;
 146         } else {
 147                 return genConfirmForm( $req, $args, undef, $args );
 148         }
 149 }
 150
 151 sub passLenCheck( $ ) {
 152         my( $pass ) = @_;
 153         return ( ( length $pass ) >= 4 ) ? undef : 'Password must have at least 4 characters';
 154 }
 155
 156 sub passSameCheck( $ ) {
 157         my( $data ) = @_;
 158         return ( ( ( defined $data->{'password'} ) != ( defined $data->{'confirm_password'} ) ) || ( ( defined $data->{'password'} ) && ( $data->{'password'} ne $data->{'confirm_password'} ) ) ) ? 'Passwords do not match' : undef;
 159 }
 160
 161 sub confirmSubmit( $$$ ) {
 162         my( $req, $args, $tables ) = @_;
 163         my( $data, $error ) = getForm( {
 164                 'email' => sub {
 165                         return emailCheck( shift, $tables );
 166                 },
 167                 'confirm' => undef,
 168                 'login' => sub {
 169                         return loginCheck( shift, $tables );
 170                 },
 171                 'password' => \&passLenCheck,
 172                 'confirm_password' => undef }, [ \&passSameCheck ] );
 173         return OK if( ! checkRegHash( $req, $args, $tables, $data->{'email'}, $data->{'confirm'} ) );#Not much info, but this is an attack anyway
 174         return genConfirmForm( $req, $args, $error, $data ) if( defined $error );
 175         unless( addUser( $tables, $data->{'login'}, $data->{'email'}, $data->{'password'} ) ) {
 176                 usedAddress( $req, $args );
 177                 return OK;
 178         }
 179         genHtmlHead( $req, 'Registered', undef );
 180         genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Registered', [ [ 'Help', 'help', 'account' ] ], [ [ 'Log in', 'login' ] ] );
 181         print '<p>
 182                         You have registered successfully.';
 183         genHtmlFooter( 0, undef, undef );
 184         return OK;
 185 }
 186
 187 sub genLoginForm( $$$$ ) {
 188         my( $req, $args, $error, $values ) = @_;
 189         $req->headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'cookie-test', -value => 1 ) );
 190         genHtmlHead( $req, 'Log in', undef );
 191         genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Log in', [ [ 'Help', 'help', 'account' ] ], [ [ 'Register', 'register' ], [ 'Reset password', 'respass' ] ] );
 192         print '<div class="error"><p>'.$error.'</div>' if( defined $error );
 193         print '<form name="login" id="login" method="POST" action="'.setAddrPrefix( $req->uri(), 'mods' ).buildExcept( 'action', $args ).'?action=login"><table>';
 194         genForm( [ [ 'Login name or email:', 'text', 'login', 'maxlength="255"' ],
 195                 [ 'Password:', 'password', 'password' ],
 196                 [ '', 'submit', 'login', 'value="Login"' ] ], $values );
 197         print '</table></form>';
 198         genHtmlFooter( 0, undef, undef );
 199         return OK;
 200 }
 201
 202 sub loginForm( $$$ ) {
 203         my( $req, $args, $tables, $auth ) = @_;
 204         return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless( $auth->{'ssl'} );
 205         return genLoginForm( $req, $args, undef, {} );
 206 }
 207
 208 sub loginSubmit( $$$ ) {
 209         my( $req, $args, $tables ) = @_;
 210         my( $data, $error ) = getForm( {
 211                 'login' => undef,
 212                 'password' => undef
 213         }, [] );
 214         my $logged = 0;
 215         my $cookies = fetch CGI::Cookie;
 216         unless( $cookies->{'cookie-test'} ) {
 217                 return genLoginForm( $req, $args, 'You need to enable cookies', $data );
 218         }
 219         my( $id, $passwd, $email, $last ) = $tables->getLogInfo( $data->{'login'} );
 220         if( defined $passwd && defined $data->{'password'} ) {
 221                 my $salted = saltedPasswd( $email, $data->{'password'} );
 222                 $logged = $salted eq $passwd;
 223         }
 224         if( $logged ) {
 225                 $req->err_headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'auth', -value => genAuthToken( $tables, $id, $req, undef, $email ) ) );
 226                 $args->{'action'} = ( defined $args->{'redirectaction'} && $args->{'redirectaction'} ne '' ) ? $args->{'redirectaction'} : 'list';
 227                 my $url = 'https://'.$req->hostname().setAddrPrefix( $req->uri(), $args->{'action'} eq 'list' ? 'read' : 'mods' ).buildExcept( 'redirectaction', $args );
 228                 return HTTPRedirect( $req, $url );
 229         } else {
 230                 return genLoginForm( $req, $args, 'Invalid login credetials', $data );
 231         }
 232 }
 233
 234 sub logout( $$ ) {
 235         my( $req, $args ) = @_;
 236         $req->err_headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'auth', -value => '0' ) );
 237         return HTTPRedirect( $req, 'http://'.$req->hostname().setAddrPrefix( $req->uri(), 'read' ).buildExcept( 'action', $args ) );
 238 }
 239
 240 sub checkLogin( $$ ) {
 241         my( $req, $tables ) = @_;
 242         my $cookies = fetch CGI::Cookie;
 243         my $cookie = $cookies->{'auth'};
 244         my( $authed, $id, $regen, $rights, $error, $name ) = checkAuthToken( $tables, $req, defined( $cookie ) ? $cookie->value : undef );
 245         if( $regen ) {
 246                 $req->headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'auth', -value => genAuthToken( $tables, $id, $req, $rights, $name ) ) );
 247         }
 248         my $hterror = $authed ? '' : '<div class="error"><p>'.$error.'</div>';
 249         return { 'authid' => $authed ? $id : undef, 'accrights' => $rights, 'logerror' => $hterror, 'name' => $authed ? $name : undef };
 250 }
 251
 252 sub notLoggedComplaint( $$$ ) {
 253         my( $req, $args, $auth ) = @_;
 254         return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'};
 255         $args->{'redirectaction'} = $args->{'action'};
 256         return genLoginForm( $req, $args, 'This action requires you to be logged in', undef );
 257 }
 258
 259 sub genResetPasswdForm( $$$$ ) {
 260         my( $req, $args, $error, $values ) = @_;
 261         genHtmlHead( $req, 'Reset password', undef );
 262         genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Reset password', [ [ 'Help', 'help', 'account' ] ], [ [ 'Log in', 'login' ], [ 'Register', 'register' ] ] );
 263         print "<p>If you forgot your password (or didn't create one yet), you can reset it to a new value here.\n";
 264         print "Provide your email address here and further instructions will be sent to you.\n";
 265         print '<div class="error">'.$error.'</div>' if( defined $error );
 266         print '<form name="respass" id="respass" method="POST" action="">
 267                 <table>';
 268         genForm( [ [ 'Email:', 'text', 'email', 'maxlength="255"' ],
 269                 [ '', 'submit', 'respass', 'value="Send"' ] ], $values );
 270         print '</table></form>';
 271         genHtmlFooter( 0, undef, undef );
 272         return OK;
 273 }
 274
 275 sub resetPasswdForm( $$$$ ) {
 276         my( $req, $args ) = @_;
 277         return genResetPasswdForm( $req, $args, undef, {} );
 278 }
 279
 280 sub resetPasswdFormSubmit( $$$ ) {
 281         my( $req, $args, $tables ) = @_;
 282         my( $data, $error ) = getForm( {
 283                 'email' => undef
 284         }, [] );
 285         my( $id, $login, $passwd ) = $tables->resetInfo( $data->{'email'} );
 286         if( defined( $id ) ) {
 287                 $login = '' unless( defined( $login ) );
 288                 my $site = $req->hostname();
 289                 my $url = 'https://'.$req->hostname().setAddrPrefix( $req->uri(), 'mods' );
 290                 my $hash = genResetHash( $id, $data->{'email'}, $login, $passwd );
 291                 sendMail( $data->{'email'}, 'Reset password',
 292                         "A request to reset password for the $site site was received for this address\n".
 293                         "If you really wish to get a new password, visit this link:\n\n".
 294                         $url.'?action=respass-confirm?email='.$data->{'email'}.'?confirm='.$hash."\n".
 295                         "\n\nThank you\n".
 296                         "\n(This is an autogenerated email, do not respond to it)" );
 297                 genHtmlHead( $req, 'Reset password', undef );
 298                 genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Reset password', [ [ 'Help', 'help', 'account' ] ], [ [ 'Log in', 'login' ] ] );
 299                 print "<p>An email with information has been sent to your address.\n";
 300                 genHtmlFooter( 0, undef, undef );
 301                 return OK;
 302         } else {
 303                 $error = '<p>This email address is not registered. Check it for typos or register it.';
 304         }
 305         return genResetPasswdForm( $req, $args, $error, $data ) if( defined( $error ) );
 306 }
 307
 308 sub genResetPasswdConfigForm( $$$$$$ ) {
 309         my( $req, $args, $error, $values, $email, $hash ) = @_;
 310         genHtmlHead( $req, 'Reset password', undef );
 311         genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Reset password', [ [ 'Help', 'help', 'account' ] ], [ [ 'Log in', 'login' ] ] );
 312         print '<div class="error">'.$error.'</div>' if( defined $error );
 313         print "<p>You can enter new password here:\n";
 314         print '<form name="respass-confirm" id="respass-confirm" method="POST" action="">
 315                 <table>';
 316         genForm( [ [ 'Password:', 'password', 'password' ],
 317                 [ 'Confirm password:', 'password', 'confirm_password' ],
 318                 [ '', 'submit', 'respass', 'value="Send"' ] ], $values );
 319         print "</table>";
 320         print "<input type='hidden' name='email' value='".encode( $email )."'><input type='hidden' name='hash' value='".encode( $hash )."'>\n";
 321         print "</form>\n";
 322         genHtmlFooter( 0, undef, undef );
 323         return OK;
 324 }
 325
 326 sub resetPasswdConfirmForm( $$$$ ) {
 327         my( $req, $args, $tables, $auth ) = @_;
 328         my( $email, $hash ) = ( $args->{'email'}, $args->{'confirm'} );
 329         my( $id, $login, $passwd ) = $tables->resetInfo( $email );
 330         my $myHash;
 331         return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'};
 332         $myHash = genResetHash( $id, $email, $login, $passwd ) if( defined( $id ) );
 333         if( defined( $myHash ) && ( $myHash eq $hash ) ) {#Ok, it is his mail and he asked
 334                 return genResetPasswdConfigForm( $req, $args, undef, {}, $email, $hash );
 335         } else {
 336                 genHtmlHead( $req, 'Reset password', undef );
 337                 print "<h1>Reset password</h1>\n";
 338                 print "<p>Provided link is not valid. Did you use it already?\n";
 339                 print "<p>You can get a <a href='".$req->uri()."?action=respass'>new one</a>.\n";
 340                 genHtmlFooter( 0, undef, undef );
 341                 return OK;
 342         }
 343 }
 344
 345 sub resetPasswdConfirmFormSubmit( $$$ ) {
 346         my( $req, $args, $tables ) = @_;
 347         my( $data, $error ) = getForm( {
 348                 'password' => \&passLenCheck,
 349                 'confirm_password' => undef,
 350                 'email' => undef,
 351                 'hash' => undef
 352         }, [ \&passSameCheck ] );
 353         my( $email, $hash ) = ( $data->{'email'}, $args->{'confirm'} );
 354         if( defined( $error ) ) {
 355                 return genResetPasswdConfigForm( $req, $args, $error, $data, $email, $hash );
 356         } else {
 357                 my( $id, $login, $passwd ) = $tables->resetInfo( $email );
 358                 my $myHash;
 359                 $myHash = genResetHash( $id, $email, $login, $passwd ) if( defined( $id ) );
 360                 if( defined( $myHash ) && ( $myHash eq $hash ) ) {
 361                         changePasswd( $tables, $id, $data->{'password'}, $email );
 362                         genHtmlHead( $req, 'Reset password', undef );
 363                         genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Reset password', [ [ 'Help', 'help', 'account' ] ], [ [ 'Log in', 'login' ] ] );
 364                         print "<p>Your password was successfuly changed.\n";
 365                         genHtmlFooter( 0, undef, undef );
 366                         return OK;
 367                 } else {
 368                         return genResetPasswdConfigForm( $req, $args, $error, $data, $email, $hash );
 369                 }
 370         }
 371 }
 372
 373 sub genProfileForm( $$$$$$ ) {
 374         my( $req, $args, $auth, $error, $data, $info ) = @_;
 375         genHtmlHead( $req, 'User profile', undef );
 376         delete $data->{'current_password'};
 377         delete $data->{'confirm_password'};
 378         delete $data->{'password'};
 379         genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'User profile', [ [ 'Help', 'help', 'profile' ] ], [ logItem( $auth ), [ 'Notifications', 'notifications' ] ] );
 380         print '<div class="error"><p>'.$error.'</div>' if defined $error;
 381         print "<div class='info'><p>$info</div>\n" if defined $info;
 382         print '<form name="profile" id="profile" method="POST" action=""><table>';
 383         genForm( [ [ 'Email:', 'text', 'email', 'maxlength="255"' ],
 384                 [ 'Login:', 'text', 'login', 'maxlength="50"' ],
 385                 [ 'Xmpp:', 'text', 'xmpp', 'maxlength="255"' ],
 386                 [ 'New password:', 'password', 'password' ],
 387                 [ 'Confirm password:', 'password', 'confirm_password' ],
 388                 [ 'Current password:', 'password', 'current_password' ],
 389                 [ 'Email batch time (min):', 'text', 'email_time', 'maxlength="10"' ],
 390                 [ 'Xmpp batch time (min):', 'text', 'xmpp_time', 'maxlength="10"' ],
 391                 [ '', 'submit', 'profile', 'value="Submit"' ] ], $data );
 392         print '</table></form>';
 393         genHtmlFooter( 0, undef, undef );
 394         return OK;
 395 }
 396
 397 sub profileForm( $$$$ ) {
 398         my( $req, $args, $tables, $auth ) = @_;
 399         return notLoggedComplaint( $req, $args, $auth ) unless defined $auth->{'authid'};
 400         return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'};
 401         return genProfileForm( $req, $args, $auth, undef, $tables->profileData( $auth->{'authid'} ), undef );
 402 }
 403
 404 sub checkNum( $$ ) {
 405         my( $value, $name ) = @_;
 406         return ( "$name has invalid number format", '0' ) unless ( $value =~ /\d+/ );
 407         return undef;
 408 }
 409
 410 sub profileFormSubmit( $$$$ ) {
 411         my( $req, $args, $tables, $auth ) = @_;
 412         return notLoggedComplaint( $req, $args, $auth ) unless defined $auth->{'authid'};
 413         my $oldData = $tables->profileData( $auth->{'authid'} );
 414         my( $data, $error ) = getForm( {
 415                 'email' => sub {
 416                         my $email = shift;
 417                         return undef if ( defined $email ) && ( $email eq $oldData->{'email'} );
 418                         return emailCheck( $email, $tables );
 419                 },
 420                 'login' => sub {
 421                         my $login = shift;
 422                         $login = undef if ( defined $login ) && ( $login eq '' );
 423                         return undef if ( defined $login ) && ( defined $oldData->{'login'} ) && ( $oldData->{'login'} eq $login );
 424                         return ( undef, $login ) if ( !defined $login ) && ( !defined $oldData->{'login'} );
 425                         return loginCheck( $login, $tables );
 426                 },
 427                 'xmpp' => sub {
 428                         my $xmpp = shift;
 429                         return ( undef, undef ) if ( !defined $xmpp ) || ( $xmpp eq '' );
 430                         return "Xmpp address limit is 255" if length $xmpp > 255;
 431                         return "Invalid Xmpp address" unless $xmpp =~ /^([^'"\@<>\/]+\@)?[^\@'"<>\/]+(\/.*)?/;
 432                         return undef;
 433                 },
 434                 'password' => sub {
 435                         my $passwd = shift;
 436                         $passwd = undef if ( defined $passwd ) && ( $passwd eq '' );
 437                         return ( undef, undef ) unless defined $passwd;
 438                         return passLenCheck( $passwd );
 439                 },
 440                 'confirm_password' => undef,
 441                 'current_password' => undef,
 442                 'email_time' => sub {
 443                         return checkNum( shift, "Email batch time" );
 444                 },
 445                 'xmpp_time' => sub {
 446                         return checkNum( shift, "Xmpp batch time" );
 447                 }
 448         }, [ sub {
 449                 my $data = shift;
 450                 return undef unless defined $data->{'password'};
 451                 return passSameCheck( $data );
 452         }, sub {
 453                 my $data = shift;
 454                 my $change = 0;
 455                 $change = 1 if $data->{'email'} ne $oldData->{'email'};
 456                 $data->{'login'} = undef if defined $data->{'login'} && $data->{'login'} eq '';
 457                 $oldData->{'login'} = undef if defined $oldData->{'login'} && $oldData->{'login'} eq '';
 458                 $change = 1 if ( ( ( defined $data->{'login'} ) != ( defined $oldData->{'login'} ) ) || ( ( defined $data->{'login'} ) && ( defined $oldData->{'login'} ) && ( $data->{'login'} ne $oldData->{'login'} ) ) );
 459                 $change = 1 if ( defined $data->{'password'} ) && ( $data->{'password'} ne '' );
 460                 return undef unless $change;
 461                 my $logged = 0;
 462                 my( $id, $passwd, $email, $last ) = $tables->getLogInfo( $oldData->{'email'} );
 463                 if( defined $passwd && defined $data->{'current_password'} ) {
 464                         my $salted = saltedPasswd( $email, $data->{'current_password'} );
 465                         $logged = ( $salted eq $passwd ) && ( $id == $auth->{'authid'} );
 466                 }
 467                 return "You need to provide correct current password to change email, login or password" unless $logged;
 468                 return undef;
 469         } ] );
 470         return genProfileForm( $req, $args, $auth, $error, $data, undef ) if defined $error;
 471         pushProfile( $tables, $auth->{'authid'}, $oldData, $data );
 472         return genProfileForm( $req, $args, $auth, undef, $data, "Profile updated." );
 473 }
 474
 475 1;