![[site community profile]](https://www.dreamwidth.org/img/comm_staff.png){kind=small}
[dw-free] offer text captcha as an alternative to reCAPTCHA
[commit: http://hg.dwscoalition.org/dw-free/rev/6888252ac285]
http://bugs.dwscoalition.org/show_bug.cgi?id=3227
Implement textCAPTCHA: Refactors the DW::Captcha module to be able to
support multiple captcha types / implementations. Adds a setting to allow
the captcha type to be set on a per-journal basis. (default will be
textcaptcha rather than the graphical recaptcha)
Patch by![[personal profile]](https://www.dreamwidth.org/img/silk/identity/user.png)
fu.
Files modified:
http://bugs.dwscoalition.org/show_bug.cgi?id=3227
Implement textCAPTCHA: Refactors the DW::Captcha module to be able to
support multiple captcha types / implementations. Adds a setting to allow
the captcha type to be set on a per-journal basis. (default will be
textcaptcha rather than the graphical recaptcha)
Patch by
fu.Files modified:
- bin/upgrading/en.dat
- bin/upgrading/proplists.dat
- cgi-bin/DW/Captcha.pm
- cgi-bin/DW/Captcha/reCAPTCHA.pm
- cgi-bin/DW/Captcha/textCAPTCHA.pm
- cgi-bin/DW/Controller/RPC/TextCAPTCHA.pm
- cgi-bin/DW/Setting/Captcha.pm
- cgi-bin/LJ/Global/Defaults.pm
- cgi-bin/LJ/Talk.pm
- cgi-bin/LJ/User.pm
- cgi-bin/LJ/Widget/SubmitRequest.pm
- doc/config-local.pl.txt
- doc/config-private.pl.txt
- etc/config.pl
- htdocs/create.bml
- htdocs/js/dw/dw-core.js
- htdocs/lostinfo.bml
- htdocs/manage/settings/index.bml
- htdocs/register.bml
- htdocs/stc/textcaptcha.css
- htdocs/support/submit.bml
- t/captcha-textcaptcha.t
- t/captcha.t
- views/textcaptcha-response.tt
- views/textcaptcha-response.tt.text
- views/textcaptcha.tt
- views/textcaptcha.tt.text
--------------------------------------------------------------------------------
diff -r 40433367c052 -r 6888252ac285 bin/upgrading/en.dat
--- a/bin/upgrading/en.dat Wed Feb 15 06:01:15 2012 +0800
+++ b/bin/upgrading/en.dat Sat Feb 18 13:26:01 2012 +0800
@@ -33,6 +33,8 @@
captcha.invalid=Incorrect response in the antispam field. Please try again.
+captcha.loading=Loading anti-spam test...
+
captcha.title=Please fill out the CAPTCHA as an anti-spam measure
cleanhtml.error.markup=( <a [[aopts]]>Error: Irreparable invalid markup in entry. Raw contents behind the cut.</a> )
@@ -2436,6 +2438,14 @@
setting.birthdaydisplay.question=Birthday display options:
+setting.captcha.label=Anti-Spam Type
+
+setting.captcha.option=Commenters will see
+
+setting.captcha.option.select.image=graphical/image anti-spam tests
+
+setting.captcha.option.select.text=text-based anti-spam tests
+
setting.commentcaptcha.label=Anti-Spam
setting.commentcaptcha.option=Show CAPTCHA to
diff -r 40433367c052 -r 6888252ac285 bin/upgrading/proplists.dat
--- a/bin/upgrading/proplists.dat Wed Feb 15 06:01:15 2012 +0800
+++ b/bin/upgrading/proplists.dat Sat Feb 18 13:26:01 2012 +0800
@@ -54,6 +54,14 @@
multihomed: 0
prettyname: Language to browse with
+userproplist.captcha:
+ cldversion: 4
+ datatype: char
+ des: CAPTCHA type to show in the user's journal
+ indexed: 0
+ multihomed: 0
+ prettyname: CAPTCHA type
+
userproplist.city:
cldversion: 4
datatype: char
diff -r 40433367c052 -r 6888252ac285 cgi-bin/DW/Captcha.pm
--- a/cgi-bin/DW/Captcha.pm Wed Feb 15 06:01:15 2012 +0800
+++ b/cgi-bin/DW/Captcha.pm Sat Feb 18 13:26:01 2012 +0800
@@ -7,7 +7,7 @@
# Authors:
# Afuna <coder.dw@afunamatata.com>
#
-# Copyright (c) 2010 by Dreamwidth Studios, LLC.
+# Copyright (c) 2010-2012 by Dreamwidth Studios, LLC.
#
# This program is free software; you may redistribute it and/or modify it under
# the same terms as Perl itself. For a copy of the license, please reference
@@ -20,89 +20,183 @@
=head1 SYNOPSIS
+Here's the simplest method:
+
+ # print out the captcha form fields on a particular page
+ my $captcha = DW::Captcha->new( $page );
+ if ( $captcha->enabled ) {
+ $captcha->print;
+ }
+
+ # elsewhere, process the post
+ if ( $r->did_post ) {
+ my $captcha = DW::Captcha->new( $page, %{$r->post_args} );
+
+ my $captcha_error;
+ push @errors, $captcha_error unless $captcha->validate( err_ref => \$captcha_error );
+ }
+
+
+When using in conjunction with LJ::Widget subclasses, you can just specify the form field names and let the widget handle it:
+
+ LJ::Widget->use_specific_form_fields( post => \%POST, widget => "...", fields => [ DW::Captcha->form_fields ] )
+ if DW::Captcha->enabled( 'create' );
=cut
use strict;
-use warnings;
package DW::Captcha;
-# at some point we may replace this, or try to make this implementation more flexible
-# right now, let's just go with this
+use LJ::ModuleLoader;
-BEGIN {
- my $rv = eval <<USE;
-use Captcha::reCAPTCHA;
-1;
-USE
- warn "NOTE: Captcha::reCAPTCHA was not found.\n"
- unless $rv;
+my @CLASSES = LJ::ModuleLoader->module_subclasses( "DW::Captcha" );
- our $MODULES_INSTALLED = $rv;
+my %impl2class;
+foreach my $class ( @CLASSES ) {
+ eval "use $class";
+ die "Error loading class '$class': $@" if $@;
+ $impl2class{lc $class->name} = $class;
}
# class methods
+=head1 API
+
+=head2 C<< DW::Captcha->new( $implementation, $page, %opts ) >>
+
+Arguments:
+
+=over
+
+=item page - the page we're going to display this CAPTCHA on
+
+=item implementation - which CAPTCHA implementation we'd like to use
+
+=item a hash of additional options, including the request/response from a form post
+
+=back
+
+=cut
+
sub new {
- my ( $class, $type, %opts ) = @_;
+ my ( $class, $page, %opts ) = @_;
+
+ # yes, I really do want to do this rather than $impl{...||$LJ::DEFAULT_CAPTCHA...}
+ # we want to make certain that someone can't force all captchas off
+ # by asking for an invalid captcha type
+ my $impl = $LJ::CAPTCHA_TYPES{delete $opts{want} || ""} || "";
+ my $subclass = $impl2class{$impl};
+ $subclass = $impl2class{$LJ::CAPTCHA_TYPES{$LJ::DEFAULT_CAPTCHA_TYPE}}
+ unless $subclass && $subclass->site_enabled;
my $self = bless {
- type => $type,
- }, $class;
+ page => $page,
+ }, $subclass;
- $self->init_opts( %opts );
+ $self->_init_opts( %opts );
return $self;
}
-sub form_fields { qw( recaptcha_response_field recaptcha_challenge_field ) }
-sub public_key { LJ::conf_test( $LJ::RECAPTCHA{public_key} ) }
-sub private_key { LJ::conf_test( $LJ::RECAPTCHA{private_key} ) }
+# must be implemented by subclasses
+=head2 C<< $class->name >>
-sub site_enabled {
- return 0 unless $DW::Captcha::MODULES_INSTALLED;
- return LJ::is_enabled( 'recaptcha' ) && $LJ::RECAPTCHA{public_key} && $LJ::RECAPTCHA{private_key};
-}
+The name used to refer to this CAPTCHA implementation.
+
+=cut
+
+sub name { return ""; }
+
# object methods
+
+=head2 C<< $captcha->form_fields >>
+
+Returns a list of the form fields expected by the CAPTCHA implementation.
+
+=head2 C<< $captcha->site_enabled >>
+
+Whether CAPTCHA is enabled site-wide. (Specific pages may have CAPTCHA disabled)
+
+=head2 C<< $captcha->print >>
+
+Print the CAPTCHA form fields.
+
+=head2 C<< $captcha->validate( %opts ) >>
+
+Return whether the response for this CAPTCHA was valid.
+
+Arguments:
+
+=over
+
+=item opts - a hash of additional options, including the request/response from a form post
+and an error reference (err_ref) which may contain additional information in case
+the validation failed
+
+=back
+
+=head2 C<< $captcha->enabled( $page ) >>
+
+Whether this CAPTCHA implementation is enabled on this particular page
+(or sitewide if this captcha instance isn't tied to a specific page)
+
+Arguments:
+
+=over
+
+=item page - Optional. A specific page to check
+
+=back
+
+=head2 C<< $captcha->page >>
+
+Return the page that this CAPTCHA instance is going to be used with
+
+=head2 C<< $captcha->challenge >>
+
+Challenge text, provided by the CAPTCHA implementation
+
+=head2 C<< $captcha->response >>
+
+User-provided response text
+
+=cut
+
+# must be implemented by subclasses
+sub form_fields { qw() }
+
+sub site_enabled { return LJ::is_enabled( 'captcha' ) && $_[0]->_implementation_enabled ? 1 : 0 }
+
+# must be implemented by subclasses
+sub _implementation_enabled { return 1; }
+
+
sub print {
my $self = $_[0];
return "" unless $self->enabled;
- my $captcha = Captcha::reCAPTCHA->new;
- my $ret = $captcha->get_options_setter( { theme => 'white' } );
-
- $ret .= "<div class='captcha'>";
-
- $ret .= $captcha->get_html(
- public_key(), # public key
- '', # error (optional)
- $LJ::IS_SSL # page uses ssl
- );
-
- $ret .= "<p>" . BML::ml( 'captcha.accessibility.contact', { email => $LJ::SUPPORT_EMAIL } ) . "</p>";
+ my $ret = "<div class='captcha'>";
+ $ret .= $self->_print;
+ $ret .= "<p style='clear:both'>" . BML::ml( 'captcha.accessibility.contact', { email => $LJ::SUPPORT_EMAIL } ) . "</p>";
$ret .= "</div>";
return $ret;
}
-sub validate {
+# must be implemented by subclasses
+sub _print { return ""; }
+
+sub validate {
my ( $self, %opts ) = @_;
# if disabled, then it's always valid to allow the post to go through
return 1 unless $self->enabled;
- $self->init_opts( %opts );
+ $self->_init_opts( %opts );
my $err_ref = $opts{err_ref};
- my $result;
if ( $self->challenge ) {
- my $captcha = Captcha::reCAPTCHA->new;
- $result = $captcha->check_answer(
- private_key(), $ENV{REMOTE_ADDR},
- $self->challenge, $self->response
- );
-
- return 1 if $result->{is_valid} eq '1';
+ return 1 if $self->_validate;
}
$$err_ref = LJ::Lang::ml( 'captcha.invalid' );
@@ -110,25 +204,30 @@
return 0;
}
-# enabled can be used as either a class or an object method
+# must be implemented by subclasses
+sub _validate { return 0; }
+
sub enabled {
+ my $page;
+ $page = $_[0]->page if ref $_[0];
+ $page ||= $_[1];
- my $type = ref $_[0] ? $_[0]->type : $_[1];
-
- return $type
- ? site_enabled() && $LJ::CAPTCHA_FOR{$type}
- : site_enabled();
+ return $page
+ ? $_[0]->site_enabled() && $LJ::CAPTCHA_FOR{$page}
+ : $_[0]->site_enabled();
}
-sub init_opts {
+# internal method. Used to initialize the challenge and response fields
+# must be implemented by subclasses
+sub _init_opts {
my ( $self, %opts ) = @_;
- $self->{challenge} ||= $opts{recaptcha_challenge_field};
- $self->{response} ||= $opts{recaptcha_response_field};
+ # do something
}
-sub type { return $_[0]->{type} }
+sub page { return $_[0]->{page} }
sub challenge { return $_[0]->{challenge} }
sub response { return $_[0]->{response} }
+
1;
diff -r 40433367c052 -r 6888252ac285 cgi-bin/DW/Captcha/reCAPTCHA.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/cgi-bin/DW/Captcha/reCAPTCHA.pm Sat Feb 18 13:26:01 2012 +0800
@@ -0,0 +1,88 @@
+#!/usr/bin/perl
+#
+# DW::Captcha::reCAPTCHA
+#
+# This module handles integration with the reCAPTCHA service
+#
+# Authors:
+# Afuna <coder.dw@afunamatata.com>
+#
+# Copyright (c) 2012 by Dreamwidth Studios, LLC.
+#
+# This program is free software; you may redistribute it and/or modify it under
+# the same terms as Perl itself. For a copy of the license, please reference
+# 'perldoc perlartistic' or 'perldoc perlgpl'.
+#
+
+=head1 NAME
+
+DW::Captcha::reCAPTCHA - This module handles integration with the reCAPTCHA service
+
+=head1 SYNOPSIS
+
+=cut
+
+use strict;
+
+package DW::Captcha::reCAPTCHA;
+use base 'DW::Captcha';
+
+BEGIN {
+ my $rv = eval <<USE;
+use Captcha::reCAPTCHA;
+1;
+USE
+ warn "NOTE: Captcha::reCAPTCHA was not found.\n"
+ unless $rv;
+
+ our $MODULES_INSTALLED = $rv;
+}
+
+
+# implemented as overrides for the base class
+
+
+# class methods
+sub name { return "recaptcha" }
+
+# object methods
+sub form_fields { qw( recaptcha_response_field recaptcha_challenge_field ) }
+sub _implementation_enabled {
+ return 0 unless $DW::Captcha::reCAPTCHA::MODULES_INSTALLED;
+ return LJ::is_enabled( 'captcha', 'recaptcha' ) && _public_key() && _private_key() ? 1 : 0;
+}
+
+sub _print {
+ my $captcha = Captcha::reCAPTCHA->new;
+ return $captcha->get_options_setter( { theme => 'white' } ) .
+ $captcha->get_html(
+ _public_key(), # public key
+ '', # error (optional)
+ $LJ::IS_SSL # page uses ssl
+ );
+}
+
+sub _validate {
+ my $self = $_[0];
+
+ my $captcha = Captcha::reCAPTCHA->new;
+ my $result = $captcha->check_answer(
+ _private_key(), $ENV{REMOTE_ADDR},
+ $self->challenge, $self->response
+ );
+
+ return 1 if $result->{is_valid} eq '1';
+}
+
+sub _init_opts {
+ my ( $self, %opts ) = @_;
+
+ $self->{challenge} ||= $opts{recaptcha_challenge_field};
+ $self->{response} ||= $opts{recaptcha_response_field};
+}
+
+# recaptcha-specific methods
+sub _public_key { LJ::conf_test( $LJ::RECAPTCHA{public_key} ) }
+sub _private_key { LJ::conf_test( $LJ::RECAPTCHA{private_key} ) }
+
+1;
diff -r 40433367c052 -r 6888252ac285 cgi-bin/DW/Captcha/textCAPTCHA.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/cgi-bin/DW/Captcha/textCAPTCHA.pm Sat Feb 18 13:26:01 2012 +0800
@@ -0,0 +1,237 @@
+#!/usr/bin/perl
+#
+# DW::Captcha::textCAPTCHA
+#
+# This module handles integration with the textCAPTCHA service
+#
+# Authors:
+# Afuna <coder.dw@afunamatata.com>
+#
+# Copyright (c) 2012 by Dreamwidth Studios, LLC.
+#
+# This program is free software; you may redistribute it and/or modify it under
+# the same terms as Perl itself. For a copy of the license, please reference
+# 'perldoc perlartistic' or 'perldoc perlgpl'.
+#
+
+=head1 NAME
+
+DW::Captcha::textCAPTCHA - This module handles integration with the textCAPTCHA service
+
+=head1 SYNOPSIS
+
+=cut
+
+use strict;
+
+package DW::Captcha::textCAPTCHA;
+use base 'DW::Captcha';
+
+use XML::Simple;
+use Digest::MD5 ();
+
+
+# implemented as overrides for the base class
+
+
+# class methods
+sub name { return "textcaptcha" }
+
+# object methods
+sub form_fields { qw( textcaptcha_challenge textcaptcha_response textcaptcha_response_noscript textcaptcha_chalauth ) }
+sub _implementation_enabled {
+ return LJ::is_enabled( 'captcha', 'textcaptcha' ) && _api_key() ? 1 : 0;
+}
+
+# this prints out the js/iframe to load the captcha (but not the captcha itself)
+sub _print {
+ my $self = $_[0];
+
+ # form_auth remains the same throughout the lifetime of the request
+ # so we can just call this here instead of passing it in from the external form
+ my $auth = LJ::form_auth( 1 );
+
+ # we can't use need_res, alas, because we're printing this inline
+ # after the <head> has already been printed
+ # FIXME: remove check when we get rid of the old library
+ my $loading_text = LJ::Lang::ml( "captcha.loading" );
+ my $captcha_load = $LJ::ACTIVE_RES_GROUP && $LJ::ACTIVE_RES_GROUP eq "jquery"
+ ? qq!
+<script type="text/javascript">
+jQuery(function(jq){
+ jq("#textcaptcha_container").html("$loading_text")
+ .load(jq.endpoint("captcha") + "/$auth");
+});
+</script>
+ ! : qq!
+<script type="text/javascript">
+ \$("textcaptcha_container").innerHTML = "$loading_text";
+ HTTPReq.getJSON({
+ "url": LiveJournal.getAjaxUrl("captcha") + "/$auth.json",
+ "method": "GET",
+ "onError": LiveJournal.ajaxError,
+ "onData": function(data) {\$("textcaptcha_container").innerHTML = data.captcha}
+ })
+</script>
+ !;
+
+ my $response_label = LJ::Lang::ml( "/textcaptcha-response.tt.response.user.label" );
+
+ # putting it in noscript so that we don't load it the page unnecessarily if we actually have JS
+ return qq{
+<div id="textcaptcha_container" aria-live="assertive" style="line-height: 1.2em">
+ $captcha_load
+<noscript><iframe src="$LJ::SITEROOT/captcha/text/$auth" style="width:100%;height:4em" id="textcaptcha_fallback"></iframe>
+<label for="textcaptcha_response_noscript">$response_label</label> <input type="text" maxlength="255" autocomplete="off" value="" name="textcaptcha_response_noscript" class="text" id="textcaptcha_response_noscript" size="50" />
+</noscript>
+</div>};
+}
+
+sub _validate {
+ my $self = $_[0];
+ return DW::Captcha::textCAPTCHA::Logic::check_answer( $self->challenge, $self->response, $self->form_auth, $self->captcha_auth );
+}
+
+sub _init_opts {
+ my ( $self, %opts ) = @_;
+
+ # rather than having a lot of ifs/elses here to extract multiple keys
+ # when we're pulling via BML vs via a controller, etc
+ # let's just pull directly from the request
+ my $r = DW::Request->get;
+ my $post_args = $r->post_args if $r;
+
+ if ( $post_args ) {
+ if ( my $response_noscript = $post_args->{textcaptcha_response_noscript} ) {
+ my %parsed = DW::Captcha::textCAPTCHA::Logic::from_form_string( $response_noscript );
+ $self->{$_} ||= $parsed{$_} foreach qw( challenge response form_auth captcha_auth );
+ } else {
+ # allow multiple values
+ $self->{challenge} ||= [ $post_args->get_all( "textcaptcha_challenge" ) ];
+
+ # just allow the user to submit one
+ $self->{response} ||= $post_args->{textcaptcha_response};
+
+ # assume we need the form auth
+ $self->{form_auth} ||= $post_args->{lj_form_auth};
+
+ $self->{captcha_auth} ||= $post_args->{textcaptcha_chalauth};
+ }
+ }
+}
+
+=head1 C<< textCAPTCHA-specific methods >>
+
+=cut
+
+# textcaptcha-specific methods
+sub _api_key { LJ::conf_test( $LJ::TEXTCAPTCHA{api_key} ) }
+
+=head2 C<< $captcha->form_auth >>
+
+Generic form auth. Ties this captcha to a specific form instance.
+
+=cut
+
+=head2 C<< $captcha->captcha_auth >>
+
+Additional auth for this captcha. Enforces time limit and single use.
+
+=cut
+
+sub form_auth { return $_[0]->{form_auth} }
+sub captcha_auth { return $_[0]->{captcha_auth} }
+
+package DW::Captcha::textCAPTCHA::Logic;
+
+# this is an internal class which shouldn't be called directly by anything else
+# (except maybe tests)
+
+sub fetch {
+ my ( $class ) = $_[0];
+
+ my $ua = LJ::get_useragent( role => 'textcaptcha', timeout => $LJ::TEXTCAPTCHA{timeout} );
+ $ua->agent("$LJ::SITENAME ($LJ::ADMIN_EMAIL; captcha request)");
+ my $res = $ua->get( "http://api.textcaptcha.com/" . DW::Captcha::textCAPTCHA::_api_key() );
+ return $res && $res->is_success ? $res->content : "";
+}
+
+# arguments:
+# * xml string containing the captcha question as a plain string
+# and answer, or answers, as an MD5 hash
+# * the form auth which we can use to tie this captcha to a particular instance
+
+# returns a hashref containing data suitable for use within the form:
+# * the question to display
+# * answers (salted)
+# * captcha auth
+sub form_data {
+ my ( $captcha_data_string, $auth ) = @_;
+ my $captcha = eval { XML::Simple::XMLin( $captcha_data_string, ForceArray => [ 'answer' ] ); };
+
+ # get the timestamp
+ my $secret = LJ::get_secret( (split( /:/, $auth ))[1] );
+ my @salted_answers = map { Digest::MD5::md5_hex( $auth . $secret . $_ ) } @{$captcha->{answer}};
+
+ return {
+ question => $captcha->{question},
+ answers => \@salted_answers,
+ chal => LJ::challenge_generate( 900 ), # 15 minute token
+ };
+}
+
+# arguments:
+# * valid responses to the captcha
+# * the user's response
+# * form auth
+# * captcha auth
+sub check_answer {
+ my ( $form_responses, $user_response, $form_auth, $captcha_auth ) = @_;
+
+ # all forms we use captcha with should have had a corresponding lj_form_auth
+ # but just in case we miss a spot (though we really shouldn't) let's cut this short
+ # also cut short if we don't provide the captcha-specific auth
+ return 0 unless $form_auth && $captcha_auth;
+
+ my $chal_opts = {};
+ return 0 unless LJ::challenge_check( $captcha_auth, $chal_opts );
+
+ my $secret = LJ::get_secret( ( split( /:/, $form_auth ))[1] );
+
+ my $user_answer = Digest::MD5::md5_hex( LJ::trim( lc $user_response ) );
+ my $check_answer = Digest::MD5::md5_hex( $form_auth . $secret . $user_answer );
+
+ foreach ( @$form_responses ) {
+ return 1 if $_ eq $check_answer;
+ }
+
+ return 0;
+}
+
+# concatenate all relevant values into one string
+sub to_form_string {
+ my $self = $_[0];
+
+ return join( "::",
+ ( $self->form_auth,
+ $self->captcha_auth,
+ $self->response,
+ join( "::", @{$self->challenge||[]} )
+ )
+ );
+}
+
+# return a hash
+sub from_form_string {
+ my ( $string ) = @_;
+
+ my ( $form_auth, $captcha_auth, $response, @challenges ) = split "::", $string;
+ return (
+ form_auth => $form_auth,
+ captcha_auth => $captcha_auth,
+ response => $response,
+ challenge => \@challenges
+ );
+}
+
+1;
diff -r 40433367c052 -r 6888252ac285 cgi-bin/DW/Controller/RPC/TextCAPTCHA.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/cgi-bin/DW/Controller/RPC/TextCAPTCHA.pm Sat Feb 18 13:26:01 2012 +0800
@@ -0,0 +1,73 @@
+#!/usr/bin/perl
+#
+# DW::Controller::TextCAPTCHA
+#
+# AJAX endpoint that returns a textCAPTCHA instance
+# May also be loaded on a page
+#
+# Author:
+# Afuna <coder.dw@afunamatata.com>
+#
+# Copyright (c) 2012 by Dreamwidth Studios, LLC.
+#
+# This program is free software; you may redistribute it and/or modify it under
+# the same terms as Perl itself. For a copy of the license, please reference
+# 'perldoc perlartistic' or 'perldoc perlgpl'.
+#
+
+package DW::Controller::RPC::TextCAPTCHA;
+
+use strict;
+
+use DW::Routing;
+use JSON;
+use DW::Captcha::textCAPTCHA;
+
+DW::Routing->register_regex( "/__rpc_captcha/(.*)", \&captcha_handler, app => 1, user => 1, format => 'html', formats => [qw( html json )] );
+DW::Routing->register_regex( "/captcha/text/(.*)", \&iframe_captcha_handler, app => 1, format => 'html' );
+
+# loaded inline into the page using JS
+sub captcha_handler {
+ my ( $call_opts, $auth ) = @_;
+
+ my $from_textcaptcha = DW::Captcha::textCAPTCHA::Logic->fetch;
+ my ( $captcha ) = DW::Captcha::textCAPTCHA::Logic::form_data( $from_textcaptcha, $auth );
+
+ if ( $call_opts->format eq "json" ) {
+ # json format is for the old JS library
+ my $captcha_html = DW::Template->template_string( 'textcaptcha.tt', { captcha => $captcha }, { fragment => 1 } );
+
+ my $r = DW::Request->get;
+ $r->print( objToJson( { captcha => $captcha_html } ) );
+ return $r->OK;
+ } else {
+ return DW::Template->render_template( 'textcaptcha.tt', { captcha => $captcha }, { fragment => 1 } );
+ }
+}
+
+# fallback for the no-js case
+sub iframe_captcha_handler {
+ my ( $call_opts, $auth ) = @_;
+
+ my $error;
+ my $r = DW::Request->get;
+ if ( $r->did_post ) {
+ my $captcha_object = DW::Captcha->new( undef, %{$r->post_args} );
+
+ # we don't check whether this is true or not (we'd end up expiring the captcha's auth if we did)
+ return DW::Template->render_template( 'textcaptcha-response.tt', { response => DW::Captcha::textCAPTCHA::Logic::to_form_string( $captcha_object ) }, { fragment => 1 } );
+ }
+
+ my $from_textcaptcha = DW::Captcha::textCAPTCHA::Logic->fetch;
+ my ( $captcha ) = DW::Captcha::textCAPTCHA::Logic::form_data( $from_textcaptcha, $auth );
+
+ return DW::Template->render_template( 'textcaptcha.tt', {
+ handle_submit => 1,
+
+ captcha => $captcha,
+ form_auth => $auth,
+ error => $error
+ }, { fragment => 1 } );
+}
+
+1;
diff -r 40433367c052 -r 6888252ac285 cgi-bin/DW/Setting/Captcha.pm
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/cgi-bin/DW/Setting/Captcha.pm Sat Feb 18 13:26:01 2012 +0800
@@ -0,0 +1,71 @@
+#!/usr/bin/perl
+#
+# DW::Setting::Captcha
+#
+# LJ::Setting module for choosing the captcha type to display on this journal
+#
+# Authors:
+# Afuna <coder.dw@afunamatata.com>
+#
+# Copyright (c) 2012 by Dreamwidth Studios, LLC.
+#
+# This program is free software; you may redistribute it and/or modify it under
+# the same terms as Perl itself. For a copy of the license, please reference
+# 'perldoc perlartistic' or 'perldoc perlgpl'.
+#
+
+package DW::Setting::Captcha;
+use base 'LJ::Setting';
+use strict;
+
+use DW::Captcha;
+
+sub should_render {
+ my ( $class, $u ) = @_;
+ return $u->is_identity ? 0 : 1;
+}
+
+sub label {
+ my $class = shift;
+ return $class->ml( 'setting.captcha.label' );
+}
+
+sub option {
+ my ( $class, $u, $errs, $args ) = @_;
+ my $key = $class->pkgkey;
+
+ my $captcha_type = $class->get_arg( $args, "captcha" ) || $u->captcha_type;
+
+ my @opts = (
+ "T" => $class->ml( "setting.captcha.option.select.text" ),
+ "I" => $class->ml( "setting.captcha.option.select.image" ),
+ );
+
+ my $ret;
+ $ret .= "<label for='${key}captcha'>";
+ $ret .= $class->ml( 'setting.captcha.option' );
+ $ret .= "</label> ";
+
+ $ret .= LJ::html_select( { name => "${key}captcha",
+ id => "${key}captcha",
+ selected => $captcha_type },
+ @opts );
+
+ my $errdiv = $class->errdiv( $errs, "captcha" );
+ $ret .= "<br />$errdiv" if $errdiv;
+
+ return $ret;
+}
+
+sub save {
+ my ( $class, $u, $args ) = @_;
+
+ my $val = $class->get_arg( $args, "captcha" );
+ $val = undef unless $val =~ /^[IT]$/;
+
+ $u->captcha_type( $val );
+
+ return 1;
+}
+
+1;
diff -r 40433367c052 -r 6888252ac285 cgi-bin/LJ/Global/Defaults.pm
--- a/cgi-bin/LJ/Global/Defaults.pm Wed Feb 15 06:01:15 2012 +0800
+++ b/cgi-bin/LJ/Global/Defaults.pm Sat Feb 18 13:26:01 2012 +0800
@@ -358,6 +358,14 @@
"js/hoverIntent.js" => "js/hoverIntent.minified.js",
"js/tooltip.js" => "js/tooltip.min.js",
) unless defined %LJ::MINIFY;
+
+ # mapping of captcha type to specific desired implementation
+ %CAPTCHA_TYPES = (
+ "T" => "textcaptcha", # "T" is for text
+ "I" => "recaptcha", # "I" is for image
+ ) unless defined %CAPTCHA_TYPES;
+ $DEFAULT_CAPTCHA_TYPE ||= "T";
+
}
diff -r 40433367c052 -r 6888252ac285 cgi-bin/LJ/Talk.pm
--- a/cgi-bin/LJ/Talk.pm Wed Feb 15 06:01:15 2012 +0800
+++ b/cgi-bin/LJ/Talk.pm Sat Feb 18 13:26:01 2012 +0800
@@ -2032,7 +2032,7 @@
# Display captcha challenge if over rate limits.
if ( $opts->{do_captcha} ) {
- my $captcha = DW::Captcha->new;
+ my $captcha = DW::Captcha->new( undef, want => $journalu->captcha_type );
$ret .= $captcha->print;
}
@@ -3665,8 +3665,10 @@
# unixify line-endings
$form->{'body'} =~ s/\r\n/\n/g;
+ # FIXME: remove when we no longer support BML
+ $form->{textcaptcha_challenge} = [ split /\0/, $form->{textcaptcha_challenge} ];
+
# now check for UTF-8 correctness, it must hold
-
return $err->("<?badinput?>") unless LJ::text_in($form);
$init->{unknown8bit} = 0;
@@ -3775,10 +3777,11 @@
##
## 1. Check rate by remote user and by IP (for anonymous user)
##
- if ( DW::Captcha->enabled( 'anonpost' ) || DW::Captcha->enabled( 'authpost' ) ) {
+ my $captcha = DW::Captcha->new;
+ if ( $captcha->enabled( 'anonpost' ) || $captcha->enabled( 'authpost' ) ) {
return 1 unless LJ::Talk::Post::check_rate( $commenter, $journal );
}
- if ( DW::Captcha->enabled( 'anonpost' ) && $anon_commenter) {
+ if ( $captcha->enabled( 'anonpost' ) && $anon_commenter) {
return 1 if LJ::sysban_check( 'talk_ip_test', LJ::get_remote_ip() );
}
@@ -3819,8 +3822,8 @@
## 4. Global (site) settings
## See if they have any tags or URLs in the comment's body
##
- if ( DW::Captcha->enabled( 'comment_html_auth' )
- || ( DW::Captcha->enabled( 'comment_html_anon' ) && $anon_commenter))
+ if ( $captcha->enabled( 'comment_html_auth' )
+ || ( $captcha->enabled( 'comment_html_anon' ) && $anon_commenter))
{
if ($body =~ /<[a-z]/i) {
# strip white-listed bare tags w/o attributes,
diff -r 40433367c052 -r 6888252ac285 cgi-bin/LJ/User.pm
--- a/cgi-bin/LJ/User.pm Wed Feb 15 06:01:15 2012 +0800
+++ b/cgi-bin/LJ/User.pm Sat Feb 18 13:26:01 2012 +0800
@@ -2187,6 +2187,16 @@
return $_[0]->get_cap( 'viewmailqueue' ) ? 1 : 0;
}
+sub captcha_type {
+ my $u = $_[0];
+
+ if ( defined $_[1] ) {
+ $u->set_prop( captcha => $_[1] );
+ }
+
+ return $_[1] || $u->prop( 'captcha' ) || $LJ::DEFAULT_CAPTCHA_TYPE;
+}
+
sub clear_prop {
my ($u, $prop) = @_;
$u->set_prop($prop, undef);
diff -r 40433367c052 -r 6888252ac285 cgi-bin/LJ/Widget/SubmitRequest.pm
--- a/cgi-bin/LJ/Widget/SubmitRequest.pm Wed Feb 15 06:01:15 2012 +0800
+++ b/cgi-bin/LJ/Widget/SubmitRequest.pm Sat Feb 18 13:26:01 2012 +0800
@@ -219,11 +219,5 @@
return ('spid' => $spid);
}
-sub error_list {
- my ($class, @errors) = @_;
- return unless @errors;
-
- $class->error($_) foreach @errors;
-}
1;
diff -r 40433367c052 -r 6888252ac285 doc/config-local.pl.txt
--- a/doc/config-local.pl.txt Wed Feb 15 06:01:15 2012 +0800
+++ b/doc/config-local.pl.txt Sat Feb 18 13:26:01 2012 +0800
@@ -56,6 +56,11 @@
private_key => $DW::PRIVATE::RECAPTCHA{private_key},
);
+ # setup textcaptcha
+ %TEXTCAPTCHA = (
+ api_key => $DW::PRIVATE::TEXTCAPTCHA{api_key},
+ );
+
# If enabled, disable people coming in over Tor exits from using various parts of the site.
$USE_TOR_CONFIGS = 0;
diff -r 40433367c052 -r 6888252ac285 doc/config-private.pl.txt
--- a/doc/config-private.pl.txt Wed Feb 15 06:01:15 2012 +0800
+++ b/doc/config-private.pl.txt Sat Feb 18 13:26:01 2012 +0800
@@ -169,6 +169,13 @@
# public_key => ,
# private_key => ,
#);
+
+ #%TEXTCAPTCHA = (
+ # # this works for testing purposes.
+ # # sign up at the textcaptcha website for a key for production use
+ # api_key => "demo",
+ # timeout => 10,
+ #);
}
1;
diff -r 40433367c052 -r 6888252ac285 etc/config.pl
--- a/etc/config.pl Wed Feb 15 06:01:15 2012 +0800
+++ b/etc/config.pl Sat Feb 18 13:26:01 2012 +0800
@@ -141,6 +141,7 @@
adult_content => 0,
blockwatch => 1,
'community-logins' => 0,
+ captcha => 0,
directory => 0,
esn_archive => 1,
eventlogrecord => 1,
@@ -164,6 +165,16 @@
# ref $_[0] && defined $_[0]->{sitename} &&
# $_[0]->{sitename} eq 'LiveJournal' ? 1 : 0 };
+ # disable the recaptcha module, but keep textcaptcha enabled
+ # you'd probably want to edit $LJ::DEFAULT_CAPTCHA_TYPE in this case
+ #$DISABLED{captcha} = sub {
+ # my $module = $_[0];
+ # return 1 if $module eq "recaptcha";
+ # return 0 if $module eq "textcaptcha";
+ # return 0;
+ #};
+
+
# turn $SERVER_DOWN on while you do any maintenance
$SERVER_TOTALLY_DOWN = 0;
$SERVER_DOWN = 0;
@@ -838,6 +849,7 @@
# on why they're banned
# $BLOCKED_ANON_URI = '';
+ # pages where we want to see captcha
%CAPTCHA_FOR = (
create => 0,
lostinfo => 1,
diff -r 40433367c052 -r 6888252ac285 htdocs/create.bml
--- a/htdocs/create.bml Wed Feb 15 06:01:15 2012 +0800
+++ b/htdocs/create.bml Sat Feb 18 13:26:01 2012 +0800
@@ -39,9 +39,11 @@
my $code;
my $rate_ok;
if ( LJ::did_post() ) {
- LJ::Widget->use_specific_form_fields( post => \%POST, widget => "CreateAccount", fields => [ DW::Captcha->form_fields ] )
- if DW::Captcha->enabled( 'create' );
- %from_post = LJ::Widget->handle_post( \%POST, ( 'CreateAccount' ) );
+ my $post_args = DW::Request->get->post_args;
+ my $captcha = DW::Captcha->new( 'create' );
+ LJ::Widget->use_specific_form_fields( post => $post_args, widget => "CreateAccount", fields => [ $captcha->form_fields ] )
+ if $captcha->enabled( 'create' );
+ %from_post = LJ::Widget->handle_post( $post_args, ( 'CreateAccount' ) );
} else {
# we always need the code, because it might contain paid time
$code = LJ::trim( $GET{code} );
diff -r 40433367c052 -r 6888252ac285 htdocs/js/dw/dw-core.js
--- a/htdocs/js/dw/dw-core.js Wed Feb 15 06:01:15 2012 +0800
+++ b/htdocs/js/dw/dw-core.js Sat Feb 18 13:26:01 2012 +0800
@@ -54,6 +54,10 @@
image: function() { return $("<img>", { src: $.throbber.src } ) }
};
+$.endpoint = function(action){
+ return Site && Site.currentJournal ? "/" + Site.currentJournal + "/__rpc_" + action : "/__rpc_" + action;
+};
+
// position is an optional first argument
$.fn.throbber = function(position, jqxhr) {
var $this = $(this);
diff -r 40433367c052 -r 6888252ac285 htdocs/lostinfo.bml
--- a/htdocs/lostinfo.bml Wed Feb 15 06:01:15 2012 +0800
+++ b/htdocs/lostinfo.bml Sat Feb 18 13:26:01 2012 +0800
@@ -24,9 +24,7 @@
LJ::set_active_crumb('lostinfo');
- my %captcha_fields;
- @captcha_fields{DW::Captcha->form_fields} = @POST{DW::Captcha->form_fields};
- my $captcha = DW::Captcha->new( 'lostinfo', %captcha_fields );
+ my $captcha = DW::Captcha->new( 'lostinfo', %POST );
my $captcha_error;
@@ -38,7 +36,7 @@
if $captcha->enabled;
$ret .= "<form action='lostinfo' method='post'>\n";
-
+ $ret .= LJ::form_auth();
$ret .= $captcha->print;
$ret .= "<?h1 $ML{'.lostpassword.title'} h1?>\n";
@@ -81,6 +79,7 @@
}
# we have a post action
+ return LJ::bad_input( LJ::Lang::ml( "error.invalidform" ) ) unless LJ::check_form_auth();
# note: some lostinfo_do.bml translation strings are used below
# because the code was once in lostinfo_do.bml, but later
diff -r 40433367c052 -r 6888252ac285 htdocs/manage/settings/index.bml
--- a/htdocs/manage/settings/index.bml Wed Feb 15 06:01:15 2012 +0800
+++ b/htdocs/manage/settings/index.bml Sat Feb 18 13:26:01 2012 +0800
@@ -133,6 +133,7 @@
LJ::Setting::EnableComments
LJ::Setting::CommentScreening
LJ::Setting::CommentCaptcha
+ DW::Setting::Captcha
LJ::Setting::CommentIP
LJ::Setting::Display::BanUsers
DW::Setting::AllowVgiftsFrom
diff -r 40433367c052 -r 6888252ac285 htdocs/register.bml
--- a/htdocs/register.bml Wed Feb 15 06:01:15 2012 +0800
+++ b/htdocs/register.bml Sat Feb 18 13:26:01 2012 +0800
@@ -104,6 +104,7 @@
my $captcha = DW::Captcha->new( 'validate_openid', %POST );
if ( $captcha->response ) {
+ return LJ::bad_input( "error.invalidform" ) unless LJ::check_form_auth() && $captcha->enabled;
my $err_ref;
return LJ::bad_input( $err_ref )
unless $captcha->validate( err_ref => \$err_ref );
@@ -111,6 +112,7 @@
my $ret = "<?h1 $ML{'captcha.title'} h1?>";
$ret .= "<form method='POST' action='$LJ::SITEROOT/register'><input type='hidden' name='qs' value='$qs'>";
$ret .= $captcha->print;
+ $ret .= LJ::form_auth() if $captcha->enabled;
$ret .= "<input type='submit' value='$ML{'.form.submit'}' ></form>";
return $ret;
}
diff -r 40433367c052 -r 6888252ac285 htdocs/stc/textcaptcha.css
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/htdocs/stc/textcaptcha.css Sat Feb 18 13:26:01 2012 +0800
@@ -0,0 +1,6 @@
+body { font-family: sans-serif; padding: 0; margin: 0; }
+p { line-height: 1.5em; margin: 0; padding: 0;}
+textarea { height: 2.5em; width: 50%; display: block; }
+
+form, .textcaptcha {padding: 0 !important; margin: 0;}
+.
diff -r 40433367c052 -r 6888252ac285 htdocs/support/submit.bml
--- a/htdocs/support/submit.bml Wed Feb 15 06:01:15 2012 +0800
+++ b/htdocs/support/submit.bml Sat Feb 18 13:26:01 2012 +0800
@@ -20,9 +20,12 @@
use strict;
LJ::set_active_crumb('supportsubmit');
- LJ::Widget->use_specific_form_fields( post => \%POST, widget => "SubmitRequest_Support", fields => [ DW::Captcha->form_fields ] );
- return LJ::Widget->handle_post_and_render(\%POST, 'LJ::Widget::SubmitRequest::Support',
+ my $captcha = DW::Captcha->new();
+ LJ::Widget->use_specific_form_fields( post => \%POST, widget => "SubmitRequest_Support", fields => [ $captcha->form_fields ] );
+ my $ret = LJ::Widget->handle_post_and_render(\%POST, 'LJ::Widget::SubmitRequest::Support',
'category' => $GET{category}, 'post' => LJ::Widget::SubmitRequest::Support->post_fields(\%POST));
+ my @errors = LJ::Widget->error_list;
+ return @errors ? LJ::error_list( @errors ) . $ret : $ret;
}
_code?>
<=body
diff -r 40433367c052 -r 6888252ac285 t/captcha-textcaptcha.t
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/t/captcha-textcaptcha.t Sat Feb 18 13:26:01 2012 +0800
@@ -0,0 +1,129 @@
+# -*-perl-*-
+
+use strict;
+use Test::More tests => 21;
+use lib "$ENV{LJHOME}/cgi-bin";
+require 'ljlib.pl';
+
+use DW::Captcha;
+use XML::Simple;
+
+my $fakeanswers_single = {
+ question => 'The white bank is what colour?',
+ answer => 'd508fe45cecaf653904a0e774084bb5c',
+};
+
+my $fakeanswers_multiple = {
+ question => 'If I have twelve monkeys, how many monkeys do I have?',
+ answer => [ "c20ad4d76fe97759aa27a0c99bff6710", # 12
+ "15f6f8dc036519d7fe15b39338f6e5db", # twelve
+ ],
+};
+
+# convenience method to generate and handle answers for the captcha
+# to make multiple inputs to the test easier to understand
+sub _run_test {
+ local $Test::Builder::Level = $Test::Builder::Level + 2;
+
+ my ( $content, $auth, $answer, $testmsg, $fail ) = @_;
+
+ subtest "generating and testing captcha" => sub {
+ # generate new captcha auth for each, because we can't reuse captcha on this form
+ # note: we can reuse the form auth! might have a need to pull in alternate captcha for same form
+ my $captcha = DW::Captcha::textCAPTCHA::Logic::form_data( $content, $auth );
+ my $checked = DW::Captcha::textCAPTCHA::Logic::check_answer( $captcha->{answers}, $answer, $auth, $captcha->{chal} );
+
+ $fail ? ok( ! $checked, $testmsg ) : ok( $checked, $testmsg );
+ }
+}
+
+note( "single answer" );
+{
+ LJ::start_request();
+ my $content = XML::Simple::XMLout( $fakeanswers_single, NoAttr => 1 );
+ my $auth = LJ::form_auth( 1 );
+ my $captcha = DW::Captcha::textCAPTCHA::Logic::form_data( $content, $auth );
+
+ # we want the question to be the same
+ # but we know the answer will be different -- we don't know and don't care what it will be though
+ is( $captcha->{question}, $fakeanswers_single->{question}, "got back the question for use in a form" );
+ isnt( $captcha->{answers}->[0], $fakeanswers_single->{answer}, "got back an answer for use in a form (which does not look like what we put in)" );
+
+ isnt( $captcha->{chal}, $auth, "Form auth and captcha auth are not the same" );
+
+ my $test_captcha = sub {
+ my ( $answer, $msg, %opts ) = @_;
+ return _run_test( $content, $auth, $answer, $msg, $opts{fail} ? 1 : 0 );
+ };
+
+ # now validate user responses
+ $test_captcha->( "blue" , "completely incorrect", fail => 1 );
+ $test_captcha->( "white" , "correct" );
+ $test_captcha->( "WHITE" , "correct (caps)" );
+ $test_captcha->( "white ", "correct (whitespace)" );
+
+ LJ::start_request();
+ $captcha = DW::Captcha::textCAPTCHA::Logic::form_data( $content, $auth );
+ ok( ! DW::Captcha::textCAPTCHA::Logic::check_answer( $captcha->{answers}, "white", LJ::form_auth( 1 ), $captcha->{chal} ), "incorrect (auth; tried to submit captcha on a different form?)" );
+}
+
+note( "multiple valid answers" );
+{
+ LJ::start_request();
+ my $content = XML::Simple::XMLout( $fakeanswers_multiple, NoAttr => 1 );
+ my $auth = LJ::form_auth( 1 );
+ my $captcha = DW::Captcha::textCAPTCHA::Logic::form_data( $content, $auth );
+
+ my %original_answers = map { $_ => 1 } @{$fakeanswers_multiple->{answer}};
+ is( $captcha->{question}, $fakeanswers_multiple->{question}, "got back the question for use in a form" );
+
+ foreach ( @{ $captcha->{answers} } ) {
+ ok( !$original_answers{$_}, "one ofs multiple answers for use in a form (which does not look like what we put in)" );
+ }
+
+ my $test_captcha = sub {
+ my ( $answer, $msg, %opts ) = @_;
+ return _run_test( $content, $auth, $answer, $msg, $opts{fail} ? 1 : 0 );
+ };
+
+ # now validate user responses
+ $test_captcha->( "12" , "correct ('12' is one of the valid choices)" );
+ $test_captcha->( "twelve" , "correct ('twelve' is another of the valid choices)" );
+ $test_captcha->( "a dozen", "incorrect ('a dozen' is not one of the valid choices)", fail => 1 );
+};
+
+note( "no form auth passed in" );
+{
+ my $content = XML::Simple::XMLout( $fakeanswers_single, NoAttr => 1 );
+ my $captcha = DW::Captcha::textCAPTCHA::Logic::form_data( $content, "" );
+ my $captcha_auth = $captcha->{chal};
+
+ # we want the question to be the same
+ # but we know the answer will be different -- we don't know and don't care what it will be though
+ is( $captcha->{question}, $fakeanswers_single->{question}, "got back the question for use in a form" );
+ isnt( $captcha->{answers}->[0], $fakeanswers_single->{answer}, "got back an answer for use in a form (which does not look like what we put in)" );
+
+ # now validate user response
+ ok( ! DW::Captcha::textCAPTCHA::Logic::check_answer( $captcha->{answers}, "white", "", $captcha_auth ), "correct answer, but we have no auth" );
+};
+
+note( "tried to reuse captcha + form_auth" );
+{
+ LJ::start_request();
+ my $content = XML::Simple::XMLout( $fakeanswers_single, NoAttr => 1 );
+ my $auth = LJ::form_auth( 1 );
+ my $captcha = DW::Captcha::textCAPTCHA::Logic::form_data( $content, $auth );
+ my $captcha_auth = $captcha->{chal};
+
+ # we want the question to be the same
+ # but we know the answer will be different -- we don't know and don't care what it will be though
+ is( $captcha->{question}, $fakeanswers_single->{question}, "got back the question for use in a form" );
+ isnt( $captcha->{answers}->[0], $fakeanswers_single->{answer}, "got back an answer for use in a form (which does not look like what we put in)" );
+
+ # now validate user response
+ ok( DW::Captcha::textCAPTCHA::Logic::check_answer( $captcha->{answers}, "white", $auth, $captcha_auth ), "correct" );
+
+ # whoo captcha succeded! let's try to reuse it
+ LJ::start_request();
+ ok( ! DW::Captcha::textCAPTCHA::Logic::check_answer( $captcha->{answers}, "white", $auth, $captcha_auth ), "tried to reuse captcha results" );
+};
diff -r 40433367c052 -r 6888252ac285 t/captcha.t
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/t/captcha.t Sat Feb 18 13:26:01 2012 +0800
@@ -0,0 +1,68 @@
+# -*-perl-*-
+
+use strict;
+use Test::More tests => 14;
+use lib "$ENV{LJHOME}/cgi-bin";
+require 'ljlib.pl';
+
+# override for the sake of the test
+%LJ::CAPTCHA_FOR = (
+ testpage => 1,
+ nocaptchapage => 0,
+);
+
+note( "disabled captcha for a specific page" );
+{
+ my $captcha = DW::Captcha->new( "nocaptchapage" );
+ ok( ! $captcha->enabled, "Captcha is not enabled for nocaptchapage" );
+}
+
+note( "check captcha is enabled" );
+{
+ my $captcha = DW::Captcha->new( "testpage" );
+ ok( $captcha->enabled, "Captcha is enabled for testpage" );
+}
+
+note( "check various implementations are loaded okay" );
+{
+ my $default = $LJ::CAPTCHA_TYPES{$LJ::DEFAULT_CAPTCHA_TYPE};
+
+ ok( DW::Captcha->site_enabled, "Captcha is enabled site-wide" );
+ my $captcha = DW::Captcha->new( 'testpage' );
+ is( $captcha->name, $default, "Use default captcha implementation" );
+
+
+ $captcha = DW::Captcha->new( 'testpage', want => 'I' );
+ is( $captcha->name, "recaptcha", "Using reCAPTCHA" );
+
+ # can also be done using DW::Captcha::reCAPTCHA->site_enabled
+ # but technically we shouldn't be worrying about module names
+ ok( $captcha->site_enabled, "reCAPTCHA is enabled and configured on this site" );
+
+
+ $captcha = DW::Captcha->new( 'testpage', want => 'T' );
+ is( $captcha->name, "textcaptcha", "Using textCAPTCHA" );
+ ok( $captcha->site_enabled, "textCAPTCHA is enabled and configured on this site" );
+
+ $captcha = DW::Captcha->new( 'testpage', want => 'abc' );
+ is( $captcha->name, $default, "not a valid captcha implementation, so used default" );
+ ok( $captcha->site_enabled, "not a valid captcha implementation, so used default to make sure we still get captcha" );
+}
+
+note( "user tries to use a disabled captcha type" );
+{
+ local %LJ::DISABLED = ( captcha => sub {
+ my $module = $_[0];
+ return 0 if $module eq "recaptcha";
+ return 1 if $module eq "textcaptcha";
+ } );
+ local $LJ::DEFAULT_CAPTCHA_TYPE = "I";
+
+ my $captcha = DW::Captcha->new( "testpage", want => "I" ); # image
+ is( $captcha->name, "recaptcha", "want recaptcha, everything is fine" );
+ ok( $captcha->site_enabled, "recaptcha was enabled" );
+
+ my $captcha = DW::Captcha->new( "testpage", want => "T" ); # text
+ is( $captcha->name, "recaptcha", "wanted textcaptcha, but it's not enabled so use recaptcha instead" );
+ ok( $captcha->site_enabled, "recaptcha (our fallback) is enabled" );
+}
diff -r 40433367c052 -r 6888252ac285 views/textcaptcha-response.tt
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/views/textcaptcha-response.tt Sat Feb 18 13:26:01 2012 +0800
@@ -0,0 +1,21 @@
+[%# textcaptcha-response.tt
+
+Displays captcha-related info the user needs to paste into their main form
+
+Authors:
+ Afuna <coder.dw@afunamatata.com>
+
+This program is free software; you may redistribute it and/or modify it under
+the same terms as Perl itself. For a copy of the license, please reference
+'perldoc perlartistic' or 'perldoc perlgpl'.
+-%]
+
+[% dw.need_res( 'stc/textcaptcha.css' ) %]
+<div class="response">
+[%- label ='.response.iframe.label' | ml -%]
+[%- form.textarea( label = label
+ name = "captcha_response"
+ id = "captcha_response"
+ value = response
+) -%]
+</div>
diff -r 40433367c052 -r 6888252ac285 views/textcaptcha-response.tt.text
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/views/textcaptcha-response.tt.text Sat Feb 18 13:26:01 2012 +0800
@@ -0,0 +1,4 @@
+;; -*- coding: utf-8 -*-
+.response.iframe.label=Captcha Response (copy this)
+
+.response.user.label=Captcha Response (paste here)
diff -r 40433367c052 -r 6888252ac285 views/textcaptcha.tt
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/views/textcaptcha.tt Sat Feb 18 13:26:01 2012 +0800
@@ -0,0 +1,61 @@
+[%# textcaptcha.tt
+
+Displays an instance of textCAPTCHA, to be pulled into a page
+
+Authors:
+ Afuna <coder.dw@afunamatata.com>
+
+This program is free software; you may redistribute it and/or modify it under
+the same terms as Perl itself. For a copy of the license, please reference
+'perldoc perlartistic' or 'perldoc perlgpl'.
+-%]
+
+[%- IF handle_submit -%]
+ [% dw.need_res( 'stc/textcaptcha.css' ) %]
+
+ <form method='POST'>
+ [%- IF error -%]
+ <p>[% error %]</p>
+ [%- ELSE -%]
+ <p>[% '.nojs.instructions' | ml %]</p>
+ [%- END -%]
+[%- END -%]
+
+<div class='textcaptcha' style='padding: 0.5em 0'>
+[%- IF captcha.question -%]
+ [%- form.textbox( label = captcha.question
+ id = "textcaptcha_response"
+ name = "textcaptcha_response"
+
+ maxlength = "255"
+ size = "50"
+
+ autocomplete = "off"
+ ) -%]
+
+ [%- FOREACH answer = captcha.answers;
+ form.hidden(
+ name = "textcaptcha_challenge"
+ value = answer
+ );
+ END -%]
+
+ [%- form.hidden(
+ name = "textcaptcha_chalauth"
+ value = captcha.chal
+ ) -%]
+
+ [%- IF handle_submit -%]
+ [%- form.hidden(
+ name = "lj_form_auth"
+ value = form_auth
+ ) -%]
+ [%- form.submit() -%]
+ </form>
+ [%- END -%]
+
+[%- ELSE -%]
+[%- ".error.noquestion" | ml -%]
+[%- END -%]
+
+</div>
diff -r 40433367c052 -r 6888252ac285 views/textcaptcha.tt.text
--- /dev/null Thu Jan 01 00:00:00 1970 +0000
+++ b/views/textcaptcha.tt.text Sat Feb 18 13:26:01 2012 +0800
@@ -0,0 +1,5 @@
+;; -*- coding: utf-8 -*-
+
+.error.noquestion=Sorry, the anti-spam test is not available right now. Please wait and try again.
+
+.nojs.instructions=Copy the result to the "Captcha Response" field
--------------------------------------------------------------------------------
no subject
This is awesome!