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

[Francois Gouget]

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

For bug 31798.
http://bugs.winehq.com/show_bug.cgi?id=31798

Sure a bot only needs to hardcode the answer to get past this 'captcha'. 
However any spammer should realize there's no point attempting to create 
an account on WineTestBot long before changing the spam bot code.

In order for this change to take effect it will be necessary to update 
the actual ConfigLocal.pm file to add the question/answer pair, and to 
restart the web server.

 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;
-- 
2.0.0