313 lines
9.5 KiB
Plaintext
313 lines
9.5 KiB
Plaintext
|
#!/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');
|
||
|
|
}
|