Diff for /loncom/lond between versions 1.568 and 1.580

version 1.568, 2021/08/01 19:28:10 version 1.580, 2023/12/22 18:50:55
Line 259  my %trust = ( Line 259  my %trust = (
                instidrules => {remote => 1, domroles => 1,},                 instidrules => {remote => 1, domroles => 1,},
                instrulecheck => {remote => 1, enroll => 1, reqcrs => 1, domroles => 1},                 instrulecheck => {remote => 1, enroll => 1, reqcrs => 1, domroles => 1},
                instselfcreatecheck => {institutiononly => 1},                 instselfcreatecheck => {institutiononly => 1},
                  instunamemapcheck => {remote => 1,},  
                instuserrules => {remote => 1, enroll => 1, reqcrs => 1, domroles => 1},                 instuserrules => {remote => 1, enroll => 1, reqcrs => 1, domroles => 1},
                keys => {remote => 1,},                 keys => {remote => 1,},
                load => {anywhere => 1},                 load => {anywhere => 1},
Line 266  my %trust = ( Line 267  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 304  my %trust = ( Line 306  my %trust = (
                servertimezone => {remote => 1, enroll => 1},                 servertimezone => {remote => 1, enroll => 1},
                setannounce => {remote => 1, domroles => 1},                 setannounce => {remote => 1, domroles => 1},
                sethost => {anywhere => 1},                 sethost => {anywhere => 1},
                  signlti => {remote => 1},
                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,},
Line 311  my %trust = ( Line 314  my %trust = (
                tmpget => {institutiononly => 1},                 tmpget => {institutiononly => 1},
                tmpput => {remote => 1, othcoau => 1},                 tmpput => {remote => 1, othcoau => 1},
                tokenauthuserfile => {anywhere => 1},                 tokenauthuserfile => {anywhere => 1},
                  unamemaprules => {remote => 1,},
                unsub => {content => 1,},                 unsub => {content => 1,},
                update => {shared => 1},                 update => {shared => 1},
                updatebalcookie => {institutiononly => 1},                 updatebalcookie => {institutiononly => 1},
Line 862  sub PushFile { Line 866  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_hosts') || ($filename eq 'dns_domain') ||
              ($filename eq 'loncapaCAcrl')) {               ($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 '
Line 2036  sub read_lonnet_global { Line 2040  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|oracle)/) {                          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 2654  sub update_passwd_history { Line 2658  sub update_passwd_history {
     return;      return;
 }  }
   
   sub inst_unamemap_check {
       my ($cmd, $tail, $client)   = @_;
       my $userinput               = "$cmd:$tail";
       my %rulecheck;
       my $outcome;
       my ($udom,$uname,@rules) = split(/:/,$tail);
       $udom = &unescape($udom);
       $uname = &unescape($uname);
       @rules = map {&unescape($_);} (@rules);
       eval {
           local($SIG{__DIE__})='DEFAULT';
           $outcome = &localenroll::unamemap_check($udom,$uname,\@rules,\%rulecheck);
       };
       if (!$@) {
           if ($outcome eq 'ok') {
               my $result='';
               foreach my $key (keys(%rulecheck)) {
                   $result.=&escape($key).'='.&Apache::lonnet::freeze_escape($rulecheck{$key}).'&';
               }
               &Reply($client,\$result,$userinput);
           } else {
               &Reply($client,"error\n", $userinput);
           }
       } else {
           &Failure($client,"unknown_cmd\n",$userinput);
       }
   }
   &register_handler("instunamemapcheck",\&inst_unamemap_check,0,1,0);
   
   
 #  #
 #   Determines if this is the home server for a user.  The home server  #   Determines if this is the home server for a user.  The home server
 #   for a user will have his/her lon-capa passwd file.  Therefore all we need  #   for a user will have his/her lon-capa passwd file.  Therefore all we need
Line 5141  sub get_domain_handler { Line 5175  sub get_domain_handler {
     my $userinput = "$cmd:$tail";      my $userinput = "$cmd:$tail";
   
     my ($udom,$namespace,$what)=split(/:/,$tail,3);      my ($udom,$namespace,$what)=split(/:/,$tail,3);
     if ($namespace =~ /^enc/) {      if (($namespace =~ /^enc/) || ($namespace eq 'private')) {
         &Failure( $client, "refused\n", $userinput);          &Failure( $client, "refused\n", $userinput);
     } else {      } else {
         my $res = LONCAPA::Lond::get_dom($userinput);          my $res = LONCAPA::Lond::get_dom($userinput);
Line 5156  sub get_domain_handler { Line 5190  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 $res = LONCAPA::Lond::get_dom($userinput);      my ($udom,$namespace,$what) = split(/:/,$tail,3);
       if ($namespace eq 'private') {
           &Failure( $client, "refused\n", $userinput);
       } else {
           my $res = LONCAPA::Lond::get_dom($userinput);
           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("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:/) {      if ($res =~ /^error:/) {
         &Failure($client, \$res, $userinput);          &Failure($client, \$res, $userinput);
     } else {      } else {
Line 5182  sub encrypted_get_domain_handler { Line 5305  sub encrypted_get_domain_handler {
     }      }
     return 1;      return 1;
 }  }
 &register_handler("egetdom", \&encrypted_get_domain_handler, 1, 1, 0);  &register_handler("lti", \&lti_handler, 1, 1, 0);
   
   #
   # Data for LTI payload (received encrypted) are unencrypted and
   # then signed with the appropriate key and secret, before re-encrypting
   # the signed payload which is sent to the client for unencryption by
   # the caller: lonnet::sign_lti()) before dispatch either to a web browser
   # (launch) or to a remote web service (roster, logout, or grade).  
   #
   # Parameters:
   #   $cmd             - Command request keyword (signlti).
   #   $tail            - Tail of the command.  This is a colon-separated list
   #                      consisting of the domain, coursenum (if for an External
   #                      Tool defined in a course), crsdef (true if defined in
   #                      a course), type (linkprot or lti)
   #                      context (launch, roster, logout, or grade),
   #                      escaped launch URL, numeric ID of external tool,
   #                      version number for encryption key (if tool's LTI secret was
   #                      encrypted before storing), a frozen hash of LTI launch 
   #                      parameters, and a frozen hash of LTI information,
   #                      (e.g., method => 'HMAC-SHA1',
   #                             respfmt => 'to_authorization_header').
   #   $client          - File descriptor open on the client.
   # Returns:
   #   1       - Continue processing.
   #   0       - Exit.
   #  Side effects:
   #     The reply will contain the LTI payload, as & separated key=value pairs,
   #     where value is itself a frozen hash, if the required key and secret
   #     for the specific tool ID are available. The payload data are retrieved from
   #     a call to Lond::sign_lti_payload(), and the reply is encrypted before being
   #     written to $client.
   #
   sub sign_lti_handler {
       my ($cmd, $tail, $client) = @_;
   
       my $userinput = "$cmd:$tail";
   
       my ($cdom,$cnum,$crsdef,$type,$context,$escurl,
           $ltinum,$keynum,$paramsref,$inforef) = split(/:/,$tail);
       my $url = &unescape($escurl);
       my $params = &Apache::lonnet::thaw_unescape($paramsref);
       my $info = &Apache::lonnet::thaw_unescape($inforef);
       my $res =
           &LONCAPA::Lond::sign_lti_payload($cdom,$cnum,$crsdef,$type,$context,$url,$ltinum,
                                            $keynum,$perlvar{'lonVersion'},$params,$info);
       my $result;
       if (ref($res) eq 'HASH') {
           foreach my $key (keys(%{$res})) {
               $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($res->{$key}).'&';
           }
           $result =~ s/\&$//;
       } else {
           $result = $res;
       }
       if ($result =~ /^error:/) {
           &Failure($client, \$result, $userinput);
       } else {
           if ($cipher) {
               my $cmdlength=length($result);
               $result.="         ";
               my $encres='';
               for (my $encidx=0;$encidx<=$cmdlength;$encidx+=8) {
                   $encres.= unpack("H16",
                                    $cipher->encrypt(substr($result,
                                                            $encidx,
                                                            8)));
               }
               &Reply( $client,"enc:$cmdlength:$encres\n",$userinput);
           } else {
               &Failure( $client, "error:no_key\n",$userinput);
           }
       }
       return 1;
   }
   &register_handler("signlti", \&sign_lti_handler, 1, 1, 0);
   
 #  #
 #  Puts an id to a domains id database.   #  Puts an id to a domains id database. 
Line 5609  sub tmp_put_handler { Line 5807  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 6708  sub get_institutional_selfcreate_rules { Line 6914  sub get_institutional_selfcreate_rules {
 }  }
 &register_handler("instemailrules",\&get_institutional_selfcreate_rules,0,1,0);  &register_handler("instemailrules",\&get_institutional_selfcreate_rules,0,1,0);
   
   sub get_unamemap_rules {
       my ($cmd, $tail, $client)   = @_;
       my $userinput               = "$cmd:$tail";
       my $dom = &unescape($tail);
       my (%rules_hash,@rules_order);
       my $outcome;
       eval {
           local($SIG{__DIE__})='DEFAULT';
           $outcome = &localenroll::unamemap_rules($dom,\%rules_hash,\@rules_order);
       };
       if (!$@) {
           if ($outcome eq 'ok') {
               my $result;
               foreach my $key (keys(%rules_hash)) {
                   $result .= &escape($key).'='.&Apache::lonnet::freeze_escape($rules_hash{$key}).'&';
               }
               $result =~ s/\&$//;
               $result .= ':';
               if (@rules_order > 0) {
                   foreach my $item (@rules_order) {
                       $result .= &escape($item).'&';
                   }
               }
               $result =~ s/\&$//;
               &Reply($client,\$result,$userinput);
           } else {
               &Reply($client,"error\n", $userinput);
           }
       } else {
           &Failure($client,"unknown_cmd\n",$userinput);
       }
   }
   &register_handler("unamemaprules",\&get_unamemap_rules,0,1,0);
   
 sub institutional_username_check {  sub institutional_username_check {
     my ($cmd, $tail, $client)   = @_;      my ($cmd, $tail, $client)   = @_;
Line 7794  sub make_new_child { Line 8033  sub make_new_child {
         &Authen::Krb5::init_context();          &Authen::Krb5::init_context();
   
         my $no_ets;          my $no_ets;
         if ($dist =~ /^(?:centos|rhes|scientific|oracle)(\d+)$/) {          if ($dist =~ /^(?:centos|rhes|scientific|oracle|rocky|alma)(\d+)/) {
             if ($1 >= 7) {              if ($1 >= 7) {
                 $no_ets = 1;                  $no_ets = 1;
             }              }
Line 7983  sub make_new_child { Line 8222  sub make_new_child {
  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 7999  sub make_new_child { Line 8238  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 8289  sub validate_user { Line 8528  sub validate_user {
             } elsif ((($domdefaults{'auth_def'} eq 'krb4') ||               } elsif ((($domdefaults{'auth_def'} eq 'krb4') || 
                       ($domdefaults{'auth_def'} eq 'krb5')) &&                        ($domdefaults{'auth_def'} eq 'krb5')) &&
                      ($domdefaults{'auth_arg_def'} ne '')) {                       ($domdefaults{'auth_arg_def'} ne '')) {
                 $howpwd = $domdefaults{'auth_def'};                  #
                 $contentpwd = $domdefaults{'auth_arg_def'};                   # Don't attempt authentication for username and password supplied
                   # for user without an account if uername contains @ to avoid
                   # call to &Authen::Krb5::parse_name() which will result in con_lost
                   #
                   unless ($user =~ /\@/) {
                       $howpwd = $domdefaults{'auth_def'};
                       $contentpwd = $domdefaults{'auth_arg_def'};
                   }
             }              }
         }          }
     }      }
Line 8634  sub currentversion { Line 8880  sub currentversion {
     if (-e $ulsdir) {      if (-e $ulsdir) {
  if(-d $ulsdir) {   if(-d $ulsdir) {
     if (opendir(LSDIR,$ulsdir)) {      if (opendir(LSDIR,$ulsdir)) {
                   if (-e $fname) {
                       $version=0;
                   }
  my $ulsfn;   my $ulsfn;
  while ($ulsfn=readdir(LSDIR)) {   while ($ulsfn=readdir(LSDIR)) {
 # see if this is a regular file (ignore links produced earlier)  # see if this is a regular file (ignore links produced earlier)

Removed from v.1.568  
changed lines
  Added in v.1.580


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.