--- loncom/interface/loncommon.pm 2019/07/30 21:13:54 1.1075.2.135 +++ loncom/interface/loncommon.pm 2021/12/17 19:59:39 1.1075.2.159 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.135 2019/07/30 21:13:54 raeburn Exp $ +# $Id: loncommon.pm,v 1.1075.2.159 2021/12/17 19:59:39 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -428,7 +428,7 @@ sub studentbrowser_javascript { OFFLOAD - } } } } @@ -7986,7 +8317,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 '') { @@ -8107,6 +8439,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 @@ -8308,13 +8643,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 (< // @@ -8332,7 +8675,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'}). @@ -8341,12 +8684,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.""; } @@ -10202,11 +10545,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'}); @@ -10217,8 +10564,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; @@ -10226,15 +10573,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]; } } } @@ -14107,6 +14467,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 @@ -14116,7 +14482,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 = @@ -14157,10 +14523,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'}; @@ -15038,8 +15491,7 @@ sub construct_course { 'plc.users.denied', 'hidefromcat', 'checkforpriv', - 'categories', - 'internal.uniquecode'], + 'categories'], $$crsudom,$$crsunum); if ($args->{'textbook'}) { $cenv{'internal.textbook'} = $args->{'textbook'}; @@ -15280,12 +15732,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 @@ -15484,6 +15941,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) = @_; @@ -15519,7 +15994,23 @@ sub init_user_environment { opendir(DIR,$lonids); while ($filename=readdir(DIR)) { if ($filename=~/^$username\_\d+\_$domain\_$authhost\.id$/) { - unlink($lonids.'/'.$filename); + if (tie(my %oldenv,'GDBM_File',"$lonids/$filename", + &GDBM_READER(),0640)) { + my $linkedfile; + if (exists($oldenv{'user.linkedenv'})) { + $linkedfile = $oldenv{'user.linkedenv'}; + } + untie(%oldenv); + if (unlink("$lonids/$filename")) { + if ($linkedfile =~ /^[a-f0-9]+_linked$/) { + if (-l "$lonids/$linkedfile.id") { + unlink("$lonids/$linkedfile.id"); + } + } + } + } else { + unlink($lonids.'/'.$filename); + } } } closedir(DIR); @@ -15570,6 +16061,7 @@ sub init_user_environment { # --------------------------------------------------------- Write first profile { + my $ip = &Apache::lonnet::get_requestor_ip(); my %initial_env = ("user.name" => $username, "user.domain" => $domain, @@ -15588,7 +16080,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'}; @@ -16652,10 +17144,10 @@ sub symb_to_docspath { } sub captcha_display { - my ($context,$lonhost) = @_; + my ($context,$lonhost,$defdom) = @_; my ($output,$error); my ($captcha,$pubkey,$privkey,$version) = - &get_captcha_config($context,$lonhost); + &get_captcha_config($context,$lonhost,$defdom); if ($captcha eq 'original') { $output = &create_captcha(); unless ($output) { @@ -16671,9 +17163,9 @@ sub captcha_display { } sub captcha_response { - my ($context,$lonhost) = @_; + my ($context,$lonhost,$defdom) = @_; my ($captcha_chk,$captcha_error); - my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost); + my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom); if ($captcha eq 'original') { ($captcha_chk,$captcha_error) = &check_captcha(); } elsif ($captcha eq 'recaptcha') { @@ -16685,7 +17177,7 @@ sub captcha_response { } sub get_captcha_config { - my ($context,$lonhost) = @_; + my ($context,$lonhost,$dom_in_effect) = @_; my ($captcha,$pubkey,$privkey,$version,$hashtocheck); my $hostname = &Apache::lonnet::hostname($lonhost); my $serverhomeID = &Apache::lonnet::get_server_homeID($hostname); @@ -16733,6 +17225,27 @@ sub get_captcha_config { } elsif ($domconfhash{$serverhomedom.'.login.captcha'} eq 'original') { $captcha = 'original'; } + } elsif ($context eq 'passwords') { + if ($dom_in_effect) { + my %passwdconf = &Apache::lonnet::get_passwdconf($dom_in_effect); + if ($passwdconf{'captcha'} eq 'recaptcha') { + if (ref($passwdconf{'recaptchakeys'}) eq 'HASH') { + $pubkey = $passwdconf{'recaptchakeys'}{'public'}; + $privkey = $passwdconf{'recaptchakeys'}{'private'}; + } + if ($privkey && $pubkey) { + $captcha = 'recaptcha'; + $version = $passwdconf{'recaptchaversion'}; + if ($version ne '2') { + $version = 1; + } + } else { + $captcha = 'original'; + } + } elsif ($passwdconf{'captcha'} ne 'notused') { + $captcha = 'original'; + } + } } return ($captcha,$pubkey,$privkey,$version); } @@ -16750,13 +17263,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; } @@ -16795,7 +17312,8 @@ sub check_captcha { sub create_recaptcha { my ($pubkey,$version) = @_; if ($version >= 2) { - return '
'; + return '
'. + '
'; } else { my $use_ssl; if ($ENV{'SERVER_PORT'} == 443) { @@ -16813,13 +17331,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) { @@ -16835,7 +17354,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'}, ); @@ -16886,13 +17405,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); @@ -16975,7 +17497,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'));