Authen::Captchaをモジュール側の修正無しで出力文字種を絞る

Tweet

入稿用ファイルアップローダにトロイの木馬スクリプトを入れてきた馬鹿者がおって、どうせロボの仕業なんだろうから、Captchaつけようかーていう案件。例のとおりうちのファイルアップローダはPerlのCGIでできております。

よって、Authen::Captchaを使ってみたんですけれども、読めない文字が多すぎるので、しゃーないので、ローマ字が出ないように改造したいということになりました。

そして、

Perl Authen::Captchaを人が見やすくする修正｜でびぞー徒然日記 [debz-di.kabocha.to]

というエントリで、Authen::Captchaで使われる文字にNG文字を設定して出力ができる改良がありましたが、この改良はCaptcha.pmファイルを置き換えてしまうものでしたので、

404 Blog Not Found:perl - パッチなしでパッチする [blog.livedoor.jp]

というエントリがあったのを思い出して、後のせサクサクパッチにて実現してみました。

Filename: captcha.cgi

#!/usr/bin/perl
use strict;
use warnings;
use CGI;
use File::Spec;
use Authen::Captcha;
Authen_Captcha_fixup();
 
 
# main
 
my $q = CGI->new();
 
my $filename = make_captcha(); #Captchaを生成します。
my $image    = read_image( $filename ); #ファイルを一気読み
output_image( $image ); # CGIのpng画像として出力
 
exit; # main おわり
 
 
sub make_captcha { # Captchaを生成します。
  my $DATA_DIR  = 'captcha/data';
  my $IMAGE_DIR = 'captcha/images';
  my $CAPTCHA_LENGTH = 3;
  my $cap = Authen::Captcha->new(
    data_folder   => $DATA_DIR,
    output_folder => $IMAGE_DIR,
  );
  my $md5sum = $cap->generate_code($CAPTCHA_LENGTH);
  return File::Spec->catfile($IMAGE_DIR, "$md5sum.png");
}
 
 
sub read_image {  # 一気読み
  $filename = shift;
  undef $/;
  open my $fh, '<', $filename or die "$! $filename";
  $image = <$fh>;
  close $fh;
  return $image;
}
 
 
sub output_image { #CGIのpng形式で出力
  my $image = shift;
  print $q->header(
    -type         => 'image/png',
    -Pragma       => 'no-cache',
    -Cache_Control=> 'no-store',
    -Expires      => 'now',
  );
  print $image;
  return;
}
 
 
 
sub Authen_Captcha_fixup {
  return if  Authen::Captcha->VERSION > 1.023;
  package Authen::Captcha;
  no warnings 'redefine';
 
  *generate_random_string = sub {
	ref(my $self = shift) or croak "instance variable needed";
	my $length = shift;
 
	#If there is a character to forbid, it will add similarly. 
	my @ProhibitionChars =(
		'a' .. 'z',
	);
	my ($match,$ProhibitionChar);
 
	# generate a new code
	my $code = "";
	for(my $i=0; $i < $length; $i++)
	{ 
		my $char;
		my $list = int(rand 4) +1;
		if ($list == 1)
		{ # choose a number 1/4 of the time
			$char = int(rand 7)+50;
		} else { # choose a letter 3/4 of the time
			$char = int(rand 25)+97;
		}
 
		$char = chr($char);
 
		$match = 0;
		foreach $ProhibitionChar (@ProhibitionChars)
		{
			if ($ProhibitionChar eq $char)
			{
				$match = 1;
				last;
			}
		}
		if ($match == 1)
		{
			$i = length($code) -1;
			next;
		}
 		
		$code .= $char;
		$i = length($code) -1;
 
	}
	return $code;
 
  };
  return 1;
}
__END__

これで、数字だけ出るCaptchaになりましたとさ。

ところで、これ試していて気付いたのですが、Captchaのイメージファイルが生成されたはずのパスを読んでみてもデータがないときがある。なんだこれ。

2008.01.25 12:26 投稿　大野 義貴 [Perl] | 固定リンク |