openmamba-website/wwwroot/cgi-bin/form.cgi

#!/usr/bin/perl

use strict;
use Carp;
use CGI qw(:standard);
use GD::SecurityImage;
use Digest::MD5 qw(md5_hex);

my $captcha_on = 1;
my $captcha_font = "/usr/share/fonts/truetype/FreeSansBold.ttf";
my $output_dir = "/var/www/www.openmamba.org/captcha";
my $www_output_dir = "/captcha";
my $www_address = "topix.openmamba.org";
my $db_dir = "/var/www/www.openmamba.org/captcha";
my $users_homedir = "/var/www/www.openmamba.org/people";
my $users_datadir = "/var/www/www.openmamba.org/people/data";

my $num_of_characters = 5;
my $expire = 300;

my $emaildest = "silvan.calarco\@mambasoft.it";
my $emailsender = "noreply\@openmamba.org";
my $sendmail = "/usr/sbin/sendmail -t";

my $failmsg="";

&main;

sub main
{
        my $check_res = 0;

	# import any get or post variables into the Q namespace
	&load_cgi_variables();
	if ($Q::formsubmit)
	{
             my $res = 1;
             check_fields();
             if ($captcha_on) { $res=&check_code($Q::code, $Q::crypt); }
             if ($res == 1) {
                 if ($failmsg eq "") {
                    $check_res = &send_mail();
                    if ($check_res == 0) {
                      print header;
                      print "OK";
                      exit 0;
                    } else {
                      $failmsg = "error submitting the form, please contact the webmaster<br>";
                    }
                 }
             } elsif ($res == -1) {
                 $failmsg = "$failmsg code has expired<br>";
             } elsif ($res == -3) {
                 $failmsg = "$failmsg control code is not correct<br>";
             } else {
                 $failmsg = "general error ($res), please contact the webmaster<br>";
             }
             if ($captcha_on) { &default; } else { print header; }
             print "Please correct the following errors and submit the form again:";
             print "<br><font color=red>$failmsg</font><br>"; 
	} else {
                if ($captcha_on) {
		   &default;
                   print "<br><br>";
                } else {
                   print header;
	           print "<input type=hidden name=crypt value=\"\" id=crypt>";
                   print "<input type=hidden name=code value=\"\" id=code>\n";
                }
	}
}

sub check_fields
{
  ($Q::fullname) or $failmsg = "$failmsg username not entered<br>";
  ($Q::email) or $failmsg = "$failmsg email not entered<br>";
  ($Q::country) or $failmsg = "$failmsg country not selected<br>";
}

sub send_mail
{
  my $content = "User $Q::alias has just registered $www_address\n";
  my $subject = "A new user has registered on $www_address";

  open(SENDMAIL, "|$sendmail") or die "Cannot open $sendmail: $!";
#  print SENDMAIL $reply_to;
  print SENDMAIL "Subject: $subject\n";
  print SENDMAIL "From: $emailsender\n";
  print SENDMAIL "To: $emaildest\n";
  print SENDMAIL "Content-type: text/plain\n\n";
  print SENDMAIL "$content\n";
  close(SENDMAIL);

  open(OUTF, ">$users_homedir/" . $Q::alias . ".html") or die "Cannot create file $users_homedir/$Q::alias.html: $!";
  print OUTF "<h1>$Q::alias home page</h1><br>";
  close(OUTF);

  open(OUTF, ">$users_datadir/$Q::alias") or die "Cannot create file $users_datadir/${Q::alias}: $!";
  print OUTF "name=\"$Q::fullname\n\"";
  print OUTF  "email=\"$Q::email\n\"";
  print OUTF  "phone=$Q::phone\n";
  print OUTF  "country=$Q::country\n";
  print OUTF  "address1=$Q::address1\n";
  print OUTF  "address2=$Q::address2\n";
  print OUTF  "city=$Q::city\n";
  print OUTF  "zip=$Q::zip\n";
  print OUTF  "password=$Q::password\n";
  print OUTF  "roles=(";
  ($Q::role_supporter) and print OUTF "role_supporter ";
  ($Q::role_sponsor) and print OUTF "role_sponsor ";
  print OUTF  ")\n"; 
  close(OUTF);
  
  return 0;
}


sub touch_file
{
        my $file = shift;
        # create database file if it doesn't already exist
        if (! -e $file)
        {
                open (DATA, ">>$file") or die "Can't create File: $file\n";
                close(DATA);
        }
}

sub write_code
{
        my $code = shift;
        my $md5 = shift;

        my $database_file = File::Spec->catfile($db_dir,'codes.txt');

        # set a variable with the current time
        my $current_time = time;

        # create database file if it doesn't already exist
        touch_file($database_file);

        # clean expired codes and images
        open (DBFILE, "<$database_file")  or die "Can't open File: $database_file\n";
                flock DBFILE, 1;  # read lock
                my @data=<DBFILE>;
        close(DBFILE);

        my $new_data = "";
        foreach my $line (@data)
        {
                $line =~ s/\n//;
                my ($data_time,$data_code) = split(/::/,$line);
                if ( (($current_time - $data_time) > $expire) ||
                     ($data_code  eq $md5) )
                {       # remove expired captcha, or a dup
                        my $png_file = File::Spec->catfile($output_dir,$data_code . ".png");
                        unlink($png_file) or carp("Can't remove png file [$png_file]\n");
                } else {
                        $new_data .= $line."\n";
                }
        }

        # save the code to database
#        warn "open File: $database_file\n" if($self->debug() >= 2);
        open(DBFILE,">$database_file")  or die "Can't open File: $database_file\n"
;
                flock DBFILE, 2; # write lock
#                warn "-->>" . $new_data . "\n" if($self->debug() >= 2);
#                warn "-->>" . $current_time . "::" . $md5."\n" if($self->debug()>= 2);
                print DBFILE $new_data;
                print DBFILE $current_time."::".$md5."\n";
        close(DBFILE);
}

sub default
{
#	my $md5sum = $captcha->generate_code($num_of_characters);
        my $image = GD::SecurityImage->new(width   => 100,
                                   height  => 50,
				   ptsize  => 22,
                                   lines   => 10,
#				   scramble => 1,
				   rndmax => 5,
				   angle => 360,
#				   thickness => 1,
				   send_ctobg => 1,
				   bgcolor => '#ffffff',
				   font => $captcha_font,
                                   gd_font => 'giant');
        $image->random("");
	#$your_random_str);
        $image->create( "ttf","ec","#0000CC","#c8c8CC");
	#normal => 'circle');
	$image->particle(350,1);
        my($image_data, $mime_type, $random_number) = $image->out;
	my $md5sum=md5_hex($random_number);
	
        open(PNGFILE,"> $output_dir/$md5sum.png");
        print PNGFILE $image_data;
        close(PNGFILE);

        write_code($random_number, $md5sum);

	print header;
	print "<input type=hidden name=crypt value=\"$md5sum\" id=crypt><br>
	<table border=0><tr>
	<td>Please, enter the code in the image on the right:
	  <INPUT TYPE=text name=code id=code size=5></td>
	<td align=\"center\"><img src=\"$www_output_dir/$md5sum.png\"><br>
          <a href=\"javascript://\" onclick=javascript:formScript.update();><font size=-1>load a new code</font></a>
        </td>
	</tr></table>\n";
}

sub check_code 
{
	my ($code, $crypt) = @_;

	$code = lc($code);
	
#	warn "$code  $crypt\n" if($self->debug() >= 2);

	my $current_time = time;
	my $return_value = 0;
	my $database_file = File::Spec->catfile($db_dir,"codes.txt");

	# create database file if it doesn't already exist
	touch_file($database_file);

	# zeros (0) and ones (1) are not part of the code
	# they could be confused with (o) and (l), so we swap them in
	#$code =~ tr/01/ol/;

	my $md5 = md5_hex($code);
	
	# pull in current database
#	warn "Open File: $database_file\n" if($self->debug() >= 2);
	open (DBFILE, "<$database_file")  or die "Can't open File: $database_file\n";
		flock DBFILE, 1;  # read lock
		my @data=<DBFILE>;
	close(DBFILE);
#	warn "Close File: $database_file\n" if($self->debug() >= 2);

	my $passed=0;
	# $new_data will hold the part of the database we want to keep and 
	# write back out
	my $new_data = "";
	my $found;
	foreach my $line (@data) 
	{
		$line =~ s/\n//;
		my ($data_time,$data_code) = split(/::/,$line);
		
		my $png_file = File::Spec->catfile($output_dir,$data_code . ".png");
		
	        if ($data_code eq $crypt)
		{
			# the crypt was found in the database
			if (($current_time - $data_time) >$expire)
			{ 
#				 warn "Crypt Found But Expired\n" if($self->debug() >= 2);
				# the crypt was found but has expired
				$return_value = -1;
			} else {
#				warn "Match Crypt in File Crypt: $crypt\n" if($self->debug() >= 2);
				$found = 1;
                        }
			# remove the found crypt so it can't be used again
#			warn "Unlink File: " . $png_file . "\n" if($self->debug() >= 2);
			unlink($png_file) or carp("Can't remove png file [$png_file]\n");
		} elsif (($current_time - $data_time) > $expire) {
			# removed expired crypt
#			warn "Removing Expired Crypt File: " . $png_file ."\n" if($self->debug() >= 2);
			unlink($png_file) or carp("Can't remove png file [$png_file]\n");
		} else {
			# crypt not found or expired, keep it
			$new_data .= $line."\n";
		}
	}

	if ($md5 eq $crypt)
	{
#		warn "Match: " . $md5 . " And " . $crypt . "\n" if($self->debug() >= 2);
		# solution was correct
		if ($found)
		{
			# solution was correct and was found in database - passed
			$return_value = 1;
		} elsif (!$return_value) {
			# solution was not found in database
			$return_value = -2;
		}
	} else {
#		warn "No Match: " . $md5 . " And " . $crypt . "\n" if($self->debug() >= 2);
		# incorrect solution
		$return_value = -3;
	}

	# update database
	open(DBFILE,">$database_file")  or die "Can't open File: $database_file\n";
		flock DBFILE, 2; # write lock 
		print DBFILE $new_data;
	close(DBFILE);
	
	return $return_value;
}

sub load_cgi_variables
{
	my $cgi = new CGI;
	$cgi->import_names('Q');
}