[BACK]Return to lond CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/lond between versions 1.552 and 1.559

version 1.552, 2018/12/02 16:17:21 version 1.559, 2019/07/02 19:40:18
Line 80  my $clientsamedom;              # LonCAP Line 80  my $clientsamedom;              # LonCAP
                                 # and client.                                  # and client.
 my $clientsameinst;             # LonCAPA "internet domain" same for   my $clientsameinst;             # LonCAPA "internet domain" same for 
                                 # this host and client.                                  # this host and client.
 my $clientremoteok;             # Client allowed to host domain's users.  my $clientremoteok;             # Current domain permits hosting on client
                                 # (version constraints ignored), not set                                  # (not set if host and client share "internet domain").
                                 # if this host and client share "internet domain".                                   # Values are 0 or 1; 1 if allowed.
 my %clientprohibited;           # Actions prohibited on client;  my %clientprohibited;           # Commands from client prohibited for domain's
                                    # users.
   
 my $server;  my $server;
   
 my $keymode;  my $keymode;
Line 236  my %trust = ( Line 237  my %trust = (
                edit => {institutiononly => 1},  #not used currently                 edit => {institutiononly => 1},  #not used currently
                eget => {remote => 1, domroles => 1, enroll => 1}, #not used currently                 eget => {remote => 1, domroles => 1, enroll => 1}, #not used currently
                egetdom => {remote => 1, domroles => 1, enroll => 1, },                 egetdom => {remote => 1, domroles => 1, enroll => 1, },
                ekey => {}, #not used currently                 ekey => {anywhere => 1},
                exit => {anywhere => 1},                 exit => {anywhere => 1},
                fetchuserfile => {remote => 1, enroll => 1},                 fetchuserfile => {remote => 1, enroll => 1},
                get => {remote => 1, domroles => 1, enroll => 1},                 get => {remote => 1, domroles => 1, enroll => 1},
Line 833  sub PushFile { Line 834  sub PushFile {
     #   hosts.tab  ($filename eq host).      #   hosts.tab  ($filename eq host).
     #   domain.tab ($filename eq domain).      #   domain.tab ($filename eq domain).
     #   dns_hosts.tab ($filename eq dns_host).      #   dns_hosts.tab ($filename eq dns_host).
     #   dns_domain.tab ($filename eq dns_domain).       #   dns_domain.tab ($filename eq dns_domain).
     #   loncapaCAcrl.pem ($filename eq loncapaCAcrl);         #   loncapaCAcrl.pem ($filename eq loncapaCAcrl).
     # Construct the destination filename or reject the request.      # Construct the destination filename or reject the request.
     #      #
     # lonManage is supposed to ensure this, however this session could be      # lonManage is supposed to ensure this, however this session could be
Line 2029  sub read_lonnet_global { Line 2030  sub read_lonnet_global {
                 }                  }
                 if ($what eq 'perlvar') {                  if ($what eq 'perlvar') {
                     if (!exists($packagevars{$what}{'lonBalancer'})) {                      if (!exists($packagevars{$what}{'lonBalancer'})) {
                         if ($dist =~ /^(centos|rhes|fedora|scientific)/) {                          if ($dist =~ /^(centos|rhes|fedora|scientific|oracle)/) {
                             my $othervarref=LONCAPA::Configuration::read_conf('httpd.conf');                              my $othervarref=LONCAPA::Configuration::read_conf('httpd.conf');
                             if (ref($othervarref) eq 'HASH') {                              if (ref($othervarref) eq 'HASH') {
                                 $items->{'lonBalancer'} = $othervarref->{'lonBalancer'};                                  $items->{'lonBalancer'} = $othervarref->{'lonBalancer'};
Line 2347  sub change_password_handler { Line 2348  sub change_password_handler {
     }      }
     if($validated) {      if($validated) {
  my $realpasswd  = &get_auth_type($udom, $uname); # Defined since authd.   my $realpasswd  = &get_auth_type($udom, $uname); # Defined since authd.
   
  my ($howpwd,$contentpwd)=split(/:/,$realpasswd);   my ($howpwd,$contentpwd)=split(/:/,$realpasswd);
           my $notunique;
  if ($howpwd eq 'internal') {   if ($howpwd eq 'internal') {
     &Debug("internal auth");      &Debug("internal auth");
             my $ncpass = &hash_passwd($udom,$npass);              my $ncpass = &hash_passwd($udom,$npass);
     if(&rewrite_password_file($udom, $uname, "internal:$ncpass")) {              my (undef,$method,@rest) = split(/!/,$contentpwd);
               if ($method eq 'bcrypt') {
                   my %passwdconf = &Apache::lonnet::get_passwdconf($udom);
                   if (($passwdconf{'numsaved'}) && ($passwdconf{'numsaved'} =~ /^\d+$/)) {
                       my @oldpasswds;
                       my $userpath = &propath($udom,$uname);
                       my $fullpath = $userpath.'/oldpasswds';
                       if (-d $userpath) {
                           my @oldfiles;
                           if (-e $fullpath) {
                               if (opendir(my $dir,$fullpath)) {
                                   (@oldfiles) = grep(/^\d+$/,readdir($dir));
                                   closedir($dir);
                               }
                               if (@oldfiles) {
                                   @oldfiles = sort { $b <=> $a } (@oldfiles);
                                   my $numremoved = 0;
                                   for (my $i=0; $i<@oldfiles; $i++) {
                                       if ($i>=$passwdconf{'numsaved'}) {
                                           if (-f "$fullpath/$oldfiles[$i]") {
                                               if (unlink("$fullpath/$oldfiles[$i]")) {
                                                   $numremoved ++;
                                               }
                                           }
                                       } elsif (open(my $fh,'<',"$fullpath/$oldfiles[$i]")) {
                                           while (my $line = <$fh>) {
                                               push(@oldpasswds,$line);
                                           }
                                           close($fh);
                                       }
                                   }
                                   if ($numremoved) {
                                       &logthis("unlinked $numremoved old password files for $uname:$udom");
                                   }
                               }
                           }
                           push(@oldpasswds,$contentpwd);
                           foreach my $item (@oldpasswds) {
                               my (undef,$method,@rest) = split(/!/,$item);
                               if ($method eq 'bcrypt') {
                                   my $result = &hash_passwd($udom,$npass,@rest);
                                   if ($result eq $item) {
                                       $notunique = 1;
                                       last;
                                   }
                               }
                           }
                           unless ($notunique) {
                               unless (-e $fullpath) {
                                   if (&mkpath("$fullpath/")) {
                                       chmod(0700,$fullpath);
                                   }
                               }
                               if (-d $fullpath) {
                                   my $now = time;
                                   if (open(my $fh,'>',"$fullpath/$now")) {
                                       print $fh $contentpwd;
                                       close($fh);
                                       chmod(0400,"$fullpath/$now");
                                   }
                               }
                           }
                       }
                   }
               }
               if ($notunique) {
                   my $msg="Result of password change for $uname:$udom - password matches one used before";
                   if ($lonhost) {
                       $msg .= " - request originated from: $lonhost";
                   }
                   &logthis($msg);
                   &Reply($client, "prioruse\n", $userinput);
       } elsif (&rewrite_password_file($udom, $uname, "internal:$ncpass")) {
  my $msg="Result of password change for $uname: pwchange_success";   my $msg="Result of password change for $uname: pwchange_success";
                 if ($lonhost) {                  if ($lonhost) {
                     $msg .= " - request originated from: $lonhost";                      $msg .= " - request originated from: $lonhost";
Line 2380  sub change_password_handler { Line 2453  sub change_password_handler {
     #      #
     &Failure( $client, "auth_mode_error\n", $userinput);      &Failure( $client, "auth_mode_error\n", $userinput);
  }     }  
   
     } else {      } else {
  if ($failure eq '') {   if ($failure eq '') {
     $failure = 'non_authorized';      $failure = 'non_authorized';
Line 5552  sub del_balcookie_handler { Line 5624  sub del_balcookie_handler {
                     chomp($line);                      chomp($line);
                     if ($line eq $clientname) {                      if ($line eq $clientname) {
                         $dodelete = 1;                          $dodelete = 1;
                         last;                                last;
                     }                      }
                 }                  }
                 close($fh);                   close($fh);
                 if ($dodelete) {                  if ($dodelete) {
                     if (unlink("$execdir/$cookie.id")) {                      if (unlink("$execdir/$cookie.id")) {
                         $deleted = 1;                          $deleted = 1;
Line 7099  sub UpdateHosts { Line 7171  sub UpdateHosts {
   
     my %oldconf = %secureconf;      my %oldconf = %secureconf;
     my %connchange;      my %connchange;
     if (lonssl::Read_Connect_Config(\%secureconf,\%crlchecked,\%perlvar) eq 'ok') {      if (lonssl::Read_Connect_Config(\%secureconf,\%perlvar,\%crlchecked) eq 'ok') {
         logthis('<font color="blue"> Reloaded SSL connection rules and cleared CRL checking history </font>');          logthis('<font color="blue"> Reloaded SSL connection rules and cleared CRL checking history </font>');
     } else {      } else {
         logthis('<font color="yellow"> Failed to reload SSL connection rules and clear CRL checking history </font>');          logthis('<font color="yellow"> Failed to reload SSL connection rules and clear CRL checking history </font>');
Line 7381  if ($arch eq 'unknown') { Line 7453  if ($arch eq 'unknown') {
     chomp($arch);      chomp($arch);
 }  }
   
 unless (lonssl::Read_Connect_Config(\%secureconf,\%crlchecked,\%perlvar) eq 'ok') {  unless (lonssl::Read_Connect_Config(\%secureconf,\%perlvar,\%crlchecked) eq 'ok') {
     &logthis('<font color="blue">No connectionrules table. Will fallback to loncapa.conf</font>');      &logthis('<font color="blue">No connectionrules table. Will fallback to loncapa.conf</font>');
 }  }
   
Line 7470  sub make_new_child { Line 7542  sub make_new_child {
         &Authen::Krb5::init_context();          &Authen::Krb5::init_context();
   
         my $no_ets;          my $no_ets;
         if ($dist =~ /^(?:centos|rhes|scientific)(\d+)$/) {          if ($dist =~ /^(?:centos|rhes|scientific|oracle)(\d+)$/) {
             if ($1 >= 7) {              if ($1 >= 7) {
                 $no_ets = 1;                  $no_ets = 1;
             }              }
Line 7515  sub make_new_child { Line 7587  sub make_new_child {
     $ConnectionType = "manager";      $ConnectionType = "manager";
     $clientname = $managers{$outsideip};      $clientname = $managers{$outsideip};
  }   }
  my ($clientok,$clientinfoset);   my $clientok;
   
  if ($clientrec || $ismanager) {   if ($clientrec || $ismanager) {
     &status("Waiting for init from $clientip $clientname");      &status("Waiting for init from $clientip $clientname");
Line 7616  sub make_new_child { Line 7688  sub make_new_child {
     }      }
         
  } else {   } else {
                     $clientinfoset = &set_client_info();  
     my $ok = InsecureConnection($client);      my $ok = InsecureConnection($client);
     if($ok) {      if($ok) {
  $clientok = 1;   $clientok = 1;
Line 7654  sub make_new_child { Line 7725  sub make_new_child {
 # ------------------------------------------------------------ Process requests  # ------------------------------------------------------------ Process requests
     my $keep_going = 1;      my $keep_going = 1;
     my $user_input;      my $user_input;
             unless ($clientinfoset) {  
                 $clientinfoset = &set_client_info();  
             }  
             $clientremoteok = 0;  
             unless ($clientsameinst) {  
                 $clientremoteok = 1;  
                 my $defdom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});  
                 %clientprohibited = &get_prohibited($defdom);  
                 if ($clientintdom) {  
                     my $remsessconf = &get_usersession_config($defdom,'remotesession');  
                     if (ref($remsessconf) eq 'HASH') {  
                         if (ref($remsessconf->{'remote'}) eq 'HASH') {  
                             if (ref($remsessconf->{'remote'}->{'excludedomain'}) eq 'ARRAY') {  
                                 if (grep(/^\Q$clientintdom\E$/,@{$remsessconf->{'remote'}->{'excludedomain'}})) {  
                                     $clientremoteok = 0;  
                                 }  
                             }  
                             if (ref($remsessconf->{'remote'}->{'includedomain'}) eq 'ARRAY') {  
                                 if (grep(/^\Q$clientintdom\E$/,@{$remsessconf->{'remote'}->{'includedomain'}})) {  
                                     $clientremoteok = 1;  
                                 } else {  
                                     $clientremoteok = 0;  
                                 }  
                             }  
                         }  
                     }  
                 }  
             }  
     while(($user_input = get_request) && $keep_going) {      while(($user_input = get_request) && $keep_going) {
  alarm(120);   alarm(120);
  Debug("Main: Got $user_input\n");   Debug("Main: Got $user_input\n");
Line 7714  sub make_new_child { Line 7758  sub make_new_child {
   
 #  #
 #  Used to determine if a particular client is from the same domain  #  Used to determine if a particular client is from the same domain
 #  as the current server, or from the same internet domain.  #  as the current server, or from the same internet domain, and
   #  also if the client can host sessions for the domain's users.
   #  A hash is populated with keys set to commands sent by the client
   #  which may not be executed for this domain.
 #  #
 #  Optional input -- the client to check for domain and internet domain.  #  Optional input -- the client to check for domain and internet domain.
 #  If not specified, defaults to the package variable: $clientname  #  If not specified, defaults to the package variable: $clientname
 #  #
 #  If called in array context will not set package variables, but will  #  If called in array context will not set package variables, but will
 #  instead return an array of two values - (a) true if client is in the  #  instead return an array of two values - (a) true if client is in the
 #  same domain as the server, and (b) true if client is in the same internet  #  same domain as the server, and (b) true if client is in the same 
 #  domain.  #  internet domain.
 #  #
 #  If called in scalar context, sets package variables for current client:  #  If called in scalar context, sets package variables for current client:
 #  #
 #  $clienthomedom  - LonCAPA domain of homeID for client.  #  $clienthomedom    - LonCAPA domain of homeID for client.
 #  $clientsamedom  - LonCAPA domain same for this host and client.  #  $clientsamedom    - LonCAPA domain same for this host and client.
 #  $clientintdom   - LonCAPA "internet domain" for client.  #  $clientintdom     - LonCAPA "internet domain" for client.
 #  $clientsameinst - LonCAPA "internet domain" same for this host & client.  #  $clientsameinst   - LonCAPA "internet domain" same for this host & client.
   #  $clientremoteok   - If current domain permits hosting on this client: 1
   #  %clientprohibited - Commands prohibited for domain's users for this client.
   #
   #  if the host and client have the same "internet domain", then the value
   #  of $clientremoteok is not used, and no commands are prohibited.
 #  #
 #  returns 1 to indicate package variables have been set for current client.  #  returns 1 to indicate package variables have been set for current client.
 #  #
Line 7741  sub set_client_info { Line 7793  sub set_client_info {
     my $clientserverhomeID = &Apache::lonnet::get_server_homeID($clienthost);      my $clientserverhomeID = &Apache::lonnet::get_server_homeID($clienthost);
     my $homedom = &Apache::lonnet::host_domain($clientserverhomeID);      my $homedom = &Apache::lonnet::host_domain($clientserverhomeID);
     my $samedom = 0;      my $samedom = 0;
     if ($perlvar{'lonDefDom'} eq $homedom) {      if ($perlvar{'lonDefDomain'} eq $homedom) {
         $samedom = 1;          $samedom = 1;
     }      }
     my $intdom = &Apache::lonnet::internet_dom($clientserverhomeID);      my $intdom = &Apache::lonnet::internet_dom($clientserverhomeID);
Line 7761  sub set_client_info { Line 7813  sub set_client_info {
         $clientsamedom = $samedom;          $clientsamedom = $samedom;
         $clientintdom = $intdom;          $clientintdom = $intdom;
         $clientsameinst = $sameinst;          $clientsameinst = $sameinst;
           if ($clientsameinst) {
               undef($clientremoteok);
               undef(%clientprohibited);
           } else {
               $clientremoteok = &get_remote_hostable($currentdomainid);
               %clientprohibited = &get_prohibited($currentdomainid);
           }
         return 1;          return 1;
     }      }
 }  }
Line 8508  sub sethost { Line 8567  sub sethost {
  eq &Apache::lonnet::get_host_ip($hostid)) {   eq &Apache::lonnet::get_host_ip($hostid)) {
  $currenthostid  =$hostid;   $currenthostid  =$hostid;
  $currentdomainid=&Apache::lonnet::host_domain($hostid);   $currentdomainid=&Apache::lonnet::host_domain($hostid);
           &set_client_info();
 # &logthis("Setting hostid to $hostid, and domain to $currentdomainid");  # &logthis("Setting hostid to $hostid, and domain to $currentdomainid");
     } else {      } else {
  &logthis("Requested host id $hostid not an alias of ".   &logthis("Requested host id $hostid not an alias of ".
Line 8584  sub get_prohibited { Line 8644  sub get_prohibited {
     return %prohibited;      return %prohibited;
 }  }
   
   sub get_remote_hostable {
       my ($dom) = @_;
       my $result;
       if ($clientintdom) {
           $result = 1;
           my $remsessconf = &get_usersession_config($dom,'remotesession');
           if (ref($remsessconf) eq 'HASH') {
               if (ref($remsessconf->{'remote'}) eq 'HASH') {
                   if (ref($remsessconf->{'remote'}->{'excludedomain'}) eq 'ARRAY') {
                       if (grep(/^\Q$clientintdom\E$/,@{$remsessconf->{'remote'}->{'excludedomain'}})) {
                           $result = 0;
                       }
                   }
                   if (ref($remsessconf->{'remote'}->{'includedomain'}) eq 'ARRAY') {
                       if (grep(/^\Q$clientintdom\E$/,@{$remsessconf->{'remote'}->{'includedomain'}})) {
                           $result = 1;
                       } else {
                           $result = 0;
                       }
                   }
               }
           }
       }
       return $result;
   }
   
 sub distro_and_arch {  sub distro_and_arch {
     return $dist.':'.$arch;      return $dist.':'.$arch;
 }  }
Removed from v.1.552  
changed lines
  Added in v.1.559

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