PciIds/Html/Users.pm

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