--- loncom/interface/loncommon.pm 2017/11/16 15:06:35 1.1075.2.127.2.4
+++ loncom/interface/loncommon.pm 2018/09/02 21:21:17 1.1075.2.128
@@ -1,7 +1,7 @@
# The LearningOnline Network with CAPA
# a pile of common routines
#
-# $Id: loncommon.pm,v 1.1075.2.127.2.4 2017/11/16 15:06:35 raeburn Exp $
+# $Id: loncommon.pm,v 1.1075.2.128 2018/09/02 21:21:17 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -196,7 +196,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);
@@ -217,7 +217,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);
@@ -231,7 +231,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);
@@ -245,7 +245,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);
@@ -259,7 +259,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);
@@ -274,7 +274,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);
@@ -4720,7 +4720,7 @@ sub blockcheck {
($env{'request.role'} !~ m{^st\./\Q$cdom\E/\Q$cnum\E}));
next if ($no_userblock);
- # Retrieve blocking times and identity of locker for course
+ # Retrieve blocking times and identity of blocker for course
# of specified user, unless user has 'evb' privilege.
my ($start,$end,$trigger) =
@@ -4994,87 +4994,6 @@ 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
@@ -5215,7 +5134,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);
@@ -11503,7 +11422,7 @@ sub modify_html_refs {
return;
}
}
- if (open(my $fh,"<$container")) {
+ if (open(my $fh,'<',$container)) {
$content = join('', <$fh>);
close($fh);
} else {
@@ -11568,7 +11487,7 @@ sub modify_html_refs {
}
}
} else {
- if (open(my $fh,">$container")) {
+ if (open(my $fh,'>',$container)) {
print $fh $content;
close($fh);
$output = ''.&mt('Updated [quant,_1,reference] in [_2].',
@@ -12186,8 +12105,7 @@ sub process_decompression {
if (ref($newdirlistref) eq 'ARRAY') {
foreach my $dir_line (@{$newdirlistref}) {
my ($item,undef,undef,$testdir)=split(/\&/,$dir_line,5);
- unless (($item =~ /^\.+$/) || ($item eq $file) ||
- ((@to_skip > 0) && (grep(/^\Q$item\E$/,@to_skip)))) {
+ unless (($item =~ /^\.+$/) || ($item eq $file)) {
push(@newitems,$item);
if ($dirptr&$testdir) {
$is_dir{$item} = 1;
@@ -12775,7 +12693,7 @@ sub process_extracted_files {
$newseqid{$i} = $newidx;
unless ($errtext) {
$result .= '
'.&mt('Folder: [_1] added to course',
- &HTML::Entities::encode($docstitle,'<>&"')).
+ &HTML::Entities::encode($docstitle,'<>&"'))..
''."\n";
}
}
@@ -12800,7 +12718,7 @@ sub process_extracted_files {
$fetch =~ s/^\Q$prefix$dir\E//;
$prompttofetch{$fetch} = 1;
}
- }
+ }
}
$LONCAPA::map::resources[$newidx]=
$docstitle.':'.$url.':false:normal:res';
@@ -12900,11 +12818,11 @@ sub process_extracted_files {
$result .= ''.&mt('[_1] included as a dependency',
&HTML::Entities::encode($showpath,'<>&"')).
''."\n";
- }
- unless ($ishome) {
- my $fetch = "$fullpath/$title";
- $fetch =~ s/^\Q$prefix$dir\E//;
- $prompttofetch{$fetch} = 1;
+ unless ($ishome) {
+ my $fetch = "$fullpath/$title";
+ $fetch =~ s/^\Q$prefix$dir\E//;
+ $prompttofetch{$fetch} = 1;
+ }
}
}
}
@@ -13191,13 +13109,14 @@ sub upfile_store {
$env{'form.upfile'}=~s/\n+$//gs;
my $datatoken = &valid_datatoken($env{'user.name'}.'_'.$env{'user.domain'}.
- '_enroll_'.$env{'request.course.id'}.'_'.
+ '_enroll_'.$env{'request.course.id'}.'_'.
time.'_'.$$);
return if ($datatoken eq '');
+
{
my $datafile = $r->dir_config('lonDaemons').
'/tmp/'.$datatoken.'.tmp';
- if ( open(my $fh,">$datafile") ) {
+ if ( open(my $fh,'>',$datafile) ) {
print $fh $env{'form.upfile'};
close($fh);
}
@@ -13222,7 +13141,7 @@ sub load_tmp_file {
{
my $studentfile = $r->dir_config('lonDaemons').
'/tmp/'.$datatoken.'.tmp';
- if ( open(my $fh,"<$studentfile") ) {
+ if ( open(my $fh,'<',$studentfile) ) {
@studentdata=<$fh>;
close($fh);
}
@@ -14126,13 +14045,6 @@ 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
@@ -14142,7 +14054,7 @@ Returns: comma separated list of address
############################################################
############################################################
sub build_recipient_list {
- my ($defmail,$mailing,$defdom,$origmail,$requname,$requdom,$reqemail) = @_;
+ my ($defmail,$mailing,$defdom,$origmail) = @_;
my @recipients;
my ($otheremails,$lastresort,$allbcc,$addtext);
my %domconfig =
@@ -14183,94 +14095,6 @@ 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;
}
@@ -15658,7 +15482,8 @@ sub init_user_environment {
my %userenv = &Apache::lonnet::dump('environment',$domain,$username);
my ($tmp) = keys(%userenv);
- if ($tmp =~ /^(con_lost|error|no_such_host)/i) {
+ if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
+ } else {
undef(%userenv);
}
if (($userenv{'interface'}) && (!$form->{'interface'})) {