'. + '
'. '
';
last;
}
}
+ if ($output eq '') {
+ &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts.");
+ }
return $output;
}
@@ -17037,7 +17334,8 @@ sub check_captcha {
sub create_recaptcha {
my ($pubkey,$version) = @_;
if ($version >= 2) {
- return '';
+ return ''.
+ '';
} else {
my $use_ssl;
if ($ENV{'SERVER_PORT'} == 443) {
@@ -17055,13 +17353,14 @@ sub create_recaptcha {
sub check_recaptcha {
my ($privkey,$version) = @_;
my $captcha_chk;
+ my $ip = &Apache::lonnet::get_requestor_ip();
if ($version >= 2) {
my $ua = LWP::UserAgent->new;
$ua->timeout(10);
my %info = (
secret => $privkey,
response => $env{'form.g-recaptcha-response'},
- remoteip => $ENV{'REMOTE_ADDR'},
+ remoteip => $ip,
);
my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info);
if ($response->is_success) {
@@ -17077,7 +17376,7 @@ sub check_recaptcha {
my $captcha_result =
$captcha->check_answer(
$privkey,
- $ENV{'REMOTE_ADDR'},
+ $ip,
$env{'form.recaptcha_challenge_field'},
$env{'form.recaptcha_response_field'},
);
@@ -17128,13 +17427,16 @@ sub cleanup_html {
# $interval indicates how often to check for messages.
sub critical_redirect {
my ($interval) = @_;
+ unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
+ return ();
+ }
if ((time-$env{'user.criticalcheck.time'})>$interval) {
my @what=&Apache::lonnet::dump('critical', $env{'user.domain'},
$env{'user.name'});
&Apache::lonnet::appenv({'user.criticalcheck.time'=>time});
my $redirecturl;
if ($what[0]) {
- if (($what[0] ne 'con_lost') && ($what[0]!~/^error\:/)) {
+ if (($what[0] ne 'con_lost') && ($what[0] ne 'no_such_host') && ($what[0]!~/^error\:/)) {
$redirecturl='/adm/email?critical=display';
my $url=&Apache::lonnet::absolute_url().$redirecturl;
return (1, $url);
@@ -17194,131 +17496,6 @@ sub des_decrypt {
return $plaintext;
}
-sub make_short_symbs {
- my ($cdom,$cnum,$navmap) = @_;
- return unless (ref($navmap));
- my ($numnew,@errors);
- my @toshorten = &Apache::loncommon::get_env_multiple('form.addtiny');
- if (@toshorten) {
- my (%maps,%resources,%titles);
- &Apache::loncourserespicker::enumerate_course_contents($navmap,\%maps,\%resources,\%titles,
- 'shorturls',$cdom,$cnum);
- my %tocreate;
- if (keys(%resources)) {
- foreach my $item (sort {$a <=> $b} (@toshorten)) {
- my $symb = $resources{$item};
- if ($symb) {
- $tocreate{$cnum.'&'.$symb} = 1;
- }
- }
- }
- if (keys(%tocreate)) {
- my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum);
- my $su = Short::URL->new(no_vowels => 1);
- my $init = '';
- my (%newunique,%addcourse,%courseonly,%failed);
- # get lock on tiny db
- my $now = time;
- my $lockhash = {
- "lock\0$now" => $env{'user.name'}.
- ':'.$env{'user.domain'},
- };
- my $tries = 0;
- my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
- my ($code,$error);
- while (($gotlock ne 'ok') && ($tries<3)) {
- $tries ++;
- sleep 1;
- $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);
- }
- if ($gotlock eq 'ok') {
- $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique,
- \%addcourse,\%courseonly,\%failed);
- if (keys(%failed)) {
- my $numfailed = scalar(keys(%failed));
- push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed));
- }
- if (keys(%newunique)) {
- my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom);
- if ($putres eq 'ok') {
- $numnew = scalar(keys(%newunique));
- my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum);
- unless ($newputres eq 'ok') {
- push(@errors,&mt('error: could not store course look-up of short URLs'));
- }
- } else {
- push(@errors,&mt('error: could not store unique six character URLs'));
- }
- }
- }
- }
- }
- return ($numnew,\@errors);
-}
-
-sub shorten_symbs {
- my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_;
- return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') &&
- (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') &&
- (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH'));
- my (%possibles,%collisions);
- foreach my $key (keys(%{$tocreate})) {
- my $num = String::CRC32::crc32($key);
- my $tiny = $su->encode($num,$init);
- if ($tiny) {
- $possibles{$tiny} = $key;
- }
- }
- if (!$init) {
- $init = 1;
- } else {
- $init ++;
- }
- if (keys(%possibles)) {
- my @posstiny = keys(%possibles);
- my $configuname = &Apache::lonnet::get_domainconfiguser($cdom);
- my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname);
- if (keys(%currtiny)) {
- foreach my $key (keys(%currtiny)) {
- next if ($currtiny{$key} eq '');
- if ($currtiny{$key} eq $possibles{$key}) {
- my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key});
- unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
- $courseonly->{$tsymb} = $key;
- }
- } else {
- $collisions{$possibles{$key}} = 1;
- }
- delete($possibles{$key});
- }
- }
- foreach my $key (keys(%possibles)) {
- $newunique->{$key} = $possibles{$key};
- my ($tcnum,$tsymb) = split(/\&/,$possibles{$key});
- unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) {
- $addcourse->{$tsymb} = $key;
- }
- }
- }
- if (keys(%collisions)) {
- if ($init <5) {
- if (!$init) {
- $init = 1;
- } else {
- $init ++;
- }
- $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions,
- $newunique,$addcourse,$courseonly,$failed);
- } else {
- foreach my $key (keys(%collisions)) {
- $failed->{$key} = 1;
- $failed->{$key} = 1;
- }
- }
- }
- return $init;
-}
-
sub is_nonframeable {
my ($url,$absolute,$hostname,$ip,$nocache) = @_;
my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);