[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.1039 and 1.1046

version 1.1039, 2009/10/31 21:38:00 version 1.1046, 2009/11/29 00:17:22
Line 2729  sub userrolelog { Line 2729  sub userrolelog {
     if (($trole=~/^ca/) || ($trole=~/^aa/) ||      if (($trole=~/^ca/) || ($trole=~/^aa/) ||
         ($trole=~/^in/) || ($trole=~/^cc/) ||          ($trole=~/^in/) || ($trole=~/^cc/) ||
         ($trole=~/^ep/) || ($trole=~/^cr/) ||          ($trole=~/^ep/) || ($trole=~/^cr/) ||
         ($trole=~/^ta/)) {          ($trole=~/^ta/) || ($trole=~/^co/)) {
        my (undef,$rudom,$runame,$rsec)=split(/\//,$area);         my (undef,$rudom,$runame,$rsec)=split(/\//,$area);
        $userrolehash         $userrolehash
          {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}           {$trole.':'.$username.':'.$domain.':'.$runame.':'.$rudom.':'.$rsec}
Line 2738  sub userrolelog { Line 2738  sub userrolelog {
     if (($env{'request.role'} =~ /dc\./) &&      if (($env{'request.role'} =~ /dc\./) &&
  (($trole=~/^au/) || ($trole=~/^in/) ||   (($trole=~/^au/) || ($trole=~/^in/) ||
  ($trole=~/^cc/) || ($trole=~/^ep/) ||   ($trole=~/^cc/) || ($trole=~/^ep/) ||
  ($trole=~/^cr/) || ($trole=~/^ta/))) {   ($trole=~/^cr/) || ($trole=~/^ta/) ||
            ($trole=~/^co/))) {
        $userrolehash         $userrolehash
          {$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}           {$trole.':'.$username.':'.$domain.':'.$env{'user.name'}.':'.$env{'user.domain'}.':'}
                     =$tend.':'.$tstart;                      =$tend.':'.$tstart;
Line 2759  sub courserolelog { Line 2760  sub courserolelog {
     if (($trole eq 'cc') || ($trole eq 'in') ||      if (($trole eq 'cc') || ($trole eq 'in') ||
         ($trole eq 'ep') || ($trole eq 'ad') ||          ($trole eq 'ep') || ($trole eq 'ad') ||
         ($trole eq 'ta') || ($trole eq 'st') ||          ($trole eq 'ta') || ($trole eq 'st') ||
         ($trole=~/^cr/) || ($trole eq 'gr')) {          ($trole=~/^cr/) || ($trole eq 'gr') ||
           ($trole eq 'co')) {
         if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) {          if ($area =~ m-^/($match_domain)/($match_courseid)/?([^/]*)-) {
             my $cdom = $1;              my $cdom = $1;
             my $cnum = $2;              my $cnum = $2;
Line 3907  sub custom_roleprivs { Line 3909  sub custom_roleprivs {
         if (($rdummy ne 'con_lost') && ($roledef ne '')) {          if (($rdummy ne 'con_lost') && ($roledef ne '')) {
             my ($syspriv,$dompriv,$coursepriv)=split(/\_/,$roledef);              my ($syspriv,$dompriv,$coursepriv)=split(/\_/,$roledef);
             if (defined($syspriv)) {              if (defined($syspriv)) {
                   if ($trest =~ /^$match_community$/) {
                       $syspriv =~ s/bre\&S//; 
                   }
                 $$allroles{'cm./'}.=':'.$syspriv;                  $$allroles{'cm./'}.=':'.$syspriv;
                 $$allroles{$spec.'./'}.=':'.$syspriv;                  $$allroles{$spec.'./'}.=':'.$syspriv;
             }              }
Line 5045  sub allowed { Line 5050  sub allowed {
     my $courseprivid='';      my $courseprivid='';
   
     my $ownaccess;      my $ownaccess;
     # Community Coordinator browsing resource space.      # Community Coordinator or Assistant Co-author browsing resource space.
     if (($priv eq 'bro') && ($env{'user.author'})) {      if (($priv eq 'bro') && ($env{'user.author'})) {
         if ($uri eq '') {          if ($uri eq '') {
             $ownaccess = 1;              $ownaccess = 1;
Line 5055  sub allowed { Line 5060  sub allowed {
                 my $uname = $env{'user.name'};                  my $uname = $env{'user.name'};
                 if ($uri =~ m{^\Q$udom\E/?$}) {                  if ($uri =~ m{^\Q$udom\E/?$}) {
                     $ownaccess = 1;                      $ownaccess = 1;
                 } elsif ($uri =~ m{^\Q$udom/\E/$uname/}) {                  } elsif ($uri =~ m{^\Q$udom\E/\Q$uname\E/?}) {
                     unless ($uri =~ m{\.\./}) {                      unless ($uri =~ m{\.\./}) {
                         $ownaccess = 1;                          $ownaccess = 1;
                     }                      }
Line 5064  sub allowed { Line 5069  sub allowed {
                     if ($uri =~ m{^([^/]+)/?$}) {                      if ($uri =~ m{^([^/]+)/?$}) {
                         my $adom = $1;                          my $adom = $1;
                         foreach my $key (keys(%env)) {                          foreach my $key (keys(%env)) {
                             if ($key =~ m{^user\.role\.ca/\Q$adom\E}) {                              if ($key =~ m{^user\.role\.(ca|aa)/\Q$adom\E}) {
                                 my ($start,$end) = split('.',$env{$key});                                  my ($start,$end) = split('.',$env{$key});
                                 if (($now >= $start) && (!$end || $end < $now)) {                                  if (($now >= $start) && (!$end || $end < $now)) {
                                     $ownaccess = 1;                                      $ownaccess = 1;
Line 5075  sub allowed { Line 5080  sub allowed {
                     } elsif ($uri =~ m{^([^/]+)/([^/]+)/?}) {                      } elsif ($uri =~ m{^([^/]+)/([^/]+)/?}) {
                         my $adom = $1;                          my $adom = $1;
                         my $aname = $2;                          my $aname = $2;
                         if ($env{"user.role.ca./$adom/$aname"}) {                          foreach my $role ('ca','aa') { 
                             my ($start,$end) =                              if ($env{"user.role.$role./$adom/$aname"}) {
                                 split('.',$env{"user.role.ca./$adom/$aname"});                                  my ($start,$end) =
                             if (($now >= $start) && (!$end || $end < $now)) {                                      split('.',$env{"user.role.$role./$adom/$aname"});
                                 $ownaccess = 1;                                  if (($now >= $start) && (!$end || $end < $now)) {
                                       $ownaccess = 1;
                                       last;
                                   }
                             }                              }
                         }                          }
                     }                      }
Line 5091  sub allowed { Line 5099  sub allowed {
 # Course  # Course
   
     if ($env{'user.priv.'.$env{'request.role'}.'./'}=~/\Q$priv\E\&([^\:]*)/) {      if ($env{'user.priv.'.$env{'request.role'}.'./'}=~/\Q$priv\E\&([^\:]*)/) {
         unless (($priv eq 'bro' && !$ownaccess)) {          unless (($priv eq 'bro') && (!$ownaccess)) {
             $thisallowed.=$1;              $thisallowed.=$1;
         }          }
     }      }
Line 5100  sub allowed { Line 5108  sub allowed {
   
     if ($env{'user.priv.'.$env{'request.role'}.'./'.(split(/\//,$uri))[0].'/'}      if ($env{'user.priv.'.$env{'request.role'}.'./'.(split(/\//,$uri))[0].'/'}
        =~/\Q$priv\E\&([^\:]*)/) {         =~/\Q$priv\E\&([^\:]*)/) {
         unless (($priv eq 'bro' && !$ownaccess)) {          unless (($priv eq 'bro') && (!$ownaccess)) {
             $thisallowed.=$1;              $thisallowed.=$1;
         }          }
     }      }
Line 5112  sub allowed { Line 5120  sub allowed {
   
     if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseuri}      if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseuri}
        =~/\Q$priv\E\&([^\:]*)/) {         =~/\Q$priv\E\&([^\:]*)/) {
         unless (($priv eq 'bro' && !$ownaccess)) {          unless (($priv eq 'bro') && (!$ownaccess)) {
             $thisallowed.=$1;              $thisallowed.=$1;
         }          }
     }      }
Line 6134  sub devalidate_getgroups_cache { Line 6142  sub devalidate_getgroups_cache {
   
 sub plaintext {  sub plaintext {
     my ($short,$type,$cid,$forcedefault) = @_;      my ($short,$type,$cid,$forcedefault) = @_;
     if ($short =~ /^cr/) {      if ($short =~ m{^cr/}) {
  return (split('/',$short))[-1];   return (split('/',$short))[-1];
     }      }
     if (!defined($cid)) {      if (!defined($cid)) {
Line 6223  sub assignrole { Line 6231  sub assignrole {
                 $refused = 1;                  $refused = 1;
             }              }
             if ($refused) {              if ($refused) {
                 if (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {                  my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});
                   if (!$selfenroll && $context eq 'course') {
                       my %crsenv;
                       if ($role eq 'cc' || $role eq 'co') {
                           %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
                           if (($role eq 'cc') && ($cnum !~ /^$match_community$/)) {
                               if ($env{'request.role'} eq 'cc./'.$cdom.'/'.$cnum) {
                                   if ($crsenv{'internal.courseowner'} eq 
                                       $env{'user.name'}.':'.$env{'user.domain'}) {
                                       $refused = '';
                                   }
                               }
                           } elsif (($role eq 'co') && ($cnum =~ /^$match_community$/)) { 
                               if ($env{'request.role'} eq 'co./'.$cdom.'/'.$cnum) {
                                   if ($crsenv{'internal.courseowner'} eq 
                                       $env{'user.name'}.':'.$env{'user.domain'}) {
                                       $refused = '';
                                   }
                               }
                           }
                       }
                   } elsif (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
                     $refused = '';                      $refused = '';
                 } elsif ($context eq 'requestcourses') {                  } elsif ($context eq 'requestcourses') {
                     my @possroles = ('st','ta','ep','in','cc');                      my @possroles = ('st','ta','ep','in','cc','co');
                     if ((grep(/^\Q$role\E$/,@possroles)) && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) {                      if ((grep(/^\Q$role\E$/,@possroles)) && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) {
                         my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});                          my $wrongcc;
                         my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));                          if ($cnum =~ /^$match_community$/) {
                         if ($crsenv{'internal.courseowner'} eq                               $wrongcc = 1 if ($role eq 'cc');
                              $env{'user.name'}.':'.$env{'user.domain'}) {                          } else {
                             $refused = '';                              $wrongcc = 1 if ($role eq 'co');
                           }
                           unless ($wrongcc) {
                               my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
                               if ($crsenv{'internal.courseowner'} eq 
                                    $env{'user.name'}.':'.$env{'user.domain'}) {
                                   $refused = '';
                               }
                         }                          }
                     }                      }
                 }                  }
Removed from v.1.1039  
changed lines
  Added in v.1.1046

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