[BACK]Return to lonnet.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom / lonnet / perl

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.1473 and 1.1483

version 1.1473, 2021/11/30 15:55:40 version 1.1483, 2022/02/17 22:35:52
Line 2262  sub del_dom { Line 2262  sub del_dom {
     }      }
 }  }
   
   sub store_dom {
       my ($storehash,$id,$namespace,$dom,$home,$encrypt) = @_;
       $$storehash{'ip'}=&get_requestor_ip();
       $$storehash{'host'}=$perlvar{'lonHostID'};
       my $namevalue='';
       foreach my $key (keys(%{$storehash})) {
           $namevalue.=&escape($key).'='.&freeze_escape($$storehash{$key}).'&';
       }
       $namevalue=~s/\&$//;
       if (grep { $_ eq $home } current_machine_ids()) {
           return LONCAPA::Lond::store_dom("storedom:$dom:$namespace:$id:$namevalue");
       } else {
           if ($namespace eq 'private') {
               return 'refused';
           } elsif ($encrypt) {
               return reply("encrypt:storedom:$dom:$namespace:$id:$namevalue",$home);
           } else {
               return reply("storedom:$dom:$namespace:$id:$namevalue",$home);
           }
       }
   }
   
   sub restore_dom {
       my ($id,$namespace,$dom,$home,$encrypt) = @_;
       my $answer;
       if (grep { $_ eq $home } current_machine_ids()) {
           $answer = LONCAPA::Lond::restore_dom("restoredom:$dom:$namespace:$id");
       } elsif ($namespace ne 'private') {
           if ($encrypt) {
               $answer=&reply("encrypt:restoredom:$dom:$namespace:$id",$home);
           } else {
               $answer=&reply("restoredom:$dom:$namespace:$id",$home);
           }
       }
       my %returnhash=();
       unless (($answer eq '') || ($answer eq 'con_lost') || ($answer eq 'refused') || 
               ($answer eq 'unknown_cmd') || ($answer eq 'rejected')) {
           foreach my $line (split(/\&/,$answer)) {
               my ($name,$value)=split(/\=/,$line);
               $returnhash{&unescape($name)}=&thaw_unescape($value);
           }
           my $version;
           for ($version=1;$version<=$returnhash{'version'};$version++) {
               foreach my $item (split(/\:/,$returnhash{$version.':keys'})) {
                   $returnhash{$item}=$returnhash{$version.':'.$item};
               }
           }
       }
       return %returnhash;
   }
   
 # ----------------------------------construct domainconfig user for a domain   # ----------------------------------construct domainconfig user for a domain 
 sub get_domainconfiguser {  sub get_domainconfiguser {
     my ($udom) = @_;      my ($udom) = @_;
Line 2617  sub get_domain_defaults { Line 2668  sub get_domain_defaults {
                                   'coursedefaults','usersessions',                                    'coursedefaults','usersessions',
                                   'requestauthor','selfenrollment',                                    'requestauthor','selfenrollment',
                                   'coursecategories','ssl','autoenroll',                                    'coursecategories','ssl','autoenroll',
                                   'trust','helpsettings','wafproxy'],$domain);                                    'trust','helpsettings','wafproxy','ltisec'],$domain);
     my @coursetypes = ('official','unofficial','community','textbook','placement');      my @coursetypes = ('official','unofficial','community','textbook','placement');
     if (ref($domconfig{'defaults'}) eq 'HASH') {      if (ref($domconfig{'defaults'}) eq 'HASH') {
         $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};           $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; 
Line 2666  sub get_domain_defaults { Line 2717  sub get_domain_defaults {
     if (ref($domconfig{'coursedefaults'}) eq 'HASH') {      if (ref($domconfig{'coursedefaults'}) eq 'HASH') {
         $domdefaults{'canuse_pdfforms'} = $domconfig{'coursedefaults'}{'canuse_pdfforms'};          $domdefaults{'canuse_pdfforms'} = $domconfig{'coursedefaults'}{'canuse_pdfforms'};
         $domdefaults{'usejsme'} = $domconfig{'coursedefaults'}{'usejsme'};          $domdefaults{'usejsme'} = $domconfig{'coursedefaults'}{'usejsme'};
           $domdefaults{'inline_chem'} = $domconfig{'coursedefaults'}{'inline_chem'};
         $domdefaults{'uselcmath'} = $domconfig{'coursedefaults'}{'uselcmath'};          $domdefaults{'uselcmath'} = $domconfig{'coursedefaults'}{'uselcmath'};
         if (ref($domconfig{'coursedefaults'}{'postsubmit'}) eq 'HASH') {          if (ref($domconfig{'coursedefaults'}{'postsubmit'}) eq 'HASH') {
             $domdefaults{'postsubmit'} = $domconfig{'coursedefaults'}{'postsubmit'}{'client'};              $domdefaults{'postsubmit'} = $domconfig{'coursedefaults'}{'postsubmit'}{'client'};
Line 2698  sub get_domain_defaults { Line 2750  sub get_domain_defaults {
         }          }
         if ($domconfig{'coursedefaults'}{'texengine'}) {          if ($domconfig{'coursedefaults'}{'texengine'}) {
             $domdefaults{'texengine'} = $domconfig{'coursedefaults'}{'texengine'};              $domdefaults{'texengine'} = $domconfig{'coursedefaults'}{'texengine'};
         }           }
           if (exists($domconfig{'coursedefaults'}{'ltiauth'})) {
               $domdefaults{'crsltiauth'} = $domconfig{'coursedefaults'}{'ltiauth'};
           }
     }      }
     if (ref($domconfig{'usersessions'}) eq 'HASH') {      if (ref($domconfig{'usersessions'}) eq 'HASH') {
         if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') {          if (ref($domconfig{'usersessions'}{'remote'}) eq 'HASH') {
Line 2773  sub get_domain_defaults { Line 2828  sub get_domain_defaults {
     }      }
     if (ref($domconfig{'autoenroll'}) eq 'HASH') {      if (ref($domconfig{'autoenroll'}) eq 'HASH') {
         $domdefaults{'autofailsafe'} = $domconfig{'autoenroll'}{'autofailsafe'};          $domdefaults{'autofailsafe'} = $domconfig{'autoenroll'}{'autofailsafe'};
           $domdefaults{'failsafe'} = $domconfig{'autoenroll'}{'failsafe'};
     }      }
     if (ref($domconfig{'helpsettings'}) eq 'HASH') {      if (ref($domconfig{'helpsettings'}) eq 'HASH') {
         $domdefaults{'submitbugs'} = $domconfig{'helpsettings'}{'submitbugs'};          $domdefaults{'submitbugs'} = $domconfig{'helpsettings'}{'submitbugs'};
Line 2786  sub get_domain_defaults { Line 2842  sub get_domain_defaults {
                 $domdefaults{'waf_'.$item} = $domconfig{'wafproxy'}{$item};                  $domdefaults{'waf_'.$item} = $domconfig{'wafproxy'}{$item};
             }              }
         }          }
     }       }
       if (ref($domconfig{'ltisec'}) eq 'HASH') {
           if (ref($domconfig{'ltisec'}{'encrypt'}) eq 'HASH') {
               $domdefaults{'linkprotenc_crs'} = $domconfig{'ltisec'}{'encrypt'}{'crs'};
               $domdefaults{'linkprotenc_dom'} = $domconfig{'ltisec'}{'encrypt'}{'dom'};
               $domdefaults{'ltienc_consumers'} = $domconfig{'ltisec'}{'encrypt'}{'consumers'};
           }
           if (ref($domconfig{'ltisec'}{'private'}) eq 'HASH') {
               if (ref($domconfig{'ltisec'}{'private'}{'keys'}) eq 'ARRAY') {
                   $domdefaults{'privhosts'} = $domconfig{'ltisec'}{'private'}{'keys'};
               }
           }
       }
     &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);      &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);
     return %domdefaults;      return %domdefaults;
 }  }
Line 4659  sub bubblesheet_converter { Line 4727  sub bubblesheet_converter {
                     next if (($num == 1) && ($csvoptions{'hdr'} == 1));                      next if (($num == 1) && ($csvoptions{'hdr'} == 1));
                     $line =~ s{[\r\n]+$}{};                      $line =~ s{[\r\n]+$}{};
                     my %found;                      my %found;
                     my @values = split(/,/,$line);                      my @values = split(/,/,$line,-1);
                     my ($qstart,$record);                      my ($qstart,$record);
                     for (my $i=0; $i<@values; $i++) {                      for (my $i=0; $i<@values; $i++) {
                         if ((($qstart ne '') && ($i > $qstart)) ||                          if ((($qstart ne '') && ($i > $qstart)) ||
Line 8153  sub allowed { Line 8221  sub allowed {
     $uri=&declutter($uri);      $uri=&declutter($uri);
   
     if ($priv eq 'evb') {      if ($priv eq 'evb') {
 # Evade communication block restrictions for specified role in a course  # Evade communication block restrictions for specified role in a course or domain
         if ($env{'user.priv.'.$role} =~/evb\&([^\:]*)/) {          if ($env{'user.priv.'.$role} =~/evb\&([^\:]*)/) {
             return $1;              return $1;
         } else {          } else {
Line 12213  sub resdata { Line 12281  sub resdata {
   
 sub get_domain_lti {  sub get_domain_lti {
     my ($cdom,$context) = @_;      my ($cdom,$context) = @_;
     my ($name,%lti);      my ($name,$cachename,%lti);
     if ($context eq 'consumer') {      if ($context eq 'consumer') {
         $name = 'ltitools';          $name = 'ltitools';
     } elsif ($context eq 'provider') {      } elsif ($context eq 'provider') {
         $name = 'lti';          $name = 'lti';
       } elsif ($context eq 'linkprot') {
           $name = 'ltisec';
     } else {      } else {
         return %lti;          return %lti;
     }      }
     my ($result,$cached)=&is_cached_new($name,$cdom);  
       if ($context eq 'linkprot') {
           $cachename = $context;
       } else {
           $cachename = $name;
       }
       
       my ($result,$cached)=&is_cached_new($cachename,$cdom);
     if (defined($cached)) {      if (defined($cached)) {
         if (ref($result) eq 'HASH') {          if (ref($result) eq 'HASH') {
             %lti = %{$result};              %lti = %{$result};
Line 12229  sub get_domain_lti { Line 12306  sub get_domain_lti {
     } else {      } else {
         my %domconfig = &get_dom('configuration',[$name],$cdom);          my %domconfig = &get_dom('configuration',[$name],$cdom);
         if (ref($domconfig{$name}) eq 'HASH') {          if (ref($domconfig{$name}) eq 'HASH') {
             %lti = %{$domconfig{$name}};              if ($context eq 'linkprot') {
             my %encdomconfig = &get_dom('encconfig',[$name],$cdom,undef,1);                  if (ref($domconfig{$name}{'linkprot'}) eq 'HASH') {
             if (ref($encdomconfig{$name}) eq 'HASH') {                      %lti = %{$domconfig{$name}{'linkprot'}};
                 foreach my $id (keys(%lti)) {                  }
                     if (ref($encdomconfig{$name}{$id}) eq 'HASH') {              } else {
                         foreach my $item ('key','secret') {                  %lti = %{$domconfig{$name}};
                             $lti{$id}{$item} = $encdomconfig{$name}{$id}{$item};              }
               if (($context eq 'consumer') && (keys(%lti))) {
                   my %encdomconfig = &get_dom('encconfig',[$name],$cdom,undef,1);
                   if (ref($encdomconfig{$name}) eq 'HASH') {
                       foreach my $id (keys(%lti)) {
                           if (ref($encdomconfig{$name}{$id}) eq 'HASH') {
                               foreach my $item ('key','secret') {
                                   $lti{$id}{$item} = $encdomconfig{$name}{$id}{$item};
                               }
                         }                          }
                     }                      }
                 }                  }
             }              }
         }          }
         my $cachetime = 24*60*60;          my $cachetime = 24*60*60;
         &do_cache_new($name,$cdom,\%lti,$cachetime);          &do_cache_new($cachename,$cdom,\%lti,$cachetime);
     }      }
     return %lti;      return %lti;
 }  }
Line 12264  sub get_course_lti { Line 12349  sub get_course_lti {
     return %courselti;      return %courselti;
 }  }
   
   sub courselti_itemid {
       my ($cnum,$cdom,$url,$method,$params,$context) = @_;
       my ($chome,$itemid);
       $chome = &homeserver($cnum,$cdom);
       return if ($chome eq 'no_host');
       if (ref($params) eq 'HASH') {
           my $items = &freeze_escape($params);
           my $rep;
           if (grep { $_ eq $chome } current_machine_ids()) {
               $rep = LONCAPA::Lond::crslti_itemid($cdom,$cnum,$url,$method,$params,$perlvar{'lonVersion'});
           } else {
               my $escurl = &escape($url);
               my $escmethod = &escape($method);
               my $items = &freeze_escape($params);
               $rep = &reply("encrypt:lti:$cdom:$cnum:$context:$escurl:$escmethod:$items",$chome);
           }
           unless (($rep=~/^(refused|rejected|error)/) || ($rep eq 'con_lost') ||
                   ($rep eq 'unknown_cmd')) {
               $itemid = $rep;
           }
       }
       return $itemid;
   }
   
   sub domainlti_itemid {
       my ($cdom,$url,$method,$params,$context) = @_;
       my ($primary_id,$itemid);
       $primary_id = &domain($cdom,'primary');
       return if ($primary_id eq '');
       if (ref($params) eq 'HASH') {
           my $items = &freeze_escape($params);
           my $rep;
           if (grep { $_ eq $primary_id } current_machine_ids()) {
               $rep = LONCAPA::Lond::domlti_itemid($cdom,$context,$url,$method,$params,$perlvar{'lonVersion'});
           } else {
               my $cnum = '';
               my $escurl = &escape($url);
               my $escmethod = &escape($method);
               my $items = &freeze_escape($params);
               $rep = &reply("encrypt:lti:$cdom:$cnum:$context:$escurl:$escmethod:$items",$primary_id);
           }
           unless (($rep=~/^(refused|rejected|error)/) || ($rep eq 'con_lost') ||
                   ($rep eq 'unknown_cmd')) {
               $itemid = $rep;
           }
       }
       return $itemid;
   }
   
 sub get_numsuppfiles {  sub get_numsuppfiles {
     my ($cnum,$cdom,$ignorecache)=@_;      my ($cnum,$cdom,$ignorecache)=@_;
     my $hashid=$cnum.':'.$cdom;      my $hashid=$cnum.':'.$cdom;
Line 14656  sub use_proxy_alias { Line 14790  sub use_proxy_alias {
     return;      return;
 }  }
   
 sub alias_shibboleth {  sub alias_sso {
     my ($lonid) = @_;      my ($lonid) = @_;
     if ($lonid eq '') {      if ($lonid eq '') {
         $lonid = $perlvar{'lonHostID'};          $lonid = $perlvar{'lonHostID'};
Removed from v.1.1473  
changed lines
  Added in v.1.1483

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