package Baseweb::Authentication;

use 5.014002;
use strict;
use warnings;
use Digest::SHA qw(sha256_hex hmac_sha1);
use CGI;
use CGI::Cookie;
use HTML::Template;
use Convert::Base32;
use URI::Escape;

require Exporter;

our @ISA = qw(Exporter);

our %EXPORT_TAGS = ( 'all' => [ qw(
	
) ] );

our @EXPORT_OK = ( @{ $EXPORT_TAGS{'all'} } );

our @EXPORT = qw(
	
);

=head1 NAME

Baseweb::Authentication - Handle the authentication and sessions of users within web-based application development

BaseWeb creates a web platform that takes care of application authentication, session handling, and basic web templates.  It also has support for using the Google Authenticator one-time-password solution.


=head1 VERSION

Version 0.03

=cut

our $VERSION = '0.03';

=head1 SYNOPSIS

=cut



=head1 FUNCTIONS

=cut 

=head2 new

Creates a new session function

	use Baseweb::Authentication;

	my $bw = Baseweb::Authentication->new({
		title	=> 'My Application Title',
		footer	=> 'The default footer message',
		cgi	=> $cgi,
		dbh	=> $dbh,
		timeout	=> 900,
		otp	=> 1
	});

title - set the title of the application (mandatory)
cgi - specify the CGI handle (mandatory)
dbh - specify the DBI handle (mandatory)
timeout - Specifies the time before the session expires (default is 900 seconds)
otp - Specifies if the Google Authenticator plugin should be used (default is 0)
footer - Specifies the message to display at the footer message

=cut	

sub new
{
	my ($class,$ref) = @_;
	my $self = {};
	bless $self, ref $class || $class;

	my %OPTIONS = %{$ref};

	# save the CGI and DBH variables... We'll use them quite a few times.
	$self->{cgi}	 	= $OPTIONS{cgi};
	$self->{dbh} 		= $OPTIONS{dbh};
	$self->{otp} 		= $OPTIONS{otp} 	? $OPTIONS{otp} 	: 0;
	$self->{title}		= $OPTIONS{title}	? $OPTIONS{title} 	: 'Default title';
	$self->{timeout}	= $OPTIONS{timeout}	? $OPTIONS{timeout}	: 900;
	$self->{footer}		= $OPTIONS{footer}	? $OPTIONS{footer}	: 'Default footer';
 
	# == read cookies
	my %cookies = CGI::Cookie->fetch;
	if($cookies{sessionid})
	{
		$self->{sessionid} = $cookies{sessionid}->value;
	}
 
	# == If the cookie is corrupt or missing, create a new session
	if($self->{sessionid} !~ /^[a-f0-9]{64}$/)
	{
		# TODO -- yeah, about that... make this more random
		$self->{sessionid} = lc(sha256_hex ((rand * time * $$ . $ENV{REMOTE_ADDR} . $ENV{USER_AGENT})));
	}
 
	# == create a cookie
	my $s = 0;

	# if we're over SSL, set the cookie to secure
	if($ENV{HTTPS} =~ /on/)
	{
		$s = 1;
	}
	$self->{cookie} = CGI::Cookie->new(-name => 'sessionid',-value => $self->{sessionid}, -httponly => 1, -secure => $s, -expires => '+1d');

	# == setup the HTML template
	$self->{tmpl} = HTML::Template->new(filename => 'template.tmpl', die_on_bad_params => 0);

	if($self->{otp} == 1)
	{
		$self->render_param('useotp','true');
	}

	$self->render_param('title',$self->{title});
	$self->render_param('footer',$self->{footer});

	return $self;
} 

=head2 authenticate

Handles the main authentication of the process

=cut

sub authenticate
{
	my ($self) = @_;

	# == grab the basic variables that may be passed from the form
	my $username	= $self->{cgi}->param('username');
	my $password	= $self->{cgi}->param('password');
	my $password1	= $self->{cgi}->param('password1');
	my $password2	= $self->{cgi}->param('password2');
	my $otp		= $self->{cgi}->param('otp');
	my $func	= $self->{cgi}->param('func');

	if(!$self->validate())
	{
		# == go here if the user did not validate his session
		if($username eq '')
		{
			print $self->render_output("LOGIN","1");
			$self->{dbh}->disconnect();
			exit(0);
		}
		else
		{
			# do the logon thing

			my $uid = $self->logon($username,$password,$otp);

			if($uid ne '0')
			{
				# I placed housekeeping here.. This will ensure it runs at least when a user logs on.  We could move this to it's
				# own cronjob.
				$self->housekeeping();

				# == update the last logon time
				$self->{dbh}->do('update x_userlist set i_lastlogon = ? where id = ?',undef,time,$uid);

				$self->auditlog(2,'Access granted','Access has been granted for user ' . $username);
				# == create a session... everything is good...
				$self->render_param('message','Logged on successfully');
				$self->create($uid);
			}
			else
			{
				$self->auditlog(1,'Access denied','Access has been denied for user ' . $username);
				$self->render_param("ERROR","Access denied");
				print $self->render_output("LOGIN","1");
				$self->{dbh}->disconnect();
				exit(0);
			}
		}
	}

	# == show the menus we want to see when we're logged on ok
	$self->render_menu(1,'Logout','?func=logout');
	$self->render_menu(1,'Change password','?func=changepassword');
	if($self->{otp} == 1)
	{
		$self->render_menu(1,'OTP','?func=registerotp');
	}

	# ================ if you made it this far, we authenticatd ok! =============

	# == handle a change of password now..
	if($func eq 'changepassword')
	{
		if($password1 ne $password2 || $password1 eq '')
		{
			if($password1 ne $password2)
			{
				$self->render_param('error','Your passwords do not match!');
			}

			print $self->render_output('changepassword','true');
			$self->{dbh}->disconnect();
			exit(0);
		}

		# TODO -- we may want to do some complexity checks

		if(length($password1) < 7)
		{
			$self->render_param('error','Your password is not long enough.');
			print $self->render_output('changepassword','true');
			$self->{dbh}->disconnect();
			exit(0);
		}

		$self->changepassword($password1);
		$self->render_param('message','Password changed.');
		$self->auditlog(4,'Password changed','Password has been changed');
	}

	# == handle the registration of a one time password
	if($func eq 'registerotp' && $self->{otp} == 1)
	{
		my $key = $self->otp_generatekey();

		# produce the QR code
		my $img = $self->otp_qrcode($self->username(),$key,uri_escape($self->{title}));

		$self->render_param('OTPQR',$img);
		print $self->render_output('OTP',$key);
		$self->{dbh}->disconnect();
		exit(0);
	}

	if($func eq 'validateotp' && $self->{otp} == 1)
	{
		my $key = $self->{cgi}->param('key');
		my $otp = $self->{cgi}->param('otp');

		if($self->otp_validate($otp,$key))
		{
			# it's been validated, so now we update the database table.
			if($self->{dbh}->do('update x_userlist set t_otpkey = ? where id = ?',undef,$key,$self->{id}))
			{
				$self->render_param('message',"The OTP has been set.");
				$self->auditlog(3,'OTP set','The OTP has been set for ' . $self->{username});
			}
			else
			{
				$self->render_param('error','The OTP validated, but there was a problem updating the database.');
			}
		}
		else
		{
			$self->render_param('error',"Did not validate!");
		}
	}
}

=head2 create

The create function will create the session variables to indicate the session is now valid.

=cut 

sub create
{
	my ($self,$uid) = @_;

	$self->setvar('timestamp',time);
	$self->setvar('uid',$uid);
	$self->{id} = $uid;
}

=head2 validate

This procedure checks the session validity.  It reads the cookie, and checks if it was updated in the last timeout period.
=cut

sub validate
{
	my ($self) = @_;

	# == the logout feature must sit here.. If we log out, then the validation must fail.
	if($self->{cgi}->param('func') eq 'logout')
	{
		$self->auditlog(3,'Logged out','User has been logged out');
		$self->render_param('message','You have been logged out');
		$self->terminate();
		return 0;
	}

	my $age = time - $self->getvar('timestamp');
	if($age < $self->{timeout})
	{
		# we are within the timeout bracket
		$self->setvar('timestamp',time);

		# grab the uid variable (you'll need it again!)
		$self->{id} = $self->getvar('uid');
		return 1;
	}
	else
	{
		# session timed out
		return 0;
	}
}

=head2 logon

Checks the user table to see if the username and password matches what we have on file.

=cut

sub logon
{
	my ($self,$username,$password,$otp) = @_;

	# find the entry in the database

	my $sth = $self->{dbh}->prepare('select id,t_otpkey from x_userlist where t_username = ? and t_password = ?');

	if($sth->execute($username,sha256_hex($password)))
	{
		my $otpkey;

		($self->{id},$otpkey) = $sth->fetchrow_array();

		# if we have a one time password key in the database...
		my $o = 0;
		if($otpkey ne '' && $self->{otp} == 1)
		{
			$o = $self->otp_validate($otp,$otpkey);
		}	
		else
		{
			$o = 1;
		}

		if($self->{id} ne '' && $o == 1)
		{
			return $self->{id};
		}
	}
	else
	{
		# create the table
		$self->{dbh}->do('create table x_userlist (id integer auto_increment primary key,t_username varchar(200),t_password varchar(64),t_otpkey varchar(20),i_lastlogon integer, i_lastpwdchg integer)');
		$self->{dbh}->do('create index idx_username on x_userlist (t_username) ');

		# create the default username and password

		my $defuser = "admin";
		my $defpass = "password";	
		
		$self->{dbh}->do('insert into x_userlist (t_username,t_password,i_lastpwdchg) values(?,?,?)',undef,$defuser,sha256_hex($defpass),time);
		return $self->logon($username,$password);
	}

	return 0;
}

=head2 changepassword

Changes the current logged on user's password

=cut

sub changepassword
{
	my ($self,$newpass) = @_;

	$self->{dbh}->do('update x_userlist set t_password = ?,i_lastpwdchg = ? where id = ?',undef,sha256_hex($newpass),time,$self->{id});
}

=head2 auditlog

Logs the events for auditing and tracking 

=cut

sub auditlog
{
	my ($self,$level,$status,$message) = @_;

	if(!$self->{dbh}->do('insert into x_auditlog (i_level,t_status,t_message,i_timestamp,t_ip,t_useragent,i_userid) values (?,?,?,?,?,?,?)',undef,$level,$status,$message,time,$ENV{REMOTE_ADDR},$ENV{HTTP_USER_AGENT},$self->{id}))
	{
		$self->{dbh}->do('create table x_auditlog (id integer auto_increment primary key,i_level integer, t_status varchar(30), t_message varchar(200), i_timestamp integer, t_ip varchar(30), t_useragent varchar(250),i_userid integer)');

		$self->auditlog($self->{dbh},$level,$status,$message);
	}
}

=head2 header

Similar to CGI header..

=cut 

sub header
{
	my ($self) = @_;
	# TODO -- we need to find a way to make this header act like the CGI header by passing any variable right through, and adding
	# the cookie to it..
	return $self->{cgi}->header(-cookie=>$self->{cookie});
}

=head2 setvar

Sets a variable for the session

=cut

sub setvar
{
	my ($self,$p,$v) = @_;

	if(!$self->{dbh}->do('replace into x_sessions (t_session,t_param,t_value) values (?,?,?)',undef,$self->{sessionid},$p,$v))
	{
		$self->create_session_table();
	}
}

=head2 getvar

Gets a variable for the session

=cut

sub getvar
{
	my ($self,$p) = @_;

	my $sth = $self->{dbh}->prepare('select t_value from x_sessions where t_session = ? and t_param = ?');
	if($sth->execute($self->{sessionid},$p))
	{
		my (@ary) = $sth->fetchrow_array();
		$sth->finish();

		return $ary[0];
	}
	else
	{
		$self->create_session_table();
		return '';
	}
}

=head2 create_session_table
Creates the session table if it doesn't exist yet

=cut

sub create_session_table
{
	my ($self) = @_;

	if($self->{dbh}->errstr() =~ /Table .+ doesn\'t exist/)
	{
		$self->{dbh}->do("create table x_sessions (id integer auto_increment primary key,t_session varchar(200), t_param varchar(20), t_value varchar(255))");

		$self->{dbh}->do("create unique index idx_session on x_sessions (t_session,t_param);");
	}
}

=head2 update

The update function will update the session ID as being a valid session id.  Run this every time the user does anything to prevent the automatic account logout.

=cut 

sub update 
{
	my ($self,$id) = @_;

	if(!$self->{dbh}->do("update x_sessions set i_time = ? where t_session = ?",undef,time,$id))
	{
		$self->create_session_table();
		$self->update($id);
	}
}

=head2 terminate

Kills any trace of the session by deleting all it's variables.  This is the same as logging off completely.

=cut

sub terminate
{
	my ($self) = @_;

	$self->{dbh}->do('delete from x_sessions where t_session = ?',undef,$self->{sessionid});
}

=head2 render_output

Renders the output HTML from the template.tmpl file.

	$bw->render_output('page','content');

=cut

sub render_output
{
	my ($self,$page,$content) = @_;

	$self->{tmpl}->param(menu1  => \@{$self->{menu}->{1}}	);
	$self->{tmpl}->param(menu2  => \@{$self->{menu}->{2}}	);
	$self->{tmpl}->param(menu3  => \@{$self->{menu}->{3}}	);


	$self->{tmpl}->param(fields => \@{$self->{form}}	);
	$self->{tmpl}->param($page  => $content			);

	return $self->{tmpl}->output();
}

=head2 render_param

Sets a variable, just like HTML::Template

	$bw->render_param('text','value');

=cut

sub render_param
{
	my ($self,$text,$value) = @_;

	$self->{tmpl}->param($text => $value);
}

=head2 render_menu

Adds a menu item

	$bw->render_menu(1,'Google','http://www.google.com');

=cut

sub render_menu
{
	my ($self,$menu,$text,$link) = @_;

	my %mnu = (text => $text, link => $link);

	push(@{$self->{menu}->{$menu}},\%mnu);
}

=head2 housekeeping

Performs database housekeeping, like deleting old sessions from the session tables.

	$bw->housekeeping();

=cut

sub housekeeping
{
	# housekeeping procedure... Run this once in a while to keep things tight
	my ($self) = @_;

	my $sth = $self->{dbh}->prepare("select t_session from x_sessions where t_param = 'timestamp' and from_unixtime(t_value) < (now() - ?)");
	if($sth->execute($self->{timeout}))
	{
		while (my ($ts) = $sth->fetchrow_array())
		{
			$self->{dbh}->do('delete from x_sessions where t_session = ?',undef,$ts);
		}
	}

	
}

=head2 username

Returns the username for the current logged on user

=cut

sub username
{
	my ($self) = @_;

	my $u;

	my $sth = $self->{dbh}->prepare('select t_username from x_userlist where id = ?');
	if($sth->execute($self->{id}))
	{
		($u) = $sth->fetchrow_array();
		$sth->finish();
	}	
	return $u;
}

=head2 otp_generatekey

Generates a unique key to be used when using the one time password module.

	my $key = $bw->otp_generatekey();

=cut

sub otp_generatekey
{
	my ($self) = @_;

	my $ch;
	for(my $k=0;$k<10;$k++)
	{
		$ch .= chr(rand(255));
	}
	return uc(encode_base32($ch));
}

=head2 otp_validate

Validates the provided one time password against the key.  It will allow for a one minute drift in time.

	if($bw->otp_validate($otp,$key))
	{
		print "success";
	}
	else
	{
		print "failure";
	}

=cut

sub otp_validate
{
	my ($self,$otp,$key) = @_;

	# == check if the OTP is a 6 digit number,if not, fail straight away

	if($otp !~ /^[0-9]{6}$/)
	{
		return 0;
	}

	for(my $k = -1;$k<=1;$k++)
	{
		my $calc_otp = $self->otp_generate($key,$k);
		if($otp eq $calc_otp)
		{
			return 1;
		}
	}
	return 0;
}

=head2 otp_generate

Generates the OTP based on the key we have.

	my $code = $bw->otp_generate($key,$internal);

=cut

sub otp_generate
{
	my ($self,$key,$interval) = @_;

	# Turn the key into a standard string, no spaces, all upper case
	$key = uc($key);
	$key =~ s/\ //g;

	# decode the key from base32
	my $key_decoded = decode_base32($key);

	# Read the time, and produce the 30 second slice
	my $time = int(time / 30) + $interval;

	# Pack the time to binary
	$time = chr(0) . chr(0) . chr(0) . chr(0) . pack('N*',$time);

	# hash the time with the key
	my $hmac = hmac_sha1 ($time,$key_decoded);

	# get the offset
	my $offset = ord(substr($hmac,-1)) & 0x0F;

	# use the offset to get part of the hash
	my $hashpart = substr($hmac,$offset,4);

	# get the first number
	my @val = unpack("N",$hashpart);
	my $value = $val[0];

	# grab the first 32 bits	
	$value = $value & 0x7FFFFFFF;
	$value = $value % 1000000;

	return $value;	
}

=head otp_qrcode

Creates the image string for the QR code to scan.  This method is using the Google QR code.  I only did this because the QR code modules are a mess to install.

	my $img = $bw->otp_qrcode('username','secret code','issuer');

	print "<img src=\"$img\">";

=cut

sub otp_qrcode
{
	my ($self,$user,$secret,$issuer) = @_;

	$secret = uc($secret);
	my $text = "otpauth://totp/$user?secret=$secret&issuer=$issuer";

	my $google = "http://chart.apis.google.com/chart?cht=qr&chs=200x200&chl=" . uri_escape($text) . "&chld=H|0";

	return $google;
}

=head1 TODO

* Allow users to register themselves
* I forgot my password!
* I misplaced my OTP device!
* Pretty up the template

=cut

=head1 SEE ALSO

=head1 AUTHOR

Phil Massyn, E<lt>massyn@gmail.com<gt>

=head1 COPYRIGHT AND LICENSE

Copyright (C) 2014 by Phil Massyn

This library is free software; you can redistribute it and/or modify
it under the same terms as Perl itself, either Perl version 5.14.2 or,
at your option, any later version of Perl 5 you may have available.

=cut

