captcha — handle captcha images used for authentication
Attribute | Pos. | Req. | Default | Description |
---|---|---|---|---|
function | func | Yes | Yes | captcha function | |
length | 4 | length of the captcha code | ||
interpolate | 0 | interpolate output? | ||
hide | 0 | Hide the tag return value? |
This tag generates and/or checks "captcha" images to authenticate user input. If called for the first time in a page, it generates a code/image pair and sets the code in the session (at $Vend::Session->{captcha}).
The captcha tag provides the following functions:
Checks the captcha source code (presumably from the previous page) against the guess. If it matches, returns 1. If not, returns 0 and puts error in $Tag->error.
The image, relative_image and image_tag functions are undocumented.
This tag appears to be affected by, or affects, the following:
Catalog Variables: CAPTCHA_IMAGE_SUBDIR
, CAPTCHA_IMAGE_LOCATION
, DOCROOT
, CAPTCHA_IMAGE_PATH
, IMAGE_DIR
, CAPTCHA_UMASK
Interchange 5.9.0:
Source: code/SystemTag/captcha.coretag
Lines: 294
# Copyright 2006-2007 Interchange Development Group and others # # This program is free software; you can redistribute it and/or modify # it under the terms of the GNU General Public License as published by # the Free Software Foundation; either version 2 of the License, or # (at your option) any later version. See the LICENSE file for details. # # $Id: captcha.coretag,v 1.4 2007-03-30 23:55:57 pajamian Exp $ UserTag captcha Order function UserTag captcha attrAlias func function UserTag captcha addAttr UserTag captcha Description Generate captcha codes for authentication check UserTag captcha Version $Revision: 1.4 $ UserTag captcha Routine <<EOR my $Have_Captcha; eval { require Authen::Captcha; $Have_Captcha = 1; }; sub { my ($func, $opt) = @_; use vars qw/$Tag/; if(! $Have_Captcha) { ::logError("Use of captcha tag without Authen::Captcha, skipping"); return ''; } $func = lc($func); $func =~ s/[^a-z]+//g; my $result = ''; if($func eq 'code') { $result = $Vend::Session->{captcha}; } $opt->{length} ||= 4; my $en = $opt->{error_name} || 'captcha'; my $subdir = $opt->{image_subdir} || $::Variable->{CAPTCHA_IMAGE_SUBDIR} || 'captcha'; my $tmpdir = "$Vend::Cfg->{ScratchDir}/$subdir"; mkdir($tmpdir) unless -d $tmpdir; my $imgdir = $opt->{image_location} || $::Variable->{CAPTCHA_IMAGE_LOCATION}; unless ($imgdir ) { if(! $Global::NoAbsolute and $::Variable->{DOCROOT}) { $imgdir = "$::Variable->{DOCROOT}$::Variable->{IMAGE_DIR}/$subdir"; } else { $imgdir = "images/$subdir"; } } my $imgpath = $opt->{image_path} || $::Variable->{CAPTCHA_IMAGE_PATH} || "$::Variable->{IMAGE_DIR}/$subdir"; my $captcha = Authen::Captcha->new( data_folder => $tmpdir, output_folder => $imgdir, ); my $guess = $opt->{guess} || $CGI::values{mv_captcha_guess}; my $code = $opt->{source}; if($func eq 'check') { my $check_against = $code || $Vend::Session->{captcha}; my $status = $captcha->check_code($guess, $check_against); if($status > 0) { return $status; } elsif($status == 0) { $Tag->error( { name => $en, set => "Code not checked: error" }); return 0; } elsif($status == -1) { $Tag->error( { name => $en, set => "Code expired" }); return 0; } elsif($status == -2) { $Tag->error( { name => $en, set => "Code never generated" }); return 0; } elsif($status == -3) { $Tag->error( { name => $en, set => "Code doesn't match" }); return 0; } } else { # Used for [captcha-refresh] if requested $::Instance->{last_captcha_build_opt} = { %$opt }; my $save_u = umask($::Variable->{CAPTCHA_UMASK} || 2); if($opt->{reset}) { undef $Vend::Captcha; delete $Vend::Session->{captcha}; } if($Vend::Captcha) { $code ||= $Vend::Session->{captcha}; } if($func eq 'code' and $code) { return $code; } eval { unless( Vend::File::allowed_file($imgdir, 1) ) { my $msg = errmsg("No permission to write directory '%s'", $imgdir); $Tag->error( { name => $en, set => $msg }); return 0; } mkdir($imgdir) unless -d $imgdir; if(! $code) { $code = $Vend::Session->{captcha} = $captcha->generate_code($opt->{length}); $Vend::Captcha = $code; } umask $save_u; }; if($@) { $Tag->error( { name => $en, set => "Error: $@" }); return ''; } if($func eq 'code') { return $code; } # Now probably an image function. unless ($func =~ /ima?ge?/) { $Tag->error({ name => $en, set => errmsg("Unknown function %s", $func), }); return undef; } my $path = $opt->{relative} ? "$subdir/$code.png" : "$imgpath/$code.png"; if(! $opt->{name_only}) { return $Tag->image($path); } else { return $path; } } } EOR UserTag captcha Documentation <<EOD =head1 NAME Interchange [captcha] tag =head1 SYNOPSIS [captcha function="check|code|image|relative_image|image_tag" length="4" image-subdir="captcha" image-location="images/captcha" image-path="/standard/images/captcha" source="[cgi mv_captcha_source]" error-name="captcha" guess="[cgi mv_captcha_guess]" ] =head1 DESCRIPTION This tag generates and/or checks "captcha" images to authenticate user input. If called for the first time in a page, it generates a code/image pair and sets the code in the session (at $Vend::Session->{captcha}). There are several functions. =over 4 =item check Checks the captcha source code (presumably from the previous page) against the guess. If it matches, returns 1. If not, returns 0 and puts error in $Tag->error. =item code Returns the generated code. Generates one if not done previously in session. =item image Returns an IMG tag as generated by Interchange's [image] tag. If the name-only=1 option is passed, no surrounding IMG tag will be generated, only the image name. If the C<relative=1> option is passed, that name will not be prefaced with the ImageDir. =back The additional options are: =over 4 =item guess The input from the user when the function is C<check>. Default is the contents of [cgi mv_captcha_guess]. =item image-subdir The image subdirectory (based in images directory) which will be used. =item image-path The base path for URL generation. Default is the Interchange IMAGE_DIR variable. =item image-location The directory where image files will be generated. Default is the Interchange IMAGE_DIR variable based in the Interchange DOCROOT variable, with the subdirectory above, i.e. C<[var DOCROOT][var IMAGE_DIR]/captcha>. =item length Length of the input for the captcha. Default is 4 characters. =item name-only When set, tells the image function to not generate an HTML IMG tag. =item relative When set, tells the image function (when in name-only mode) to return relative path. =item reset Normally only one captcha code / image will be generated per page transaction. If this is set, you can generate another one -- though you would have to take care of saving the generated code yourself, as $Session->{captcha} is overwritten. =item source The captcha base to guess against for the C<check> function. Default is the contents of the last-generated captcha, or [cgi mv_captcha_source]. =back =head1 EXAMPLE [if cgi mv_captcha_guess] [tmp good][captcha check][/tmp] [if scratch good] You guessed right! [else] Sorry, try again. [/else] [/if] <br> [/if] [captcha function=image] <form action="[process href="@@MV_PAGE@@"]"> <input type=text name=mv_captcha_guess size value=""> <input type=submit value="Guess"> </form> [error auto=1] =head1 PREREQUISITES Authen::Captcha =head1 AUTHOR Mike Heins, <mike AT THE DOMAIN perusion.com>. EOD