[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.1511 and 1.1512

version 1.1511, 2023/06/02 01:20:29 version 1.1512, 2023/06/20 14:03:57
Line 2757  sub get_domain_defaults { Line 2757  sub get_domain_defaults {
                                   'coursecategories','ssl','autoenroll',                                    'coursecategories','ssl','autoenroll',
                                   'trust','helpsettings','wafproxy',                                    'trust','helpsettings','wafproxy',
                                   'ltisec','toolsec','domexttool',                                    'ltisec','toolsec','domexttool',
                                   'exttool'],$domain);                                    'exttool','privacy'],$domain);
     my @coursetypes = ('official','unofficial','community','textbook','placement');      my @coursetypes = ('official','unofficial','community','textbook','placement');
     if (ref($domconfig{'defaults'}) eq 'HASH') {      if (ref($domconfig{'defaults'}) eq 'HASH') {
         $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};           $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; 
Line 2968  sub get_domain_defaults { Line 2968  sub get_domain_defaults {
             }              }
         }          }
     }      }
       if (ref($domconfig{'privacy'}) eq 'HASH') {
           if (ref($domconfig{'privacy'}{'approval'}) eq 'HASH') {
               foreach my $domtype ('instdom','extdom') {
                   if (ref($domconfig{'privacy'}{'approval'}{$domtype}) eq 'HASH') {
                       foreach my $roletype ('domain','author','course','community') {
                           if ($domconfig{'privacy'}{'approval'}{$domtype}{$roletype} eq 'user') {
                               $domdefaults{'userapprovals'} = 1;
                               last;
                           }
                       }
                   }
                   last if ($domdefaults{'userapprovals'});
               }
           }
       }
     &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);      &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);
     return %domdefaults;      return %domdefaults;
 }  }
Line 5424  sub userrolelog { Line 5439  sub userrolelog {
 }  }
   
 sub courserolelog {  sub courserolelog {
     my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$selfenroll,$context)=@_;      my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$selfenroll,
           $context,$othdomby,$requester)=@_;
     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 5437  sub courserolelog { Line 5453  sub courserolelog {
                            selfenroll => $selfenroll,                             selfenroll => $selfenroll,
                            context    => $context,                             context    => $context,
                         );                          );
           if ($othdomby) {
               if ($othdomby eq 'othdombydc') {
                   $storehash{'approval'} = 'domain';
               } elsif ($othdomby eq 'othdombyuser') {
                   $storehash{'approval'} = 'user'; 
               }
               if ($requester ne '') {
                   $storehash{'requester'} = $requester;
               }
           }
         if ($trole eq 'gr') {          if ($trole eq 'gr') {
             $namespace = 'groupslog';              $namespace = 'groupslog';
             $storehash{'group'} = $sec;              $storehash{'group'} = $sec;
Line 5453  sub courserolelog { Line 5479  sub courserolelog {
 }  }
   
 sub domainrolelog {  sub domainrolelog {
     my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$context)=@_;      my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,
           $context,$othdomby,$requester)=@_;
     if ($area =~ m{^/($match_domain)/$}) {      if ($area =~ m{^/($match_domain)/$}) {
         my $cdom = $1;          my $cdom = $1;
         my $domconfiguser = &get_domainconfiguser($cdom);          my $domconfiguser = &get_domainconfiguser($cdom);
Line 5464  sub domainrolelog { Line 5491  sub domainrolelog {
                            end     => $tend,                             end     => $tend,
                            context => $context,                             context => $context,
                         );                          );
           if ($othdomby) {
               if ($othdomby eq 'othdombydc') {
                   $storehash{'approval'} = 'domain';
               } elsif ($othdomby eq 'othdombyuser') {
                   $storehash{'approval'} = 'user';
               }
               if ($requester ne '') {
                   $storehash{'requester'} = $requester;
               }
           }
         &write_log('domain',$namespace,\%storehash,$delflag,$username,          &write_log('domain',$namespace,\%storehash,$delflag,$username,
                    $domain,$domconfiguser,$cdom);                     $domain,$domconfiguser,$cdom);
     }      }
Line 5472  sub domainrolelog { Line 5509  sub domainrolelog {
 }  }
   
 sub coauthorrolelog {  sub coauthorrolelog {
     my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$context)=@_;      my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,
           $context,$othdomby,$requester)=@_;
     if ($area =~ m{^/($match_domain)/($match_username)$}) {      if ($area =~ m{^/($match_domain)/($match_username)$}) {
         my $audom = $1;          my $audom = $1;
         my $auname = $2;          my $auname = $2;
Line 5483  sub coauthorrolelog { Line 5521  sub coauthorrolelog {
                            end     => $tend,                             end     => $tend,
                            context => $context,                             context => $context,
                         );                          );
           if ($othdomby) {
               if ($othdomby eq 'othdombydc') {
                   $storehash{'approval'} = 'domain';
               } elsif ($othdomby eq 'othdombyuser') {
                   $storehash{'approval'} = 'user';
               }
               if ($requester ne '') {
                   $storehash{'requester'} = $requester;
               }
           }
         &write_log('author',$namespace,\%storehash,$delflag,$username,          &write_log('author',$namespace,\%storehash,$delflag,$username,
                    $domain,$auname,$audom);                     $domain,$auname,$audom);
     }      }
Line 8249  sub is_course_owner { Line 8297  sub is_course_owner {
 }  }
   
 sub is_advanced_user {  sub is_advanced_user {
     my ($udom,$uname) = @_;      my ($udom,$uname,$nocache) = @_;
       my ($is_adv,$is_author,$use_cache,$hashid);
     if ($udom ne '' && $uname ne '') {      if ($udom ne '' && $uname ne '') {
         if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {          if (($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
             if (wantarray) {              if (wantarray) {
Line 8257  sub is_advanced_user { Line 8306  sub is_advanced_user {
             } else {              } else {
                 return $env{'user.adv'};                  return $env{'user.adv'};
             }              }
           } elsif (!$nocache) {
               $use_cache = 1;
               $hashid = "$udom:$uname";  
               my ($info,$cached)=&is_cached_new('isadvau',$hashid);
               if ($cached) {
                   ($is_adv,$is_author) = split(/:/,$info);
                   if (wantarray) {
                       return ($is_adv,$is_author);
                   }
                   return $is_adv; 
               }
         }          }
     }      }
     my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1);      my %roleshash = &get_my_roles($uname,$udom,'userroles',undef,undef,undef,1);
     my %allroles;      my %allroles;
     my ($is_adv,$is_author);  
     foreach my $role (keys(%roleshash)) {      foreach my $role (keys(%roleshash)) {
         my ($trest,$tdomain,$trole,$sec) = split(/:/,$role);          my ($trest,$tdomain,$trole,$sec) = split(/:/,$role);
         my $area = '/'.$tdomain.'/'.$trest;          my $area = '/'.$tdomain.'/'.$trest;
Line 8292  sub is_advanced_user { Line 8351  sub is_advanced_user {
             }              }
         }          }
     }      }
       if ($use_cache) {
           my $cachetime = 600;
           &do_cache_new('isadvau',$hashid,$is_adv.':'.$is_author,$cachetime);
       }
     if (wantarray) {      if (wantarray) {
         return ($is_adv,$is_author);          return ($is_adv,$is_author);
     }      }
Line 10339  sub toggle_coursegroup_status { Line 10402  sub toggle_coursegroup_status {
 }  }
   
 sub modify_group_roles {  sub modify_group_roles {
     my ($cdom,$cnum,$group_id,$user,$end,$start,$userprivs,$selfenroll,$context) = @_;      my ($cdom,$cnum,$group_id,$user,$end,$start,$userprivs,$selfenroll,$context,
           $othdomby,$requester) = @_;
     my $url = '/'.$cdom.'/'.$cnum.'/'.$group_id;      my $url = '/'.$cdom.'/'.$cnum.'/'.$group_id;
     my $role = 'gr/'.&escape($userprivs);      my $role = 'gr/'.&escape($userprivs);
     my ($uname,$udom) = split(/:/,$user);      my ($uname,$udom) = split(/:/,$user);
     my $result = &assignrole($udom,$uname,$url,$role,$end,$start,'',$selfenroll,$context);      my $result = &assignrole($udom,$uname,$url,$role,$end,$start,'',$selfenroll,$context,
                                $othdomby,$requester);
     if ($result eq 'ok') {      if ($result eq 'ok') {
         &devalidate_getgroups_cache($udom,$uname,$cdom,$cnum);          &devalidate_getgroups_cache($udom,$uname,$cdom,$cnum);
     }      }
Line 10471  sub plaintext { Line 10536  sub plaintext {
   
 sub assignrole {  sub assignrole {
     my ($udom,$uname,$url,$role,$end,$start,$deleteflag,$selfenroll,      my ($udom,$uname,$url,$role,$end,$start,$deleteflag,$selfenroll,
         $context)=@_;          $context,$othdomby,$requester,$reqsec,$reqrole)=@_;
     my $mrole;      my $mrole;
     if ($role =~ /^cr\//) {      if ($role =~ /^cr\//) {
         my $cwosec=$url;          my $cwosec=$url;
         $cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/;          $cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/;
         if ((!&allowed('ccr',$cwosec)) && (!&allowed('ccr',$udom))) {          if ((!&allowed('ccr',$cwosec)) && (!&allowed('ccr',$udom))) {
            my $refused = 1;              my $refused = 1;
            if ($context eq 'requestcourses') {              if ($context eq 'requestcourses') {
                if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) {                  if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) {
                    if ($role =~ m{^cr/($match_domain)/($match_username)/([^/]+)$}) {                      if ($role =~ m{^cr/($match_domain)/($match_username)/([^/]+)$}) {
                        if (($1 eq $env{'user.domain'}) && ($2 eq $env{'user.name'})) {                          if (($1 eq $env{'user.domain'}) && ($2 eq $env{'user.name'})) {
                            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 %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'}) {
                                $refused = '';                                  $refused = '';
                            }                              }
                        }                          }
                    }                      }
                }                  }
            }              } elsif (($context eq 'course') && ($othdomby eq 'othdombyuser')) {
            if ($refused) {                  my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});
                &logthis('Refused custom assignrole: '.                  my ($sec) = ($url =~ m{^/\Q$cwosec\E/(.*)$});
                         $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.                  my $key = "$uname:$udom:$role:$sec";
                         ' by '.$env{'user.name'}.' at '.$env{'user.domain'});                  my %queuedrolereq = &Apache::lonnet::get('nohist_othdomqueued',[$key],$cdom,$cnum);
                return 'refused';                  if ((exists($queuedrolereq{$key})) && (ref($queuedrolereq{$key}) eq 'HASH')) {
            }                      if (($queuedrolereq{$key}{'adj'} eq 'user') && ($queuedrolereq{$key}{'requester'} eq $requester)) {
                           $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\//) {
         my $cwogrp=$url;          my $cwogrp=$url;
         $cwogrp=~s{^/($match_domain)/($match_courseid)/.*}{$1/$2};          $cwogrp=~s{^/($match_domain)/($match_courseid)/.*}{$1/$2};
         unless (&allowed('mdg',$cwogrp)) {          if (!&allowed('mdg',$cwogrp)) {
             &logthis('Refused group assignrole: '.              my $refused = 1;
               $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.              if (($refused) && ($othdomby eq 'othdombyuser') && ($requester ne '') && ($reqrole ne '')) {
                     $env{'user.name'}.' at '.$env{'user.domain'});                  my ($cdom,$cnum) = ($cwogrp =~ m{^/?($match_domain)/($match_courseid)$});
             return 'refused';                  my $key = "$uname:$udom:$reqrole:$reqsec";
                   my %queuedrolereq = &Apache::lonnet::get('nohist_othdomqueued',[$key],$cdom,$cnum);
                   if ((exists($queuedrolereq{$key})) && (ref($queuedrolereq{$key}) eq 'HASH')) {
                       if (($queuedrolereq{$key}{'adj'} eq 'user') && ($queuedrolereq{$key}{'requester'} eq $requester)) {
                           $refused = '';
                       }
                   }
               }
               if ($refused) {
                   &logthis('Refused group assignrole: '.
                            $udom.' '.$uname.' '.$url.' '.$role.' '.$end.' '.$start.' by '.
                            $env{'user.name'}.' at '.$env{'user.domain'});
                   return 'refused';
               }
         }          }
         $mrole='gr';          $mrole='gr';
     } else {      } else {
Line 10524  sub assignrole { Line 10612  sub assignrole {
             }              }
             if ($refused) {              if ($refused) {
                 my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});                  my ($cdom,$cnum) = ($cwosec =~ m{^/?($match_domain)/($match_courseid)$});
                 if (!$selfenroll && (($context eq 'course') || ($context eq 'ltienroll' && $env{'request.lti.login'}))) {                  if (!$selfenroll && ($othdomby ne 'othdombyuser') &&
                      (($context eq 'course') || ($context eq 'ltienroll' && $env{'request.lti.login'}))) {
                     my %crsenv;                      my %crsenv;
                     if ($role eq 'cc' || $role eq 'co') {                      if ($role eq 'cc' || $role eq 'co') {
                         %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));                          %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
Line 10550  sub assignrole { Line 10639  sub assignrole {
                     } elsif (($context eq 'ltienroll') && ($env{'request.lti.login'})) {                      } elsif (($context eq 'ltienroll') && ($env{'request.lti.login'})) {
                         $refused = '';                          $refused = '';
                     }                      }
                   } elsif ($othdomby eq 'othdombyuser') {
                       my ($key,%queuedrolereq);
                       if ($context eq 'course') {
                           my ($sec) = ($url =~ m{^/\Q$cwosec\E/(.*)$});
                           $key = "$uname:$udom:$role:$sec";
                           %queuedrolereq = &Apache::lonnet::get('nohist_othdomqueued',[$key],$cdom,$cnum);
                           if ((exists($queuedrolereq{$key})) && (ref($queuedrolereq{$key}) eq 'HASH')) {
                               if (($queuedrolereq{$key}{'adj'} eq 'user') && ($queuedrolereq{$key}{'requester'} eq $requester)) {
                                   if ((($role eq 'cc') && ($cnum !~ /^$match_community$/)) || 
                                       (($role eq 'co') && ($cnum =~ /^$match_community$/))) {
                                       my %crsenv = &userenvironment($cdom,$cnum,('internal.courseowner'));
                                       if ($crsenv{'internal.courseowner'} eq $requester) {
                                           $refused = '';
                                       }
                                   } elsif ($role =~ /^(?:in|ta|ep|st)$/) {
                                       $refused = '';
                                   }
                               }
                           }
                       } elsif (($context eq 'author') && ($role =~ /^ca|aa$/)) {
                           my $key = "$uname:$udom:$role"; 
                           my ($audom,$auname) = ($url =~ m{^/($match_domain)/($match_username)$});
                           if (($audom ne '') && ($auname ne '')) {
                               my %queuedrolereq = &Apache::lonnet::get('nohist_othdomqueued',[$key],$audom,$auname);
                               if ((exists($queuedrolereq{$key})) && (ref($queuedrolereq{$key}) eq 'HASH')) {
                                   if (($queuedrolereq{$key}{'adj'} eq 'user') && ($queuedrolereq{$key}{'requester'} eq $requester)) {
                                       $refused = '';
                                   }
                               }
                           }
                       } elsif (($context eq 'domain') && ($role ne 'dc') && ($role ne 'su')) {
                           my $key = "$uname:$udom:$role";
                           my ($roledom) = ($url =~ m{^/($match_domain)/\Q$role\E$});
                           if ($roledom ne '') {
                               my $confname = $roledom.'-domainconfig';
                               my %queuedrolereq = &Apache::lonnet::get('nohist_othdomqueued',[$key],$roledom,$confname);
                               if ((exists($queuedrolereq{$key})) && (ref($queuedrolereq{$key}) eq 'HASH')) {
                                   if (($queuedrolereq{$key}{'adj'} eq 'user') && ($queuedrolereq{$key}{'requester'} eq $requester)) {
                                       $refused = '';
                                   }
                               }
                           }
                       }
                 } elsif ($context eq 'requestcourses') {                  } elsif ($context eq 'requestcourses') {
                     my @possroles = ('st','ta','ep','in','cc','co');                      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 '')) {
Line 10662  sub assignrole { Line 10794  sub assignrole {
                                                  $origstart,$selfenroll,$context);                                                   $origstart,$selfenroll,$context);
             }              }
             &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,              &courserolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
                            $selfenroll,$context);                             $selfenroll,$context,$othdomby,$requester);
         } elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') ||          } elsif (($role eq 'li') || ($role eq 'dg') || ($role eq 'sc') ||
                  ($role eq 'au') || ($role eq 'dc') || ($role eq 'dh') ||                   ($role eq 'au') || ($role eq 'dc') || ($role eq 'dh') ||
                  ($role eq 'da')) {                   ($role eq 'da')) {
             &domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,              &domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
                            $context);                             $context,$othdomby,$requester);
         } elsif (($role eq 'ca') || ($role eq 'aa')) {          } elsif (($role eq 'ca') || ($role eq 'aa')) {
             &coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,              &coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
                              $context);                                $context,$othdomby,$requester); 
         }          }
         if ($role eq 'cc') {          if ($role eq 'cc') {
             &autoupdate_coowners($url,$end,$start,$uname,$udom);              &autoupdate_coowners($url,$end,$start,$uname,$udom);
Line 11022  sub modifystudent { Line 11154  sub modifystudent {
   
 sub modify_student_enrollment {  sub modify_student_enrollment {
     my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,      my ($udom,$uname,$uid,$first,$middle,$last,$gene,$usec,$end,$start,$type,
         $locktype,$cid,$selfenroll,$context,$credits,$instsec) = @_;          $locktype,$cid,$selfenroll,$context,$credits,$instsec,$othdomby,$requester) = @_;
     my ($cdom,$cnum,$chome);      my ($cdom,$cnum,$chome);
     if (!$cid) {      if (!$cid) {
  unless ($cid=$env{'request.course.id'}) {   unless ($cid=$env{'request.course.id'}) {
Line 11083  sub modify_student_enrollment { Line 11215  sub modify_student_enrollment {
  $uurl.='/'.$usec;   $uurl.='/'.$usec;
     }      }
     my $result = &assignrole($udom,$uname,$uurl,'st',$end,$start,undef,      my $result = &assignrole($udom,$uname,$uurl,'st',$end,$start,undef,
                              $selfenroll,$context);                               $selfenroll,$context,$othdomby,$requester);
     if ($result ne 'ok') {      if ($result ne 'ok') {
         if ($old_entry{$user} ne '') {          if ($old_entry{$user} ne '') {
             $reply = &cput('classlist',\%old_entry,$cdom,$cnum);              $reply = &cput('classlist',\%old_entry,$cdom,$cnum);
Line 11359  sub store_userdata { Line 11491  sub store_userdata {
 # ---------------------------------------------------------- Assign Custom Role  # ---------------------------------------------------------- Assign Custom Role
   
 sub assigncustomrole {  sub assigncustomrole {
     my ($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start,$deleteflag,$selfenroll,$context)=@_;      my ($udom,$uname,$url,$rdom,$rnam,$rolename,$end,$start,$deleteflag,
           $selfenroll,$context,$othdomby,$requester)=@_;
     return &assignrole($udom,$uname,$url,'cr/'.$rdom.'/'.$rnam.'/'.$rolename,      return &assignrole($udom,$uname,$url,'cr/'.$rdom.'/'.$rnam.'/'.$rolename,
                        $end,$start,$deleteflag,$selfenroll,$context);                         $end,$start,$deleteflag,$selfenroll,$context,$othdomby,
                          $requester);
 }  }
   
 # ----------------------------------------------------------------- Revoke Role  # ----------------------------------------------------------------- Revoke Role
Removed from v.1.1511  
changed lines
  Added in v.1.1512

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