Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with HTTPS or Subversion.

Download ZIP
Newer
Older
100755 92 lines (72 sloc) 2.374 kb
1b05706 @xsawyerx adding captcha-creating script
xsawyerx authored
1 #!/usr/bin/perl
2
3 use strict;
4 use warnings;
5
62deaac wrap up the captcha creation, following changes made in auth.pl:
sawyer authored
6 use File::stat;
1b05706 @xsawyerx adding captcha-creating script
xsawyerx authored
7 use File::Spec;
8 use File::Slurp;
9 use Digest::MD5 'md5_hex';
10 use CGI::Simple;
11 use Authen::Captcha;
12 use GD::SecurityImage;
13
14 sub create_formula {
15 my @numbers = ( 0 .. 20 );
62deaac wrap up the captcha creation, following changes made in auth.pl:
sawyer authored
16 my %operators = (
17 '+' => sub { $_[0] + $_[1] },
18 '-' => sub { $_[0] - $_[1] },
19 '*' => sub { $_[0] * $_[1] },
20 '/' => sub { $_[0] * $_[1] },
21 );
1b05706 @xsawyerx adding captcha-creating script
xsawyerx authored
22 my ( $num1, $op, $num2, $accepted );
23
24 while ( ! $accepted ) {
62deaac wrap up the captcha creation, following changes made in auth.pl:
sawyer authored
25 $num1 = $numbers[ rand scalar @numbers ];
26 $num2 = $numbers[ rand scalar @numbers ];
27 $op = ( keys %operators )[ rand scalar keys %operators ];
1b05706 @xsawyerx adding captcha-creating script
xsawyerx authored
28
29 # avoiding edge cases in division
30 if ( $op eq '/' ) {
31 if ( $num2 == 0 ) {
32 # avoiding division by zero
33 next;
34 } elsif ( $num1 % $num2 != 0 ) {
35 # check if easily divisable
36 next;
37 }
38 }
39
40 $accepted++;
41 }
42
62deaac wrap up the captcha creation, following changes made in auth.pl:
sawyer authored
43 return [ "$num1 $op $num2", $operators{$op}->( $num1, $num2 ) ];
1b05706 @xsawyerx adding captcha-creating script
xsawyerx authored
44 }
45
46 sub create_image {
47 my $text = shift;
48
49 # Create a normal image
50 my $image = GD::SecurityImage->new(
51 width => 100,
52 height => 50,
62deaac wrap up the captcha creation, following changes made in auth.pl:
sawyer authored
53 lines => 3,
1b05706 @xsawyerx adding captcha-creating script
xsawyerx authored
54 #gd_font => 'giant',
55 rndmax => 3,
56 );
57
58 $image->random($text);
59 $image->create(normal => 'rect');
60
61 return $image;
62 }
63
62deaac wrap up the captcha creation, following changes made in auth.pl:
sawyer authored
64 my $cgi = CGI::Simple->new();
65 my $data_folder = 'captchas';
66 my ( $formula, $result ) = @{ create_formula() };
67 my $md5sum = md5_hex($result);
68 my $image = create_image($formula);
69 my $really_delete = 1; # set to 0 or '' for testing purposes
70 my $captcha_timeout = 10; # allow them to exit for 1 minute
71
72 -d $data_folder || die "Cannot find data folder ($data_folder)";
1b05706 @xsawyerx adding captcha-creating script
xsawyerx authored
73
74 my ( $image_data, $mime_type, $random_number ) = $image->out;
62deaac wrap up the captcha creation, following changes made in auth.pl:
sawyer authored
75 my $image_filename = File::Spec->catfile( $data_folder, "$md5sum.png" );
76
77 # write the new file
78 write_file( $image_filename, { binmode => ':raw' }, $image_data );
79
80 # delete older files
81 my $captcha_regex = qr/^\w+\.png$/;
1b05706 @xsawyerx adding captcha-creating script
xsawyerx authored
82
62deaac wrap up the captcha creation, following changes made in auth.pl:
sawyer authored
83 foreach my $file ( read_dir($data_folder) ) {
84 $file =~ $captcha_regex || next;
85 my $filename = File::Spec->catfile( $data_folder, $file );
86
87 if ( stat($filename)->ctime() < ( time() - $captcha_timeout ) ) {
88 $really_delete && unlink $filename;
89 }
90 }
1b05706 @xsawyerx adding captcha-creating script
xsawyerx authored
91
Something went wrong with that request. Please try again.