--- loncom/interface/loncommon.pm 2023/03/12 02:20:43 1.1075.2.161.2.16 +++ loncom/interface/loncommon.pm 2021/08/07 20:49:11 1.1364 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.161.2.16 2023/03/12 02:20:43 raeburn Exp $ +# $Id: loncommon.pm,v 1.1364 2021/08/07 20:49:11 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -61,7 +61,7 @@ use POSIX qw(strftime mktime); use Apache::lonmenu(); use Apache::lonenc(); use Apache::lonlocal; -use Apache::lonnavmaps(); +use Apache::lonnet(); use HTML::Entities; use Apache::lonhtmlcommon(); use Apache::loncoursedata(); @@ -71,17 +71,19 @@ use Apache::lonuserutils(); use Apache::lonuserstate(); use Apache::courseclassifier(); use LONCAPA qw(:DEFAULT :match); -use LONCAPA::map(); +use LONCAPA::LWPReq; use HTTP::Request; use DateTime::TimeZone; use DateTime::Locale; use Encode(); +use Text::Aspell; use Authen::Captcha; use Captcha::reCAPTCHA; use JSON::DWIW; -use LWP::UserAgent; use Crypt::DES; use DynaLoader; # for Crypt::DES version +use MIME::Lite; +use MIME::Types; use File::Copy(); use File::Path(); use String::CRC32(); @@ -170,6 +172,7 @@ sub ssi_with_retries { # ----------------------------------------------- Filetypes/Languages/Copyright my %language; my %supported_language; +my %supported_codes; my %latex_language; # For choosing hyphenation in my %latex_language_bykey; # for choosing hyphenation from metadata my %cprtag; @@ -204,14 +207,15 @@ BEGIN { while (my $line = <$fh>) { next if ($line=~/^\#/); chomp($line); - my ($key,$two,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line)); + my ($key,$code,$country,$three,$enc,$val,$sup,$latex)=(split(/\t/,$line)); $language{$key}=$val.' - '.$enc; if ($sup) { $supported_language{$key}=$sup; + $supported_codes{$key} = $code; } if ($latex) { $latex_language_bykey{$key} = $latex; - $latex_language{$two} = $latex; + $latex_language{$code} = $latex; } } close($fh); @@ -690,7 +694,7 @@ if (!Array.prototype.indexOf) { var n = 0; if (arguments.length > 0) { n = Number(arguments[1]); - if (n !== n) { // shortcut for verifying if it's NaN + if (n !== n) { // shortcut for verifying if it is NaN n = 0; } else if (n !== 0 && n !== (1 / 0) && n !== -(1 / 0)) { n = (n > 0 || -1) * Math.floor(Math.abs(n)); @@ -891,6 +895,8 @@ sub selectcourse_link { my $linktext = &mt('Select Course'); if ($selecttype eq 'Community') { $linktext = &mt('Select Community'); + } elsif ($selecttype eq 'Placement') { + $linktext = &mt('Select Placement Test'); } elsif ($selecttype eq 'Course/Community') { $linktext = &mt('Select Course/Community'); $type = ''; @@ -926,12 +932,12 @@ sub check_uncheck_jscript { function checkAll(field) { if (field.length > 0) { for (i = 0; i < field.length; i++) { - if (!field[i].disabled) { + if (!field[i].disabled) { field[i].checked = true; } } } else { - if (!field.disabled) { + if (!field.disabled) { field.checked = true; } } @@ -951,8 +957,8 @@ ENDSCRT } sub select_timezone { - my ($name,$selected,$onchange,$includeempty,$id,$disabled)=@_; - my $output=''."\n"; if ($includeempty) { $output .= '\n"; } $typeselectform.=""; } @@ -17054,7 +17381,7 @@ sub build_filters { if (exists($filter->{'instcodefilter'})) { # if (($fixeddom) || ($formname eq 'requestcrs') || # ($formname eq 'modifycourse') || ($formname eq 'filterpicker')) { - if ($codedom) { + if ($codedom) { $officialjs = 1; ($instcodeform,$jscript,$$numtitlesref) = &Apache::courseclassifier::instcode_selectors($codedom,'filterpicker', @@ -17183,7 +17510,7 @@ $typeelement return $jscript.$clonewarning.$output; } -=pod +=pod =item * &timebased_select_form() @@ -17198,7 +17525,7 @@ item - name of form element (sincefilter filter - anonymous hash of criteria and their values Returns: HTML for a select box contained a blank, then six time selections, - with value set in incoming form variables currently selected. + with value set in incoming form variables currently selected. Side Effects: None @@ -17235,7 +17562,7 @@ page load completion for page showing se Inputs: None -Returns: markup containing updateFilters() and hideSearching() javascript functions. +Returns: markup containing updateFilters() and hideSearching() javascript functions. Side Effects: None @@ -17274,7 +17601,7 @@ to retrieve a hash for which keys are co Inputs: -dom - domain being searched +dom - domain being searched type - course type ('Course' or 'Community' or '.' if any). @@ -17286,7 +17613,7 @@ cloneruname - optional username of new c clonerudom - optional domain of new course owner -domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, +domcloner - optional "domcloner" flag; has value=1 if user has ccc priv in domain being filtered by, (used when DC is using course creation form) codetitles - reference to array of titles of components in institutional codes (official courses). @@ -17296,8 +17623,8 @@ cc_clone - escaped comma separated list reqcrsdom - domain of new course, where search_courses is used to identify potential courses to clone -reqinstcode - institutional code of new course, where search_courses is used to identify potential - courses to clone +reqinstcode - institutional code of new course, where search_courses is used to identify potential + courses to clone Returns: %courses - hash of courses satisfying search criteria, keys = course IDs, values are corresponding colon-separated escaped description, institutional code, owner and type. @@ -17423,8 +17750,8 @@ $required - LON-CAPA version needed by c Returns: -$switchserver - query string tp append to /adm/switchserver call (if - current server's LON-CAPA version is too old. +$switchserver - query string tp append to /adm/switchserver call (if + current server's LON-CAPA version is too old. $warning - Message is displayed if no suitable server could be found. @@ -17537,7 +17864,7 @@ Inputs: $loncaparev - Version on current server (format: Major.Minor.Subrelease-datestamp) $interval (optional) - Time which may elapse (in s) between last check for content - change in current course. (default: 600 s). + change in current course. (default: 600 s). Returns: an array; first element is: @@ -17545,9 +17872,9 @@ Returns: an array; first element is: 'switch' - if content updates mean user's session needs to be switched to a server running a newer LON-CAPA version - + 'update' - if course session needs to be refreshed (i.e., Big Hash needs to be reloaded) - on current server hosting user's session + on current server hosting user's session '' - if no action required. @@ -17555,10 +17882,10 @@ Returns: an array; first element is: If first item element is 'switch': -second item is $switchwarning - Warning message if no suitable server found to host session. +second item is $switchwarning - Warning message if no suitable server found to host session. third item is $switchserver - query string to append to /adm/switchserver containing lonHostID - and current role. + and current role. otherwise: no other elements returned. @@ -17577,73 +17904,61 @@ sub needs_coursereinit { } if (($now-$env{'request.course.timechecked'})>$interval) { &Apache::lonnet::appenv({'request.course.timechecked'=>$now}); - my $blocked = &blocking_status('reinit',undef,$cnum,$cdom,undef,1); + my $blocked = &blocking_status('reinit',$cnum,$cdom,undef,1); if ($blocked) { return (); } - my $update; - my $lastmainchange = &Apache::lonnet::get_coursechange($cdom,$cnum); - my $lastsuppchange = &Apache::lonnet::get_suppchange($cdom,$cnum); - if ($lastmainchange > $env{'request.course.tied'}) { - my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum); - if ($needswitch) { - return ('switch',$switchwarning,$switchserver); - } - $update = 'main'; - } - if ($lastsuppchange > $env{'request.course.suppupdated'}) { - if ($update) { - $update = 'both'; - } else { - my ($needswitch,$switchwarning,$switchserver) = &switch_for_update($loncaparev,$cdom,$cnum); - if ($needswitch) { - return ('switch',$switchwarning,$switchserver); - } else { - $update = 'supp'; + my $lastchange = &Apache::lonnet::get_coursechange($cdom,$cnum); + if ($lastchange > $env{'request.course.tied'}) { + my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); + if ($curr_reqd_hash{'internal.releaserequired'} ne '') { + my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'}; + if ($curr_reqd_hash{'internal.releaserequired'} ne $required) { + &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' => + $curr_reqd_hash{'internal.releaserequired'}}); + my ($switchserver,$switchwarning) = + &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'}, + $curr_reqd_hash{'internal.releaserequired'}); + if ($switchwarning ne '' || $switchserver ne '') { + return ('switch',$switchwarning,$switchserver); + } } } - return ($update); - } - } - return (); -} - -sub switch_for_update { - my ($loncaparev,$cdom,$cnum) = @_; - my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); - if ($curr_reqd_hash{'internal.releaserequired'} ne '') { - my $required = $env{'course.'.$cdom.'_'.$cnum.'.internal.releaserequired'}; - if ($curr_reqd_hash{'internal.releaserequired'} ne $required) { - &Apache::lonnet::appenv({'course.'.$cdom.'_'.$cnum.'.internal.releaserequired' => - $curr_reqd_hash{'internal.releaserequired'}}); - my ($switchserver,$switchwarning) = - &check_release_required($loncaparev,$cdom.'_'.$cnum,$env{'request.role'}, - $curr_reqd_hash{'internal.releaserequired'}); - if ($switchwarning ne '' || $switchserver ne '') { - return ('switch',$switchwarning,$switchserver); - } + return ('update'); } } return (); } sub update_content_constraints { - my ($cdom,$cnum,$chome,$cid) = @_; + my ($cdom,$cnum,$chome,$cid,$keeporder) = @_; my %curr_reqd_hash = &Apache::lonnet::userenvironment($cdom,$cnum,'internal.releaserequired'); my ($reqdmajor,$reqdminor) = split(/\./,$curr_reqd_hash{'internal.releaserequired'}); - my %checkresponsetypes; + my (%checkresponsetypes,%checkcrsrestypes); foreach my $key (keys(%Apache::lonnet::needsrelease)) { my ($item,$name,$value) = split(/:/,$key); if ($item eq 'resourcetag') { if ($name eq 'responsetype') { $checkresponsetypes{$value} = $Apache::lonnet::needsrelease{$key} } + } elsif ($item eq 'course') { + if ($name eq 'courserestype') { + $checkcrsrestypes{$value} = $Apache::lonnet::needsrelease{$key}; + } } } my $navmap = Apache::lonnavmaps::navmap->new(); if (defined($navmap)) { - my %allresponses; - foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() },1,0)) { + my (%allresponses,%allcrsrestypes); + foreach my $res ($navmap->retrieveResources(undef,sub { $_[0]->is_problem() || $_[0]->is_tool() },1,0)) { + if ($res->is_tool()) { + if ($allcrsrestypes{'exttool'}) { + $allcrsrestypes{'exttool'} ++; + } else { + $allcrsrestypes{'exttool'} = 1; + } + next; + } my %responses = $res->responseTypes(); foreach my $key (keys(%responses)) { next unless(exists($checkresponsetypes{$key})); @@ -17656,8 +17971,38 @@ sub update_content_constraints { ($reqdmajor,$reqdminor) = ($major,$minor); } } + foreach my $key (keys(%allcrsrestypes)) { + my ($major,$minor) = split(/\./,$checkcrsrestypes{$key}); + if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) { + ($reqdmajor,$reqdminor) = ($major,$minor); + } + } undef($navmap); } + my (@resources,@order,@resparms,@zombies); + if ($keeporder) { + use LONCAPA::map; + @resources = @LONCAPA::map::resources; + @order = @LONCAPA::map::order; + @resparms = @LONCAPA::map::resparms; + @zombies = @LONCAPA::map::zombies; + } + my $suppmap = 'supplemental.sequence'; + my ($suppcount,$supptools,$errors) = (0,0,0); + ($suppcount,$supptools,$errors) = &recurse_supplemental($cnum,$cdom,$suppmap, + $suppcount,$supptools,$errors); + if ($keeporder) { + @LONCAPA::map::resources = @resources; + @LONCAPA::map::order = @order; + @LONCAPA::map::resparms = @resparms; + @LONCAPA::map::zombies = @zombies; + } + if ($supptools) { + my ($major,$minor) = split(/\./,$checkcrsrestypes{'exttool'}); + if (($major > $reqdmajor) || ($major == $reqdmajor && $minor > $reqdminor)) { + ($reqdmajor,$reqdminor) = ($major,$minor); + } + } unless (($reqdmajor eq '') && ($reqdminor eq '')) { &Apache::lonnet::update_released_required($reqdmajor.'.'.$reqdminor,$cdom,$cnum,$chome,$cid); } @@ -17678,7 +18023,7 @@ sub allmaps_incourse { if ($lastchange > $env{'request.course.tied'}) { my ($furl,$ferr) = &Apache::lonuserstate::readmap("$cdom/$cnum"); unless ($ferr) { - &update_content_constraints($cdom,$cnum,$chome,$cid); + &update_content_constraints($cdom,$cnum,$chome,$cid,1); } } my $navmap = Apache::lonnavmaps::navmap->new(); @@ -17704,10 +18049,8 @@ sub parse_supplemental_title { my $name = &plainname($uname,$udom); $name = &HTML::Entities::encode($name,'"<>&\''); $renametitle = &HTML::Entities::encode($renametitle,'"<>&\''); - $title=''.&Apache::lonlocal::locallocaltime($time).' '.$name; - if ($foldertitle ne '') { - $title .= ':
'.$foldertitle; - } + $title=''.&Apache::lonlocal::locallocaltime($time).' '. + $name.':
'.$foldertitle; } if (wantarray) { return ($title,$foldertitle,$renametitle); @@ -17715,147 +18058,32 @@ sub parse_supplemental_title { return $title; } -sub get_supplemental { - my ($cnum,$cdom,$ignorecache,$possdel)=@_; - my $hashid=$cnum.':'.$cdom; - my ($supplemental,$cached,$set_httprefs); - unless ($ignorecache) { - ($supplemental,$cached) = &Apache::lonnet::is_cached_new('supplemental',$hashid); - } - unless (defined($cached)) { - my $chome=&Apache::lonnet::homeserver($cnum,$cdom); - unless ($chome eq 'no_host') { - my @order = @LONCAPA::map::order; - my @resources = @LONCAPA::map::resources; - my @resparms = @LONCAPA::map::resparms; - my @zombies = @LONCAPA::map::zombies; - my ($errors,%ids,%hidden); - $errors = - &recurse_supplemental($cnum,$cdom,'supplemental.sequence', - $errors,$possdel,\%ids,\%hidden); - @LONCAPA::map::order = @order; - @LONCAPA::map::resources = @resources; - @LONCAPA::map::resparms = @resparms; - @LONCAPA::map::zombies = @zombies; - $set_httprefs = 1; - if ($env{'request.course.id'} eq $cdom.'_'.$cnum) { - &Apache::lonnet::appenv({'request.course.suppupdated' => time}); - } - $supplemental = { - ids => \%ids, - hidden => \%hidden, - }; - &Apache::lonnet::do_cache_new('supplemental',$hashid,$supplemental,600); - } - } - return ($supplemental,$set_httprefs); -} - sub recurse_supplemental { - my ($cnum,$cdom,$suppmap,$errors,$possdel,$suppids,$hiddensupp,$hidden) = @_; - if (($suppmap) && (ref($suppids) eq 'HASH') && (ref($hiddensupp) eq 'HASH')) { - my $mapnum; - if ($suppmap eq 'supplemental.sequence') { - $mapnum = 0; - } else { - ($mapnum) = ($suppmap =~ /^supplemental_(\d+)\.sequence$/); - } + my ($cnum,$cdom,$suppmap,$numfiles,$numexttools,$errors) = @_; + if ($suppmap) { my ($errtext,$fatal) = &LONCAPA::map::mapread('/uploaded/'.$cdom.'/'.$cnum.'/'.$suppmap); if ($fatal) { $errors ++; } else { - my @order = @LONCAPA::map::order; - if (@order > 0) { - my @resources = @LONCAPA::map::resources; - my @resparms = @LONCAPA::map::resparms; - foreach my $idx (@order) { - my ($title,$src,$ext,$type,$status)=split(/\:/,$resources[$idx]); + if ($#LONCAPA::map::resources > 0) { + foreach my $res (@LONCAPA::map::resources) { + my ($title,$src,$ext,$type,$status)=split(/\:/,$res); if (($src ne '') && ($status eq 'res')) { - my $id = $mapnum.':'.$idx; - push(@{$suppids->{$src}},$id); - if (($hidden) || (&get_supp_parameter($resparms[$idx],'parameter_hiddenresource') =~ /^yes/i)) { - $hiddensupp->{$id} = 1; - } if ($src =~ m{^\Q/uploaded/$cdom/$cnum/\E(supplemental_\d+\.sequence)$}) { - $errors = &recurse_supplemental($cnum,$cdom,$1,$errors,$possdel,$suppids, - $hiddensupp,$hiddensupp->{$id}); + ($numfiles,$numexttools,$errors) = &recurse_supplemental($cnum,$cdom,$1, + $numfiles,$numexttools,$errors); } else { - my $allowed; - if (($env{'request.role.adv'}) || (!$hiddensupp->{$id})) { - $allowed = 1; - } elsif ($possdel) { - foreach my $item (@{$suppids->{$src}}) { - next if ($item eq $id); - unless ($hiddensupp->{$item}) { - $allowed = 1; - last; - } - } - if ((!$allowed) && (exists($env{'httpref.'.$src}))) { - &Apache::lonnet::delenv('httpref.'.$src); - } - } - if ($allowed && (!exists($env{'httpref.'.$src}))) { - &Apache::lonnet::allowuploaded('/adm/coursedoc',$src); - } - } - } - } - } - } - } - return $errors; -} - -sub set_supp_httprefs { - my ($cnum,$cdom,$supplemental,$possdel) = @_; - if (ref($supplemental) eq 'HASH') { - if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) { - foreach my $src (keys(%{$supplemental->{'ids'}})) { - next if ($src =~ /\.sequence$/); - if (ref($supplemental->{'ids'}->{$src}) eq 'ARRAY') { - my $allowed; - if ($env{'request.role.adv'}) { - $allowed = 1; - } else { - foreach my $id (@{$supplemental->{'ids'}->{$src}}) { - unless ($supplemental->{'hidden'}->{$id}) { - $allowed = 1; - last; - } - } - } - if (exists($env{'httpref.'.$src})) { - if ($possdel) { - unless ($allowed) { - &Apache::lonnet::delenv('httpref.'.$src); + if ($src =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) { + $numexttools ++; } + $numfiles ++; } - } elsif ($allowed) { - &Apache::lonnet::allowuploaded('/adm/coursedoc',$src); } } } - if ($env{'request.course.id'} eq $cdom.'_'.$cnum) { - &Apache::lonnet::appenv({'request.course.suppupdated' => time}); - } - } - } -} - -sub get_supp_parameter { - my ($resparm,$name)=@_; - return if ($resparm eq ''); - my $value=undef; - my $ptype=undef; - foreach (split('&&&',$resparm)) { - my ($thistype,$thisname,$thisvalue)=split('___',$_); - if ($thisname eq $name) { - $value=$thisvalue; - $ptype=$thistype; } } - return $value; + return ($numfiles,$numexttools,$errors); } sub symb_to_docspath { @@ -17928,71 +18156,10 @@ sub symb_to_docspath { return $path; } -sub validate_folderpath { - my ($supplementalflag,$allowed,$coursenum,$coursedom) = @_; - if ($env{'form.folderpath'} ne '') { - my @items = split(/\&/,$env{'form.folderpath'}); - my ($badpath,$changed,$got_supp,$supppath,%supphidden,%suppids); - for (my $i=0; $i<@items; $i++) { - my $odd = $i%2; - if (($odd) && (!$supplementalflag) && ($items[$i] !~ /^[^:]*:(|\d+):(|1):(|1):(|1):(|1)$/)) { - $badpath = 1; - } elsif ($odd && $supplementalflag) { - my $idx = $i-1; - if ($items[$i] =~ /^([^:]*)::(|1):::$/) { - my $esc_name = $1; - if ((!$allowed) || ($items[$idx] eq 'supplemental')) { - $supppath .= '&'.$esc_name; - $changed = 1; - } else { - $supppath .= '&'.$items[$i]; - } - } elsif (($allowed) && ($items[$idx] ne 'supplemental')) { - $changed = 1; - my $is_hidden; - unless ($got_supp) { - my ($supplemental) = &get_supplemental($coursenum,$coursedom); - if (ref($supplemental) eq 'HASH') { - if (ref($supplemental->{'hidden'}) eq 'HASH') { - %supphidden = %{$supplemental->{'hidden'}}; - } - if (ref($supplemental->{'ids'}) eq 'HASH') { - %suppids = %{$supplemental->{'ids'}}; - } - } - $got_supp = 1; - } - if (ref($suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}) eq 'ARRAY') { - my $mapid = $suppids{"/uploaded/$coursedom/$coursenum/$items[$idx].sequence"}->[0]; - if ($supphidden{$mapid}) { - $is_hidden = 1; - } - } - $supppath .= '&'.$items[$i].'::'.$is_hidden.':::'; - } else { - $supppath .= '&'.$items[$i]; - } - } elsif ((!$odd) && ($items[$i] !~ /^(default|supplemental)(|_\d+)$/)) { - $badpath = 1; - } elsif ($supplementalflag) { - $supppath .= '&'.$items[$i]; - } - last if ($badpath); - } - if ($badpath) { - delete($env{'form.folderpath'}); - } elsif ($changed && $supplementalflag) { - $supppath =~ s/^\&//; - $env{'form.folderpath'} = $supppath; - } - } - return; -} - sub captcha_display { my ($context,$lonhost,$defdom) = @_; my ($output,$error); - my ($captcha,$pubkey,$privkey,$version) = + my ($captcha,$pubkey,$privkey,$version) = &get_captcha_config($context,$lonhost,$defdom); if ($captcha eq 'original') { $output = &create_captcha(); @@ -18063,7 +18230,7 @@ sub get_captcha_config { $captcha = 'recaptcha'; $version = $domconfhash{$serverhomedom.'.login.recaptchaversion'}; if ($version ne '2') { - $version = 1; + $version = 1; } } else { $captcha = 'original'; @@ -18092,7 +18259,7 @@ sub get_captcha_config { $captcha = 'original'; } } - } + } return ($captcha,$pubkey,$privkey,$version); } @@ -18109,10 +18276,9 @@ sub create_captcha { if (-e $Apache::lonnet::perlvar{'lonCaptchaDir'}.'/'.$md5sum.'.png') { $output = ''."\n". - ''. &mt('Type in the letters/numbers shown below').' '. - ''. - '
'. + ''. + '
'. 'captcha'; last; } @@ -18158,8 +18324,7 @@ sub check_captcha { sub create_recaptcha { my ($pubkey,$version) = @_; if ($version >= 2) { - return '
'. - '
'; + return '
'; } else { my $use_ssl; if ($ENV{'SERVER_PORT'} == 443) { @@ -18171,22 +18336,27 @@ sub create_recaptcha { &mt('If the text is hard to read, [_1] will replace them.', 'reCAPTCHA refresh'). '

'; - } + } } sub check_recaptcha { my ($privkey,$version) = @_; my $captcha_chk; - my $ip = &Apache::lonnet::get_requestor_ip(); + my $ip = &Apache::lonnet::get_requestor_ip(); if ($version >= 2) { - my $ua = LWP::UserAgent->new; - $ua->timeout(10); my %info = ( - secret => $privkey, + secret => $privkey, response => $env{'form.g-recaptcha-response'}, remoteip => $ip, ); - my $response = $ua->post('https://www.google.com/recaptcha/api/siteverify',\%info); + my $request=new HTTP::Request('POST','https://www.google.com/recaptcha/api/siteverify'); + $request->content(join('&',map { + my $name = escape($_); + "$name=" . ( ref($info{$_}) eq 'ARRAY' + ? join("&$name=", map {escape($_) } @{$info{$_}}) + : &escape($info{$_}) ); + } keys(%info))); + my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',10,1); if ($response->is_success) { my $data = JSON::DWIW->from_json($response->decoded_content); if (ref($data) eq 'HASH') { @@ -18249,7 +18419,7 @@ sub cleanup_html { # Checks for critical messages and returns a redirect url if one exists. # $interval indicates how often to check for messages. -# $context is the calling context -- roles, grades, contents, menu or flip. +# $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 '')) { @@ -18259,7 +18429,7 @@ sub critical_redirect { if (($env{'request.course.id'}) && (($context eq 'flip') || ($context eq 'contents'))) { my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'}; my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'}; - my $blocked = &blocking_status('alert',undef,$cnum,$cdom,undef,1); + my $blocked = &blocking_status('alert',$cnum,$cdom,undef,1); if ($blocked) { my $checkrole = "cm./$cdom/$cnum"; if ($env{'request.course.sec'} ne '') { @@ -18271,18 +18441,18 @@ sub critical_redirect { } } } - my @what=&Apache::lonnet::dump('critical', $env{'user.domain'}, + 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] ne 'no_such_host') && ($what[0]!~/^error\:/)) { - $redirecturl='/adm/email?critical=display'; - my $url=&Apache::lonnet::absolute_url().$redirecturl; + 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); } } - } + } return (); } @@ -18481,7 +18651,6 @@ sub shorten_symbs { } else { foreach my $key (keys(%collisions)) { $failed->{$key} = 1; - $failed->{$key} = 1; } } } @@ -18511,9 +18680,7 @@ sub is_nonframeable { } my $uselink; my $request = new HTTP::Request('HEAD',$url); - my $ua = LWP::UserAgent->new; - $ua->timeout(5); - my $response=$ua->request($request); + my $response = &LONCAPA::LWPReq::makerequest('',$request,'','',5); if ($response->is_success()) { my $secpolicy = lc($response->header('content-security-policy')); my $xframeop = lc($response->header('x-frame-options')); @@ -18650,7 +18817,7 @@ sub page_menu { my @entries = split(/\&/,$value); foreach my $entry (@entries) { my ($name,$fields) = split(/=/,$entry); - if (($name eq 'top') || ($name eq 'inline') || ($name eq 'foot') || ($name eq 'main')) { + if (($name eq 'top') || ($name eq 'inline') || ($name eq 'main')) { $menu{$name} = $fields; } else { my @shown;