--- loncom/interface/loncommon.pm 2020/07/18 19:14:03 1.1075.2.141.2.4 +++ loncom/interface/loncommon.pm 2020/03/05 21:54:44 1.1075.2.144 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.141.2.4 2020/07/18 19:14:03 raeburn Exp $ +# $Id: loncommon.pm,v 1.1075.2.144 2020/03/05 21:54:44 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -83,8 +83,6 @@ use Crypt::DES; use DynaLoader; # for Crypt::DES version use File::Copy(); use File::Path(); -use String::CRC32(); -use Short::URL(); # ---------------------------------------------- Designs use vars qw(%defaultdesign); @@ -5037,7 +5035,8 @@ sub check_ip_acc { if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { return 1; } - my ($ip,$allowed); + my $allowed=0; + my $ip; 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; @@ -5046,34 +5045,13 @@ sub check_ip_acc { } my $name; - my %access = ( - allowfrom => 1, - denyfrom => 0, - ); - my @allows; - my @denies; - foreach my $item (split(',',$acc)) { - $item =~ s/^\s*//; - $item =~ s/\s*$//; - if ($item =~ /^\!(.+)$/) { - push(@denies,$1); - } else { - push(@allows,$item); - } - } - my $numdenies = scalar(@denies); - my $numallows = scalar(@allows); - my $count = 0; - foreach my $pattern (@denies,@allows) { - $count ++; - my $acctype = 'allowfrom'; - if ($count <= $numdenies) { - $acctype = 'denyfrom'; - } + foreach my $pattern (split(',',$acc)) { + $pattern =~ s/^\s*//; + $pattern =~ s/\s*$//; if ($pattern =~ /\*$/) { #35.8.* $pattern=~s/\*//; - if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } + if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) { #35.8.3.[34-56] my $low=$2; @@ -5081,7 +5059,7 @@ sub check_ip_acc { $pattern=$1; if ($ip =~ /^\Q$pattern\E/) { my $last=(split(/\./,$ip))[3]; - if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; } + if ($last <=$high && $last >=$low) { $allowed=1; } } } elsif ($pattern =~ /^\*/) { #*.msu.edu @@ -5091,10 +5069,10 @@ sub check_ip_acc { my $netaddr=inet_aton($ip); ($name)=gethostbyaddr($netaddr,AF_INET); } - if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; } + if ($name =~ /\Q$pattern\E$/i) { $allowed=1; } } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) { #127.0.0.1 - if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } + if ($ip =~ /^\Q$pattern\E/) { $allowed=1; } } else { #some.name.com if (!defined($name)) { @@ -5102,16 +5080,9 @@ sub check_ip_acc { my $netaddr=inet_aton($ip); ($name)=gethostbyaddr($netaddr,AF_INET); } - if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; } - } - if ($allowed =~ /^(0|1)$/) { last; } - } - if ($allowed eq '') { - if ($numdenies && !$numallows) { - $allowed = 1; - } else { - $allowed = 0; + if ($name =~ /\Q$pattern\E$/i) { $allowed=1; } } + if ($allowed) { last; } } return $allowed; } @@ -7956,85 +7927,43 @@ 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; if (ref($domdefs{'offloadnow'}) eq 'HASH') { + my $lonhost = $Apache::lonnet::perlvar{'lonHostID'}; if ($domdefs{'offloadnow'}{$lonhost}) { - $offload = 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; - $dom_in_use = $env{'user.domain'}; - } + 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(); } - } - } - } - if ($offload) { - 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(); - } - 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 { - $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'}; + my $disable_submit = 0; + if ($requrl =~ /$LONCAPA::assess_re/) { + $disable_submit = 1; } - 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 ($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".'); + } else { + if (($requrl =~ m{^/res/}) && ($env{'form.submitted'} =~ /^part_/)) { + $msg = &mt('Your LON-CAPA submission has been recorded')."\\n"; } - if ($shownsymb) { - &js_escape(\$shownsymb); - $newurl .= '&symb='.$shownsymb; + $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'}) { + $newurl .= '&symb='.$env{'request.symb'}; + } else { + $newurl .= '&origurl='.$requrl; } - } else { - my $shownurl = &Apache::lonenc::check_encrypt($requrl); - &js_escape(\$shownurl); - $newurl .= '&origurl='.$shownurl; } - } - &js_escape(\$msg); - $result.=< OFFLOAD + } } } } @@ -15539,17 +15469,12 @@ 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 => $opendate, + my %storecontent = ($storeunder => time, $storeunder.'.type' => 'date_start'); - $outcome .= &mt('All assignments open starting [_1]', - &Apache::lonlocal::locallocaltime($opendate)).': '. - &Apache::lonnet::cput - ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed; + + $outcome .= &mt('Opening all assignments').': '.&Apache::lonnet::cput + ('resourcedata',\%storecontent,$$crsudom,$$crsunum).$linefeed; } # # Set first page @@ -17253,131 +17178,6 @@ sub des_decrypt { return $plaintext; } -sub make_short_symbs { - my ($cdom,$cnum,$navmap) = @_; - return unless (ref($navmap)); - 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)) { - foreach my $item (sort {$a <=> $b} (@toshorten)) { - my $symb = $resources{$item}; - if ($symb) { - $tocreate{$cnum.'&'.$symb} = 1; - } - } - } - if (keys(%tocreate)) { - my %coursetiny = &Apache::lonnet::dump('tiny',$cdom,$cnum); - my $su = Short::URL->new(no_vowels => 1); - my $init = ''; - my (%newunique,%addcourse,%courseonly,%failed); - # get lock on tiny db - my $now = time; - my $lockhash = { - "lock\0$now" => $env{'user.name'}. - ':'.$env{'user.domain'}, - }; - my $tries = 0; - my $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom); - my ($code,$error); - while (($gotlock ne 'ok') && ($tries<3)) { - $tries ++; - sleep 1; - $gotlock = &Apache::lonnet::newput_dom('tiny',$lockhash,$cdom); - } - if ($gotlock eq 'ok') { - $init = &shorten_symbs($cdom,$init,$su,\%coursetiny,\%tocreate,\%newunique, - \%addcourse,\%courseonly,\%failed); - if (keys(%failed)) { - my $numfailed = scalar(keys(%failed)); - push(@errors,&mt('error: could not obtain unique six character URL for [quant,_1,resource]',$numfailed)); - } - if (keys(%newunique)) { - my $putres = &Apache::lonnet::newput_dom('tiny',\%newunique,$cdom); - if ($putres eq 'ok') { - $numnew = scalar(keys(%newunique)); - my $newputres = &Apache::lonnet::newput('tiny',\%addcourse,$cdom,$cnum); - unless ($newputres eq 'ok') { - push(@errors,&mt('error: could not store course look-up of short URLs')); - } - } else { - push(@errors,&mt('error: could not store unique six character URLs')); - } - } - } - } - } - return ($numnew,\@errors); -} - -sub shorten_symbs { - my ($cdom,$init,$su,$coursetiny,$tocreate,$newunique,$addcourse,$courseonly,$failed) = @_; - return unless ((ref($su)) && (ref($coursetiny) eq 'HASH') && (ref($tocreate) eq 'HASH') && - (ref($newunique) eq 'HASH') && (ref($addcourse) eq 'HASH') && - (ref($courseonly) eq 'HASH') && (ref($failed) eq 'HASH')); - my (%possibles,%collisions); - foreach my $key (keys(%{$tocreate})) { - my $num = String::CRC32::crc32($key); - my $tiny = $su->encode($num,$init); - if ($tiny) { - $possibles{$tiny} = $key; - } - } - if (!$init) { - $init = 1; - } else { - $init ++; - } - if (keys(%possibles)) { - my @posstiny = keys(%possibles); - my $configuname = &Apache::lonnet::get_domainconfiguser($cdom); - my %currtiny = &Apache::lonnet::get('tiny',\@posstiny,$cdom,$configuname); - if (keys(%currtiny)) { - foreach my $key (keys(%currtiny)) { - next if ($currtiny{$key} eq ''); - if ($currtiny{$key} eq $possibles{$key}) { - my ($tcnum,$tsymb) = split(/\&/,$currtiny{$key}); - unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) { - $courseonly->{$tsymb} = $key; - } - } else { - $collisions{$possibles{$key}} = 1; - } - delete($possibles{$key}); - } - } - foreach my $key (keys(%possibles)) { - $newunique->{$key} = $possibles{$key}; - my ($tcnum,$tsymb) = split(/\&/,$possibles{$key}); - unless (($coursetiny->{$tsymb} eq $key) || ($addcourse->{$tsymb} eq $key) || ($courseonly->{$tsymb} eq $key)) { - $addcourse->{$tsymb} = $key; - } - } - } - if (keys(%collisions)) { - if ($init <5) { - if (!$init) { - $init = 1; - } else { - $init ++; - } - $init = &shorten_symbs($cdom,$init,$su,$coursetiny,\%collisions, - $newunique,$addcourse,$courseonly,$failed); - } else { - foreach my $key (keys(%collisions)) { - $failed->{$key} = 1; - $failed->{$key} = 1; - } - } - } - return $init; -} - sub is_nonframeable { my ($url,$absolute,$hostname,$ip,$nocache) = @_; my ($remprotocol,$remhost) = ($url =~ m{^(https?)\://(([a-z0-9]+(-[a-z0-9]+)*\.)+[a-z]{2,})}i);