version 1.1312, 2016/06/19 04:28:19
|
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 10216 sub stat_file {
|
Line 10315 sub stat_file {
|
return (); |
return (); |
} |
} |
|
|
|
# --------------------------------------------------------- recursedirs |
|
# Recursive function to traverse either a specific user's Authoring Space |
|
# or corresponding Published Resource Space, and populate the hash ref: |
|
# $dirhashref with URLs of all directories, and if $filehashref hash |
|
# ref arg is provided, the URLs of any files, excluding versioned, .meta, |
|
# or .rights files in resource space, and .meta, .save, .log, and .bak |
|
# files in Authoring Space. |
|
# |
|
# Inputs: |
|
# |
|
# $is_home - true if current server is home server for user's space |
|
# $context - either: priv, or res respectively for Authoring or Resource Space. |
|
# $docroot - Document root (i.e., /home/httpd/html |
|
# $toppath - Top level directory (i.e., /res/$dom/$uname or /priv/$dom/$uname |
|
# $relpath - Current path (relative to top level). |
|
# $dirhashref - reference to hash to populate with URLs of directories (Required) |
|
# $filehashref - reference to hash to populate with URLs of files (Optional) |
|
# |
|
# Returns: nothing |
|
# |
|
# Side Effects: populates $dirhashref, and $filehashref (if provided). |
|
# |
|
# Currently used by interface/londocs.pm to create linked select boxes for |
|
# directory and filename to import a Course "Author" resource into a course, and |
|
# also to create linked select boxes for Authoring Space and Directory to choose |
|
# save location for creation of a new "standard" problem from the Course Editor. |
|
# |
|
|
|
sub recursedirs { |
|
my ($is_home,$context,$docroot,$toppath,$relpath,$dirhashref,$filehashref) = @_; |
|
return unless (ref($dirhashref) eq 'HASH'); |
|
my $currpath = $docroot.$toppath; |
|
if ($relpath) { |
|
$currpath .= "/$relpath"; |
|
} |
|
my $savefile; |
|
if (ref($filehashref)) { |
|
$savefile = 1; |
|
} |
|
if ($is_home) { |
|
if (opendir(my $dirh,$currpath)) { |
|
foreach my $item (sort { lc($a) cmp lc($b) } grep(!/^\.+$/,readdir($dirh))) { |
|
next if ($item eq ''); |
|
if (-d "$currpath/$item") { |
|
my $newpath; |
|
if ($relpath) { |
|
$newpath = "$relpath/$item"; |
|
} else { |
|
$newpath = $item; |
|
} |
|
$dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1; |
|
&recursedirs($is_home,$context,$docroot,$toppath,$newpath,$dirhashref,$filehashref); |
|
} elsif ($savefile) { |
|
if ($context eq 'priv') { |
|
unless ($item =~ /\.(meta|save|log|bak|DS_Store)$/) { |
|
$filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1; |
|
} |
|
} else { |
|
unless (($item =~ /\.meta$/) || ($item =~ /\.\d+\.\w+$/) || ($item =~ /\.rights$/)) { |
|
$filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1; |
|
} |
|
} |
|
} |
|
} |
|
closedir($dirh); |
|
} |
|
} else { |
|
my ($dirlistref,$listerror) = |
|
&dirlist($toppath.$relpath); |
|
my @dir_lines; |
|
my $dirptr=16384; |
|
if (ref($dirlistref) eq 'ARRAY') { |
|
foreach my $dir_line (sort |
|
{ |
|
my ($afile)=split('&',$a,2); |
|
my ($bfile)=split('&',$b,2); |
|
return (lc($afile) cmp lc($bfile)); |
|
} (@{$dirlistref})) { |
|
my ($item,$dom,undef,$testdir,undef,undef,undef,undef,$size,undef,$mtime,undef,undef,undef,$obs,undef) = |
|
split(/\&/,$dir_line,16); |
|
$item =~ s/\s+$//; |
|
next if (($item =~ /^\.\.?$/) || ($obs)); |
|
if ($dirptr&$testdir) { |
|
my $newpath; |
|
if ($relpath) { |
|
$newpath = "$relpath/$item"; |
|
} else { |
|
$relpath = '/'; |
|
$newpath = $item; |
|
} |
|
$dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1; |
|
&recursedirs($is_home,$context,$docroot,$toppath,$newpath,$dirhashref,$filehashref); |
|
} elsif ($savefile) { |
|
if ($context eq 'priv') { |
|
unless ($item =~ /\.(meta|save|log|bak|DS_Store)$/) { |
|
$filehashref->{$relpath}{$item} = 1; |
|
} |
|
} else { |
|
unless (($item =~ /\.meta$/) || ($item =~ /\.\d+\.\w+$/)) { |
|
$filehashref->{$relpath}{$item} = 1; |
|
} |
|
} |
|
} |
|
} |
|
} |
|
} |
|
return; |
|
} |
|
|
# -------------------------------------------------------- Value of a Condition |
# -------------------------------------------------------- Value of a Condition |
|
|
# gets the value of a specific preevaluated condition |
# gets the value of a specific preevaluated condition |
Line 13754 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 |
|
|
|
|