[BACK]Return to loncommon.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / interface

Diff for /loncom/interface/loncommon.pm between versions 1.1075.2.13 and 1.1075.2.14

version 1.1075.2.13, 2012/08/07 13:15:28 version 1.1075.2.14, 2012/09/01 09:49:08
Line 70  use Apache::lonclonecourse(); Line 70  use Apache::lonclonecourse();
 use LONCAPA qw(:DEFAULT :match);  use LONCAPA qw(:DEFAULT :match);
 use DateTime::TimeZone;  use DateTime::TimeZone;
 use DateTime::Locale::Catalog;  use DateTime::Locale::Catalog;
   use Authen::Captcha;
   use Captcha::reCAPTCHA;
   
 # ---------------------------------------------- Designs  # ---------------------------------------------- Designs
 use vars qw(%defaultdesign);  use vars qw(%defaultdesign);
Line 885  sub check_uncheck_jscript { Line 887  sub check_uncheck_jscript {
 function checkAll(field) {  function checkAll(field) {
     if (field.length > 0) {      if (field.length > 0) {
         for (i = 0; i < field.length; i++) {          for (i = 0; i < field.length; i++) {
             field[i].checked = true ;              if (!field[i].disabled) {
                   field[i].checked = true;
               }
         }          }
     } else {      } else {
         field.checked = true          if (!field.disabled) {
               field.checked = true;
           }
     }      }
 }  }
     
Line 13884  sub init_user_environment { Line 13890  sub init_user_environment {
                                                   \%userenv,\%domdef,\%is_adv);                                                    \%userenv,\%domdef,\%is_adv);
         }          }
   
           $userenv{'canrequest.author'} =
               &Apache::lonnet::usertools_access($username,$domain,'requestauthor',
                                           'reload','requestauthor',
                                           \%userenv,\%domdef,\%is_adv);
           my %reqauthor = &Apache::lonnet::get('requestauthor',['author_status','author'],
                                                $domain,$username);
           my $reqstatus = $reqauthor{'author_status'};
           if ($reqstatus eq 'approval' || $reqstatus eq 'approved') {
               if (ref($reqauthor{'author'}) eq 'HASH') {
                   $userenv{'requestauthorqueued'} = $reqstatus.':'.
                                                     $reqauthor{'author'}{'timestamp'};
               }
           }
   
  $env{'user.environment'} = "$lonids/$cookie.id";   $env{'user.environment'} = "$lonids/$cookie.id";
   
  if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",   if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
Line 14058  sub parse_supplemental_title { Line 14078  sub parse_supplemental_title {
     return $title;      return $title;
 }  }
   
   sub captcha_display {
       my ($context,$lonhost) = @_;
       my ($output,$error);
       my ($captcha,$pubkey,$privkey) = &get_captcha_config($context,$lonhost);
       if ($captcha eq 'original') {
           $output = &create_captcha();
           unless ($output) {
               $error = 'captcha';
           }
       } elsif ($captcha eq 'recaptcha') {
           $output = &create_recaptcha($pubkey);
           unless ($output) {
               $error = 'recaptcha';
           }
       }
       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 'original') {
           ($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,$hashtocheck);
       my $hostname = &Apache::lonnet::hostname($lonhost);
       my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname);
       my $serverhomedom = &Apache::lonnet::host_domain($serverhomeID);
       if ($context eq 'usercreation') {
           my %domconfig = &Apache::lonnet::get_dom('configuration',[$context],$serverhomedom);
           if (ref($domconfig{$context}) eq 'HASH') {
               $hashtocheck = $domconfig{$context}{'cancreate'};
               if (ref($hashtocheck) eq 'HASH') {
                   if ($hashtocheck->{'captcha'} eq 'recaptcha') {
                       if (ref($hashtocheck->{'recaptchakeys'}) eq 'HASH') {
                           $pubkey = $hashtocheck->{'recaptchakeys'}{'public'};
                           $privkey = $hashtocheck->{'recaptchakeys'}{'private'};
                       }
                       if ($privkey && $pubkey) {
                           $captcha = 'recaptcha';
                       } else {
                           $captcha = 'original';
                       }
                   } elsif ($hashtocheck->{'captcha'} ne 'notused') {
                       $captcha = 'original';
                   }
               }
           } else {
               $captcha = 'captcha';
           }
       } elsif ($context eq 'login') {
           my %domconfhash = &Apache::loncommon::get_domainconf($serverhomedom);
           if ($domconfhash{$serverhomedom.'.login.captcha'} eq 'recaptcha') {
               $pubkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_public'};
               $privkey = $domconfhash{$serverhomedom.'.login.recaptchakeys_private'};
               if ($privkey && $pubkey) {
                   $captcha = 'recaptcha';
               } else {
                   $captcha = 'original';
               }
           } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') {
               $captcha = 'original';
           }
       }
       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').'&nbsp;'.
                        '<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  =pod
   
 =back  =back
Removed from v.1.1075.2.13  
changed lines
  Added in v.1.1075.2.14

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>