#!/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 $captcha_md5sum = ""; my $output_dir = "/var/www/www.openmamba.org/captcha"; my $www_output_dir = "/captcha"; my $www_address = "topix2.openmamba.org"; my $db_dir = "/var/www/www.openmamba.org/captcha"; my $regdb_file = "/var/www/www.openmamba.org/cgi-bin/regdb"; 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 = "webmaster\@mambasoft.it"; my $emailsender = "noreply\@openmamba.org"; my $sendmail = "/usr/sbin/sendmail -t"; my $database_file = File::Spec->catfile($db_dir,'codes.txt'); my $failmsg=""; &main; sub main { open(FILE, "config") || die "Error: cannot open configuration file."; while () { chomp; # no newline s/#.*//; # no comments s/^\s+//; # no leading white s/\s+$//; # no trailing white next unless length; my ($var, $value) = split(/\s*=\s*/,$_,2); # print "assignment:$var=$value"; eval("\$$var=$value;"); } 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) { # write one time code for register.php script if ($captcha_on) { generate_captcha(1); } my $md5sum=md5_hex(rand()); open(DBFILE,">>$database_file") or die "Can't open File: $database_file\n"; flock DBFILE, 2; # write lock print DBFILE "0::".$md5sum."\n"; close(DBFILE); print "Location:/scripts/register.php?user_login=$Q::alias&user_email=$Q::email&code=$md5sum&captcha_code=$captcha_md5sum\n\n"; # print "OK"; # print header; # print "OK"; exit 0; } else { $failmsg = "error submitting the form, please contact the webmaster
"; } } } elsif ($res == -1) { $failmsg = "$failmsg code has expired
"; } elsif ($res == -2) { $failmsg = "$failmsg control code is not correct
"; } elsif ($res == -3) { $failmsg = "$failmsg control code is not correct
"; } else { $failmsg = "general error ($res), please contact the webmaster
"; } if ($captcha_on) { &generate_captcha; } else { print header; } print "Please correct the following errors and submit the form again:"; print "
$failmsg
"; } else { if ($captcha_on) { &generate_captcha; print "

"; } else { print header; print ""; print "\n"; } } } sub check_fields { ($Q::fullname) or $failmsg = "$failmsg username not entered
"; ($Q::email) or $failmsg = "$failmsg email not entered
"; ($Q::alias) or $failmsg = "$failmsg alias not entered
"; ($Q::country) or $failmsg = "$failmsg country not selected
"; ($Q::accept_document =~ "true") or $failmsg = "$failmsg service conditions not accepted
"; } sub send_mail { my $content = "User $Q::alias has just registered on $www_address\n Full Name: $Q::fullname Country: $Q::country Language: $Q::language E-Mail: $Q::email Accept privacy: $Q::accept_document Info openmamba: $Q::info_openmamba Info mambaSoft: $Q::info_mambasoft Prefer HTML: $Q::info_HTML "; 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, ">>$regdb_file") or die "Cannot open file $regdb_file for append: $!"; print OUTF "$Q::alias,$Q::fullname,$Q::country,$Q::language,$Q::email,$Q::accept_document,". "$Q::info_openmamba,$Q::info_mambasoft,$Q::info_HTML\n"; 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; # 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=; 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 generate_captcha { # output_mode = # 0: print captcha html code # 1: return md5sum my ($output_mode) = @_; # 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); if ($output_mode != 1) { print header; print "
"; print ""; print ""; print "
Please, enter the code in the image on the right:"; print "
"; print "load a new code"; print "
\n"; }; $captcha_md5sum=$md5sum; } 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=; 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'); }