--- loncom/lonnet/perl/lonnet.pm 2009/05/06 12:13:26 1.996
+++ loncom/lonnet/perl/lonnet.pm 2009/06/11 19:02:32 1.1002
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.996 2009/05/06 12:13:26 raeburn Exp $
+# $Id: lonnet.pm,v 1.1002 2009/06/11 19:02:32 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -718,7 +718,12 @@ sub spareserver {
if ($protocol{$spare_server} eq 'https') {
$protocol = $protocol{$spare_server};
}
- $spare_server = $protocol.'://'.&hostname($spare_server);
+ if (defined($spare_server)) {
+ my $hostname = &hostname($spare_server);
+ if (defined($hostname)) {
+ $spare_server = $protocol.'://'.$hostname;
+ }
+ }
}
return $spare_server;
}
@@ -1904,7 +1909,7 @@ sub ssi {
&Apache::lonenc::check_encrypt(\$fn);
if (%form) {
$request=new HTTP::Request('POST',&absolute_url().$fn);
- $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys %form));
+ $request->content(join('&',map { &escape($_).'='.&escape($form{$_}) } keys(%form)));
} else {
$request=new HTTP::Request('GET',&absolute_url().$fn);
}
@@ -2554,7 +2559,7 @@ sub flushcourselogs {
# Reverse lookup of domain roles (dc, ad, li, sc, au)
#
my %domrolebuffer = ();
- foreach my $entry (keys %domainrolehash) {
+ foreach my $entry (keys(%domainrolehash)) {
my ($role,$uname,$udom,$runame,$rudom,$rsec)=split(/:/,$entry);
if ($domrolebuffer{$rudom}) {
$domrolebuffer{$rudom}.='&'.&escape($entry).
@@ -2734,15 +2739,29 @@ sub get_course_adv_roles {
my %dumphash=
&dump('nohist_userroles',$coursehash{'domain'},$coursehash{'num'});
my $now=time;
- foreach my $entry (keys %dumphash) {
+ my %privileged;
+ foreach my $entry (keys(%dumphash)) {
my ($tend,$tstart)=split(/\:/,$dumphash{$entry});
if (($tstart) && ($tstart<0)) { next; }
if (($tend) && ($tend<$now)) { next; }
if (($tstart) && ($now<$tstart)) { next; }
my ($role,$username,$domain,$section)=split(/\:/,$entry);
if ($username eq '' || $domain eq '') { next; }
- if ((&privileged($username,$domain)) &&
- (!$nothide{$username.':'.$domain})) { next; }
+ unless (ref($privileged{$domain}) eq 'HASH') {
+ my %dompersonnel =
+ &Apache::lonnet::get_domain_roles($domain,['dc'],$now,$now);
+ $privileged{$domain} = {};
+ foreach my $server (keys(%dompersonnel)) {
+ if (ref($dompersonnel{$server}) eq 'HASH') {
+ foreach my $user (keys(%{$dompersonnel{$server}})) {
+ my ($trole,$uname,$udom) = split(/:/,$user);
+ $privileged{$udom}{$uname} = 1;
+ }
+ }
+ }
+ }
+ if ((exists($privileged{$domain}{$username})) &&
+ (!$nothide{$username.':'.$domain})) { next; }
if ($role eq 'cr') { next; }
if ($codes) {
if ($section) { $role .= ':'.$section; }
@@ -2787,6 +2806,7 @@ sub get_my_roles {
}
my %returnhash=();
my $now=time;
+ my %privileged;
foreach my $entry (keys(%dumphash)) {
my ($role,$tend,$tstart);
if ($context eq 'userroles') {
@@ -2835,9 +2855,32 @@ sub get_my_roles {
}
}
if ($hidepriv) {
- if ((&privileged($username,$domain)) &&
- (!$nothide{$username.':'.$domain})) {
- next;
+ if ($context eq 'userroles') {
+ if ((&privileged($username,$domain)) &&
+ (!$nothide{$username.':'.$domain})) {
+ next;
+ }
+ } else {
+ unless (ref($privileged{$domain}) eq 'HASH') {
+ my %dompersonnel =
+ &Apache::lonnet::get_domain_roles($domain,['dc'],$now,$now);
+ $privileged{$domain} = {};
+ if (keys(%dompersonnel)) {
+ foreach my $server (keys(%dompersonnel)) {
+ if (ref($dompersonnel{$server}) eq 'HASH') {
+ foreach my $user (keys(%{$dompersonnel{$server}})) {
+ my ($trole,$uname,$udom) = split(/:/,$user);
+ $privileged{$udom}{$uname} = $trole;
+ }
+ }
+ }
+ }
+ }
+ if (exists($privileged{$domain}{$username})) {
+ if (!$nothide{$username.':'.$domain}) {
+ next;
+ }
+ }
}
}
if ($withsec) {
@@ -3407,7 +3450,7 @@ sub tmpreset {
if (tie(%hash,'GDBM_File',
$path.'/tmpstore_'.$stuname.'_'.$domain.'_'.$namespace.'.db',
&GDBM_WRCREAT(),0640)) {
- foreach my $key (keys %hash) {
+ foreach my $key (keys(%hash)) {
if ($key=~ /:$symb/) {
delete($hash{$key});
}
@@ -3843,7 +3886,7 @@ sub set_userprivs {
my $adv=0;
my %grouproles = ();
if (keys(%{$allgroups}) > 0) {
- foreach my $role (keys %{$allroles}) {
+ foreach my $role (keys(%{$allroles})) {
my ($trole,$area,$sec,$extendedarea);
if ($role =~ m-^(\w+|cr/$match_domain/$match_username/\w+)\.(/$match_domain/$match_courseid)(/?\w*)\.-) {
$trole = $1;
@@ -3887,7 +3930,7 @@ sub set_userprivs {
}
sub role_status {
- my ($rolekey,$then,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
+ my ($rolekey,$then,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
my @pwhere = ();
if (exists($env{$rolekey}) && $env{$rolekey} ne '') {
(undef,undef,$$role,@pwhere)=split(/\./,$rolekey);
@@ -3898,7 +3941,41 @@ sub role_status {
$$tstatus='is';
if ($$tstart && $$tstart>$then) {
$$tstatus='future';
- if ($$tstart<$now) { $$tstatus='will'; }
+ if ($$tstart && $$tstart>$refresh) {
+ if ($$tstart<$now) {
+ if (($$where ne '') && ($$role ne '')) {
+ my (%allroles,%allgroups,$group_privs);
+ my %userroles = (
+ 'user.role.'.$$role.'.'.$$where => $$tstart.'.'.$$tend
+ );
+ my $spec=$$role.'.'.$$where;
+ my ($tdummy,$tdomain,$trest)=split(/\//,$$where);
+ if ($$role eq 'gr') {
+ my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},
+ $env{'user.name'})=@_;
+ my ($trole) = split('_',$role,1);
+ (undef,my $group_privs) = split(/\//,$trole);
+ $group_privs = &unescape($group_privs);
+ }
+ if ($$role =~ /^cr\//) {
+ &custom_roleprivs(\%allroles,$$role,$tdomain,$trest,$spec,$$where);
+ } elsif ($$role eq 'gr') {
+ my %rolehash = &get('roles',[$$where.'_'.$$role],$env{'user.domain'},
+ $env{'user.name'});
+ my $trole = split('_',$rolehash{$$where.'_'.$$role},1);
+ (undef,my $group_privs) = split(/\//,$trole);
+ $group_privs = &unescape($group_privs);
+ &group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart);
+ } else {
+ &standard_roleprivs(\%allroles,$$role,$tdomain,$spec,$trest,$$where);
+ }
+ my ($author,$adv)= &set_userprivs(\%userroles,\%allroles,\%allgroups);
+ &appenv(\%userroles,[$$role,'cm']);
+ &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$role);
+ $$tstatus = 'is';
+ }
+ }
+ }
}
if ($$tend) {
if ($$tend<$then) {
@@ -3912,11 +3989,11 @@ sub role_status {
}
sub check_adhoc_privs {
- my ($cdom,$cnum,$then,$now,$checkrole) = @_;
+ my ($cdom,$cnum,$then,$refresh,$now,$checkrole) = @_;
my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
if ($env{$cckey}) {
my ($role,$where,$trolecode,$tstart,$tend,$tremark,$tstatus,$tpstart,$tpend);
- &role_status($cckey,$then,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
+ &role_status($cckey,$then,$refresh,$now,\$role,\$where,\$trolecode,\$tstatus,\$tstart,\$tend);
unless (($tstatus eq 'is') || ($tstatus eq 'will_not')) {
&set_adhoc_privileges($cdom,$cnum,$checkrole);
}
@@ -5003,7 +5080,7 @@ sub allowed {
my $envkey;
if ($thisallowed=~/L/) {
- foreach $envkey (keys %env) {
+ foreach $envkey (keys(%env)) {
if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {
my $courseid=$2;
my $roleid=$1.'.'.$2;
@@ -5294,7 +5371,7 @@ sub fetch_enrollment_query {
}
my $host=&hostname($homeserver);
my $cmd = '';
- foreach my $affiliate (keys %{$affiliatesref}) {
+ foreach my $affiliate (keys(%{$affiliatesref})) {
$cmd .= $affiliate.'='.join(",",@{$$affiliatesref{$affiliate}}).'%%';
}
$cmd =~ s/%%$//;
@@ -7802,7 +7879,7 @@ sub symblist {
if (($env{'request.course.fn'}) && (%newhash)) {
if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
&GDBM_WRCREAT(),0640)) {
- foreach my $url (keys %newhash) {
+ foreach my $url (keys(%newhash)) {
next if ($url eq 'last_known'
&& $env{'form.no_update_last_known'});
$hash{declutter($url)}=&encode_symb($mapname,