[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 and 1.1056.4.33.2.2

version 1.1056.4.33, 2011/10/19 16:36:02 version 1.1056.4.33.2.2, 2012/02/08 01:05:20
Line 636  sub appenv { Line 636  sub appenv {
 # ----------------------------------------------------- Delete from Environment  # ----------------------------------------------------- Delete from Environment
   
 sub delenv {  sub delenv {
     my ($delthis,$regexp) = @_;      my ($delthis,$regexp,$roles) = @_;
     if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) {      if (($delthis=~/^user\.role/) || ($delthis=~/^user\.priv/)) {
         &logthis("<font color=\"blue\">WARNING: ".          my $refused = 1;
                 "Attempt to delete from environment ".$delthis);          if (ref($roles) eq 'ARRAY') {
         return 'error';              my ($type,$role) = ($delthis =~ /^user\.(role|priv)\.([^.]+)\./);
               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 882  sub choose_server { Line 891  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);      my ($login_host,$hostname,$portal_path,$isredirect);
     foreach my $lonhost (keys(%servers)) {      foreach my $lonhost (keys(%servers)) {
         my $loginvia;          my $loginvia;
         if ($checkloginvia) {          if ($checkloginvia) {
Line 893  sub choose_server { Line 902  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 909  sub choose_server { Line 920  sub choose_server {
     if ($login_host ne '') {      if ($login_host ne '') {
         $hostname = &hostname($login_host);          $hostname = &hostname($login_host);
     }      }
     return ($login_host,$hostname);      return ($login_host,$hostname,$portal_path,$isredirect);
 }  }
   
 # --------------------------------------------- Try to change a user's password  # --------------------------------------------- Try to change a user's password
Line 1576  sub get_domain_defaults { Line 1587  sub get_domain_defaults {
         $domdefaults{'auth_arg_def'} = $domconfig{'defaults'}{'auth_arg_def'};          $domdefaults{'auth_arg_def'} = $domconfig{'defaults'}{'auth_arg_def'};
         $domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'};          $domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'};
         $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'};          $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'};
           $domdefaults{'portal_def'} = $domconfig{'defaults'}{'portal_def'};
     } else {      } else {
         $domdefaults{'lang_def'} = &domain($domain,'lang_def');          $domdefaults{'lang_def'} = &domain($domain,'lang_def');
         $domdefaults{'auth_def'} = &domain($domain,'auth_def');          $domdefaults{'auth_def'} = &domain($domain,'auth_def');
Line 3222  sub get_my_roles { Line 3234  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 4234  sub rolesinit { Line 4250  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 4251  sub rolesinit { Line 4266  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 4403  sub set_userprivs { Line 4419  sub set_userprivs {
             }              }
         }          }
         my $thesestr='';          my $thesestr='';
         foreach my $priv (keys(%thesepriv)) {          foreach my $priv (sort(keys(%thesepriv))) {
     $thesestr.=':'.$priv.'&'.$thesepriv{$priv};      $thesestr.=':'.$priv.'&'.$thesepriv{$priv};
  }   }
         $userroles->{'user.priv.'.$role} = $thesestr;          $userroles->{'user.priv.'.$role} = $thesestr;
Line 4412  sub set_userprivs { Line 4428  sub set_userprivs {
 }  }
   
 sub role_status {  sub role_status {
     my ($rolekey,$then,$refresh,$now,$role,$where,$trolecode,$tstatus,$tstart,$tend) = @_;      my ($rolekey,$update,$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 4421  sub role_status { Line 4437  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>$then) {              if ($$tstart && $$tstart>$update) {
                 $$tstatus='future';                  $$tstatus='future';
                 if ($$tstart<$now) {                  if ($$tstart<$now) {
                     if ($$tstart && $$tstart>$refresh) {                      if ($$tstart && $$tstart>$refresh) {
Line 4446  sub role_status { Line 4462  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);
                                 if (keys(%course_roles) > 0) {                                  &get_groups_roles($tdomain,$trest,
                                     my ($tnum) = ($trest =~ /^($match_courseid)/);                                                    \%course_roles,\@rolecodes,
                                     if ($tdomain ne '' && $tnum ne '') {                                                    \%groups_roles);
                                         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 4485  sub role_status { Line 4478  sub role_status {
                 }                  }
             }              }
             if ($$tend) {              if ($$tend) {
                 if ($$tend<$then) {                  if ($$tend<$update) {
                     $$tstatus='expired';                      $$tstatus='expired';
                 } elsif ($$tend<$now) {                  } elsif ($$tend<$now) {
                     $$tstatus='will_not';                      $$tstatus='will_not';
Line 4495  sub role_status { Line 4488  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,$then,$refresh,$now,$checkrole,$caller) = @_;      my ($cdom,$cnum,$update,$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,$then,$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);
         }          }
Removed from v.1.1056.4.33  
changed lines
  Added in v.1.1056.4.33.2.2

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