[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.1406 and 1.1412

version 1.1406, 2019/02/26 14:42:27 version 1.1412, 2019/07/23 01:30:44
Line 1082  sub find_existing_session { Line 1082  sub find_existing_session {
     return;      return;
 }  }
   
   sub delusersession {
       my ($lonid,$udom,$uname) = @_;
       my $uprimary_id = &domain($udom,'primary');
       my $uintdom = &internet_dom($uprimary_id);
       my $intdom = &internet_dom($lonid);
       my $serverhomedom = &host_domain($lonid);
       if (($uintdom ne '') && ($uintdom eq $intdom)) {
           return &reply(join(':','delusersession',
                               map {&escape($_)} ($udom,$uname)),$lonid);
       }
       return;
   }
   
 # check if user's browser sent load balancer cookie and server still has session  # check if user's browser sent load balancer cookie and server still has session
 # and is not overloaded.  # and is not overloaded.
 sub check_for_balancer_cookie {  sub check_for_balancer_cookie {
Line 1252  sub changepass { Line 1265  sub changepass {
     } elsif ($answer =~ "invalid_client") {      } elsif ($answer =~ "invalid_client") {
         &logthis("$server refused to change $uname in $udom password because ".          &logthis("$server refused to change $uname in $udom password because ".
                  "it was a reset by e-mail originating from an invalid server.");                   "it was a reset by e-mail originating from an invalid server.");
       } elsif ($answer =~ "^prioruse") {
          &logthis("$server refused to change $uname in $udom password because ".
                   "the password had been used before");
     }      }
     return $answer;      return $answer;
 }  }
Line 2705  sub get_domain_defaults { Line 2721  sub get_domain_defaults {
     return %domdefaults;      return %domdefaults;
 }  }
   
   sub get_dom_cats {
       my ($dom) = @_;
       return unless (&domain($dom));
       my ($cats,$cached)=&is_cached_new('cats',$dom);
       unless (defined($cached)) {
           my %domconfig = &get_dom('configuration',['coursecategories'],$dom);
           if (ref($domconfig{'coursecategories'}) eq 'HASH') {
               if (ref($domconfig{'coursecategories'}{'cats'}) eq 'HASH') {
                   %{$cats} = %{$domconfig{'coursecategories'}{'cats'}};
               } else {
                   $cats = {};
               }
           } else {
               $cats = {};
           }
           &Apache::lonnet::do_cache_new('cats',$dom,$cats,3600);
       }
       return $cats; 
   }
   
 sub course_portal_url {  sub course_portal_url {
     my ($cnum,$cdom) = @_;      my ($cnum,$cdom) = @_;
     my $chome = &homeserver($cnum,$cdom);      my $chome = &homeserver($cnum,$cdom);
Line 2721  sub course_portal_url { Line 2757  sub course_portal_url {
     return $firsturl;      return $firsturl;
 }  }
   
   # --------------------------------------------- Get domain config for passwords
   
   sub get_passwdconf {
       my ($dom) = @_;
       my (%passwdconf,$gotconf,$lookup);
       my ($result,$cached)=&is_cached_new('passwdconf',$dom);
       if (defined($cached)) {
           if (ref($result) eq 'HASH') {
               %passwdconf = %{$result};
               $gotconf = 1;
           }
       }
       unless ($gotconf) {
           my %domconfig = &get_dom('configuration',['passwords'],$dom);
           if (ref($domconfig{'passwords'}) eq 'HASH') {
               %passwdconf = %{$domconfig{'passwords'}};
           }
           my $cachetime = 24*60*60;
           &do_cache_new('passwdconf',$dom,\%passwdconf,$cachetime);
       }
       return %passwdconf;
   }
   
 # --------------------------------------------------- Assign a key to a student  # --------------------------------------------------- Assign a key to a student
   
 sub assign_access_key {  sub assign_access_key {
Line 8057  sub allowed { Line 8116  sub allowed {
   
     if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseuri}      if ($env{'user.priv.'.$env{'request.role'}.'.'.$courseuri}
        =~/\Q$priv\E\&([^\:]*)/) {         =~/\Q$priv\E\&([^\:]*)/) {
         unless (($priv eq 'bro') && (!$ownaccess)) {          if ($priv eq 'mip') {
             $thisallowed.=$1;              my $rem = $1;
               if (($uri ne '') && ($env{'request.course.id'} eq $uri) &&
                   ($env{'course.'.$env{'request.course.id'}.'.internal.courseowner'} eq $env{'user.name'}.':'.$env{'user.domain'})) {
                   my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
                   if ($cdom ne '') {
                       my %passwdconf = &get_passwdconf($cdom);
                       if (ref($passwdconf{'crsownerchg'}) eq 'HASH') {
                           if (ref($passwdconf{'crsownerchg'}{'by'}) eq 'ARRAY') {
                               if (@{$passwdconf{'crsownerchg'}{'by'}}) {
                                   my @inststatuses = split(':',$env{'environment.inststatus'});
                                   unless (@inststatuses) {
                                       @inststatuses = ('default');
                                   }
                                   foreach my $status (@inststatuses) {
                                       if (grep(/^\Q$status\E$/,@{$passwdconf{'crsownerchg'}{'by'}})) {
                                           $thisallowed.=$rem;
                                       }
                                   }
                               }
                           }
                       }
                   }
               }
           } else {
               unless (($priv eq 'bro') && (!$ownaccess)) {
                   $thisallowed.=$1;
               }
         }          }
     }      }
   
Line 8147  sub allowed { Line 8232  sub allowed {
   
     if ($env{'request.course.id'}) {      if ($env{'request.course.id'}) {
   
   # If this is modifying password (internal auth) domains must match for user and user's role.
   
           if ($priv eq 'mip') {
               if ($env{'user.domain'} eq $env{'request.role.domain'}) {
                   return $thisallowed;
               } else {
                   return '';
               }
           }
   
        $courseprivid=$env{'request.course.id'};         $courseprivid=$env{'request.course.id'};
        if ($env{'request.course.sec'}) {         if ($env{'request.course.sec'}) {
           $courseprivid.='/'.$env{'request.course.sec'};            $courseprivid.='/'.$env{'request.course.sec'};
Line 10051  sub store_coowners { Line 10146  sub store_coowners {
 sub modifyuserauth {  sub modifyuserauth {
     my ($udom,$uname,$umode,$upass)=@_;      my ($udom,$uname,$umode,$upass)=@_;
     my $uhome=&homeserver($uname,$udom);      my $uhome=&homeserver($uname,$udom);
     unless (&allowed('mau',$udom)) { return 'refused'; }      my $allowed;
       if (&allowed('mau',$udom)) {
           $allowed = 1;
       } elsif (($umode eq 'internal') && ($udom eq $env{'user.domain'}) &&
                ($env{'request.course.id'}) && (&allowed('mip',$env{'request.course.id'})) &&
                (!$env{'course.'.$env{'request.course.id'}.'.internal.nopasswdchg'})) {
           my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};
           my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};
           if (($cdom ne '') && ($cnum ne '')) {
               my $is_owner = &is_course_owner($cdom,$cnum);
               if ($is_owner) {
                   $allowed = 1;
               }
           }
       }
       unless ($allowed) { return 'refused'; }
     &logthis('Call to modify user authentication '.$udom.', '.$uname.', '.      &logthis('Call to modify user authentication '.$udom.', '.$uname.', '.
              $umode.' by '.$env{'user.name'}.' at '.$env{'user.domain'}.               $umode.' by '.$env{'user.name'}.' at '.$env{'user.domain'}.
              ' in domain '.$env{'request.role.domain'});                 ' in domain '.$env{'request.role.domain'});  
Removed from v.1.1406  
changed lines
  Added in v.1.1412

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