1 package PciIds::Html::Users;
4 use PciIds::Html::Util;
5 use PciIds::Html::Forms;
10 use Apache2::Const qw(:common);
11 use Apache2::SubRequest;
16 our @EXPORT = qw(&checkLogin ¬LoggedComplaint);
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="">
25 genForm( [ [ 'Email:', 'text', 'email', 'maxlength="255"' ],
26 [ '', 'submit', 'register', 'value="Register"' ] ], $values );
27 print '</table></form>';
32 sub registerForm( $$ ) {#Form for registering a new user
33 my( $req, $args ) = @_;
34 return genRegisterForm( $req, $args, undef, {} );
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 ) );
46 sub emailCheck( $$ ) {
47 my( $email, $tables ) = @_;
49 return 'Does not look like an email address' unless ( ( $newmail ) = ( $email =~ /^([^,? "'`;]+@[^@,?\/ "'`;]+)$/ ) );#make sure the mail is not only reasonable looking, but safe to work with too
50 return 'Email too long' if length $newmail > 255;
51 return 'An account for this email address already exists' if( $tables->hasEmail( $newmail ) );
52 return ( undef, $newmail );
55 sub registerSubmit( $$$ ) {#A registration form has been submited
56 my( $req, $args, $tables ) = @_;
57 my( $data, $error ) = getForm( {
59 return emailCheck( shift, $tables );
62 return genRegisterForm( $req, $args, $error, $data ) if( defined $error );
63 my $site = $req->hostname();
64 my $url = 'https://'.$req->hostname().setAddrPrefix( $req->uri(), 'mods' );
65 sendMail( $data->{'email'}, 'Confirm registration', "Someone, probably you, requested registration of this address\n".
66 "for the $site site. If it wasn't you, please ignore this email message.\n".
67 "\nOtherwise, please continue by filling in the form at this address:".
68 "\n".$url.'?action=register-confirm?email='.$data->{'email'}.'?confirm='.emailConfirm( $data->{'email'} )."\n".
70 "\n(This is an autogenerated email, do not respond to it)" );
71 genHtmlHead( $req, 'Registration email sent', undef );
72 print '<h1>Register email sent</h1>
74 An email containing further information has been sent to you.
75 Please follow these instruction to finish the registration process.';
80 sub genConfirmForm( $$$$ ) {
81 my( $req, $args, $error, $values ) = @_;
82 genHtmlHead( $req, 'Confirm registration', undef );
83 print '<h1>Confirm registration</h1>';
84 print '<div class="error">'.$error.'</div>' if( defined $error );
85 print '<p>Email address: '.encode( $values->{'email'} );
86 print '<form name="register-confirm" id="register-confirm" method="POST" action="">';
87 print '<div class="hidden"><p><input type="hidden" value="'.encode( $values->{'email'} ).'" name="email"><input type="hidden" value="'.encode( $values->{'confirm'} ).'" name="confirm"></div>';
89 genForm( [ [ 'Login (Optional):', 'text', 'login', 'maxlength="50"' ],
90 [ 'Password:', 'password', 'password' ],
91 [ 'Confirm password:', 'password', 'confirm_password' ],
92 [ '', 'submit', 'register', 'value=Register' ] ], $values );
93 print '</table></form>';
98 sub usedAddress( $ ) {
100 genHtmlHead( $req, 'Used address', undef );
101 print '<h1>Used address</h1>
104 An account for this address is already registered.
105 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>.
111 sub checkRegHash( $$$$ ) {
112 my( $req, $tables, $email, $hash ) = @_;
113 if( ! checkConfirmHash( $email, $hash ) ) {
114 genHtmlHead( $req, 'Invalid registration request', undef );
115 print '<h1>Invalid registration request</h1>
118 This registration request is invalid.
119 Are you sure you got it from the registration email?
123 } elsif( $tables->hasEmail( $email ) ) {
124 return usedAddress( $req );
130 sub confirmForm( $$$$ ) {
131 my( $req, $args, $tables, $auth ) = @_;
132 return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'};
133 if( ! checkRegHash( $req, $tables, $args->{'email'}, $args->{'confirm'} ) ) {
136 return genConfirmForm( $req, $args, undef, $args );
140 sub passLenCheck( $ ) {
142 return ( ( length $pass ) >= 4 ) ? undef : 'Password must have at least 4 characters';
145 sub passSameCheck( $ ) {
147 return ( ( ( defined $data->{'password'} ) != ( defined $data->{'confirm_password'} ) ) || ( ( defined $data->{'password'} ) && ( $data->{'password'} ne $data->{'confirm_password'} ) ) ) ? 'Passwords do not match' : undef;
150 sub confirmSubmit( $$$ ) {
151 my( $req, $args, $tables ) = @_;
152 my( $data, $error ) = getForm( {
154 return emailCheck( shift, $tables );
158 return loginCheck( shift, $tables );
160 'password' => \&passLenCheck,
161 'confirm_password' => undef }, [ \&passSameCheck ] );
162 return OK if( ! checkRegHash( $req, $tables, $data->{'email'}, $data->{'confirm'} ) );#Not much info, but this is an attack anyway
163 return genConfirmForm( $req, $args, $error, $data ) if( defined $error );
164 unless( addUser( $tables, $data->{'login'}, $data->{'email'}, $data->{'password'} ) ) {
168 genHtmlHead( $req, 'Registered', undef );
169 print '<h1>Registered</h1>
171 You are now registered.
172 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>.';
177 sub genLoginForm( $$$$ ) {
178 my( $req, $args, $error, $values ) = @_;
179 $req->headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'cookie-test', -value => 1 ) );
180 genHtmlHead( $req, 'Login', undef );
181 print '<h1>Login</h1>';
182 my $addr = PciIds::Address::new( $req->uri() );
183 genCustomMenu( $addr, $args, [ [ 'Register', 'register' ], [ 'Reset password', 'respass' ] ] );
184 print '<div class="error"><p>'.$error.'</div>' if( defined $error );
185 print '<form name="login" id="login" method="POST" action="'.setAddrPrefix( $req->uri(), 'mods' ).buildExcept( 'action', $args ).'?action=login"><table>';
186 genForm( [ [ 'Login name or email:', 'text', 'login', 'maxlength="255"' ],
187 [ 'Password:', 'password', 'password' ],
188 [ '', 'submit', 'login', 'value="Login"' ] ], $values );
189 print '</table></form>';
194 sub loginForm( $$$ ) {
195 my( $req, $args, $tables, $auth ) = @_;
196 return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless( $auth->{'ssl'} );
197 return genLoginForm( $req, $args, undef, {} );
200 sub loginSubmit( $$$ ) {
201 my( $req, $args, $tables ) = @_;
202 my( $data, $error ) = getForm( {
207 my $cookies = fetch CGI::Cookie;
208 unless( $cookies->{'cookie-test'} ) {
209 return genLoginForm( $req, $args, 'You need to enable cookies', $data );
211 my( $id, $passwd, $email, $last ) = $tables->getLogInfo( $data->{'login'} );
212 if( defined $passwd && defined $data->{'password'} ) {
213 my $salted = saltedPasswd( $email, $data->{'password'} );
214 $logged = $salted eq $passwd;
217 $req->headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'auth', -value => genAuthToken( $tables, $id, $req, undef ) ) );
218 $args->{'action'} = ( defined $args->{'redirectaction'} ) ? $args->{'redirectaction'} : 'list';
219 my $prefix = ( !defined( $args->{'action'} ) or ( $args->{'action'} eq '' ) or ( $args->{'action'} eq 'list' ) ) ? 'read' : 'mods';
220 my $url = "http://".$req->hostname().setAddrPrefix( $req->uri(), $prefix ).buildExcept( 'redirectaction', $args );
221 genHtmlHead( $req, 'Logged in', undef );
222 print '<h1>Logged in</h1>';
223 print '<div class="lastlog"><p>'.encode( $last ).'</div>' if( defined( $last ) );
224 print "<p><a href='$url'>Continue here</a>";
228 return genLoginForm( $req, $args, 'Invalid login credetials', $data );
233 my( $req, $args, $tables, $auth ) = @_;
234 $req->headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'auth', -value => '0' ) );
235 return PciIds::Html::List::list( $req, $args, $tables, {} );
238 sub checkLogin( $$ ) {
239 my( $req, $tables ) = @_;
240 my $cookies = fetch CGI::Cookie;
241 my( $authed, $id, $regen, $rights, $error ) = checkAuthToken( $tables, $req, defined( $cookies->{'auth'} ) ? $cookies->{'auth'}->value : undef );
243 $req->headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'auth', -value => genAuthToken( $tables, $id, $req, $rights ) ) );
245 my $hterror = $authed ? '' : '<div class="error"><p>'.$error.'</div>';
246 return { 'authid' => $authed ? $id : undef, 'accrights' => $rights, 'logerror' => $hterror };
249 sub notLoggedComplaint( $$$ ) {
250 my( $req, $args, $auth ) = @_;
251 return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'};
252 $args->{'redirectaction'} = $args->{'action'};
253 return genLoginForm( $req, $args, 'This action requires you to be logged in', undef );
256 sub genResetPasswdForm( $$$$ ) {
257 my( $req, $args, $error, $values ) = @_;
258 genHtmlHead( $req, 'Reset password', undef );
259 print "<h1>Reset password</h1>\n";
260 print "<p>If you forgot your password (or didn't create one yet), you can reset it to a new value here.\n";
261 print "Provide your email address here and further instructions will be sent to you.\n";
262 print '<div class="error">'.$error.'</div>' if( defined $error );
263 print '<form name="respass" id="respass" method="POST" action="">
265 genForm( [ [ 'Email:', 'text', 'email', 'maxlength="255"' ],
266 [ '', 'submit', 'respass', 'value="Send"' ] ], $values );
267 print '</table></form>';
272 sub resetPasswdForm( $$$$ ) {
273 my( $req, $args ) = @_;
274 return genResetPasswdForm( $req, $args, undef, {} );
277 sub resetPasswdFormSubmit( $$$ ) {
278 my( $req, $args, $tables ) = @_;
279 my( $data, $error ) = getForm( {
282 my( $id, $login, $passwd ) = $tables->resetInfo( $data->{'email'} );
283 if( defined( $id ) ) {
284 $login = '' unless( defined( $login ) );
285 my $site = $req->hostname();
286 my $url = 'https://'.$req->hostname().setAddrPrefix( $req->uri(), 'mods' );
287 my $hash = genResetHash( $id, $data->{'email'}, $login, $passwd );
288 sendMail( $data->{'email'}, 'Reset password',
289 "A request to reset password for the $site site was received for this address\n".
290 "If you really wish to get a new password, visit this link:\n\n".
291 $url.'?action=respass-confirm?email='.$data->{'email'}.'?confirm='.$hash."\n".
293 "\n(This is an autogenerated email, do not respond to it)" );
294 genHtmlHead( $req, 'Reset password', undef );
295 print "<h1>Reset password</h1>\n";
296 print "<p>An email with information was sent to your address.\n";
300 $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.';
302 return genResetPasswdForm( $req, $args, $error, $data ) if( defined( $error ) );
305 sub genResetPasswdConfigForm( $$$$$$ ) {
306 my( $req, $args, $error, $values, $email, $hash ) = @_;
307 genHtmlHead( $req, 'Reset password', undef );
308 print "<h1>Reset password</h1>\n";
309 print '<div class="error">'.$error.'</div>' if( defined $error );
310 print "<p>You can enter new password here:\n";
311 print '<form name="respass-confirm" id="respass-confirm" method="POST" action="">
313 genForm( [ [ 'Password:', 'password', 'password' ],
314 [ 'Confirm password:', 'password', 'confirm_password' ],
315 [ '', 'submit', 'respass', 'value="Send"' ] ], $values );
317 print "<input type='hidden' name='email' value='".encode( $email )."'><input type='hidden' name='hash' value='".encode( $hash )."'>\n";
323 sub resetPasswdConfirmForm( $$$$ ) {
324 my( $req, $args, $tables, $auth ) = @_;
325 my( $email, $hash ) = ( $args->{'email'}, $args->{'confirm'} );
326 my( $id, $login, $passwd ) = $tables->resetInfo( $email );
328 return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'};
329 $myHash = genResetHash( $id, $email, $login, $passwd ) if( defined( $id ) );
330 if( defined( $myHash ) && ( $myHash eq $hash ) ) {#Ok, it is his mail and he asked
331 return genResetPasswdConfigForm( $req, $args, undef, {}, $email, $hash );
333 genHtmlHead( $req, 'Reset password', undef );
334 print "<h1>Reset password</h1>\n";
335 print "<p>Provided link is not valid. Did you use it already?\n";
336 print "<p>You can get a <a href='".$req->uri()."?action=respass'>new one</a>.\n";
342 sub resetPasswdConfirmFormSubmit( $$$ ) {
343 my( $req, $args, $tables ) = @_;
344 my( $data, $error ) = getForm( {
345 'password' => \&passLenCheck,
346 'confirm_password' => undef,
349 }, [ \&passSameCheck ] );
350 my( $email, $hash ) = ( $data->{'email'}, $args->{'confirm'} );
351 if( defined( $error ) ) {
352 return genResetPasswdConfigForm( $req, $args, $error, $data, $email, $hash );
354 my( $id, $login, $passwd ) = $tables->resetInfo( $email );
356 $myHash = genResetHash( $id, $email, $login, $passwd ) if( defined( $id ) );
357 if( defined( $myHash ) && ( $myHash eq $hash ) ) {
358 changePasswd( $tables, $id, $data->{'password'}, $email );
359 genHtmlHead( $req, 'Reset password', undef );
360 print "<h1>Reset password</h1>\n";
361 print "<p>Your password was successfuly changed. You can <a href='".$req->uri()."?action=login'>log in</a>.\n";
365 return genResetPasswdConfigForm( $req, $args, $error, $data, $email, $hash );
370 sub genProfileForm( $$$$$ ) {
371 my( $req, $args, $error, $data, $info ) = @_;
372 genHtmlHead( $req, 'User profile', undef );
373 delete $data->{'current_password'};
374 delete $data->{'confirm_password'};
375 delete $data->{'password'};
376 print "<h1>User profile</h1>\n";
377 print '<div class="error"><p>'.$error.'</div>' if defined $error;
378 print "<div class='info'><p>$info</div>\n" if defined $info;
379 print '<form name="profile" id="profile" method="POST" action=""><table>';
380 genForm( [ [ 'Email:', 'text', 'email', 'maxlength="255"' ],
381 [ 'Login:', 'text', 'login', 'maxlength="50"' ],
382 [ 'Xmpp:', 'text', 'xmpp', 'maxlength="255"' ],
383 [ 'New password:', 'password', 'password' ],
384 [ 'Confirm password:', 'password', 'confirm_password' ],
385 [ 'Current password:', 'password', 'current_password' ],
386 [ 'Email batch time (min):', 'text', 'email_time', 'maxlength="10"' ],
387 [ 'Xmpp batch time (min):', 'text', 'xmpp_time', 'maxlength="10"' ],
388 [ '', 'submit', 'profile', 'value="Submit"' ] ], $data );
389 print '</table></form>';
390 print "<p><a class='navigation' href='http://".$req->hostname().setAddrPrefix( $req->uri(), 'read' ).buildExcept( 'action', $args )."?action=list'>Back to browsing</a>\n";
395 sub profileForm( $$$$ ) {
396 my( $req, $args, $tables, $auth ) = @_;
397 return notLoggedComplaint( $req, $args, $auth ) unless defined $auth->{'authid'};
398 return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'};
399 return genProfileForm( $req, $args, undef, $tables->profileData( $auth->{'authid'} ), undef );
403 my( $value, $name ) = @_;
404 return ( "$name has invalid number format", '0' ) unless ( $value =~ /\d+/ );
408 sub profileFormSubmit( $$$$ ) {
409 my( $req, $args, $tables, $auth ) = @_;
410 return notLoggedComplaint( $req, $args, $auth ) unless defined $auth->{'authid'};
411 my $oldData = $tables->profileData( $auth->{'authid'} );
412 my( $data, $error ) = getForm( {
415 return undef if ( defined $email ) && ( $email eq $oldData->{'email'} );
416 return emailCheck( $email, $tables );
420 $login = undef if ( defined $login ) && ( $login eq '' );
421 return undef if ( defined $login ) && ( defined $oldData->{'login'} ) && ( $oldData->{'login'} eq $login );
422 return ( undef, $login ) if ( !defined $login ) && ( !defined $oldData->{'login'} );
423 return loginCheck( $login, $tables );
427 return ( undef, undef ) if ( !defined $xmpp ) || ( $xmpp eq '' );
428 return "Xmpp address limit is 255" if length $xmpp > 255;
429 return "Invalid Xmpp address" unless $xmpp =~ /^([^'"\@<>\/]+\@)?[^\@'"<>\/]+(\/.*)?/;
434 $passwd = undef if ( defined $passwd ) && ( $passwd eq '' );
435 return ( undef, undef ) unless defined $passwd;
436 return passLenCheck( $passwd );
438 'confirm_password' => undef,
439 'current_password' => undef,
440 'email_time' => sub {
441 return checkNum( shift, "Email batch time" );
444 return checkNum( shift, "Xmpp batch time" );
448 return undef unless defined $data->{'password'};
449 return passSameCheck( $data );
453 $change = 1 if $data->{'email'} ne $oldData->{'email'};
454 $change = 1 if ( ( ( defined $data->{'login'} ) != ( defined $oldData->{'login'} ) ) || ( ( defined $data->{'login'} ) && ( defined $oldData->{'login'} ) && ( $data->{'login'} ne $oldData->{'login'} ) ) );
455 $change = 1 if ( defined $data->{'password'} ) && ( $data->{'password'} ne '' );
456 return undef unless $change;
458 my( $id, $passwd, $email, $last ) = $tables->getLogInfo( $oldData->{'email'} );
459 if( defined $passwd && defined $data->{'current_password'} ) {
460 my $salted = saltedPasswd( $email, $data->{'current_password'} );
461 $logged = ( $salted eq $passwd ) && ( $id == $auth->{'authid'} );
463 return "You need to provide correct current password to change email, login or password" unless $logged;
466 return genProfileForm( $req, $args, $error, $data, undef ) if defined $error;
467 pushProfile( $tables, $auth->{'authid'}, $oldData, $data );
468 return genProfileForm( $req, $args, undef, $data, "Profile updated." );