version 1.462, 2010/11/02 10:20:35
|
version 1.469, 2011/01/20 10:55:02
|
Line 15
|
Line 15
|
# |
# |
# LON-CAPA is distributed in the hope that it will be useful, |
# LON-CAPA is distributed in the hope that it will be useful, |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
# but WITHOUT ANY WARRANTY; without even the implied warranty of |
|
|
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
# MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the |
# GNU General Public License for more details. |
# GNU General Public License for more details. |
# |
# |
Line 53 use LONCAPA::lonssl;
|
Line 54 use LONCAPA::lonssl;
|
use Fcntl qw(:flock); |
use Fcntl qw(:flock); |
use Apache::lonnet; |
use Apache::lonnet; |
|
|
my $DEBUG = 1; # Non zero to enable debug log entries. |
my $DEBUG = 0; # Non zero to enable debug log entries. |
|
|
my $status=''; |
my $status=''; |
my $lastlog=''; |
my $lastlog=''; |
Line 1121 sub establish_key_handler {
|
Line 1122 sub establish_key_handler {
|
sub load_handler { |
sub load_handler { |
my ($cmd, $tail, $replyfd) = @_; |
my ($cmd, $tail, $replyfd) = @_; |
|
|
|
|
|
|
# Get the load average from /proc/loadavg and calculate it as a percentage of |
# Get the load average from /proc/loadavg and calculate it as a percentage of |
# the allowed load limit as set by the perl global variable lonLoadLim |
# the allowed load limit as set by the perl global variable lonLoadLim |
|
|
Line 2422 sub user_has_session_handler {
|
Line 2425 sub user_has_session_handler {
|
|
|
my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail)); |
my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail)); |
|
|
&logthis("Looking for $udom $uname"); |
|
opendir(DIR,$perlvar{'lonIDsDir'}); |
opendir(DIR,$perlvar{'lonIDsDir'}); |
my $filename; |
my $filename; |
while ($filename=readdir(DIR)) { |
while ($filename=readdir(DIR)) { |
Line 4423 sub get_id_handler {
|
Line 4425 sub get_id_handler {
|
sub put_dcmail_handler { |
sub put_dcmail_handler { |
my ($cmd,$tail,$client) = @_; |
my ($cmd,$tail,$client) = @_; |
my $userinput = "$cmd:$tail"; |
my $userinput = "$cmd:$tail"; |
|
|
|
|
my ($udom,$what)=split(/:/,$tail); |
my ($udom,$what)=split(/:/,$tail); |
chomp($what); |
chomp($what); |
my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT()); |
my $hashref = &tie_domain_hash($udom, "nohist_dcmail", &GDBM_WRCREAT()); |
Line 5996 if (-e $pidfile) {
|
Line 5999 if (-e $pidfile) {
|
$server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'}, |
$server = IO::Socket::INET->new(LocalPort => $perlvar{'londPort'}, |
Type => SOCK_STREAM, |
Type => SOCK_STREAM, |
Proto => 'tcp', |
Proto => 'tcp', |
Reuse => 1, |
ReuseAddr => 1, |
Listen => 10 ) |
Listen => 10 ) |
or die "making socket: $@\n"; |
or die "making socket: $@\n"; |
|
|
Line 6393 sub make_new_child {
|
Line 6396 sub make_new_child {
|
#don't get intercepted |
#don't get intercepted |
$SIG{USR1}= \&logstatus; |
$SIG{USR1}= \&logstatus; |
$SIG{ALRM}= \&timeout; |
$SIG{ALRM}= \&timeout; |
|
# |
|
# Block sigpipe as it gets thrownon socket disconnect and we want to |
|
# deal with that as a read faiure instead. |
|
# |
|
my $blockset = POSIX::SigSet->new(SIGPIPE); |
|
sigprocmask(SIG_BLOCK, $blockset); |
|
|
$lastlog='Forked '; |
$lastlog='Forked '; |
$status='Forked'; |
$status='Forked'; |
|
|
Line 7348 sub releasereqd_check {
|
Line 7358 sub releasereqd_check {
|
my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); |
my ($reqdmajor,$reqdminor) = split(/\./,$courseinfo->{'releaserequired'}); |
return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); |
return unless (&useable_role($reqdmajor,$reqdminor,$major,$minor)); |
} |
} |
|
} else { |
|
return; |
} |
} |
} |
} |
return 1; |
return 1; |
Line 7355 sub releasereqd_check {
|
Line 7367 sub releasereqd_check {
|
|
|
sub get_courseinfo_hash { |
sub get_courseinfo_hash { |
my ($cnum,$cdom,$home) = @_; |
my ($cnum,$cdom,$home) = @_; |
my $hashid = $cdom.':'.$cnum; |
my %info; |
my %info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.'); |
eval { |
if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') { |
local($SIG{ALRM}) = sub { die "timeout\n"; }; |
return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600); |
local($SIG{__DIE__})='DEFAULT'; |
|
alarm(3); |
|
%info = &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,1,[$home],'.'); |
|
alarm(0); |
|
}; |
|
if ($@) { |
|
if ($@ eq "timeout\n") { |
|
&logthis("<font color='blue'>WARNING courseiddump for $cnum:$cdom from $home timedout</font>"); |
|
} else { |
|
&logthis("<font color='yellow'>WARNING unexpected error during eval of call for courseiddump from $home</font>"); |
|
} |
|
} else { |
|
if (ref($info{$cdom.'_'.$cnum}) eq 'HASH') { |
|
my $hashid = $cdom.':'.$cnum; |
|
return &Apache::lonnet::do_cache_new('courseinfo',$hashid,$info{$cdom.'_'.$cnum},600); |
|
} |
} |
} |
return; |
return; |
} |
} |
Line 7402 sub check_homecourses {
|
Line 7429 sub check_homecourses {
|
return; |
return; |
} |
} |
foreach my $hashid (keys(%recent)) { |
foreach my $hashid (keys(%recent)) { |
&Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600); |
my ($result,$cached)=&Apache::lonnet::is_cached_new('courseinfo',$hashid); |
|
unless ($cached) { |
|
&Apache::lonnet::do_cache_new('courseinfo',$hashid,$courseinfo{$hashid},600); |
|
} |
} |
} |
foreach my $hashid (keys(%{$homecourses})) { |
foreach my $hashid (keys(%{$homecourses})) { |
next if ($recent{$hashid}); |
next if ($recent{$hashid}); |