[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.1331 and 1.1332

version 1.1331, 2016/12/05 00:52:02 version 1.1332, 2017/01/02 19:44:20
Line 2247  sub get_domain_defaults { Line 2247  sub get_domain_defaults {
                                   'coursedefaults','usersessions',                                    'coursedefaults','usersessions',
                                   'requestauthor','selfenrollment',                                    'requestauthor','selfenrollment',
                                   'coursecategories','ssl','autoenroll',                                    'coursecategories','ssl','autoenroll',
                                   'trust'],$domain);                                    'trust','helpsettings'],$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 2392  sub get_domain_defaults { Line 2392  sub get_domain_defaults {
     if (ref($domconfig{'autoenroll'}) eq 'HASH') {      if (ref($domconfig{'autoenroll'}) eq 'HASH') {
         $domdefaults{'autofailsafe'} = $domconfig{'autoenroll'}{'autofailsafe'};          $domdefaults{'autofailsafe'} = $domconfig{'autoenroll'}{'autofailsafe'};
     }      }
       if (ref($domconfig{'helpsettings'}) eq 'HASH') {
           $domdefaults{'submitbugs'} = $domconfig{'helpsettings'}{'submitbugs'};
           if (ref($domconfig{'helpsettings'}{'adhoc'}) eq 'HASH') {
               $domdefaults{'adhocroles'} = $domconfig{'helpsettings'}{'adhoc'};
           }
       }
     &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);      &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);
     return %domdefaults;      return %domdefaults;
 }  }
Line 4484  sub get_my_roles { Line 4490  sub get_my_roles {
     return %returnhash;      return %returnhash;
 }  }
   
   sub get_my_adhocroles {
       my ($cid) = @_;
       my (@possroles,%description);
       if ($cid =~ /^($match_domain)_($match_courseid)$/) {
           my $cdom = $1;
           my $cnum = $2;
           if ($env{"user.role.dh./$cdom/"}) {
               my $then=$env{'user.login.time'};
               my $update=$env{'user.update.time'};
               my $liverole = 1;
               my ($tstart,$tend)=split(/\./,$env{'user.role.dh./'.$cdom});
               my $limit = $update;
               if ($env{'request.role'} eq 'dh./'.$cdom.'/') {
                   $limit = $then;
               }
               if ($tstart && $tstart>$limit) { $liverole = 0; }
               if ($tend   && $tend  <$limit) { $liverole = 0; }
               if ($liverole) {
                   if (&homeserver($cnum,$cdom) ne 'no_host') {
                       my %domdefaults = &get_domain_defaults($cdom);
                       if (ref($domdefaults{'adhocroles'}) eq 'HASH') {
                           my $count = 0;
                           my %domcurrent = %{$domdefaults{'adhocroles'}};
                           my (%ordered,%access_in_dom);
                           foreach my $role (sort(keys(%domcurrent))) {
                               my ($order,$desc,$access_in_dom);
                               if (ref($domcurrent{$role}) eq 'HASH') {
                                   $order = $domcurrent{$role}{'order'};
                                   $desc = $domcurrent{$role}{'desc'};
                                   $access_in_dom{$role} = $domcurrent{$role}{'access'};
                               }
                               if ($order eq '') {
                                   $order = $count;
                               }
                               $ordered{$order} = $role;
                               if ($desc ne '') {
                                   $description{$role} = $desc;
                               } else {
                                   $description{$role}= $role;
                               }
                               $count++;
                           }
                           my @roles_by_num = ();
                           foreach my $item (sort {$a <=> $b } (keys(%ordered))) {
                               push(@roles_by_num,$ordered{$item});
                           }
                           if (@roles_by_num) {
                               my %settings;
                               if ($env{'request.course.id'} eq $cid) {
                                   foreach my $envkey (keys(%env)) {
                                       if ($envkey =~ /^\Qcourse.$cid.\E(internal\.adhoc.+)$/) {
                                           $settings{$1} = $env{$envkey};
                                       }
                                   }
                               } else {
                                   %settings = &dump('environment',$cdom,$cnum,'internal\.adhoc');
                               }
                               my %setincrs;
                               if ($settings{'internal.adhocaccess'}) {
                                   map { $setincrs{$_} = 1; } split(/,/,$settings{'internal.adhocaccess'});
                               }
                               my @statuses;
                               if ($env{'environment.inststatus'}) {
                                   @statuses = split(/,/,$env{'environment.inststatus'});
                               }
                               my $user = $env{'user.name'}.':'.$env{'user.domain'};
                               foreach my $role (@roles_by_num) {
                                   my ($curraccess,@okstatus,@personnel);
                                   if ($setincrs{$role}) {
                                       ($curraccess,my $rest) = split(/=/,$settings{'internal.adhoc.'.$role});
                                       if ($curraccess eq 'status') {
                                           @okstatus = split(/\&/,$rest);
                                       } elsif (($curraccess eq 'exc') || ($curraccess eq 'inc')) {
                                           @personnel = split(/\&/,$rest);
                                       }
                                   } else {
                                       $curraccess = $access_in_dom{$role};
                                       if ($curraccess eq 'status') {
                                           if (ref($domcurrent{$role}{$curraccess}) eq 'ARRAY') {
                                               @okstatus = @{$domcurrent{$role}{$curraccess}};
                                           }
                                       } elsif (($curraccess eq 'exc') || ($curraccess eq 'inc')) {
                                           if (ref($domcurrent{$role}{$curraccess}) eq 'ARRAY') {
                                               @personnel = @{$domcurrent{$role}{$curraccess}};
                                           }
                                       }
                                   }
                                   if ($curraccess eq 'none') {
                                       next;
                                   } elsif ($curraccess eq 'all') {
                                       push(@possroles,$role);
                                   } elsif ($curraccess eq 'status') {
                                       if (@okstatus) {
                                           if (!@statuses) {
                                               if (grep(/^default$/,@okstatus)) {
                                                   push(@possroles,$role);
                                               }
                                           } else {
                                               foreach my $status (@okstatus) {
                                                   if (grep(/^\Q$status\E$/,@statuses)) {
                                                       push(@possroles,$role);
                                                       last;
                                                   }
                                               }
                                           }
                                       }
                                   } elsif (($curraccess eq 'exc') || ($curraccess eq 'inc')) {
                                       if (grep(/^\Q$user\E$/,@personnel)) {
                                           if ($curraccess eq 'exc') {
                                               push(@possroles,$role);
                                           }
                                       } elsif ($curraccess eq 'inc') {
                                           push(@possroles,$role);
                                       }
                                   }
                               }
                           }
                       }
                   }
               }
           }
       }
       return (\@possroles,\%description);
   }
   
 # ----------------------------------------------------- Frontpage Announcements  # ----------------------------------------------------- Frontpage Announcements
 #  #
 #  #
Line 4724  sub get_domain_roles { Line 4855  sub get_domain_roles {
     return %personnel;      return %personnel;
 }  }
   
   sub get_active_domroles {
       my ($dom,$roles) = @_;
       return () unless (ref($roles) eq 'ARRAY');
       my $now = time;
       my %dompersonnel = &get_domain_roles($dom,$roles,$now,$now);
       my %domroles;
       foreach my $server (keys(%dompersonnel)) {
           foreach my $user (sort(keys(%{$dompersonnel{$server}}))) {
               my ($trole,$uname,$udom,$runame,$rudom,$rsec) = split(/:/,$user);
               $domroles{$uname.':'.$udom} = $dompersonnel{$server}{$user};
           }
       }
       return %domroles;
   }
   
 # ----------------------------------------------------------- Interval timing   # ----------------------------------------------------------- Interval timing 
   
 {  {
Line 5616  sub custom_roleprivs { Line 5762  sub custom_roleprivs {
                     $$allroles{$spec.'./'.$tdomain.'/'}.=':'.$dompriv;                      $$allroles{$spec.'./'.$tdomain.'/'}.=':'.$dompriv;
                 }                  }
                 if (($trest ne '') && (defined($coursepriv))) {                  if (($trest ne '') && (defined($coursepriv))) {
                       if ($trole =~ m{^cr/$tdomain/$tdomain\Q-domainconfig\E/([^/]+)$}) {
                           my $rolename = $1;
                           $coursepriv = &course_adhocrole_privs($rolename,$tdomain,$trest,$coursepriv);
                       }
                     $$allroles{'cm.'.$area}.=':'.$coursepriv;                      $$allroles{'cm.'.$area}.=':'.$coursepriv;
                     $$allroles{$spec.'.'.$area}.=':'.$coursepriv;                      $$allroles{$spec.'.'.$area}.=':'.$coursepriv;
                 }                  }
Line 5624  sub custom_roleprivs { Line 5774  sub custom_roleprivs {
     }      }
 }  }
   
   sub course_adhocrole_privs {
       my ($rolename,$cdom,$cnum,$coursepriv) = @_;
       my %overrides = &get('environment',["internal.adhocpriv.$rolename"],$cdom,$cnum);
       if ($overrides{"internal.adhocpriv.$rolename"}) {
           my (%currprivs,%storeprivs);
           foreach my $item (split(/:/,$coursepriv)) {
               my ($priv,$restrict) = split(/\&/,$item);
               $currprivs{$priv} = $restrict;
           }
           my (%possadd,%possremove,%full);
           foreach my $item (split(/\:/,$Apache::lonnet::pr{'cr:c'})) {
               my ($priv,$restrict)=split(/\&/,$item);
               $full{$priv} = $restrict;
           }
           foreach my $item (split(/,/,$overrides{"internal.adhocpriv.$rolename"})) {
                next if ($item eq '');
                my ($rule,$rest) = split(/=/,$item);
                next unless (($rule eq 'off') || ($rule eq 'on'));
                foreach my $priv (split(/:/,$rest)) {
                    if ($priv ne '') {
                        if ($rule eq 'off') {
                            $possremove{$priv} = 1;
                        } else {
                            $possadd{$priv} = 1;
                        }
                    }
                }
            }
            foreach my $priv (sort(keys(%full))) {
                if (exists($currprivs{$priv})) {
                    unless (exists($possremove{$priv})) {
                        $storeprivs{$priv} = $currprivs{$priv};
                    }
                } elsif (exists($possadd{$priv})) {
                    $storeprivs{$priv} = $full{$priv};
                }
            }
            $coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs)));
        }
        return $coursepriv;
   }
   
 sub group_roleprivs {  sub group_roleprivs {
     my ($allgroups,$area,$group_privs,$tend,$tstart) = @_;      my ($allgroups,$area,$group_privs,$tend,$tstart) = @_;
     my $access = 1;      my $access = 1;
Line 5867  sub set_adhoc_privileges { Line 6059  sub set_adhoc_privileges {
     my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'},      my %userroles = &set_arearole($role,$area,'','',$env{'user.domain'},
                                   $env{'user.name'},1);                                    $env{'user.name'},1);
     my %rolehash = ();      my %rolehash = ();
     if ($role =~ m{^cr/$dcdom/$dcdom\Q-domainconfig\E/}) {      if ($role =~ m{^\Qcr/$dcdom/$dcdom\E\-domainconfig/(\w+)$}) {
           my $rolename = $1;
         &custom_roleprivs(\%rolehash,$role,$dcdom,$pickedcourse,$spec,$area);          &custom_roleprivs(\%rolehash,$role,$dcdom,$pickedcourse,$spec,$area);
           my %domdef = &get_domain_defaults($dcdom);
           if (ref($domdef{'adhocroles'}) eq 'HASH') {
               if (ref($domdef{'adhocroles'}{$rolename}) eq 'HASH') {
                   &appenv({'request.role.desc' => $domdef{'adhocroles'}{$rolename}{'desc'},});
               }
           }
     } else {      } else {
         &standard_roleprivs(\%rolehash,$role,$dcdom,$spec,$pickedcourse,$area);          &standard_roleprivs(\%rolehash,$role,$dcdom,$spec,$pickedcourse,$area);
     }      }
Line 5878  sub set_adhoc_privileges { Line 6077  sub set_adhoc_privileges {
     unless ($caller eq 'constructaccess' && $env{'request.course.id'}) {      unless ($caller eq 'constructaccess' && $env{'request.course.id'}) {
         &appenv( {'request.role'        => $spec,          &appenv( {'request.role'        => $spec,
                   'request.role.domain' => $dcdom,                    'request.role.domain' => $dcdom,
                   'request.course.sec'  => ''                    'request.course.sec'  => $sec,
                  }                   }
                );                 );
         my $tadv=0;          my $tadv=0;
Removed from v.1.1331  
changed lines
  Added in v.1.1332

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