[LON-CAPA-cvs] cvs: loncom(version_2_11_X) /interface loncommon.pm
raeburn
raeburn at source.lon-capa.org
Sat Sep 1 05:49:08 EDT 2012
raeburn Sat Sep 1 09:49:08 2012 EDT
Modified files: (Branch: version_2_11_X)
/loncom/interface loncommon.pm
Log:
- For 2.11
- backport 1.1092, 1.1093, 1.1094, 1.1095.
-------------- next part --------------
Index: loncom/interface/loncommon.pm
diff -u loncom/interface/loncommon.pm:1.1075.2.13 loncom/interface/loncommon.pm:1.1075.2.14
--- loncom/interface/loncommon.pm:1.1075.2.13 Tue Aug 7 13:15:28 2012
+++ loncom/interface/loncommon.pm Sat Sep 1 09:49:08 2012
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1075.2.13 2012/08/07 13:15:28 raeburn Exp $
+# $Id: loncommon.pm,v 1.1075.2.14 2012/09/01 09:49:08 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -70,6 +70,8 @@
use LONCAPA qw(:DEFAULT :match);
use DateTime::TimeZone;
use DateTime::Locale::Catalog;
+use Authen::Captcha;
+use Captcha::reCAPTCHA;
# ---------------------------------------------- Designs
use vars qw(%defaultdesign);
@@ -885,10 +887,14 @@
function checkAll(field) {
if (field.length > 0) {
for (i = 0; i < field.length; i++) {
- field[i].checked = true ;
+ if (!field[i].disabled) {
+ field[i].checked = true;
+ }
}
} else {
- field.checked = true
+ if (!field.disabled) {
+ field.checked = true;
+ }
}
}
@@ -13884,6 +13890,20 @@
\%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";
if (tie(my %disk_env,'GDBM_File',"$lonids/$cookie.id",
@@ -14058,6 +14078,164 @@
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').' '.
+ '<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
More information about the LON-CAPA-cvs
mailing list