In general the captchas are all something the jerks can get past if they try hard, so it's best to plan on being in an arms race.
First of all, I don't want to store anything, so I make the thing parse the CGI args into a hash, which includes some secret part — that I'm sure they could figure out if they spent the effort, but I could always change it.
my $msg = sha1_base64( join("^G", ("secret part", map {$cgi->param($_)} grep {not m/^(?:usec|utime|tcode)$/} $cgi->param))); my $code = $1 if $msg =~ m/(.{4})\z/;
I use GD and GD::Text::Align to draw things, and I use Math::Trig for various angle calculations. The code is all a bit sloppy, as it grew rather organically, but it technically functions.
This captcha, where I rotate, resize and translate one font is considered very weak. The random circles sometimes make it impossible for humans to read as well, so I also have a js onClick event to reload the image (thus re-randomizing its rendering).
print $cgi->header({type=>"image/png"}); my $repicks = 0; REPICK: $repicks ++; die "too many repikcs." if $repi +cks > 100; my @ang = (-70 .. 70); my $rot = deg2rad($ang[int rand int @ang]); my $points = 11 + int rand 10; my @size = (200, 100); my $gd = new GD::Image(@size); $gd->interlaced(0); my $rr = int rand 50; my $rg = int rand 50; my $white = $gd->colorAllocate(255, 255, 255); my $black = $gd->colorAllocate( 0, 0, 0); my $blue = $gd->colorAllocate($rr, $rg, 255); my $gd_text = GD::Text::Align->new($gd, color=>$blue) or die GD::Text: +:error(); $gd_text->set_font('helvetica.ttf', $points); $gd_text->set_text($code); my ($llx, $lly, $lrx, $lry, $urx, $ury, $ulx, $uly) = my @bb = $gd_tex +t->bounding_box(0, 0, $rot); my $cw = abs(&rightmost(@bb) - &leftmost(@bb)); goto REPICK if $cw > + $size[0]; my $ch = abs(&topmost(@bb) - &bottommost(@bb)); goto REPICK if $ch > + $size[1]; # lower left: my $ll_rx = 0 - &leftmost_or_zero(@bb); my $ll_ry = $size[1] - &bottommost_or_zero(@bb); # upper right: my $ur_rx = $size[0] - &rightmost_or_zero(@bb); my $ur_ry = 0 - &topmost_or_zero(@bb); # random of the above my $rx = &irange($ll_rx, $ur_rx); my $ry = &irange($ll_ry, $ur_ry); $gd_text->draw($rx, $ry, $rot); $gd->rectangle(0,0 => $size[0]-1,$size[1]-1 => $black); for (1 .. (5 + int rand 4)) { my $cx = &irange(0, $size[0]); my $cy = &irange(0, $size[1]); my $sz = &irange(10, int (($size[0]+$size[1])/2)); $gd->arc($cx, $cy => $sz,$sz => 0,360, $blue); } print $gd->png;
Of course, I left out many of the functions, but I suspect their names are clear enough to indicate their purpose.
-Paul
In reply to Re: howto: Perl CGI, image with random scewed text for account creations
by jettero
in thread howto: Perl CGI, image with random scewed text for account creations
by exodist
| For: | Use: | ||
| & | & | ||
| < | < | ||
| > | > | ||
| [ | [ | ||
| ] | ] |