version 1.1317, 2016/08/16 22:10:12
|
version 1.1330, 2016/11/15 20:46:35
|
Line 237 sub get_servercerts_info {
|
Line 237 sub get_servercerts_info {
|
} |
} |
if (($context ne 'cgi') && ($uselocal)) { |
if (($context ne 'cgi') && ($uselocal)) { |
my $distro = (split(/\:/,&get_server_distarch($lonhost)))[0]; |
my $distro = (split(/\:/,&get_server_distarch($lonhost)))[0]; |
if ($distro =~ /^(?:centos|redhat|scientific)(\d+)$/) { |
if ($distro eq '') { |
|
$uselocal = 0; |
|
} elsif ($distro =~ /^(?:centos|redhat|scientific)(\d+)$/) { |
if ($1 < 6) { |
if ($1 < 6) { |
$uselocal = 0; |
$uselocal = 0; |
} |
} |
Line 2242 sub get_domain_defaults {
|
Line 2244 sub get_domain_defaults {
|
'requestcourses','inststatus', |
'requestcourses','inststatus', |
'coursedefaults','usersessions', |
'coursedefaults','usersessions', |
'requestauthor','selfenrollment', |
'requestauthor','selfenrollment', |
'coursecategories','ssl','autoenroll'],$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 2376 sub get_domain_defaults {
|
Line 2379 sub get_domain_defaults {
|
$domdefaults{'connect'} = $domconfig{'ssl'}{'connect'}; |
$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') { |
if (ref($domconfig{'autoenroll'}) eq 'HASH') { |
$domdefaults{'autofailsafe'} = $domconfig{'autoenroll'}{'autofailsafe'}; |
$domdefaults{'autofailsafe'} = $domconfig{'autoenroll'}{'autofailsafe'}; |
} |
} |
Line 2635 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 2659 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 2681 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 4094 sub flushcourselogs {
|
Line 4108 sub flushcourselogs {
|
} |
} |
} |
} |
# |
# |
# Reverse lookup of domain roles (dc, ad, li, sc, au) |
# Reverse lookup of domain roles (dc, ad, li, sc, dh, au) |
# |
# |
my %domrolebuffer = (); |
my %domrolebuffer = (); |
foreach my $entry (keys(%domainrolehash)) { |
foreach my $entry (keys(%domainrolehash)) { |
Line 4109 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 4232 sub userrolelog {
|
Line 4255 sub userrolelog {
|
{$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'} |
{$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'} |
=$tend.':'.$tstart; |
=$tend.':'.$tstart; |
} |
} |
if ($trole =~ /^(dc|ad|li|au|dg|sc)/ ) { |
if ($trole =~ /^(dc|ad|li|au|dg|sc|dh)/ ) { |
my (undef,$rudom,$runame,$rsec)=split(/\//,$area); |
my (undef,$rudom,$runame,$rsec)=split(/\//,$area); |
$domainrolehash |
$domainrolehash |
{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec} |
{$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec} |
Line 5811 sub delete_env_groupprivs {
|
Line 5834 sub delete_env_groupprivs {
|
} |
} |
|
|
sub check_adhoc_privs { |
sub check_adhoc_privs { |
my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller) = @_; |
my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller,$sec) = @_; |
my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum; |
my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum; |
|
if ($sec) { |
|
$cckey .= '/'.$sec; |
|
} |
my $setprivs; |
my $setprivs; |
if ($env{$cckey}) { |
if ($env{$cckey}) { |
my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend); |
my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend); |
&role_status($cckey,$update,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend); |
&role_status($cckey,$update,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend); |
unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) { |
unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) { |
&set_adhoc_privileges($cdom,$cnum,$checkrole,$caller); |
&set_adhoc_privileges($cdom,$cnum,$checkrole,$caller,$sec); |
$setprivs = 1; |
$setprivs = 1; |
} |
} |
} else { |
} else { |
&set_adhoc_privileges($cdom,$cnum,$checkrole,$caller); |
&set_adhoc_privileges($cdom,$cnum,$checkrole,$caller,$sec); |
$setprivs = 1; |
$setprivs = 1; |
} |
} |
return $setprivs; |
return $setprivs; |
} |
} |
|
|
sub set_adhoc_privileges { |
sub set_adhoc_privileges { |
# role can be cc or ca |
# role can be cc, ca, or cr/<dom>/<dom>-domainconfig/role |
my ($dcdom,$pickedcourse,$role,$caller) = @_; |
my ($dcdom,$pickedcourse,$role,$caller,$sec) = @_; |
my $area = '/'.$dcdom.'/'.$pickedcourse; |
my $area = '/'.$dcdom.'/'.$pickedcourse; |
|
if ($sec ne '') { |
|
$area .= '/'.$sec; |
|
} |
my $spec = $role.'.'.$area; |
my $spec = $role.'.'.$area; |
my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'}, |
my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'}, |
$env{'user.name'},1); |
$env{'user.name'},1); |
my %ccrole = (); |
my %rolehash = (); |
&standard_roleprivs(\%ccrole,$role,$dcdom,$spec,$pickedcourse,$area); |
if ($role =~ m{^cr/$dcdom/$dcdom\Q-domainconfig\E/}) { |
my ($author,$adv)= &set_userprivs(\%userroles,\%ccrole); |
&custom_roleprivs(\%rolehash,$role,$dcdom,$pickedcourse,$spec,$area); |
|
} else { |
|
&standard_roleprivs(\%rolehash,$role,$dcdom,$spec,$pickedcourse,$area); |
|
} |
|
my ($author,$adv)= &set_userprivs(\%userroles,\%rolehash); |
&appenv(\%userroles,[$role,'cm']); |
&appenv(\%userroles,[$role,'cm']); |
&log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role); |
&log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role); |
unless ($caller eq 'constructaccess' && $env{'request.course.id'}) { |
unless ($caller eq 'constructaccess' && $env{'request.course.id'}) { |
Line 6227 sub tmpget {
|
Line 6260 sub tmpget {
|
if (!defined($server)) { $server = $perlvar{'lonHostID'}; } |
if (!defined($server)) { $server = $perlvar{'lonHostID'}; } |
my $rep=&reply("tmpget:$token",$server); |
my $rep=&reply("tmpget:$token",$server); |
my %returnhash; |
my %returnhash; |
|
if ($rep =~ /^(con_lost|error|no_such_host)/i) { |
|
return %returnhash; |
|
} |
foreach my $item (split(/\&/,$rep)) { |
foreach my $item (split(/\&/,$rep)) { |
my ($key,$value)=split(/=/,$item); |
my ($key,$value)=split(/=/,$item); |
next if ($key =~ /^error: 2 /); |
|
$returnhash{&unescape($key)}=&thaw_unescape($value); |
$returnhash{&unescape($key)}=&thaw_unescape($value); |
} |
} |
return %returnhash; |
return %returnhash; |
Line 7413 sub constructaccess {
|
Line 7448 sub constructaccess {
|
my ($ownername,$ownerdomain,$ownerhome); |
my ($ownername,$ownerdomain,$ownerhome); |
|
|
($ownerdomain,$ownername) = |
($ownerdomain,$ownername) = |
($url=~ m{^(?:\Q$perlvar{'lonDocRoot'}\E|)(?:/daxepage|/daxeopen)?/priv/($match_domain)/($match_username)/}); |
($url=~ m{^(?:\Q$perlvar{'lonDocRoot'}\E|)(?:/daxepage|/daxeopen)?/priv/($match_domain)/($match_username)(?:/|$)}); |
|
|
# The URL does not really point to any authorspace, forget it |
# The URL does not really point to any authorspace, forget it |
unless (($ownername) && ($ownerdomain)) { return ''; } |
unless (($ownername) && ($ownerdomain)) { return ''; } |
Line 7761 sub get_symb_from_alias {
|
Line 7796 sub get_symb_from_alias {
|
|
|
sub definerole { |
sub definerole { |
if (allowed('mcr','/')) { |
if (allowed('mcr','/')) { |
my ($rolename,$sysrole,$domrole,$courole)=@_; |
my ($rolename,$sysrole,$domrole,$courole,$uname,$udom)=@_; |
foreach my $role (split(':',$sysrole)) { |
foreach my $role (split(':',$sysrole)) { |
my ($crole,$cqual)=split(/\&/,$role); |
my ($crole,$cqual)=split(/\&/,$role); |
if ($pr{'cr:s'}!~/\Q$crole\E/) { return "refused:s:$crole"; } |
if ($pr{'cr:s'}!~/\Q$crole\E/) { return "refused:s:$crole"; } |
Line 7789 sub definerole {
|
Line 7824 sub definerole {
|
} |
} |
} |
} |
} |
} |
|
my $uhome; |
|
if (($uname ne '') && ($udom ne '')) { |
|
$uhome = &homeserver($uname,$udom); |
|
return $uhome if ($uhome eq 'no_host'); |
|
} else { |
|
$uname = $env{'user.name'}; |
|
$udom = $env{'user.domain'}; |
|
$uhome = $env{'user.home'}; |
|
} |
my $command="encrypt:rolesput:$env{'user.domain'}:$env{'user.name'}:". |
my $command="encrypt:rolesput:$env{'user.domain'}:$env{'user.name'}:". |
"$env{'user.domain'}:$env{'user.name'}:". |
"$udom:$uname:rolesdef_$rolename=". |
"rolesdef_$rolename=". |
|
escape($sysrole.'_'.$domrole.'_'.$courole); |
escape($sysrole.'_'.$domrole.'_'.$courole); |
return reply($command,$env{'user.home'}); |
return reply($command,$uhome); |
} else { |
} else { |
return 'refused'; |
return 'refused'; |
} |
} |
Line 7908 sub fetch_enrollment_query {
|
Line 7951 sub fetch_enrollment_query {
|
&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 8842 sub assignrole {
|
Line 8885 sub assignrole {
|
&courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag, |
&courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag, |
$selfenroll,$context); |
$selfenroll,$context); |
} elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') || |
} elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') || |
($role eq 'au') || ($role eq 'dc')) { |
($role eq 'au') || ($role eq 'dc') || ($role eq 'dh')) { |
&domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag, |
&domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag, |
$context); |
$context); |
} elsif (($role eq 'ca') || ($role eq 'aa')) { |
} elsif (($role eq 'ca') || ($role eq 'aa')) { |
Line 10202 sub dirlist {
|
Line 10245 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 13716 in which case the null string is returne
|
Line 13776 in which case the null string is returne
|
|
|
=item * |
=item * |
|
|
definerole($rolename,$sysrole,$domrole,$courole) : define role; define a custom |
definerole($rolename,$sysrole,$domrole,$courole,$uname,$udom) : define role; |
role rolename set privileges in format of lonTabs/roles.tab for system, domain, |
define a custom role rolename set privileges in format of lonTabs/roles.tab |
and course level |
for system, domain, and course level. $uname and $udom are optional (current |
|
user's username and domain will be used when either of $uname or $udom are absent. |
|
|
=item * |
=item * |
|
|