[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.1025 and 1.1028

version 1.1025, 2009/09/03 21:23:36 version 1.1028, 2009/09/16 05:59:49
Line 5613  sub auto_validate_instcode { Line 5613  sub auto_validate_instcode {
     }      }
     my $response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'.      my $response=&unescape(&reply('autovalidateinstcode:'.$cdom.':'.
                            &escape($instcode).':'.&escape($owner),$homeserver));                             &escape($instcode).':'.&escape($owner),$homeserver));
     return $response;      my ($outcome,$description) = map { &unescape($_); } split('&',$response,2);
       return ($outcome,$description);
 }  }
   
 sub auto_create_password {  sub auto_create_password {
Line 6058  sub assignrole { Line 6059  sub assignrole {
         my $cwosec=$url;          my $cwosec=$url;
         $cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/;          $cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/;
  unless (&allowed('ccr',$cwosec)) {   unless (&allowed('ccr',$cwosec)) {
            &logthis('Refused custom assignrole: '.             my $refused = 1;
              $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.             if ($context eq 'requestcourses') {
     $env{'user.name'}.' at '.$env{'user.domain'});                 if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) {
            return 'refused';                      if ($role =~ m{^cr/($match_domain)/($match_username)/([^/]+)$}) {
                          if (($1 eq $env{'user.domain'}) && ($2 eq $env{'user.name'})) {
                              my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});
                              my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
                              if ($crsenv{'internal.courseowner'} eq
                                  $env{'user.name'}.':'.$env{'user.domain'}) {
                                  $refused = '';
                              }
                          }
                      }
                  }
              }
              if ($refused) {
                  &logthis('Refused custom assignrole: '.
                           $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.
                           ' by '.$env{'user.name'}.' at '.$env{'user.domain'});
                  return 'refused';
              }
         }          }
         $mrole='cr';          $mrole='cr';
     } elsif ($role =~ /^gr\//) {      } elsif ($role =~ /^gr\//) {
Line 6090  sub assignrole { Line 6108  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') {
                     if (($role eq 'cc') && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) {                      my @possroles = ('st','ta','ep','in','cc');
                         my ($cdom,$cnum) = ($cwosec =~ m{^/($match_domain)/($match_courseid)$});                      if ((grep(/^\Q$role\E$/,@possroles)) && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) {
                           my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});
                         my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));                          my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
                         if ($crsenv{'internal.courseowner'} eq                           if ($crsenv{'internal.courseowner'} eq 
                              $env{'user.name'}.':'.$env{'user.domain'}) {                               $env{'user.name'}.':'.$env{'user.domain'}) {
Line 6426  sub createcourse { Line 6445  sub createcourse {
         $course_owner,$crstype,$cnum,$context,$category)=@_;          $course_owner,$crstype,$cnum,$context,$category)=@_;
     $url=&declutter($url);      $url=&declutter($url);
     my $cid='';      my $cid='';
     unless (&allowed('ccc',$udom)) {      if ($context eq 'requestcourses') {
         if ($context eq 'requestcourses') {          my $can_create = 0;
             unless (&usertools_access($course_owner,$udom,$category,undef,$context)) {          my ($ownername,$ownerdom) = split(':',$course_owner);
                 return 'refused';          if ($udom eq $ownerdom) {
               if (&usertools_access($ownername,$ownerdom,$category,undef,
                                     $context)) {
                   $can_create = 1;
               }
           } else {
               my %userenv = &userenvironment($ownerdom,$ownername,'reqcrsotherdom.'.
                                              $category);
               if ($userenv{'reqcrsotherdom.'.$category} ne '') {
                   my @curr = split(',',$userenv{'reqcrsotherdom.'.$category});
                   if (@curr > 0) {
                       my @options = qw(approval validate autolimit);
                       my $optregex = join('|',@options);
                       if (grep(/^\Q$udom\E:($optregex)(=?\d*)$/,@curr)) {
                           $can_create = 1;
                       }
                   }
               }
           }
           if ($can_create) {
               unless ($ownername eq $env{'user.name'} && $ownerdom eq $env{'user.domain'}) {
                   unless (&allowed('ccc',$udom)) {
                       return 'refused'; 
                   }
             }              }
         } else {          } else {
             return 'refused';              return 'refused';
         }          }
       } elsif (!&allowed('ccc',$udom)) {
           return 'refused';
     }      }
 # --------------------------------------------------------------- Get Unique ID  # --------------------------------------------------------------- Get Unique ID
     my $uname;      my $uname;
Removed from v.1.1025  
changed lines
  Added in v.1.1028

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