root/branches/release-35/lib/MT/Util/Captcha.pm @ 1952

# Movable Type (r) Open Source (C) 2001-2008 Six Apart, Ltd.
# This program is distributed under the terms of the
# GNU General Public License, version 2.
#
# $Id$

package MT::Util::Captcha;

use strict;
use warnings;
use base qw( MT::ErrorHandler );

use constant READABLECHARS => '23456789abcdefghjkmnzpqrstuvwxyz';
use constant WIDTH  => 25;
use constant HEIGHT => 35;
use constant LENGTH => 6;
use constant EXPIRE => 60 * 10;

use MT::Session;

sub check_availability {
    my $class = shift;

    eval "require Image::Magick;";
    if ($@) {
        return MT->translate('Movable Type default CAPTCHA provider requires Image::Magick.');
    }

    my $cfg = MT->config;
    my $base = $cfg->CaptchaSourceImageBase;
    unless ($base) {
        require File::Spec;
        $base = File::Spec->catfile(MT->instance->config_dir, 'mt-static', 'images', 'captcha-source');
        $base = undef unless (-d $base);
    }
    unless ($base) {
        return MT->translate('You need to configure CaptchaSourceImageBase.');
    }
    undef;
}

sub form_fields {
    my $self = shift;
    my ($blog_id) = @_;

    require MT::App;
    my $token = MT::App->make_magic_token;
    return q() unless $token;

    my $cfg = MT->config;
    my $cgipath = $cfg->CGIPath;
    $cgipath .= '/' if $cgipath !~ m!/$!;
    my $commentscript = $cfg->CommentScript;

    my $caption = MT->translate('Captcha');
    my $description = MT->translate('Type the characters you see in the picture above.');
    return <<FORM_FIELDS;
<div class="label"><label for="captcha_code">$caption:</label></div>
<div class="field">
<input type="hidden" name="token" value="$token" />
<img src="$cgipath$commentscript/captcha/$blog_id/$token" width="150" height="35" /><br />
<input name="captcha_code" id="captcha_code" value="" autocomplete="off" />
<p>$description</p>
</div>
FORM_FIELDS
}

sub generate_captcha {
    my $self = shift;
    my ($app, $blog_id, $token) = @_;

    my $code = $self->_generate_code(LENGTH());

    my $sess = MT::Session->new;
    $sess->id($code);
    $sess->kind('CA'); #CA == CaptchA
    $sess->start(time);
    $sess->name($token);
    $sess->save or
        $app->error($sess->errstr), return undef;
    
    my $image_data = $self->_generate_captcha($app, $code, 'png') or
        return undef; 

    return $image_data; 
}

sub validate_captcha {
    my $self = shift;
    my ($app) = @_;

    my $token = $app->param('token');
    my $code = $app->param('captcha_code');

    my $from = time - EXPIRE();
    MT::Session->remove({ kind => 'CA', start => [undef, $from] }, { range => { start => 1 }});

    my $sess = MT::Session->load({ id => $code, name => $token, kind => 'CA' });
    return 0 unless $sess;
    if ($sess->start() < (time - EXPIRE())) {
        $sess->remove;
        return 0;
    }
    $sess->remove;
    return 1;
}

sub _makerandom {
    my $size = shift;

    my $bytes = int($size / 8) + ($size % 8 ? 1 : 0);

    my $rand;
    if (-e "/dev/urandom") {
        my $fh;
        open($fh, '/dev/urandom')
            or die "Couldn't open /dev/urandom";
        my $got = sysread $fh, $rand, $bytes;
        die "Didn't read all bytes from urandom" unless $got == $bytes;
        close $fh;
    } else {
        for (1..$bytes) {
            $rand .= chr(int(rand(256)));
        }
    }
    $rand;
}

sub _generate_code {
    my $self = shift;
    my($len) = @_;

    my $code = '';

    my $genval = unpack('H*', _makerandom($len*2*8/2));

    # Cycle through the octets pulling off the lower 5 bits then mapped into
    # our acceptable characters
    foreach my $i (0..($len-1)) {
      my $byte = ord(pack('H2', substr($genval, $i*2, 2)));
      my $x = ($byte & 31);

      $code .= substr(READABLECHARS(), $byte & 31, 1);
    }

    return $code;
}

sub _generate_captcha {
    my $self = shift;
    my ($app, $code, $format) = @_;
    $format ||= 'png';
    my $len = LENGTH();

    my $cfg = $app->config;
    my $base = $cfg->CaptchaSourceImageBase;
    unless ($base) {
        require File::Spec;
        $base = File::Spec->catfile(MT->instance->config_dir, 'mt-static', 'images', 'captcha-source');
        $base = undef unless (-d $base);
    }
    return $app->error($app->translate('You need to configure CaptchaSourceImageBase.'))
        unless $base;

    require Image::Magick;
    my $imbase = Image::Magick->new(magick=>'png')
        or return $app->error($app->translate("Image creation failed."));

    # Read the predefined letter PNG for each letter in $code
    my $x = $imbase->Read(map { File::Spec->catfile($base, $_ . '.png') }
                          split(//, $code));
    if ($x) {
        return $app->error($app->translate("Image error: [_1]", $x));
    }

    # Futz with the size and blurriness of each letter
    foreach my $i (0..($len - 1)) {
        my $a = int rand int(WIDTH() / 14);
        my $b = int rand int(HEIGHT() / 12);

        $imbase->[$i]->Resize(width => $a, height => $b, blur => rand(3));
    }

    # Combine all the individual tiles into one block
    my $tile_geom    = join('x', $len, 1);
    my $geometry_str = join('x', WIDTH(), HEIGHT());
    my $im = $imbase->Montage(geometry => $geometry_str,
                              tile     => $tile_geom);
    $im->Blur();

    # Add some lines and dots to the image
    for my $i (0..($len * WIDTH() * HEIGHT() / 14+200-1)) {
        my $a = int rand($len * WIDTH());
        my $b = int rand HEIGHT();
        my $c = int rand($len * WIDTH());
        my $d = int rand HEIGHT();
        my $index = $im->Get("pixel[$a, $b]");


        if ($i < ($len * WIDTH() * HEIGHT() / 14+200) / 100) {
            $im->Draw(primitive => 'line',
                      stroke    => $index,
                      points    => "$a, $b, $c, $d");
        } elsif ($i < ($len * WIDTH() * HEIGHT() / 14+200) / 2) {
            $im->Set("pixel[$c, $d]" => $index);
        } else {
            $im->Set("pixel[$c, $d]" => "black");
        }
    }

    # Read in the background file
    my $a = int rand(5) + 1;
    my $background = Image::Magick->new();
    $background->Read(File::Spec->catfile($base, 'background' . $a . '.png'));
    $background->Resize(width => ($len * WIDTH()), height => HEIGHT());
    $im->Composite(compose => "Bumpmap",
                   tile    => 'False',
                   image   => $background);
    $im->Modulate(brightness => 105);
    $im->Border(fill     => 'black',
                width    => 1,
                height   => 1,
                geometry => join('x', WIDTH() * $len, HEIGHT()));

    my @blobs = $im->ImageToBlob(magick=>$format);
    return $blobs[0];
}

1;