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