[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1056.4.33.2.2 and 1.1056.4.34

version 1.1056.4.33.2.2, 2012/02/08 01:05:20 version 1.1056.4.34, 2012/01/06 18:13:41
Line 636  sub appenv { Line 636  sub appenv {
 # ----------------------------------------------------- Delete from Environment  # ----------------------------------------------------- Delete from Environment
   
 sub delenv {  sub delenv {
     my ($delthis,$regexp,$roles) = @_;      my ($delthis,$regexp) = @_;
     if (($delthis=~/^user\.role/) || ($delthis=~/^user\.priv/)) {      if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) {
         my $refused = 1;          &logthis("<font color=\"blue\">WARNING: ".
         if (ref($roles) eq 'ARRAY') {                  "Attempt to delete from environment ".$delthis);
             my ($type,$role) = ($delthis =~ /^user\.(role|priv)\.([^.]+)\./);          return 'error';
             if (grep(/^\Q$role\E$/,@{$roles})) {  
                 $refused = 0;  
             }  
         }  
         if ($refused) {  
             &logthis("<font color=\"blue\">WARNING: ".  
                      "Attempt to delete from environment ".$delthis);  
             return 'error';  
         }  
     }      }
     my $opened = open(my $env_file,'+<',$env{'user.environment'});      my $opened = open(my $env_file,'+<',$env{'user.environment'});
     if ($opened      if ($opened
Line 891  sub choose_server { Line 882  sub choose_server {
     my %domconfhash = &Apache::loncommon::get_domainconf($udom);      my %domconfhash = &Apache::loncommon::get_domainconf($udom);
     my %servers = &get_servers($udom);      my %servers = &get_servers($udom);
     my $lowest_load = 30000;      my $lowest_load = 30000;
     my ($login_host,$hostname,$portal_path,$isredirect);      my ($login_host,$hostname,$portal_path);
     foreach my $lonhost (keys(%servers)) {      foreach my $lonhost (keys(%servers)) {
         my $loginvia;          my $loginvia;
         if ($checkloginvia) {          if ($checkloginvia) {
Line 902  sub choose_server { Line 893  sub choose_server {
                     &compare_server_load($lonhost, $login_host, $lowest_load);                      &compare_server_load($lonhost, $login_host, $lowest_load);
                 if ($login_host eq $server) {                  if ($login_host eq $server) {
                     $portal_path = $path;                      $portal_path = $path;
                     $isredirect = 1;  
                 }                  }
             } else {              } else {
                 ($login_host, $lowest_load) =                  ($login_host, $lowest_load) =
                     &compare_server_load($lonhost, $login_host, $lowest_load);                      &compare_server_load($lonhost, $login_host, $lowest_load);
                 if ($login_host eq $lonhost) {                  if ($login_host eq $lonhost) {
                     $portal_path = '';                      $portal_path = '';
                     $isredirect = '';  
                 }                  }
             }              }
         } else {          } else {
Line 920  sub choose_server { Line 909  sub choose_server {
     if ($login_host ne '') {      if ($login_host ne '') {
         $hostname = &hostname($login_host);          $hostname = &hostname($login_host);
     }      }
     return ($login_host,$hostname,$portal_path,$isredirect);      return ($login_host,$hostname);
 }  }
   
 # --------------------------------------------- Try to change a user's password  # --------------------------------------------- Try to change a user's password
Line 3234  sub get_my_roles { Line 3223  sub get_my_roles {
                     if (!grep(/^cr$/,@{$roles})) {                      if (!grep(/^cr$/,@{$roles})) {
                         next;                          next;
                     }                      }
                 } elsif ($role =~ /^gr\//) {  
                     if (!grep(/^gr$/,@{$roles})) {  
                         next;  
                     }  
                 } else {                  } else {
                     next;                      next;
                 }                  }
Line 4250  sub rolesinit { Line 4235  sub rolesinit {
     }      }
     my %allroles=();      my %allroles=();
     my %allgroups=();         my %allgroups=();   
       my $group_privs;
   
     if ($rolesdump ne '') {      if ($rolesdump ne '') {
         foreach my $entry (split(/&/,$rolesdump)) {          foreach my $entry (split(/&/,$rolesdump)) {
Line 4266  sub rolesinit { Line 4252  sub rolesinit {
  }   }
             } elsif ($role =~ m|^gr/|) {              } elsif ($role =~ m|^gr/|) {
                 ($trole,$tend,$tstart) = split(/_/,$role);                  ($trole,$tend,$tstart) = split(/_/,$role);
                 next if ($tstart eq '-1');  
                 ($trole,$group_privs) = split(/\//,$trole);                  ($trole,$group_privs) = split(/\//,$trole);
                 $group_privs = &unescape($group_privs);                  $group_privs = &unescape($group_privs);
     } else {      } else {
Line 4419  sub set_userprivs { Line 4404  sub set_userprivs {
             }              }
         }          }
         my $thesestr='';          my $thesestr='';
         foreach my $priv (sort(keys(%thesepriv))) {          foreach my $priv (keys(%thesepriv)) {
     $thesestr.=':'.$priv.'&'.$thesepriv{$priv};      $thesestr.=':'.$priv.'&'.$thesepriv{$priv};
  }   }
         $userroles->{'user.priv.'.$role} = $thesestr;          $userroles->{'user.priv.'.$role} = $thesestr;
Line 4428  sub set_userprivs { Line 4413  sub set_userprivs {
 }  }
   
 sub role_status {  sub role_status {
     my ($rolekey,$update,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;      my ($rolekey,$then,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;
     my @pwhere = ();      my @pwhere = ();
     if (exists($env{$rolekey}) && $env{$rolekey} ne '') {      if (exists($env{$rolekey}) && $env{$rolekey} ne '') {
         (undef,undef,$$role,@pwhere)=split(/\./,$rolekey);          (undef,undef,$$role,@pwhere)=split(/\./,$rolekey);
Line 4437  sub role_status { Line 4422  sub role_status {
             $$trolecode=$$role.'.'.$$where;              $$trolecode=$$role.'.'.$$where;
             ($$tstart,$$tend)=split(/\./,$env{$rolekey});              ($$tstart,$$tend)=split(/\./,$env{$rolekey});
             $$tstatus='is';              $$tstatus='is';
             if ($$tstart && $$tstart>$update) {              if ($$tstart && $$tstart>$then) {
                 $$tstatus='future';                  $$tstatus='future';
                 if ($$tstart<$now) {                  if ($$tstart<$now) {
                     if ($$tstart && $$tstart>$refresh) {                      if ($$tstart && $$tstart>$refresh) {
Line 4462  sub role_status { Line 4447  sub role_status {
                                 $group_privs = &unescape($group_privs);                                  $group_privs = &unescape($group_privs);
                                 &group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart);                                  &group_roleprivs(\%allgroups,$$where,$group_privs,$$tend,$$tstart);
                                 my %course_roles = &get_my_roles($env{'user.name'},$env{'user.domain'},'userroles',['active'],['cc','co','in','ta','ep','ad','st','cr'],[$tdomain],1);                                  my %course_roles = &get_my_roles($env{'user.name'},$env{'user.domain'},'userroles',['active'],['cc','co','in','ta','ep','ad','st','cr'],[$tdomain],1);
                                 &get_groups_roles($tdomain,$trest,                                  if (keys(%course_roles) > 0) {
                                                   \%course_roles,\@rolecodes,                                      my ($tnum) = ($trest =~ /^($match_courseid)/);
                                                   \%groups_roles);                                      if ($tdomain ne '' && $tnum ne '') {
                                           foreach my $key (keys(%course_roles)) {
                                               if ($key =~ /^\Q$tnum\E:\Q$tdomain\E:([^:]+):?([^:]*)/) {
                                                   my $crsrole = $1;
                                                   my $crssec = $2;
                                                   if ($crsrole =~ /^cr/) {
                                                       unless (grep(/^cr$/,@rolecodes)) {
                                                           push(@rolecodes,'cr');
                                                       }
                                                   } else {
                                                       unless(grep(/^\Q$crsrole\E$/,@rolecodes)) {
                                                           push(@rolecodes,$crsrole);
                                                       }
                                                   }
                                                   my $rolekey = $crsrole.'./'.$tdomain.'/'.$tnum;
                                                   if ($crssec ne '') {
                                                       $rolekey .= '/'.$crssec;
                                                   }
                                                   $rolekey .= './';
                                                   $groups_roles{$rolekey} = \@rolecodes;
                                               }
                                           }
                                       }
                                   }
                             } else {                              } else {
                                 push(@rolecodes,$$role);                                  push(@rolecodes,$$role);
                                 &standard_roleprivs(\%allroles,$$role,$tdomain,$spec,$trest,$$where);                                  &standard_roleprivs(\%allroles,$$role,$tdomain,$spec,$trest,$$where);
Line 4478  sub role_status { Line 4486  sub role_status {
                 }                  }
             }              }
             if ($$tend) {              if ($$tend) {
                 if ($$tend<$update) {                  if ($$tend<$then) {
                     $$tstatus='expired';                      $$tstatus='expired';
                 } elsif ($$tend<$now) {                  } elsif ($$tend<$now) {
                     $$tstatus='will_not';                      $$tstatus='will_not';
Line 4488  sub role_status { Line 4496  sub role_status {
     }      }
 }  }
   
 sub get_groups_roles {  
     my ($cdom,$rest,$cdom_courseroles,$rolecodes,$groups_roles) = @_;  
     return unless((ref($cdom_courseroles) eq 'HASH') &&  
                   (ref($rolecodes) eq 'ARRAY') &&  
                   (ref($groups_roles) eq 'HASH'));  
     if (keys(%{$cdom_courseroles}) > 0) {  
         my ($cnum) = ($rest =~ /^($match_courseid)/);  
         if ($cdom ne '' && $cnum ne '') {  
             foreach my $key (keys(%{$cdom_courseroles})) {  
                 if ($key =~ /^\Q$cnum\E:\Q$cdom\E:([^:]+):?([^:]*)/) {  
                     my $crsrole = $1;  
                     my $crssec = $2;  
                     if ($crsrole =~ /^cr/) {  
                         unless (grep(/^cr$/,@{$rolecodes})) {  
                             push(@{$rolecodes},'cr');  
                         }  
                     } else {  
                         unless(grep(/^\Q$crsrole\E$/,@{$rolecodes})) {  
                             push(@{$rolecodes},$crsrole);  
                         }  
                     }  
                     my $rolekey = "$crsrole./$cdom/$cnum";  
                     if ($crssec ne '') {  
                         $rolekey .= "/$crssec";  
                     }  
                     $rolekey .= './';  
                     $groups_roles->{$rolekey} = $rolecodes;  
                 }  
             }  
         }  
     }  
     return;  
 }  
   
 sub delete_env_groupprivs {  
     my ($where,$courseroles,$possroles) = @_;  
     return unless((ref($courseroles) eq 'HASH') && (ref($possroles) eq 'ARRAY'));  
     my ($dummy,$udom,$uname,$group) = split(/\//,$where);  
     unless (ref($courseroles->{$udom}) eq 'HASH') {  
         %{$courseroles->{$udom}} =  
             &get_my_roles('','','userroles',['active'],  
                           $possroles,[$udom],1);  
     }  
     if (ref($courseroles->{$udom}) eq 'HASH') {  
         foreach my $item (keys(%{$courseroles->{$udom}})) {  
             my ($cnum,$cdom,$crsrole,$crssec) = split(/:/,$item);  
             my $area = '/'.$cdom.'/'.$cnum;  
             my $privkey = "user.priv.$crsrole.$area";  
             if ($crssec ne '') {  
                 $privkey .= '/'.$crssec;  
             }  
             $privkey .= ".$area/$group";  
             &Apache::lonnet::delenv($privkey,undef,[$crsrole]);  
         }  
     }  
     return;  
 }  
   
 sub check_adhoc_privs {  sub check_adhoc_privs {
     my ($cdom,$cnum,$update,$refresh,$now,$checkrole,$caller) = @_;      my ($cdom,$cnum,$then,$refresh,$now,$checkrole,$caller) = @_;
     my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;      my $cckey = 'user.role.'.$checkrole.'./'.$cdom.'/'.$cnum;
     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,$then,$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);
         }          }
Removed from v.1.1056.4.33.2.2  
changed lines
  Added in v.1.1056.4.34

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>