[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.1036 and 1.1042

version 1.1036, 2009/10/25 14:49:07 version 1.1042, 2009/11/06 01:49:10
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 5044  sub allowed { Line 5045  sub allowed {
     my $statecond=0;      my $statecond=0;
     my $courseprivid='';      my $courseprivid='';
   
       my $ownaccess;
       # Community Coordinator browsing resource space.
       if (($priv eq 'bro') && ($env{'user.author'})) {
           if ($uri eq '') {
               $ownaccess = 1;
           } else {
               if (($env{'user.domain'} ne '') && ($env{'user.name'} ne '')) {
                   my $udom = $env{'user.domain'};
                   my $uname = $env{'user.name'};
                   if ($uri =~ m{^\Q$udom\E/?$}) {
                       $ownaccess = 1;
                   } elsif ($uri =~ m{^\Q$udom\E/\Q$uname\E/?}) {
                       unless ($uri =~ m{\.\./}) {
                           $ownaccess = 1;
                       }
                   } elsif (($udom ne 'public') && ($uname ne 'public')) {
                       my $now = time;
                       if ($uri =~ m{^([^/]+)/?$}) {
                           my $adom = $1;
                           foreach my $key (keys(%env)) {
                               if ($key =~ m{^user\.role\.(ca|aa)/\Q$adom\E}) {
                                   my ($start,$end) = split('.',$env{$key});
                                   if (($now >= $start) && (!$end || $end < $now)) {
                                       $ownaccess = 1;
                                       last;
                                   }
                               }
                           }
                       } elsif ($uri =~ m{^([^/]+)/([^/]+)/?}) {
                           my $adom = $1;
                           my $aname = $2;
                           foreach my $role ('ca','aa') { 
                               if ($env{"user.role.$role./$adom/$aname"}) {
                                   my ($start,$end) =
                                       split('.',$env{"user.role.$role./$adom/$aname"});
                                   if (($now >= $start) && (!$end || $end < $now)) {
                                       $ownaccess = 1;
                                       last;
                                   }
                               }
                           }
                       }
                   }
               }
           }
       }
   
 # Course  # Course
   
     if ($env{'user.priv.'.$env{'request.role'}.'./'}=~/\Q$priv\E\&([^\:]*)/) {      if ($env{'user.priv.'.$env{'request.role'}.'./'}=~/\Q$priv\E\&([^\:]*)/) {
        $thisallowed.=$1;          unless (($priv eq 'bro' && !$ownaccess)) {
               $thisallowed.=$1;
           }
     }      }
   
 # Domain  # Domain
   
     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\&([^\:]*)/) {
        $thisallowed.=$1;          unless (($priv eq 'bro' && !$ownaccess)) {
               $thisallowed.=$1;
           }
     }      }
   
 # Course: uri itself is a course  # Course: uri itself is a course
Line 5064  sub allowed { Line 5116  sub allowed {
   
     if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseuri}      if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseuri}
        =~/\Q$priv\E\&([^\:]*)/) {         =~/\Q$priv\E\&([^\:]*)/) {
        $thisallowed.=$1;          unless (($priv eq 'bro' && !$ownaccess)) {
               $thisallowed.=$1;
           }
     }      }
   
 # URI is an uploaded document for this course, default permissions don't matter  # URI is an uploaded document for this course, default permissions don't matter
Line 6090  sub plaintext { Line 6144  sub plaintext {
     if (!defined($cid)) {      if (!defined($cid)) {
         $cid = $env{'request.course.id'};          $cid = $env{'request.course.id'};
     }      }
     if (defined($cid) && ($env{'course.'.$cid.'.'.$short.'.plaintext'} ne '')) {  
         unless ($forcedefault) {  
             my $roletext = $env{'course.'.$cid.'.'.$short.'.plaintext'};   
             &Apache::lonlocal::mt_escape(\$roletext);  
             return &Apache::lonlocal::mt($roletext);  
         }  
     }  
     my %rolenames = (      my %rolenames = (
                       Course    => 'std',                        Course    => 'std',
                       Community => 'alt1',                        Community => 'alt1',
                     );                      );
     if (defined($type) &&       if ($cid ne '') {
          defined($rolenames{$type}) &&           if ($env{'course.'.$cid.'.'.$short.'.plaintext'} ne '') {
          defined($prp{$short}{$rolenames{$type}})) {              unless ($forcedefault) {
                   my $roletext = $env{'course.'.$cid.'.'.$short.'.plaintext'}; 
                   &Apache::lonlocal::mt_escape(\$roletext);
                   return &Apache::lonlocal::mt($roletext);
               }
           }
       }
       if ((defined($type)) && (defined($rolenames{$type})) &&
           (defined($rolenames{$type})) && 
           (defined($prp{$short}{$rolenames{$type}}))) {
         return &Apache::lonlocal::mt($prp{$short}{$rolenames{$type}});          return &Apache::lonlocal::mt($prp{$short}{$rolenames{$type}});
     } else {      } elsif ($cid ne '') {
         return &Apache::lonlocal::mt($prp{$short}{'std'});          my $crstype = $env{'course.'.$cid.'.type'};
           if (($crstype ne '') && (defined($rolenames{$crstype})) &&
               (defined($prp{$short}{$rolenames{$crstype}}))) {
               return &Apache::lonlocal::mt($prp{$short}{$rolenames{$crstype}});
           }
     }      }
       return &Apache::lonlocal::mt($prp{$short}{'std'});
 }  }
   
 # ----------------------------------------------------------------- Assign Role  # ----------------------------------------------------------------- Assign Role
Line 6169  sub assignrole { Line 6230  sub assignrole {
                 if (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {                  if (($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 ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});
                         my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));                          my $wrongcc;
                         if ($crsenv{'internal.courseowner'} eq                           if ($cnum =~ /^$match_community$/) {
                              $env{'user.name'}.':'.$env{'user.domain'}) {                              $wrongcc = 1 if ($role eq 'cc');
                             $refused = '';                          } else {
                               $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 = '';
                               }
                         }                          }
                     }                      }
                 }                  }
Line 6547  sub createcourse { Line 6616  sub createcourse {
         if (($chome eq '') || ($chome eq 'no_host')) {          if (($chome eq '') || ($chome eq 'no_host')) {
             $uname = $cnum;              $uname = $cnum;
         } else {          } else {
             $uname = &generate_coursenum($udom);              $uname = &generate_coursenum($udom,$crstype);
         }          }
     } else {      } else {
         $uname = &generate_coursenum($udom);          $uname = &generate_coursenum($udom,$crstype);
     }      }
     return $uname if ($uname =~ /^error/);      return $uname if ($uname =~ /^error/);
 # -------------------------------------------------- Check supplied server name  # -------------------------------------------------- Check supplied server name
Line 6610  ENDINITMAP Line 6679  ENDINITMAP
   
 # ------------------------------------------------------------------- Create ID  # ------------------------------------------------------------------- Create ID
 sub generate_coursenum {  sub generate_coursenum {
     my ($udom) = @_;      my ($udom,$crstype) = @_;
     my $domdesc = &domain($udom);      my $domdesc = &domain($udom);
     return 'error: invalid domain' if ($domdesc eq '');      return 'error: invalid domain' if ($domdesc eq '');
     my $uname=int(1+rand(9)).      my $first;
       if ($crstype eq 'Community') {
           $first = '0';
       } else {
           $first = int(1+rand(9)); 
       } 
       my $uname=$first.
         ('a'..'z','A'..'Z','0'..'9')[int(rand(62))].          ('a'..'z','A'..'Z','0'..'9')[int(rand(62))].
         substr($$.time,0,5).unpack("H8",pack("I32",time)).          substr($$.time,0,5).unpack("H8",pack("I32",time)).
         unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};          unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
 # ----------------------------------------------- Make sure that does not exist  # ----------------------------------------------- Make sure that does not exist
     my $uhome=&homeserver($uname,$udom,'true');      my $uhome=&homeserver($uname,$udom,'true');
     unless (($uhome eq '') || ($uhome eq 'no_host')) {      unless (($uhome eq '') || ($uhome eq 'no_host')) {
         $uname=int(1+rand(9)).          if ($crstype eq 'Community') {
               $first = '0';
           } else {
               $first = int(1+rand(9));
           }
           $uname=$first.
                ('a'..'z','A'..'Z','0'..'9')[int(rand(62))].                 ('a'..'z','A'..'Z','0'..'9')[int(rand(62))].
                substr($$.time,0,5).unpack("H8",pack("I32",time)).                 substr($$.time,0,5).unpack("H8",pack("I32",time)).
                unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};                 unpack("H2",pack("I32",int(rand(255)))).$perlvar{'lonHostID'};
Line 10204  createcourse($udom,$description,$url,$co Line 10284  createcourse($udom,$description,$url,$co
   
 =item *  =item *
   
 generate_coursenum($udom) : get a unique (unused) course number in domain $udom  generate_coursenum($udom,$crstype) : get a unique (unused) course number in domain $udom for course type $crstype (Course or Community).
   
 =back  =back
   
Removed from v.1.1036  
changed lines
  Added in v.1.1042

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