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

Diff for /loncom/lond between versions 1.537 and 1.572

version 1.537, 2017/05/23 01:31:03 version 1.572, 2022/02/01 23:13:21
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 108  my %perlvar;   # Will have the apache co Line 109  my %perlvar;   # Will have the apache co
 my %secureconf;                 # Will have requirements for security   my %secureconf;                 # Will have requirements for security 
                                 # of lond connections                                  # of lond connections
   
   my %crlchecked;                 # Will contain clients for which the client's SSL
                                   # has been checked against the cluster's Certificate
                                   # Revocation List.
   
 my $dist;  my $dist;
   
 #  #
Line 172  my @installerrors = ("ok", Line 177  my @installerrors = ("ok",
 # shared    ("Access to other domain's content by this domain")  # shared    ("Access to other domain's content by this domain")
 # enroll    ("Enrollment in this domain's courses by others")  # enroll    ("Enrollment in this domain's courses by others")
 # coaurem   ("Co-author roles for this domain's users elsewhere")  # coaurem   ("Co-author roles for this domain's users elsewhere")
   # othcoau   ("Co-author roles in this domain for others")
 # domroles  ("Domain roles in this domain assignable to others")  # domroles  ("Domain roles in this domain assignable to others")
 # catalog   ("Course Catalog for this domain displayed elsewhere")  # catalog   ("Course Catalog for this domain displayed elsewhere")
 # reqcrs    ("Requests for creation of courses in this domain by others")  # reqcrs    ("Requests for creation of courses in this domain by others")
Line 207  my %trust = ( Line 213  my %trust = (
                autovalidateclass_sec => {catalog => 1},                 autovalidateclass_sec => {catalog => 1},
                autovalidatecourse => {remote => 1, enroll => 1},                 autovalidatecourse => {remote => 1, enroll => 1},
                autovalidateinstcode => {domroles => 1, remote => 1, enroll => 1},                 autovalidateinstcode => {domroles => 1, remote => 1, enroll => 1},
                  autovalidateinstcrosslist => {remote => 1, enroll => 1},
                  autoinstsecreformat => {remote => 1, enroll => 1},
                changeuserauth => {remote => 1, domroles => 1},                 changeuserauth => {remote => 1, domroles => 1},
                chatretr => {remote => 1, enroll => 1},                 chatretr => {remote => 1, enroll => 1},
                chatsend => {remote => 1, enroll => 1},                 chatsend => {remote => 1, enroll => 1},
Line 214  my %trust = ( Line 222  my %trust = (
                courseidput => {remote => 1, domroles => 1, enroll => 1},                 courseidput => {remote => 1, domroles => 1, enroll => 1},
                courseidputhash => {remote => 1, domroles => 1, enroll => 1},                 courseidputhash => {remote => 1, domroles => 1, enroll => 1},
                courselastaccess => {remote => 1, domroles => 1, enroll => 1},                 courselastaccess => {remote => 1, domroles => 1, enroll => 1},
                  coursesessions => {institutiononly => 1},
                currentauth => {remote => 1, domroles => 1, enroll => 1},                 currentauth => {remote => 1, domroles => 1, enroll => 1},
                currentdump => {remote => 1, enroll => 1},                 currentdump => {remote => 1, enroll => 1},
                currentversion => {remote=> 1, content => 1},                 currentversion => {remote=> 1, content => 1},
                dcmaildump => {remote => 1, domroles => 1},                 dcmaildump => {remote => 1, domroles => 1},
                dcmailput => {remote => 1, domroles => 1},                 dcmailput => {remote => 1, domroles => 1},
                del => {remote => 1, domroles => 1, enroll => 1, content => 1},                 del => {remote => 1, domroles => 1, enroll => 1, content => 1},
                  delbalcookie => {institutiononly => 1},
                  delusersession => {institutiononly => 1},
                deldom => {remote => 1, domroles => 1}, # not currently used                 deldom => {remote => 1, domroles => 1}, # not currently used
                devalidatecache => {institutiononly => 1},                 devalidatecache => {institutiononly => 1},
                domroleput => {remote => 1, enroll => 1},                 domroleput => {remote => 1, enroll => 1},
Line 228  my %trust = ( Line 239  my %trust = (
                du2 => {remote => 1, enroll => 1},                 du2 => {remote => 1, enroll => 1},
                dump => {remote => 1, enroll => 1, domroles => 1},                 dump => {remote => 1, enroll => 1, domroles => 1},
                edit => {institutiononly => 1},  #not used currently                 edit => {institutiononly => 1},  #not used currently
                  edump => {remote => 1, enroll => 1, domroles => 1},
                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 254  my %trust = ( Line 266  my %trust = (
                ls => {remote => 1, enroll => 1, content => 1,},                 ls => {remote => 1, enroll => 1, content => 1,},
                ls2 => {remote => 1, enroll => 1, content => 1,},                 ls2 => {remote => 1, enroll => 1, content => 1,},
                ls3 => {remote => 1, enroll => 1, content => 1,},                 ls3 => {remote => 1, enroll => 1, content => 1,},
                  lti => {institutiononly => 1},
                makeuser => {remote => 1, enroll => 1, domroles => 1,},                 makeuser => {remote => 1, enroll => 1, domroles => 1,},
                mkdiruserfile => {remote => 1, enroll => 1,},                 mkdiruserfile => {remote => 1, enroll => 1,},
                newput => {remote => 1, enroll => 1, reqcrs => 1, domroles => 1,},                 newput => {remote => 1, enroll => 1, reqcrs => 1, domroles => 1,},
Line 295  my %trust = ( Line 308  my %trust = (
                store => {remote => 1, enroll => 1, reqcrs => 1,},                 store => {remote => 1, enroll => 1, reqcrs => 1,},
                studentphoto => {remote => 1, enroll => 1},                 studentphoto => {remote => 1, enroll => 1},
                sub => {content => 1,},                 sub => {content => 1,},
                tmpdel => {anywhere => 1},                 tmpdel => {institutiononly => 1},
                tmpget => {anywhere => 1},                 tmpget => {institutiononly => 1},
                tmpput => {anywhere => 1},                 tmpput => {remote => 1, othcoau => 1},
                tokenauthuserfile => {anywhere => 1},                 tokenauthuserfile => {anywhere => 1},
                unsub => {content => 1,},                 unsub => {content => 1,},
                update => {shared => 1},                 update => {shared => 1},
                  updatebalcookie => {institutiononly => 1},
                updateclickers => {remote => 1},                 updateclickers => {remote => 1},
                userhassession => {anywhere => 1},                 userhassession => {anywhere => 1},
                userload => {anywhere => 1},                 userload => {anywhere => 1},
Line 420  sub SSLConnection { Line 434  sub SSLConnection {
     Debug("Approving promotion -> ssl");      Debug("Approving promotion -> ssl");
     #  And do so:      #  And do so:
   
       my $CRLFile;
       unless ($crlchecked{$clientname}) {
           $CRLFile = lonssl::CRLFile();
           $crlchecked{$clientname} = 1;
       }
   
     my $SSLSocket = lonssl::PromoteServerSocket($Socket,      my $SSLSocket = lonssl::PromoteServerSocket($Socket,
  $CACertificate,   $CACertificate,
  $Certificate,   $Certificate,
  $KeyFile);   $KeyFile,
    $clientname,
                                                   $CRLFile,
                                                   $clientversion);
     if(! ($SSLSocket) ) { # SSL socket promotion failed.      if(! ($SSLSocket) ) { # SSL socket promotion failed.
  my $err = lonssl::LastError();   my $err = lonssl::LastError();
  &logthis("<font color=\"red\"> CRITICAL "   &logthis("<font color=\"red\"> CRITICAL "
Line 779  sub ConfigFileFromSelector { Line 802  sub ConfigFileFromSelector {
     my $selector   = shift;      my $selector   = shift;
     my $tablefile;      my $tablefile;
   
     my $tabledir = $perlvar{'lonTabDir'}.'/';      if ($selector eq 'loncapaCAcrl') {
     if (($selector eq "hosts") || ($selector eq "domain") ||           my $tabledir = $perlvar{'lonCertificateDirectory'};
         ($selector eq "dns_hosts") || ($selector eq "dns_domain")) {          if (-d $tabledir) {
  $tablefile =  $tabledir.$selector.'.tab';              $tablefile =  $tabledir.'/'.$selector.'.pem';
           }
       } else {
           my $tabledir = $perlvar{'lonTabDir'}.'/';
           if (($selector eq "hosts") || ($selector eq "domain") || 
               ($selector eq "dns_hosts") || ($selector eq "dns_domain")) {
       $tablefile =  $tabledir.$selector.'.tab';
           }
     }      }
     return $tablefile;      return $tablefile;
 }  }
Line 806  sub PushFile { Line 836  sub PushFile {
     my ($command, $filename, $contents) = split(":", $request, 3);      my ($command, $filename, $contents) = split(":", $request, 3);
     &Debug("PushFile");      &Debug("PushFile");
           
     #  At this point in time, pushes for only the following tables are      #  At this point in time, pushes for only the following tables and
     #  supported:      #  CRL file are supported:
     #   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).
     # 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 832  sub PushFile { Line 863  sub PushFile {
   
     if($filename eq "host") {      if($filename eq "host") {
  $contents = AdjustHostContents($contents);   $contents = AdjustHostContents($contents);
     } elsif ($filename eq 'dns_host' || $filename eq 'dns_domain') {      } elsif (($filename eq 'dns_host') || ($filename eq 'dns_domain') ||
                ($filename eq 'loncapaCAcrl')) {
         if ($contents eq '') {          if ($contents eq '') {
             &logthis('<font color="red"> Pushfile: unable to install '              &logthis('<font color="red"> Pushfile: unable to install '
                     .$tablefile." - no data received from push. </font>");                      .$tablefile." - no data received from push. </font>");
Line 843  sub PushFile { Line 875  sub PushFile {
             if ($managers{$clientip} eq $clientname) {              if ($managers{$clientip} eq $clientname) {
                 my $clientprotocol = $Apache::lonnet::protocol{$clientname};                  my $clientprotocol = $Apache::lonnet::protocol{$clientname};
                 $clientprotocol = 'http' if ($clientprotocol ne 'https');                  $clientprotocol = 'http' if ($clientprotocol ne 'https');
                 my $url = '/adm/'.$filename;                  my $url;
                 $url =~ s{_}{/};                  if ($filename eq 'loncapaCAcrl') {
                       $url = '/adm/dns/loncapaCRL';
                   } else {
                       $url = '/adm/'.$filename;
                       $url =~ s{_}{/};
                   }
                 my $request=new HTTP::Request('GET',"$clientprotocol://$clienthost$url");                  my $request=new HTTP::Request('GET',"$clientprotocol://$clienthost$url");
                 my $response = LONCAPA::LWPReq::makerequest($clientname,$request,'',\%perlvar,60,0);                  my $response = LONCAPA::LWPReq::makerequest($clientname,$request,'',\%perlvar,60,0);
                 if ($response->is_error()) {                  if ($response->is_error()) {
Line 1606  sub du2_handler { Line 1643  sub du2_handler {
 #  #
 #    1. for a directory, and the path does not begin with one of:  #    1. for a directory, and the path does not begin with one of:
 #        (a) /home/httpd/html/res/<domain>  #        (a) /home/httpd/html/res/<domain>
 #        (b) /home/httpd/html/res/userfiles/  #        (b) /home/httpd/html/userfiles/
 #        (c) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/userfiles  #        (c) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/userfiles
 #    or is:  #    or is:
 #  #
 #    2. for a file, and the path (after prepending) does not begin with:  #    2. for a file, and the path (after prepending) does not begin with one of:
 #    /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/  #        (a) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/
   #        (b) /home/httpd/html/res/<domain>/<username>/
   #        (c) /home/httpd/html/userfiles/<domain>/<username>/
 #  #
 #    the response will be "refused".  #    the response will be "refused".
 #  #
Line 1642  sub ls_handler { Line 1681  sub ls_handler {
     }      }
     if (-e $ulsdir) {      if (-e $ulsdir) {
  if(-d $ulsdir) {   if(-d $ulsdir) {
             unless (($ulsdir =~ m{/home/httpd/html/(res/$LONCAPA::match_domain|userfiles/)}) ||              unless (($ulsdir =~ m{^/home/httpd/html/(res/$LONCAPA::match_domain|userfiles/)}) ||
                     ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/userfiles/})) {                      ($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/userfiles})) {
                 &Failure($client,"refused\n",$userinput);                  &Failure($client,"refused\n",$userinput);
                 return 1;                  return 1;
             }              }
Line 1670  sub ls_handler { Line 1709  sub ls_handler {
  closedir(LSDIR);   closedir(LSDIR);
     }      }
  } else {   } else {
             unless ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/}) {              unless (($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/}) ||
                       ($ulsdir =~ m{^/home/httpd/html/(?:res|userfiles)/$LONCAPA::match_domain/$LONCAPA::match_name/})) {
                 &Failure($client,"refused\n",$userinput);                  &Failure($client,"refused\n",$userinput);
                 return 1;                  return 1;
             }              }
Line 1703  sub ls_handler { Line 1743  sub ls_handler {
 #  #
 #    1. for a directory, and the path does not begin with one of:  #    1. for a directory, and the path does not begin with one of:
 #        (a) /home/httpd/html/res/<domain>  #        (a) /home/httpd/html/res/<domain>
 #        (b) /home/httpd/html/res/userfiles/  #        (b) /home/httpd/html/userfiles/
 #        (c) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/userfiles  #        (c) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/userfiles
 #    or is:  #    or is:
 #  #
 #    2. for a file, and the path (after prepending) does not begin with:  #    2. for a file, and the path (after prepending) does not begin with one of:
 #    /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/  #        (a) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/
   #        (b) /home/httpd/html/res/<domain>/<username>/
   #        (c) /home/httpd/html/userfiles/<domain>/<username>/
 #  #
 #    the response will be "refused".  #    the response will be "refused".
 #  #
Line 1738  sub ls2_handler { Line 1780  sub ls2_handler {
     }      }
     if (-e $ulsdir) {      if (-e $ulsdir) {
         if(-d $ulsdir) {          if(-d $ulsdir) {
             unless (($ulsdir =~ m{/home/httpd/html/(res/$LONCAPA::match_domain|userfiles/)}) ||              unless (($ulsdir =~ m{^/home/httpd/html/(res/$LONCAPA::match_domain|userfiles/)}) ||
                     ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/userfiles/})) {                      ($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/userfiles})) {
                 &Failure($client,"refused\n","$userinput");                  &Failure($client,"refused\n","$userinput");
                 return 1;                  return 1;
             }              }
Line 1767  sub ls2_handler { Line 1809  sub ls2_handler {
                 closedir(LSDIR);                  closedir(LSDIR);
             }              }
         } else {          } else {
             unless ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/}) {              unless (($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/}) ||
                       ($ulsdir =~ m{^/home/httpd/html/(?:res|userfiles)/$LONCAPA::match_domain/$LONCAPA::match_name/})) {
                 &Failure($client,"refused\n",$userinput);                  &Failure($client,"refused\n",$userinput);
                 return 1;                  return 1;
             }              }
Line 1792  sub ls2_handler { Line 1835  sub ls2_handler {
 #  #
 #    1. for a directory, and the path does not begin with one of:  #    1. for a directory, and the path does not begin with one of:
 #        (a) /home/httpd/html/res/<domain>  #        (a) /home/httpd/html/res/<domain>
 #        (b) /home/httpd/html/res/userfiles/  #        (b) /home/httpd/html/userfiles/
 #        (c) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/userfiles  #        (c) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/userfiles
 #        (d) /home/httpd/html/priv/<domain>/ and client is the homeserver  #        (d) /home/httpd/html/priv/<domain> and client is the homeserver
 #  #
 #    or is:  #    or is:
 #  #
 #    2. for a file, and the path (after prepending) does not begin with:  #    2. for a file, and the path (after prepending) does not begin with one of:
 #    /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/  #        (a) /home/httpd/lonUsers/<domain>/<1>/<2>/<3>/<username>/
   #        (b) /home/httpd/html/res/<domain>/<username>/
   #        (c) /home/httpd/html/userfiles/<domain>/<username>/
   #        (d) /home/httpd/html/priv/<domain>/<username>/ and client is the homeserver
 #  #
 #    the response will be "refused".  #    the response will be "refused".
 #  #
Line 1873  sub ls3_handler { Line 1919  sub ls3_handler {
     my $rights;      my $rights;
     my $ulsout='';      my $ulsout='';
     my $ulsfn;      my $ulsfn;
   
       my ($crscheck,$toplevel,$currdom,$currnum,$skip);
       unless ($islocal) {
           my ($major,$minor) = split(/\./,$clientversion);
           if (($major < 2) || ($major == 2 && $minor < 12)) {
               $crscheck = 1;
           }
       }
     if (-e $ulsdir) {      if (-e $ulsdir) {
         if(-d $ulsdir) {          if(-d $ulsdir) {
             unless (($getpropath) || ($getuserdir) ||              unless (($getpropath) || ($getuserdir) ||
                     ($ulsdir =~ m{/home/httpd/html/(res/$LONCAPA::match_domain|userfiles/)}) ||                      ($ulsdir =~ m{^/home/httpd/html/(res/$LONCAPA::match_domain|userfiles/)}) ||
                     ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/userfiles/}) ||                      ($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/userfiles}) ||
                     (($ulsdir =~ m{/home/httpd/html/priv/$LONCAPA::match_domain/}) && ($islocal))) {                      (($ulsdir =~ m{^/home/httpd/html/priv/$LONCAPA::match_domain}) && ($islocal))) {
                 &Failure($client,"refused\n",$userinput);                  &Failure($client,"refused\n",$userinput);
                 return 1;                  return 1;
             }              }
             if (opendir(LSDIR,$ulsdir)) {              if (($crscheck) &&
                   ($ulsdir =~ m{^/home/httpd/html/res/($LONCAPA::match_domain)(/?$|/$LONCAPA::match_courseid)})) {
                   ($currdom,my $posscnum) = ($1,$2);
                   if (($posscnum eq '') || ($posscnum eq '/')) {
                       $toplevel = 1;
                   } else {
                       $posscnum =~ s{^/+}{};
                       if (&LONCAPA::Lond::is_course($currdom,$posscnum)) {
                           $skip = 1;
                       }
                   }
               }
               if ((!$skip) && (opendir(LSDIR,$ulsdir))) {
                 while ($ulsfn=readdir(LSDIR)) {                  while ($ulsfn=readdir(LSDIR)) {
                       if (($crscheck) && ($toplevel) && ($currdom ne '') &&
                           ($ulsfn =~ /^$LONCAPA::match_courseid$/) && (-d "$ulsdir/$ulsfn")) {
                           if (&LONCAPA::Lond::is_course($currdom,$ulsfn)) {
                               next;
                           }
                       }
                     undef($obs);                      undef($obs);
                     undef($rights);                      undef($rights);
                     my @ulsstats=stat($ulsdir.'/'.$ulsfn);                      my @ulsstats=stat($ulsdir.'/'.$ulsfn);
Line 1907  sub ls3_handler { Line 1979  sub ls3_handler {
             }              }
         } else {          } else {
             unless (($getpropath) || ($getuserdir) ||              unless (($getpropath) || ($getuserdir) ||
                     ($ulsdir =~ m{/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_username/})) {                      ($ulsdir =~ m{^/home/httpd/lonUsers/$LONCAPA::match_domain(?:/[\w\-.@]){3}/$LONCAPA::match_name/}) ||
                       ($ulsdir =~ m{^/home/httpd/html/(?:res|userfiles)/$LONCAPA::match_domain/$LONCAPA::match_name/}) ||
                       (($ulsdir =~ m{^/home/httpd/html/priv/$LONCAPA::match_domain/$LONCAPA::match_name/}) && ($islocal))) {
                 &Failure($client,"refused\n",$userinput);                  &Failure($client,"refused\n",$userinput);
                 return 1;                  return 1;
             }              }
Line 1963  sub read_lonnet_global { Line 2037  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|rocky|alma)/) {
                             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 2059  sub server_distarch_handler { Line 2133  sub server_distarch_handler {
 sub server_certs_handler {  sub server_certs_handler {
     my ($cmd,$tail,$client) = @_;      my ($cmd,$tail,$client) = @_;
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
     my $result;      my $hostname = &Apache::lonnet::hostname($perlvar{'lonHostID'});
     my $result = &LONCAPA::Lond::server_certs(\%perlvar);      my $result = &LONCAPA::Lond::server_certs(\%perlvar,$perlvar{'lonHostID'},$hostname);
     &Reply($client,\$result,$userinput);      &Reply($client,\$result,$userinput);
     return;      return;
 }  }
Line 2281  sub change_password_handler { Line 2355  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 2303  sub change_password_handler { Line 2449  sub change_password_handler {
     my $result = &change_unix_password($uname, $npass);      my $result = &change_unix_password($uname, $npass);
             if ($result eq 'ok') {              if ($result eq 'ok') {
                 &update_passwd_history($uname,$udom,$howpwd,$context);                  &update_passwd_history($uname,$udom,$howpwd,$context);
              }              }
     &logthis("Result of password change for $uname: ".      &logthis("Result of password change for $uname: ".
      $result);       $result);
     &Reply($client, \$result, $userinput);      &Reply($client, \$result, $userinput);
Line 2314  sub change_password_handler { Line 2460  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 2596  sub update_resource_handler { Line 2741  sub update_resource_handler {
  my $request=new HTTP::Request('GET',"$remoteurl");   my $request=new HTTP::Request('GET',"$remoteurl");
                 $response=&LONCAPA::LWPReq::makerequest($clientname,$request,$transname,\%perlvar,1200,0,1);                  $response=&LONCAPA::LWPReq::makerequest($clientname,$request,$transname,\%perlvar,1200,0,1);
  if ($response->is_error()) {   if ($response->is_error()) {
 # FIXME: we should probably clean up here instead of just whine                      my $reply=&Apache::lonnet::reply("unsub:$fname","$clientname");
     unlink($transname);                      &devalidate_meta_cache($fname);
                       if (-e $transname) {
                           unlink($transname);
                       }
                       unlink($fname);
     my $message=$response->status_line;      my $message=$response->status_line;
     &logthis("LWP GET: $message for $fname ($remoteurl)");      &logthis("LWP GET: $message for $fname ($remoteurl)");
  } else {   } else {
Line 2891  sub user_has_session_handler { Line 3040  sub user_has_session_handler {
 }  }
 &register_handler("userhassession", \&user_has_session_handler, 0,1,0);  &register_handler("userhassession", \&user_has_session_handler, 0,1,0);
   
   sub del_usersession_handler {
       my ($cmd, $tail, $client) = @_;
   
       my $result;
       my ($udom, $uname) = map { &unescape($_) } (split(/:/, $tail));
       if (($udom =~ /^$LONCAPA::match_domain$/) && ($uname =~ /^$LONCAPA::match_username$/)) {
           my $lonidsdir = $perlvar{'lonIDsDir'};
           if (-d $lonidsdir) {
               if (opendir(DIR,$lonidsdir)) {
                   my $filename;
                   while ($filename=readdir(DIR)) {
                       if ($filename=~/^\Q$uname\E_\d+_\Q$udom\E_/) {
                           if (tie(my %oldenv,'GDBM_File',"$lonidsdir/$filename",
                                   &GDBM_READER(),0640)) {
                               my $linkedfile;
                               if (exists($oldenv{'user.linkedenv'})) {
                                   $linkedfile = $oldenv{'user.linkedenv'};
                               }
                               untie(%oldenv);
                               $result = unlink("$lonidsdir/$filename");
                               if ($result) {
                                   if ($linkedfile =~ /^[a-f0-9]+_linked$/) {
                                       if (-l "$lonidsdir/$linkedfile.id") {
                                           unlink("$lonidsdir/$linkedfile.id");
                                       }
                                   }
                               }
                           } else {
                               $result = unlink("$lonidsdir/$filename");
                           }
                           last;
                       }
                   }
               }
           }
           if ($result == 1) {
               &Reply($client, "$result\n", "$cmd:$tail");
           } else {
               &Reply($client, "not_found\n", "$cmd:$tail");
           }
       } else {
           &Failure($client, "invalid_user\n", "$cmd:$tail");
       }
       return 1;
   }
   
   &register_handler("delusersession", \&del_usersession_handler, 0,1,0);
   
 #  #
 #  Authenticate access to a user file by checking that the token the user's   #  Authenticate access to a user file by checking that the token the user's 
 #  passed also exists in their session file  #  passed also exists in their session file
Line 3634  sub dump_with_regexp { Line 3831  sub dump_with_regexp {
 }  }
 &register_handler("dump", \&dump_with_regexp, 0, 1, 0);  &register_handler("dump", \&dump_with_regexp, 0, 1, 0);
   
   #
   #  Process the encrypted dump request. Original call should
   #  be from lonnet::dump() with seventh arg ($encrypt) set to
   #  1, to ensure that both request and response are encrypted.
   #
   #  Parameters:
   #     $cmd               - Command keyword of request (edump).
   #     $tail              - Tail of the command.
   #                          See &dump_with_regexp for more
   #                          information about this.
   #     $client            - File open on the client.
   #  Returns:
   #     1      - Continue processing
   #     0      - server should exit.
   #
   
   sub encrypted_dump_with_regexp {
       my ($cmd, $tail, $client) = @_;
       my $res = LONCAPA::Lond::dump_with_regexp($tail, $clientversion);
   
       if ($res =~ /^error:/) {
           Failure($client, \$res, "$cmd:$tail");
       } else {
           if ($cipher) {
               my $cmdlength=length($res);
               $res.="         ";
               my $encres='';
               for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
                   $encres.= unpack("H16",
                                    $cipher->encrypt(substr($res,
                                                            $encidx,
                                                            8)));
               }
               &Reply( $client,"enc:$cmdlength:$encres\n","$cmd:$tail");
           } else {
               &Failure( $client, "error:no_key\n","$cmd:$tail");
           }
       }
   }
   &register_handler("edump", \&encrypted_dump_with_regexp, 0, 1, 0);
   
 #  Store a set of key=value pairs associated with a versioned name.  #  Store a set of key=value pairs associated with a versioned name.
 #  #
 #  Parameters:  #  Parameters:
Line 4682  sub course_lastaccess_handler { Line 4920  sub course_lastaccess_handler {
 }  }
 &register_handler("courselastaccess",\&course_lastaccess_handler, 0, 1, 0);  &register_handler("courselastaccess",\&course_lastaccess_handler, 0, 1, 0);
   
   sub course_sessions_handler {
       my ($cmd, $tail, $client) = @_;
       my $userinput = "$cmd:$tail";
       my ($cdom,$cnum,$lastactivity) = split(':',$tail);
       my $dbsuffix = '_'.$cdom.'_'.$cnum.'.db';
       my (%sessions,$qresult);
       my $now=time;
       if (opendir(DIR,$perlvar{'lonIDsDir'})) {
           my $filename;
           while ($filename=readdir(DIR)) {
               next if ($filename=~/^\./);
               next if ($filename=~/^publicuser_/);
               next if ($filename=~/^[a-f0-9]+_(linked|lti_\d+)\.id$/);
               if ($filename =~ /^($LONCAPA::match_username)_\d+_($LONCAPA::match_domain)_/) {
                   my ($uname,$udom) = ($1,$2);
                   next unless (-e "$perlvar{'lonDaemons'}/tmp/$uname$dbsuffix");
                   my $mtime = (stat("$perlvar{'lonIDsDir'}/$filename"))[9];
                   if ($lastactivity < 0) {
                       next if ($mtime-$now > $lastactivity);
                   } else {
                       next if ($now-$mtime > $lastactivity);
                   }
                   $sessions{$uname.':'.$udom} = $mtime;
               }
           }
           closedir(DIR); 
       }
       foreach my $user (keys(%sessions)) {
           $qresult.=&escape($user).'='.$sessions{$user}.'&';
       }
       if ($qresult) {
           chop($qresult);
       }
       &Reply($client, \$qresult, $userinput);
       return 1;
   }
   &register_handler("coursesessions",\&course_sessions_handler, 0, 1, 0);
   
 #  #
 # Puts an unencrypted entry in a namespace db file at the domain level   # Puts an unencrypted entry in a namespace db file at the domain level 
 #  #
Line 4846  sub del_domain_handler { Line 5122  sub del_domain_handler {
 # domain directory.  # domain directory.
 #  #
 # Parameters:  # Parameters:
 #   $cmd             - Command request keyword (get).  #   $cmd             - Command request keyword (getdom).
 #   $tail            - Tail of the command.  This is a colon separated list  #   $tail            - Tail of the command.  This is a colon separated list
 #                      consisting of the domain and the 'namespace'   #                      consisting of the domain and the 'namespace' 
 #                      which selects the gdbm file to do the lookup in,  #                      which selects the gdbm file to do the lookup in,
Line 4863  sub del_domain_handler { Line 5139  sub del_domain_handler {
 sub get_domain_handler {  sub get_domain_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
   
   
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
   
     my ($udom,$namespace,$what)=split(/:/,$tail,3);      my ($udom,$namespace,$what)=split(/:/,$tail,3);
     chomp($what);  
     if ($namespace =~ /^enc/) {      if ($namespace =~ /^enc/) {
         &Failure( $client, "refused\n", $userinput);          &Failure( $client, "refused\n", $userinput);
     } else {      } else {
         my @queries=split(/\&/,$what);          my $res = LONCAPA::Lond::get_dom($userinput);
         my $qresult='';          if ($res =~ /^error:/) {
         my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER());              &Failure($client, \$res, $userinput);
         if ($hashref) {  
             for (my $i=0;$i<=$#queries;$i++) {  
                 $qresult.="$hashref->{$queries[$i]}&";  
             }  
             if (&untie_domain_hash($hashref)) {  
                 $qresult=~s/\&$//;  
                 &Reply($client, \$qresult, $userinput);  
             } else {  
                 &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".  
                           "while attempting getdom\n",$userinput);  
             }  
         } else {          } else {
             &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".              &Reply($client, \$res, $userinput);
                      "while attempting getdom\n",$userinput);  
         }          }
     }      }
   
Line 4895  sub get_domain_handler { Line 5157  sub get_domain_handler {
 }  }
 &register_handler("getdom", \&get_domain_handler, 0, 1, 0);  &register_handler("getdom", \&get_domain_handler, 0, 1, 0);
   
   #
   # Encrypted get from the namespace database file at the domain level.
   # This function retrieves a keyed item from a specific named database in the
   # domain directory.
   #
   # Parameters:
   #   $cmd             - Command request keyword (egetdom).
   #   $tail            - Tail of the command.  This is a colon separated list
   #                      consisting of the domain and the 'namespace'
   #                      which selects the gdbm file to do the lookup in,
   #                      & separated list of keys to lookup.  Note that
   #                      the values are returned as an & separated list too.
   #   $client          - File descriptor open on the client.
   # Returns:
   #   1       - Continue processing.
   #   0       - Exit.
   #  Side effects:
   #     reply is encrypted before being written to $client.
   #
 sub encrypted_get_domain_handler {  sub encrypted_get_domain_handler {
     my ($cmd, $tail, $client) = @_;      my ($cmd, $tail, $client) = @_;
   
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
   
     my ($udom,$namespace,$what)=split(/:/,$tail,3);      my $res = LONCAPA::Lond::get_dom($userinput);
     chomp($what);      if ($res =~ /^error:/) {
     my @queries=split(/\&/,$what);          &Failure($client, \$res, $userinput);
     my $qresult='';      } else {
     my $hashref = &tie_domain_hash($udom, "$namespace", &GDBM_READER());          if ($cipher) {
     if ($hashref) {              my $cmdlength=length($res);
         for (my $i=0;$i<=$#queries;$i++) {              $res.="         ";
             $qresult.="$hashref->{$queries[$i]}&";              my $encres='';
         }              for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
         if (&untie_domain_hash($hashref)) {                  $encres.= unpack("H16",
             $qresult=~s/\&$//;                                   $cipher->encrypt(substr($res,
             if ($cipher) {                                                           $encidx,
                 my $cmdlength=length($qresult);                                                           8)));
                 $qresult.="         ";  
                 my $encqresult='';  
                 for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {  
                     $encqresult.= unpack("H16",  
                                          $cipher->encrypt(substr($qresult,  
                                                                  $encidx,  
                                                                  8)));  
                 }  
                 &Reply( $client, "enc:$cmdlength:$encqresult\n", $userinput);  
             } else {  
                 &Failure( $client, "error:no_key\n", $userinput);  
             }              }
               &Reply( $client,"enc:$cmdlength:$encres\n",$userinput);
         } else {          } else {
             &Failure( $client, "error: ".($!+0)." untie(GDBM) Failed ".              &Failure( $client, "error:no_key\n",$userinput);
                       "while attempting egetdom\n",$userinput);  
         }          }
     } else {  
         &Failure($client, "error: ".($!+0)." tie(GDBM) Failed ".  
                  "while attempting egetdom\n",$userinput);  
     }      }
     return 1;      return 1;
 }  }
 &register_handler("egetdom", \&encrypted_get_domain_handler, 1, 1, 0);  &register_handler("egetdom", \&encrypted_get_domain_handler, 1, 1, 0);
   
 #  #
   # Encrypted get from the namespace database file at the domain level.
   # This function retrieves a keyed item from a specific named database in the
   # domain directory.
   #
   # Parameters:
   #   $cmd             - Command request keyword (lti).
   #   $tail            - Tail of the command.  This is a colon-separated list
   #                      consisting of the domain, coursenum, if for LTI-
   #                      enabled deep-linking to course content using
   #                      link protection configured within a course,
   #                      context (=deeplink) if for LTI-enabled deep-linking
   #                      to course content using LTI Provider settings
   #                      configured within a course's domain, the (escaped)
   #                      launch URL, the (escaped) method (typically POST),
   #                      and a frozen hash of the LTI launch parameters
   #                      from the LTI payload.
   #   $client          - File descriptor open on the client.
   # Returns:
   #   1       - Continue processing.
   #   0       - Exit.
   #  Side effects:
   #     The reply will contain an LTI itemID, if the signed LTI payload
   #     could be verified using the consumer key and the shared secret 
   #     available for that key (for the itemID) for either the course or domain, 
   #     depending on values for cnum and context. The reply is encrypted before 
   #     being written to $client.
   #
   sub lti_handler {
       my ($cmd, $tail, $client) = @_;
   
       my $userinput = "$cmd:$tail";
   
       my ($cdom,$cnum,$context,$escurl,$escmethod,$items) = split(/:/,$tail);
       my $url = &unescape($escurl);
       my $method = &unescape($escmethod);
       my $params = &Apache::lonnet::thaw_unescape($items);
       my $res;
       if ($cnum ne '') {
           $res = &LONCAPA::Lond::crslti_itemid($cdom,$cnum,$url,$method,$params,$perlvar{'lonVersion'});
       } else {
           $res = &LONCAPA::Lond::domlti_itemid($cdom,$context,$url,$method,$params,$perlvar{'lonVersion'});
       }
       if ($res =~ /^error:/) {
           &Failure($client, \$res, $userinput);
       } else {
           if ($cipher) {
               my $cmdlength=length($res);
               $res.="         ";
               my $encres='';
               for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
                   $encres.= unpack("H16",
                                    $cipher->encrypt(substr($res,
                                                            $encidx,
                                                            8)));
               }
               &Reply( $client,"enc:$cmdlength:$encres\n",$userinput);
           } else {
               &Failure( $client, "error:no_key\n",$userinput);
           }
       }
       return 1;
   }
   &register_handler("lti", \&lti_handler, 1, 1, 0);
   
   #
 #  Puts an id to a domains id database.   #  Puts an id to a domains id database. 
 #  #
 #  Parameters:  #  Parameters:
Line 5362  sub tmp_put_handler { Line 5694  sub tmp_put_handler {
     }      }
     my ($id,$store);      my ($id,$store);
     $tmpsnum++;      $tmpsnum++;
     if (($context eq 'resetpw') || ($context eq 'createaccount')) {      my $numtries = 0;
         $id = &md5_hex(&md5_hex(time.{}.rand().$$));      my $execdir=$perlvar{'lonDaemons'};
       if (($context eq 'resetpw') || ($context eq 'createaccount') ||
           ($context eq 'sso') || ($context eq 'link') || ($context eq 'retry')) {
           $id = &md5_hex(&md5_hex(time.{}.rand().$$.$tmpsnum));
           while ((-e "$execdir/tmp/$id.tmp") && ($numtries <10)) {
               undef($id);
               $id = &md5_hex(&md5_hex(time.{}.rand().$$.$tmpsnum));
               $numtries ++;
           }
     } else {      } else {
         $id = $$.'_'.$clientip.'_'.$tmpsnum;          $id = $$.'_'.$clientip.'_'.$tmpsnum;
     }      }
     $id=~s/\W/\_/g;      $id=~s/\W/\_/g;
     $record=~s/\n//g;      $record=~s/\n//g;
     my $execdir=$perlvar{'lonDaemons'};      if (($id ne '') &&
     if ($store=IO::File->new(">$execdir/tmp/$id.tmp")) {          ($store=IO::File->new(">$execdir/tmp/$id.tmp"))) {
  print $store $record;   print $store $record;
  close $store;   close $store;
  &Reply($client, \$id, $userinput);   &Reply($client, \$id, $userinput);
Line 5453  sub tmp_del_handler { Line 5793  sub tmp_del_handler {
 &register_handler("tmpdel", \&tmp_del_handler, 0, 1, 0);  &register_handler("tmpdel", \&tmp_del_handler, 0, 1, 0);
   
 #  #
   #  Process the updatebalcookie command.  This command updates a
   #  cookie in the lonBalancedir directory on a load balancer node.
   #
   # Parameters:
   #   $cmd      - Command that got us here.
   #   $tail     - Tail of the request (escaped cookie: escaped current entry)
   #
   #   $client   - socket open on the client process.
   #
   # Returns:
   #   1     - Indicating processing should continue.
   # Side Effects:
   #   A cookie file is updated from the lonBalancedir directory
   #   A reply is sent to the client.
   #
   sub update_balcookie_handler {
       my ($cmd, $tail, $client) = @_;
   
       my $userinput= "$cmd:$tail";
       chomp($tail);
       my ($cookie,$lastentry) = map { &unescape($_) } (split(/:/,$tail));
   
       my $updatedone;
       if ($cookie =~ /^$LONCAPA::match_domain\_$LONCAPA::match_username\_[a-f0-9]{32}$/) {
           my $execdir=$perlvar{'lonBalanceDir'};
           if (-e "$execdir/$cookie.id") {
               my $doupdate;
               if (open(my $fh,'<',"$execdir/$cookie.id")) {
                   while (my $line = <$fh>) {
                       chomp($line);
                       if ($line eq $lastentry) {
                           $doupdate = 1;
                           last;
                       }
                   }
                   close($fh);
               }
               if ($doupdate) {
                   if (open(my $fh,'>',"$execdir/$cookie.id")) {
                       print $fh $clientname;
                       close($fh);
                       $updatedone = 1;
                   }
               }
           }
       }
       if ($updatedone) {
           &Reply($client, "ok\n", $userinput);
       } else {
           &Failure( $client, "error: ".($!+0)."file update failed ".
                     "while attempting updatebalcookie\n", $userinput);
       }
       return 1;
   }
   &register_handler("updatebalcookie", \&update_balcookie_handler, 0, 1, 0);
   
   #
   #  Process the delbalcookie command. This command deletes a balancer
   #  cookie in the lonBalancedir directory on a load balancer node.
   #
   # Parameters:
   #   $cmd      - Command that got us here.
   #   $cookie   - Cookie to be deleted.
   #   $client   - socket open on the client process.
   #
   # Returns:
   #   1     - Indicating processing should continue.
   # Side Effects:
   #   A cookie file is deleted from the lonBalancedir directory
   #   A reply is sent to the client.
   sub del_balcookie_handler {
       my ($cmd, $cookie, $client) = @_;
   
       my $userinput= "$cmd:$cookie";
   
       chomp($cookie);
       $cookie = &unescape($cookie);
       my $deleted = '';
       if ($cookie =~ /^$LONCAPA::match_domain\_$LONCAPA::match_username\_[a-f0-9]{32}$/) {
           my $execdir=$perlvar{'lonBalanceDir'};
           if (-e "$execdir/$cookie.id") {
               if (open(my $fh,'<',"$execdir/$cookie.id")) {
                   my $dodelete;
                   while (my $line = <$fh>) {
                       chomp($line);
                       if ($line eq $clientname) {
                           $dodelete = 1;
                           last;
                       }
                   }
                   close($fh);
                   if ($dodelete) {
                       if (unlink("$execdir/$cookie.id")) {
                           $deleted = 1;
                       }
                   }
               }
           }
       }
       if ($deleted) {
           &Reply($client, "ok\n", $userinput);
       } else {
           &Failure( $client, "error: ".($!+0)."Unlinking cookie file Failed ".
                     "while attempting delbalcookie\n", $userinput);
       }
       return 1;
   }
   &register_handler("delbalcookie", \&del_balcookie_handler, 0, 1, 0);
   
   #
 #   Processes the setannounce command.  This command  #   Processes the setannounce command.  This command
 #   creates a file named announce.txt in the top directory of  #   creates a file named announce.txt in the top directory of
 #   the documentn root and sets its contents.  The announce.txt file is  #   the documentn root and sets its contents.  The announce.txt file is
Line 5635  sub validate_instcode_handler { Line 6085  sub validate_instcode_handler {
 }  }
 &register_handler("autovalidateinstcode", \&validate_instcode_handler, 0, 1, 0);  &register_handler("autovalidateinstcode", \&validate_instcode_handler, 0, 1, 0);
   
   #
   #  Validate co-owner for cross-listed institutional code and
   #  institutional course code itself used for a LON-CAPA course.
   #
   # Formal Parameters:
   #   $cmd          - The command request that got us dispatched.
   #   $tail         - The tail of the command.  In this case,
   #                   this is a colon separated string containing:
   #      $dom            - Course's LON-CAPA domain
   #      $instcode       - Institutional course code for the course
   #      $inst_xlist     - Institutional course Id for the crosslisting
   #      $coowner        - Username of co-owner
   #      (values for all but $dom have been escaped). 
   #
   #   $client       - Socket open on the client.
   # Returns:
   #    1           - Indicating processing should continue.
   #
   sub validate_instcrosslist_handler  {
       my ($cmd, $tail, $client) = @_;
       my $userinput = "$cmd:$tail";
       my ($dom,$instcode,$inst_xlist,$coowner) = split(/:/,$tail);
       $instcode = &unescape($instcode);
       $inst_xlist = &unescape($inst_xlist);
       $coowner = &unescape($coowner);
       my $outcome = &localenroll::validate_crosslist_access($dom,$instcode,
                                                             $inst_xlist,$coowner);
       &Reply($client, \$outcome, $userinput);
   
       return 1;
   }
   &register_handler("autovalidateinstcrosslist", \&validate_instcrosslist_handler, 0, 1, 0);
   
 #   Get the official sections for which auto-enrollment is possible.  #   Get the official sections for which auto-enrollment is possible.
 #   Since the admin people won't know about 'unofficial sections'   #   Since the admin people won't know about 'unofficial sections' 
 #   we cannot auto-enroll on them.  #   we cannot auto-enroll on them.
Line 5731  sub validate_course_section_handler { Line 6214  sub validate_course_section_handler {
 # Formal Parameters:  # Formal Parameters:
 #    $cmd     - The command request that got us dispatched.  #    $cmd     - The command request that got us dispatched.
 #    $tail    - The tail of the command.   In this case this is a colon separated  #    $tail    - The tail of the command.   In this case this is a colon separated
 #               set of words that will be split into:  #               set of values that will be split into:
 #               $inst_class  - Institutional code for the specific class section     #               $inst_class  - Institutional code for the specific class section   
 #               $courseowner - The escaped username:domain of the course owner   #               $ownerlist   - An escaped comma-separated list of username:domain 
   #                              of the course owner, and co-owner(s).
 #               $cdom        - The domain of the course from the institution's  #               $cdom        - The domain of the course from the institution's
 #                              point of view.  #                              point of view.
 #    $client  - The socket open on the client.  #    $client  - The socket open on the client.
Line 5758  sub validate_class_access_handler { Line 6242  sub validate_class_access_handler {
 &register_handler("autovalidateclass_sec", \&validate_class_access_handler, 0, 1, 0);  &register_handler("autovalidateclass_sec", \&validate_class_access_handler, 0, 1, 0);
   
 #  #
   #    Modify institutional sections (using customized &instsec_reformat()
   #    routine in localenroll.pm), to either clutter or declutter, for  
   #    purposes of ensuring an institutional course section (string) can
   #    be unambiguously separated into institutional course and section.
   #
   # Formal Parameters:
   #    $cmd     - The command request that got us dispatched.
   #    $tail    - The tail of the command.   In this case this is a colon separated
   #               set of values that will be split into:
   #               $cdom        - The LON-CAPA domain of the course.
   #               $action      - Either: clutter or declutter
   #                              clutter adds character(s) to eliminate ambiguity
   #                              declutter removes the added characters (e.g., for
   #                              display of the institutional course section string.
   #               $info        - A frozen hash in which keys are: 
   #                              LON-CAPA course number:Institutional course code
   #                              and values are a reference to an array of the
   #                              items to modify -- either institutional sections,
   #                              or institutional course sections (for crosslistings). 
   #    $client  - The socket open on the client.
   # Returns:
   #    1 - continue processing.
   #   
   
   sub instsec_reformat_handler {
       my ($cmd, $tail, $client) = @_;
       my $userinput = "$cmd:$tail";
       my ($cdom,$action,$info) = split(/:/,$tail);
       my $instsecref = &Apache::lonnet::thaw_unescape($info);
       my ($outcome,$result);
       eval {
           local($SIG{__DIE__})='DEFAULT';
           $outcome=&localenroll::instsec_reformat($cdom,$action,$instsecref);
           if ($outcome eq 'ok') {
               if (ref($instsecref) eq 'HASH') {
                   foreach my $key (keys(%{$instsecref})) {
                       $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($instsecref->{$key}).'&';
                   }
                   $result =~ s/\&$//;
               }
           }
       };
       if (!$@) {
           if ($outcome eq 'ok') {
               &Reply( $client, \$result, $userinput);
           } else {
               &Reply($client,\$outcome, $userinput);
           }
       } else {
           &Failure($client,"unknown_cmd\n",$userinput);
       }
       return 1;
   }
   &register_handler("autoinstsecreformat",\&instsec_reformat_handler, 0, 1, 0);
   
   #
   #   Validate course owner or co-owners(s) access to enrollment data for all sections
   #   and crosslistings for a particular course.
   #
   #
   # Formal Parameters:
   #    $cmd     - The command request that got us dispatched.
   #    $tail    - The tail of the command.   In this case this is a colon separated
   #               set of values that will be split into:
   #               $ownerlist   - An escaped comma-separated list of username:domain
   #                              of the course owner, and co-owner(s).
   #               $cdom        - The domain of the course from the institution's
   #                              point of view.
   #               $classes     - Frozen hash of institutional course sections and
   #                              crosslistings.
   #    $client  - The socket open on the client.
   # Returns:
   #    1 - continue processing.
   #
   
   sub validate_classes_handler {
       my ($cmd, $tail, $client) = @_;
       my $userinput = "$cmd:$tail";
       my ($ownerlist,$cdom,$classes) = split(/:/, $tail);
       my $classesref = &Apache::lonnet::thaw_unescape($classes);
       my $owners = &unescape($ownerlist);
       my $result;
       eval {
           local($SIG{__DIE__})='DEFAULT';
           my %validations;
           my $response = &localenroll::check_instclasses($owners,$cdom,$classesref,
                                                          \%validations);
           if ($response eq 'ok') {
               foreach my $key (keys(%validations)) {
                   $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($validations{$key}).'&';
               }
               $result =~ s/\&$//;
           } else {
               $result = 'error';
           }
       };
       if (!$@) {
           &Reply($client, \$result, $userinput);
       } else {
           &Failure($client,"unknown_cmd\n",$userinput);
       }
       return 1;
   }
   &register_handler("autovalidateinstclasses", \&validate_classes_handler, 0, 1, 0);
   
   #
 #   Create a password for a new LON-CAPA user added by auto-enrollment.  #   Create a password for a new LON-CAPA user added by auto-enrollment.
 #   Only used for case where authentication method for new user is localauth  #   Only used for case where authentication method for new user is localauth
 #  #
Line 6791  my $wwwid=getpwnam('www'); Line 7381  my $wwwid=getpwnam('www');
 if ($wwwid!=$<) {  if ($wwwid!=$<) {
    my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";     my $emailto="$perlvar{'lonAdmEMail'},$perlvar{'lonSysEMail'}";
    my $subj="LON: $currenthostid User ID mismatch";     my $subj="LON: $currenthostid User ID mismatch";
    system("echo 'User ID mismatch.  lond must be run as user www.' |\     system("echo 'User ID mismatch.  lond must be run as user www.' |".
  mailto $emailto -s '$subj' > /dev/null");            " mail -s '$subj' $emailto > /dev/null");
    exit 1;     exit 1;
 }  }
   
Line 6926  sub UpdateHosts { Line 7516  sub UpdateHosts {
   
     my %oldconf = %secureconf;      my %oldconf = %secureconf;
     my %connchange;      my %connchange;
     if (lonssl::Read_Connect_Config(\%secureconf,\%perlvar) eq 'ok') {      if (lonssl::Read_Connect_Config(\%secureconf,\%perlvar,\%crlchecked) eq 'ok') {
         logthis('<font color="blue"> Reloaded SSL connection rules </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 </font>');          logthis('<font color="yellow"> Failed to reload SSL connection rules and clear CRL checking history </font>');
     }      }
     if ((ref($oldconf{'connfrom'}) eq 'HASH') && (ref($secureconf{'connfrom'}) eq 'HASH')) {      if ((ref($oldconf{'connfrom'}) eq 'HASH') && (ref($secureconf{'connfrom'}) eq 'HASH')) {
         foreach my $type ('dom','intdom','other') {          foreach my $type ('dom','intdom','other') {
Line 7208  if ($arch eq 'unknown') { Line 7798  if ($arch eq 'unknown') {
     chomp($arch);      chomp($arch);
 }  }
   
 unless (lonssl::Read_Connect_Config(\%secureconf,\%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 7297  sub make_new_child { Line 7887  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|rocky|alma)(\d+)/) {
             if ($1 >= 7) {              if ($1 >= 7) {
                 $no_ets = 1;                  $no_ets = 1;
             }              }
Line 7342  sub make_new_child { Line 7932  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 7443  sub make_new_child { Line 8033  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 7481  sub make_new_child { Line 8070  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");
  $keep_going = &process_request($user_input);   $keep_going = &process_request($user_input);
  alarm(0);   alarm(0);
  &status('Listening to '.$clientname." ($keymode)");      &status('Listening to '.$clientname." ($keymode)");
     }      }
   
 # --------------------------------------------- client unknown or fishy, refuse  # --------------------------------------------- client unknown or fishy, refuse
Line 7530  sub make_new_child { Line 8092  sub make_new_child {
           
     &logthis("<font color='red'>CRITICAL: "      &logthis("<font color='red'>CRITICAL: "
      ."Disconnect from $clientip ($clientname)</font>");           ."Disconnect from $clientip ($clientname)</font>");    
       
       
     # this exit is VERY important, otherwise the child will become      # this exit is VERY important, otherwise the child will become
     # a producer of more and more children, forking yourself into      # a producer of more and more children, forking yourself into
     # process death.      # process death.
Line 7541  sub make_new_child { Line 8103  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 7568  sub set_client_info { Line 8138  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 7588  sub set_client_info { Line 8158  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 8303  sub make_passwd_file { Line 8880  sub make_passwd_file {
  $result = "pass_file_failed_error";   $result = "pass_file_failed_error";
     }      }
  }   }
       } elsif ($umode eq 'lti') {
           my $pf = IO::File->new(">$passfilename");
           if($pf) {
               print $pf "lti:\n";
               &update_passwd_history($uname,$udom,$umode,$action);
           } else {
               $result = "pass_file_failed_error";
           }
     } else {      } else {
  $result="auth_mode_error";   $result="auth_mode_error";
     }      }
Line 8327  sub sethost { Line 8912  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 8403  sub get_prohibited { Line 8989  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;
 }  }
Line 8809  is closed and the child exits. Line 9421  is closed and the child exits.
 =item Red CRITICAL Can't get key file <error>          =item Red CRITICAL Can't get key file <error>        
   
 SSL key negotiation is being attempted but the call to  SSL key negotiation is being attempted but the call to
 lonssl::KeyFile  failed.  This usually means that the  lonssl::KeyFile failed.  This usually means that the
 configuration file is not correctly defining or protecting  configuration file is not correctly defining or protecting
 the directories/files lonCertificateDirectory or  the directories/files lonCertificateDirectory or
 lonnetPrivateKey  lonnetPrivateKey
Removed from v.1.537  
changed lines
  Added in v.1.572

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
500 Internal Server Error

Internal Server Error

The server encountered an internal error or misconfiguration and was unable to complete your request.

Please contact the server administrator at root@localhost to inform them of the time this error occurred, and the actions you performed just before this error.

More information about this error may be available in the server error log.