1 package PciIds::Html::Users;
4 use PciIds::Html::Util;
5 use PciIds::Html::Forms;
9 use PciIds::Html::Handler;
12 use Apache2::Const qw(:common);
13 use Apache2::SubRequest;
18 our @EXPORT = qw(&checkLogin ¬LoggedComplaint);
20 sub genRegisterForm( $$$$ ) {
21 my( $req, $args, $error, $values ) = @_;
22 genHtmlHead( $req, 'Register a new user', undef );
23 print "<div class='top'>\n";
24 print '<h1>Register a new user</h1>';
25 genLocMenu( $req, $args, [ [ 'Log in', 'login' ], [ 'Help', 'help', 'account' ] ] );
26 print "<div class='clear'></div></div>\n";
27 print '<div class="error">'.$error.'</div>' if( defined $error );
28 print '<form name="register" id="register" method="POST" action="">
30 genForm( [ [ 'Email:', 'text', 'email', 'maxlength="255"' ],
31 [ '', 'submit', 'register', 'value="Register"' ] ], $values );
32 print '</table></form>';
37 sub registerForm( $$ ) {#Form for registering a new user
38 my( $req, $args ) = @_;
39 return genRegisterForm( $req, $args, undef, {} );
42 sub loginCheck( $$ ) {
43 my( $login, $tables ) = @_;
44 return undef if( ( not defined $login ) || ( $login eq '' ) );#empty login is ok
45 return 'Login too long' if( ( length $login ) > 50 );
46 return 'Login contains invalid characters' unless( $login =~ /^[-_a-zA-Z0-9]+$/ );
47 return 'This login already exists' if( $tables->hasLogin( $login ) );
51 sub registerSubmit( $$$ ) {#A registration form has been submited
52 my( $req, $args, $tables ) = @_;
53 my( $data, $error ) = getForm( {
55 return emailCheck( shift, $tables );
58 return genRegisterForm( $req, $args, $error, $data ) if( defined $error );
59 my $site = $req->hostname();
60 my $url = 'https://'.$req->hostname().setAddrPrefix( $req->uri(), 'mods' );
61 sendMail( $data->{'email'}, 'Confirm registration', "Someone, probably you, requested registration of this address\n".
62 "for the $site site. If it wasn't you, please ignore this email message.\n".
63 "\nOtherwise, please continue by filling in the form at this address:".
64 "\n".$url.'?action=register-confirm?email='.$data->{'email'}.'?confirm='.emailConfirm( $data->{'email'} )."\n".
66 "\n(This is an autogenerated email, do not respond to it)" );
67 genHtmlHead( $req, 'Registration email sent', undef );
68 print "<div class='top'>\n";
69 print "<h1>Registration email sent</h1>\n";
70 genLocMenu( $req, $args, [ [ 'Log in', 'login' ], [ 'Help', 'help', 'account' ] ] );
71 print "<div class='clear'></div></div>\n";
73 An email containing further information has been sent to you.
74 Please follow these instruction to finish the registration process.';
79 sub genConfirmForm( $$$$ ) {
80 my( $req, $args, $error, $values ) = @_;
81 genHtmlHead( $req, 'Confirm registration', undef );
82 print "<div class='top'>\n";
83 print '<h1>Confirm registration</h1>';
84 genLocMenu( $req, $args, [ [ 'Register', 'register' ], [ 'Help', 'help', 'account' ] ] );
85 print "<div class='clear'></div></div>\n";
86 print '<div class="error">'.$error.'</div>' if( defined $error );
87 print '<p>Email address: '.encode( $values->{'email'} );
88 print '<form name="register-confirm" id="register-confirm" method="POST" action="">';
89 print '<div class="hidden"><p><input type="hidden" value="'.encode( $values->{'email'} ).'" name="email"><input type="hidden" value="'.encode( $values->{'confirm'} ).'" name="confirm"></div>';
91 genForm( [ [ 'Login (Optional):', 'text', 'login', 'maxlength="50"' ],
92 [ 'Password:', 'password', 'password' ],
93 [ 'Confirm password:', 'password', 'confirm_password' ],
94 [ '', 'submit', 'register', 'value=Register' ] ], $values );
95 print '</table></form>';
100 sub usedAddress( $$ ) {
101 my( $req, $args ) = @_;
102 genHtmlHead( $req, 'Used address', undef );
103 print "<div class='top'>\n";
104 print "<h1>Used address</h1>\n";
105 genLocMenu( $req, $args, [ [ 'Log in', 'login' ], [ 'Reset password', 'respass' ], [ 'Register', 'register' ], [ 'Help', 'help', 'account' ] ] );
106 print "<div class='clear'></div></div>\n";
107 print '<div class="error">
109 An account for this address is already registered.
110 Please, reset or remember your password or start again with a different address.
116 sub checkRegHash( $$$$$ ) {
117 my( $req, $args, $tables, $email, $hash ) = @_;
118 if( ! checkConfirmHash( $email, $hash ) ) {
119 genHtmlHead( $req, 'Invalid registration request', undef );
120 print '<h1>Invalid registration request</h1>
123 This registration request is invalid.
124 Are you sure you got it from the registration email?
128 } elsif( $tables->hasEmail( $email ) ) {
129 return usedAddress( $req, $args );
135 sub confirmForm( $$$$ ) {
136 my( $req, $args, $tables, $auth ) = @_;
137 return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'};
138 if( ! checkRegHash( $req, $args, $tables, $args->{'email'}, $args->{'confirm'} ) ) {
141 return genConfirmForm( $req, $args, undef, $args );
145 sub passLenCheck( $ ) {
147 return ( ( length $pass ) >= 4 ) ? undef : 'Password must have at least 4 characters';
150 sub passSameCheck( $ ) {
152 return ( ( ( defined $data->{'password'} ) != ( defined $data->{'confirm_password'} ) ) || ( ( defined $data->{'password'} ) && ( $data->{'password'} ne $data->{'confirm_password'} ) ) ) ? 'Passwords do not match' : undef;
155 sub confirmSubmit( $$$ ) {
156 my( $req, $args, $tables ) = @_;
157 my( $data, $error ) = getForm( {
159 return emailCheck( shift, $tables );
163 return loginCheck( shift, $tables );
165 'password' => \&passLenCheck,
166 'confirm_password' => undef }, [ \&passSameCheck ] );
167 return OK if( ! checkRegHash( $req, $args, $tables, $data->{'email'}, $data->{'confirm'} ) );#Not much info, but this is an attack anyway
168 return genConfirmForm( $req, $args, $error, $data ) if( defined $error );
169 unless( addUser( $tables, $data->{'login'}, $data->{'email'}, $data->{'password'} ) ) {
170 usedAddress( $req, $args );
173 genHtmlHead( $req, 'Registered', undef );
174 print "<div class='top'>\n";
175 print "<h1>Registered</h1>\n";
176 genLocMenu( $req, $args, [ [ 'Log in', 'login' ], [ 'Help', 'help', 'account' ] ] );
177 print "<div class='clear'></div></div>\n";
179 You have registered successfully.';
184 sub genLoginForm( $$$$ ) {
185 my( $req, $args, $error, $values ) = @_;
186 $req->headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'cookie-test', -value => 1 ) );
187 genHtmlHead( $req, 'Login', undef );
188 print "<div class='top'>\n";
189 print '<h1>Login</h1>';
190 genLocMenu( $req, $args, [ [ 'Register', 'register' ], [ 'Reset password', 'respass' ], [ 'Help', 'help', 'account' ] ] );
191 print "<div class='clear'></div></div>\n";
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>';
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, {} );
208 sub loginSubmit( $$$ ) {
209 my( $req, $args, $tables ) = @_;
210 my( $data, $error ) = getForm( {
215 my $cookies = fetch CGI::Cookie;
216 unless( $cookies->{'cookie-test'} ) {
217 return genLoginForm( $req, $args, 'You need to enable cookies', $data );
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;
225 my $cookie = new CGI::Cookie( -name => 'auth', -value => genAuthToken( $tables, $id, $req, undef, $email ) );
226 $req->headers_out->add( 'Set-Cookie' => $cookie );
227 $args->{'action'} = ( defined $args->{'redirectaction'} ) ? $args->{'redirectaction'} : 'list';
228 delete $args->{'redirectaction'};
229 $args->{'full_links'} = 1;
230 my $auth = checkLoginInternal( $req, $tables, $cookie );
231 return PciIds::Html::Handler::callHandler( $req, $args, $tables, $auth, 1, 'GET' );
233 return genLoginForm( $req, $args, 'Invalid login credetials', $data );
238 my( $req, $args, $tables, $auth ) = @_;
239 $req->headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'auth', -value => '0' ) );
240 return PciIds::Html::List::list( $req, $args, $tables, {} );
243 sub checkLoginInternal( $$$ ) {
244 my( $req, $tables, $cookie ) = @_;
245 my( $authed, $id, $regen, $rights, $error, $name ) = checkAuthToken( $tables, $req, defined( $cookie ) ? $cookie->value : undef );
247 $req->headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'auth', -value => genAuthToken( $tables, $id, $req, $rights, $name ) ) );
249 my $hterror = $authed ? '' : '<div class="error"><p>'.$error.'</div>';
250 return { 'authid' => $authed ? $id : undef, 'accrights' => $rights, 'logerror' => $hterror, 'name' => $authed ? $name : undef };
253 sub checkLogin( $$ ) {
254 my( $req, $tables ) = @_;
255 my $cookies = fetch CGI::Cookie;
256 my $cookie = $cookies->{'auth'};
257 return checkLoginInternal( $req, $tables, $cookie );
260 sub notLoggedComplaint( $$$ ) {
261 my( $req, $args, $auth ) = @_;
262 return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'};
263 $args->{'redirectaction'} = $args->{'action'};
264 return genLoginForm( $req, $args, 'This action requires you to be logged in', undef );
267 sub genResetPasswdForm( $$$$ ) {
268 my( $req, $args, $error, $values ) = @_;
269 genHtmlHead( $req, 'Reset password', undef );
270 print "<div class='top'>\n";
271 print "<h1>Reset password</h1>\n";
272 genLocMenu( $req, $args, [ [ 'Log in', 'login' ], [ 'Register', 'register' ], [ 'Help', 'help', 'account' ] ] );
273 print "<div class='clear'></div></div>\n";
274 print "<p>If you forgot your password (or didn't create one yet), you can reset it to a new value here.\n";
275 print "Provide your email address here and further instructions will be sent to you.\n";
276 print '<div class="error">'.$error.'</div>' if( defined $error );
277 print '<form name="respass" id="respass" method="POST" action="">
279 genForm( [ [ 'Email:', 'text', 'email', 'maxlength="255"' ],
280 [ '', 'submit', 'respass', 'value="Send"' ] ], $values );
281 print '</table></form>';
286 sub resetPasswdForm( $$$$ ) {
287 my( $req, $args ) = @_;
288 return genResetPasswdForm( $req, $args, undef, {} );
291 sub resetPasswdFormSubmit( $$$ ) {
292 my( $req, $args, $tables ) = @_;
293 my( $data, $error ) = getForm( {
296 my( $id, $login, $passwd ) = $tables->resetInfo( $data->{'email'} );
297 if( defined( $id ) ) {
298 $login = '' unless( defined( $login ) );
299 my $site = $req->hostname();
300 my $url = 'https://'.$req->hostname().setAddrPrefix( $req->uri(), 'mods' );
301 my $hash = genResetHash( $id, $data->{'email'}, $login, $passwd );
302 sendMail( $data->{'email'}, 'Reset password',
303 "A request to reset password for the $site site was received for this address\n".
304 "If you really wish to get a new password, visit this link:\n\n".
305 $url.'?action=respass-confirm?email='.$data->{'email'}.'?confirm='.$hash."\n".
307 "\n(This is an autogenerated email, do not respond to it)" );
308 genHtmlHead( $req, 'Reset password', undef );
309 print "<div class='top'>\n";
310 print "<h1>Reset password</h1>\n";
311 genLocMenu( $req, $args, [ [ 'Log in', 'login' ], [ 'Help', 'help', 'account' ] ] );
312 print "<div class='clear'></div></div>\n";
313 print "<p>An email with information has been sent to your address.\n";
317 $error = '<p>This email address is not registered. Check it for typos or register it.';
319 return genResetPasswdForm( $req, $args, $error, $data ) if( defined( $error ) );
322 sub genResetPasswdConfigForm( $$$$$$ ) {
323 my( $req, $args, $error, $values, $email, $hash ) = @_;
324 genHtmlHead( $req, 'Reset password', undef );
325 print "<div class='top'>\n";
326 print "<h1>Reset password</h1>\n";
327 genLocMenu( $req, $args, [ [ 'Log in', 'login' ], [ 'Help', 'help', 'account' ] ] );
328 print "<div class='clear'></div></div>\n";
329 print '<div class="error">'.$error.'</div>' if( defined $error );
330 print "<p>You can enter new password here:\n";
331 print '<form name="respass-confirm" id="respass-confirm" method="POST" action="">
333 genForm( [ [ 'Password:', 'password', 'password' ],
334 [ 'Confirm password:', 'password', 'confirm_password' ],
335 [ '', 'submit', 'respass', 'value="Send"' ] ], $values );
337 print "<input type='hidden' name='email' value='".encode( $email )."'><input type='hidden' name='hash' value='".encode( $hash )."'>\n";
343 sub resetPasswdConfirmForm( $$$$ ) {
344 my( $req, $args, $tables, $auth ) = @_;
345 my( $email, $hash ) = ( $args->{'email'}, $args->{'confirm'} );
346 my( $id, $login, $passwd ) = $tables->resetInfo( $email );
348 return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'};
349 $myHash = genResetHash( $id, $email, $login, $passwd ) if( defined( $id ) );
350 if( defined( $myHash ) && ( $myHash eq $hash ) ) {#Ok, it is his mail and he asked
351 return genResetPasswdConfigForm( $req, $args, undef, {}, $email, $hash );
353 genHtmlHead( $req, 'Reset password', undef );
354 print "<h1>Reset password</h1>\n";
355 print "<p>Provided link is not valid. Did you use it already?\n";
356 print "<p>You can get a <a href='".$req->uri()."?action=respass'>new one</a>.\n";
362 sub resetPasswdConfirmFormSubmit( $$$ ) {
363 my( $req, $args, $tables ) = @_;
364 my( $data, $error ) = getForm( {
365 'password' => \&passLenCheck,
366 'confirm_password' => undef,
369 }, [ \&passSameCheck ] );
370 my( $email, $hash ) = ( $data->{'email'}, $args->{'confirm'} );
371 if( defined( $error ) ) {
372 return genResetPasswdConfigForm( $req, $args, $error, $data, $email, $hash );
374 my( $id, $login, $passwd ) = $tables->resetInfo( $email );
376 $myHash = genResetHash( $id, $email, $login, $passwd ) if( defined( $id ) );
377 if( defined( $myHash ) && ( $myHash eq $hash ) ) {
378 changePasswd( $tables, $id, $data->{'password'}, $email );
379 genHtmlHead( $req, 'Reset password', undef );
380 print "<div class='top'>\n";
381 print "<h1>Reset password</h1>\n";
382 genLocMenu( $req, $args, [ [ 'Log in', 'login' ], [ 'Help', 'help', 'account' ] ] );
383 print "<div class='clear'></div></div>\n";
384 print "<p>Your password was successfuly changed.\n";
388 return genResetPasswdConfigForm( $req, $args, $error, $data, $email, $hash );
393 sub genProfileForm( $$$$$$ ) {
394 my( $req, $args, $auth, $error, $data, $info ) = @_;
395 genHtmlHead( $req, 'User profile', undef );
396 delete $data->{'current_password'};
397 delete $data->{'confirm_password'};
398 delete $data->{'password'};
399 print "<div class='top'>\n";
400 print "<h1>User profile</h1>\n";
401 genLocMenu( $req, $args, [ logItem( $auth ), [ 'Notifications', 'notifications' ], [ 'Help', 'help', 'profile' ] ] );
402 print "<div class='clear'></div></div>\n";
403 print '<div class="error"><p>'.$error.'</div>' if defined $error;
404 print "<div class='info'><p>$info</div>\n" if defined $info;
405 print '<form name="profile" id="profile" method="POST" action=""><table>';
406 genForm( [ [ 'Email:', 'text', 'email', 'maxlength="255"' ],
407 [ 'Login:', 'text', 'login', 'maxlength="50"' ],
408 [ 'Xmpp:', 'text', 'xmpp', 'maxlength="255"' ],
409 [ 'New password:', 'password', 'password' ],
410 [ 'Confirm password:', 'password', 'confirm_password' ],
411 [ 'Current password:', 'password', 'current_password' ],
412 [ 'Email batch time (min):', 'text', 'email_time', 'maxlength="10"' ],
413 [ 'Xmpp batch time (min):', 'text', 'xmpp_time', 'maxlength="10"' ],
414 [ '', 'submit', 'profile', 'value="Submit"' ] ], $data );
415 print '</table></form>';
420 sub profileForm( $$$$ ) {
421 my( $req, $args, $tables, $auth ) = @_;
422 return notLoggedComplaint( $req, $args, $auth ) unless defined $auth->{'authid'};
423 return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'};
424 return genProfileForm( $req, $args, $auth, undef, $tables->profileData( $auth->{'authid'} ), undef );
428 my( $value, $name ) = @_;
429 return ( "$name has invalid number format", '0' ) unless ( $value =~ /\d+/ );
433 sub profileFormSubmit( $$$$ ) {
434 my( $req, $args, $tables, $auth ) = @_;
435 return notLoggedComplaint( $req, $args, $auth ) unless defined $auth->{'authid'};
436 my $oldData = $tables->profileData( $auth->{'authid'} );
437 my( $data, $error ) = getForm( {
440 return undef if ( defined $email ) && ( $email eq $oldData->{'email'} );
441 return emailCheck( $email, $tables );
445 $login = undef if ( defined $login ) && ( $login eq '' );
446 return undef if ( defined $login ) && ( defined $oldData->{'login'} ) && ( $oldData->{'login'} eq $login );
447 return ( undef, $login ) if ( !defined $login ) && ( !defined $oldData->{'login'} );
448 return loginCheck( $login, $tables );
452 return ( undef, undef ) if ( !defined $xmpp ) || ( $xmpp eq '' );
453 return "Xmpp address limit is 255" if length $xmpp > 255;
454 return "Invalid Xmpp address" unless $xmpp =~ /^([^'"\@<>\/]+\@)?[^\@'"<>\/]+(\/.*)?/;
459 $passwd = undef if ( defined $passwd ) && ( $passwd eq '' );
460 return ( undef, undef ) unless defined $passwd;
461 return passLenCheck( $passwd );
463 'confirm_password' => undef,
464 'current_password' => undef,
465 'email_time' => sub {
466 return checkNum( shift, "Email batch time" );
469 return checkNum( shift, "Xmpp batch time" );
473 return undef unless defined $data->{'password'};
474 return passSameCheck( $data );
478 $change = 1 if $data->{'email'} ne $oldData->{'email'};
479 $change = 1 if ( ( ( defined $data->{'login'} ) != ( defined $oldData->{'login'} ) ) || ( ( defined $data->{'login'} ) && ( defined $oldData->{'login'} ) && ( $data->{'login'} ne $oldData->{'login'} ) ) );
480 $change = 1 if ( defined $data->{'password'} ) && ( $data->{'password'} ne '' );
481 return undef unless $change;
483 my( $id, $passwd, $email, $last ) = $tables->getLogInfo( $oldData->{'email'} );
484 if( defined $passwd && defined $data->{'current_password'} ) {
485 my $salted = saltedPasswd( $email, $data->{'current_password'} );
486 $logged = ( $salted eq $passwd ) && ( $id == $auth->{'authid'} );
488 return "You need to provide correct current password to change email, login or password" unless $logged;
491 return genProfileForm( $req, $args, $auth, $error, $data, undef ) if defined $error;
492 pushProfile( $tables, $auth->{'authid'}, $oldData, $data );
493 return genProfileForm( $req, $args, $auth, undef, $data, "Profile updated." );