version 1.1288, 2015/06/12 21:11:20
|
version 1.1295, 2015/10/26 16:03:42
|
Line 92 use GDBM_File;
|
Line 92 use GDBM_File;
|
use HTML::LCParser; |
use HTML::LCParser; |
use Fcntl qw(:flock); |
use Fcntl qw(:flock); |
use Storable qw(thaw nfreeze); |
use Storable qw(thaw nfreeze); |
use Time::HiRes qw( gettimeofday tv_interval ); |
use Time::HiRes qw( sleep gettimeofday tv_interval ); |
use Cache::Memcached; |
use Cache::Memcached; |
use Digest::MD5; |
use Digest::MD5; |
use Math::Random; |
use Math::Random; |
Line 101 use LONCAPA qw(:DEFAULT :match);
|
Line 101 use LONCAPA qw(:DEFAULT :match);
|
use LONCAPA::Configuration; |
use LONCAPA::Configuration; |
use LONCAPA::lonmetadata; |
use LONCAPA::lonmetadata; |
use LONCAPA::Lond; |
use LONCAPA::Lond; |
use Time::HiRes qw(sleep); |
|
|
|
use File::Copy; |
use File::Copy; |
|
|
Line 376 sub subreply {
|
Line 375 sub subreply {
|
|
|
my $lockfile=$peerfile.".lock"; |
my $lockfile=$peerfile.".lock"; |
while (-e $lockfile) { # Need to wait for the lockfile to disappear. |
while (-e $lockfile) { # Need to wait for the lockfile to disappear. |
Time::HiRes::sleep(0.1); |
sleep(0.1); |
} |
} |
# At this point, either a loncnew parent is listening or an old lonc |
# At this point, either a loncnew parent is listening or an old lonc |
# or loncnew child is listening so we can connect or everything's dead. |
# or loncnew child is listening so we can connect or everything's dead. |
Line 394 sub subreply {
|
Line 393 sub subreply {
|
} else { |
} else { |
&create_connection(&hostname($server),$server); |
&create_connection(&hostname($server),$server); |
} |
} |
Time::HiRes::sleep(0.1); # Try again later if failed connection. |
sleep(0.1); # Try again later if failed connection. |
} |
} |
my $answer; |
my $answer; |
if ($client) { |
if ($client) { |
Line 423 sub reply {
|
Line 422 sub reply {
|
|
|
sub reconlonc { |
sub reconlonc { |
my ($lonid) = @_; |
my ($lonid) = @_; |
my $hostname = &hostname($lonid); |
|
if ($lonid) { |
if ($lonid) { |
|
my $hostname = &hostname($lonid); |
my $peerfile="$perlvar{'lonSockDir'}/$hostname"; |
my $peerfile="$perlvar{'lonSockDir'}/$hostname"; |
if ($hostname && -e $peerfile) { |
if ($hostname && -e $peerfile) { |
&logthis("Trying to reconnect lonc for $lonid ($hostname)"); |
&logthis("Trying to reconnect lonc for $lonid ($hostname)"); |
Line 449 sub reconlonc {
|
Line 448 sub reconlonc {
|
&logthis("lonc at pid $loncpid responding, sending USR1"); |
&logthis("lonc at pid $loncpid responding, sending USR1"); |
kill USR1 => $loncpid; |
kill USR1 => $loncpid; |
sleep 1; |
sleep 1; |
} else { |
} else { |
&logthis( |
&logthis( |
"<font color=\"blue\">WARNING:". |
"<font color=\"blue\">WARNING:". |
" lonc at pid $loncpid not responding, giving up</font>"); |
" lonc at pid $loncpid not responding, giving up</font>"); |
Line 470 sub critical {
|
Line 469 sub critical {
|
} |
} |
my $answer=reply($cmd,$server); |
my $answer=reply($cmd,$server); |
if ($answer eq 'con_lost') { |
if ($answer eq 'con_lost') { |
&reconlonc("$perlvar{'lonSockDir'}/$server"); |
&reconlonc($server); |
my $answer=reply($cmd,$server); |
my $answer=reply($cmd,$server); |
if ($answer eq 'con_lost') { |
if ($answer eq 'con_lost') { |
my $now=time; |
my $now=time; |
Line 1940 sub get_instuser {
|
Line 1939 sub get_instuser {
|
return ($outcome,%userinfo); |
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 { |
sub inst_rulecheck { |
my ($udom,$uname,$id,$item,$rules) = @_; |
my ($udom,$uname,$id,$item,$rules) = @_; |
my %returnhash; |
my %returnhash; |
Line 7330 sub get_commblock_resources {
|
Line 7386 sub get_commblock_resources {
|
} |
} |
} |
} |
} |
} |
if ($interval[0] =~ /^\d+$/) { |
if ($interval[0] =~ /^\d+/) { |
|
my ($timelimit) = split(/_/,$interval[0]); |
my $first_access; |
my $first_access; |
if ($type eq 'resource') { |
if ($type eq 'resource') { |
$first_access=&get_first_access($interval[1],$item); |
$first_access=&get_first_access($interval[1],$item); |
Line 7340 sub get_commblock_resources {
|
Line 7397 sub get_commblock_resources {
|
$first_access=&get_first_access($interval[1]); |
$first_access=&get_first_access($interval[1]); |
} |
} |
if ($first_access) { |
if ($first_access) { |
my $timesup = $first_access+$interval[0]; |
my $timesup = $first_access+$timelimit; |
if ($timesup > $now) { |
if ($timesup > $now) { |
my $activeblock; |
my $activeblock; |
foreach my $res (@to_test) { |
foreach my $res (@to_test) { |
Line 7679 sub get_query_reply {
|
Line 7736 sub get_query_reply {
|
my $replyfile=LONCAPA::tempdir().$queryid; |
my $replyfile=LONCAPA::tempdir().$queryid; |
my $reply=''; |
my $reply=''; |
for (1..100) { |
for (1..100) { |
Time::HiRes::sleep(0.2); |
sleep(0.2); |
if (-e $replyfile.'.end') { |
if (-e $replyfile.'.end') { |
if (open(my $fh,$replyfile)) { |
if (open(my $fh,$replyfile)) { |
$reply = join('',<$fh>); |
$reply = join('',<$fh>); |
Line 9524 sub modify_access_controls {
|
Line 9581 sub modify_access_controls {
|
|
|
while (($gotlock ne 'ok') && $tries < 10) { |
while (($gotlock ne 'ok') && $tries < 10) { |
$tries ++; |
$tries ++; |
Time::HiRes::sleep(0.1); |
sleep(0.1); |
$gotlock = &newput('file_permissions',$lockhash,$domain,$user); |
$gotlock = &newput('file_permissions',$lockhash,$domain,$user); |
} |
} |
if ($gotlock eq 'ok') { |
if ($gotlock eq 'ok') { |
Line 10117 sub get_userresdata {
|
Line 10174 sub get_userresdata {
|
} |
} |
#error 2 occurs when the .db doesn't exist |
#error 2 occurs when the .db doesn't exist |
if ($tmp!~/error: 2 /) { |
if ($tmp!~/error: 2 /) { |
&logthis("<font color=\"blue\">WARNING:". |
if ((!defined($cached)) || ($tmp ne 'con_lost')) { |
" Trying to get resource data for ". |
&logthis("<font color=\"blue\">WARNING:". |
$uname." at ".$udom.": ". |
" Trying to get resource data for ". |
$tmp."</font>"); |
$uname." at ".$udom.": ". |
|
$tmp."</font>"); |
|
} |
} elsif ($tmp=~/error: 2 /) { |
} elsif ($tmp=~/error: 2 /) { |
#&EXT_cache_set($udom,$uname); |
#&EXT_cache_set($udom,$uname); |
&do_cache_new('userres',$hashid,undef,600); |
&do_cache_new('userres',$hashid,undef,600); |
Line 12338 sub fetch_dns_checksums {
|
Line 12397 sub fetch_dns_checksums {
|
} |
} |
|
|
sub load_domain_tab { |
sub load_domain_tab { |
my ($ignore_cache) = @_; |
my ($ignore_cache,$nocache) = @_; |
&get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache); |
&get_dns('/adm/dns/domain',\&parse_domain_tab,$ignore_cache,$nocache); |
my $fh; |
my $fh; |
if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) { |
if (open($fh,"<".$perlvar{'lonTabDir'}.'/domain.tab')) { |
my @lines = <$fh>; |
my @lines = <$fh>; |
Line 12425 sub fetch_dns_checksums {
|
Line 12484 sub fetch_dns_checksums {
|
} |
} |
|
|
sub load_hosts_tab { |
sub load_hosts_tab { |
my ($ignore_cache) = @_; |
my ($ignore_cache,$nocache) = @_; |
&get_dns('/adm/dns/hosts',\&parse_hosts_tab,$ignore_cache); |
&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>; |
my @config = <$config>; |
&parse_hosts_tab(\@config); |
&parse_hosts_tab(\@config); |
Line 12448 sub fetch_dns_checksums {
|
Line 12507 sub fetch_dns_checksums {
|
} |
} |
|
|
sub all_names { |
sub all_names { |
&load_hosts_tab() if (!$loaded); |
my ($ignore_cache,$nocache) = @_; |
|
&load_hosts_tab($ignore_cache,$nocache) if (!$loaded); |
|
|
return %name_to_host; |
return %name_to_host; |
} |
} |
Line 12570 sub fetch_dns_checksums {
|
Line 12630 sub fetch_dns_checksums {
|
} |
} |
|
|
sub get_iphost { |
sub get_iphost { |
my ($ignore_cache) = @_; |
my ($ignore_cache,$nocache) = @_; |
|
|
if (!$ignore_cache) { |
if (!$ignore_cache) { |
if (%iphost) { |
if (%iphost) { |
Line 12594 sub fetch_dns_checksums {
|
Line 12654 sub fetch_dns_checksums {
|
%old_name_to_ip = %{$ip_info->[1]}; |
%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)) { |
foreach my $name (keys(%name_to_host)) { |
my $ip; |
my $ip; |
if (!exists($name_to_ip{$name})) { |
if (!exists($name_to_ip{$name})) { |
Line 12619 sub fetch_dns_checksums {
|
Line 12679 sub fetch_dns_checksums {
|
} |
} |
push(@{$iphost{$ip}},@{$name_to_host{$name}}); |
push(@{$iphost{$ip}},@{$name_to_host{$name}}); |
} |
} |
&do_cache_new('iphost','iphost', |
unless ($nocache) { |
[\%iphost,\%name_to_ip,\%lonid_to_ip], |
&do_cache_new('iphost','iphost', |
48*60*60); |
[\%iphost,\%name_to_ip,\%lonid_to_ip], |
|
48*60*60); |
|
} |
|
|
return %iphost; |
return %iphost; |
} |
} |