Francois Gouget : testbot/web: Add a simple 'captcha' on the registration page.

[Alexandre Julliard]

Module: tools
Branch: master
Commit: a83696fd675954763053ea193f09977b6d452625
URL:    http://source.winehq.org/git/tools.git/?a=commit;h=a83696fd675954763053ea193f09977b6d452625

Author: Francois Gouget <fgouget at codeweavers.com>
Date:   Fri Jun 13 18:32:32 2014 +0200

testbot/web: Add a simple 'captcha' on the registration page.

The captcha is in the form of a simple configurable question where the
answer should be obvious to Wine developers.

---

 testbot/lib/WineTestBot/Config.pm              |    6 ++++--
 testbot/lib/WineTestBot/ConfigLocalTemplate.pl |    5 +++++
 testbot/web/Register.pl                        |   20 +++++++++++++++++---
 3 files changed, 26 insertions(+), 5 deletions(-)

diff --git a/testbot/lib/WineTestBot/Config.pm b/testbot/lib/WineTestBot/Config.pm
index fbf2b0b..db7f18d 100644
--- a/testbot/lib/WineTestBot/Config.pm
+++ b/testbot/lib/WineTestBot/Config.pm
@@ -33,7 +33,8 @@ use vars qw (@ISA @EXPORT @EXPORT_OK $UseSSL $LogDir $DataDir $BinDir
              $ProjectName $PatchesMailingList $LDAPServer
              $LDAPBindDN $LDAPSearchBase $LDAPSearchFilter
              $LDAPRealNameAttribute $LDAPEMailAttribute $AgentPort $Tunnel
-             $TunnelDefaults $JobPurgeDays $JobArchiveDays $WebHostName);
+             $TunnelDefaults $JobPurgeDays $JobArchiveDays $WebHostName
+             $RegistrationQ $RegistrationARE);
 
 require Exporter;
 @ISA = qw(Exporter);
@@ -45,7 +46,8 @@ require Exporter;
              $TagPrefix $ProjectName $PatchesMailingList
              $LDAPServer $LDAPBindDN $LDAPSearchBase $LDAPSearchFilter
              $LDAPRealNameAttribute $LDAPEMailAttribute $AgentPort $Tunnel
-             $TunnelDefaults $JobPurgeDays $JobArchiveDays $WebHostName);
+             $TunnelDefaults $JobPurgeDays $JobArchiveDays $WebHostName
+             $RegistrationQ $RegistrationARE);
 @EXPORT_OK = qw($DbDataSource $DbUsername $DbPassword);
 
 if ($::RootDir !~ m=^/=)
diff --git a/testbot/lib/WineTestBot/ConfigLocalTemplate.pl b/testbot/lib/WineTestBot/ConfigLocalTemplate.pl
index 260d79e..6d8128b 100644
--- a/testbot/lib/WineTestBot/ConfigLocalTemplate.pl
+++ b/testbot/lib/WineTestBot/ConfigLocalTemplate.pl
@@ -49,6 +49,11 @@ $WineTestBot::Config::WinePatchCc = "";
 # Host name of the web interface
 $WineTestBot::Config::WebHostName = undef;
 
+# The question to ask to filter out bots trying to register, and the regular
+# expression that the answer must match.
+$RegistrationQ = "What is the software project being tested?";
+$RegistrationARE = "(?i:wine)";
+
 # Prefix of the tag used for sending winetest reports
 $WineTestBot::Config::TagPrefix = undef;
 
diff --git a/testbot/web/Register.pl b/testbot/web/Register.pl
index 70d8868..eb0f1ec 100644
--- a/testbot/web/Register.pl
+++ b/testbot/web/Register.pl
@@ -35,11 +35,15 @@ sub _initialize($$$)
   my ($self, $Request, $RequiredRole) = @_;
 
   $self->SUPER::_initialize($Request, $RequiredRole, CreateUsers());
+  $self->{ExtraProperties} = [];
+  if ($RegistrationQ)
+  {
+    $self->GetParam("RegA", "") if (!defined $self->GetParam("RegA"));
+    push @{$self->{ExtraProperties}}, CreateBasicPropertyDescriptor("RegA", "Please demonstrate you are not a bot by answering this question: $RegistrationQ", !1, 1, "A", 40);
+  }
 
   $self->GetParam("Remarks", "") if (!defined $self->GetParam("Remarks"));
-  $self->{ExtraProperties} = [
-    CreateBasicPropertyDescriptor("Remarks", "Remarks", !1, !1, "textarea", 200)
-  ];
+  push @{$self->{ExtraProperties}}, CreateBasicPropertyDescriptor("Remarks", "Remarks", !1, !1, "textarea", 160);
 }
 
 sub GetTitle($)
@@ -110,6 +114,16 @@ sub OnSendRequest($)
 {
   my ($self) = @_;
 
+  if ($RegistrationQ)
+  {
+    my $RegA = $self->GetParam("RegA");
+    if ($RegA !~ /$RegistrationARE/)
+    {
+      $self->{ErrMessage} = "Wrong 'captcha' answer. Please try again.";
+      $self->{ErrField} = "Captcha";
+      return !1;
+    }
+  }
   if (! $self->Save())
   {
     return !1;