--- loncom/lonnet/perl/lonnet.pm 2015/05/22 18:06:13 1.1172.2.68 +++ loncom/lonnet/perl/lonnet.pm 2016/08/07 01:48:59 1.1172.2.76 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.68 2015/05/22 18:06:13 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.76 2016/08/07 01:48:59 raeburn Exp $ # # Copyright Michigan State University Board of Trustees # @@ -417,8 +417,8 @@ sub reply { sub reconlonc { my ($lonid) = @_; - my $hostname = &hostname($lonid); if ($lonid) { + my $hostname = &hostname($lonid); my $peerfile="$perlvar{'lonSockDir'}/$hostname"; if ($hostname && -e $peerfile) { &logthis("Trying to reconnect lonc for $lonid ($hostname)"); @@ -464,7 +464,7 @@ sub critical { } my $answer=reply($cmd,$server); if ($answer eq 'con_lost') { - &reconlonc("$perlvar{'lonSockDir'}/$server"); + &reconlonc($server); my $answer=reply($cmd,$server); if ($answer eq 'con_lost') { my $now=time; @@ -1283,7 +1283,7 @@ sub check_loadbalancing { my $uintdom = &Apache::lonnet::internet_dom($uprimary_id); my $intdom = &Apache::lonnet::internet_dom($lonhost); my $serverhomedom = &host_domain($lonhost); - + my $domneedscache; my $cachetime = 60*60*24; if (($uintdom ne '') && ($uintdom eq $intdom)) { @@ -1298,6 +1298,8 @@ sub check_loadbalancing { &Apache::lonnet::get_dom('configuration',['loadbalancing'],$dom_in_use); if (ref($domconfig{'loadbalancing'}) eq 'HASH') { $result = &do_cache_new('loadbalancing',$dom_in_use,$domconfig{'loadbalancing'},$cachetime); + } else { + $domneedscache = $dom_in_use; } } if (ref($result) eq 'HASH') { @@ -1356,7 +1358,9 @@ sub check_loadbalancing { my %domconfig = &Apache::lonnet::get_dom('configuration',['loadbalancing'],$serverhomedom); if (ref($domconfig{'loadbalancing'}) eq 'HASH') { - $result = &do_cache_new('loadbalancing',$dom_in_use,$domconfig{'loadbalancing'},$cachetime); + $result = &do_cache_new('loadbalancing',$serverhomedom,$domconfig{'loadbalancing'},$cachetime); + } else { + $domneedscache = $serverhomedom; } } if (ref($result) eq 'HASH') { @@ -1376,12 +1380,21 @@ sub check_loadbalancing { $is_balancer = 1; $offloadto = &this_host_spares($dom_in_use); } + unless (defined($cached)) { + $domneedscache = $serverhomedom; + } } } else { if ($perlvar{'lonBalancer'} eq 'yes') { $is_balancer = 1; $offloadto = &this_host_spares($dom_in_use); } + unless (defined($cached)) { + $domneedscache = $serverhomedom; + } + } + if ($domneedscache) { + &do_cache_new('loadbalancing',$domneedscache,$is_balancer,$cachetime); } if ($is_balancer) { my $lowest_load = 30000; @@ -1554,7 +1567,7 @@ sub idget { my %servers = &get_servers($udom,'library'); foreach my $tryserver (keys(%servers)) { - my $idlist=join('&',@ids); + my $idlist=join('&', map { &escape($_); } @ids); $idlist=~tr/A-Z/a-z/; my $reply=&reply("idget:$udom:".$idlist,$tryserver); my @answer=(); @@ -1564,7 +1577,7 @@ sub idget { my $i; for ($i=0;$i<=$#ids;$i++) { if ($answer[$i]) { - $returnhash{$ids[$i]}=$answer[$i]; + $returnhash{$ids[$i]}=&unescape($answer[$i]); } } } @@ -1793,7 +1806,7 @@ sub retrieve_inst_usertypes { sub is_domainimage { my ($url) = @_; - if ($url=~m-^/+res/+($match_domain)/+\1\-domainconfig/+(img|logo|domlogo)/+-) { + if ($url=~m-^/+res/+($match_domain)/+\1\-domainconfig/+(img|logo|domlogo)/+[^/]-) { if (&domain($1) ne '') { return '1'; } @@ -1934,6 +1947,63 @@ sub get_instuser { return ($outcome,%userinfo); } +sub get_multiple_instusers { + my ($udom,$users,$caller) = @_; + my ($outcome,$results); + if (ref($users) eq 'HASH') { + my $count = keys(%{$users}); + my $requested = &freeze_escape($users); + my $homeserver = &domain($udom,'primary'); + if ($homeserver ne '') { + my $queryid=&reply('querysend:getmultinstusers:::'.$caller.'='.$requested,$homeserver); + my $host=&hostname($homeserver); + if ($queryid !~/^\Q$host\E\_/) { + &logthis('get_multiple_instusers invalid queryid: '.$queryid. + ' for host: '.$homeserver.'in domain '.$udom); + return ($outcome,$results); + } + my $response = &get_query_reply($queryid); + my $maxtries = 5; + if ($count > 100) { + $maxtries = 1+int($count/20); + } + my $tries = 1; + while (($response=~/^timeout/) && ($tries <= $maxtries)) { + $response = &get_query_reply($queryid); + $tries ++; + } + if ($response eq '') { + $results = {}; + foreach my $key (keys(%{$users})) { + my ($uname,$id); + if ($caller eq 'id') { + $id = $key; + } else { + $uname = $key; + } + my ($resp,%info) = &get_instuser($udom,$uname,$id); + $outcome = $resp; + if ($resp eq 'ok') { + %{$results} = (%{$results}, %info); + } else { + last; + } + } + } elsif(!&error($response) && ($response ne 'refused')) { + if (($response eq 'unavailable') || ($response eq 'invalid') || ($response eq 'timeout')) { + $outcome = $response; + } else { + ($outcome,my $userdata) = split(/=/,$response,2); + if ($outcome eq 'ok') { + $results = &thaw_unescape($userdata); + } + } + } + } + } + return ($outcome,$results); +} + sub inst_rulecheck { my ($udom,$uname,$id,$item,$rules) = @_; my %returnhash; @@ -2030,7 +2100,7 @@ sub get_domain_defaults { 'requestcourses','inststatus', 'coursedefaults','usersessions', 'requestauthor','selfenrollment', - 'coursecategories'],$domain); + 'coursecategories','autoenroll'],$domain); my @coursetypes = ('official','unofficial','community','textbook'); if (ref($domconfig{'defaults'}) eq 'HASH') { $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; @@ -2155,6 +2225,9 @@ sub get_domain_defaults { $domdefaults{'catunauth'} = $domconfig{'coursecategories'}{'unauth'}; } } + if (ref($domconfig{'autoenroll'}) eq 'HASH') { + $domdefaults{'autofailsafe'} = $domconfig{'autoenroll'}{'autofailsafe'}; + } &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime); return %domdefaults; } @@ -8902,7 +8975,7 @@ sub modifyuser { sub modifystudent { my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec, $end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid, - $selfenroll,$context,$inststatus,$credits)=@_; + $selfenroll,$context,$inststatus,$credits,$instsec)=@_; if (!$cid) { unless ($cid=$env{'request.course.id'}) { return 'not_in_class'; @@ -8918,13 +8991,13 @@ sub modifystudent { $uid = undef if (!$forceid); $reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last, $gene,$usec,$end,$start,$type,$locktype, - $cid,$selfenroll,$context,$credits); + $cid,$selfenroll,$context,$credits,$instsec); return $reply; } sub modify_student_enrollment { my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type, - $locktype,$cid,$selfenroll,$context,$credits) = @_; + $locktype,$cid,$selfenroll,$context,$credits,$instsec) = @_; my ($cdom,$cnum,$chome); if (!$cid) { unless ($cid=$env{'request.course.id'}) { @@ -8971,7 +9044,7 @@ sub modify_student_enrollment { my %old_entry = &Apache::lonnet::get('classlist',[$user],$cdom,$cnum); my $reply=cput('classlist', {$user => - join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype,$credits) }, + join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype,$credits,$instsec) }, $cdom,$cnum); if (($reply eq 'ok') || ($reply eq 'delayed')) { &devalidate_getsection_cache($udom,$uname,$cid); @@ -10007,10 +10080,12 @@ sub get_userresdata { } #error 2 occurs when the .db doesn't exist if ($tmp!~/error: 2 /) { - &logthis("WARNING:". - " Trying to get resource data for ". - $uname." at ".$udom.": ". - $tmp.""); + if ((!defined($cached)) || ($tmp ne 'con_lost')) { + &logthis("WARNING:". + " Trying to get resource data for ". + $uname." at ".$udom.": ". + $tmp.""); + } } elsif ($tmp=~/error: 2 /) { #&EXT_cache_set($udom,$uname); &do_cache_new('userres',$hashid,undef,600); @@ -12227,8 +12302,8 @@ sub fetch_dns_checksums { } sub load_domain_tab { - my ($ignore_cache) = @_; - &get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache); + my ($ignore_cache,$nocache) = @_; + &get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache,$nocache); my $fh; if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) { my @lines = <$fh>; @@ -12314,8 +12389,8 @@ sub fetch_dns_checksums { } sub load_hosts_tab { - my ($ignore_cache) = @_; - &get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache); + my ($ignore_cache,$nocache) = @_; + &get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache,$nocache); open(my $config,"<$perlvar{'lonTabDir'}/hosts.tab"); my @config = <$config>; &parse_hosts_tab(\@config); @@ -12337,7 +12412,8 @@ sub fetch_dns_checksums { } sub all_names { - &load_hosts_tab() if (!$loaded); + my ($ignore_cache,$nocache) = @_; + &load_hosts_tab($ignore_cache,$nocache) if (!$loaded); return %name_to_host; } @@ -12459,7 +12535,7 @@ sub fetch_dns_checksums { } sub get_iphost { - my ($ignore_cache) = @_; + my ($ignore_cache,$nocache) = @_; if (!$ignore_cache) { if (%iphost) { @@ -12483,7 +12559,7 @@ sub fetch_dns_checksums { %old_name_to_ip = %{$ip_info->[1]}; } - my %name_to_host = &all_names(); + my %name_to_host = &all_names($ignore_cache,$nocache); foreach my $name (keys(%name_to_host)) { my $ip; if (!exists($name_to_ip{$name})) { @@ -12508,9 +12584,11 @@ sub fetch_dns_checksums { } push(@{$iphost{$ip}},@{$name_to_host{$name}}); } - &do_cache_new('iphost','iphost', - [\%iphost,\%name_to_ip,\%lonid_to_ip], - 48*60*60); + unless ($nocache) { + &do_cache_new('iphost','iphost', + [\%iphost,\%name_to_ip,\%lonid_to_ip], + 48*60*60); + } return %iphost; } @@ -13274,6 +13352,8 @@ Inputs: =item $credits, number of credits student will earn from this class +=item $instsec, institutional course section code for student + =back