######################################################################
#
#  Modified EPrints Register Account, uses Authen::Captcha
#
######################################################################
#
#  This file is derived from the register CGI script distributed 
# as part of GNU EPrints 2. 
#  
#  Copyright (c) 2007 Mark Muldoon
#  
#  register_captcha is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#  
#  register_captcha 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.
#
######################################################################

######################################################################
#
#  Originial copyright notice from register script:
# 
######################################################################
#
#  This file is part of GNU EPrints 2.
#  
#  Copyright (c) 2000-2004 University of Southampton, UK. SO17 1BJ.
#  
#  EPrints 2 is free software; you can redistribute it and/or modify
#  it under the terms of the GNU General Public License as published by
#  the Free Software Foundation; either version 2 of the License, or
#  (at your option) any later version.
#  
#  EPrints 2 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 EPrints 2; if not, write to the Free Software
#  Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
#
######################################################################

use EPrints::Session;
use strict;

######## Start Captcha stuff ###################
# Here are various parameters that determine
# the appearance and generation of captcha images.
use Authen::Captcha ;

# Paths, relative to the archive root, to the directories
# that will hold the database relating captcha images
# to the text strings they represent
my $captcha_db_relpath = "var/captcha_db" ; # relative to archiveroot
my $captcha_img_relpath = "html/en/images/captcha" ; # relative to archiveroot
my $captcha_img_relurl = "images/captcha" ; # relative to baseurl

# Things affecting the appearance of the images
my $captcha_n_chars = 6 ;

my $captcha_char_width = 35 ;	# pixels
my $captcha_char_height = 50 ;	# pixels

# Captcha images are wiped out - and deleted from
# the database - after a time that you can set here.
my $captcha_lifespan = 300 ; 	# in seconds

# Define names for some strings corresponding to 
# possible verdicts: the strings themselves go into
# the archive's phrase files, for example phrases-en.xml.
my %captcha_verdict_str_name = (
	 1 => "cgi/register:CaptchaVerdictPassed",
	 0 => "cgi/register:CaptchaVerdictFileError",
	-1 => "cgi/register:CaptchaVerdictCodeExpired",
	-2 => "cgi/register:CaptchaVerdictCodeUnknown",
	-3 => "cgi/register:CaptchaVerdictCodeWrong"
) ;
######## End Captcha stuff   ###################

my $session = new EPrints::Session;
exit( 0 ) unless( defined $session );

my( $page, $title ) = make_page( $session );

$session->build_page( $title, $page, "register" );
$session->send_page();

$session->terminate();

sub make_page
{
	my( $session ) = @_;

	unless( $session->get_archive()->get_conf("allow_web_signup") )
	{
		return mk_err_page( 
			$session,
			"cgi/register:no_web_signup" );
	}
	
	my $mlangopt = $session->get_archive()->get_conf("multi_language_options");

	my $user_ds = $session->get_archive()->get_dataset( "user" );

	my $extrafields = $session->get_archive()->get_conf( "extra_reg_fields" );

	my $default_type = $session->get_archive()->get_conf( "default_user_type" ); 
	my $extrafields =  $session->get_archive()->get_conf( "user_registration_fields" );
	$extrafields = [] if( !defined $extrafields );

	my $fieldlist = []; 
	my( $f ) = {};
	foreach my $fieldid ( @{$extrafields} )
	{
		$f->{$fieldid} = $user_ds->get_field( $fieldid )->clone();
		if( $user_ds->field_required_in_type( $f->{$fieldid}, $default_type ))
		{
			$f->{$fieldid}->set_property( "required", 1 );
		}
		push @{$fieldlist}, $f->{$fieldid};
	}

	my @sysfields = ( "email", "username", "newpassword" );
	if( $mlangopt ) { push @sysfields,'lang'; }

	foreach my $fieldid ( @sysfields )
	{
		$f->{$fieldid} = $user_ds->get_field( $fieldid )->clone();
		$f->{$fieldid}->set_property( "confid" , "register" );
		$f->{$fieldid}->set_property( "required", 1 );
		push @{$fieldlist}, $f->{$fieldid};
	}

	if( !$session->have_parameters() )
	{
		my $page = $session->make_doc_fragment;
		$page->appendChild( $session->html_phrase( "cgi/register:intro" ) );
		my $defaults = { lang => $session->get_langid() };
		$page->appendChild( make_reg_form( $session, $fieldlist, $defaults ));
		
		my $title = $session->html_phrase( "cgi/register:title" );
		return( $page, $title );
	}

	if( $session->have_parameters() )
	{
		
	}
	# Process the form.
	my $v = { lang => $session->get_langid() };
	foreach my $field ( @{$fieldlist} )
	{
		$v->{$field->get_name} = $field->form_value( $session );
	}
	foreach my $field ( @{$fieldlist} )
	{
		if( !EPrints::Utils::is_set( $v->{$field->get_name} ) 
			&& $field->get_property( "required" ) )
		{
			return mk_err_page( 
				$session,
				"cgi/register:missing_field",
				$fieldlist,
				$v,
				{fieldname=>$field->render_name($session)} );
		}
	}
	
	######## Start Captcha stuff ###################
	
	# Create a new object
	my $captcha = setup_captcha_obj( $session ) ;

	# Get the MD5 sum from the form and then check 
	# whether the user has entered the right string.
	my $usr_captcha_str = $session->param( "captcha_str" ) ;
	$usr_captcha_str =~ s/^\s+// ; # remove leading ...
	$usr_captcha_str =~ s/\s+$// ; # .. and trailing space.
	
	my $MD5_sum = $session->param( "captcha_MD5" ) ;
	my $verdict = $captcha->check_code( $usr_captcha_str, $MD5_sum ) ;
	if( $verdict != 1 ) 
	{
# 		$session->get_archive()->log( 
# 				"Captcha: usr_str = \"$usr_captcha_str\"; MD5_sum = $MD5_sum.\n" ) ;
		return mk_err_page( 
			$session,
			$captcha_verdict_str_name{ $verdict }, 
			$fieldlist,
			$v,
			{email=>$session->make_text( $v->{email} )} );
	}
	######## End Captcha stuff   ###################

	if( defined EPrints::User::user_with_email( $session, $v->{email} ) )
	{
		return mk_err_page( 
			$session,
			"cgi/register:email_exists", 
			$fieldlist,
			$v,
			{email=>$session->make_text( $v->{email} )} );
	}

	if( defined EPrints::User::user_with_username( $session, $v->{username} ) )
	{
		return mk_err_page( 
			$session,
			"cgi/register:username_exists", 
			$fieldlist,
			$v,
			{username=>$session->make_text( $v->{username} )} );
	}

	my $user = EPrints::User::create_user( $session, $default_type );
	foreach my $fieldid ( keys %{$f} )
	{
		$user->set_value( $fieldid, $v->{$fieldid} );
	}

	my $page = $session->make_doc_fragment;
	$page->appendChild( $session->html_phrase( 
		"cgi/register:created_new_user",
			email=>$session->make_text( $v->{email} ),
			username=>$session->make_text( $v->{username} ) ) );

	my $pin = sprintf( "%04X%04X%04X%04X",int rand 0xffff,int rand 0xffff,int rand 0xffff,int rand 0xffff );
	$user->set_value( "newemail", undef );
	$user->set_value( "pin", $pin );
	$user->set_value( "pinsettime", time() );
	$user->commit();

	# If email fails then we should abort
	my $rc = $user->mail( 
		"cgi/register:account",
		$session->html_phrase( 
			"mail_password_pin", 
			confirmurl => $session->make_text( $session->get_archive()->get_conf( "perl_url" )."/confirm?userid=".$user->get_value( "userid" )."&pin=".$pin ),
			username => $user->render_value( "username" ) ) );

	if( !$rc )
	{
		# couldn't send email, so remove the user object again
		# and apologise
		$user->remove();
		return mk_err_page(
			$session,
			"general:email_failed",
			$fieldlist,
			$v,
			{} );
	}

#`	$page->appendChild( $session->html_phrase( "general:frontpage_link" ) );

	my $title = $session->html_phrase( "cgi/register:title" );
	return( $page, $title );
}


sub mk_err_page
{
	my( $session, $phrase, $fieldlist, $defaults, $opts ) = @_;

	my $page = $session->make_doc_fragment;
	my $problems = $session->make_element( "div",class=>'problems' );
	$page->appendChild( $problems );
	$problems->appendChild( $session->html_phrase( $phrase, %{$opts} ) );
#	$page->appendChild( $session->html_phrase( "general:frontpage_link" ) );
	if( defined $fieldlist )
	{
		#$page->appendChild( $session->render_ruler );
		$page->appendChild( make_reg_form( $session, $fieldlist, $defaults ) );
	}

	return( 
		$page,	
		$session->html_phrase( "cgi/register:error" ) );
}

sub make_reg_form
{
	my( $session, $fieldlist, $defaults ) = @_;
	
	######## Start Captcha stuff ###################
	# Wipe out any previous efforts
	$defaults->{captcha_str} = undef ; 
	
	# Construct a field for the captcha text and,
	# at the smae time, prepare a fresh image.
	my $captcha_field =  make_captcha_field( $session ) ;
	push @{$fieldlist}, $captcha_field ;
	######## End Captcha stuff   ###################

	######## End Captcha stuff   ###################

	$defaults->{newpassword} = undef;		

	return $session->render_input_form(
			fields=>$fieldlist,
			values=>$defaults,
			show_help=>1,
			show_names=>1,
			comments=>{above_buttons=>$session->html_phrase( "cgi/register:register_agreement" )},
			default_action=>"submit",
			buttons=>{
				submit=>$session->phrase( "cgi/register:action_submit" )
			},
			
			######## Start Captcha stuff ###################
			# Add a hidden item that retains a record  
			# of which captcha image we've displayed.
			hidden_fields => { "captcha_MD5" => $captcha_field->{ "MD5_sum" } }, 
			######## End Captcha stuff   ###################

			dest=>"register" 
	);
}

######## Start Captcha stuff ###################
# Here are some functions to make the process
# of captcha generation and checking look tidy.

sub setup_captcha_obj
######################################################
#	my $captcha_obj = setup_captcha_obj() ;
#
#	Create a new Auten::Captch object and install
# the parameter values from the top of the file.
#
{
	my( $session ) = @_ ;

	# Construct some paths
	my $archive = $session->get_archive() ;
	my $archive_root_dir = $archive->get_conf( 'archiveroot' ) ;
	my $url_root_dir = $archive_root_dir . $archive->get_conf( 'urlpath' ) ;
	
	# Create a new object, setting various params at a stroke
	my $captcha = Authen::Captcha->new(
		data_folder => "$archive_root_dir/$captcha_db_relpath",
		output_folder => "$url_root_dir/$captcha_img_relpath",
		width => $captcha_char_width,
		height => $captcha_char_height,
		expire => $captcha_lifespan
	) ;
	
	# Return that puppy
	return( $captcha ) ;
}
######################################################

sub make_captcha_field
######################################################
#	my $captcha_field = make_captcha_field() ;
#
#	Create an input field for the registration form:
# here "field" is in the sense of EPrints::MetaField.
# Or, well, in the sense of my understanding of the
# the code there, which is probably, at the most 
# charitable, incomplete.
#
{
	my( $session ) = @_ ;
	
	# Create a captcha object and then an image. 
	# Image filename is "$captcha_md5sum.png"
	my $captcha = setup_captcha_obj( $session ) ;
	my $MD5_sum = $captcha->generate_code( $captcha_n_chars ) ;
	
	# Get am URL for the image file
	my $captcha_img_url = $session->get_archive->get_conf( "base_url" ) . 
								"/$captcha_img_relurl/$MD5_sum.png" ;

	# Create the MetaField, as a standard text field.
	my $captcha_field = EPrints::MetaField->new(
							# Core attributes of a field
							"archive" => $session->get_archive(),
							"confid" => "register",
							"name" => "captcha_str",
							"required" => 1,
							"type" => "text",
							
							# Stuff to exploit standard EPrints machinery
							"maxlength" => 2 * $captcha_n_chars,
							"render_input" => \&render_captcha_field,			
						) ;
						
	# Sneak a few extra properties into the field once
	# it has been created. This circumvents some warnings
	# in EPrints::MetaField->new().
	$captcha_field->{ "img_url" } = $captcha_img_url ;
	$captcha_field->{ "MD5_sum" } = $MD5_sum ;
	
	# Return that puppy
	return( $captcha_field ) ;
}
######################################################

sub render_captcha_field
######################################################
#	render_captcha_field
#
#	This is a rendering function in the style of
# the EPrints::MetaData::render_input_field(). It
# draws the image, then places a text box below it.
#
{
	my( $field, $session, $value, $dataset, $type, $staff, $hidden_fields, $obj ) = @_ ;
	
	# Place the image
	my $html = $session->make_doc_fragment() ;
	my $div = $session->make_doc_fragment( "div", class => "captcha_image" ) ;
	$div->appendChild( 
		$session->make_element( 
			"img", 
			"src" =>  $field->{ "img_url" }, 
			"class" => "captcha_image" 
		) 
	) ;
	
	$html->appendChild( $div ) ;
	$html->appendChild( $session->make_element( "br" ) ) ;
	
	# Now invoke the standard rendering function to actually make the text box.
	$html->appendChild(
		$field->render_input_field_actual( 
			$session, 
			$value, 
			$dataset, 
			$type, 
			$staff,
			$hidden_fields,
			$obj 
		)
	) ;
	
	return( $html ) ;
}
######## End Captcha stuff   ###################