Beefy Boxes and Bandwidth Generously Provided by pair Networks
No such thing as a small change

Comment on

( #3333=superdoc: print w/replies, xml ) Need Help??
I have no idea how to do the audio except via festival or something like that. I have in the past used a machine for generating random weak captchas that make my sites too much effort to bother with — since there's never actually anything of value for the bot to do, banning URLs and things as necessary.

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.


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

Use:  <p> text here (a paragraph) </p>
and:  <code> code here </code>
to format your post; it's "PerlMonks-approved HTML":

  • Posts are HTML formatted. Put <p> </p> tags around your paragraphs. Put <code> </code> tags around your code and data!
  • Titles consisting of a single word are discouraged, and in most cases are disallowed outright.
  • Read Where should I post X? if you're not absolutely sure you're posting in the right place.
  • Please read these before you post! —
  • Posts may use any of the Perl Monks Approved HTML tags:
    a, abbr, b, big, blockquote, br, caption, center, col, colgroup, dd, del, div, dl, dt, em, font, h1, h2, h3, h4, h5, h6, hr, i, ins, li, ol, p, pre, readmore, small, span, spoiler, strike, strong, sub, sup, table, tbody, td, tfoot, th, thead, tr, tt, u, ul, wbr
  • You may need to use entities for some characters, as follows. (Exception: Within code tags, you can put the characters literally.)
            For:     Use:
    & &amp;
    < &lt;
    > &gt;
    [ &#91;
    ] &#93;
  • Link using PerlMonks shortcuts! What shortcuts can I use for linking?
  • See Writeup Formatting Tips and other pages linked from there for more info.
  • Log In?

    What's my password?
    Create A New User
    and all is quiet...

    How do I use this? | Other CB clients
    Other Users?
    Others lurking in the Monastery: (3)
    As of 2018-05-27 05:56 GMT
    Find Nodes?
      Voting Booth?