#	PciIds web database
#	Copyright (C) 2008 Michal Vaner (vorner@ucw.cz)
#
#	This program is free software; you can redistribute it and/or modify
#	it under the terms of the GNU General Public License as published by
#	he Free Software Foundation; either version 2 of the License, or
#	(at your option) any later version.
#
#	This program is distributed in the hope that it will be useful,
#	but WITHOUT ANY WARRANTY; without even the implied warranty of
#	MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
#
#	GNU General Public License for more details.
#
#	You should have received a copy of the GNU General Public License
#	along with this program; if not, write to the Free Software
#	Foundation, Inc., 51 Franklin St, Fifth Floor, Boston, MA  02110-1301  USA

package PciIds::Html::Users;
use strict;
use warnings;
use PciIds::Html::Util;
use PciIds::Html::Forms;
use PciIds::Email;
use PciIds::Users;
use PciIds::Address;
use CGI;
use CGI::Cookie;
use Apache2::Const qw(:common);
use Apache2::SubRequest;
use APR::Table;

use base 'Exporter';

our @EXPORT = qw(&checkLogin &notLoggedComplaint);

sub genRegisterForm( $$$$ ) {
	my( $req, $args, $error, $values ) = @_;
	genHtmlHead( $req, 'Register a new user', undef );
	genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Register a new user', [ [ 'Help', 'help', 'account' ] ], [ [ 'Log in', 'login' ] ] );
	print '<div class="error">'.$error.'</div>' if( defined $error );
	print '<form name="register" id="register" method="POST" action="">
		<table>';
	genForm( [ [ 'Email:', 'text', 'email', 'maxlength="255"' ],
		[ '', 'submit', 'register', 'value="Register"' ] ], $values );
	print '</table></form>';
	genHtmlFooter( 0, undef, undef );
	return OK;
}

sub registerForm( $$ ) {#Form for registering a new user
	my( $req, $args ) = @_;
	return genRegisterForm( $req, $args, undef, {} );
}

sub loginCheck( $$ ) {
	my( $login, $tables ) = @_;
	return undef if( ( not defined $login ) || ( $login eq '' ) );#empty login is ok
	return 'Login too long' if( ( length $login ) > 50 );
	return 'Login contains invalid characters' unless( $login =~ /^[-_a-zA-Z0-9]+$/ );
	return 'This login already exists' if( $tables->hasLogin( $login ) );
	return undef;
}

sub registerSubmit( $$$ ) {#A registration form has been submited
	my( $req, $args, $tables ) = @_;
	my( $data, $error ) = getForm( {
		'email' => sub {
			return emailCheck( shift, $tables );
		}
	}, [] );
	return genRegisterForm( $req, $args, $error, $data ) if( defined $error );
	my $site = $req->hostname();
	my $url = 'https://'.$req->hostname().setAddrPrefix( $req->uri(), 'mods' );
	sendMail( $data->{'email'}, 'Confirm registration', "Someone, probably you, requested registration of this address\n".
		"for the $site site. If it wasn't you, please ignore this email message.\n".
		"\nOtherwise, please continue by filling in the form at this address:".
		"\n".$url.'?action=register-confirm?email='.$data->{'email'}.'?confirm='.emailConfirm( $data->{'email'} )."\n".
		"\nThank you\n".
		"\n(This is an autogenerated email, do not respond to it)" );
	genHtmlHead( $req, 'Registration email sent', undef );
	genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Registration email sent', [ [ 'Help', 'help', 'account' ] ], [ [ 'Log in', 'login' ] ] );
	print "<div class='clear'></div></div>\n";
	print '<p>
			An email containing further information has been sent to you.
			Please follow these instruction to finish the registration process.';
	genHtmlFooter( 0, undef, undef );
	return OK;
}

sub genConfirmForm( $$$$ ) {
	my( $req, $args, $error, $values ) = @_;
	genHtmlHead( $req, 'Confirm registration', undef );
	genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Confirm registration', [ [ 'Help', 'help', 'account' ] ], [ [ 'Register', 'register' ] ] );
	print '<div class="error">'.$error.'</div>' if( defined $error );
	print '<p>Email address: '.encode( $values->{'email'} );
	print '<form name="register-confirm" id="register-confirm" method="POST" action="">';
	print '<div class="hidden"><p><input type="hidden" value="'.encode( $values->{'email'} ).'" name="email"><input type="hidden" value="'.encode( $values->{'confirm'} ).'" name="confirm"></div>';
	print '<table>';
	genForm( [ [ 'Login (Optional):', 'text', 'login', 'maxlength="50"' ],
		[ 'Password:', 'password', 'password' ],
		[ 'Confirm password:', 'password', 'confirm_password' ],
		[ '', 'submit', 'register', 'value=Register' ] ], $values );
	print '</table></form>';
	genHtmlFooter( 0, undef, undef );
	return OK;
}

sub usedAddress( $$ ) {
	my( $req, $args ) = @_;
	genHtmlHead( $req, 'Used address', undef );
	genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Used address', [ [ 'Help', 'help', 'account' ] ], [ [ 'Log in', 'login' ], [ 'Reset password', 'respass' ], [ 'Register', 'register' ] ] );
	print '<div class="error">
		<p>
			An account for this address is already registered.
			Please, reset or remember your password or start again with a different address.
		</div>';
	genHtmlFooter( 0, undef, undef );
	return 0;
}

sub checkRegHash( $$$$$ ) {
	my( $req, $args, $tables, $email, $hash ) = @_;
	if( ! checkConfirmHash( $email, $hash ) ) {
		genHtmlHead( $req, 'Invalid registration request', undef );
		print '<h1>Invalid registration request</h1>
			<div class="error">
			<p>
				This registration request is invalid.
				Are you sure you got it from the registration email?
			</div>';
		genHtmlFooter( 0, undef, undef );
		return 0;
	} elsif( $tables->hasEmail( $email ) ) {
		return usedAddress( $req, $args );
	} else {
		return 1;
	}
}

sub confirmForm( $$$$ ) {
	my( $req, $args, $tables, $auth ) = @_;
	return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'};
	if( ! checkRegHash( $req, $args, $tables, $args->{'email'}, $args->{'confirm'} ) ) {
		return OK;
	} else {
		return genConfirmForm( $req, $args, undef, $args );
	}
}

sub passLenCheck( $ ) {
	my( $pass ) = @_;
	return ( ( length $pass ) >= 4 ) ? undef : 'Password must have at least 4 characters';
}

sub passSameCheck( $ ) {
	my( $data ) = @_;
	return ( ( ( defined $data->{'password'} ) != ( defined $data->{'confirm_password'} ) ) || ( ( defined $data->{'password'} ) && ( $data->{'password'} ne $data->{'confirm_password'} ) ) ) ? 'Passwords do not match' : undef;
}

sub confirmSubmit( $$$ ) {
	my( $req, $args, $tables ) = @_;
	my( $data, $error ) = getForm( {
		'email' => sub {
			return emailCheck( shift, $tables );
		},
		'confirm' => undef,
		'login' => sub {
			return loginCheck( shift, $tables );
		},
		'password' => \&passLenCheck,
		'confirm_password' => undef }, [ \&passSameCheck ] );
	return OK if( ! checkRegHash( $req, $args, $tables, $data->{'email'}, $data->{'confirm'} ) );#Not much info, but this is an attack anyway
	return genConfirmForm( $req, $args, $error, $data ) if( defined $error );
	unless( addUser( $tables, $data->{'login'}, $data->{'email'}, $data->{'password'} ) ) {
		usedAddress( $req, $args );
		return OK;
	}
	genHtmlHead( $req, 'Registered', undef );
	genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Registered', [ [ 'Help', 'help', 'account' ] ], [ [ 'Log in', 'login' ] ] );
	print '<p>
			You have registered successfully.';
	genHtmlFooter( 0, undef, undef );
	return OK;
}

sub genLoginForm( $$$$ ) {
	my( $req, $args, $error, $values ) = @_;
	$req->headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'cookie-test', -value => 1 ) );
	genHtmlHead( $req, 'Log in', undef );
	genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Log in', [ [ 'Help', 'help', 'account' ] ], [ [ 'Register', 'register' ], [ 'Reset password', 'respass' ] ] );
	print '<div class="error"><p>'.$error.'</div>' if( defined $error );
	print '<form name="login" id="login" method="POST" action="'.setAddrPrefix( $req->uri(), 'mods' ).buildExcept( 'action', $args ).'?action=login"><table>';
	genForm( [ [ 'Login name or email:', 'text', 'login', 'maxlength="255"' ],
		[ 'Password:', 'password', 'password' ],
		[ '', 'submit', 'login', 'value="Login"' ] ], $values );
	print '</table></form>';
	genHtmlFooter( 0, undef, undef );
	return OK;
}

sub loginForm( $$$ ) {
	my( $req, $args, $tables, $auth ) = @_;
	return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless( $auth->{'ssl'} );
	return genLoginForm( $req, $args, undef, {} );
}

sub loginSubmit( $$$ ) {
	my( $req, $args, $tables ) = @_;
	my( $data, $error ) = getForm( {
		'login' => undef,
		'password' => undef
	}, [] );
	my $logged = 0;
	my $cookies = fetch CGI::Cookie;
	unless( $cookies->{'cookie-test'} ) {
		return genLoginForm( $req, $args, 'You need to enable cookies', $data );
	}
	my( $id, $passwd, $email, $last ) = $tables->getLogInfo( $data->{'login'} );
	if( defined $passwd && defined $data->{'password'} ) {
		my $salted = saltedPasswd( $email, $data->{'password'} );
		$logged = $salted eq $passwd;
	}
	if( $logged ) {
		$req->err_headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'auth', -value => genAuthToken( $tables, $id, $req, undef, $email ) ) );
		$args->{'action'} = ( defined $args->{'redirectaction'} && $args->{'redirectaction'} ne '' ) ? $args->{'redirectaction'} : 'list';
		my $url = 'https://'.$req->hostname().setAddrPrefix( $req->uri(), $args->{'action'} eq 'list' ? 'read' : 'mods' ).buildExcept( 'redirectaction', $args );
		return HTTPRedirect( $req, $url );
	} else {
		return genLoginForm( $req, $args, 'Invalid login credetials', $data );
	}
}

sub logout( $$ ) {
	my( $req, $args ) = @_;
	$req->err_headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'auth', -value => '0' ) );
	return HTTPRedirect( $req, 'http://'.$req->hostname().setAddrPrefix( $req->uri(), 'read' ).buildExcept( 'action', $args ) );
}

sub checkLogin( $$ ) {
	my( $req, $tables ) = @_;
	my $cookies = fetch CGI::Cookie;
	my $cookie = $cookies->{'auth'};
	my( $authed, $id, $regen, $rights, $error, $name ) = checkAuthToken( $tables, $req, defined( $cookie ) ? $cookie->value : undef );
	if( $regen ) {
		$req->headers_out->add( 'Set-Cookie' => new CGI::Cookie( -name => 'auth', -value => genAuthToken( $tables, $id, $req, $rights, $name ) ) );
	}
	my $hterror = $authed ? '' : '<div class="error"><p>'.$error.'</div>';
	return { 'authid' => $authed ? $id : undef, 'accrights' => $rights, 'logerror' => $hterror, 'name' => $authed ? $name : undef };
}

sub notLoggedComplaint( $$$ ) {
	my( $req, $args, $auth ) = @_;
	return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'};
	$args->{'redirectaction'} = $args->{'action'};
	return genLoginForm( $req, $args, 'This action requires you to be logged in', undef );
}

sub genResetPasswdForm( $$$$ ) {
	my( $req, $args, $error, $values ) = @_;
	genHtmlHead( $req, 'Reset password', undef );
	genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Reset password', [ [ 'Help', 'help', 'account' ] ], [ [ 'Log in', 'login' ], [ 'Register', 'register' ] ] );
	print "<p>If you forgot your password (or didn't create one yet), you can reset it to a new value here.\n";
	print "Provide your email address here and further instructions will be sent to you.\n";
	print '<div class="error">'.$error.'</div>' if( defined $error );
	print '<form name="respass" id="respass" method="POST" action="">
		<table>';
	genForm( [ [ 'Email:', 'text', 'email', 'maxlength="255"' ],
		[ '', 'submit', 'respass', 'value="Send"' ] ], $values );
	print '</table></form>';
	genHtmlFooter( 0, undef, undef );
	return OK;
}

sub resetPasswdForm( $$$$ ) {
	my( $req, $args ) = @_;
	return genResetPasswdForm( $req, $args, undef, {} );
}

sub resetPasswdFormSubmit( $$$ ) {
	my( $req, $args, $tables ) = @_;
	my( $data, $error ) = getForm( {
		'email' => undef
	}, [] );
	my( $id, $login, $passwd ) = $tables->resetInfo( $data->{'email'} );
	if( defined( $id ) ) {
		$login = '' unless( defined( $login ) );
		my $site = $req->hostname();
		my $url = 'https://'.$req->hostname().setAddrPrefix( $req->uri(), 'mods' );
		my $hash = genResetHash( $id, $data->{'email'}, $login, $passwd );
		sendMail( $data->{'email'}, 'Reset password',
			"A request to reset password for the $site site was received for this address\n".
			"If you really wish to get a new password, visit this link:\n\n".
			$url.'?action=respass-confirm?email='.$data->{'email'}.'?confirm='.$hash."\n".
			"\n\nThank you\n".
			"\n(This is an autogenerated email, do not respond to it)" );
		genHtmlHead( $req, 'Reset password', undef );
		genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Reset password', [ [ 'Help', 'help', 'account' ] ], [ [ 'Log in', 'login' ] ] );
		print "<p>An email with information has been sent to your address.\n";
		genHtmlFooter( 0, undef, undef );
		return OK;
	} else {
		$error = '<p>This email address is not registered. Check it for typos or register it.';
	}
	return genResetPasswdForm( $req, $args, $error, $data ) if( defined( $error ) );
}

sub genResetPasswdConfigForm( $$$$$$ ) {
	my( $req, $args, $error, $values, $email, $hash ) = @_;
	genHtmlHead( $req, 'Reset password', undef );
	genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Reset password', [ [ 'Help', 'help', 'account' ] ], [ [ 'Log in', 'login' ] ] );
	print '<div class="error">'.$error.'</div>' if( defined $error );
	print "<p>You can enter new password here:\n";
	print '<form name="respass-confirm" id="respass-confirm" method="POST" action="">
		<table>';
	genForm( [ [ 'Password:', 'password', 'password' ],
		[ 'Confirm password:', 'password', 'confirm_password' ],
		[ '', 'submit', 'respass', 'value="Send"' ] ], $values );
	print "</table>";
	print "<input type='hidden' name='email' value='".encode( $email )."'><input type='hidden' name='hash' value='".encode( $hash )."'>\n";
	print "</form>\n";
	genHtmlFooter( 0, undef, undef );
	return OK;
}

sub resetPasswdConfirmForm( $$$$ ) {
	my( $req, $args, $tables, $auth ) = @_;
	my( $email, $hash ) = ( $args->{'email'}, $args->{'confirm'} );
	my( $id, $login, $passwd ) = $tables->resetInfo( $email );
	my $myHash;
	return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'};
	$myHash = genResetHash( $id, $email, $login, $passwd ) if( defined( $id ) );
	if( defined( $myHash ) && ( $myHash eq $hash ) ) {#Ok, it is his mail and he asked
		return genResetPasswdConfigForm( $req, $args, undef, {}, $email, $hash );
	} else {
		genHtmlHead( $req, 'Reset password', undef );
		print "<h1>Reset password</h1>\n";
		print "<p>Provided link is not valid. Did you use it already?\n";
		print "<p>You can get a <a href='".$req->uri()."?action=respass'>new one</a>.\n";
		genHtmlFooter( 0, undef, undef );
		return OK;
	}
}

sub resetPasswdConfirmFormSubmit( $$$ ) {
	my( $req, $args, $tables ) = @_;
	my( $data, $error ) = getForm( {
		'password' => \&passLenCheck,
		'confirm_password' => undef,
		'email' => undef,
		'hash' => undef
	}, [ \&passSameCheck ] );
	my( $email, $hash ) = ( $data->{'email'}, $args->{'confirm'} );
	if( defined( $error ) ) {
		return genResetPasswdConfigForm( $req, $args, $error, $data, $email, $hash );
	} else {
		my( $id, $login, $passwd ) = $tables->resetInfo( $email );
		my $myHash;
		$myHash = genResetHash( $id, $email, $login, $passwd ) if( defined( $id ) );
		if( defined( $myHash ) && ( $myHash eq $hash ) ) {
			changePasswd( $tables, $id, $data->{'password'}, $email );
			genHtmlHead( $req, 'Reset password', undef );
			genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'Reset password', [ [ 'Help', 'help', 'account' ] ], [ [ 'Log in', 'login' ] ] );
			print "<p>Your password was successfuly changed.\n";
			genHtmlFooter( 0, undef, undef );
			return OK;
		} else {
			return genResetPasswdConfigForm( $req, $args, $error, $data, $email, $hash );
		}
	}
}

sub genProfileForm( $$$$$$ ) {
	my( $req, $args, $auth, $error, $data, $info ) = @_;
	genHtmlHead( $req, 'User profile', undef );
	delete $data->{'current_password'};
	delete $data->{'confirm_password'};
	delete $data->{'password'};
	genCustomHead( $req, $args, PciIds::Address::new( $req->uri() ), 'User profile', [ [ 'Help', 'help', 'profile' ] ], [ logItem( $auth ), [ 'Notifications', 'notifications' ] ] );
	print '<div class="error"><p>'.$error.'</div>' if defined $error;
	print "<div class='info'><p>$info</div>\n" if defined $info;
	print '<form name="profile" id="profile" method="POST" action=""><table>';
	genForm( [ [ 'Email:', 'text', 'email', 'maxlength="255"' ],
		[ 'Login:', 'text', 'login', 'maxlength="50"' ],
		[ 'Xmpp:', 'text', 'xmpp', 'maxlength="255"' ],
		[ 'New password:', 'password', 'password' ],
		[ 'Confirm password:', 'password', 'confirm_password' ],
		[ 'Current password:', 'password', 'current_password' ],
		[ 'Email batch time (min):', 'text', 'email_time', 'maxlength="10"' ],
		[ 'Xmpp batch time (min):', 'text', 'xmpp_time', 'maxlength="10"' ],
		[ '', 'submit', 'profile', 'value="Submit"' ] ], $data );
	print '</table></form>';
	genHtmlFooter( 0, undef, undef );
	return OK;
}

sub profileForm( $$$$ ) {
	my( $req, $args, $tables, $auth ) = @_;
	return notLoggedComplaint( $req, $args, $auth ) unless defined $auth->{'authid'};
	return HTTPRedirect( $req, 'https://'.$req->hostname().$req->uri().buildArgs( $args ) ) unless $auth->{'ssl'};
	return genProfileForm( $req, $args, $auth, undef, $tables->profileData( $auth->{'authid'} ), undef );
}

sub checkNum( $$ ) {
	my( $value, $name ) = @_;
	return ( "$name has invalid number format", '0' ) unless ( $value =~ /\d+/ );
	return undef;
}

sub profileFormSubmit( $$$$ ) {
	my( $req, $args, $tables, $auth ) = @_;
	return notLoggedComplaint( $req, $args, $auth ) unless defined $auth->{'authid'};
	my $oldData = $tables->profileData( $auth->{'authid'} );
	my( $data, $error ) = getForm( {
		'email' => sub {
			my $email = shift;
			return undef if ( defined $email ) && ( $email eq $oldData->{'email'} );
			return emailCheck( $email, $tables );
		},
		'login' => sub {
			my $login = shift;
			$login = undef if ( defined $login ) && ( $login eq '' );
			return undef if ( defined $login ) && ( defined $oldData->{'login'} ) && ( $oldData->{'login'} eq $login );
			return ( undef, $login ) if ( !defined $login ) && ( !defined $oldData->{'login'} );
			return loginCheck( $login, $tables );
		},
		'xmpp' => sub {
			my $xmpp = shift;
			return ( undef, undef ) if ( !defined $xmpp ) || ( $xmpp eq '' );
			return "Xmpp address limit is 255" if length $xmpp > 255;
			return "Invalid Xmpp address" unless $xmpp =~ /^([^'"\@<>\/]+\@)?[^\@'"<>\/]+(\/.*)?/;
			return undef;
		},
		'password' => sub {
			my $passwd = shift;
			$passwd = undef if ( defined $passwd ) && ( $passwd eq '' );
			return ( undef, undef ) unless defined $passwd;
			return passLenCheck( $passwd );
		},
		'confirm_password' => undef,
		'current_password' => undef,
		'email_time' => sub {
			return checkNum( shift, "Email batch time" );
		},
		'xmpp_time' => sub {
			return checkNum( shift, "Xmpp batch time" );
		}
	}, [ sub {
		my $data = shift;
		return undef unless defined $data->{'password'};
		return passSameCheck( $data );
	}, sub {
		my $data = shift;
		my $change = 0;
		$change = 1 if $data->{'email'} ne $oldData->{'email'};
		$data->{'login'} = undef if defined $data->{'login'} && $data->{'login'} eq '';
		$oldData->{'login'} = undef if defined $oldData->{'login'} && $oldData->{'login'} eq '';
		$change = 1 if ( ( ( defined $data->{'login'} ) != ( defined $oldData->{'login'} ) ) || ( ( defined $data->{'login'} ) && ( defined $oldData->{'login'} ) && ( $data->{'login'} ne $oldData->{'login'} ) ) );
		$change = 1 if ( defined $data->{'password'} ) && ( $data->{'password'} ne '' );
		return undef unless $change;
		my $logged = 0;
		my( $id, $passwd, $email, $last ) = $tables->getLogInfo( $oldData->{'email'} );
		if( defined $passwd && defined $data->{'current_password'} ) {
			my $salted = saltedPasswd( $email, $data->{'current_password'} );
			$logged = ( $salted eq $passwd ) && ( $id == $auth->{'authid'} );
		}
		return "You need to provide correct current password to change email, login or password" unless $logged;
		return undef;
	} ] );
	return genProfileForm( $req, $args, $auth, $error, $data, undef ) if defined $error;
	pushProfile( $tables, $auth->{'authid'}, $oldData, $data );
	return genProfileForm( $req, $args, $auth, undef, $data, "Profile updated." );
}

1;
