[interchange-cvs] interchange - heins modified 2 files
interchange-cvs at icdevgroup.org
interchange-cvs at icdevgroup.org
Sun Aug 6 15:51:38 EDT 2006
User: heins
Date: 2006-08-06 19:51:38 GMT
Modified: lib/Vend UserDB.pm
Added: code/SystemTag captcha.coretag
Log:
* Add "captcha" capability to Interchange.
* Docs for captcha tag embedded in code/SystemTag/captcha.coretag.
* Short example:
[if cgi mv_captcha_guess]
[tmp good][captcha check][/tmp]
[if scratch good]
You guessed right!
[else]
Sorry, try again.
[/else]
[/if]
[/if]
[captcha imagetag]
<form action="[process href="@@MV_PAGE@@"]">
<input type=hidden name=mv_captcha_source value="[captcha code]">
<input type=text name=mv_captcha_guess size value="">
<input type=submit value="Guess">
</form>
[error auto=1]
* Also add ability to specify capability for creating new IC account
in catalog.cfg:
UserDB default captcha 1
Combined with this code in pages/new_account.html:
[if config UserDB->captcha]
<tr>
<td colspan=2>
[captcha image_tag]
</td>
</tr>
<tr>
<td align="right" class="titletab_small">
<b>[L]Letters above[/L]:</b>
</td>
<td align="left" class="titletab_small">
<input type="text" name="mv_captcha_guess" value="">
</td>
</tr>
[/if]
will insist on user getting captcha correct before new account
is generated.
* Not included by default as most sites don't have much problem.
Revision Changes Path
1.1 interchange/code/SystemTag/captcha.coretag
rev 1.1, prev_rev 1.0
Index: captcha.coretag
===================================================================
UserTag captcha Order function
UserTag captcha addAttr
UserTag captcha Description Generate captcha codes for authentication check
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 = $opt->{tmpdir}
|| "$Vend::Cfg->{ScratchDir}/$subdir";
mkdir($tmpdir)
unless -d $tmpdir;
my $imgdir = $opt->{image_location}
|| $::Variable->{CAPTCHA_IMAGE_LOCATION}
|| "$::Variable->{DOCROOT}$::Variable->{IMAGE_DIR}/$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 {
my $save_u = umask($::Variable->{CAPTCHA_UMASK} || 2);
if($func eq 'code') {
$code ||= $Vend::Session->{captcha};
return $code if $code;
}
eval {
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;
}
if($func =~ /^rel(ative)?ima?ge?$/) {
return "$subdir/$code.png";
}
if($func =~ /^ima?ge?$/) {
return "$imgpath/$code.png";
}
if($func =~ /^ima?ge?.*tag/) {
return $Tag->image("$imgpath/$code.png");
}
}
}
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="/var/www/html/standard/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 the full URL path to the image (based on image directory).
=item relative_image
Returns a relative URL path to the image.
=item image_tag
Returns an image tag as generated by Interchange's [image] tag.
=back
The additional options are:
=over 4
=item length
Length of the input for the captcha. Default is 4 characters.
=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 guess
The input from the user when the function is C<check>. Default is the
contents of [cgi mv_captcha_guess].
=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 PREREQUISITES
Authen::Captcha
=head1 AUTHOR
Mike Heins, <mike AT THE DOMAIN perusion.com>.
EOD
2.46 +8 -2 interchange/lib/Vend/UserDB.pm
rev 2.46, prev_rev 2.45
Index: UserDB.pm
===================================================================
RCS file: /var/cvs/interchange/lib/Vend/UserDB.pm,v
retrieving revision 2.45
retrieving revision 2.46
diff -u -r2.45 -r2.46
--- UserDB.pm 3 Aug 2006 15:57:14 -0000 2.45
+++ UserDB.pm 6 Aug 2006 19:51:38 -0000 2.46
@@ -1,6 +1,6 @@
# Vend::UserDB - Interchange user database functions
#
-# $Id: UserDB.pm,v 2.45 2006/08/03 15:57:14 mheins Exp $
+# $Id: UserDB.pm,v 2.46 2006/08/06 19:51:38 mheins Exp $
#
# Copyright (C) 2002-2005 Interchange Development Group
# Copyright (C) 1996-2002 Red Hat, Inc.
@@ -17,7 +17,7 @@
package Vend::UserDB;
-$VERSION = substr(q$Revision: 2.45 $, 10);
+$VERSION = substr(q$Revision: 2.46 $, 10);
use vars qw!
$VERSION
@@ -1643,6 +1643,12 @@
die errmsg("Must have at least %s characters in username.",
$self->{USERMINLEN}) . "\n"
if length($self->{USERNAME}) < $self->{USERMINLEN};
+
+ if($self->{OPTIONS}{captcha}) {
+ my $status = Vend::Tags->captcha( { function => 'check' });
+ die errmsg("Must input captcha code correctly.\n")
+ unless $status;
+ }
# Here we put the username in a non-primary key field, checking
# for existence
More information about the interchange-cvs
mailing list