#!/usr/bin/perl -w

package zeitform::captcha;

use Crypt::CBC;
use Digest::SHA1 qw(sha1_base64);
use GD::SecurityImage;
use MIME::Base64;

our $VERSION = "0.01";

## internal
{
  my $_defaults =
    {
     _secret         => 'my secret key',

     ## Crypt::CBC options
     _crypt_algo     => 'Blowfish',        ## cipher
     _crypt_salt     => 1,                 ## salt

     _captcha_length => 6,

     _captcha_opts   => {
			 width  => 120,
			 height => 40,
			 lines  => 10,
			 angle  => 3,
			 font   =>"/usr/X11R6/lib/X11/fonts/truetype/Vera.ttf",
			},
    };

  sub _defaults { $_defaults; }

}

## constructor
sub new
  {
    my ($caller, %args) = @_;
    my $class = ref($caller) || $caller;
    return unless $args{secret}; ## force secret!
    my $self = bless { }, $class;

    my $defaults = $self->_defaults;
    foreach my $key (map { s/^_//; $_ } keys %$defaults)
      {
	$self->{"_$key"} = $args{$key} || $defaults->{"_$key"};
      }
    return $self;
  }

sub encrypt
  {
    my ($self, $string, %args) = @_;
    return unless $string;

    my $cipher = Crypt::CBC->new(-key    => $self->{_secret},
				 -cipher => $self->{_crypt_algo},
				 -salt   => $self->{_crypt_salt});

    return $self->_encode($cipher->encrypt($string));
  }

sub decrypt
  {
    my ($self, $string, %args) = @_;
    return unless $string;

    my $cipher = Crypt::CBC->new(-key    => $self->{_secret},
				 -cipher => $self->{_crypt_algo},
				 -salt   => $self->{_crypt_salt});

    return $cipher->decrypt($self->_decode($string));
  }

sub captcha_text
  {
    my ($self, $cipher, %args) = @_;
    return unless $cipher;

    return lc(substr(sha1_base64($self->{_secret} . $cipher . ($args{salt}||"")),
		     0, $self->{_captcha_length}));
  }

sub captcha_image
  {
    my ($self, $cipher, %args) = @_;
    return unless $cipher;

    my $image = GD::SecurityImage->new( %{ $self->{_captcha_opts} } );
    $image->random($self->captcha_text($cipher, %args));

    $image->create("ttf", 'circle', "#f37325", "#ffc75a"); ## make me config
    #$image->particle(2400, 1);                            ## make me config

    return $image->out;
  }

sub _encode
  {
    my ($self, $string) = @_;
    return unless $string;
    $string = encode_base64($string);
    $string =~ s/\s//g;  ## remove whitespace
    $string =~ s/\+/-/g; ## convert for uri "+" -> "-"
    $string =~ s/\//_/g; ## convert for uri "/" -> "_"
    $string =~ s/=+$//;  ## remove padding
    return $string;
  }

sub _decode
  {
    my ($self, $string) = @_;
    return unless $string;
    $string =~ s/-/+/g;  ## revert for uri "+" -> "-"
    $string =~ s/_/\//g; ## revert for uri "/" -> "_"
    $string .= "=" x (4 - length($string) % 4) if length($string) % 4; ## add padding
    $string = decode_base64($string);
    return $string;
  }

1;
###############################################################################

package main;

use strict;
use CGI;
use HTML::Template;

my $c = zeitform::captcha->new(secret => 'my secret key');

my $q       = CGI->new;
my $type    = $q->param("type") || "";
my $id      = $q->param("id");
my $captcha = $q->param("c");
my $rnd     = $q->param("rnd");


## generate image
if ($type eq "image" && $id)
  {
    my($image_data, $mime_type, $random_number) = $c->captcha_image($id, salt => $rnd);
    print $q->header($mime_type);
    print $image_data;
  }
## generate captcha form and validate
else
  {
    my $template = HTML::Template->new(filehandle => *DATA,
				       die_on_bad_params => 0);
    $template->param(self => $q->url());
    $template->param(id   => $id      ) if $id;
    $template->param(rnd  => $rnd     ) if $rnd;

    if ($id && $captcha)
      {
	### captcha matches
	if ($captcha eq $c->captcha_text($id, salt => $rnd))
	  {
	    $template->param(verified => $c->decrypt($id));
	  }
	## captcha is wrong
	else
	  {
	    $template->param(rnd     => int(rand(1000)));
	    $template->param(failure => 1);
	  }
	
	
      }
    elsif ($id)
      {
	## output captcha form
	$template->param(new => int(rand(1000)));
      }
    else
      {
	### debug - would print genereic error here!!!!
	#$template->param(error => 1);
	$template->param(error => $c->encrypt('ulf@zeitform.de'));
      }

    print $q->header;
    print $template->output;

  }


## HTML-Template follows

__DATA__
<html>
<head>
  <title>Captcha Test</title>
</head>
<body>

<TMPL_IF error><!-- no id, no captcha, debug code for now -->
  <p>Test this LINK: <a href="<TMPL_VAR self>?id=<TMPL_VAR error>">click</a></p>

<TMPL_ELSE>

<TMPL_IF verified><!-- captcha was susccessful - show email -->

  <p>
    <a href="mailto:<TMPL_VAR verified>"><TMPL_VAR verified></a>
  </p>

<TMPL_ELSE><!-- show captcha image and form -->

  <a href="<TMPL_VAR self>?id=<TMPL_VAR id>&rnd=<TMPL_VAR new>">
    <img src="<TMPL_VAR self>?type=image&id=<TMPL_VAR id><TMPL_IF rnd>&rnd=<TMPL_VAR rnd></TMPL_IF>">
  </a>
  <form method="post" action="<TMPL_VAR self>">
    <input type="hidden" name="id" value="<TMPL_VAR id>">
    <TMPL_IF rnd><input type="hidden" name="rnd" value="<TMPL_VAR rnd>"></TMPL_IF>
    <input type="text" name="c">
  </form>
  <TMPL_IF failure>
  <p>Try again!</p>
  </TMPL_IF>

</TMPL_IF>
</TMPL_IF>

</body>
</html>