@@ -9,7 +9,7 @@ package Authen::Captcha;
use 5.00503;
use strict;
use GD;
-use Digest::MD5 qw(md5_hex);
+use String::Random qw(random_regex);
use Carp;
# these are used to find default images dir
use File::Basename;
@@ -17,7 +17,7 @@ use File::Spec;
use vars qw($VERSION);
-$VERSION = sprintf "%d.%03d", q$Revision: 1.23 $ =~ /(\d+)/g;
+$VERSION = '1.024';
# get our file name, used to find the default images
my $default_images_folder;
@@ -197,14 +197,15 @@ sub data_folder
sub check_code
{
ref(my $self = shift) or croak "instance variable needed";
- my ($code, $crypt) = @_;
+ my ($code, $token) = @_;
$code = lc($code);
- warn "$code $crypt\n" if($self->debug() >= 2);
+ warn "$code $token\n" if($self->debug() >= 2);
my $current_time = time;
- my $return_value = 0;
+ # solution was not found in database (well, yet :)
+ my $return_value = -2;
my $database_file = File::Spec->catfile($self->data_folder(),"codes.txt");
# create database file if it doesn't already exist
@@ -214,12 +215,10 @@ sub check_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);
+ $self->_get_exclusive_lock();
open (DATA, "<$database_file") or die "Can't open File: $database_file\n";
- flock DATA, 1; # read lock
my @data=<DATA>;
close(DATA);
warn "Close File: $database_file\n" if($self->debug() >= 2);
@@ -228,70 +227,99 @@ sub check_code
# $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($self->output_folder(),$data_code . ".png");
- if ($data_code eq $crypt)
+ my ($data_time,$data_token,$data_code) = $line =~ m/(^\d+)::([a-f0-9]{32})::(.*)$/
+ or next;
+
+ my $png_file = File::Spec->catfile($self->output_folder(),$data_token . ".png");
+ if ($data_token eq $token)
{
- # the crypt was found in the database
+
+ # the token was found in the database
if (($current_time - $data_time) > $self->expire())
{
warn "Crypt Found But Expired\n" if($self->debug() >= 2);
- # the crypt was found but has expired
+ # the token was found but has expired
$return_value = -1;
} else {
- warn "Match Crypt in File Crypt: $crypt\n" if($self->debug() >= 2);
- $found = 1;
+ warn "Match Crypt in File Crypt: $token\n" if($self->debug() >= 2);
}
- if ( ($md5 ne $crypt) && ($return_value != -1) && $self->keep_failures())
- { # solution was wrong, not expired, and we're keeping failures
+
+ if ( ($data_code eq $code) && ($return_value != -1) )
+ {
+ warn "Match: " . $data_token . " And " . $token . "\n" if($self->debug() >= 2);
+ # solution was correct and was found in database - passed
+ $return_value = 1;
+ }
+
+ if ( $return_value < ($self->keep_failures() ? -1 : -2) )
+ {
+ warn "No Match: " . $data_token . " And " . $token . "\n" if($self->debug() >= 2);
+ # solution was wrong, not expired, and we're keeping failures
$new_data .= $line."\n";
} else {
- # remove the found crypt so it can't be used again
+ # remove the found token 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");
}
+
+ if ( $return_value == -2 ) {
+ # incorrect solution
+ $return_value = -3;
+ }
+
} elsif (($current_time - $data_time) > $self->expire()) {
- # removed expired crypt
+ # removed expired token
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
+ # token 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(DATA,">$database_file") or die "Can't open File: $database_file\n";
- flock DATA, 2; # write lock
print DATA $new_data;
close(DATA);
+ $self->_release_lock();
return $return_value;
}
+
+sub _open_lock_file {
+ my $self = shift;
+ my $file_name = shift;
+ open(LOCK, ">>$file_name") or die "Error opening lockfile $file_name: $!\n";
+}
+
+sub _get_shared_lock {
+ my $self = shift;
+ my $lock_file_name = File::Spec->catfile($self->data_folder(),"codes.lock");
+ $self->_open_lock_file($lock_file_name);
+
+ # shared lock
+ flock(LOCK, 1) or die "Error locking lockfile in shared mode: $!\n";
+}
+
+sub _get_exclusive_lock {
+ my $self = shift;
+ my $lock_file_name = File::Spec->catfile($self->data_folder(),"codes.lock");
+ $self->_open_lock_file($lock_file_name);
+
+ # exclusive lock
+ flock(LOCK, 2) or die "Error locking lockfile exclusively: $!\n";
+}
+
+sub _release_lock {
+ my $self = shift;
+ flock(LOCK, 8) or die "Error unlocking lockfile: $!\n";
+ close(LOCK);
+}
+
sub _touch_file
{
ref(my $self = shift) or croak "instance variable needed";
@@ -331,7 +359,7 @@ sub _save_code
{
ref(my $self = shift) or croak "instance variable needed";
my $code = shift;
- my $md5 = shift;
+ my $token = shift;
my $database_file = File::Spec->catfile($self->data_folder(),'codes.txt');
@@ -342,8 +370,9 @@ sub _save_code
$self->_touch_file($database_file);
# clean expired codes and images
+ $self->_get_exclusive_lock();
+
open (DATA, "<$database_file") or die "Can't open File: $database_file\n";
- flock DATA, 1; # read lock
my @data=<DATA>;
close(DATA);
@@ -351,11 +380,12 @@ sub _save_code
foreach my $line (@data)
{
$line =~ s/\n//;
- my ($data_time,$data_code) = split(/::/,$line);
+ my ($data_time,$data_token,$data_code) = $line =~ m/(^\d+)::([a-f0-9]{32})::(.*)$/
+ or next;
if ( (($current_time - $data_time) > ($self->expire())) ||
- ($data_code eq $md5) )
+ ($data_token eq $token) )
{ # remove expired captcha, or a dup
- my $png_file = File::Spec->catfile($self->output_folder(),$data_code . ".png");
+ my $png_file = File::Spec->catfile($self->output_folder(),$data_token . ".png");
unlink($png_file) or carp("Can't remove png file [$png_file]\n");
} else {
$new_data .= $line."\n";
@@ -365,21 +395,19 @@ sub _save_code
# save the code to database
warn "open File: $database_file\n" if($self->debug() >= 2);
open(DATA,">$database_file") or die "Can't open File: $database_file\n";
- flock DATA, 2; # write lock
warn "-->>" . $new_data . "\n" if($self->debug() >= 2);
- warn "-->>" . $current_time . "::" . $md5."\n" if($self->debug() >= 2);
+ warn "-->>" . $current_time . "::" . $token."::".$code."\n" if($self->debug() >= 2);
print DATA $new_data;
- print DATA $current_time."::".$md5."\n";
+ print DATA $current_time."::".$token."::".$code."\n";
close(DATA);
+ $self->_release_lock();
warn "Close File: $database_file\n" if($self->debug() >= 2);
-
}
sub create_image_file
{
ref(my $self = shift) or croak "instance variable needed";
my $code = shift;
- my $md5 = shift;
my $length = length($code);
my $im_width = $self->width();
@@ -447,7 +475,6 @@ sub create_sound_file
{
ref(my $self = shift) or croak "instance variable needed";
my $code = shift;
- my $md5 = shift;
my $length = length($code);
my @chars = split('',$code);
@@ -490,25 +517,25 @@ sub generate_code
my $length = shift;
my $code = $self->generate_random_string($length);
- my $md5 = md5_hex($code);
+ my $token = random_regex('[a-f0-9]{32}');
my ($captcha_data_ref,$output_filename);
if ($self->type() eq 'image')
{
- $captcha_data_ref = $self->create_image_file($code,$md5);
- $output_filename = File::Spec->catfile($self->output_folder(),$md5 . ".png");
+ $captcha_data_ref = $self->create_image_file($code);
+ $output_filename = File::Spec->catfile($self->output_folder(),$token . ".png");
} elsif ($self->type() eq 'sound') {
- $captcha_data_ref = $self->create_sound_file($code,$md5);
- $output_filename = File::Spec->catfile($self->output_folder(),$md5 . ".wav");
+ $captcha_data_ref = $self->create_sound_file($code);
+ $output_filename = File::Spec->catfile($self->output_folder(),$token . ".wav");
} else {
croak "invalid captcha type [" . $self->type() . "]";
}
$self->_save_file($captcha_data_ref,$output_filename);
- $self->_save_code($code,$md5);
+ $self->_save_code($code,$token);
- # return crypt (md5)... or, if they want it, the code as well.
- return wantarray ? ($md5,$code) : $md5;
+ # return token (token)... or, if they want it, the code as well.
+ return wantarray ? ($token,$code) : $token;
}
sub version
@@ -534,7 +561,7 @@ Authen::Captcha - Perl extension for creating captcha's to verify the human elem
# set the data_folder. contains flatfile db to maintain state
$captcha->data_folder('/some/folder');
- # set directory to hold publicly accessable images
+ # set directory to hold publicly accessible images
$captcha->output_folder('/some/http/folder');
# Alternitively, any of the methods to set variables may also be
@@ -545,24 +572,28 @@ Authen::Captcha - Perl extension for creating captcha's to verify the human elem
output_folder => '/some/http/folder',
);
- # create a captcha. Image filename is "$md5sum.png"
- my $md5sum = $captcha->generate_code($number_of_characters);
+ # create a captcha. Image filename is "$token.png"
+ my $token = $captcha->generate_code($number_of_characters);
# check for a valid submitted captcha
# $code is the submitted letter combination guess from the user
- # $md5sum is the submitted md5sum from the user (that we gave them)
- my $results = $captcha->check_code($code,$md5sum);
+ # $token is the submitted token from the user (that we gave them)
+ my $results = $captcha->check_code($code,$token);
# $results will be one of:
# 1 : Passed
# 0 : Code not checked (file error)
# -1 : Failed: code expired
# -2 : Failed: invalid code (not in database)
- # -3 : Failed: invalid code (code does not match crypt)
+ # -3 : Failed: invalid code (code does not match token)
##############
+=head1 WARNING
+
+The captcha produced by this module is rather weak compared to other modules available. You are advised to update to L<GD::SecurityImage>, which provides API-compatible interface in L<GD::SecurityImage::AC> module.
+
=head1 ABSTRACT
-Authen::Captcha provides an object oriented interface to captcha file creations. Captcha stands for Completely Automated Public Turning test to tell Computers and Humans Apart. A Captcha is a program that can generate and grade tests that:
+Authen::Captcha provides an object oriented interface to captcha file creations. Captcha stands for Completely Automated Public Turing test to tell Computers and Humans Apart. A Captcha is a program that can generate and grade tests that:
- most humans can pass.
- current computer programs can't pass
@@ -629,26 +660,26 @@ See the method descriptions for more detail on what they mean.
=back
-=item C<$md5sum = $captcha-E<gt>generate_code( $number_of_characters );>
+=item C<$token = $captcha-E<gt>generate_code( $number_of_characters );>
-Creates a captcha. Image filename is "$md5sum.png"
+Creates a captcha. Image filename is "$token.png"
It can also be called in array context to retrieve the string of characters used to generate the captcha (the string the user is expected to respond with). This is useful for debugging.
ex.
-C<($md5sum,$chars) = $captcha-E<gt>generate_code( $number_of_characters );>
+C<($token,$chars) = $captcha-E<gt>generate_code( $number_of_characters );>
-=item C<$results = $captcha-E<gt>check_code($code,$md5sum);>
+=item C<$results = $captcha-E<gt>check_code($code,$token);>
check for a valid submitted captcha
$code is the submitted letter combination guess from the user
-$md5sum is the submitted md5sum from the user (that we gave them)
+$token is the submitted token from the user (that we gave them)
-If the $code and $md5sum are correct, the image file and database entry will be removed.
+If the $code and $token are correct, the image file and database entry will be removed.
-If the $md5sum matches one in the database, and "keep_failures" is false (the default), the image file and database entry will be removed to avoid repeated attempts on the same captcha.
+If the $token matches one in the database, and "keep_failures" is false (the default), the image file and database entry will be removed to avoid repeated attempts on the same captcha.
$results will be one of:
@@ -656,7 +687,7 @@ $results will be one of:
0 : Code not checked (file error)
-1 : Failed: code expired
-2 : Failed: invalid code (not in database)
- -3 : Failed: invalid code (code does not match crypt)
+ -3 : Failed: invalid code (code does not match token)
=back
@@ -666,12 +697,12 @@ $results will be one of:
=item C<$captcha-E<gt>data_folder( '/some/folder' );>
-Required. Sets the directory to hold the flatfile database that will be used to store the current non-expired valid captcha md5sum's.
-Must be writable by the process running the script (usually the web server user, which is usually either "apache" or "http"), but should not be accessable to the end user.
+Required. Sets the directory to hold the flatfile database that will be used to store the current non-expired valid captcha tokens.
+Must be writable by the process running the script (usually the web server user, which is usually either "apache" or "http"), but should not be accessible to the end user.
=item C<$captcha-E<gt>output_folder( '/some/folder' );>
-Required. Sets the directory to hold the generated Captcha image files. This is usually a web accessable directory so that the user can view the images in here, but it doesn't have to be web accessable (you could be attaching the images to an e-mail for some verification, or some other Captcha implementation).
+Required. Sets the directory to hold the generated Captcha image files. This is usually a web accessible directory so that the user can view the images in here, but it doesn't have to be web accessible (you could be attaching the images to an e-mail for some verification, or some other Captcha implementation).
Must be writable by the process running the script (usually the web server user, which is usually either "apache" or "http").
=item C<$captcha-E<gt>images_folder( '/some/folder' );>
@@ -722,12 +753,16 @@ Josh I. Miller, E<lt>jmiller@purifieddata.netE<gt>
First Productions, Inc. created the cgi-script distributed under the GPL which was used as the basis for this module. Much work has gone into making this more robust, and suitable for other applications, but much of the origonal code remains.
+Fixes were reported and contributed by various people, see Changes file for a complete list.
+
=head1 COPYRIGHT AND LICENSE
Copyright 2003, First Productions, Inc. (FIRSTPRODUCTIONS HUMAN TEST 1.0)
Copyright 2003 by Seth Jackson
+Copyright 2012 by Paolo Rossi, Lubomir Rintel, Chris Dunlop, Gert Schepens and Ernesto Hernández-Novich
+
This library 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. (see license.txt).
This program 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.
@@ -0,0 +1,46 @@
+{
+ "abstract" : "Perl extension for creating captcha's to verify the human element in transactions.",
+ "author" : [
+ "Seth T. Jackson <sjackson@purifieddata.net>"
+ ],
+ "dynamic_config" : 1,
+ "generated_by" : "ExtUtils::MakeMaker version 6.68, CPAN::Meta::Converter version 2.120921",
+ "license" : [
+ "unknown"
+ ],
+ "meta-spec" : {
+ "url" : "http://search.cpan.org/perldoc?CPAN::Meta::Spec",
+ "version" : "2"
+ },
+ "name" : "Authen-Captcha",
+ "no_index" : {
+ "directory" : [
+ "t",
+ "inc"
+ ]
+ },
+ "prereqs" : {
+ "build" : {
+ "requires" : {
+ "ExtUtils::MakeMaker" : "0"
+ }
+ },
+ "runtime" : {
+ "requires" : {
+ "File::Basename" : "0",
+ "File::Spec" : "0.8",
+ "GD" : "0",
+ "String::Random" : "0"
+ }
+ }
+ },
+ "release_status" : "stable",
+ "resources" : {
+ "repository" : {
+ "type" : "git",
+ "url" : "https://github.com/lkundrak/perl-Authen-Captcha.git",
+ "web" : "https://github.com/lkundrak/perl-Authen-Captcha"
+ }
+ },
+ "version" : "1.024"
+}
@@ -6,12 +6,22 @@ WriteMakefile(
'NAME' => 'Authen::Captcha',
'VERSION_FROM' => 'Captcha.pm', # finds $VERSION
'PREREQ_PM' => {
- 'File::Spec' => 0,
+ 'File::Spec' => '0.8',
'File::Basename' => 0,
- 'Digest::MD5' => 0,
+ 'String::Random' => 0,
'GD' => 0,
},
- ($] >= 5.005 ? ## Add these new keywords supported since 5.005
+ ($] >= 5.008 ? ## Add these new keywords supported since 5.005
(ABSTRACT_FROM => 'Captcha.pm', # retrieve abstract from module
- AUTHOR => 'Seth T. Jackson <sjackson@purifieddata.net>') : ()),
+ AUTHOR => 'Seth T. Jackson <sjackson@purifieddata.net>',
+ META_MERGE => {
+ 'meta-spec' => { version => 2 },
+ resources => {
+ repository => {
+ type => 'git',
+ url => 'https://github.com/lkundrak/perl-Authen-Captcha.git',
+ web => 'https://github.com/lkundrak/perl-Authen-Captcha',
+ },
+ },
+ }) : ())
);