[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.1434 and 1.1446

version 1.1434, 2020/12/18 15:23:03 version 1.1446, 2021/04/09 02:01:11
Line 1445  sub spare_can_host { Line 1445  sub spare_can_host {
             $canhost = 0;              $canhost = 0;
         }          }
     }      }
       if ($canhost) {
           if (ref($defdomdefaults{'offloadoth'}) eq 'HASH') {
               if ($defdomdefaults{'offloadoth'}{$try_server}) {
                   unless (&shared_institution($udom,$try_server)) {
                       $canhost = 0;
                   }
               }
           }
       }
     if (($canhost) && ($uint_dom)) {      if (($canhost) && ($uint_dom)) {
         my @intdoms;          my @intdoms;
         my $internet_names = &get_internet_names($try_server);          my $internet_names = &get_internet_names($try_server);
Line 2155  sub get_dom { Line 2164  sub get_dom {
     }      }
     if ($udom && $uhome && ($uhome ne 'no_host')) {      if ($udom && $uhome && ($uhome ne 'no_host')) {
         my $rep;          my $rep;
         if ($namespace =~ /^enc/) {          if (grep { $_ eq $uhome } &current_machine_ids()) {
             $rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome);              # domain information is hosted on this machine
               my $cmd = 'getdom';
               if ($namespace =~ /^enc/) {
                   $cmd = 'egetdom';
               }
               $rep = &LONCAPA::Lond::get_dom("$cmd:$udom:$namespace:$items");
         } else {          } else {
             $rep=&reply("getdom:$udom:$namespace:$items",$uhome);              if ($namespace =~ /^enc/) {
                   $rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome);
               } else {
                   $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
               }
         }          }
         my %returnhash;          my %returnhash;
         if ($rep eq '' || $rep =~ /^error: 2 /) {          if ($rep eq '' || $rep =~ /^error: 2 /) {
Line 2689  sub get_domain_defaults { Line 2707  sub get_domain_defaults {
         if (ref($domconfig{'usersessions'}{'offloadnow'}) eq 'HASH') {          if (ref($domconfig{'usersessions'}{'offloadnow'}) eq 'HASH') {
             $domdefaults{'offloadnow'} = $domconfig{'usersessions'}{'offloadnow'};              $domdefaults{'offloadnow'} = $domconfig{'usersessions'}{'offloadnow'};
         }          }
           if (ref($domconfig{'usersessions'}{'offloadoth'}) eq 'HASH') {
               $domdefaults{'offloadoth'} = $domconfig{'usersessions'}{'offloadoth'};
           }
     }      }
     if (ref($domconfig{'selfenrollment'}) eq 'HASH') {      if (ref($domconfig{'selfenrollment'}) eq 'HASH') {
         if (ref($domconfig{'selfenrollment'}{'admin'}) eq 'HASH') {          if (ref($domconfig{'selfenrollment'}{'admin'}) eq 'HASH') {
Line 2757  sub get_domain_defaults { Line 2778  sub get_domain_defaults {
         }          }
     }      }
     if (ref($domconfig{'wafproxy'}) eq 'HASH') {      if (ref($domconfig{'wafproxy'}) eq 'HASH') {
         foreach my $item ('ipheader','trusted','exempt') {          foreach my $item ('ipheader','trusted','vpnint','vpnext') {
             if ($domconfig{'wafproxy'}{$item}) {              if ($domconfig{'wafproxy'}{$item}) {
                 $domdefaults{'waf_'.$item} = $domconfig{'wafproxy'}{$item};                  $domdefaults{'waf_'.$item} = $domconfig{'wafproxy'}{$item};
             }              }
Line 4053  sub clean_filename { Line 4074  sub clean_filename {
 # Replace all .\d. sequences with _\d. so they no longer look like version  # Replace all .\d. sequences with _\d. so they no longer look like version
 # numbers  # numbers
     $fname=~s/\.(\d+)(?=\.)/_$1/g;      $fname=~s/\.(\d+)(?=\.)/_$1/g;
   # Replace three or more adjacent underscores with one for consistency 
   # with loncfile::filename_check() so complete url can be extracted by
   # lonnet::decode_symb()
       $fname=~s/_{3,}/_/g;
     return $fname;      return $fname;
 }  }
   
Line 8082  sub allowed { Line 8107  sub allowed {
   
     if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; }      if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; }
 # Free bre access to adm and meta resources  # Free bre access to adm and meta resources
     if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|ext\.tool)$}))       if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|viewclasslist|aboutme|ext\.tool)$})) 
  || (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) ))    || (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) )) 
  && ($priv eq 'bre')) {   && ($priv eq 'bre')) {
  return 'F';   return 'F';
Line 9402  sub auto_validate_instcode { Line 9427  sub auto_validate_instcode {
     return ($outcome,$description,$defaultcredits);      return ($outcome,$description,$defaultcredits);
 }  }
   
   sub auto_validate_inst_crosslist {
       my ($cnum,$cdom,$instcode,$inst_xlist,$coowner) = @_;
       my ($homeserver,$response);
       if (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/)) {
           $homeserver = &homeserver($cnum,$cdom);
       }
       if (!defined($homeserver)) {
           if ($cdom =~ /^$match_domain$/) {
               $homeserver = &domain($cdom,'primary');
           }
       }
       unless (($homeserver eq '') || ($homeserver eq 'no_host')) {
           $response=&reply('autovalidateinstcrosslist:'.$cdom.':'.
                            &escape($instcode).':'.&escape($inst_xlist).':'.
                            &escape($coowner),$homeserver);
       }
       return $response;
   }
   
 sub auto_create_password {  sub auto_create_password {
     my ($cnum,$cdom,$authparam,$udom) = @_;      my ($cnum,$cdom,$authparam,$udom) = @_;
     my ($homeserver,$response);      my ($homeserver,$response);
Line 10223  sub autoupdate_coowners { Line 10267  sub autoupdate_coowners {
         if ($domdesign{$cdom.'.autoassign.co-owners'}) {          if ($domdesign{$cdom.'.autoassign.co-owners'}) {
             my %coursehash = &coursedescription($cdom.'_'.$cnum);              my %coursehash = &coursedescription($cdom.'_'.$cnum);
             my $instcode = $coursehash{'internal.coursecode'};              my $instcode = $coursehash{'internal.coursecode'};
               my $xlists = $coursehash{'internal.crosslistings'};
             if ($instcode ne '') {              if ($instcode ne '') {
                 if (($start && $start <= $now) && ($end == 0) || ($end > $now)) {                  if (($start && $start <= $now) && ($end == 0) || ($end > $now)) {
                     unless ($coursehash{'internal.courseowner'} eq $uname.':'.$udom) {                      unless ($coursehash{'internal.courseowner'} eq $uname.':'.$udom) {
                         my ($delcoowners,@newcoowners,$putresult,$delresult,$coowners);                          my ($delcoowners,@newcoowners,$putresult,$delresult,$coowners);
                         my ($result,$desc) = &auto_validate_instcode($cnum,$cdom,$instcode,$uname.':'.$udom);                          my ($result,$desc) = &auto_validate_instcode($cnum,$cdom,$instcode,$uname.':'.$udom);
                           unless ($result eq 'valid') {
                               if ($xlists ne '') {
                                   foreach my $xlist (split(',',$xlists)) {
                                       my ($inst_crosslist,$lcsec) = split(':',$xlist);
                                       $result =
                                           &auto_validate_inst_crosslist($cnum,$cdom,$instcode,
                                                                         $inst_crosslist,$uname.':'.$udom);
                                       last if ($result eq 'valid');
                                   }
                               }
                           }
                         if ($result eq 'valid') {                          if ($result eq 'valid') {
                             if ($coursehash{'internal.co-owners'}) {                              if ($coursehash{'internal.co-owners'}) {
                                 foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) {                                  foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) {
Line 10240  sub autoupdate_coowners { Line 10296  sub autoupdate_coowners {
                             } else {                              } else {
                                 push(@newcoowners,$uname.':'.$udom);                                  push(@newcoowners,$uname.':'.$udom);
                             }                              }
                         } else {                          } elsif ($coursehash{'internal.co-owners'}) {
                             if ($coursehash{'internal.co-owners'}) {                              foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) {
                                 foreach my $coowner (split(',',$coursehash{'internal.co-owners'})) {                                  unless ($coowner eq $uname.':'.$udom) {
                                     unless ($coowner eq $uname.':'.$udom) {                                      push(@newcoowners,$coowner);
                                         push(@newcoowners,$coowner);  
                                     }  
                                 }  
                                 unless (@newcoowners > 0) {  
                                     $delcoowners = 1;  
                                     $coowners = '';  
                                 }                                  }
                             }                              }
                               unless (@newcoowners > 0) {
                                   $delcoowners = 1;
                                   $coowners = '';
                               }
                         }                          }
                         if (@newcoowners || $delcoowners) {                          if (@newcoowners || $delcoowners) {
                             &store_coowners($cdom,$cnum,$coursehash{'home'},                              &store_coowners($cdom,$cnum,$coursehash{'home'},
Line 10332  sub modifyuserauth { Line 10386  sub modifyuserauth {
     &log($udom,,$uname,$uhome,      &log($udom,,$uname,$uhome,
         'Authentication changed by '.$env{'user.domain'}.', '.          'Authentication changed by '.$env{'user.domain'}.', '.
                                      $env{'user.name'}.', '.$umode.                                       $env{'user.name'}.', '.$umode.
          '(Remote '.$ENV{'REMOTE_ADDR'}.'): '.$reply);           '(Remote '.$ip.'): '.$reply);
     unless ($reply eq 'ok') {      unless ($reply eq 'ok') {
         &logthis('Authentication mode error: '.$reply);          &logthis('Authentication mode error: '.$reply);
  return 'error: '.$reply;   return 'error: '.$reply;
Line 12407  sub EXT { Line 12461  sub EXT {
         }          }
     } elsif ($realm eq 'client') {      } elsif ($realm eq 'client') {
         if ($space eq 'remote_addr') {          if ($space eq 'remote_addr') {
             return $ENV{'REMOTE_ADDR'};              return &get_requestor_ip();
         }          }
     }      }
     return '';      return '';
Line 14217  sub default_login_domain { Line 14271  sub default_login_domain {
 }  }
   
 sub shared_institution {  sub shared_institution {
     my ($dom) = @_;      my ($dom,$lonhost) = @_;
       if ($lonhost eq '') {
           $lonhost = $perlvar{'lonHostID'};
       }
     my $same_intdom;      my $same_intdom;
     my $hostintdom = &internet_dom($perlvar{'lonHostID'});      my $hostintdom = &internet_dom($lonhost);
     if ($hostintdom ne '') {      if ($hostintdom ne '') {
         my %iphost = &get_iphost();          my %iphost = &get_iphost();
         my $primary_id = &domain($dom,'primary');          my $primary_id = &domain($dom,'primary');
Line 14288  sub get_requestor_ip { Line 14345  sub get_requestor_ip {
     my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};      my $dom_in_use = $Apache::lonnet::perlvar{'lonDefDomain'};
     my $proxyinfo = &get_proxy_settings($dom_in_use);      my $proxyinfo = &get_proxy_settings($dom_in_use);
     if ((ref($proxyinfo) eq 'HASH') && ($from_ip)) {      if ((ref($proxyinfo) eq 'HASH') && ($from_ip)) {
         if ($proxyinfo->{'exempt'}) {          if ($proxyinfo->{'vpnint'}) {
             if (&ip_match($from_ip,$proxyinfo->{'exempt'})) {              if (&ip_match($from_ip,$proxyinfo->{'vpnint'})) {
                 return $from_ip;                  return $from_ip;
             }              }
         }          }
Line 14309  sub get_requestor_ip { Line 14366  sub get_requestor_ip {
                     $xfor = $ENV{'HTTP_X_FORWARDED_FOR'};                      $xfor = $ENV{'HTTP_X_FORWARDED_FOR'};
                 }                  }
                 if (($ip eq '') && ($xfor ne '')) {                  if (($ip eq '') && ($xfor ne '')) {
                     my @ips = reverse(split(/\s*,\s*/,$xfor));  
                     foreach my $poss_ip (reverse(split(/\s*,\s*/,$xfor))) {                      foreach my $poss_ip (reverse(split(/\s*,\s*/,$xfor))) {
                         unless (&ip_match($poss_ip,$proxyinfo->{'trusted'})) {                          unless (&ip_match($poss_ip,$proxyinfo->{'trusted'})) {
                             $ip = $poss_ip;                              $ip = $poss_ip;
                               last;
                         }                          }
                     }                      }
                 }                  }
Line 14331  sub get_proxy_settings { Line 14388  sub get_proxy_settings {
     my $proxyinfo = {      my $proxyinfo = {
                        ipheader => $domdefaults{'waf_ipheader'},                         ipheader => $domdefaults{'waf_ipheader'},
                        trusted  => $domdefaults{'waf_trusted'},                         trusted  => $domdefaults{'waf_trusted'},
                        exempt   => $domdefaults{'waf_exempt'},                         vpnint   => $domdefaults{'waf_vpnint'},
                          vpnext   => $domdefaults{'waf_vpnext'},
                     };                      };
     return $proxyinfo;      return $proxyinfo;
 }  }
Line 14356  sub get_proxy_alias { Line 14414  sub get_proxy_alias {
         if ($dom ne '') {          if ($dom ne '') {
             my $cachetime = 60*60*24;              my $cachetime = 60*60*24;
             my %domconfig =              my %domconfig =
                 &Apache::lonnet::get_dom('configuration',['proxy'],$dom);                  &Apache::lonnet::get_dom('configuration',['wafproxy'],$dom);
             my $alias;              my $alias;
             if (ref($domconfig{'proxy'}) eq 'HASH') {              if (ref($domconfig{'wafproxy'}) eq 'HASH') {
                 if (ref($domconfig{'proxy'}{'alias'}) eq 'HASH') {                  if (ref($domconfig{'wafproxy'}{'alias'}) eq 'HASH') {
                     $alias = $domconfig{'proxy'}{'alias'}{$lonhost};                      $alias = $domconfig{'wafproxy'}{'alias'}{$lonhost};
                 }                  }
             }              }
             return &do_cache_new('proxyalias',$lonhost,$alias,$cachetime);              return &do_cache_new('proxyalias',$lonhost,$alias,$cachetime);
Removed from v.1.1434  
changed lines
  Added in v.1.1446

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