--- loncom/interface/loncommon.pm 2020/03/05 21:54:44 1.1075.2.144 +++ loncom/interface/loncommon.pm 2021/06/20 17:38:14 1.1075.2.154 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.144 2020/03/05 21:54:44 raeburn Exp $ +# $Id: loncommon.pm,v 1.1075.2.154 2021/06/20 17:38:14 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -4423,6 +4423,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() @@ -4678,13 +4731,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 { @@ -4811,7 +4864,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; @@ -4831,7 +4884,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 = ''; @@ -4844,7 +4897,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; @@ -4966,12 +5025,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; @@ -4987,7 +5046,12 @@ sub blocking_status { $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'; @@ -5041,7 +5105,8 @@ sub check_ip_acc { ($ENV{'REMOTE_ADDR'} eq &Apache::lonnet::get_host_ip($Apache::lonnet::perlvar{'lonHostID'}))) { $ip = $env{'request.host'} || $ENV{'REMOTE_ADDR'} || $clientip; } else { - $ip = $ENV{'REMOTE_ADDR'} || $env{'request.host'} || $clientip; + my $remote_ip = &Apache::lonnet::get_requestor_ip(); + $ip = $remote_ip || $env{'request.host'} || $clientip; } my $name; @@ -7927,43 +7992,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 - } } } } @@ -10298,11 +10418,15 @@ sub sorted_inst_types { } sub get_institutional_codes { - my ($settings,$allcourses,$LC_code) = @_; + my ($cdom,$crs,$settings,$allcourses,$LC_code) = @_; # Get complete list of course sections to update my @currsections = (); my @currxlists = (); + my (%unclutteredsec,%unclutteredlcsec); my $coursecode = $$settings{'internal.coursecode'}; + my $crskey = $crs.':'.$coursecode; + @{$unclutteredsec{$crskey}} = (); + @{$unclutteredlcsec{$crskey}} = (); if ($$settings{'internal.sectionnums'} ne '') { @currsections = split(/,/,$$settings{'internal.sectionnums'}); @@ -10313,8 +10437,8 @@ sub get_institutional_codes { } if (@currxlists > 0) { - foreach (@currxlists) { - if (m/^([^:]+):(\w*)$/) { + foreach my $xl (@currxlists) { + if ($xl =~ /^([^:]+):(\w*)$/) { unless (grep/^$1$/,@{$allcourses}) { push(@{$allcourses},$1); $$LC_code{$1} = $2; @@ -10322,15 +10446,28 @@ sub get_institutional_codes { } } } - + if (@currsections > 0) { - foreach (@currsections) { - if (m/^(\w+):(\w*)$/) { - my $sec = $coursecode.$1; + foreach my $sec (@currsections) { + if ($sec =~ m/^(\w+):(\w*)$/ ) { + my $instsec = $1; my $lc_sec = $2; - unless (grep/^$sec$/,@{$allcourses}) { + unless (grep/^\Q$instsec\E$/,@{$unclutteredsec{$crskey}}) { + push(@{$unclutteredsec{$crskey}},$instsec); + push(@{$unclutteredlcsec{$crskey}},$lc_sec); + } + } + } + } + + if (@{$unclutteredsec{$crskey}} > 0) { + my %formattedsec = &Apache::lonnet::auto_instsec_reformat($cdom,'clutter',\%unclutteredsec); + if ((ref($formattedsec{$crskey}) eq 'ARRAY') && (ref($unclutteredlcsec{$crskey}) eq 'ARRAY')) { + for (my $i=0; $i<@{$formattedsec{$crskey}}; $i++) { + my $sec = $coursecode.$formattedsec{$crskey}[$i]; + unless (grep/^\Q$sec\E$/,@{$allcourses}) { push(@{$allcourses},$sec); - $$LC_code{$sec} = $lc_sec; + $$LC_code{$sec} = $unclutteredlcsec{$crskey}[$i]; } } } @@ -15469,12 +15606,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 @@ -15673,6 +15815,24 @@ sub compare_arrays { return @difference; } +sub lon_status_items { + my %defaults = ( + E => 100, + W => 4, + N => 1, + U => 5, + threshold => 200, + sysmail => 2500, + ); + my %names = ( + E => 'Errors', + W => 'Warnings', + N => 'Notices', + U => 'Unsent', + ); + return (\%defaults,\%names); +} + # -------------------------------------------------------- Initialize user login sub init_user_environment { my ($r, $username, $domain, $authhost, $form, $args) = @_; @@ -15775,6 +15935,7 @@ sub init_user_environment { # --------------------------------------------------------- Write first profile { + my $ip = &Apache::lonnet::get_requestor_ip(); my %initial_env = ("user.name" => $username, "user.domain" => $domain, @@ -15793,7 +15954,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'}; @@ -17039,13 +17200,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) { @@ -17061,7 +17223,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'}, );