recaptcha.pl 8.9 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203204205206207208209210211212213214215216217218219220221222223224225226227228229230231232233234235236237238239240241242243244245246247248249250251252253254255256257258259260261262263264265266267268269270271272273274275276277278279280281282283284285286287288289290291292293
  1. #!/usr/bin/env perl
  2. use strict;
  3. use v5.10;
  4. # ====================[ recapcha.pl ]====================
  5. =head1 NAME
  6. recaptcha - An Oddmuse module for adding footnotes to Oddmuse Wiki pages.
  7. =head1 INSTALLATION
  8. recaptcha is simply installable; simply:
  9. =over
  10. =item Move this file into the B<wiki/modules/> directory for your Oddmuse Wiki.
  11. =item Register at https://admin.recaptcha.net/recaptcha/createsite/ for a
  12. site-specific, public/private key pair to the reCAPTCHA service.
  13. =item Set the C<$ReCaptchaPublicKey> and C<$ReCaptchaPrivateKey> configuration
  14. variables in your site's configuration file (B<wiki/config.pl>) to
  15. whatever public and private key strings that registration allotted to you.
  16. See L<Configuration>, below.
  17. =back
  18. =cut
  19. AddModuleDescription('recaptcha.pl', 'ReCaptcha Extension');
  20. # ....................{ CONFIGURATION }....................
  21. =head1 CONFIGURATION
  22. recaptcha is easily configurable; set these variables in the B<wiki/config.pl>
  23. file for your Oddmuse Wiki.
  24. =cut
  25. our ($q, %AdminPages, $LinkPattern, $FreeLinks, $FreeLinkPattern, $WikiLinks, @MyInitVariables, %CookieParameters, @MyFormChanges);
  26. our ($ReCaptchaPrivateKey,
  27. $ReCaptchaPublicKey,
  28. $ReCaptchaTheme,
  29. $ReCaptchaTabIndex,
  30. $ReCaptchaRememberAnswer,
  31. $ReCaptchaSecretKey,
  32. $ReCaptchaRequiredList,
  33. %ReCaptchaProtectedForms);
  34. =head2 $ReCaptchaPublicKey
  35. You must set this to the public key that the reCAPTCHA service allots to you on
  36. registering for that service.
  37. =cut
  38. $ReCaptchaPublicKey = 'XXX';
  39. =head2 $ReCaptchaPrivateKey
  40. You must set this to the private key that the reCAPTCHA service allots to you on
  41. registering for that service.
  42. =cut
  43. $ReCaptchaPrivateKey = 'YYY';
  44. =head2 $ReCaptchaTheme
  45. A string identifying which of the following CSS themes to skin the embedded
  46. reCAPTCHA with:
  47. string value | notes
  48. ---------------+------
  49. 'red' | The default.
  50. 'white' |
  51. 'blackglass' |
  52. 'clean' | This is our recommended theme; see below.
  53. 'custom' | This is not recommended; see below.
  54. You are recommended to use the 'clean' theme, as that tends to integrate more
  55. aesthetically cleanly than the others. This requires some CSS styling on your
  56. part, however, and is, therefore, not the default. For details, see:
  57. http://wiki.recaptcha.net/index.php/How_to_change_reCAPTCHA_colors
  58. You are recommended not to use the 'custom' theme, as this extension does not
  59. adequately support that theme, yet. For details, see:
  60. http://recaptcha.net/apidocs/captcha/client.html#Custom%20theming
  61. =cut
  62. $ReCaptchaTheme = undef;
  63. =head2 $ReCaptchaTabIndex
  64. An unsigned integer indicating the HTML form "tab index" of the embedded
  65. reCAPTCHA. (The default should be fine, theoretically.)
  66. =cut
  67. $ReCaptchaTabIndex = undef;
  68. =head2 $ReCaptchaRequiredList
  69. The page name for exceptions, if defined. Every page linked to via WikiWord
  70. or [[free link]] is considered to be a page which needs questions asked. All
  71. other pages do not require questions asked. If not set, then all pages need
  72. questions asked.
  73. =cut
  74. $ReCaptchaRequiredList = '';
  75. =head2 $ReCaptchaRememberAnswer
  76. If a user successfully answers the reCAPTCHA correctly, remember this in the
  77. cookie and don't ask again.
  78. =cut
  79. $ReCaptchaRememberAnswer = 1;
  80. =head2 $ReCaptchaSecretKey
  81. The name of the reCAPTCHA parameter in the Oddmuse cookie. If some spam bot,
  82. robot spider, or other malware program begins targetting this module, simply
  83. change the name. This offers a "first line of defense." (Changing the value of
  84. this secret key forces users to successfully answer a new reCAPTCHA.)
  85. =cut
  86. $ReCaptchaSecretKey = 'question';
  87. # Forms using one of the following classes are protected.
  88. %ReCaptchaProtectedForms = (
  89. 'comment' => 1,
  90. 'edit upload' => 1,
  91. 'edit text' => 1
  92. );
  93. # ....................{ INITIALIZATION }....................
  94. push(@MyInitVariables, \&ReCaptchaInit);
  95. sub ReCaptchaInit {
  96. $ReCaptchaRequiredList = FreeToNormal($ReCaptchaRequiredList);
  97. $AdminPages{$ReCaptchaRequiredList} = 1;
  98. $CookieParameters{$ReCaptchaSecretKey} = '';
  99. }
  100. # ....................{ EDITING }....................
  101. push(@MyFormChanges, \&ReCaptchaQuestionAddTo);
  102. sub ReCaptchaQuestionAddTo {
  103. my ($form, $type, $upload) = @_;
  104. if (not $upload
  105. and not ReCaptchaException(GetId())
  106. and not $ReCaptchaRememberAnswer && GetParam($ReCaptchaSecretKey, 0)
  107. and not UserIsEditor()) {
  108. $form =~
  109. s/(\Q<p><input type="submit" name="Save"\E)/ReCaptchaGetQuestion().$1/e;
  110. }
  111. return $form;
  112. }
  113. sub ReCaptchaGetQuestion {
  114. my $need_button = shift;
  115. # Unfortunately, "Captcha::reCAPTCHA" produces invalid HTML for the reCAPTCHA theme.
  116. # We must brute-force the proper HTML, instead.
  117. # my %recaptcha_options = ();
  118. # if (defined $ReCaptchaTheme) { $recaptcha_options{theme} = $ReCaptchaTheme; }
  119. # if (defined $ReCaptchaTabIndex) { $recaptcha_options{tabindex} = $ReCaptchaTabIndex; }
  120. eval "use Captcha::reCAPTCHA";
  121. my $captcha_html = Captcha::reCAPTCHA->new()->get_html(
  122. $ReCaptchaPublicKey, undef, $ENV{'HTTPS'} eq 'on', undef);
  123. my $submit_html = $need_button ? $q->submit(-value=> T('Go!')) : '';
  124. my $options_html = '
  125. <script type="text/javascript">
  126. var RecaptchaOptions = {
  127. ';
  128. if (defined $ReCaptchaTheme) { $options_html .= " theme : '$ReCaptchaTheme'\n"; }
  129. if (defined $ReCaptchaTabIndex) { $options_html .= " tabindex : $ReCaptchaTabIndex\n"; }
  130. $options_html .= ' };
  131. </script>';
  132. return $options_html.ReCaptchaGetQuestionHtml($captcha_html.$submit_html);
  133. }
  134. =head2 ReCaptchaGetQuestionHtml
  135. Enclose the reCAPTCHA iframe in Oddmuse-specific HTML and CSS.
  136. Wiki administrators are encouraged to replace this function with their own,
  137. Wiki-specific function by redefining this function in B<config.pl>.
  138. =cut
  139. sub ReCaptchaGetQuestionHtml {
  140. my $question_html = shift;
  141. return $q->div({-class=> 'question'}, $ReCaptchaTheme eq 'clean'
  142. ? $q->p(T('Please type the following two words:')).$question_html
  143. : $q->p(T('Please answer this captcha:' )).$question_html);
  144. }
  145. # ....................{ POSTING }....................
  146. *OldReCaptchaDoPost = \&DoPost;
  147. *DoPost = \&NewReCaptchaDoPost;
  148. sub NewReCaptchaDoPost {
  149. my(@params) = @_;
  150. my $id = FreeToNormal(GetParam('title', undef));
  151. my $preview = GetParam('Preview', undef); # case matters!
  152. my $correct = 0;
  153. unless (UserIsEditor() or UserIsAdmin()
  154. or $ReCaptchaRememberAnswer && GetParam($ReCaptchaSecretKey, 0)
  155. or $preview
  156. or $correct = ReCaptchaCheckAnswer() # remember this!
  157. or ReCaptchaException($id)) {
  158. print GetHeader('', T('Edit Denied'), undef, undef, '403 FORBIDDEN');
  159. print $q->start_div({-class=>'error'});
  160. print $q->p(T('You did not answer correctly.'));
  161. print GetFormStart(), ReCaptchaGetQuestion(1),
  162. (map { $q->input({-type=>'hidden', -name=>$_,
  163. -value=>UnquoteHtml(GetParam($_))}) }
  164. qw(title text oldtime summary recent_edit aftertext)), $q->end_form;
  165. print $q->end_div();
  166. PrintFooter();
  167. # logging to the error log file of the server
  168. # warn "Q: '$ReCaptchaQuestions[$question_num][0]', A: '$answer'\n";
  169. return;
  170. }
  171. if (not GetParam($ReCaptchaSecretKey, 0) and $correct) {
  172. SetParam($ReCaptchaSecretKey, 1);
  173. }
  174. return (OldReCaptchaDoPost(@params));
  175. }
  176. sub ReCaptchaCheckAnswer {
  177. eval "use Captcha::reCAPTCHA";
  178. my $result = Captcha::reCAPTCHA->new()->check_answer(
  179. $ReCaptchaPrivateKey,
  180. $q->remote_addr(),
  181. GetParam('recaptcha_challenge_field'),
  182. GetParam('recaptcha_response_field')
  183. );
  184. return $result->{is_valid};
  185. }
  186. # ....................{ ERROR-HANDLING }....................
  187. sub ReCaptchaException {
  188. my $id = shift;
  189. return 0 unless $ReCaptchaRequiredList and $id;
  190. my $data = GetPageContent($ReCaptchaRequiredList);
  191. if ($WikiLinks) {
  192. while ($data =~ /$LinkPattern/g) {
  193. return 0 if FreeToNormal($1) eq $id;
  194. }
  195. }
  196. if ($FreeLinks) {
  197. while ($data =~ /\[\[$FreeLinkPattern\]\]/g) {
  198. return 0 if FreeToNormal($1) eq $id;
  199. }
  200. }
  201. return 1;
  202. }
  203. =head1 COPYRIGHT AND LICENSE
  204. =encoding utf8
  205. The information below applies to everything in this distribution,
  206. except where noted.
  207. Copyleft 2008 by B.w.Curry <http://www.raiazome.com>.
  208. Copyright 2004–2008 by Brock Wilcox <awwaiid@thelackthereof.org>.
  209. Copyright 2006–2015 by Alex Schroeder <alex@gnu.org>.
  210. This program is free software; you can redistribute it and/or modify
  211. it under the terms of the GNU General Public License as published by
  212. the Free Software Foundation; either version 3 of the License, or
  213. (at your option) any later version.
  214. This program is distributed in the hope that it will be useful,
  215. but WITHOUT ANY WARRANTY; without even the implied warranty of
  216. MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
  217. GNU General Public License for more details.
  218. You should have received a copy of the GNU General Public License
  219. along with this program. If not, see L<http://www.gnu.org/licenses/>.
  220. =cut