[LON-CAPA-cvs] cvs: doc /loncapafiles loncapafiles.lpml loncom/html/res/adm/pages refresh.gif loncom/interface createaccount.pm domainprefs.pm loncommon.pm

raeburn raeburn at source.lon-capa.org
Sat Aug 25 00:35:54 EDT 2012


raeburn		Sat Aug 25 04:35:54 2012 EDT

  Added files:                 
    /loncom/html/res/adm/pages	refresh.gif 

  Modified files:              
    /loncom/interface	domainprefs.pm createaccount.pm loncommon.pm 
    /doc/loncapafiles	loncapafiles.lpml 
  Log:
  - Validation of human (CAPTCHA).
    - self creation of account (e-mail address as username).
    - choice of CAPTCHA:  original (Authen::CAPTCHA) or newer reCAPTCHA (requires)
      DC to create account with http://www.google.com/recaptcha/, or not used.
    - Routines to generate CAPTCHA input and validate response moved to loncommon.pm
      to facilitate re-use.
    - Domain configuration for self-creation of accounts allows DC to choose which
      CAPTCHA option to use.
  - CPAN module: Captcha::reCAPTCHA now needed. rpm being added to msu/testing repos,
    and dependency included in LONCAPA-prerequisites 1-21.   
  
  
-------------- next part --------------
Index: loncom/interface/domainprefs.pm
diff -u loncom/interface/domainprefs.pm:1.164 loncom/interface/domainprefs.pm:1.165
--- loncom/interface/domainprefs.pm:1.164	Tue Aug 21 21:12:08 2012
+++ loncom/interface/domainprefs.pm	Sat Aug 25 04:34:44 2012
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Handler to set domain-wide configuration settings
 #
-# $Id: domainprefs.pm,v 1.164 2012/08/21 21:12:08 raeburn Exp $
+# $Id: domainprefs.pm,v 1.165 2012/08/25 04:34:44 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -410,7 +410,7 @@
     if ($phase eq 'process') {
         &Apache::lonconfigsettings::make_changes($r,$dom,$phase,$context,\@prefs_order,\%prefs,\%domconfig,$confname,\@roles);
     } elsif ($phase eq 'display') {
-        my $js;
+        my $js = &recaptcha_js();
         if (keys(%servers) > 1) {
             my ($othertitle,$usertypes,$types) =
                 &Apache::loncommon::sorted_inst_types($dom);
@@ -2350,9 +2350,7 @@
         $datatable .= '</span></td></tr>';
         
      }
-     
      return $datatable;
-	
 }
 
 
@@ -3266,18 +3264,19 @@
         }
         my ($othertitle,$usertypes,$types) =
             &Apache::loncommon::sorted_inst_types($dom);
+        my $createsettings;
+        if (ref($settings) eq 'HASH') {
+            $createsettings = $settings->{cancreate};
+        }
         if (ref($usertypes) eq 'HASH') {
             if (keys(%{$usertypes}) > 0) {
-                my $createsettings;
-                if (ref($settings) eq 'HASH') {
-                    $createsettings = $settings->{cancreate};
-                }
                 $datatable .= &insttypes_row($createsettings,$types,$usertypes,
                                              $dom,$numinrow,$othertitle,
                                              'statustocreate');
                 $$rowtotal ++;
             }
         }
+        $datatable .= &captcha_choice('cancreate',$createsettings);
     } else {
         my @contexts = ('author','course','domain');
         my @authtypes = ('int','krb4','krb5','loc');
@@ -3329,6 +3328,63 @@
     return $datatable;
 }
 
+sub captcha_choice {
+    my ($context,$settings) = @_;
+    my ($keyentry,$currpub,$currpriv,%checked,$rowname,$pubtext,$privtext);
+    my %lt = &captcha_phrases();
+    $keyentry = 'hidden';
+    if ($context eq 'cancreate') {
+        $rowname = &mt('CAPTCHA validation (e-mail as username)');
+    } elsif ($context eq 'help') {
+        $rowname =  &mt('CAPTCHA validation');
+    }
+    if (ref($settings) eq 'HASH') {
+        if ($settings->{'captcha'}) {
+            $checked{$settings->{'captcha'}} = ' checked="checked"';
+        } else {
+            $checked{'original'} = ' checked="checked"';
+        }
+        if ($settings->{'captcha'} eq 'recaptcha') {
+            $pubtext = $lt{'pub'};
+            $privtext = $lt{'priv'};
+            $keyentry = 'text';
+        }
+        if (ref($settings->{'recaptchakeys'}) eq 'HASH') {
+            $currpub = $settings->{'recaptchakeys'}{'public'};
+            $currpriv = $settings->{'recaptchakeys'}{'private'};
+        }
+    } else {
+        $checked{'original'} = ' checked="checked"';
+    }
+    my $output = '<tr class="LC_odd_row">'.
+                 '<td class="LC_left_item">'.$rowname.'</td><td class="LC_right_item" colspan="2">'."\n".
+                 '<table><tr><td>'."\n";
+    foreach my $option ('original','recaptcha','notused') {
+        $output .= '<span class="LC_nobreak"><label><input type="radio" name="'.$context.'_captcha" value="'.
+                   $option.'" '.$checked{$option}.' onchange="javascript:updateCaptcha('."this,'$context'".');" />'.
+                   $lt{$option}.'</label></span>';
+        unless ($option eq 'notused') {
+            $output .= (' 'x2)."\n";
+        }
+    }
+#
+# Note: If reCAPTCHA is to be used for LON-CAPA servers in a domain, a domain coordinator should visit:
+# https://www.google.com/recaptcha and generate a Public and Private key. For domains with multiple
+# servers a single key pair will be used for all servers, so the internet domain (e.g., yourcollege.edu) 
+# specified for use with the key should be broad enough to accommodate all servers in the LON-CAPA domain.
+#  
+    $output .= '</td></tr>'."\n".
+               '<tr><td>'."\n".
+               '<span class="LC_nobreak"><span id="'.$context.'_recaptchapubtxt">'.$pubtext.'</span> '."\n".
+               '<input type="'.$keyentry.'" id="'.$context.'_recaptchapub" name="'.$context.'_recaptchapub" value="'.
+               $currpub.'" size="40" /></span><br />'."\n".
+               '<span class="LC_nobreak"><span id="'.$context.'_recaptchaprivtxt">'.$privtext.'</span> '."\n".
+               '<input type="'.$keyentry.'" id="'.$context.'_recaptchapriv" name="'.$context.'_recaptchapriv" value="'.
+               $currpriv.'" size="40" /></span></td></tr></table>'."\n".
+               '</td></tr>';
+    return $output;
+}
+
 sub user_formats_row {
     my ($type,$settings,$rules,$ruleorder,$numinrow,$rowcount) = @_;
     my $output;
@@ -4293,9 +4349,13 @@
     if ($context eq 'cansearch') {
         $showdom = ' ('.$dom.')';
     }
+    my $class = 'LC_left_item';
+    if ($context eq 'statustocreate') {
+        $class = 'LC_right_item';
+    }
     my $output =  '<tr class="LC_odd_row">'.
                   '<td>'.$lt{$context}.$showdom.
-                  '</td><td class="LC_left_item" colspan="2"><table>';
+                  '</td><td class="'.$class.'" colspan="2"><table>';
     my $rem;
     if (ref($types) eq 'ARRAY') {
         for (my $i=0; $i<@{$types}; $i++) {
@@ -6317,6 +6377,7 @@
         }
         push(@contexts,'statustocreate');
     }
+    &process_captcha('cancreate',\%changes,\%cancreate,\%curr_usercreation);
     if (ref($curr_usercreation{'cancreate'}) eq 'HASH') {
         foreach my $item (@contexts) {
             if (($item eq 'selfcreate') || ($item eq 'statustocreate')) {
@@ -6499,7 +6560,7 @@
                 my %lt = &usercreation_types();
                 foreach my $type (@{$changes{'cancreate'}}) {
                     my $chgtext;
-                    unless ($type eq 'statustocreate') {
+                    unless (($type eq 'statustocreate') || ($type eq 'captcha') || ($type eq 'recaptchakeys')) {
                         $chgtext = $lt{$type}.', ';
                     }
                     if ($type eq 'selfcreate') {
@@ -6558,6 +6619,35 @@
                                 }
                             }
                         }
+                    } elsif ($type eq 'captcha') {
+                        if ($cancreate{$type} eq 'notused') {
+                            $chgtext .= &mt('No CAPTCHA validation in use for self-creation screen.');
+                        } else {
+                            my %captchas = &captcha_phrases();
+                            if ($captchas{$cancreate{$type}}) {
+                                $chgtext .= &mt("Validation for self-creation screen set to $captchas{$cancreate{$type}}.");
+                            } else {
+                                $chgtext .= &mt('Validation for self-creation screen set to unknown type.'); 
+                            }
+                        }
+                    } elsif ($type eq 'recaptchakeys') {
+                        my ($privkey,$pubkey);
+                        if (ref($cancreate{$type}) eq 'HASH') {
+                            $pubkey = $cancreate{$type}{'public'};
+                            $privkey = $cancreate{$type}{'private'};
+                        }
+                        $chgtext .= &mt('ReCAPTCHA keys changes').'<ul>';
+                        if (!$pubkey) {
+                            $chgtext .= '<li>'.&mt('Public key deleted').'</li>';
+                        } else {
+                            $chgtext .= '<li>'.&mt('Public key set to [_1]',$pubkey).'</li>';
+                        }
+                        if (!$privkey) {
+                            $chgtext .= '<li>'.&mt('Private key deleted').'</li>';
+                        } else {
+                            $chgtext .= '<li>'.&mt('Private key set to [_1]',$pubkey).'</li>';
+                        }
+                        $chgtext .= '</ul>';
                     } else {
                         if ($cancreate{$type} eq 'none') {
                             $chgtext .= &mt('creation of new users is not permitted, except by a Domain Coordinator.');
@@ -6657,6 +6747,43 @@
     return $resulttext;
 }
 
+sub process_captcha {
+    my ($container,$changes,$newsettings,$current) = @_;
+    return unless ((ref($changes) eq 'HASH') && (ref($newsettings) eq 'HASH') || (ref($current) eq 'HASH'));
+    $newsettings->{'captcha'} = $env{'form.'.$container.'_captcha'};
+    unless ($newsettings->{'captcha'} eq 'recaptcha' || $newsettings->{'captcha'} eq 'notused') {
+        $newsettings->{'captcha'} = 'original';
+    }
+    if ($current->{'captcha'} ne $newsettings->{'captcha'}) {
+        if (ref($changes->{'cancreate'}) eq 'ARRAY') {
+            push(@{$changes->{'cancreate'}},'captcha');
+        } elsif (!defined($changes->{'cancreate'})) {
+            $changes->{'cancreate'} = ['captcha'];
+        }
+    }
+    my ($newpub,$newpriv,$currpub,$currpriv);
+    if ($newsettings->{'captcha'} eq 'recaptcha') {
+        $newpub = $env{'form.'.$container.'_recaptchapub'};
+        $newpriv = $env{'form.'.$container.'_recaptchapriv'};
+    }
+    $newsettings->{'recaptchakeys'} = {
+                                         public  => $newpub,
+                                         private => $newpriv,
+                                      };
+    if (ref($current->{'recaptchakeys'}) eq 'HASH') {
+        $currpub = $current->{'recaptchakeys'}{'public'};
+        $currpriv = $current->{'recaptchakeys'}{'private'};
+    }
+    if (($newpub ne $currpub) || ($newpriv ne $currpriv)) {
+        if (ref($changes->{'cancreate'}) eq 'ARRAY') {
+            push(@{$changes->{'cancreate'}},'recaptchakeys');
+        } elsif (!defined($changes->{'cancreate'})) {
+            $changes->{'cancreate'} = ['recaptchakeys'];
+        }
+    }
+    return;
+}
+
 sub modify_usermodification {
     my ($dom,%domconfig) = @_;
     my ($resulttext,%curr_usermodification,%changes);
@@ -8422,4 +8549,71 @@
 
 }
 
+sub recaptcha_js {
+    my %lt = &captcha_phrases();
+    return <<"END";
+
+<script type="text/javascript">
+// <![CDATA[
+
+function updateCaptcha(caller,context) {
+    var privitem;
+    var pubitem;
+    var privtext;
+    var pubtext;
+    if (document.getElementById(context+'_recaptchapub')) {
+        pubitem = document.getElementById(context+'_recaptchapub');
+    } else {
+        return;
+    }
+    if (document.getElementById(context+'_recaptchapriv')) {
+        privitem = document.getElementById(context+'_recaptchapriv');
+    } else {
+        return;
+    }
+    if (document.getElementById(context+'_recaptchapubtxt')) {
+        pubtext = document.getElementById(context+'_recaptchapubtxt');
+    } else {
+        return;
+    }
+    if (document.getElementById(context+'_recaptchaprivtxt')) {
+        privtext = document.getElementById(context+'_recaptchaprivtxt');
+    } else {
+        return;
+    }
+    if (caller.checked) {
+        if (caller.value == 'recaptcha') {
+            pubitem.type = 'text';
+            privitem.type = 'text';
+            pubitem.size = '40';
+            privitem.size = '40';
+            pubtext.innerHTML = "$lt{'pub'}";
+            privtext.innerHTML = "$lt{'priv'}";
+        } else {
+            pubitem.type = 'hidden';
+            privitem.type = 'hidden';
+            pubtext.innerHTML = '';
+            privtext.innerHTML = '';
+        }
+    }
+    return;
+}
+
+// ]]>
+</script>
+
+END
+
+}
+
+sub captcha_phrases {
+    return &Apache::lonlocal::texthash (
+                 priv => 'Private key',
+                 pub  => 'Public key',
+                 original  => 'original (CAPTCHA)',
+                 recaptcha => 'successor (ReCAPTCHA)',
+                 notused   => 'unused',
+    );
+}
+
 1;
Index: loncom/interface/createaccount.pm
diff -u loncom/interface/createaccount.pm:1.51 loncom/interface/createaccount.pm:1.52
--- loncom/interface/createaccount.pm:1.51	Fri May 18 04:31:05 2012
+++ loncom/interface/createaccount.pm	Sat Aug 25 04:34:44 2012
@@ -3,7 +3,7 @@
 # institutional log-in ID (institutional authentication required - localauth
 #  or kerberos) or an e-mail address.
 #
-# $Id: createaccount.pm,v 1.51 2012/05/18 04:31:05 raeburn Exp $
+# $Id: createaccount.pm,v 1.52 2012/08/25 04:34:44 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -382,8 +382,14 @@
         }
         if (grep(/^email$/,@{$cancreate})) {
             $output .= '<div class="LC_left_float"><h3>'.&mt('Create account with an e-mail address as your username').'</h3>';
-            my $captchaform = &create_captcha();
-            if ($captchaform) {
+            my ($captchaform,$error) = &Apache::loncommon::captcha_display('usercreation',$lonhost);
+            if ($error) {
+                my $helpdesk = '/adm/helpdesk?origurl=%2fadm%2fcreateaccount';
+                if ($courseid ne '') {
+                    $helpdesk .= '&courseid='.$courseid;
+                }
+                $output .= '<span class="LC_error">'.&mt('An error occurred generating the validation code[_1] required for an e-mail address to be used as username.','<br />').'</span><br /><br />'.&mt('[_1]Contact the helpdesk[_2] or [_3]reload[_2] the page and try again.','<a href="'.$helpdesk.'">','</a>','<a href="javascript:window.location.reload()">');
+            } else {
                 my $submit_text = &mt('Request LON-CAPA account');
                 my $emailform = '<input type="text" name="useremail" size="25" value="" />';
                 if (grep(/^login$/,@{$cancreate})) {
@@ -394,12 +400,14 @@
                 $output .=  '<form name="createaccount" method="post" onsubmit="return validate_email()" action="/adm/createaccount">'.
                             &Apache::lonhtmlcommon::start_pick_box()."\n".
                             &Apache::lonhtmlcommon::row_title(&mt('E-mail address'),
-                                                             'LC_pick_box_title')."\n".
-                            $emailform."\n".
-                            &Apache::lonhtmlcommon::row_closure(1).
-                            &Apache::lonhtmlcommon::row_title(&mt('Validation'),
-                                                             'LC_pick_box_title')."\n".
-                            $captchaform."\n".'<br /><br />';
+                                                              'LC_pick_box_title')."\n".
+                            $emailform."\n";
+                if ($captchaform) {
+                    $output .= &Apache::lonhtmlcommon::row_closure(1).
+                               &Apache::lonhtmlcommon::row_title(&mt('Validation'),
+                                                                 'LC_pick_box_title')."\n".
+                               $captchaform."\n".'<br /><br />';
+                }
                 if ($courseid ne '') {
                     $output .= '<input type="hidden" name="courseid" value="'.$courseid.'"/>'."\n"; 
                 }
@@ -413,12 +421,6 @@
                     $output .= &Apache::lonhtmlcommon::echo_form_input(['courseid']);
                 }
                 $output .= '</form>';
-            } else {
-                my $helpdesk = '/adm/helpdesk?origurl=%2fadm%2fcreateaccount';
-                if ($courseid ne '') {
-                    $helpdesk .= '&courseid='.$courseid;
-                }
-                $output .= '<span class="LC_error">'.&mt('An error occurred generating the validation code[_1] required for an e-mail address to be used as username.','<br />').'</span><br /><br />'.&mt('[_1]Contact the helpdesk[_2] or [_3]reload[_2] the page and try again.','<a href="'.$helpdesk.'">','</a>','<a href="javascript:window.location.reload()">');
             }
             $output .= '</div>';
         }
@@ -503,23 +505,10 @@
                                          $contact_name,$contact_email);
                 return $output;
             } else {
-                my $code = $env{'form.code'};
-                my $md5sum = $env{'form.crypt'};
-                my %captcha_params = &captcha_settings();
-                my $captcha = Authen::Captcha->new(
-                                  output_folder => $captcha_params{'output_dir'},
-                                  data_folder   => $captcha_params{'db_dir'},
-                                 );
-                my $captcha_chk = $captcha->check_code($code,$md5sum);
-                my %captcha_hash = (
-                                  0       => 'Code not checked (file error)',
-                                  -1      => 'Failed: code expired',
-                                  -2      => 'Failed: invalid code (not in database)',
-                                  -3      => 'Failed: invalid code (code does not match crypt)',
-                                   );
+                my ($captcha_chk,$captcha_error) = &Apache::loncommon::captcha_response('usercreation',$server);
                 if ($captcha_chk != 1) {
                     $output = &invalid_state('captcha',$domdesc,$contact_name,
-                                             $contact_email,$captcha_hash{$captcha_chk});
+                                             $contact_email,$captcha_error);
                     return $output;
                 }
                 my $uhome=&Apache::lonnet::homeserver($useremail,$domain);
@@ -1185,39 +1174,6 @@
     return $msg;
 }
 
-sub create_captcha {
-    my ($output_dir,$db_dir) = @_;
-    my %captcha_params = &captcha_settings();
-    my ($output,$maxtries,$tries) = ('',10,0);
-    while ($tries < $maxtries) {
-        $tries ++;
-        my $captcha = Authen::Captcha->new (
-                                           output_folder => $captcha_params{'output_dir'},
-                                           data_folder   => $captcha_params{'db_dir'},
-                                          );
-        my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
-
-        if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
-            $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
-                      &mt('Type in the letters/numbers shown below').' '.
-                     '<input type="text" size="5" name="code" value="" /><br />'.
-                     '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" />';
-            last;
-        }
-    }
-    return $output;
-}
-
-sub captcha_settings {
-    my %captcha_params = ( 
-                           output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
-                           www_output_dir => "/captchaspool",
-                           db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
-                           numchars       => '5',
-                         );
-    return %captcha_params;
-}
-
 sub getkeys {
     my ($lkey,$ukey) = @_;
     my $lextkey=hex($lkey);
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.1093 loncom/interface/loncommon.pm:1.1094
--- loncom/interface/loncommon.pm:1.1093	Tue Aug 21 01:50:33 2012
+++ loncom/interface/loncommon.pm	Sat Aug 25 04:34:44 2012
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # a pile of common routines
 #
-# $Id: loncommon.pm,v 1.1093 2012/08/21 01:50:33 raeburn Exp $
+# $Id: loncommon.pm,v 1.1094 2012/08/25 04:34:44 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -71,6 +71,8 @@
 use DateTime::TimeZone;
 use DateTime::Locale::Catalog;
 use Text::Aspell;
+use Authen::Captcha;
+use Captcha::reCAPTCHA;
 
 # ---------------------------------------------- Designs
 use vars qw(%defaultdesign);
@@ -14064,6 +14066,148 @@
     return $title;
 }
 
+sub captcha_display {
+    my ($context,$lonhost) = @_;
+    my ($output,$error);
+    my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
+    if ($captcha eq 'captcha') {
+        $output = &create_captcha();
+        unless ($output) {
+            $error = 'captcha'; 
+        }
+    } elsif ($captcha eq 'recaptcha') {
+        $output = &create_recaptcha($pubkey);
+        unless ($output) {
+            $error = 'recpatcha'; 
+        }
+    }
+    return ($output,$error);
+}
+
+sub captcha_response {
+    my ($context,$lonhost) = @_;
+    my ($captcha_chk,$captcha_error);
+    my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
+    if ($captcha eq 'captcha') {
+        ($captcha_chk,$captcha_error) = &check_captcha();
+    } elsif ($captcha eq 'recaptcha') {
+        $captcha_chk = &check_recaptcha($privkey);
+    } else {
+        $captcha_chk = 1;
+    }
+    return ($captcha_chk,$captcha_error);
+}
+
+sub get_captcha_config {
+    my ($context,$lonhost) = @_;
+    my ($captcha,$pubkey,$privkey);
+    my $hostname = &Apache::lonnet::hostname($lonhost);
+    my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
+    my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
+    my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
+    if (ref($domconfig{$context}) eq 'HASH') {
+        if ($domconfig{$context}{'captcha'} eq 'recaptcha') {
+            if (ref($domconfig{$context}{'recaptchakeys'}) eq 'HASH') {
+                $pubkey = $domconfig{$context}{'recaptchakeys'}{'public'};
+                $privkey = $domconfig{$context}{'recaptchakeys'}{'private'};
+            }
+            if ($privkey && $pubkey) {
+                $captcha = 'recaptcha';
+            }
+        } elsif ($domconfig{$context}{'captcha'} eq 'notused') {
+            $captcha = '';
+        } elsif ($domconfig{$context}{'captcha'} eq 'captcha') {
+            $captcha = 'captcha';
+        } else {
+            if ($context eq 'usercreation') {
+                $captcha = 'captcha';
+            }
+        }
+    }
+    return ($captcha,$pubkey,$privkey);
+}
+
+sub create_captcha {
+    my %captcha_params = &captcha_settings();
+    my ($output,$maxtries,$tries) = ('',10,0);
+    while ($tries < $maxtries) {
+        $tries ++;
+        my $captcha = Authen::Captcha->new (
+                                           output_folder => $captcha_params{'output_dir'},
+                                           data_folder   => $captcha_params{'db_dir'},
+                                          );
+        my $md5sum = $captcha->generate_code($captcha_params{'numchars'});
+
+        if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') {
+            $output = '<input type="hidden" name="crypt" value="'.$md5sum.'" />'."\n".
+                      &mt('Type in the letters/numbers shown below').' '.
+                     '<input type="text" size="5" name="code" value="" /><br />'.
+                     '<img src="'.$captcha_params{'www_output_dir'}.'/'.$md5sum.'.png" />';
+            last;
+        }
+    }
+    return $output;
+}
+
+sub captcha_settings {
+    my %captcha_params = (
+                           output_dir     => $Apache::lonnet::perlvar{'lonCaptchaDir'},
+                           www_output_dir => "/captchaspool",
+                           db_dir         => $Apache::lonnet::perlvar{'lonCaptchaDb'},
+                           numchars       => '5',
+                         );
+    return %captcha_params;
+}
+
+sub check_captcha {
+    my ($captcha_chk,$captcha_error);
+    my $code = $env{'form.code'};
+    my $md5sum = $env{'form.crypt'};
+    my %captcha_params = &captcha_settings();
+    my $captcha = Authen::Captcha->new(
+                      output_folder => $captcha_params{'output_dir'},
+                      data_folder   => $captcha_params{'db_dir'},
+                  );
+    my $captcha_chk = $captcha->check_code($code,$md5sum);
+    my %captcha_hash = (
+                        0       => 'Code not checked (file error)',
+                       -1      => 'Failed: code expired',
+                       -2      => 'Failed: invalid code (not in database)',
+                       -3      => 'Failed: invalid code (code does not match crypt)',
+    );
+    if ($captcha_chk != 1) {
+        $captcha_error = $captcha_hash{$captcha_chk}
+    }
+    return ($captcha_chk,$captcha_error);
+}
+
+sub create_recaptcha {
+    my ($pubkey) = @_;
+    my $captcha = Captcha::reCAPTCHA->new;
+    return $captcha->get_options_setter({theme => 'white'})."\n".
+           $captcha->get_html($pubkey).
+           &mt('If either word is hard to read, [_1] will replace them.',
+               '<image src="/res/adm/pages/refresh.gif" alt="reCAPTCHA refresh" />').
+           '<br /><br />';
+}
+
+sub check_recaptcha {
+    my ($privkey) = @_;
+    my $captcha_chk;
+    my $captcha = Captcha::reCAPTCHA->new;
+    my $captcha_result =
+        $captcha->check_answer(
+                                $privkey,
+                                $ENV{'REMOTE_ADDR'},
+                                $env{'form.recaptcha_challenge_field'},
+                                $env{'form.recaptcha_response_field'},
+                              );
+    if ($captcha_result->{is_valid}) {
+        $captcha_chk = 1;
+    }
+    return $captcha_chk;
+}
+
 =pod
 
 =back
Index: doc/loncapafiles/loncapafiles.lpml
diff -u doc/loncapafiles/loncapafiles.lpml:1.808 doc/loncapafiles/loncapafiles.lpml:1.809
--- doc/loncapafiles/loncapafiles.lpml:1.808	Fri Aug 17 22:51:33 2012
+++ doc/loncapafiles/loncapafiles.lpml	Sat Aug 25 04:35:54 2012
@@ -2,7 +2,7 @@
  "http://lpml.sourceforge.net/DTD/lpml.dtd">
 <!-- loncapafiles.lpml -->
 
-<!-- $Id: loncapafiles.lpml,v 1.808 2012/08/17 22:51:33 www Exp $ -->
+<!-- $Id: loncapafiles.lpml,v 1.809 2012/08/25 04:35:54 raeburn Exp $ -->
 
 <!--
 
@@ -7346,6 +7346,7 @@
 open-all-folders.gif;
 open-first-problem.gif;
 qempty.gif;
+refresh.gif;
 show-all.gif;
 show-incomplete-problems.gif;
 star.gif;


More information about the LON-CAPA-cvs mailing list