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                 # Used for [captcha-refresh] if requested
 100                 $::Instance->{last_captcha_build_opt} = { %$opt };
 101
 102             my $save_u = umask($::Variable->{CAPTCHA_UMASK} || 2);
 103
 104                 if($opt->{reset}) {
 105                         undef $Vend::Captcha;
 106                         delete $Vend::Session->{captcha};
 107                 }
 108
 109                 if($Vend::Captcha) {
 110                         $code ||= $Vend::Session->{captcha};
 111                 }
 112
 113                 if($func eq 'code' and $code) {
 114                         return $code;
 115                 }
 116
 117            eval {
 118
 119                 unless( Vend::File::allowed_file($imgdir, 1) ) {
 120                         my $msg = errmsg("No permission to write directory '%s'", $imgdir);
 121                         $Tag->error( { name => $en, set => $msg });
 122                         return 0;
 123                 }
 124
 125                 mkdir($imgdir) unless -d $imgdir;
 126
 127                 if(! $code) {
 128                         $code = $Vend::Session->{captcha} = $captcha->generate_code($opt->{length});
 129                         $Vend::Captcha = $code;
 130                 }
 131                 umask $save_u;
 132            };
 133
 134                 if($@) {
 135                         $Tag->error( { name => $en, set => "Error: $@" });
 136                         return '';
 137                 }
 138
 139                 if($func eq 'code') {
 140                         return $code;
 141                 }
 142
 143                 # Now probably an image function.
 144
 145                 unless ($func =~ /ima?ge?/)  {
 146                         $Tag->error({
 147                                                         name => $en,
 148                                                         set => errmsg("Unknown function %s", $func),
 149                                                 });
 150                         return undef;
 151                 }
 152
 153                 my $path = $opt->{relative} ? "$subdir/$code.png" : "$imgpath/$code.png";
 154
 155                 if(! $opt->{name_only}) {
 156                         return  $Tag->image($path);
 157                 }
 158                 else {
 159                         return $path;
 160                 }
 161         }
 162
 163 }
 164 EOR
 165
 166 UserTag captcha Documentation <<EOD
 167 =head1 NAME
 168
 169 Interchange [captcha] tag
 170
 171 =head1 SYNOPSIS
 172
 173   [captcha  function="check|code|image|relative_image|image_tag"
 174             length="4"
 175             image-subdir="captcha"
 176             image-location="images/captcha"
 177             image-path="/standard/images/captcha"
 178             source="[cgi mv_captcha_source]"
 179             error-name="captcha"
 180             guess="[cgi mv_captcha_guess]"
 181         ]
 182
 183 =head1 DESCRIPTION
 184
 185 This tag generates and/or checks "captcha" images to authenticate user input.
 186 If called for the first time in a page, it generates a code/image pair and
 187 sets the code in the session (at $Vend::Session->{captcha}).
 188
 189 There are several functions.
 190
 191 =over 4
 192
 193 =item check
 194
 195 Checks the captcha source code (presumably from the previous page) against
 196 the guess. If it matches, returns 1. If not, returns 0 and puts error
 197 in $Tag->error.
 198
 199 =item code
 200
 201 Returns the generated code. Generates one if not done previously in session.
 202
 203 =item image
 204
 205 Returns an IMG tag as generated by Interchange's [image] tag. If the
 206 name-only=1 option is passed, no surrounding IMG tag will be generated,
 207 only the image name. If the C<relative=1> option is passed, that name
 208 will not be prefaced with the ImageDir.
 209
 210 =back
 211
 212 The additional options are:
 213
 214 =over 4
 215
 216 =item guess
 217
 218 The input from the user when the function is C<check>. Default is the
 219 contents of [cgi mv_captcha_guess].
 220
 221 =item image-subdir
 222
 223 The image subdirectory (based in images directory) which will
 224 be used.
 225
 226 =item image-path
 227
 228 The base path for URL generation. Default is the Interchange IMAGE_DIR
 229 variable.
 230
 231 =item image-location
 232
 233 The directory where image files will be generated. Default is the
 234 Interchange IMAGE_DIR variable based in the Interchange DOCROOT
 235 variable, with the subdirectory above, i.e. C<[var DOCROOT][var IMAGE_DIR]/captcha>.
 236
 237 =item length
 238
 239 Length of the input for the captcha. Default is 4 characters.
 240
 241 =item name-only
 242
 243 When set, tells the image function to not generate an HTML IMG tag.
 244
 245 =item relative
 246
 247 When set, tells the image function (when in name-only mode) to
 248 return relative path.
 249
 250 =item reset
 251
 252 Normally only one captcha code / image will be generated per page
 253 transaction. If this is set, you can generate another one -- though
 254 you would have to take care of saving the generated code yourself,
 255 as $Session->{captcha} is overwritten.
 256
 257 =item source
 258
 259 The captcha base to guess against for the C<check> function. Default is the
 260 contents of the last-generated captcha, or [cgi mv_captcha_source].
 261
 262 =back
 263
 264 =head1 EXAMPLE
 265
 266         [if cgi mv_captcha_guess]
 267                 [tmp good][captcha check][/tmp]
 268                 [if scratch good]
 269                         You guessed right!
 270                 [else]
 271                         Sorry, try again.
 272                 [/else]
 273                 [/if]
 274                 <br>
 275         [/if]
 276
 277         [captcha function=image]
 278
 279         <form action="[process href="@@MV_PAGE@@"]">
 280         <input type=text name=mv_captcha_guess size value="">
 281         <input type=submit value="Guess">
 282         </form>
 283
 284         [error auto=1]
 285
 286 =head1 PREREQUISITES
 287
 288 Authen::Captcha
 289
 290 =head1 AUTHOR
 291
 292 Mike Heins, <mike AT THE DOMAIN perusion.com>.
 293
 294 EOD