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