--- loncom/interface/loncommon.pm 2017/03/13 21:02:21 1.1075.2.124 +++ loncom/interface/loncommon.pm 2020/05/25 18:46:14 1.1075.2.127.2.10 @@ -1,7 +1,7 @@ # The LearningOnline Network with CAPA # a pile of common routines # -# $Id: loncommon.pm,v 1.1075.2.124 2017/03/13 21:02:21 raeburn Exp $ +# $Id: loncommon.pm,v 1.1075.2.127.2.10 2020/05/25 18:46:14 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -80,6 +80,10 @@ use JSON::DWIW; use LWP::UserAgent; 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); @@ -194,7 +198,7 @@ BEGIN { { my $langtabfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/language.tab'; - if ( open(my $fh,"<$langtabfile") ) { + if ( open(my $fh,'<',$langtabfile) ) { while (my $line = <$fh>) { next if ($line=~/^\#/); chomp($line); @@ -215,7 +219,7 @@ BEGIN { { my $copyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. '/copyright.tab'; - if ( open (my $fh,"<$copyrightfile") ) { + if ( open (my $fh,'<',$copyrightfile) ) { while (my $line = <$fh>) { next if ($line=~/^\#/); chomp($line); @@ -229,7 +233,7 @@ BEGIN { { my $sourcecopyrightfile = $Apache::lonnet::perlvar{'lonIncludes'}. '/source_copyright.tab'; - if ( open (my $fh,"<$sourcecopyrightfile") ) { + if ( open (my $fh,'<',$sourcecopyrightfile) ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); @@ -243,7 +247,7 @@ BEGIN { # -------------------------------------------------------------- default domain designs my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; my $designfile = $designdir.'/default.tab'; - if ( open (my $fh,"<$designfile") ) { + if ( open (my $fh,'<',$designfile) ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); @@ -257,7 +261,7 @@ BEGIN { { my $categoryfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/filecategories.tab'; - if ( open (my $fh,"<$categoryfile") ) { + if ( open (my $fh,'<',$categoryfile) ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); @@ -272,7 +276,7 @@ BEGIN { { my $typesfile = $Apache::lonnet::perlvar{'lonTabDir'}. '/filetypes.tab'; - if ( open (my $fh,"<$typesfile") ) { + if ( open (my $fh,'<',$typesfile) ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); @@ -4612,7 +4616,8 @@ sub blockcheck { # boards, chat or groups, check for blocking in current course only. if (($activity eq 'boards' || $activity eq 'chat' || - $activity eq 'groups' || $activity eq 'printout') && + $activity eq 'groups' || $activity eq 'printout' || + $activity eq 'reinit' || $activity eq 'alert') && ($env{'request.course.id'})) { foreach my $key (keys(%live_courses)) { if ($key ne $env{'request.course.id'}) { @@ -4923,6 +4928,10 @@ END_MYBLOCK $text = &mt('Printing Blocked'); } elsif ($activity eq 'passwd') { $text = &mt('Password Changing Blocked'); + } elsif ($activity eq 'alert') { + $text = &mt('Checking Critical Messages Blocked'); + } elsif ($activity eq 'reinit') { + $text = &mt('Checking Course Update Blocked'); } $output .= <<"END_BLOCK";
@@ -4992,6 +5001,87 @@ sub check_ip_acc { return $allowed; } +sub check_slotip_acc { + my ($acc,$clientip)=@_; + &Apache::lonxml::debug("acc is $acc"); + if (!defined($acc) || $acc =~ /^\s*$/ || $acc =~/^\s*no\s*$/i) { + return 1; + } + my $allowed; + my $ip=$ENV{'REMOTE_ADDR'} || $clientip || $env{'request.host'}; + + my $name; + my %access = ( + allowfrom => 1, + denyfrom => 0, + ); + my @allows; + my @denies; + foreach my $item (split(',',$acc)) { + $item =~ s/^\s*//; + $item =~ s/\s*$//; + my $pattern; + 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'; + } + if ($pattern =~ /\*$/) { + #35.8.* + $pattern=~s/\*//; + if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } + } elsif ($pattern =~ /(\d+\.\d+\.\d+)\.\[(\d+)-(\d+)\]$/) { + #35.8.3.[34-56] + my $low=$2; + my $high=$3; + $pattern=$1; + if ($ip =~ /^\Q$pattern\E/) { + my $last=(split(/\./,$ip))[3]; + if ($last <=$high && $last >=$low) { $allowed=$access{$acctype}; } + } + } elsif ($pattern =~ /^\*/) { + #*.msu.edu + $pattern=~s/\*//; + if (!defined($name)) { + use Socket; + my $netaddr=inet_aton($ip); + ($name)=gethostbyaddr($netaddr,AF_INET); + } + if ($name =~ /\Q$pattern\E$/i) { $allowed=$access{$acctype}; } + } elsif ($pattern =~ /\d+\.\d+\.\d+\.\d+/) { + #127.0.0.1 + if ($ip =~ /^\Q$pattern\E/) { $allowed=$access{$acctype}; } + } else { + #some.name.com + if (!defined($name)) { + use Socket; + 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; + } + } + return $allowed; +} + ############################################### =pod @@ -5132,7 +5222,7 @@ sub get_legacy_domconf { my $designdir=$Apache::lonnet::perlvar{'lonTabDir'}.'/lonDomColors'; my $designfile = $designdir.'/'.$udom.'.tab'; if (-e $designfile) { - if ( open (my $fh,"<$designfile") ) { + if ( open (my $fh,'<',$designfile) ) { while (my $line = <$fh>) { next if ($line =~ /^\#/); chomp($line); @@ -7897,6 +7987,7 @@ OFFLOAD '; } + $result .= ''."\n"; return $result.''; } @@ -9574,7 +9665,7 @@ sub get_secgrprole_info { } sub user_picker { - my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom) = @_; + my ($dom,$srch,$forcenewuser,$caller,$cancreate,$usertype,$context,$fixeddom,$noinstd) = @_; my $currdom = $dom; my @alldoms = &Apache::lonnet::all_domains(); if (@alldoms == 1) { @@ -9639,10 +9730,12 @@ sub user_picker { &html_escape(\%html_lt); &js_escape(\%js_lt); my $domform; + my $allow_blank = 1; if ($fixeddom) { - $domform = &select_dom_form($currdom,'srchdomain',1,1,undef,[$currdom]); + $allow_blank = 0; + $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1,undef,[$currdom]); } else { - $domform = &select_dom_form($currdom,'srchdomain',1,1); + $domform = &select_dom_form($currdom,'srchdomain',$allow_blank,1); } my $srchinsel = '