code/SystemTag/captcha.coretag

   1 # Copyright 2006-2007 Interchange Development Group and others
   2 #
   3 # This program is free software; you can redistribute it and/or modify
   4 # it under the terms of the GNU General Public License as published by
   5 # the Free Software Foundation; either version 2 of the License, or
   6 # (at your option) any later version.  See the LICENSE file for details.
   7 #
   8 # $Id: captcha.coretag,v 1.4 2007-03-30 23:55:57 pajamian Exp $
   9
  10 UserTag captcha Order           function
  11 UserTag captcha attrAlias       func function
  12 UserTag captcha addAttr
  13 UserTag captcha Description     Generate captcha codes for authentication check
  14 UserTag captcha Version         $Revision: 1.4 $
  15
  16 UserTag captcha Routine         <<EOR
  17 my $Have_Captcha;
  18 eval {
  19         require Authen::Captcha;
  20         $Have_Captcha = 1;
  21 };
  22
  23 sub {
  24         my ($func, $opt) = @_;
  25
  26         use vars qw/$Tag/;
  27
  28         if(! $Have_Captcha) {
  29                 ::logError("Use of captcha tag without Authen::Captcha, skipping");
  30                 return '';
  31         }
  32
  33         $func = lc($func);
  34         $func =~ s/[^a-z]+//g;
  35         my $result = '';
  36         if($func eq 'code') {
  37                 $result = $Vend::Session->{captcha};
  38         }
  39
  40         $opt->{length} ||= 4;
  41         my $en = $opt->{error_name} || 'captcha';
  42
  43         my $subdir = $opt->{image_subdir}
  44                                  || $::Variable->{CAPTCHA_IMAGE_SUBDIR}
  45                                  || 'captcha';
  46         my $tmpdir = "$Vend::Cfg->{ScratchDir}/$subdir";
  47
  48         mkdir($tmpdir) unless -d $tmpdir;
  49
  50         my $imgdir = $opt->{image_location} || $::Variable->{CAPTCHA_IMAGE_LOCATION};
  51
  52         unless ($imgdir ) {
  53                 if(! $Global::NoAbsolute and $::Variable->{DOCROOT}) {
  54                          $imgdir = "$::Variable->{DOCROOT}$::Variable->{IMAGE_DIR}/$subdir";
  55                 }
  56                 else {
  57                          $imgdir = "images/$subdir";
  58                 }
  59         }
  60
  61         my $imgpath = $opt->{image_path}
  62                                  || $::Variable->{CAPTCHA_IMAGE_PATH}
  63                                  || "$::Variable->{IMAGE_DIR}/$subdir";
  64
  65
  66         my $captcha = Authen::Captcha->new(
  67                                         data_folder => $tmpdir,
  68                                         output_folder => $imgdir,
  69                                 );
  70
  71         my $guess   = $opt->{guess} || $CGI::values{mv_captcha_guess};
  72         my $code    = $opt->{source};
  73
  74         if($func eq 'check') {
  75
  76                 my $check_against = $code || $Vend::Session->{captcha};
  77                 my $status = $captcha->check_code($guess, $check_against);
  78                 if($status > 0) {
  79                         return $status;
  80                 }
  81                 elsif($status == 0) {
  82                         $Tag->error( { name => $en, set => "Code not checked: error" });
  83                         return 0;
  84                 }
  85                 elsif($status == -1) {
  86                         $Tag->error( { name => $en, set => "Code expired" });
  87                         return 0;
  88                 }
  89                 elsif($status == -2) {
  90                         $Tag->error( { name => $en, set => "Code never generated" });
  91                         return 0;
  92                 }
  93                 elsif($status == -3) {
  94                         $Tag->error( { name => $en, set => "Code doesn't match" });
  95                         return 0;
  96                 }
  97         }
  98         else {
  99             my $save_u = umask($::Variable->{CAPTCHA_UMASK} || 2);
 100
 101                 if($opt->{reset}) {
 102                         undef $Vend::Captcha;
 103                         delete $Vend::Session->{captcha};
 104                 }
 105
 106                 if($Vend::Captcha) {
 107                         $code ||= $Vend::Session->{captcha};
 108                 }
 109
 110                 if($func eq 'code' and $code) {
 111                         return $code;
 112                 }
 113
 114            eval {
 115
 116                 unless( Vend::File::allowed_file($imgdir, 1) ) {
 117                         my $msg = errmsg("No permission to write directory '%s'", $imgdir);
 118                         $Tag->error( { name => $en, set => $msg });
 119                         return 0;
 120                 }
 121
 122                 mkdir($imgdir) unless -d $imgdir;
 123
 124                 if(! $code) {
 125                         $code = $Vend::Session->{captcha} = $captcha->generate_code($opt->{length});
 126                         $Vend::Captcha = $code;
 127                 }
 128                 umask $save_u;
 129            };
 130
 131                 if($@) {
 132                         $Tag->error( { name => $en, set => "Error: $@" });
 133                         return '';
 134                 }
 135
 136                 if($func eq 'code') {
 137                         return $code;
 138                 }
 139
 140                 # Now probably an image function.
 141
 142                 unless ($func =~ /ima?ge?/)  {
 143                         $Tag->error({
 144                                                         name => $en,
 145                                                         set => errmsg("Unknown function %s", $func),
 146                                                 });
 147                         return undef;
 148                 }
 149
 150                 my $path = $opt->{relative} ? "$subdir/$code.png" : "$imgpath/$code.png";
 151
 152                 if(! $opt->{name_only}) {
 153                         return  $Tag->image($path);
 154                 }
 155                 else {
 156                         return $path;
 157                 }
 158         }
 159
 160 }
 161 EOR
 162
 163 UserTag captcha Documentation <<EOD
 164 =head1 NAME
 165
 166 Interchange [captcha] tag
 167
 168 =head1 SYNOPSIS
 169
 170   [captcha  function="check|code|image|relative_image|image_tag"
 171             length="4"
 172             image-subdir="captcha"
 173             image-location="images/captcha"
 174             image-path="/standard/images/captcha"
 175             source="[cgi mv_captcha_source]"
 176             error-name="captcha"
 177             guess="[cgi mv_captcha_guess]"
 178         ]
 179
 180 =head1 DESCRIPTION
 181
 182 This tag generates and/or checks "captcha" images to authenticate user input.
 183 If called for the first time in a page, it generates a code/image pair and
 184 sets the code in the session (at $Vend::Session->{captcha}).
 185
 186 There are several functions.
 187
 188 =over 4
 189
 190 =item check
 191
 192 Checks the captcha source code (presumably from the previous page) against
 193 the guess. If it matches, returns 1. If not, returns 0 and puts error
 194 in $Tag->error.
 195
 196 =item code
 197
 198 Returns the generated code. Generates one if not done previously in session.
 199
 200 =item image
 201
 202 Returns an IMG tag as generated by Interchange's [image] tag. If the
 203 name-only=1 option is passed, no surrounding IMG tag will be generated,
 204 only the image name. If the C<relative=1> option is passed, that name
 205 will not be prefaced with the ImageDir.
 206
 207 =back
 208
 209 The additional options are:
 210
 211 =over 4
 212
 213 =item guess
 214
 215 The input from the user when the function is C<check>. Default is the
 216 contents of [cgi mv_captcha_guess].
 217
 218 =item image-subdir
 219
 220 The image subdirectory (based in images directory) which will
 221 be used.
 222
 223 =item image-path
 224
 225 The base path for URL generation. Default is the Interchange IMAGE_DIR
 226 variable.
 227
 228 =item image-location
 229
 230 The directory where image files will be generated. Default is the
 231 Interchange IMAGE_DIR variable based in the Interchange DOCROOT
 232 variable, with the subdirectory above, i.e. C<[var DOCROOT][var IMAGE_DIR]/captcha>.
 233
 234 =item length
 235
 236 Length of the input for the captcha. Default is 4 characters.
 237
 238 =item name-only
 239
 240 When set, tells the image function to not generate an HTML IMG tag.
 241
 242 =item relative
 243
 244 When set, tells the image function (when in name-only mode) to
 245 return relative path.
 246
 247 =item reset
 248
 249 Normally only one captcha code / image will be generated per page
 250 transaction. If this is set, you can generate another one -- though
 251 you would have to take care of saving the generated code yourself,
 252 as $Session->{captcha} is overwritten.
 253
 254 =item source
 255
 256 The captcha base to guess against for the C<check> function. Default is the
 257 contents of the last-generated captcha, or [cgi mv_captcha_source].
 258
 259 =back
 260
 261 =head1 EXAMPLE
 262
 263         [if cgi mv_captcha_guess]
 264                 [tmp good][captcha check][/tmp]
 265                 [if scratch good]
 266                         You guessed right!
 267                 [else]
 268                         Sorry, try again.
 269                 [/else]
 270                 [/if]
 271                 <br>
 272         [/if]
 273
 274         [captcha function=image]
 275
 276         <form action="[process href="@@MV_PAGE@@"]">
 277         <input type=text name=mv_captcha_guess size value="">
 278         <input type=submit value="Guess">
 279         </form>
 280
 281         [error auto=1]
 282
 283 =head1 PREREQUISITES
 284
 285 Authen::Captcha
 286
 287 =head1 AUTHOR
 288
 289 Mike Heins, <mike AT THE DOMAIN perusion.com>.
 290
 291 EOD