--- loncom/lonnet/perl/lonnet.pm 2017/08/27 17:49:49 1.1354 +++ loncom/lonnet/perl/lonnet.pm 2017/11/13 00:49:31 1.1359 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1354 2017/08/27 17:49:49 raeburn Exp $ +# $Id: lonnet.pm,v 1.1359 2017/11/13 00:49:31 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -146,7 +146,7 @@ our @EXPORT = qw(%env); sub logtouch { my $execdir=$perlvar{'lonDaemons'}; unless (-e "$execdir/logs/lonnet.log") { - open(my $fh,">>$execdir/logs/lonnet.log"); + open(my $fh,">>","$execdir/logs/lonnet.log"); close $fh; } my ($wwwuid,$wwwgid)=(getpwnam('www'))[2,3]; @@ -158,7 +158,7 @@ sub logthis { my $execdir=$perlvar{'lonDaemons'}; my $now=time; my $local=localtime($now); - if (open(my $fh,">>$execdir/logs/lonnet.log")) { + if (open(my $fh,">>","$execdir/logs/lonnet.log")) { my $logstring = $local. " ($$): ".$message."\n"; # Keep any \'s in string. print $fh $logstring; close($fh); @@ -171,7 +171,7 @@ sub logperm { my $execdir=$perlvar{'lonDaemons'}; my $now=time; my $local=localtime($now); - if (open(my $fh,">>$execdir/logs/lonnet.perm.log")) { + if (open(my $fh,">>","$execdir/logs/lonnet.perm.log")) { print $fh "$now:$message:$local\n"; close($fh); } @@ -485,7 +485,7 @@ sub reconlonc { &logthis("Trying to reconnect lonc"); my $loncfile="$perlvar{'lonDaemons'}/logs/lonc.pid"; - if (open(my $fh,"<$loncfile")) { + if (open(my $fh,"<",$loncfile)) { my $loncpid=<$fh>; chomp($loncpid); if (kill 0 => $loncpid) { @@ -525,7 +525,7 @@ sub critical { $dumpcount++; { my $dfh; - if (open($dfh,">$dfilename")) { + if (open($dfh,">",$dfilename)) { print $dfh "$cmd\n"; close($dfh); } @@ -534,7 +534,7 @@ sub critical { my $wcmd=''; { my $dfh; - if (open($dfh,"<$dfilename")) { + if (open($dfh,"<",$dfilename)) { $wcmd=<$dfh>; close($dfh); } @@ -650,7 +650,7 @@ sub transfer_profile_to_env { # ---------------------------------------------------- Check for valid session sub check_for_valid_session { - my ($r,$name,$userhashref) = @_; + my ($r,$name,$userhashref,$domref) = @_; my %cookies=CGI::Cookie->parse($r->header_in('Cookie')); my ($linkname,$pubname); if ($name eq '') { @@ -678,7 +678,16 @@ sub check_for_valid_session { } else { $lonidsdir=$r->dir_config('lonIDsDir'); } - return undef if (!-e "$lonidsdir/$handle.id"); + if (!-e "$lonidsdir/$handle.id") { + if ((ref($domref)) && ($name eq 'lonID') && + ($handle =~ /^($match_username)\_\d+\_($match_domain)\_(.+)$/)) { + my ($possuname,$possudom,$possuhome) = ($1,$2,$3); + if ((&domain($possudom) ne '') && (&homeserver($possuname,$possudom) eq $possuhome)) { + $$domref = $possudom; + } + } + return undef; + } my $opened = open(my $idf,'+<',"$lonidsdir/$handle.id"); return undef if (!$opened); @@ -2085,6 +2094,16 @@ sub inst_directory_query { my $homeserver = &domain($udom,'primary'); my $outcome; if ($homeserver ne '') { + unless ($homeserver eq $perlvar{'lonHostID'}) { + if ($srch->{'srchby'} eq 'email') { + my $lcrev = &get_server_loncaparev(undef,$homeserver); + my ($major,$minor) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/); + if (($major eq '' && $minor eq '') || ($major < 2) || + (($major == 2) && ($minor < 12))) { + return; + } + } + } my $queryid=&reply("querysend:instdirsearch:". &escape($srch->{'srchby'}).':'. &escape($srch->{'srchterm'}).':'. @@ -2126,6 +2145,14 @@ sub usersearch { my $query = 'usersearch'; foreach my $tryserver (keys(%libserv)) { if (&host_domain($tryserver) eq $dom) { + unless ($tryserver eq $perlvar{'lonHostID'}) { + if ($srch->{'srchby'} eq 'email') { + my $lcrev = &get_server_loncaparev(undef,$tryserver); + my ($major,$minor) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?$/); + next if (($major eq '' && $minor eq '') || ($major < 2) || + (($major == 2) && ($minor < 12))); + } + } my $host=&hostname($tryserver); my $queryid= &reply("querysend:".&escape($query).':'. @@ -2444,6 +2471,9 @@ sub get_domain_defaults { } elsif ($domconfig{'coursedefaults'}{'canclone'}) { $domdefaults{'canclone'}=$domconfig{'coursedefaults'}{'canclone'}; } + if ($domconfig{'coursedefaults'}{'texengine'}) { + $domdefaults{'texengine'} = $domconfig{'coursedefaults'}{'texengine'}; + } } if (ref($domconfig{'usersessions'}) eq 'HASH') { if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') { @@ -3585,7 +3615,7 @@ sub process_coursefile { $home); } } elsif ($action eq 'uploaddoc') { - open(my $fh,'>'.$filepath.'/'.$fname); + open(my $fh,'>',$filepath.'/'.$fname); print $fh $env{'form.'.$source}; close($fh); if ($parser eq 'parse') { @@ -3643,7 +3673,7 @@ sub store_edited_file { ($fpath,$fname) = ($file =~ m|^(.*)/([^/]+)$|); $fpath=$docudom.'/'.$docuname.'/'.$fpath; my $filepath = &build_filepath($fpath); - open(my $fh,'>'.$filepath.'/'.$fname); + open(my $fh,'>',$filepath.'/'.$fname); print $fh $content; close($fh); my $home=&homeserver($docuname,$docudom); @@ -3794,7 +3824,7 @@ sub userfileupload { mkdir($fullpath,0777); } } - open(my $fh,'>'.$fullpath.'/'.$fname); + open(my $fh,'>',$fullpath.'/'.$fname); print $fh $env{'form.'.$formname}; close($fh); if ($context eq 'existingfile') { @@ -3869,7 +3899,7 @@ sub finishuserfileupload { # Save the file { - if (!open(FH,'>'.$filepath.'/'.$file)) { + if (!open(FH,'>',$filepath.'/'.$file)) { &logthis('Failed to create '.$filepath.'/'.$file); print STDERR ('Failed to create '.$filepath.'/'.$file."\n"); return '/adm/notfound.html'; @@ -3927,7 +3957,8 @@ sub finishuserfileupload { my $input = $filepath.'/'.$file; my $output = $filepath.'/'.'tn-'.$file; my $thumbsize = $thumbwidth.'x'.$thumbheight; - system("convert -sample $thumbsize $input $output"); + my @args = ('convert','-sample',$thumbsize,$input,$output); + system({$args[0]} @args); if (-e $filepath.'/'.'tn-'.$file) { $fetchthumb = 1; } @@ -4887,7 +4918,7 @@ sub postannounce { sub getannounce { - if (open(my $fh,$perlvar{'lonDocRoot'}.'/announcement.txt')) { + if (open(my $fh,"<",$perlvar{'lonDocRoot'}.'/announcement.txt')) { my $announcement=''; while (my $line = <$fh>) { $announcement .= $line; } close($fh); @@ -8433,7 +8464,7 @@ sub fetch_enrollment_query { if ($xml_classlist =~ /^error/) { &logthis('fetch_enrollment_query - autoretrieve error: '.$xml_classlist.' for '.$filename.' from server: '.$homeserver.' '.$context.' '.$cnum); } else { - if ( open(FILE,">$destname") ) { + if ( open(FILE,">",$destname) ) { print FILE &unescape($xml_classlist); close(FILE); } else { @@ -8462,7 +8493,7 @@ sub get_query_reply { for (1..$loopmax) { sleep($sleep); if (-e $replyfile.'.end') { - if (open(my $fh,$replyfile)) { + if (open(my $fh,"<",$replyfile)) { $reply = join('',<$fh>); close($fh); } else { return 'error: reply_file_error'; } @@ -10089,7 +10120,7 @@ sub save_selected_files { my ($user, $path, @files) = @_; my $filename = $user."savedfiles"; my @other_files = &files_not_in_path($user, $path); - open (OUT, '>'.$tmpdir.$filename); + open (OUT,'>',LONCAPA::tempdir().$filename); foreach my $file (@files) { print (OUT $env{'form.currentpath'}.$file."\n"); } @@ -10103,7 +10134,7 @@ sub save_selected_files { sub clear_selected_files { my ($user) = @_; my $filename = $user."savedfiles"; - open (OUT, '>'.LONCAPA::tempdir().$filename); + open (OUT,'>',LONCAPA::tempdir().$filename); print (OUT undef); close (OUT); return ("ok"); @@ -10113,7 +10144,7 @@ sub files_in_path { my ($user, $path) = @_; my $filename = $user."savedfiles"; my %return_files; - open (IN, '<'.LONCAPA::tempdir().$filename); + open (IN,'<',LONCAPA::tempdir().$filename); while (my $line_in = ) { chomp ($line_in); my @paths_and_file = split (m!/!, $line_in); @@ -10135,7 +10166,7 @@ sub files_not_in_path { my $filename = $user."savedfiles"; my @return_files; my $path_part; - open(IN, '<'.LONCAPA::.$filename); + open(IN, '<',LONCAPA::tempdir().$filename); while (my $line = ) { #ok, I know it's clunky, but I want it to work my @paths_and_file = split(m|/|, $line); @@ -12998,7 +13029,7 @@ sub readfile { my $file = shift; if ( (! -e $file ) || ($file eq '') ) { return -1; }; my $fh; - open($fh,"<$file"); + open($fh,"<",$file); my $a=''; while (my $line = <$fh>) { $a .= $line; } return $a; @@ -13111,7 +13142,7 @@ sub machine_ids { sub additional_machine_domains { my @domains; - open(my $fh,"<$perlvar{'lonTabDir'}/expected_domains.tab"); + open(my $fh,"<","$perlvar{'lonTabDir'}/expected_domains.tab"); while( my $line = <$fh>) { $line =~ s/\s//g; push(@domains,$line); @@ -13257,7 +13288,7 @@ sub get_dns { } my %alldns; - open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); + open(my $config,"<","$perlvar{'lonTabDir'}/hosts.tab"); foreach my $dns (<$config>) { next if ($dns !~ /^\^(\S*)/x); my $line = $1; @@ -13283,7 +13314,7 @@ sub get_dns { close($config); my $which = (split('/',$url))[3]; &logthis("unable to contact DNS defaulting to on disk file dns_$which.tab\n"); - open($config,"<$perlvar{'lonTabDir'}/dns_$which.tab"); + open($config,"<","$perlvar{'lonTabDir'}/dns_$which.tab"); my @content = <$config>; &$func(\@content,$hashref); return; @@ -13376,7 +13407,7 @@ sub fetch_dns_checksums { my ($ignore_cache,$nocache) = @_; &get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache,$nocache); my $fh; - if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) { + if (open($fh,"<",$perlvar{'lonTabDir'}.'/domain.tab')) { my @lines = <$fh>; &parse_domain_tab(\@lines); } @@ -13478,7 +13509,7 @@ sub fetch_dns_checksums { sub load_hosts_tab { my ($ignore_cache,$nocache) = @_; &get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache,$nocache); - open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); + open(my $config,"<","$perlvar{'lonTabDir'}/hosts.tab"); my @config = <$config>; &parse_hosts_tab(\@config); close($config); @@ -13749,7 +13780,7 @@ sub all_loncaparevs { { sub load_loncaparevs { if (-e "$perlvar{'lonTabDir'}/loncaparevs.tab") { - if (open(my $config,"<$perlvar{'lonTabDir'}/loncaparevs.tab")) { + if (open(my $config,"<","$perlvar{'lonTabDir'}/loncaparevs.tab")) { while (my $configline=<$config>) { chomp($configline); my ($hostid,$loncaparev)=split(/:/,$configline); @@ -13765,7 +13796,7 @@ sub all_loncaparevs { { sub load_serverhomeIDs { if (-e "$perlvar{'lonTabDir'}/serverhomeIDs.tab") { - if (open(my $config,"<$perlvar{'lonTabDir'}/serverhomeIDs.tab")) { + if (open(my $config,"<","$perlvar{'lonTabDir'}/serverhomeIDs.tab")) { while (my $configline=<$config>) { chomp($configline); my ($name,$id)=split(/:/,$configline); @@ -13790,7 +13821,7 @@ BEGIN { # ------------------------------------------------------ Read spare server file { - open(my $config,"<$perlvar{'lonTabDir'}/spare.tab"); + open(my $config,"<","$perlvar{'lonTabDir'}/spare.tab"); while (my $configline=<$config>) { chomp($configline); @@ -13804,7 +13835,7 @@ BEGIN { } # ------------------------------------------------------------ Read permissions { - open(my $config,"<$perlvar{'lonTabDir'}/roles.tab"); + open(my $config,"<","$perlvar{'lonTabDir'}/roles.tab"); while (my $configline=<$config>) { chomp($configline); @@ -13818,7 +13849,7 @@ BEGIN { # -------------------------------------------- Read plain texts for permissions { - open(my $config,"<$perlvar{'lonTabDir'}/rolesplain.tab"); + open(my $config,"<","$perlvar{'lonTabDir'}/rolesplain.tab"); while (my $configline=<$config>) { chomp($configline); @@ -13838,7 +13869,7 @@ BEGIN { # ---------------------------------------------------------- Read package table { - open(my $config,"<$perlvar{'lonTabDir'}/packages.tab"); + open(my $config,"<","$perlvar{'lonTabDir'}/packages.tab"); while (my $configline=<$config>) { if ($configline !~ /\S/ || $configline=~/^#/) { next; } @@ -13892,7 +13923,7 @@ BEGIN { # ---------------------------------------------------------- Read managers table { if (-e "$perlvar{'lonTabDir'}/managers.tab") { - if (open(my $config,"<$perlvar{'lonTabDir'}/managers.tab")) { + if (open(my $config,"<","$perlvar{'lonTabDir'}/managers.tab")) { while (my $configline=<$config>) { chomp($configline); next if ($configline =~ /^\#/);