version 1.1313, 2016/07/01 19:59:46
|
version 1.1324, 2016/09/21 05:15:40
|
Line 229 sub get_server_distarch {
|
Line 229 sub get_server_distarch {
|
return; |
return; |
} |
} |
|
|
|
sub get_servercerts_info { |
|
my ($lonhost,$context) = @_; |
|
my ($rep,$uselocal); |
|
if (grep { $_ eq $lonhost } ¤t_machine_ids()) { |
|
$uselocal = 1; |
|
} |
|
if (($context ne 'cgi') && ($uselocal)) { |
|
my $distro = (split(/\:/,&get_server_distarch($lonhost)))[0]; |
|
if ($distro eq '') { |
|
$uselocal = 0; |
|
} elsif ($distro =~ /^(?:centos|redhat|scientific)(\d+)$/) { |
|
if ($1 < 6) { |
|
$uselocal = 0; |
|
} |
|
} |
|
} |
|
if ($uselocal) { |
|
$rep = LONCAPA::Lond::server_certs(\%perlvar); |
|
} else { |
|
$rep=&reply('servercerts',$lonhost); |
|
} |
|
my ($result,%returnhash); |
|
if (defined($lonhost)) { |
|
if (!defined(&hostname($lonhost))) { |
|
return; |
|
} |
|
} |
|
if (($rep=~/^(refused|rejected|error)/) || ($rep eq 'con_lost') || |
|
($rep eq 'unknown_cmd')) { |
|
$result = $rep; |
|
} else { |
|
$result = 'ok'; |
|
my @pairs=split(/\&/,$rep); |
|
foreach my $item (@pairs) { |
|
my ($key,$value)=split(/=/,$item,2); |
|
my $what = &unescape($key); |
|
$returnhash{$what}=&thaw_unescape($value); |
|
} |
|
} |
|
return ($result,\%returnhash); |
|
} |
|
|
sub get_server_loncaparev { |
sub get_server_loncaparev { |
my ($dom,$lonhost,$ignore_cache,$caller) = @_; |
my ($dom,$lonhost,$ignore_cache,$caller) = @_; |
if (defined($lonhost)) { |
if (defined($lonhost)) { |
Line 2202 sub get_domain_defaults {
|
Line 2244 sub get_domain_defaults {
|
'requestcourses','inststatus', |
'requestcourses','inststatus', |
'coursedefaults','usersessions', |
'coursedefaults','usersessions', |
'requestauthor','selfenrollment', |
'requestauthor','selfenrollment', |
'coursecategories'],$domain); |
'coursecategories','ssl','autoenroll', |
|
'trust'],$domain); |
my @coursetypes = ('official','unofficial','community','textbook','placement'); |
my @coursetypes = ('official','unofficial','community','textbook','placement'); |
if (ref($domconfig{'defaults'}) eq 'HASH') { |
if (ref($domconfig{'defaults'}) eq 'HASH') { |
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; |
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; |
Line 2328 sub get_domain_defaults {
|
Line 2371 sub get_domain_defaults {
|
$domdefaults{'catunauth'} = $domconfig{'coursecategories'}{'unauth'}; |
$domdefaults{'catunauth'} = $domconfig{'coursecategories'}{'unauth'}; |
} |
} |
} |
} |
|
if (ref($domconfig{'ssl'}) eq 'HASH') { |
|
if (ref($domconfig{'ssl'}{'replication'}) eq 'HASH') { |
|
$domdefaults{'replication'} = $domconfig{'ssl'}{'replication'}; |
|
} |
|
if (ref($domconfig{'ssl'}{'connect'}) eq 'HASH') { |
|
$domdefaults{'connect'} = $domconfig{'ssl'}{'connect'}; |
|
} |
|
} |
|
if (ref($domconfig{'trust'}) eq 'HASH') { |
|
my @prefixes = qw(content shared enroll othcoau coaurem domroles catalog reqcrs msg); |
|
foreach my $prefix (@prefixes) { |
|
if (ref($domconfig{'trust'}{$prefix}) eq 'HASH') { |
|
$domdefaults{'trust'.$prefix} = $domconfig{'trust'}{$prefix}; |
|
} |
|
} |
|
} |
|
if (ref($domconfig{'autoenroll'}) eq 'HASH') { |
|
$domdefaults{'autofailsafe'} = $domconfig{'autoenroll'}{'autofailsafe'}; |
|
} |
&do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime); |
&do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime); |
return %domdefaults; |
return %domdefaults; |
} |
} |
Line 2584 sub make_key {
|
Line 2646 sub make_key {
|
sub devalidate_cache_new { |
sub devalidate_cache_new { |
my ($name,$id,$debug) = @_; |
my ($name,$id,$debug) = @_; |
if ($debug) { &Apache::lonnet::logthis("deleting $name:$id"); } |
if ($debug) { &Apache::lonnet::logthis("deleting $name:$id"); } |
|
my $remembered_id=$name.':'.$id; |
$id=&make_key($name,$id); |
$id=&make_key($name,$id); |
$memcache->delete($id); |
$memcache->delete($id); |
delete($remembered{$id}); |
delete($remembered{$remembered_id}); |
delete($accessed{$id}); |
delete($accessed{$remembered_id}); |
} |
} |
|
|
sub is_cached_new { |
sub is_cached_new { |
my ($name,$id,$debug) = @_; |
my ($name,$id,$debug) = @_; |
$id=&make_key($name,$id); |
my $remembered_id=$name.':'.$id; # this is to avoid make_key (which is slow) whenever possible |
if (exists($remembered{$id})) { |
if (exists($remembered{$remembered_id})) { |
if ($debug) { &Apache::lonnet::logthis("Early return $id of $remembered{$id} "); } |
if ($debug) { &Apache::lonnet::logthis("Early return $remembered_id of $remembered{$remembered_id} "); } |
$accessed{$id}=[&gettimeofday()]; |
$accessed{$remembered_id}=[&gettimeofday()]; |
$hits++; |
$hits++; |
return ($remembered{$id},1); |
return ($remembered{$remembered_id},1); |
} |
} |
|
$id=&make_key($name,$id); |
my $value = $memcache->get($id); |
my $value = $memcache->get($id); |
if (!(defined($value))) { |
if (!(defined($value))) { |
if ($debug) { &Apache::lonnet::logthis("getting $id is not defined"); } |
if ($debug) { &Apache::lonnet::logthis("getting $id is not defined"); } |
Line 2608 sub is_cached_new {
|
Line 2672 sub is_cached_new {
|
if ($debug) { &Apache::lonnet::logthis("getting $id is __undef__"); } |
if ($debug) { &Apache::lonnet::logthis("getting $id is __undef__"); } |
$value=undef; |
$value=undef; |
} |
} |
&make_room($id,$value,$debug); |
&make_room($remembered_id,$value,$debug); |
if ($debug) { &Apache::lonnet::logthis("getting $id is $value"); } |
if ($debug) { &Apache::lonnet::logthis("getting $id is $value"); } |
return ($value,1); |
return ($value,1); |
} |
} |
|
|
sub do_cache_new { |
sub do_cache_new { |
my ($name,$id,$value,$time,$debug) = @_; |
my ($name,$id,$value,$time,$debug) = @_; |
|
my $remembered_id=$name.':'.$id; |
$id=&make_key($name,$id); |
$id=&make_key($name,$id); |
my $setvalue=$value; |
my $setvalue=$value; |
if (!defined($setvalue)) { |
if (!defined($setvalue)) { |
Line 2630 sub do_cache_new {
|
Line 2695 sub do_cache_new {
|
$memcache->disconnect_all(); |
$memcache->disconnect_all(); |
} |
} |
# need to make a copy of $value |
# need to make a copy of $value |
&make_room($id,$value,$debug); |
&make_room($remembered_id,$value,$debug); |
return $value; |
return $value; |
} |
} |
|
|
sub make_room { |
sub make_room { |
my ($id,$value,$debug)=@_; |
my ($remembered_id,$value,$debug)=@_; |
|
|
$remembered{$id}= (ref($value)) ? &Storable::dclone($value) |
$remembered{$remembered_id}= (ref($value)) ? &Storable::dclone($value) |
: $value; |
: $value; |
if ($to_remember<0) { return; } |
if ($to_remember<0) { return; } |
$accessed{$id}=[&gettimeofday()]; |
$accessed{$remembered_id}=[&gettimeofday()]; |
if (scalar(keys(%remembered)) <= $to_remember) { return; } |
if (scalar(keys(%remembered)) <= $to_remember) { return; } |
my $to_kick; |
my $to_kick; |
my $max_time=0; |
my $max_time=0; |
Line 4058 sub flushcourselogs {
|
Line 4123 sub flushcourselogs {
|
delete $domainrolehash{$entry}; |
delete $domainrolehash{$entry}; |
} |
} |
foreach my $dom (keys(%domrolebuffer)) { |
foreach my $dom (keys(%domrolebuffer)) { |
my %servers = &get_servers($dom,'library'); |
my %servers; |
|
if (defined(&domain($dom,'primary'))) { |
|
my $primary=&domain($dom,'primary'); |
|
my $hostname=&hostname($primary); |
|
$servers{$primary} = $hostname; |
|
} else { |
|
%servers = &get_servers($dom,'library'); |
|
} |
foreach my $tryserver (keys(%servers)) { |
foreach my $tryserver (keys(%servers)) { |
unless (&reply('domroleput:'.$dom.':'. |
if (&reply('domroleput:'.$dom.':'. |
$domrolebuffer{$dom},$tryserver) eq 'ok') { |
$domrolebuffer{$dom},$tryserver) eq 'ok') { |
|
last; |
|
} else { |
&logthis('Put of domain roles failed for '.$dom.' and '.$tryserver); |
&logthis('Put of domain roles failed for '.$dom.' and '.$tryserver); |
} |
} |
} |
} |
Line 7824 sub update_allusers_table {
|
Line 7898 sub update_allusers_table {
|
|
|
sub fetch_enrollment_query { |
sub fetch_enrollment_query { |
my ($context,$affiliatesref,$replyref,$dom,$cnum) = @_; |
my ($context,$affiliatesref,$replyref,$dom,$cnum) = @_; |
my $homeserver; |
my ($homeserver,$sleep,$loopmax); |
my $maxtries = 1; |
my $maxtries = 1; |
if ($context eq 'automated') { |
if ($context eq 'automated') { |
$homeserver = $perlvar{'lonHostID'}; |
$homeserver = $perlvar{'lonHostID'}; |
|
$sleep = 2; |
|
$loopmax = 100; |
$maxtries = 10; # will wait for up to 2000s for retrieval of classlist data before timeout |
$maxtries = 10; # will wait for up to 2000s for retrieval of classlist data before timeout |
} else { |
} else { |
$homeserver = &homeserver($cnum,$dom); |
$homeserver = &homeserver($cnum,$dom); |
Line 7845 sub fetch_enrollment_query {
|
Line 7921 sub fetch_enrollment_query {
|
&logthis('fetch_enrollment_query: invalid queryid: '.$queryid.' for host: '.$host.' and homeserver: '.$homeserver.' context: '.$context.' '.$cnum); |
&logthis('fetch_enrollment_query: invalid queryid: '.$queryid.' for host: '.$host.' and homeserver: '.$homeserver.' context: '.$context.' '.$cnum); |
return 'error: '.$queryid; |
return 'error: '.$queryid; |
} |
} |
my $reply = &get_query_reply($queryid); |
my $reply = &get_query_reply($queryid,$sleep,$loopmax); |
my $tries = 1; |
my $tries = 1; |
while (($reply=~/^timeout/) && ($tries < $maxtries)) { |
while (($reply=~/^timeout/) && ($tries < $maxtries)) { |
$reply = &get_query_reply($queryid); |
$reply = &get_query_reply($queryid,$sleep,$loopmax); |
$tries ++; |
$tries ++; |
} |
} |
if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) { |
if ( ($reply =~/^timeout/) || ($reply =~/^error/) ) { |
&logthis('fetch_enrollment_query error: '.$reply.' for '.$dom.' '.$env{'user.name'}.' for '.$queryid.' context: '.$context.' '.$cnum.' maxtries: '.$maxtries.' tries: '.$tries); |
&logthis('fetch_enrollment_query error: '.$reply.' for '.$dom.' '.$env{'user.name'}.' for '.$queryid.' context: '.$context.' '.$cnum.' maxtries: '.$maxtries.' tries: '.$tries); |
} else { |
} else { |
my @responses = split(/:/,$reply); |
my @responses = split(/:/,$reply); |
if ($homeserver eq $perlvar{'lonHostID'}) { |
if (grep { $_ eq $homeserver } ¤t_machine_ids()) { |
foreach my $line (@responses) { |
foreach my $line (@responses) { |
my ($key,$value) = split(/=/,$line,2); |
my ($key,$value) = split(/=/,$line,2); |
$$replyref{$key} = $value; |
$$replyref{$key} = $value; |
Line 7890 sub fetch_enrollment_query {
|
Line 7966 sub fetch_enrollment_query {
|
} |
} |
|
|
sub get_query_reply { |
sub get_query_reply { |
my $queryid=shift; |
my ($queryid,$sleep,$loopmax) = @_;; |
|
if (($sleep eq '') || ($sleep !~ /^\d+\.?\d*$/)) { |
|
$sleep = 0.2; |
|
} |
|
if (($loopmax eq '') || ($loopmax =~ /\D/)) { |
|
$loopmax = 100; |
|
} |
my $replyfile=LONCAPA::tempdir().$queryid; |
my $replyfile=LONCAPA::tempdir().$queryid; |
my $reply=''; |
my $reply=''; |
for (1..100) { |
for (1..$loopmax) { |
sleep(0.2); |
sleep($sleep); |
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 9088 sub modifyuser {
|
Line 9170 sub modifyuser {
|
sub modifystudent { |
sub modifystudent { |
my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec, |
my ($udom,$uname,$uid,$umode,$upass,$first,$middle,$last,$gene,$usec, |
$end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid, |
$end,$start,$forceid,$desiredhome,$email,$type,$locktype,$cid, |
$selfenroll,$context,$inststatus,$credits)=@_; |
$selfenroll,$context,$inststatus,$credits,$instsec)=@_; |
if (!$cid) { |
if (!$cid) { |
unless ($cid=$env{'request.course.id'}) { |
unless ($cid=$env{'request.course.id'}) { |
return 'not_in_class'; |
return 'not_in_class'; |
Line 9104 sub modifystudent {
|
Line 9186 sub modifystudent {
|
$uid = undef if (!$forceid); |
$uid = undef if (!$forceid); |
$reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last, |
$reply = &modify_student_enrollment($udom,$uname,$uid,$first,$middle,$last, |
$gene,$usec,$end,$start,$type,$locktype, |
$gene,$usec,$end,$start,$type,$locktype, |
$cid,$selfenroll,$context,$credits); |
$cid,$selfenroll,$context,$credits,$instsec); |
return $reply; |
return $reply; |
} |
} |
|
|
sub modify_student_enrollment { |
sub modify_student_enrollment { |
my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type, |
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); |
my ($cdom,$cnum,$chome); |
if (!$cid) { |
if (!$cid) { |
unless ($cid=$env{'request.course.id'}) { |
unless ($cid=$env{'request.course.id'}) { |
Line 9157 sub modify_student_enrollment {
|
Line 9239 sub modify_student_enrollment {
|
my %old_entry = &Apache::lonnet::get('classlist',[$user],$cdom,$cnum); |
my %old_entry = &Apache::lonnet::get('classlist',[$user],$cdom,$cnum); |
my $reply=cput('classlist', |
my $reply=cput('classlist', |
{$user => |
{$user => |
join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype,$credits) }, |
join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype,$credits,$instsec) }, |
$cdom,$cnum); |
$cdom,$cnum); |
if (($reply eq 'ok') || ($reply eq 'delayed')) { |
if (($reply eq 'ok') || ($reply eq 'delayed')) { |
&devalidate_getsection_cache($udom,$uname,$cid); |
&devalidate_getsection_cache($udom,$uname,$cid); |
Line 10143 sub dirlist {
|
Line 10225 sub dirlist {
|
foreach my $user (sort(keys(%allusers))) { |
foreach my $user (sort(keys(%allusers))) { |
push(@alluserslist,$user.'&user'); |
push(@alluserslist,$user.'&user'); |
} |
} |
return (\@alluserslist); |
|
|
if (!%listerror) { |
|
# no errors |
|
return (\@alluserslist); |
|
} elsif (scalar(keys(%servers)) == 1) { |
|
# one library server, one error |
|
my ($key) = keys(%listerror); |
|
return (\@alluserslist, $listerror{$key}); |
|
} elsif ( grep { $_ eq 'con_lost' } values(%listerror) ) { |
|
# con_lost indicates that we might miss data from at least one |
|
# library server |
|
return (\@alluserslist, 'con_lost'); |
|
} else { |
|
# multiple library servers and no con_lost -> data should be |
|
# complete. |
|
return (\@alluserslist); |
|
} |
|
|
} else { |
} else { |
return ([],'missing username'); |
return ([],'missing username'); |
} |
} |
Line 13863 Inputs:
|
Line 13962 Inputs:
|
|
|
=item $credits, number of credits student will earn from this class |
=item $credits, number of credits student will earn from this class |
|
|
|
=item $instsec, institutional course section code for student |
|
|
=back |
=back |
|
|
|
|