[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.1172.2.93.4.10 and 1.1172.2.104

version 1.1172.2.93.4.10, 2018/04/29 00:56:53 version 1.1172.2.104, 2019/02/15 21:34:43
Line 75  use LWP::UserAgent(); Line 75  use LWP::UserAgent();
 use HTTP::Date;  use HTTP::Date;
 use Image::Magick;  use Image::Magick;
   
 use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir  use vars qw(%perlvar %spareid %pr %prp $memcache %packagetab $tmpdir $deftex
             $_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease              $_64bit %env %protocol %loncaparevs %serverhomeIDs %needsrelease
             %managerstab);              %managerstab);
   
Line 695  sub appenv { Line 695  sub appenv {
                 $env{$key}=$newenv->{$key};                  $env{$key}=$newenv->{$key};
             }              }
         }          }
         my $opened = open(my $env_file,'+<',$env{'user.environment'});          my $lonids = $perlvar{'lonIDsDir'};
         if ($opened          if ($env{'user.environment'} =~ m{^\Q$lonids/\E$match_username\_\d+\_$match_domain\_[\w\-.]+\.id$}) {
     && &timed_flock($env_file,LOCK_EX)              my $opened = open(my $env_file,'+<',$env{'user.environment'});
     &&              if ($opened
     tie(my %disk_env,'GDBM_File',$env{'user.environment'},          && &timed_flock($env_file,LOCK_EX)
         (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {          &&
     while (my ($key,$value) = each(%{$newenv})) {          tie(my %disk_env,'GDBM_File',$env{'user.environment'},
         $disk_env{$key} = $value;              (&GDBM_WRITER()|&GDBM_NOLOCK()),0640)) {
     }          while (my ($key,$value) = each(%{$newenv})) {
     untie(%disk_env);              $disk_env{$key} = $value;
           }
           untie(%disk_env);
               }
         }          }
     }      }
     return 'ok';      return 'ok';
Line 1697  sub get_dom { Line 1700  sub get_dom {
         }          }
     }      }
     if ($udom && $uhome && ($uhome ne 'no_host')) {      if ($udom && $uhome && ($uhome ne 'no_host')) {
         my $rep;          my $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
         if ($namespace =~ /^enc/) {  
             $rep=&reply("encrypt:egetdom:$udom:$namespace:$items",$uhome);  
         } else {  
             $rep=&reply("getdom:$udom:$namespace:$items",$uhome);  
         }  
         my %returnhash;          my %returnhash;
         if ($rep eq '' || $rep =~ /^error: 2 /) {          if ($rep eq '' || $rep =~ /^error: 2 /) {
             return %returnhash;              return %returnhash;
Line 1746  sub put_dom { Line 1744  sub put_dom {
             $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';              $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
         }          }
         $items=~s/\&$//;          $items=~s/\&$//;
         if ($namespace =~ /^enc/) {          return &reply("putdom:$udom:$namespace:$items",$uhome);
             return &reply("encrypt:putdom:$udom:$namespace:$items",$uhome);  
         } else {  
             return &reply("putdom:$udom:$namespace:$items",$uhome);  
         }  
     } else {      } else {
         &logthis("put_dom failed - no homeserver and/or domain");          &logthis("put_dom failed - no homeserver and/or domain");
     }      }
Line 1841  sub inst_directory_query { Line 1835  sub inst_directory_query {
     my $homeserver = &domain($udom,'primary');      my $homeserver = &domain($udom,'primary');
     my $outcome;      my $outcome;
     if ($homeserver ne '') {      if ($homeserver ne '') {
         unless ($homeserver eq $perlvar{'lonHostID'}) {  
             if ($srch->{'srchby'} eq 'email') {  
                 my $lcrev = &get_server_loncaparev(undef,$homeserver);  
                 my ($major,$minor,$subver) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.([\w.\-]+)\'?$/);  
                 if (($major eq '' && $minor eq '') || ($major < 2) ||  
                     (($major == 2) && ($minor < 11)) ||   
                     (($major == 2) && ($minor == 11) && ($subver !~ /^2\.B/))) {  
                     return;  
                 }  
             }  
         }  
  my $queryid=&reply("querysend:instdirsearch:".   my $queryid=&reply("querysend:instdirsearch:".
    &escape($srch->{'srchby'}).':'.     &escape($srch->{'srchby'}).':'.
    &escape($srch->{'srchterm'}).':'.     &escape($srch->{'srchterm'}).':'.
Line 1893  sub usersearch { Line 1876  sub usersearch {
     my $query = 'usersearch';      my $query = 'usersearch';
     foreach my $tryserver (keys(%libserv)) {      foreach my $tryserver (keys(%libserv)) {
         if (&host_domain($tryserver) eq $dom) {          if (&host_domain($tryserver) eq $dom) {
             unless ($tryserver eq $perlvar{'lonHostID'}) {  
                 if ($srch->{'srchby'} eq 'email') {  
                     my $lcrev = &get_server_loncaparev(undef,$tryserver);  
                     my ($major,$minor,$subver) = ($lcrev =~ /^\'?(\d+)\.(\d+)\.([\w.\-]+)\'?$/);  
                     next if (($major eq '' && $minor eq '') || ($major < 2) ||  
                              (($major == 2) && ($minor < 11)) ||   
                              (($major == 2) && ($minor == 11) && ($subver !~ /^2\.B/)));  
                 }  
             }  
             my $host=&hostname($tryserver);              my $host=&hostname($tryserver);
             my $queryid=              my $queryid=
                 &reply("querysend:".&escape($query).':'.                  &reply("querysend:".&escape($query).':'.
Line 2219  sub get_domain_defaults { Line 2193  sub get_domain_defaults {
         } elsif ($domconfig{'coursedefaults'}{'canclone'}) {          } elsif ($domconfig{'coursedefaults'}{'canclone'}) {
             $domdefaults{'canclone'}=$domconfig{'coursedefaults'}{'canclone'};              $domdefaults{'canclone'}=$domconfig{'coursedefaults'}{'canclone'};
         }          }
           if ($domconfig{'coursedefaults'}{'texengine'}) {
               $domdefaults{'texengine'} = $domconfig{'coursedefaults'}{'texengine'};
           }
     }      }
     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 2282  sub get_domain_defaults { Line 2259  sub get_domain_defaults {
     return %domdefaults;      return %domdefaults;
 }  }
   
 sub course_portal_url {  
     my ($cnum,$cdom) = @_;  
     my $chome = &homeserver($cnum,$cdom);  
     my $hostname = &hostname($chome);  
     my $protocol = $protocol{$chome};  
     $protocol = 'http' if ($protocol ne 'https');  
     my %domdefaults = &get_domain_defaults($cdom);  
     my $firsturl;  
     if ($domdefaults{'portal_def'}) {  
         $firsturl = $domdefaults{'portal_def'};  
     } else {  
         $firsturl = $protocol.'://'.$hostname;  
     }  
     return $firsturl;  
 }  
   
 # --------------------------------------------------- Assign a key to a student  # --------------------------------------------------- Assign a key to a student
   
 sub assign_access_key {  sub assign_access_key {
Line 2882  sub absolute_url { Line 2843  sub absolute_url {
 sub ssi {  sub ssi {
   
     my ($fn,%form)=@_;      my ($fn,%form)=@_;
     my $ua=new LWP::UserAgent;      my ($request,$response);
     my $request;  
   
     $form{'no_update_last_known'}=1;      $form{'no_update_last_known'}=1;
     &Apache::lonenc::check_encrypt(\$fn);      &Apache::lonenc::check_encrypt(\$fn);
Line 2900  sub ssi { Line 2860  sub ssi {
     }      }
   
     $request->header(Cookie => $ENV{'HTTP_COOKIE'});      $request->header(Cookie => $ENV{'HTTP_COOKIE'});
     my $response= $ua->request($request);  
       if (($env{'request.course.id'}) &&
           ($form{'grade_courseid'} eq $env{'request.course.id'}) &&
           ($form{'grade_username'} ne '') && ($form{'grade_domain'} ne '') &&
           ($form{'grade_symb'} ne '') &&
           (&Apache::lonnet::allowed('mgr',$env{'request.course.id'}.
                                    ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) {
           if (LWP::UserAgent->VERSION >= 5.834) {
               my $ua=new LWP::UserAgent;
               $ua->local_address('127.0.0.1');
               $response = $ua->request($request);
           } else {
               {
                   require LWP::Protocol::http;
                   local @LWP::Protocol::http::EXTRA_SOCK_OPTS = (LocalAddr => '127.0.0.1');
                   my $ua=new LWP::UserAgent;
                   $response = $ua->request($request);
                   @LWP::Protocol::http::EXTRA_SOCK_OPTS = ();
               }
           }
       } else {
           my $ua=new LWP::UserAgent;
           $response = $ua->request($request);
       }
     if (wantarray) {      if (wantarray) {
  return ($response->content, $response);   return ($response->content, $response);
     } else {      } else {
Line 2920  sub externalssi { Line 2903  sub externalssi {
     }      }
 }  }
   
   # If the local copy of a replicated resource is outdated, trigger a
   # connection from the homeserver to flush the delayed queue. If no update
   # happens, remove local copies of outdated resource (and corresponding
   # metadata file).
   
   sub remove_stale_resfile {
       my ($url) = @_;
       my $removed;
       if ($url=~m{^/res/($match_domain)/($match_username)/}) {
           my $audom = $1;
           my $auname = $2;
           unless (($url =~ /\.\d+\.\w+$/) || ($url =~ m{^/res/lib/templates/})) {
               my $homeserver = &homeserver($auname,$audom);
               unless (($homeserver eq 'no_host') ||
                       (grep { $_ eq $homeserver } &current_machine_ids())) {
                   my $fname = &filelocation('',$url);
                   if (-e $fname) {
                       my $ua=new LWP::UserAgent;
                       $ua->timeout(5);
                       my $protocol = $protocol{$homeserver};
                       $protocol = 'http' if ($protocol ne 'https');
                       my $hostname = &hostname($homeserver);
                       if ($hostname) {
                           my $uri = $protocol.'://'.$hostname.'/raw/'.&declutter($url);
                           my $request=new HTTP::Request('HEAD',$uri);
                           my $response=$ua->request($request);
                           if ($response->is_success()) {
                               my $remmodtime = &HTTP::Date::str2time( $response->header('Last-modified') );
                               my $locmodtime = (stat($fname))[9];
                               if ($locmodtime < $remmodtime) {
                                   my $stale;
                                   my $answer = &reply('pong',$homeserver);
                                   if ($answer eq $homeserver.':'.$perlvar{'lonHostID'}) {
                                       sleep(0.2);
                                       $locmodtime = (stat($fname))[9];
                                       if ($locmodtime < $remmodtime) {
                                           my $posstransfer = $fname.'.in.transfer';
                                           if ((-e $posstransfer) && ($remmodtime < (stat($posstransfer))[9])) {
                                               $removed = 1;
                                           } else {
                                               $stale = 1;
                                           }
                                       } else {
                                           $removed = 1;
                                       }
                                   } else {
                                       $stale = 1;
                                   }
                                   if ($stale) {
                                       unlink($fname);
                                       if ($uri!~/\.meta$/) {
                                           unlink($fname.'.meta');
                                       }
                                       &reply("unsub:$fname",$homeserver);
                                       $removed = 1;
                                   }
                               }
                           }
                       }
                   }
               }
           }
       }
       return $removed;
   }
   
 # -------------------------------- Allow a /uploaded/ URI to be vouched for  # -------------------------------- Allow a /uploaded/ URI to be vouched for
   
 sub allowuploaded {  sub allowuploaded {
Line 3058  sub can_edit_resource { Line 3107  sub can_edit_resource {
                         $forceedit = 1;                          $forceedit = 1;
                     }                      }
                     $cfile = $resurl;                      $cfile = $resurl;
                 } elsif ($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) {  
                     $incourse = 1;  
                     if ($env{'form.forceedit'}) {  
                         $forceview = 1;  
                     } else {  
                         $forceedit = 1;  
                     }  
                     $cfile = $resurl;  
                 } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {                  } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
                     $incourse = 1;                      $incourse = 1;
                     if ($env{'form.forceedit'}) {                      if ($env{'form.forceedit'}) {
Line 3090  sub can_edit_resource { Line 3131  sub can_edit_resource {
                         $forceedit = 1;                          $forceedit = 1;
                     }                      }
                     $cfile = $resurl;                      $cfile = $resurl;
             } elsif (($resurl =~ m{^/adm/wrapper/adm/$cdom/$cnum/\d+/ext\.tool$}) && ($env{'form.folderpath'} =~ /^supplemental/)) {  
                 $incourse = 1;  
                 if ($env{'form.forceedit'}) {  
                     $forceview = 1;  
                 } else {  
                     $forceedit = 1;  
                 }  
                 $cfile = $resurl;  
             } elsif (($resurl eq '/adm/extresedit') && ($symb || $env{'form.folderpath'})) {              } elsif (($resurl eq '/adm/extresedit') && ($symb || $env{'form.folderpath'})) {
                 $incourse = 1;                  $incourse = 1;
                 $forceview = 1;                  $forceview = 1;
Line 3107  sub can_edit_resource { Line 3140  sub can_edit_resource {
                     $cfile = &clutter($res);                      $cfile = &clutter($res);
                 } else {                  } else {
                     $cfile = $env{'form.suppurl'};                      $cfile = $env{'form.suppurl'};
                     my $escfile = &unescape($cfile);                      $cfile =~ s{^http://}{};
                     if ($escfile =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {                      $cfile = '/adm/wrapper/ext/'.$cfile;
                         $cfile = '/adm/wrapper'.$escfile;  
                     } else {  
                         $escfile =~ s{^http://}{};  
                         $cfile = &escape("/adm/wrapper/ext/$escfile");  
                     }  
                 }                  }
             } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {              } elsif ($resurl =~ m{^/?adm/viewclasslist$}) {
                 if ($env{'form.forceedit'}) {                  if ($env{'form.forceedit'}) {
Line 3448  sub userfileupload { Line 3476  sub userfileupload {
             } else {              } else {
                 $docudom = $env{'user.domain'};                  $docudom = $env{'user.domain'};
             }              }
             if ($destuname =~ /^$match_username$/) {              if ($destuname =~ /^$match_username$/) { 
                 $docuname = $destuname;                  $docuname = $destuname;
             } else {              } else {
                 $docuname = $env{'user.name'};                  $docuname = $env{'user.name'};
Line 4828  my %cachedtimes=(); Line 4856  my %cachedtimes=();
 my $cachedtime='';  my $cachedtime='';
   
 sub load_all_first_access {  sub load_all_first_access {
     my ($uname,$udom,$ignorecache)=@_;      my ($uname,$udom)=@_;
     if (($cachedkey eq $uname.':'.$udom) &&      if (($cachedkey eq $uname.':'.$udom) &&
         (abs($cachedtime-time)<5) && (!$env{'form.markaccess'}) &&          (abs($cachedtime-time)<5) && (!$env{'form.markaccess'})) {
         (!$ignorecache)) {  
         return;          return;
     }      }
     $cachedtime=time;      $cachedtime=time;
Line 4840  sub load_all_first_access { Line 4867  sub load_all_first_access {
 }  }
   
 sub get_first_access {  sub get_first_access {
     my ($type,$argsymb,$argmap,$ignorecache)=@_;      my ($type,$argsymb,$argmap)=@_;
     my ($symb,$courseid,$udom,$uname)=&whichuser();      my ($symb,$courseid,$udom,$uname)=&whichuser();
     if ($argsymb) { $symb=$argsymb; }      if ($argsymb) { $symb=$argsymb; }
     my ($map,$id,$res)=&decode_symb($symb);      my ($map,$id,$res)=&decode_symb($symb);
Line 4852  sub get_first_access { Line 4879  sub get_first_access {
     } else {      } else {
  $res=$symb;   $res=$symb;
     }      }
     &load_all_first_access($uname,$udom,$ignorecache);      &load_all_first_access($uname,$udom);
     return $cachedtimes{"$courseid\0$res"};      return $cachedtimes{"$courseid\0$res"};
 }  }
   
Line 4869  sub set_first_access { Line 4896  sub set_first_access {
     }      }
     $cachedkey='';      $cachedkey='';
     my $firstaccess=&get_first_access($type,$symb,$map);      my $firstaccess=&get_first_access($type,$symb,$map);
     if (!$firstaccess) {      if ($firstaccess) {
           &logthis("First access time already set ($firstaccess) when attempting ".
                    "to set new value (type: $type, extent: $res) for $uname:$udom ".
                    "in $courseid");
           return 'already_set';
       } else {
         my $start = time;          my $start = time;
  my $putres = &put('firstaccesstimes',{"$courseid\0$res"=>$start},   my $putres = &put('firstaccesstimes',{"$courseid\0$res"=>$start},
                           $udom,$uname);                            $udom,$uname);
Line 4882  sub set_first_access { Line 4914  sub set_first_access {
                         'course.'.$courseid.'.timerinterval.'.$res => $interval,                          'course.'.$courseid.'.timerinterval.'.$res => $interval,
                      }                       }
                   );                    );
               if (($cachedtime) && (abs($start-$cachedtime) < 5)) {
                   $cachedtimes{"$courseid\0$res"} = $start;
               }
           } elsif ($putres ne 'refused') {
               &logthis("Result: $putres when attempting to set first access time ".
                        "(type: $type, extent: $res) for $uname:$udom in $courseid");
         }          }
         return $putres;          return $putres;
     }      }
Line 6258  sub currentdump { Line 6296  sub currentdump {
    #     #
    my %returnhash=();     my %returnhash=();
    #     #
    if ($rep eq 'unknown_cmd') {      if ($rep eq "unknown_cmd") { 
        # an old lond will not know currentdump         # an old lond will not know currentdump
        # Do a dump and make it look like a currentdump         # Do a dump and make it look like a currentdump
        my @tmp = &dumpstore($courseid,$sdom,$sname,'.');         my @tmp = &dumpstore($courseid,$sdom,$sname,'.');
Line 7191  sub allowed { Line 7229  sub allowed {
   
     if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; }      if (defined($env{'allowed.'.$priv})) { return $env{'allowed.'.$priv}; }
 # Free bre access to adm and meta resources  # Free bre access to adm and meta resources
     if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|ext\.tool)$}))       if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard)$})) 
  || (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) ))    || (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) )) 
  && ($priv eq 'bre')) {   && ($priv eq 'bre')) {
  return 'F';   return 'F';
Line 7852  sub get_commblock_resources { Line 7890  sub get_commblock_resources {
                             }                              }
                         }                          }
                     }                      }
                     if ($interval[0] =~ /^(\d+)/) {                      if ($interval[0] =~ /^\d+$/) {
                         my $timelimit = $1;  
                         my $first_access;                          my $first_access;
                         if ($type eq 'resource') {                          if ($type eq 'resource') {
                             $first_access=&get_first_access($interval[1],$item);                              $first_access=&get_first_access($interval[1],$item);
Line 7863  sub get_commblock_resources { Line 7900  sub get_commblock_resources {
                             $first_access=&get_first_access($interval[1]);                              $first_access=&get_first_access($interval[1]);
                         }                          }
                         if ($first_access) {                          if ($first_access) {
                             my $timesup = $first_access+$timelimit;                              my $timesup = $first_access+$interval[0];
                             if ($timesup > $now) {                              if ($timesup > $now) {
                                 my $activeblock;                                  my $activeblock;
                                 foreach my $res (@to_test) {                                  foreach my $res (@to_test) {
Line 9730  sub generate_coursenum { Line 9767  sub generate_coursenum {
 sub is_course {  sub is_course {
     my ($cdom, $cnum) = scalar(@_) == 1 ?       my ($cdom, $cnum) = scalar(@_) == 1 ? 
          ($_[0] =~ /^($match_domain)_($match_courseid)$/)  :  @_;           ($_[0] =~ /^($match_domain)_($match_courseid)$/)  :  @_;
       return unless (($cdom =~ /^$match_domain$/) && ($cnum =~ /^$match_courseid$/));
     return unless $cdom and $cnum;      my $uhome=&homeserver($cnum,$cdom);
       my $iscourse;
     my %courses = &courseiddump($cdom, '.', 1, '.', '.', $cnum, undef, undef,      if (grep { $_ eq $uhome } current_machine_ids()) {
         '.');          $iscourse = &LONCAPA::Lond::is_course($cdom,$cnum);
       } else {
     return unless(exists($courses{$cdom.'_'.$cnum}));          my $hashid = $cdom.':'.$cnum;
           ($iscourse,my $cached) = &is_cached_new('iscourse',$hashid);
           unless (defined($cached)) {
               my %courses = &courseiddump($cdom, '.', 1, '.', '.',
                                           $cnum,undef,undef,'.');
               $iscourse = 0;
               if (exists($courses{$cdom.'_'.$cnum})) {
                   $iscourse = 1;
               }
               &do_cache_new('iscourse',$hashid,$iscourse,3600);
           }
       }
       return unless($iscourse);
     return wantarray ? ($cdom, $cnum) : $cdom.'_'.$cnum;      return wantarray ? ($cdom, $cnum) : $cdom.'_'.$cnum;
 }  }
   
Line 9918  sub files_not_in_path { Line 9967  sub files_not_in_path {
     my $filename = $user."savedfiles";      my $filename = $user."savedfiles";
     my @return_files;      my @return_files;
     my $path_part;      my $path_part;
     open(IN,'<',LONCAPA::tempdir().$filename);      open(IN, '<',LONCAPA::tempdir().$filename);
     while (my $line = <IN>) {      while (my $line = <IN>) {
         #ok, I know it's clunky, but I want it to work          #ok, I know it's clunky, but I want it to work
         my @paths_and_file = split(m|/|, $line);          my @paths_and_file = split(m|/|, $line);
Line 10578  sub get_userresdata { Line 10627  sub get_userresdata {
 #  Parameters:  #  Parameters:
 #     $name      - Course/user name.  #     $name      - Course/user name.
 #     $domain    - Name of the domain the user/course is registered on.  #     $domain    - Name of the domain the user/course is registered on.
 #     $type      - Type of thing $name is (must be 'course' or 'user')  #     $type      - Type of thing $name is (must be 'course' or 'user'
 #     @which     - Array of names of resources desired.  #     @which     - Array of names of resources desired.
 #  Returns:  #  Returns:
 #     The value of the first reasource in @which that is found in the  #     The value of the first reasource in @which that is found in the
Line 10597  sub resdata { Line 10646  sub resdata {
     }      }
     if (!ref($result)) { return $result; }          if (!ref($result)) { return $result; }    
     foreach my $item (@which) {      foreach my $item (@which) {
         if (ref($item) eq 'ARRAY') {   if (defined($result->{$item->[0]})) {
     if (defined($result->{$item->[0]})) {      return [$result->{$item->[0]},$item->[1]];
         return [$result->{$item->[0]},$item->[1]];   }
     }  
         }  
     }      }
     return undef;      return undef;
 }  }
   
 sub get_domain_ltitools {  
     my ($cdom) = @_;  
     my %ltitools;  
     my ($result,$cached)=&is_cached_new('ltitools',$cdom);  
     if (defined($cached)) {  
         if (ref($result) eq 'HASH') {  
             %ltitools = %{$result};  
         }  
     } else {  
         my %domconfig = &get_dom('configuration',['ltitools'],$cdom);  
         if (ref($domconfig{'ltitools'}) eq 'HASH') {  
             %ltitools = %{$domconfig{'ltitools'}};  
             my %encdomconfig = &get_dom('encconfig',['ltitools'],$cdom);  
             if (ref($encdomconfig{'ltitools'}) eq 'HASH') {  
                 foreach my $id (keys(%ltitools)) {  
                     if (ref($encdomconfig{'ltitools'}{$id}) eq 'HASH') {  
                         foreach my $item ('key','secret') {  
                             $ltitools{$id}{$item} = $encdomconfig{'ltitools'}{$id}{$item};  
                         }  
                     }  
                 }  
             }  
         }  
         my $cachetime = 24*60*60;  
         &do_cache_new('ltitools',$cdom,\%ltitools,$cachetime);  
     }  
     return %ltitools;  
 }  
   
 sub get_numsuppfiles {  sub get_numsuppfiles {
     my ($cnum,$cdom,$ignorecache)=@_;      my ($cnum,$cdom,$ignorecache)=@_;
     my $hashid=$cnum.':'.$cdom;      my $hashid=$cnum.':'.$cdom;
Line 11090  sub metadata { Line 11108  sub metadata {
     # if it is a non metadata possible uri return quickly      # if it is a non metadata possible uri return quickly
     if (($uri eq '') ||       if (($uri eq '') || 
  (($uri =~ m|^/*adm/|) &&    (($uri =~ m|^/*adm/|) && 
      ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard|ext\.tool)$})) ||       ($uri !~ m|^adm/includes|) && ($uri !~ m{/(smppg|bulletinboard)$})) ||
         ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) {          ($uri =~ m|/$|) || ($uri =~ m|/.meta$|) || ($uri =~ m{^/*uploaded/.+\.sequence$})) {
  return undef;   return undef;
     }      }
Line 12684  sub clutter { Line 12702  sub clutter {
 # &logthis("Got a blank emb style");  # &logthis("Got a blank emb style");
     }      }
  }   }
     } elsif ($thisfn =~ m{^/adm/$match_domain/$match_courseid/\d+/ext\.tool$}) {  
         $thisfn='/adm/wrapper'.$thisfn;  
     }      }
     return $thisfn;      return $thisfn;
 }  }
Line 12759  sub get_dns { Line 12775  sub get_dns {
     }      }
   
     my %alldns;      my %alldns;
     open(my $config,"<","$perlvar{'lonTabDir'}/hosts.tab");      if (open(my $config,"<","$perlvar{'lonTabDir'}/hosts.tab")) {
     foreach my $dns (<$config>) {          foreach my $dns (<$config>) {
  next if ($dns !~ /^\^(\S*)/x);      next if ($dns !~ /^\^(\S*)/x);
         my $line = $1;              my $line = $1;
         my ($host,$protocol) = split(/:/,$line);              my ($host,$protocol) = split(/:/,$line);
         if ($protocol ne 'https') {              if ($protocol ne 'https') {
             $protocol = 'http';                  $protocol = 'http';
               }
       $alldns{$host} = $protocol;
         }          }
  $alldns{$host} = $protocol;          close($config);
     }      }
     while (%alldns) {      while (%alldns) {
  my ($dns) = sort { $b cmp $a } keys(%alldns);   my ($dns) = sort { $b cmp $a } keys(%alldns);
Line 13401  BEGIN { Line 13419  BEGIN {
   
 }  }
   
   # ------------- set default texengine (domain default overrides this)
   {
       $deftex = LONCAPA::texengine();
   }
   
 $memcache=new Cache::Memcached({'servers'           => ['127.0.0.1:11211'],  $memcache=new Cache::Memcached({'servers'           => ['127.0.0.1:11211'],
  'compress_threshold'=> 20_000,   'compress_threshold'=> 20_000,
          });           });
Removed from v.1.1172.2.93.4.10  
changed lines
  Added in v.1.1172.2.104

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