--- loncom/interface/loncommon.pm 2019/08/25 22:56:14 1.1075.2.138 +++ loncom/interface/loncommon.pm 2022/01/16 19:11:03 1.1075.2.162 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.138 2019/08/25 22:56:14 raeburn Exp $ +# $Id: loncommon.pm,v 1.1075.2.162 2022/01/16 19:11:03 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -428,7 +428,7 @@ sub studentbrowser_javascript { OFFLOAD - } } } } @@ -8059,7 +8328,8 @@ sub print_suppression { } my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - my $blocked = &blocking_status('printout',$cnum,$cdom,undef,1); + my $clientip = &Apache::lonnet::get_requestor_ip(); + my $blocked = &blocking_status('printout',$clientip,$cnum,$cdom,undef,1); if ($blocked) { my $checkrole = "cm./$cdom/$cnum"; if ($env{'request.course.sec'} ne '') { @@ -8180,6 +8450,9 @@ $args - additional optional args support will contain https:// if server uses https (as per hosts.tab), but request is for http hostname -> hostname, originally from $r->hostname(), (optional). + links_disabled -> Links in primary and secondary menus are disabled + (Can enable them once page has loaded - see lonroles.pm + for an example). =back @@ -8381,13 +8654,20 @@ sub modal_link { $target_attr = 'target="'.$target.'"'; } return <<"ENDLINK"; - - $linktext +$linktext ENDLINK } sub modal_adhoc_script { - my ($funcname,$width,$height,$content)=@_; + my ($funcname,$width,$height,$content,$possmathjax)=@_; + my $mathjax; + if ($possmathjax) { + $mathjax = <<'ENDJAX'; + if (typeof MathJax == 'object') { + MathJax.Hub.Queue(["Typeset",MathJax.Hub]); + } +ENDJAX + } return (< // @@ -8405,7 +8686,7 @@ ENDADHOC } sub modal_adhoc_inner { - my ($funcname,$width,$height,$content)=@_; + my ($funcname,$width,$height,$content,$possmathjax)=@_; my $innerwidth=$width-20; $content=&js_ready( &start_page('Dialog',undef,{'only_body'=>1,'bgcolor'=>'#FFFFFF'}). @@ -8414,12 +8695,12 @@ sub modal_adhoc_inner { &end_scrollbox(). &end_page() ); - return &modal_adhoc_script($funcname,$width,$height,$content); + return &modal_adhoc_script($funcname,$width,$height,$content,$possmathjax); } sub modal_adhoc_window { - my ($funcname,$width,$height,$content,$linktext)=@_; - return &modal_adhoc_inner($funcname,$width,$height,$content). + my ($funcname,$width,$height,$content,$linktext,$possmathjax)=@_; + return &modal_adhoc_inner($funcname,$width,$height,$content,$possmathjax). "".$linktext.""; } @@ -10275,11 +10556,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'}); @@ -10290,8 +10575,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; @@ -10299,15 +10584,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]; } } } @@ -14180,6 +14478,12 @@ defdom (domain for which to retrieve con origmail (scalar - email address of recipient from loncapa.conf, i.e., predates configuration by DC via domainprefs.pm +$requname username of requester (if mailing type is helpdeskmail) + +$requdom domain of requester (if mailing type is helpdeskmail) + +$reqemail e-mail address of requester (if mailing type is helpdeskmail) + Returns: comma separated list of addresses to which to send e-mail. =back @@ -14189,7 +14493,7 @@ Returns: comma separated list of address ############################################################ ############################################################ sub build_recipient_list { - my ($defmail,$mailing,$defdom,$origmail) = @_; + my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_; my @recipients; my ($otheremails,$lastresort,$allbcc,$addtext); my %domconfig = @@ -14230,10 +14534,97 @@ sub build_recipient_list { } elsif ($origmail ne '') { $lastresort = $origmail; } + if ($mailing eq 'helpdeskmail') { + if ((ref($domconfig{'contacts'}{'overrides'}) eq 'HASH') && + (keys(%{$domconfig{'contacts'}{'overrides'}}))) { + my ($inststatus,$inststatus_checked); + if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') && + ($env{'user.domain'} ne 'public')) { + $inststatus_checked = 1; + $inststatus = $env{'environment.inststatus'}; + } + unless ($inststatus_checked) { + if (($requname ne '') && ($requdom ne '')) { + if (($requname =~ /^$match_username$/) && + ($requdom =~ /^$match_domain$/) && + (&Apache::lonnet::domain($requdom))) { + my $requhome = &Apache::lonnet::homeserver($requname, + $requdom); + unless ($requhome eq 'no_host') { + my %userenv = &Apache::lonnet::userenvironment($requdom,$requname,'inststatus'); + $inststatus = $userenv{'inststatus'}; + $inststatus_checked = 1; + } + } + } + } + unless ($inststatus_checked) { + if ($reqemail =~ /^[^\@]+\@[^\@]+$/) { + my %srch = (srchby => 'email', + srchdomain => $defdom, + srchterm => $reqemail, + srchtype => 'exact'); + my %srch_results = &Apache::lonnet::usersearch(\%srch); + foreach my $uname (keys(%srch_results)) { + if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') { + $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}}); + $inststatus_checked = 1; + last; + } + } + unless ($inststatus_checked) { + my ($dirsrchres,%srch_results) = &Apache::lonnet::inst_directory_query(\%srch); + if ($dirsrchres eq 'ok') { + foreach my $uname (keys(%srch_results)) { + if (ref($srch_results{$uname}{'inststatus'}) eq 'ARRAY') { + $inststatus = join(',',@{$srch_results{$uname}{'inststatus'}}); + $inststatus_checked = 1; + last; + } + } + } + } + } + } + if ($inststatus ne '') { + foreach my $status (split(/\:/,$inststatus)) { + if (ref($domconfig{'contacts'}{'overrides'}{$status}) eq 'HASH') { + my @contacts = ('adminemail','supportemail'); + foreach my $item (@contacts) { + if ($domconfig{'contacts'}{'overrides'}{$status}{$item}) { + my $addr = $domconfig{'contacts'}{'overrides'}{$status}; + if (!grep(/^\Q$addr\E$/,@recipients)) { + push(@recipients,$addr); + } + } + } + $otheremails = $domconfig{'contacts'}{'overrides'}{$status}{'others'}; + if ($domconfig{'contacts'}{'overrides'}{$status}{'bcc'}) { + my @bccs = split(/,/,$domconfig{'contacts'}{'overrides'}{$status}{'bcc'}); + my @ok_bccs; + foreach my $bcc (@bccs) { + $bcc =~ s/^\s+//g; + $bcc =~ s/\s+$//g; + if ($bcc =~ m/^[^\@]+\@[^\@]+$/) { + if (!(grep(/^\Q$bcc\E$/,@ok_bccs))) { + push(@ok_bccs,$bcc); + } + } + } + if (@ok_bccs > 0) { + $allbcc = join(', ',@ok_bccs); + } + } + $addtext = $domconfig{'contacts'}{'overrides'}{$status}{'include'}; + last; + } + } + } + } + } } elsif ($origmail ne '') { $lastresort = $origmail; } - if (($mailing eq 'helpdeskmail') && ($lastresort ne '')) { unless (grep(/^\Q$defdom\E$/,&Apache::lonnet::current_machine_domains())) { my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; @@ -15111,8 +15502,7 @@ sub construct_course { 'plc.users.denied', 'hidefromcat', 'checkforpriv', - 'categories', - 'internal.uniquecode'], + 'categories'], $$crsudom,$$crsunum); if ($args->{'textbook'}) { $cenv{'internal.textbook'} = $args->{'textbook'}; @@ -15353,12 +15743,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 @@ -15557,6 +15952,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) = @_; @@ -15659,6 +16072,7 @@ sub init_user_environment { # --------------------------------------------------------- Write first profile { + my $ip = &Apache::lonnet::get_requestor_ip(); my %initial_env = ("user.name" => $username, "user.domain" => $domain, @@ -15677,7 +16091,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'}; @@ -16860,13 +17274,17 @@ sub create_captcha { if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') { $output = ''."\n". + ''. &mt('Type in the letters/numbers shown below').' '. ''. - '
'. + '

'. 'captcha'; last; } } + if ($output eq '') { + &Apache::lonnet::logthis("Failed to create Captcha code after $tries attempts."); + } return $output; } @@ -16905,7 +17323,8 @@ sub check_captcha { sub create_recaptcha { my ($pubkey,$version) = @_; if ($version >= 2) { - return '
'; + return '
'. + '
'; } else { my $use_ssl; if ($ENV{'SERVER_PORT'} == 443) { @@ -16923,13 +17342,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) { @@ -16945,7 +17365,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'}, ); @@ -16996,13 +17416,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); @@ -17085,7 +17508,9 @@ sub is_nonframeable { } my $uselink; my $request = new HTTP::Request('HEAD',$url); - my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5); + my $ua = LWP::UserAgent->new; + $ua->timeout(5); + my $response=$ua->request($request); if ($response->is_success()) { my $secpolicy = lc($response->header('content-security-policy')); my $xframeop = lc($response->header('x-frame-options'));