#!/usr/bin/perl -w
package Captcha;
use strict;
use warnings;
use GD;
use DB_File;
use Digest::SHA qw(sha1_base64);
=begin
Simple CAPTCHA module
1. Install Perl's GD library:
On FreeBSD: make -C /usr/ports/graphics/p5-GD install clean
On Ubuntu: apt install libgd-perl
2. Put this module into /var/www/lib
3. Create a CGI script /var/www/cgi-bin/captcha.pl which outputs a random
CAPTCHA image:
#!/usr/bin/perl -w
use strict;
use warnings;
use FindBin qw($Bin);
use lib $Bin . "/../lib";
use Captcha;
new Captcha()->image();
4. Create a CGI script /var/www/cgi-bin/order.pl which does the real work and
therefore has to be protected by a CAPTCHA:
#!/usr/bin/perl -w
use strict;
use warnings;
use CGI;
use FindBin qw($Bin);
use lib $Bin . "/../lib";
use Captcha;
my $cgi = new CGI();
my $captcha = new Captcha();
if (!$captcha->ok($cgi->param("captcha"))) {
# user entered a wrong captcha code -> print an error
exit -1;
}
# do the real work, e.g. place the order, do some heavy computation, etc.
...
5. Create a form which serves as start page and where the user has to fill out
several fields, including the CAPTCHA:
Place an order
6. Optionally, if your start page is a CGI script, too, you might want to use
the link() method provided by this module:
#!/usr/bin/perl -w
use strict;
use warnings;
use CGI;
use FindBin qw($Bin);
use lib $Bin . "/../lib";
use Captcha;
my $cgi = new CGI();
my $captcha = new Captcha();
# ... print html form ...
print $captcha->link();
# ... print reminder of html form ...
=cut
sub new () {
my ($type, %param) = @_;
my $self = {};
bless($self, $type);
$self->{dbfile} = $param{dbfile} || "/var/tmp/captcha.db";
$self->{cookie} = $param{cookie} || "captcha_sid";
$self->{width} = $param{width} || 200;
$self->{height} = $param{height} || 50;
$self->{permitted_ips} = $param{permitted_ips} || [];
$self->{bypass_func} = $param{bypass_func} || undef;
$self->{captcha_url} = $param{captcha_url} || "captcha.pl";
$self->{captcha_field} = $param{captcha_field} || "captcha";
return $self;
}
# print new captcha with http header
sub image () {
my ($self) = @_;
# create image
$self->{img} = new GD::Image($self->{width}, $self->{height});
# 2 random colors, dark and light
my $dark = $self->{img}->colorAllocate($self->int_rand(128),
$self->int_rand(128),
$self->int_rand(128));
my $light = $self->{img}->colorAllocate(128 + $self->int_rand(128),
128 + $self->int_rand(128),
128 + $self->int_rand(128));
# fill image
for (my $x = 0; $x < $self->{width}; $x++) {
for (my $y = 0; $y < $self->{height}; $y++) {
my $color = $self->int_rand($self->{width}) < $x ? $dark : $light;
$self->{img}->setPixel($x, $y, $color);
}
}
# 2 random integers as operands
my $left = $self->int_rand(100);
my $right = $self->int_rand(100);
# plus or minus?
my $is_minus = $self->int_rand(2);
my $result = $left + (1 - 2 * $is_minus) * $right;
# draw operator
my $x = $self->{width}/2 + $self->int_rand($self->{width}/10) -
$self->{width}/20;
my $y = $self->{height}/2 + $self->int_rand($self->{height}/4) -
$self->{height}/8;
my $color = ($self->int_rand(2) == 0 ? $light : $dark);
for (my $i = - 2; $i < 3; $i++) {
$self->{img}->line($x - 10, $y + $i, $x + 10, $y + $i, $color);
if (!$is_minus) {
$self->{img}->line($x + $i, $y - 10, $x + $i, $y + 10, $color);
}
}
# draw operands
$x = 1 * $self->{width}/10 + $self->int_rand($self->{width}/10) -
$self->{width}/20;
$y = $self->{height}/2 + $self->int_rand($self->{height}/4) -
$self->{height}/8;
$self->print_string_scramble($x, $y, $left, $dark);
$x = 8 * $self->{width}/10 - $self->int_rand($self->{width}/10) +
$self->{width}/20;
$y = $self->{height}/2 + $self->int_rand($self->{height}/4) -
$self->{height}/8;
$self->print_string_scramble($x, $y, $right, $light);
# create session
my $ts = time();
my $sid = sha1_base64("Captcha" . $ts . $self->int_rand(324234233342) . $$);
my %sessions;
if (!tie(%sessions, 'DB_File', $self->{dbfile}, O_RDWR|O_CREAT, 0644,
$DB_HASH)) {
die "$ENV{REMOTE_ADDR}: $self->{dbfile}: $!";
}
$sessions{$sid} = $ts . ";" . $result;
untie(%sessions);
my $image = $self->{img}->png(5);
binmode(STDOUT);
print <{cookie}=$sid; HttpOnly
EOF
}
# random integer
sub int_rand () {
my ($self, $range) = @_;
return int(rand($range));
}
# draw text with bouncing letters
sub print_string_scramble () {
my ($self, $x, $y, $str, $color) = @_;
my $l = length($str);
for (my $i = 0; $i < $l; $i++) {
$x += $self->int_rand(6) - 3;
$y += $self->int_rand(6) - 3;
$self->{img}->string(gdGiantFont, $x, $y, substr($str, $i, 1), $color);
$x += 12;
}
}
sub bypass () {
my ($self) = @_;
foreach my $ip(@{$self->{permitted_ips}}) {
if ($ENV{REMOTE_ADDR} =~ /^$ip/) {
return 1;
}
}
if ($self->{bypass_func}) {
return &{$self->{bypass_func}()};
}
return 0;
}
sub link () {
my ($self) = @_;
return <bypass();
Please solve the following equation:
=
(Click on the image to load a new CAPTCHA)
EOF
}
sub ok {
my ($self, $user_entered) = @_;
return 1 if $self->bypass();
my $cookie = $self->{cookie};
if ($ENV{HTTP_COOKIE} !~ /$cookie=([^;]+)/) {
warn "$ENV{REMOTE_ADDR}: cookie is \"$ENV{HTTP_COOKIE}\"";
return 0;
}
my $sid = $1;
my %sessions;
if (!tie(%sessions, 'DB_File', $self->{dbfile}, O_RDWR|O_CREAT, 0644,
$DB_HASH)) {
warn "$ENV{REMOTE_ADDR}: $self->{dbfile}: $!";
return 0;
}
my $result;
foreach (keys %sessions) {
my $data = $sessions{$_};
if ($data && ($data =~ /^([0-9]+);(-?[0-9]+)$/) && ($1 + 60 >= time())) {
if ($_ eq $sid) {
$result = $2;
delete $sessions{$_};
}
} else {
delete $sessions{$_};
}
}
untie(%sessions);
if (!$result) {
warn "$ENV{REMOTE_ADDR}: session id $sid invalid";
return 0;
}
if ($user_entered ne $result) {
warn "$ENV{REMOTE_ADDR}: session id $sid: user entered $user_entered, expected $result";
return 0;
}
return 1;
}
1;