--- loncom/interface/loncommon.pm 2020/02/15 03:57:54 1.1338 +++ loncom/interface/loncommon.pm 2021/04/11 18:05:43 1.1356 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1338 2020/02/15 03:57:54 raeburn Exp $ +# $Id: loncommon.pm,v 1.1356 2021/04/11 18:05:43 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -4893,6 +4893,59 @@ sub get_student_view_with_retries { } } +sub css_links { + my ($currsymb,$level) = @_; + my ($links,@symbs,%cssrefs,%httpref); + if ($level eq 'map') { + my $navmap = Apache::lonnavmaps::navmap->new(); + if (ref($navmap)) { + my ($map,undef,$url)=&Apache::lonnet::decode_symb($currsymb); + my @resources = $navmap->retrieveResources($map,sub { $_[0]->is_problem() },0,0); + foreach my $res (@resources) { + if (ref($res) && $res->symb()) { + push(@symbs,$res->symb()); + } + } + } + } else { + @symbs = ($currsymb); + } + foreach my $symb (@symbs) { + my $css_href = &Apache::lonnet::EXT('resource.0.cssfile',$symb); + if ($css_href =~ /\S/) { + unless ($css_href =~ m{https?://}) { + my $url = (&Apache::lonnet::decode_symb($symb))[-1]; + my $proburl = &Apache::lonnet::clutter($url); + my ($probdir) = ($proburl =~ m{(.+)/[^/]+$}); + unless ($css_href =~ m{^/}) { + $css_href = &Apache::lonnet::hreflocation($probdir,$css_href); + } + if ($css_href =~ m{^/(res|uploaded)/}) { + unless (($httpref{'httpref.'.$css_href}) || + (&Apache::lonnet::is_on_map($css_href))) { + my $thisurl = $proburl; + if ($env{'httpref.'.$proburl}) { + $thisurl = $env{'httpref.'.$proburl}; + } + $httpref{'httpref.'.$css_href} = $thisurl; + } + } + } + $cssrefs{$css_href} = 1; + } + } + if (keys(%httpref)) { + &Apache::lonnet::appenv(\%httpref); + } + if (keys(%cssrefs)) { + foreach my $css_href (keys(%cssrefs)) { + next unless ($css_href =~ m{^(/res/|/uploaded/|https?://)}); + $links .= ''."\n"; + } + } + return $links; +} + =pod =item * &get_student_answers() @@ -5148,13 +5201,13 @@ sub findallcourses { ############################################### sub blockcheck { - my ($setters,$activity,$uname,$udom,$url,$is_course) = @_; + my ($setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_; if (defined($udom) && defined($uname)) { # If uname and udom are for a course, check for blocks in the course. if (($is_course) || (&Apache::lonnet::is_course($udom,$uname))) { my ($startblock,$endblock,$triggerblock) = - &get_blocks($setters,$activity,$udom,$uname,$url); + &get_blocks($setters,$activity,$udom,$uname,$url,$symb,$caller); return ($startblock,$endblock,$triggerblock); } } else { @@ -5172,7 +5225,8 @@ sub blockcheck { if (($activity eq 'boards' || $activity eq 'chat' || $activity eq 'groups' || $activity eq 'printout' || - $activity eq 'reinit' || $activity eq 'alert') && + $activity eq 'search' || $activity eq 'reinit' || + $activity eq 'alert') && ($env{'request.course.id'})) { foreach my $key (keys(%live_courses)) { if ($key ne $env{'request.course.id'}) { @@ -5282,7 +5336,7 @@ sub blockcheck { # of specified user, unless user has 'evb' privilege. my ($start,$end,$trigger) = - &get_blocks($setters,$activity,$cdom,$cnum,$url); + &get_blocks($setters,$activity,$cdom,$cnum,$url,$symb,$caller); if (($start != 0) && (($startblock == 0) || ($startblock > $start))) { $startblock = $start; @@ -5302,7 +5356,7 @@ sub blockcheck { } sub get_blocks { - my ($setters,$activity,$cdom,$cnum,$url) = @_; + my ($setters,$activity,$cdom,$cnum,$url,$symb,$caller) = @_; my $startblock = 0; my $endblock = 0; my $triggerblock = ''; @@ -5315,7 +5369,13 @@ sub get_blocks { my $now = time; my %commblocks = &Apache::lonnet::get_comm_blocks($cdom,$cnum); if ($activity eq 'docs') { - @blockers = &Apache::lonnet::has_comm_blocking('bre',undef,$url,\%commblocks); + my ($blocked,$nosymbcache,$noenccheck); + if (($caller eq 'blockedaccess') || ($caller eq 'blockingstatus')) { + $blocked = 1; + $nosymbcache = 1; + $noenccheck = 1; + } + @blockers = &Apache::lonnet::has_comm_blocking('bre',$symb,$url,$nosymbcache,$noenccheck,$blocked,\%commblocks); foreach my $block (@blockers) { if ($block =~ /^firstaccess____(.+)$/) { my $item = $1; @@ -5443,12 +5503,12 @@ sub parse_block_record { } sub blocking_status { - my ($activity,$uname,$udom,$url,$is_course) = @_; + my ($activity,$uname,$udom,$url,$is_course,$symb,$caller) = @_; my %setters; # check for active blocking my ($startblock,$endblock,$triggerblock) = - &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course); + &blockcheck(\%setters,$activity,$uname,$udom,$url,$is_course,$symb,$caller); my $blocked = 0; if ($startblock && $endblock) { $blocked = 1; @@ -5459,12 +5519,17 @@ sub blocking_status { # build a link to a popup window containing the details my $querystring = "?activity=$activity"; -# $uname and $udom decide whose portfolio the user is trying to look at - if (($activity eq 'port') || ($activity eq 'passwd')) { +# $uname and $udom decide whose portfolio (or information page) the user is trying to look at + if (($activity eq 'port') || ($activity eq 'about') || ($activity eq 'passwd')) { $querystring .= "&udom=$udom" if ($udom =~ /^$match_domain$/); $querystring .= "&uname=$uname" if ($uname =~ /^$match_username$/); } elsif ($activity eq 'docs') { - $querystring .= '&url='.&HTML::Entities::encode($url,'&"'); + my $showurl = &Apache::lonenc::check_encrypt($url); + $querystring .= '&url='.&HTML::Entities::encode($showurl,'\'&"<>'); + if ($symb) { + my $showsymb = &Apache::lonenc::check_encrypt($symb); + $querystring .= '&symb='.&HTML::Entities::encode($showsymb,'\'&"<>'); + } } my $output .= <<'END_MYBLOCK'; @@ -5489,10 +5554,16 @@ END_MYBLOCK $text = &mt('Printing Blocked'); } elsif ($activity eq 'passwd') { $text = &mt('Password Changing Blocked'); + } elsif ($activity eq 'grades') { + $text = &mt('Gradebook Blocked'); + } elsif ($activity eq 'search') { + $text = &mt('Search Blocked'); } elsif ($activity eq 'alert') { $text = &mt('Checking Critical Messages Blocked'); } elsif ($activity eq 'reinit') { $text = &mt('Checking Course Update Blocked'); + } elsif ($activity eq 'about') { + $text = &mt('Access to User Information Pages Blocked'); } $output .= <<"END_BLOCK";
@@ -5516,8 +5587,14 @@ sub check_ip_acc { if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { return 1; } - my $allowed; - my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'}; + my ($ip,$allowed); + if (($ENV{'REMOTE_ADDR'} eq '127.0.0.1') || + ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) { + $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip; + } else { + my $remote_ip = &Apache::lonnet::get_requestor_ip(); + $ip = $remote_ip || $env{'request.host'} || $clientip; + } my $name; my %access = ( @@ -8521,43 +8598,99 @@ ADDMETA my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'}; unless (&Apache::lonnet::allowed('mau',$dom_in_use)) { my %domdefs = &Apache::lonnet::get_domain_defaults($dom_in_use); + my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; + my ($offload,$offloadoth); if (ref($domdefs{'offloadnow'}) eq 'HASH') { - my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; if ($domdefs{'offloadnow'}{$lonhost}) { - my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use); - if (($newserver) && ($newserver ne $lonhost)) { - my $numsec = 5; - my $timeout = $numsec * 1000; - my ($newurl,$locknum,%locks,$msg); - if ($env{'request.role.adv'}) { - ($locknum,%locks) = &Apache::lonnet::get_locks(); + $offload = 1; + if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) && + (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) { + unless (&Apache::lonnet::shared_institution($env{'user.domain'})) { + $offloadoth = 1; + $dom_in_use = $env{'user.domain'}; } - my $disable_submit = 0; - if ($requrl =~ /$LONCAPA::assess_re/) { - $disable_submit = 1; + } + } + } + unless ($offload) { + if (ref($domdefs{'offloadoth'}) eq 'HASH') { + if ($domdefs{'offloadoth'}{$lonhost}) { + if (($env{'user.domain'} ne '') && ($env{'user.domain'} ne $dom_in_use) && + (!(($env{'user.name'} eq 'public') && ($env{'user.domain'} eq 'public')))) { + unless (&Apache::lonnet::shared_institution($env{'user.domain'})) { + $offload = 1; + $offloadoth = 1; + $dom_in_use = $env{'user.domain'}; + } } - if ($locknum) { - my @lockinfo = sort(values(%locks)); - $msg = &mt('Once the following tasks are complete: ')."\\n". - join(", ",sort(values(%locks)))."\\n". - &mt('your session will be transferred to a different server, after you click "Roles".'); + } + } + } + if ($offload) { + my $newserver = &Apache::lonnet::spareserver(30000,undef,1,$dom_in_use); + if (($newserver eq '') && ($offloadoth)) { + my @domains = &Apache::lonnet::current_machine_domains(); + if (($dom_in_use ne '') && (!grep(/^\Q$dom_in_use\E$/,@domains))) { + ($newserver) = &Apache::lonnet::choose_server($dom_in_use); + } + } + if (($newserver) && ($newserver ne $lonhost)) { + my $numsec = 5; + my $timeout = $numsec * 1000; + my ($newurl,$locknum,%locks,$msg); + if ($env{'request.role.adv'}) { + ($locknum,%locks) = &Apache::lonnet::get_locks(); + } + my $disable_submit = 0; + if ($requrl =~ /$LONCAPA::assess_re/) { + $disable_submit = 1; + } + if ($locknum) { + my @lockinfo = sort(values(%locks)); + $msg = &mt('Once the following tasks are complete:')." \n". + join(", ",sort(values(%locks)))."\n"; + if (&show_course()) { + $msg .= &mt('your session will be transferred to a different server, after you click "Courses".'); } else { - if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) { - $msg = &mt('Your LON-CAPA submission has been recorded')."\\n"; - } - $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec); - $newurl = '/adm/switchserver?otherserver='.$newserver; - if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) { - $newurl .= '&role='.$env{'request.role'}; + $msg .= &mt('your session will be transferred to a different server, after you click "Roles".'); + } + } else { + if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) { + $msg = &mt('Your LON-CAPA submission has been recorded')."\n"; + } + $msg .= &mt('Your current LON-CAPA session will be transferred to a different server in [quant,_1,second].',$numsec); + $newurl = '/adm/switchserver?otherserver='.$newserver; + if (($env{'request.role'}) && ($env{'request.role'} ne 'cm')) { + $newurl .= '&role='.$env{'request.role'}; + } + if ($env{'request.symb'}) { + my $shownsymb = &Apache::lonenc::check_encrypt($env{'request.symb'}); + if ($shownsymb =~ m{^/enc/}) { + my $reqdmajor = 2; + my $reqdminor = 11; + my $reqdsubminor = 3; + my $newserverrev = &Apache::lonnet::get_server_loncaparev('',$newserver); + my $remoterev = &Apache::lonnet::get_server_loncaparev(undef,$newserver); + my ($major,$minor,$subminor) = ($remoterev =~ /^\'?(\d+)\.(\d+)\.(\d+|)[\w.\-]+\'?$/); + if (($major eq '' && $minor eq '') || + (($reqdmajor > $major) || (($reqdmajor == $major) && ($reqdminor > $minor)) || + (($reqdmajor == $major) && ($reqdminor == $minor) && (($subminor eq '') || + ($reqdsubminor > $subminor))))) { + undef($shownsymb); + } } - if ($env{'request.symb'}) { - $newurl .= '&symb='.$env{'request.symb'}; - } else { - $newurl .= '&origurl='.$requrl; + if ($shownsymb) { + &js_escape(\$shownsymb); + $newurl .= '&symb='.$shownsymb; } + } else { + my $shownurl = &Apache::lonenc::check_encrypt($requrl); + &js_escape(\$shownurl); + $newurl .= '&origurl='.$shownurl; } - &js_escape(\$msg); - $result.=< OFFLOAD - } } } } @@ -15183,6 +15315,8 @@ Inputs: from - Sender's email address +replyto - Reply-To email address + to - Email address of recipient subject - Subject of email @@ -15193,8 +15327,6 @@ cc_string - Carbon copy email ad bcc - Blind carbon copy email address -type - File type of attachment - attachment_path - Path of file to be attached file_name - Name of file to be attached @@ -15211,8 +15343,9 @@ attachment_text - The body of an attac ############################################################ sub mime_email { - my ($from, $to, $subject, $body, $cc_string, $bcc, $attachment_path, - $file_name, $attachment_text) = @_; + my ($from,$replyto,$to,$subject,$body,$cc_string,$bcc,$attachment_path, + $file_name,$attachment_text) = @_; + my $msg = MIME::Lite->new( From => $from, To => $to, @@ -15220,6 +15353,9 @@ sub mime_email { Type =>'TEXT', Data => $body, ); + if ($replyto ne '') { + $msg->add("Reply-To" => $replyto); + } if ($cc_string ne '') { $msg->add("Cc" => $cc_string); } @@ -15818,7 +15954,8 @@ sub check_clone { my $cloneid='/'.$args->{'clonedomain'}.'/'.$args->{'clonecourse'}; my ($clonecrsudom,$clonecrsunum)= &LONCAPA::split_courseid($cloneid); my $clonehome=&Apache::lonnet::homeserver($clonecrsunum,$clonecrsudom); - my $clonemsg; + my $clonetitle; + my @clonemsg; my $can_clone = 0; my $lctype = lc($args->{'crstype'}); if ($lctype ne 'community') { @@ -15826,16 +15963,38 @@ sub check_clone { } if ($clonehome eq 'no_host') { if ($args->{'crstype'} eq 'Community') { - $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); + push(@clonemsg,({ + mt => 'No new community created.', + args => [], + }, + { + mt => 'A new community could not be cloned from the specified original - [_1] - because it is a non-existent community.', + args => [$args->{'clonedomain'}.':'.$args->{'clonedomain'}], + })); } else { - $clonemsg = &mt('No new course created.').$linefeed.&mt('A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); - } + push(@clonemsg,({ + mt => 'No new course created.', + args => [], + }, + { + mt => 'A new course could not be cloned from the specified original - [_1] - because it is a non-existent course.', + args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}], + })); + } } else { my %clonedesc = &Apache::lonnet::coursedescription($cloneid,{'one_time' => 1}); + $clonetitle = $clonedesc{'description'}; if ($args->{'crstype'} eq 'Community') { if ($clonedesc{'type'} ne 'Community') { - $clonemsg = &mt('No new community created.').$linefeed.&mt('A new community could not be cloned from the specified original - [_1] - because it is a course not a community.',$args->{'clonecourse'}.':'.$args->{'clonedomain'}); - return ($can_clone, $clonemsg, $cloneid, $clonehome); + push(@clonemsg,({ + mt => 'No new community created.', + args => [], + }, + { + mt => 'A new community could not be cloned from the specified original - [_1] - because it is a course not a community.', + args => [$args->{'clonecourse'}.':'.$args->{'clonedomain'}], + })); + return ($can_clone,\@clonemsg,$cloneid,$clonehome); } } if (($env{'request.role.domain'} eq $args->{'clonedomain'}) && @@ -15924,20 +16083,34 @@ sub check_clone { } unless ($can_clone) { if ($args->{'crstype'} eq 'Community') { - $clonemsg = &mt('No new community created.').$linefeed.&mt('The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}); + push(@clonemsg,({ + mt => 'No new community created.', + args => [], + }, + { + mt => 'The new community could not be cloned from the existing community because the new community owner ([_1]) does not have cloning rights in the existing community ([_2]).', + args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}], + })); } else { - $clonemsg = &mt('No new course created.').$linefeed.&mt('The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).',$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}); + push(@clonemsg,({ + mt => 'No new course created.', + args => [], + }, + { + mt => 'The new course could not be cloned from the existing course because the new course owner ([_1]) does not have cloning rights in the existing course ([_2]).', + args => [$args->{'ccuname'}.':'.$args->{'ccdomain'},$clonedesc{'description'}], + })); } } } } - return ($can_clone, $clonemsg, $cloneid, $clonehome); + return ($can_clone,\@clonemsg,$cloneid,$clonehome,$clonetitle); } sub construct_course { my ($args,$logmsg,$courseid,$crsudom,$crsunum,$udom,$uname,$context, - $cnum,$category,$coderef) = @_; - my $outcome; + $cnum,$category,$coderef,$callercontext,$user_lh) = @_; + my ($outcome,$msgref,$clonemsgref); my $linefeed = '
'."\n"; if ($context eq 'auto') { $linefeed = "\n"; @@ -15946,18 +16119,11 @@ sub construct_course { # # Are we cloning? # - my ($can_clone, $clonemsg, $cloneid, $clonehome); + my ($can_clone,$cloneid,$clonehome,$clonetitle); if (($args->{'clonecourse'}) && ($args->{'clonedomain'})) { - ($can_clone, $clonemsg, $cloneid, $clonehome) = &check_clone($args,$linefeed); - if ($context ne 'auto') { - if ($clonemsg ne '') { - $clonemsg = ''.$clonemsg.''; - } - } - $outcome .= $clonemsg.$linefeed; - + ($can_clone,$clonemsgref,$cloneid,$clonehome,$clonetitle) = &check_clone($args,$linefeed); if (!$can_clone) { - return (0,$outcome); + return (0,$outcome,$clonemsgref); } } @@ -15980,15 +16146,20 @@ sub construct_course { $args->{'ccuname'}.':'. $args->{'ccdomain'}, $args->{'crstype'}, - $cnum,$context,$category); + $cnum,$context,$category, + $callercontext); # Note: The testing routines depend on this being output; see # Utils::Course. This needs to at least be output as a comment # if anyone ever decides to not show this, and Utils::Course::new # will need to be suitably modified. - $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed; + if (($callercontext eq 'auto') && ($user_lh ne '')) { + $outcome .= &mt_user($user_lh,'New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed; + } else { + $outcome .= &mt('New LON-CAPA [_1] ID: [_2]',$showncrstype,$$courseid).$linefeed; + } if ($$courseid =~ /^error:/) { - return (0,$outcome); + return (0,$outcome,$clonemsgref); } # @@ -15997,23 +16168,37 @@ sub construct_course { ($$crsudom,$$crsunum)= &LONCAPA::split_courseid($$courseid); my $crsuhome=&Apache::lonnet::homeserver($$crsunum,$$crsudom); if ($crsuhome eq 'no_host') { - $outcome .= &mt('Course creation failed, unrecognized course home server.').$linefeed; - return (0,$outcome); + if (($callercontext eq 'auto') && ($user_lh ne '')) { + $outcome .= &mt_user($user_lh, + 'Course creation failed, unrecognized course home server.'); + } else { + $outcome .= &mt('Course creation failed, unrecognized course home server.'); + } + $outcome .= $linefeed; + return (0,$outcome,$clonemsgref); } $outcome .= &mt('Created on').': '.$crsuhome.$linefeed; # # Do the cloning # + my @clonemsg; if ($can_clone && $cloneid) { - $clonemsg = &mt('Cloning [_1] from [_2]',$showncrstype,$clonehome); - if ($context ne 'auto') { - $clonemsg = ''.$clonemsg.''; - } - $outcome .= $clonemsg.$linefeed; + push(@clonemsg, + { + mt => 'Created [_1] by cloning from [_2]', + args => [$showncrstype,$clonetitle], + }); my %oldcenv=&Apache::lonnet::dump('environment',$$crsudom,$$crsunum); # Copy all files - &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'},$args->{'dateshift'}); + my @info = + &Apache::lonclonecourse::copycoursefiles($cloneid,$$courseid,$args->{'datemode'}, + $args->{'dateshift'},$args->{'crscode'}, + $args->{'ccuname'}.':'.$args->{'ccdomain'}, + $args->{'tinyurls'}); + if (@info) { + push(@clonemsg,@info); + } # Restore URL $cenv{'url'}=$oldcenv{'url'}; # Restore title @@ -16038,8 +16223,7 @@ sub construct_course { 'plc.users.denied', 'hidefromcat', 'checkforpriv', - 'categories', - 'internal.uniquecode'], + 'categories'], $$crsudom,$$crsunum); if ($args->{'textbook'}) { $cenv{'internal.textbook'} = $args->{'textbook'}; @@ -16280,12 +16464,17 @@ sub construct_course { # Open all assignments # if ($args->{'openall'}) { + my $opendate = time; + if ($args->{'openallfrom'} =~ /^\d+$/) { + $opendate = $args->{'openallfrom'}; + } my $storeunder=$$crsudom.'_'.$$crsunum.'.0.opendate'; - my %storecontent = ($storeunder => time, + my %storecontent = ($storeunder => $opendate, $storeunder.'.type' => 'date_start'); - - $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput - ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed; + $outcome .= &mt('All assignments open starting [_1]', + &Apache::lonlocal::locallocaltime($opendate)).': '. + &Apache::lonnet::cput + ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed; } # # Set first page @@ -16339,7 +16528,7 @@ sub construct_course { ('resourcedata',\%storecontent,$$crsudom,$$crsunum); } - return (1,$outcome); + return (1,$outcome,\@clonemsg); } sub make_unique_code { @@ -16628,6 +16817,7 @@ sub init_user_environment { # --------------------------------------------------------- Write first profile { + my $ip = &Apache::lonnet::get_requestor_ip($r); my %initial_env = ("user.name" => $username, "user.domain" => $domain, @@ -16646,7 +16836,7 @@ sub init_user_environment { "request.course.sec" => '', "request.role" => 'cm', "request.role.adv" => $env{'user.adv'}, - "request.host" => $ENV{'REMOTE_ADDR'},); + "request.host" => $ip,); if ($form->{'localpath'}) { $initial_env{"browser.localpath"} = $form->{'localpath'}; @@ -17985,11 +18175,12 @@ sub create_recaptcha { sub check_recaptcha { my ($privkey,$version) = @_; my $captcha_chk; + my $ip = &Apache::lonnet::get_requestor_ip(); if ($version >= 2) { my %info = ( secret => $privkey, response => $env{'form.g-recaptcha-response'}, - remoteip => $ENV{'REMOTE_ADDR'}, + remoteip => $ip, ); my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify'); $request->content(join('&',map { @@ -18012,7 +18203,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'}, ); @@ -18064,6 +18255,9 @@ sub cleanup_html { # $context is the calling context -- roles, grades, contents, menu or flip. sub critical_redirect { my ($interval,$context) = @_; + unless (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) { + return (); + } if ((time-$env{'user.criticalcheck.time'})>$interval) { if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) { my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; @@ -18085,7 +18279,7 @@ sub critical_redirect { &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); @@ -18145,24 +18339,37 @@ sub des_decrypt { return $plaintext; } -sub make_short_symbs { +sub get_requested_shorturls { my ($cdom,$cnum,$navmap) = @_; return unless (ref($navmap)); - my ($numnew,@errors); + 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)) { + my %tocreate; foreach my $item (sort {$a <=> $b} (@toshorten)) { my $symb = $resources{$item}; if ($symb) { $tocreate{$cnum.'&'.$symb} = 1; } } + if (keys(%tocreate)) { + ($numnew,$errors) = &make_short_symbs($cdom,$cnum, + \%tocreate); + } } + } + return ($numnew,$errors); +} + +sub make_short_symbs { + my ($cdom,$cnum,$tocreateref,$lockuser) = @_; + my ($numnew,@errors); + if (ref($tocreateref) eq 'HASH') { + my %tocreate = %{$tocreateref}; if (keys(%tocreate)) { my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum); my $su = Short::URL->new(no_vowels => 1); @@ -18170,9 +18377,11 @@ sub make_short_symbs { my (%newunique,%addcourse,%courseonly,%failed); # get lock on tiny db my $now = time; + if ($lockuser eq '') { + $lockuser = $env{'user.name'}.':'.$env{'user.domain'}; + } my $lockhash = { - "lock\0$now" => $env{'user.name'}. - ':'.$env{'user.domain'}, + "lock\0$now" => $lockuser, }; my $tries = 0; my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom);