Programming with Perl | Ravaged by Robots!

1     #!/usr/bin/perl -w
2     use strict;
3     $|++;
4
5     use CGI qw(:all);
6
7     use Cache::FileCache;
8     my $cache = Cache::FileCache->new
9       ({namespace => 'antirobot',
10        username => 'nobody',
11        default_expires_in => '10 minutes',
12        auto_purge_interval => '1 hour',
13       });
14
15    if (length (my $info = path_info())) { # I am the image
16      my ($session) = $info =~ m{\A/([0-9a-f]+)\.png\z}i
17        or do {
18          warn("bad URL $info");
19          print header(-status => '404 Not Found');
20          exit 0;
21        };
22
23      defined(my $verify = $cache->get($session))
24        or do {
25          warn("Cannot find $session");
26          print header(-status => '404 Not Found');
27          exit 0;
28        };
29
30      ## make up an image from the verify string
31      require GD;
32
33      my $font = GD::gdGiantFont();
34      my $image = GD::Image->new(2 + $font->width * length $verify,
35                                 2 + $font->height);
36      my $background = $image->colorAllocate(0,0,0);
37      ## $image->transparent($background);
38      my $ink = $image->colorAllocate(255,255,255);
39      $image->string($font, 1, 1, $verify, $ink);
40      print header('image/png'), $image->png;
41      exit 0;
42    }
43
44    print header,
45      start_html("Vote for your favorite!"),
46      h1("Vote for your favorite ice cream flavor!");
47
48    if (defined(my $verify = param('verify'))) {
49      Delete('verify');
50      if (defined (my $session = param('session'))) {
51        Delete('session');
52        if (defined (my $validate = $cache->get($session))) {
53          $cache->remove($session); # one chance is all you get
54          if ($validate eq $verify) { # success!
55            ## would save param('flavor') here
56            print h2("Thank you!"), p("Your vote has been counted."), 
	       end_html;
57            exit 0;
58          }
59          print p("Sorry, please reenter the security string exactly 
	     as shown!");
60        }
61      }
62    }
63
64    my $verify = do {
65      my @charset = grep !/[10joli]/i, 0..9, 'a'..'z', 'A'..'Z';
66      join "", map { $charset[rand @charset] } 1..8;
67    };
68
69    my $session = do {
70      require MD5;
71      MD5->hexhash(MD5->hexhash(time.{}.rand().$$));
72    };
73    param('session', $session);
74    $cache->set($session, $verify);
75
76    print hr, startform;
77    print p("Your favorite ice-cream?");
78    print radio_group(-name => "flavor",
79                      -values => [qw(None Other Chocolate Vanilla 
	                 Strawberry)],
80                      -default => "None",
81                      -columns => 1);
82    print p("For security purposes, please enter",
83            img({src => url()."/$session.png"}).":",
84            textfield(-name => "verify"));
85    print hidden('session');
86    print br, submit, endform, hr;
87    print end_html;