1/*  Part of SWI-Prolog
    2
    3    Author:        Jan Wielemaker
    4    E-mail:        J.Wielemaker@cs.vu.nl
    5    WWW:           http://www.swi-prolog.org
    6    Copyright (C): 2013, VU University Amsterdam
    7
    8    This program is free software; you can redistribute it and/or
    9    modify it under the terms of the GNU General Public License
   10    as published by the Free Software Foundation; either version 2
   11    of the License, or (at your option) any later version.
   12
   13    This program is distributed in the hope that it will be useful,
   14    but WITHOUT ANY WARRANTY; without even the implied warranty of
   15    MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
   16    GNU General Public License for more details.
   17
   18    You should have received a copy of the GNU General Public
   19    License along with this library; if not, write to the Free Software
   20    Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA  02111-1307  USA
   21
   22    As a special exception, if you link this library with other files,
   23    compiled with a Free Software compiler, to produce an executable, this
   24    library does not by itself cause the resulting executable to be covered
   25    by the GNU General Public License. This exception does not however
   26    invalidate any other reasons why the executable file might be covered by
   27    the GNU General Public License.
   28*/
   29
   30:- module(recaptcha,
   31	  [ recaptcha//1,		% +Options
   32	    recaptcha_parameters/1,	% -HTTP parameter list
   33	    recaptcha_verify/2		% +Request, +HTTPParamList
   34	  ]).   35:- use_module(library(http/html_head)).   36:- use_module(library(http/html_write)).   37:- use_module(library(http/http_open)).   38:- use_module(library(error)).   39:- use_module(library(option)).   40
   41:- html_resource(
   42       recaptcha,
   43       [ virtual(true),
   44	 requires([ 'http://www.google.com/recaptcha/api/js/recaptcha_ajax.js'
   45		  ])
   46       ]).

Add reCAPTCHA functionality to a form

This module is a plugin for the SWI-Prolog HTTP/HTML framework to add reCAPTCHA functionality to a form. It works as follows:

  1. Load library(http/recaptcha) and define the reCAPTCHA keys as described in key/2.
  2. Create a form, typically using method('POST') and include, in addition to the data you request from the human user, the reCAPTCHA widget using e.g., 
    \recaptcha([theme(red)])
  3. In the handler of the form, you must ask for the recaptcha parameters and pass them to recaptcha_verify/2. You can do that as follows: 
    process_recaptcha_form(Request) :-
       recaptcha_parameters(RecapthaParams),
       http_parameters(Recaptha,
                       [ name(Name, []),
                         age(Age, []),
                         ...
                       | RecapthaParams
                       ]),
       (   recaptcha_verify(Request, RecapthaParams)
       ->  <process normal user fields>
       ;   <you are not human>
       ).
See also
- examples/demo.pl contains a fully functional demo. */
   83:- multifile
   84	key/2.
 recaptcha(+Options)// is det
Display the reCAPTCHA widget. Defined options are:
theme(+Theme)
Set the theme. The default theme is clean.
See also
- https://developers.google.com/recaptcha/docs/customization describes the available themes
   96recaptcha(Options) -->
   97	{ (   key(public, PublicKey)
   98	  ->  true
   99	  ;   existence_error(recaptcha_key, public)
  100	  ),
  101	  option(theme(Theme), Options, clean)
  102	},
  103	html_requires(recaptcha),
  104	html(div(id(recaptcha), [])),
  105	create_captcha(recaptcha, PublicKey, Theme).
  106
  107
  108create_captcha(Id, PublicKey, Theme) -->
  109	html(script(type('text/javascript'),
  110		    \[ 'Recaptcha.create("',PublicKey,'",\n',
  111		       '                 "',Id,'",\n',
  112		       '                 {\n',
  113		       '		     theme:"',Theme,'"\n',
  114		       '                 });\n'
  115		     ])).
 recaptcha_parameters(-List) is det
List is a list of parameters for http_parameters/3 that is needed for recaptcha_verify/2.
  123recaptcha_parameters(
  124    [ recaptcha_challenge_field(_Challenge, [optional(true), default('')]),
  125      recaptcha_response_field(_Response, [optional(true), default('')])
  126    ]).
 recaptcha_verify(+Request, +Parameters) is semidet
Is true if the user solved the captcha correctly. Fails if the user did not solve the captcha correctly but there was no error processing the request.
Errors
- recaptcha_error(Error) is raised if there was an error processing the captcha.
- domain_error(recaptcha_response, '') if the user did not fill out the captcha.
See also
- https://developers.google.com/recaptcha/docs/verify lists the errors.
  142recaptcha_verify(Request, Parameters) :-
  143	memberchk(recaptcha_challenge_field(Challenge, _), Parameters),
  144	memberchk(recaptcha_response_field(Response, _), Parameters),
  145	(   Response == ''
  146	->  domain_error(recaptcha_response, Response)
  147	;   recaptcha_verify(Request, Challenge, Response)
  148	).
  149
  150recaptcha_verify(Request, Challenge, Response) :-
  151	remote_IP(Request, Peer),
  152	(   key(private, PrivateKey)
  153	->  true
  154	;   existence_error(recaptcha_key, private)
  155	),
  156	setup_call_cleanup(
  157	    http_open('http://www.google.com/recaptcha/api/verify',
  158		      In,
  159		      [ post(form([ privatekey(PrivateKey),
  160				    remoteip(Peer),
  161				    challenge(Challenge),
  162				    response(Response)
  163				  ]))
  164		      ]),
  165	    read_stream_to_lines(In, Lines),
  166	    close(In)),
  167	maplist(atom_codes, Atoms, Lines),
  168	(   Atoms = [true|_]
  169	->  true
  170	;   Atoms = [false, 'incorrect-captcha-sol'|_]
  171	->  fail
  172	;   Atoms = [false, Error, _],
  173	    throw(error(recaptcha_error(Error), _))
  174	).
  175
  176
  177read_stream_to_lines(In, Lines) :-
  178	read_line_to_codes(In, Line0),
  179	read_stream_to_lines(Line0, In, Lines).
  180
  181read_stream_to_lines(end_of_file, _, []) :- !.
  182read_stream_to_lines(Line, In, [Line|More]) :-
  183	read_line_to_codes(In, Line1),
  184	read_stream_to_lines(Line1, In, More).
  185
  186
  187remote_IP(Request, IP) :-
  188        memberchk(x_forwarded_for(IP0), Request), !,
  189	atomic_list_concat(Parts, ', ', IP0),
  190	last(Parts, IP).
  191remote_IP(Request, IP) :-
  192        memberchk(peer(Peer), Request), !,
  193        peer_to_ip(Peer, IP).
  194remote_IP(_, -).
  195
  196
  197peer_to_ip(ip(A,B,C,D), IP) :-
  198        atomic_list_concat([A,B,C,D], '.', IP).
 key(+Which, -Key) is det
This hook must unify Key to the reCAPTCHA public key if Which us public and to the reCAPTCHA private key if Which is private.

We leave the key handling to a hook to accomodate different ways for storing and transferring the keys. A simple implementation is:

:- use_module(library(http/recaptcha)).

:- multifile recaptcha:key/2.

recaptcha:key(public,  'Public key goes here').
recaptcha:key(private, 'Private key goes here').