[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.1513 and 1.1519

version 1.1513, 2023/07/20 12:47:09 version 1.1519, 2023/11/18 14:33:07
Line 2753  sub get_domain_defaults { Line 2753  sub get_domain_defaults {
          &get_dom('configuration',['defaults','quotas',           &get_dom('configuration',['defaults','quotas',
                                   'requestcourses','inststatus',                                    'requestcourses','inststatus',
                                   'coursedefaults','usersessions',                                    'coursedefaults','usersessions',
                                   'requestauthor','selfenrollment',                                    'requestauthor','authordefaults',
                                   'coursecategories','ssl','autoenroll',                                    'selfenrollment','coursecategories',
                                   'trust','helpsettings','wafproxy',                                    'ssl','autoenroll','trust',
                                     'helpsettings','wafproxy',
                                   'ltisec','toolsec','domexttool',                                    'ltisec','toolsec','domexttool',
                                   'exttool','privacy'],$domain);                                    'exttool','privacy'],$domain);
     my @coursetypes = ('official','unofficial','community','textbook','placement');      my @coursetypes = ('official','unofficial','community','textbook','placement');
Line 2801  sub get_domain_defaults { Line 2802  sub get_domain_defaults {
     if (ref($domconfig{'requestauthor'}) eq 'HASH') {      if (ref($domconfig{'requestauthor'}) eq 'HASH') {
         $domdefaults{'requestauthor'} = $domconfig{'requestauthor'};          $domdefaults{'requestauthor'} = $domconfig{'requestauthor'};
     }      }
       if (ref($domconfig{'authordefaults'}) eq 'HASH') {
           foreach my $item ('nocodemirror','copyright','sourceavail','domcoordacc','editors') {
               if ($item eq 'editors') {
                   if (ref($domconfig{'authordefaults'}{'editors'}) eq 'ARRAY') {
                       $domdefaults{$item} = join(',',@{$domconfig{'authordefaults'}{'editors'}});
                   }
               } else {
                   $domdefaults{$item} = $domconfig{'authordefaults'}{$item};
               }
           }
       }
     if (ref($domconfig{'inststatus'}) eq 'HASH') {      if (ref($domconfig{'inststatus'}) eq 'HASH') {
         foreach my $item ('inststatustypes','inststatusorder','inststatusguest') {          foreach my $item ('inststatustypes','inststatusorder','inststatusguest') {
             $domdefaults{$item} = $domconfig{'inststatus'}{$item};              $domdefaults{$item} = $domconfig{'inststatus'}{$item};
Line 2823  sub get_domain_defaults { Line 2835  sub get_domain_defaults {
             if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') {              if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') {
                 $domdefaults{$type.'quota'} = $domconfig{'coursedefaults'}{'uploadquota'}{$type};                  $domdefaults{$type.'quota'} = $domconfig{'coursedefaults'}{'uploadquota'}{$type};
             }              }
               if (ref($domconfig{'coursedefaults'}{'coursequota'}) eq 'HASH') {
                   $domdefaults{$type.'coursequota'} = $domconfig{'coursedefaults'}{'coursequota'}{$type};
               }
             if ($domdefaults{'postsubmit'} eq 'on') {              if ($domdefaults{'postsubmit'} eq 'on') {
                 if (ref($domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}) eq 'HASH') {                  if (ref($domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}) eq 'HASH') {
                     $domdefaults{$type.'postsubtimeout'} =                       $domdefaults{$type.'postsubtimeout'} = 
Line 3918  sub can_edit_resource { Line 3933  sub can_edit_resource {
         }          }
     }      }
   
   #
   # For /adm/viewcoauthors can only edit if author or co-author who is manager.
   #
   
       if (($resurl eq '/adm/viewcoauthors') && ($cnum ne '') && ($cdom ne '')) {
           if (((&allowed('cca',"$cdom/$cnum")) ||
                (&allowed('caa',"$cdom/$cnum"))) ||
                ((&allowed('vca',"$cdom/$cnum") ||
                  &allowed('vaa',"$cdom/$cnum")) &&
                 ($env{"environment.internal.manager./$cdom/$cnum"}))) {
               $home = $env{'user.home'};
               $cfile = $resurl;
               if ($env{'form.forceedit'}) {
                   $forceview = 1;
               } else {
                   $forceedit = 1;
               }
               return ($cfile,$home,$switchserver,$forceedit,$forceview);
           } else {
               return;
           }
       }
   
     if ($env{'request.course.id'}) {      if ($env{'request.course.id'}) {
         my $crsedit = &allowed('mdc',$env{'request.course.id'});          my $crsedit = &allowed('mdc',$env{'request.course.id'});
         if ($group ne '') {          if ($group ne '') {
Line 5468  sub courserolelog { Line 5506  sub courserolelog {
             $storehash{'group'} = $sec;              $storehash{'group'} = $sec;
         } else {          } else {
             $storehash{'section'} = $sec;              $storehash{'section'} = $sec;
               my ($curruserdomstr,$newuserdomstr);
               if (exists($env{'course.'.$cdom.'_'.$cnum.'.internal.userdomains'})) {
                   $curruserdomstr = $env{'course.'.$env{'request.course.id'}.'.internal.userdomains'};
               } else {
                   my %courseinfo = &coursedescription($cdom.'/'.$cnum);
                   $curruserdomstr = $courseinfo{'internal.userdomains'};
               }
               if ($curruserdomstr ne '') {
                   my @udoms = split(/,/,$curruserdomstr);
                   unless (grep(/^\Q$domain\E/,@udoms)) {
                       push(@udoms,$domain);
                       $newuserdomstr = join(',',sort(@udoms));
                   }
               } else {
                   $newuserdomstr = $domain;
               }
               if ($newuserdomstr ne '') {
                   my $putresult = &put('environment',{ 'internal.userdomains' => $newuserdomstr },
                                        $cdom,$cnum);
                   if ($putresult eq 'ok') {
                       unless (($selfenroll) || ($context eq 'selfenroll')) { 
                           if (($context eq 'createcourse') || ($context eq 'requestcourses') ||
                               ($context eq 'automated') || ($context eq 'domain')) {
                               $env{'course.'.$cdom.'_'.$cnum.'.internal.userdomains'} = $newuserdomstr;
                           } elsif ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
                               &appenv({'course.'.$cdom.'_'.$cnum.'.internal.userdomains' => $newuserdomstr});
                           }
                       }
                   }
               }
         }          }
         &write_log('course',$namespace,\%storehash,$delflag,$username,          &write_log('course',$namespace,\%storehash,$delflag,$username,
                    $domain,$cnum,$cdom);                     $domain,$cnum,$cdom);
Line 6911  sub rolesinit { Line 6979  sub rolesinit {
     my %firstaccess = &dump('firstaccesstimes', $domain, $username);      my %firstaccess = &dump('firstaccesstimes', $domain, $username);
     my %timerinterval = &dump('timerinterval', $domain, $username);      my %timerinterval = &dump('timerinterval', $domain, $username);
     my (%coursetimerstarts, %firstaccchk, %firstaccenv, %coursetimerintervals,      my (%coursetimerstarts, %firstaccchk, %firstaccenv, %coursetimerintervals,
         %timerintchk, %timerintenv);          %timerintchk, %timerintenv, %coauthorenv);
   
     foreach my $key (keys(%firstaccess)) {      foreach my $key (keys(%firstaccess)) {
         my ($cid, $rest) = split(/\0/, $key);          my ($cid, $rest) = split(/\0/, $key);
Line 6925  sub rolesinit { Line 6993  sub rolesinit {
   
     my %allroles=();      my %allroles=();
     my %allgroups=();      my %allgroups=();
       my %gotcoauconfig=();
   
     for my $area (grep { ! /^rolesdef_/ } keys(%rolesdump)) {      for my $area (grep { ! /^rolesdef_/ } keys(%rolesdump)) {
         my $role = $rolesdump{$area};          my $role = $rolesdump{$area};
Line 6976  sub rolesinit { Line 7045  sub rolesinit {
         } else {          } else {
         # Normal role, defined in roles.tab          # Normal role, defined in roles.tab
             &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);              &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
               if (($trole eq 'ca') || ($trole eq 'aa')) {
                   (undef,my ($audom,$auname)) = split(/\//,$area);
                   unless ($gotcoauconfig{$area}) {
                       my @ca_settings = ('authoreditors','coauthorlist','coauthoroptin');
                       my %info = &userenvironment($audom,$auname,@ca_settings);
                       $gotcoauconfig{$area} = 1;
                       foreach my $item (@ca_settings) {
                           if (exists($info{$item})) {
                               my $name = $item;
                               if ($item eq 'authoreditors') {
                                   $name = 'editors';
                               }
                               $coauthorenv{"environment.internal.$name.$area"} = $info{$item};
                           }
                       }
                   }
               }
         }          }
   
         my $cid = $tdomain.'_'.$trest;          my $cid = $tdomain.'_'.$trest;
Line 7004  sub rolesinit { Line 7090  sub rolesinit {
     $env{'user.adv'} = $userroles{'user.adv'};      $env{'user.adv'} = $userroles{'user.adv'};
     $env{'user.rar'} = $userroles{'user.rar'};      $env{'user.rar'} = $userroles{'user.rar'};
   
     return (\%userroles,\%firstaccenv,\%timerintenv);      return (\%userroles,\%firstaccenv,\%timerintenv,\%coauthorenv);
 }  }
   
 sub set_arearole {  sub set_arearole {
Line 8155  sub usertools_access { Line 8241  sub usertools_access {
         %tools = (          %tools = (
                       requestauthor => 1,                        requestauthor => 1,
                  );                   );
       } elsif ($context eq 'authordefaults') {
           %tools = (
                         webdav    => 1,
                    );
     } else {      } else {
         %tools = (          %tools = (
                       aboutme   => 1,                        aboutme   => 1,
                       blog      => 1,                        blog      => 1,
                       webdav    => 1,  
                       portfolio => 1,                        portfolio => 1,
                         portaccess => 1,
                       timezone  => 1,                        timezone  => 1,
                  );                   );
     }      }
Line 8177  sub usertools_access { Line 8267  sub usertools_access {
                 return $env{'environment.canrequest.'.$tool};                  return $env{'environment.canrequest.'.$tool};
             } elsif ($context eq 'requestauthor') {              } elsif ($context eq 'requestauthor') {
                 return $env{'environment.canrequest.author'};                  return $env{'environment.canrequest.author'};
               } elsif ($context eq 'authordefaults') {
                   if ($tool eq 'webdav') {
                       return $env{'environment.availabletools.'.$tool};
                   }
             } else {              } else {
                 return $env{'environment.availabletools.'.$tool};                  return $env{'environment.availabletools.'.$tool};
             }              }
Line 8185  sub usertools_access { Line 8279  sub usertools_access {
   
     my ($toolstatus,$inststatus,$envkey);      my ($toolstatus,$inststatus,$envkey);
     if ($context eq 'requestauthor') {      if ($context eq 'requestauthor') {
         $envkey = $context;           $envkey = $context;
       } elsif ($context eq 'authordefaults') {
           if ($tool eq 'webdav') {
               $envkey = 'tools.'.$tool;
           }
     } else {      } else {
         $envkey = $context.'.'.$tool;          $envkey = $context.'.'.$tool;
     }      }
Line 8759  sub allowed { Line 8857  sub allowed {
   
 # If this is generating or modifying users, exit with special codes  # If this is generating or modifying users, exit with special codes
   
     if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:caa:'=~/\:\Q$priv\E\:/) {      if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:caa:vca:vaa:'=~/\:\Q$priv\E\:/) {
  if (($priv eq 'cca') || ($priv eq 'caa')) {   if (($priv eq 'cca') || ($priv eq 'caa')) {
     my ($audom,$auname)=split('/',$uri);      my ($audom,$auname)=split('/',$uri);
 # no author name given, so this just checks on the general right to make a co-author in this domain  # no author name given, so this just checks on the general right to make a co-author in this domain
Line 8768  sub allowed { Line 8866  sub allowed {
     if (($auname ne $env{'user.name'} && $env{'request.role'} !~ /^dc\./) ||      if (($auname ne $env{'user.name'} && $env{'request.role'} !~ /^dc\./) ||
  (($audom ne $env{'user.domain'} && $env{'request.role'} !~ /^dc\./) &&   (($audom ne $env{'user.domain'} && $env{'request.role'} !~ /^dc\./) &&
  ($audom ne $env{'request.role.domain'}))) { return ''; }   ($audom ne $env{'request.role.domain'}))) { return ''; }
    } elsif (($priv eq 'vca') || ($priv eq 'vaa')) {
               my ($audom,$auname)=split('/',$uri);
               unless ($auname) { return $thisallowed; }
               unless (($env{'request.role'} eq "dc./$audom") ||
                       ($env{'request.role'} eq "ca./$uri")) {
                   return '';
               }
  }   }
  return $thisallowed;   return $thisallowed;
     }      }
Line 10537  sub plaintext { Line 10642  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,$othdomby,$requester,$reqsec,$reqrole)=@_;          $context,$othdomby,$requester,$reqsec,$reqrole)=@_;
     my $mrole;      my ($mrole,$rolelogcontext);
     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/;
Line 10734  sub assignrole { Line 10839  sub assignrole {
                             }                              }
                         }                          }
                     }                      }
                   } elsif (($context eq 'author') && (($role eq 'ca' || $role eq 'aa'))) {
                       if ($url =~ m{^/($match_domain)/($match_username)$}) {
                           my ($audom,$auname) = ($1,$2);
                           if ((&Apache::lonnet::allowed('v'.$role,"$audom/$auname")) &&
                               ($env{"environment.internal.manager.$url"})) {
                               $refused = '';
                               $rolelogcontext = 'coauthor';
                           }
                       }
                 }                  }
                 if ($refused) {                  if ($refused) {
                     &logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url.                      &logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url.
Line 10801  sub assignrole { Line 10915  sub assignrole {
             &domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,              &domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
                            $context,$othdomby,$requester);                             $context,$othdomby,$requester);
         } elsif (($role eq 'ca') || ($role eq 'aa')) {          } elsif (($role eq 'ca') || ($role eq 'aa')) {
               if ($rolelogcontext eq '') {
                   $rolelogcontext = $context;
               }
             &coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,              &coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
                              $context,$othdomby,$requester);                                $rolelogcontext,$othdomby,$requester); 
         }          }
         if ($role eq 'cc') {          if ($role eq 'cc') {
             &autoupdate_coowners($url,$end,$start,$uname,$udom);              &autoupdate_coowners($url,$end,$start,$uname,$udom);
Removed from v.1.1513  
changed lines
  Added in v.1.1519

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