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

Diff for /loncom/lond between versions 1.489.2.43.2.10 and 1.489.2.44

version 1.489.2.43.2.10, 2023/12/29 20:10:17 version 1.489.2.44, 2022/02/25 09:46:25
Line 653  sub PushFile { Line 653  sub PushFile {
   
     if($filename eq "host") {      if($filename eq "host") {
  $contents = AdjustHostContents($contents);   $contents = AdjustHostContents($contents);
     } elsif (($filename eq 'dns_hosts') || ($filename eq 'dns_domain')) {      } elsif ($filename eq 'dns_host' || $filename eq 'dns_domain') {
         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 2407  sub update_passwd_history { Line 2407  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 2834  sub user_has_session_handler { Line 2804  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 3614  sub dump_with_regexp { Line 3536  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 4801  sub get_domain_handler { Line 4682  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/) || ($namespace eq 'private')) {      my $res = LONCAPA::Lond::get_dom($userinput);
         &Failure( $client, "refused\n", $userinput);  
     } else {  
         my $res = LONCAPA::Lond::get_dom($userinput);  
         if ($res =~ /^error:/) {  
             &Failure($client, \$res, $userinput);  
         } else {  
             &Reply($client, \$res, $userinput);  
         }  
     }  
   
     return 1;  
 }  
 &register_handler("getdom", \&get_domain_handler, 0, 1, 0);  
   
 sub encrypted_get_domain_handler {  
     my ($cmd, $tail, $client) = @_;  
   
     my $userinput = "$cmd:$tail";  
   
     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 {
         if ($cipher) {          &Reply($client, \$res, $userinput);
             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);  
   
 #  
 # 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;      return 1;
 }  }
 &register_handler("signlti", \&sign_lti_handler, 1, 1, 0);  &register_handler("getdom", \&get_domain_handler, 0, 1, 0);
   
 #  #
 #  Puts an id to a domains id database.   #  Puts an id to a domains id database. 
Line 6521  sub get_institutional_selfcreate_rules { Line 6225  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 7934  sub validate_user { Line 7605  sub validate_user {
                      ($domdefaults{'auth_arg_def'} ne '')) {                       ($domdefaults{'auth_arg_def'} ne '')) {
                 #                  #
                 # Don't attempt authentication for username and password supplied                  # Don't attempt authentication for username and password supplied
                 # for user without an account if username contains @ to avoid                  # for user without an account if uername contains @ to avoid
                 # call to &Authen::Krb5::parse_name() which will result in con_lost                  # call to &Authen::Krb5::parse_name() which will result in con_lost
                 #                  #
                 unless ($user =~ /\@/) {                  unless ($user =~ /\@/) {
Line 8284  sub currentversion { Line 7955  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.489.2.43.2.10  
changed lines
  Added in v.1.489.2.44

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