[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.146.2.20 and 1.1172.2.147

version 1.1172.2.146.2.20, 2024/03/29 17:58:49 version 1.1172.2.147, 2022/02/27 02:19:13
Line 127  our @EXPORT = qw(%env); Line 127  our @EXPORT = qw(%env);
  $logid ++;   $logid ++;
         my $now = time();          my $now = time();
  my $id=$now.'00000'.$$.'00000'.$logid;   my $id=$now.'00000'.$$.'00000'.$logid;
         my $ip = &get_requestor_ip();          my $ip = &get_requestor_ip();  
         my $logentry = {          my $logentry = {
                          $id => {                           $id => {
                                   'exe_uname' => $env{'user.name'},                                    'exe_uname' => $env{'user.name'},
Line 365  sub remote_devalidate_cache { Line 365  sub remote_devalidate_cache {
     return &reply('devalidatecache:'.&escape($cachestr),$lonhost);      return &reply('devalidatecache:'.&escape($cachestr),$lonhost);
 }  }
   
 sub sign_lti {  
     my ($cdom,$cnum,$crsdef,$type,$context,$url,$ltinum,$keynum,$paramsref,$inforef) = @_;  
     my $chome;  
     if (&domain($cdom) ne '') {  
         if ($crsdef) {  
             $chome = &homeserver($cnum,$cdom);  
         } else {  
             $chome = &domain($cdom,'primary');  
         }  
     }  
     if ($cdom && $chome && ($chome ne 'no_host')) {  
         if ((ref($paramsref) eq 'HASH') &&  
             (ref($inforef) eq 'HASH')) {  
             my $rep;  
             if (grep { $_ eq $chome } &current_machine_ids()) {  
                 # domain information is hosted on this machine  
                 $rep =  
                     &LONCAPA::Lond::sign_lti_payload($cdom,$cnum,$crsdef,$type,  
                                                      $context,$url,$ltinum,$keynum,  
                                                      $perlvar{'lonVersion'},  
                                                      $paramsref,$inforef);  
                 if (ref($rep) eq 'HASH') {  
                     return ('ok',$rep);  
                 }  
             } else {  
                 my ($escurl,$params,$info);  
                 $escurl = &escape($url);  
                 if (ref($paramsref) eq 'HASH') {  
                     $params = &freeze_escape($paramsref);  
                 }  
                 if (ref($inforef) eq 'HASH') {  
                     $info = &freeze_escape($inforef);  
                 }  
                 $rep=&reply("encrypt:signlti:$cdom:$cnum:$crsdef:$type:$context:$escurl:$ltinum:$keynum:$params:$info",$chome);  
             }  
             if (($rep eq '') || ($rep =~ /^con_lost|error|no_such_host|unknown_cmd/i)) {  
                 return ();  
             } elsif (($inforef->{'respfmt'} eq 'to_post_body') ||  
                      ($inforef->{'respfmt'} eq 'to_authorization_header')) {  
                 return ('ok',$rep);  
             } else {  
                 my %returnhash;  
                 foreach my $item (split(/\&/,$rep)) {  
                     my ($name,$value)=split(/\=/,$item);  
                     $returnhash{&unescape($name)}=&thaw_unescape($value);  
                 }  
                 return('ok',\%returnhash);  
             }  
         } else {  
             return ();  
         }  
     } else {  
         return ();  
         &logthis("sign_lti failed - no homeserver and/or domain ($cdom) ($chome)");  
     }  
 }  
   
 # -------------------------------------------------- Non-critical communication  # -------------------------------------------------- Non-critical communication
 sub subreply {  sub subreply {
     my ($cmd,$server)=@_;      my ($cmd,$server)=@_;
Line 475  sub reply { Line 418  sub reply {
             my $subcmd = $1;              my $subcmd = $1;
             if (($subcmd eq 'auth') || ($subcmd eq 'passwd') ||              if (($subcmd eq 'auth') || ($subcmd eq 'passwd') ||
                 ($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') ||                  ($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') ||
                 ($subcmd eq 'putdom') || ($subcmd eq 'autoexportgrades') ||                  ($subcmd eq 'putdom') || ($subcmd eq 'autoexportgrades')) {
                 ($subcmd eq 'put')) {  
                 (undef,undef,my @rest) = split(/:/,$cmd);                  (undef,undef,my @rest) = split(/:/,$cmd);
                 if (($subcmd eq 'auth') || ($subcmd eq 'putdom')) {                  if (($subcmd eq 'auth') || ($subcmd eq 'putdom')) {
                     splice(@rest,2,1,'Hidden');                      splice(@rest,2,1,'Hidden');
                 } elsif ($subcmd eq 'passwd') {                  } elsif ($subcmd eq 'passwd') {
                     splice(@rest,2,2,('Hidden','Hidden'));                      splice(@rest,2,2,('Hidden','Hidden'));
                 } elsif (($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') ||                  } elsif (($subcmd eq 'changeuserauth') || ($subcmd eq 'makeuser') ||
                          ($subcmd eq 'autoexportgrades') || ($subcmd eq 'put')) {                           ($subcmd eq 'autoexportgrades')) {
                     splice(@rest,3,1,'Hidden');                      splice(@rest,3,1,'Hidden');
                 }                  }
                 $logged = join(':',('encrypt:'.$subcmd,@rest));                  $logged = join(':',('encrypt:'.$subcmd,@rest));
Line 752  sub check_for_valid_session { Line 694  sub check_for_valid_session {
         if ($disk_env{'request.role'}) {          if ($disk_env{'request.role'}) {
             $userhashref->{'role'} = $disk_env{'request.role'};              $userhashref->{'role'} = $disk_env{'request.role'};
         }          }
         $userhashref->{'lti'} = $disk_env{'request.lti.login'};  
         if ($userhashref->{'lti'}) {  
             $userhashref->{'ltitarget'} = $disk_env{'request.lti.target'};  
             $userhashref->{'ltiuri'} = $disk_env{'request.lti.uri'};  
         }  
     }      }
     untie(%disk_env);      untie(%disk_env);
   
Line 1098  sub find_existing_session { Line 1035  sub find_existing_session {
     return;      return;
 }  }
   
 sub delusersession {  
     my ($lonid,$udom,$uname) = @_;  
     my $uprimary_id = &domain($udom,'primary');  
     my $uintdom = &internet_dom($uprimary_id);  
     my $intdom = &internet_dom($lonid);  
     my $serverhomedom = &host_domain($lonid);  
     if (($uintdom ne '') && ($uintdom eq $intdom)) {  
         return &reply(join(':','delusersession',  
                             map {&escape($_)} ($udom,$uname)),$lonid);  
     }  
     return;  
 }  
   
   
 # check if user's browser sent load balancer cookie and server still has session  # check if user's browser sent load balancer cookie and server still has session
 # and is not overloaded.  # and is not overloaded.
 sub check_for_balancer_cookie {  sub check_for_balancer_cookie {
Line 1386  sub authenticate { Line 1309  sub authenticate {
     return 'no_host';      return 'no_host';
 }  }
   
 sub can_switchserver {  
     my ($udom,$home) = @_;  
     my ($canswitch,@intdoms);  
     my $internet_names = &get_internet_names($home);  
     if (ref($internet_names) eq 'ARRAY') {  
         @intdoms = @{$internet_names};  
     }  
     my $uint_dom = &internet_dom(&domain($udom,'primary'));  
     if ($uint_dom ne '' && grep(/^\Q$uint_dom\E$/,@intdoms)) {  
         $canswitch = 1;  
     } else {  
          my $serverhomeID = &get_server_homeID(&hostname($home));  
          my $serverhomedom = &host_domain($serverhomeID);  
          my %defdomdefaults = &get_domain_defaults($serverhomedom);  
          my %udomdefaults = &get_domain_defaults($udom);  
          my $remoterev = &get_server_loncaparev('',$home);  
          $canswitch = &can_host_session($udom,$home,$remoterev,  
                                         $udomdefaults{'remotesessions'},  
                                         $defdomdefaults{'hostedsessions'});  
     }  
     return $canswitch;  
 }  
   
 sub can_host_session {  sub can_host_session {
     my ($udom,$lonhost,$remoterev,$remotesessions,$hostedsessions) = @_;      my ($udom,$lonhost,$remoterev,$remotesessions,$hostedsessions) = @_;
     my $canhost = 1;      my $canhost = 1;
Line 1982  sub dump_dom { Line 1882  sub dump_dom {
 # ------------------------------------------ get items from domain db files     # ------------------------------------------ get items from domain db files   
   
 sub get_dom {  sub get_dom {
     my ($namespace,$storearr,$udom,$uhome,$encrypt)=@_;      my ($namespace,$storearr,$udom,$uhome)=@_;
     return if ($udom eq 'public');      return if ($udom eq 'public');
     my $items='';      my $items='';
     foreach my $item (@$storearr) {      foreach my $item (@$storearr) {
Line 2009  sub get_dom { Line 1909  sub get_dom {
         if (grep { $_ eq $uhome } &current_machine_ids()) {          if (grep { $_ eq $uhome } &current_machine_ids()) {
             # domain information is hosted on this machine              # domain information is hosted on this machine
             $rep = &LONCAPA::Lond::get_dom("getdom:$udom:$namespace:$items");              $rep = &LONCAPA::Lond::get_dom("getdom:$udom:$namespace:$items");
         } else {          } else {        
             if ($encrypt) {              $rep=&reply("getdom:$udom:$namespace:$items",$uhome);
                 $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 /) {
Line 2038  sub get_dom { Line 1934  sub get_dom {
 # -------------------------------------------- put items in domain db files   # -------------------------------------------- put items in domain db files 
   
 sub put_dom {  sub put_dom {
     my ($namespace,$storehash,$udom,$uhome,$encrypt)=@_;      my ($namespace,$storehash,$udom,$uhome)=@_;
     if (!$udom) {      if (!$udom) {
         $udom=$env{'user.domain'};          $udom=$env{'user.domain'};
         if (defined(&domain($udom,'primary'))) {          if (defined(&domain($udom,'primary'))) {
Line 2059  sub put_dom { Line 1955  sub put_dom {
             $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';              $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
         }          }
         $items=~s/\&$//;          $items=~s/\&$//;
         if ($encrypt) {          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 2097  sub del_dom { Line 1989  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 2426  sub inst_rulecheck { Line 2267  sub inst_rulecheck {
                     $response=&unescape(&reply('instidrulecheck:'.&escape($udom).                      $response=&unescape(&reply('instidrulecheck:'.&escape($udom).
                                               ':'.&escape($id).':'.$rulestr,                                                ':'.&escape($id).':'.$rulestr,
                                               $homeserver));                                                $homeserver));
                 } elsif ($item eq 'unamemap') {  
                     $response=&unescape(&reply('instunamemapcheck:'.  
                                                &escape($udom).':'.&escape($uname).  
                                               ':'.$rulestr,$homeserver));  
                 } elsif ($item eq 'selfcreate') {                  } elsif ($item eq 'selfcreate') {
                     $response=&unescape(&reply('instselfcreatecheck:'.                      $response=&unescape(&reply('instselfcreatecheck:'.
                                                &escape($udom).':'.&escape($uname).                                                 &escape($udom).':'.&escape($uname).
                                               ':'.$rulestr,$homeserver));                                                ':'.$rulestr,$homeserver));
                   } elsif ($item eq 'unamemap') {
                       $response=&unescape(&reply('instunamemapcheck:'.
                                                  &escape($udom).':'.&escape($uname).
                                                 ':'.$rulestr,$homeserver));
                 }                  }
                 if ($response ne 'refused') {                  if ($response ne 'refused') {
                     my @pairs=split(/\&/,$response);                      my @pairs=split(/\&/,$response);
Line 2510  sub get_domain_defaults { Line 2351  sub get_domain_defaults {
          &Apache::lonnet::get_dom('configuration',['defaults','quotas',           &Apache::lonnet::get_dom('configuration',['defaults','quotas',
                                   'requestcourses','inststatus',                                    'requestcourses','inststatus',
                                   'coursedefaults','usersessions',                                    'coursedefaults','usersessions',
                                   'requestauthor','authordefaults',                                    'requestauthor','selfenrollment',
                                   'selfenrollment','coursecategories',                                    'coursecategories','autoenroll',
                                   'autoenroll','helpsettings',                                    'helpsettings','wafproxy'],$domain);
                                   'wafproxy','ltisec','toolsec',  
                                   'domexttool','exttool'],$domain);  
     my @coursetypes = ('official','unofficial','community','textbook');      my @coursetypes = ('official','unofficial','community','textbook');
     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 2523  sub get_domain_defaults { Line 2362  sub get_domain_defaults {
         $domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'};          $domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'};
         $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'};          $domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_def'};
         $domdefaults{'portal_def'} = $domconfig{'defaults'}{'portal_def'};          $domdefaults{'portal_def'} = $domconfig{'defaults'}{'portal_def'};
         $domdefaults{'portal_def_email'} = $domconfig{'defaults'}{'portal_def_email'};  
         $domdefaults{'portal_def_web'} = $domconfig{'defaults'}{'portal_def_web'};  
         $domdefaults{'intauth_cost'} = $domconfig{'defaults'}{'intauth_cost'};          $domdefaults{'intauth_cost'} = $domconfig{'defaults'}{'intauth_cost'};
         $domdefaults{'intauth_switch'} = $domconfig{'defaults'}{'intauth_switch'};          $domdefaults{'intauth_switch'} = $domconfig{'defaults'}{'intauth_switch'};
         $domdefaults{'intauth_check'} = $domconfig{'defaults'}{'intauth_check'};          $domdefaults{'intauth_check'} = $domconfig{'defaults'}{'intauth_check'};
Line 2555  sub get_domain_defaults { Line 2392  sub get_domain_defaults {
             $domdefaults{$item} = $domconfig{'requestcourses'}{$item};              $domdefaults{$item} = $domconfig{'requestcourses'}{$item};
         }          }
     }      }
     if (ref($domconfig{'authordefaults'}) eq 'HASH') {  
         foreach my $item ('nocodemirror','copyright','sourceavail','domcoordacc','editors') {  
             if ($item eq 'editors') {  
                 if (ref($domconfig{'authordefaults'}{'editors'}) eq 'ARRAY') {  
                     $domdefaults{$item} = join(',',@{$domconfig{'authordefaults'}{'editors'}});  
                 }  
             } else {  
                 $domdefaults{$item} = $domconfig{'authordefaults'}{$item};  
             }  
         }  
     }  
     if (ref($domconfig{'requestauthor'}) eq 'HASH') {      if (ref($domconfig{'requestauthor'}) eq 'HASH') {
         $domdefaults{'requestauthor'} = $domconfig{'requestauthor'};          $domdefaults{'requestauthor'} = $domconfig{'requestauthor'};
     }      }
Line 2590  sub get_domain_defaults { Line 2416  sub get_domain_defaults {
             if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') {              if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') {
                 $domdefaults{$type.'quota'} = $domconfig{'coursedefaults'}{'uploadquota'}{$type};                  $domdefaults{$type.'quota'} = $domconfig{'coursedefaults'}{'uploadquota'}{$type};
             }              }
             if (ref($domconfig{'coursedefaults'}{'coursequota'}) eq 'HASH') {  
                 $domdefaults{$type.'coursequota'} = $domconfig{'coursedefaults'}{'coursequota'}{$type};  
             }  
             if ($domdefaults{'postsubmit'} eq 'on') {              if ($domdefaults{'postsubmit'} eq 'on') {
                 if (ref($domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}) eq 'HASH') {                  if (ref($domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}) eq 'HASH') {
                     $domdefaults{$type.'postsubtimeout'} =                      $domdefaults{$type.'postsubtimeout'} =
                         $domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}{$type};                          $domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}{$type};
                 }                  }
             }              }
             if (ref($domconfig{'coursedefaults'}{'domexttool'}) eq 'HASH') {  
                 $domdefaults{$type.'domexttool'} = $domconfig{'coursedefaults'}{'domexttool'}{$type};  
             } else {  
                 $domdefaults{$type.'domexttool'} = 1;  
             }  
             if (ref($domconfig{'coursedefaults'}{'exttool'}) eq 'HASH') {  
                 $domdefaults{$type.'exttool'} = $domconfig{'coursedefaults'}{'exttool'}{$type};  
             } else {  
                 $domdefaults{$type.'exttool'} = 0;  
             }  
         }          }
         if (ref($domconfig{'coursedefaults'}{'canclone'}) eq 'HASH') {          if (ref($domconfig{'coursedefaults'}{'canclone'}) eq 'HASH') {
             if (ref($domconfig{'coursedefaults'}{'canclone'}{'instcode'}) eq 'ARRAY') {              if (ref($domconfig{'coursedefaults'}{'canclone'}{'instcode'}) eq 'ARRAY') {
Line 2623  sub get_domain_defaults { Line 2436  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 2696  sub get_domain_defaults { Line 2506  sub get_domain_defaults {
             }              }
         }          }
     }      }
     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{'ltiprivhosts'} = $domconfig{'ltisec'}{'private'}{'keys'};  
             }  
         }  
         if (ref($domconfig{'ltisec'}{'suggested'}) eq 'HASH') {  
             my %suggestions = %{$domconfig{'ltisec'}{'suggested'}};  
             foreach my $item (keys(%{$domconfig{'ltisec'}{'suggested'}})) {  
                 unless (ref($domconfig{'ltisec'}{'suggested'}{$item}) eq 'HASH') {  
                     delete($suggestions{$item});  
                 }  
             }  
             if (keys(%suggestions)) {  
                 $domdefaults{'linkprotsuggested'} = \%suggestions;  
             }  
         }  
     }  
     if (ref($domconfig{'toolsec'}) eq 'HASH') {  
         if (ref($domconfig{'toolsec'}{'encrypt'}) eq 'HASH') {  
             $domdefaults{'toolenc_crs'} = $domconfig{'toolsec'}{'encrypt'}{'crs'};  
             $domdefaults{'toolenc_dom'} = $domconfig{'toolsec'}{'encrypt'}{'dom'};  
         }  
         if (ref($domconfig{'toolsec'}{'private'}) eq 'HASH') {  
             if (ref($domconfig{'toolsec'}{'private'}{'keys'}) eq 'ARRAY') {  
                 $domdefaults{'toolprivhosts'} = $domconfig{'toolsec'}{'private'}{'keys'};  
             }  
         }  
     }  
     &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);      &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);
     return %domdefaults;      return %domdefaults;
 }  }
Line 2766  sub get_dom_instcats { Line 2542  sub get_dom_instcats {
             if (&auto_instcode_format($caller,$dom,\%coursecodes,\%codes,              if (&auto_instcode_format($caller,$dom,\%coursecodes,\%codes,
                                       \@codetitles,\%cat_titles,\%cat_order) eq 'ok') {                                        \@codetitles,\%cat_titles,\%cat_order) eq 'ok') {
                 $instcats = {                  $instcats = {
                                 totcodes => $totcodes,  
                                 codes => \%codes,                                  codes => \%codes,
                                 codetitles => \@codetitles,                                  codetitles => \@codetitles,
                                 cat_titles => \%cat_titles,                                  cat_titles => \%cat_titles,
Line 2817  sub get_passwdconf { Line 2592  sub get_passwdconf {
     return %passwdconf;      return %passwdconf;
 }  }
   
 sub course_portal_url {  
     my ($cnum,$cdom,$r) = @_;  
     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 {  
         my $alias = &Apache::lonnet::use_proxy_alias($r,$chome);  
         $hostname = $alias if ($alias ne '');  
         $firsturl = $protocol.'://'.$hostname;  
     }  
     return $firsturl;  
 }  
   
 sub url_prefix {  
     my ($r,$dom,$home,$context) = @_;  
     my $prefix;  
     my %domdefs = &get_domain_defaults($dom);  
     if ($domdefs{'portal_def'} && $domdefs{'portal_def_'.$context}) {  
         if ($domdefs{'portal_def'} =~ m{^(https?://[^/]+)}) {  
             $prefix = $1;  
         }  
     }  
     if ($prefix eq '') {  
         my $hostname = &hostname($home);  
         my $protocol = $protocol{$home};  
         $protocol = 'http' if ($protocol{$home} ne 'https');  
         my $alias = &use_proxy_alias($r,$home);  
         $hostname = $alias if ($alias ne '');  
         $prefix = $protocol.'://'.$hostname;  
     }  
     return $prefix;  
 }  
   
 # --------------------------------------------------- Assign a key to a student  # --------------------------------------------------- Assign a key to a student
   
 sub assign_access_key {  sub assign_access_key {
Line 3761  sub can_edit_resource { Line 3498  sub can_edit_resource {
                             $cfile =  '/adm/wrapper'.$resurl;                              $cfile =  '/adm/wrapper'.$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 3793  sub can_edit_resource { Line 3522  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 3810  sub can_edit_resource { Line 3531  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 4112  sub resizeImage { Line 3828  sub resizeImage {
 # input: $formname - the contents of the file are in $env{"form.$formname"}  # input: $formname - the contents of the file are in $env{"form.$formname"}
 #                    the desired filename is in $env{"form.$formname.filename"}  #                    the desired filename is in $env{"form.$formname.filename"}
 #        $context - possible values: coursedoc, existingfile, overwrite,   #        $context - possible values: coursedoc, existingfile, overwrite, 
 #                                    canceloverwrite, scantron, toollogo or ''.   #                                    canceloverwrite, scantron or ''. 
 #                   if 'coursedoc': upload to the current course  #                   if 'coursedoc': upload to the current course
 #                   if 'existingfile': write file to tmp/overwrites directory   #                   if 'existingfile': write file to tmp/overwrites directory 
 #                   if 'canceloverwrite': delete file written to tmp/overwrites directory  #                   if 'canceloverwrite': delete file written to tmp/overwrites directory
Line 4124  sub resizeImage { Line 3840  sub resizeImage {
 #                          Section => 4, CODE => 5, FirstQuestion => 9 }).  #                          Section => 4, CODE => 5, FirstQuestion => 9 }).
 #        $allfiles - reference to hash for embedded objects  #        $allfiles - reference to hash for embedded objects
 #        $codebase - reference to hash for codebase of java objects  #        $codebase - reference to hash for codebase of java objects
 #        $destuname - username for permanent storage of uploaded file  #        $desuname - username for permanent storage of uploaded file
 #        $destudom - domain for permanaent storage of uploaded file  #        $dsetudom - domain for permanaent storage of uploaded file
 #        $thumbwidth - width (pixels) of thumbnail to make for uploaded image   #        $thumbwidth - width (pixels) of thumbnail to make for uploaded image 
 #        $thumbheight - height (pixels) of thumbnail to make for uploaded image  #        $thumbheight - height (pixels) of thumbnail to make for uploaded image
 #        $resizewidth - width (pixels) to which to resize uploaded image  #        $resizewidth - width (pixels) to which to resize uploaded image
Line 4335  sub finishuserfileupload { Line 4051  sub finishuserfileupload {
     if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {      if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {
         my $input = $filepath.'/'.$file;          my $input = $filepath.'/'.$file;
         my $output = $filepath.'/'.'tn-'.$file;          my $output = $filepath.'/'.'tn-'.$file;
         my $makethumb;  
         my $thumbsize = $thumbwidth.'x'.$thumbheight;          my $thumbsize = $thumbwidth.'x'.$thumbheight;
         if ($context eq 'toollogo') {          my @args = ('convert','-sample',$thumbsize,$input,$output);
             my ($fullwidth,$fullheight) = &check_dimensions($input);          system({$args[0]} @args);
             if ($fullwidth ne '' && $fullheight ne '') {          if (-e $filepath.'/'.'tn-'.$file) {
                 if ($fullwidth > $thumbwidth && $fullheight > $thumbheight) {              $fetchthumb  = 1; 
                     $makethumb = 1;  
                 }  
             }  
         } else {  
             $makethumb = 1;  
         }  
         if ($makethumb) {  
             my @args = ('convert','-sample',$thumbsize,$input,$output);  
             system({$args[0]} @args);  
             if (-e $filepath.'/'.'tn-'.$file) {  
                 $fetchthumb  = 1;  
             }  
         }          }
     }      }
     
Line 4584  sub embedded_dependency { Line 4287  sub embedded_dependency {
     return;      return;
 }  }
   
 sub check_dimensions {  
     my ($inputfile) = @_;  
     my ($fullwidth,$fullheight);  
     if (($inputfile =~ m|^[/\w.\-]+$|) && (-e $inputfile)) {  
         my $mm = new File::MMagic;  
         my $mime_type = $mm->checktype_filename($inputfile);  
         if ($mime_type =~ m{^image/}) {  
             if (open(PIPE,"identify $inputfile 2>&1 |")) {  
                 my $imageinfo = <PIPE>;  
                 if (!close(PIPE)) {  
                     &Apache::lonnet::logthis("Failed to close PIPE opened to retrieve image information for $inputfile");  
                 }  
                 chomp($imageinfo);  
                 my ($fullsize) =  
                     ($imageinfo =~ /^\Q$inputfile\E\s+\w+\s+(\d+x\d+)/);  
                 if ($fullsize) {  
                     ($fullwidth,$fullheight) = split(/x/,$fullsize);  
                 }  
             }  
         }  
     }  
     return ($fullwidth,$fullheight);  
 }  
   
 sub bubblesheet_converter {  sub bubblesheet_converter {
     my ($cdom,$fullpath,$config,$format) = @_;      my ($cdom,$fullpath,$config,$format) = @_;
     if ((&domain($cdom) ne '') &&      if ((&domain($cdom) ne '') &&
Line 4844  sub get_scantronformat_file { Line 4523  sub get_scantronformat_file {
                 close($fh);                  close($fh);
             }              }
         }          }
         chomp(@lines);  
     }      }
     return @lines;      return @lines;
 }  }
Line 4971  sub flushcourselogs { Line 4649  sub flushcourselogs {
 # Typo in rev. 1.458 (2003/12/09)??  # Typo in rev. 1.458 (2003/12/09)??
 # These should likely by $env{'course.'.$cid.'.domain'} and $env{'course.'.$cid.'.num'}  # These should likely by $env{'course.'.$cid.'.domain'} and $env{'course.'.$cid.'.num'}
 #  #
 # While these remain as $env{'request.'.$cid.'.domain'} and $env{'request.'.$cid.'.num'}  # While these ramain as  $env{'request.'.$cid.'.domain'} and $env{'request.'.$cid.'.num'}
 # $dom and $name will always be null, so the &inc() call will default to storing this data  # $dom and $name will always be null, so the &inc() call will default to storing this data
 # in a nohist_accesscount.db file for the user rather than the course.  # in a nohist_accesscount.db file for the user rather than the course.
 #  #
Line 5200  sub courserolelog { Line 4878  sub courserolelog {
             $storehash{'group'} = $sec;              $storehash{'group'} = $sec;
         } else {          } else {
             $storehash{'section'} = $sec;              $storehash{'section'} = $sec;
             my ($curruserdomstr,$newuserdomstr);  
             if (exists($env{'course.'.$cdom.'_'.$cnum.'.internal.userdomains'})) {  
                 $curruserdomstr = $env{'course.'.$env{'request.course.id'}.'.internal.userdomains'};  
             } else {  
                 my %courseinfo = &coursedescription($cdom.'/'.$cnum);  
                 $curruserdomstr = $courseinfo{'internal.userdomains'};  
             }  
             if ($curruserdomstr ne '') {  
                 my @udoms = split(/,/,$curruserdomstr);  
                 unless (grep(/^\Q$domain\E/,@udoms)) {  
                     push(@udoms,$domain);  
                     $newuserdomstr = join(',',sort(@udoms));  
                 }  
             } else {  
                 $newuserdomstr = $domain;  
             }  
             if ($newuserdomstr ne '') {  
                 my $putresult = &put('environment',{ 'internal.userdomains' => $newuserdomstr },  
                                      $cdom,$cnum);  
                 if ($putresult eq 'ok') {  
                     unless (($selfenroll) || ($context eq 'selfenroll')) {  
                         if (($context eq 'createcourse') || ($context eq 'requestcourses') ||  
                             ($context eq 'automated') || ($context eq 'domain')) {  
                             $env{'course.'.$cdom.'_'.$cnum.'.internal.userdomains'} = $newuserdomstr;  
                         } elsif ($env{'request.course.id'} eq $cdom.'_'.$cnum) {  
                             &appenv({'course.'.$cdom.'_'.$cnum.'.internal.userdomains' => $newuserdomstr});  
                         }  
                     }  
                 }  
             }  
         }          }
         &write_log('course',$namespace,\%storehash,$delflag,$username,          &write_log('course',$namespace,\%storehash,$delflag,$username,
                    $domain,$cnum,$cdom);                     $domain,$cnum,$cdom);
Line 5888  my %cachedtimes=(); Line 5536  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 5900  sub load_all_first_access { Line 5547  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 5912  sub get_first_access { Line 5559  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 6738  sub rolesinit { Line 6385  sub rolesinit {
     my %firstaccess = &dump('firstaccesstimes', $domain, $username);      my %firstaccess = &dump('firstaccesstimes', $domain, $username);
     my %timerinterval = &dump('timerinterval', $domain, $username);      my %timerinterval = &dump('timerinterval', $domain, $username);
     my (%coursetimerstarts, %firstaccchk, %firstaccenv, %coursetimerintervals,      my (%coursetimerstarts, %firstaccchk, %firstaccenv, %coursetimerintervals,
         %timerintchk, %timerintenv,%coauthorenv);          %timerintchk, %timerintenv);
   
     foreach my $key (keys(%firstaccess)) {      foreach my $key (keys(%firstaccess)) {
         my ($cid, $rest) = split(/\0/, $key);          my ($cid, $rest) = split(/\0/, $key);
Line 6752  sub rolesinit { Line 6399  sub rolesinit {
   
     my %allroles=();      my %allroles=();
     my %allgroups=();      my %allgroups=();
     my %gotcoauconfig=();  
     my %domdefaults=();  
   
     for my $area (grep { ! /^rolesdef_/ } keys(%rolesdump)) {      for my $area (grep { ! /^rolesdef_/ } keys(%rolesdump)) {
         my $role = $rolesdump{$area};          my $role = $rolesdump{$area};
Line 6805  sub rolesinit { Line 6450  sub rolesinit {
         } else {          } else {
         # Normal role, defined in roles.tab          # Normal role, defined in roles.tab
             &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);              &standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
             if (($trole eq 'ca') || ($trole eq 'aa')) {  
                 (undef,my ($audom,$auname)) = split(/\//,$area);  
                 unless ($gotcoauconfig{$area}) {  
                     my @ca_settings = ('authoreditors');  
                     my %info = &userenvironment($audom,$auname,@ca_settings);  
                     $gotcoauconfig{$area} = 1;  
                     foreach my $item (@ca_settings) {  
                         if (exists($info{$item})) {  
                             my $name = $item;  
                             if ($item eq 'authoreditors') {  
                                 $name = 'editors';  
                                 unless ($info{'authoreditors'}) {  
                                     my %domdefs;  
                                     if (ref($domdefaults{$audom}) eq 'HASH') {  
                                         %domdefs = %{$domdefaults{$audom}};  
                                     } else {  
                                         %domdefs = &get_domain_defaults($audom);  
                                         $domdefaults{$audom} = \%domdefs;  
                                     }  
                                     if ($domdefs{$name} ne '') {  
                                         $info{'authoreditors'} = $domdefs{$name};  
                                     } else {  
                                         $info{'authoreditors'} = 'edit,xml';  
                                     }  
                                 }  
                             }  
                             $coauthorenv{"environment.internal.$name.$area"} = $info{$item};  
                         }  
                     }  
                 }  
             }  
         }          }
   
         my $cid = $tdomain.'_'.$trest;          my $cid = $tdomain.'_'.$trest;
Line 6864  sub rolesinit { Line 6478  sub rolesinit {
     $env{'user.adv'} = $userroles{'user.adv'};      $env{'user.adv'} = $userroles{'user.adv'};
     $env{'user.rar'} = $userroles{'user.rar'};      $env{'user.rar'} = $userroles{'user.rar'};
   
     return (\%userroles,\%firstaccenv,\%timerintenv,\%coauthorenv);      return (\%userroles,\%firstaccenv,\%timerintenv);
 }  }
   
 sub set_arearole {  sub set_arearole {
Line 6925  sub course_adhocrole_privs { Line 6539  sub course_adhocrole_privs {
             $full{$priv} = $restrict;              $full{$priv} = $restrict;
         }          }
         foreach my $item (split(/,/,$overrides{"internal.adhocpriv.$rolename"})) {          foreach my $item (split(/,/,$overrides{"internal.adhocpriv.$rolename"})) {
             next if ($item eq '');               next if ($item eq '');
             my ($rule,$rest) = split(/=/,$item);               my ($rule,$rest) = split(/=/,$item);
             next unless (($rule eq 'off') || ($rule eq 'on'));               next unless (($rule eq 'off') || ($rule eq 'on'));
             foreach my $priv (split(/:/,$rest)) {               foreach my $priv (split(/:/,$rest)) {
                 if ($priv ne '') {                   if ($priv ne '') {
                     if ($rule eq 'off') {                       if ($rule eq 'off') {
                         $possremove{$priv} = 1;                           $possremove{$priv} = 1;
                     } else {                       } else {
                         $possadd{$priv} = 1;                           $possadd{$priv} = 1;
                     }                       }
                 }                   }
             }               }
         }           }
         foreach my $priv (sort(keys(%full))) {           foreach my $priv (sort(keys(%full))) {
             if (exists($currprivs{$priv})) {               if (exists($currprivs{$priv})) {
                 unless (exists($possremove{$priv})) {                   unless (exists($possremove{$priv})) {
                     $storeprivs{$priv} = $currprivs{$priv};                       $storeprivs{$priv} = $currprivs{$priv};
                 }                   }
             } elsif (exists($possadd{$priv})) {               } elsif (exists($possadd{$priv})) {
                 $storeprivs{$priv} = $full{$priv};                   $storeprivs{$priv} = $full{$priv};
             }               }
         }           }
         $coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs)));           $coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs)));
     }       }
     return $coursepriv;       return $coursepriv;
 }  }
   
 sub group_roleprivs {  sub group_roleprivs {
Line 7213  sub set_adhoc_privileges { Line 6827  sub set_adhoc_privileges {
     my ($author,$adv,$rar)= &set_userprivs(\%userroles,\%rolehash);      my ($author,$adv,$rar)= &set_userprivs(\%userroles,\%rolehash);
     &appenv(\%userroles,[$role,'cm']);      &appenv(\%userroles,[$role,'cm']);
     &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$spec);      &log($env{'user.domain'},$env{'user.name'},$env{'user.home'},"Role ".$spec);
     unless (($caller eq 'constructaccess' && $env{'request.course.id'}) ||      unless ($caller eq 'constructaccess' && $env{'request.course.id'}) {
             ($caller eq 'tiny')) {  
         &appenv( {'request.role'        => $spec,          &appenv( {'request.role'        => $spec,
                   'request.role.domain' => $dcdom,                    'request.role.domain' => $dcdom,
                   'request.course.sec'  => $sec,                     'request.course.sec'  => $sec, 
Line 7289  sub unserialize { Line 6902  sub unserialize {
 # see Lond::dump_with_regexp  # see Lond::dump_with_regexp
 # if $escapedkeys hash keys won't get unescaped.  # if $escapedkeys hash keys won't get unescaped.
 sub dump {  sub dump {
     my ($namespace,$udomain,$uname,$regexp,$range,$escapedkeys,$encrypt)=@_;      my ($namespace,$udomain,$uname,$regexp,$range,$escapedkeys)=@_;
     if (!$udomain) { $udomain=$env{'user.domain'}; }      if (!$udomain) { $udomain=$env{'user.domain'}; }
     if (!$uname) { $uname=$env{'user.name'}; }      if (!$uname) { $uname=$env{'user.name'}; }
     my $uhome=&homeserver($uname,$udomain);      my $uhome=&homeserver($uname,$udomain);
Line 7305  sub dump { Line 6918  sub dump {
                     $uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'});                      $uname, $namespace, $regexp, $range)), $perlvar{'lonVersion'});
         return %{&unserialize($reply, $escapedkeys)};          return %{&unserialize($reply, $escapedkeys)};
     }      }
     my $rep;      my $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);
     if ($encrypt) {  
         $rep=&reply("encrypt:edump:$udomain:$uname:$namespace:$regexp:$range",$uhome);  
     } else {  
         $rep=&reply("dump:$udomain:$uname:$namespace:$regexp:$range",$uhome);  
     }  
     my @pairs=split(/\&/,$rep);      my @pairs=split(/\&/,$rep);
     my %returnhash=();      my %returnhash=();
     if (!($rep =~ /^error/ )) {      if (!($rep =~ /^error/ )) {
Line 7456  sub inc { Line 7064  sub inc {
 # --------------------------------------------------------------- put interface  # --------------------------------------------------------------- put interface
   
 sub put {  sub put {
    my ($namespace,$storehash,$udomain,$uname,$encrypt)=@_;     my ($namespace,$storehash,$udomain,$uname)=@_;
    if (!$udomain) { $udomain=$env{'user.domain'}; }     if (!$udomain) { $udomain=$env{'user.domain'}; }
    if (!$uname) { $uname=$env{'user.name'}; }     if (!$uname) { $uname=$env{'user.name'}; }
    my $uhome=&homeserver($uname,$udomain);     my $uhome=&homeserver($uname,$udomain);
Line 7465  sub put { Line 7073  sub put {
        $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';         $items.=&escape($item).'='.&freeze_escape($$storehash{$item}).'&';
    }     }
    $items=~s/\&$//;     $items=~s/\&$//;
    if ($encrypt) {     return &reply("put:$udomain:$uname:$namespace:$items",$uhome);
        return &reply("encrypt:put:$udomain:$uname:$namespace:$items",$uhome);  
    } else {  
        return &reply("put:$udomain:$uname:$namespace:$items",$uhome);  
    }  
 }  }
   
 # ------------------------------------------------------------ newput interface  # ------------------------------------------------------------ newput interface
Line 7983  sub is_portfolio_file { Line 7587  sub is_portfolio_file {
     return;      return;
 }  }
   
 sub is_coursetool_logo {  
     my ($uri) = @_;  
     if ($env{'request.course.id'}) {  
         my $courseurl = &courseid_to_courseurl($env{'request.course.id'});  
         if ($uri =~ m{^/*uploaded\Q$courseurl\E/toollogo/\d+/[^/]+$}) {  
             return 1;  
         }  
     }  
     return;  
 }  
   
 sub usertools_access {  sub usertools_access {
     my ($uname,$udom,$tool,$action,$context,$userenvref,$domdefref,$is_advref)=@_;      my ($uname,$udom,$tool,$action,$context,$userenvref,$domdefref,$is_advref)=@_;
     my ($access,%tools);      my ($access,%tools);
Line 8006  sub usertools_access { Line 7599  sub usertools_access {
                       unofficial => 1,                        unofficial => 1,
                       community  => 1,                        community  => 1,
                       textbook   => 1,                        textbook   => 1,
                       lti        => 1,  
                  );                   );
     } elsif ($context eq 'requestauthor') {      } elsif ($context eq 'requestauthor') {
         %tools = (          %tools = (
                       requestauthor => 1,                        requestauthor => 1,
                  );                   );
     } elsif ($context eq 'authordefaults') {  
         %tools = (  
                       webdav    => 1,  
                  );  
     } else {      } else {
         %tools = (          %tools = (
                       aboutme   => 1,                        aboutme   => 1,
                       blog      => 1,                        blog      => 1,
                         webdav    => 1,
                       portfolio => 1,                        portfolio => 1,
                       timezone  => 1,  
                  );                   );
     }      }
     return if (!defined($tools{$tool}));      return if (!defined($tools{$tool}));
Line 8037  sub usertools_access { Line 7625  sub usertools_access {
                 return $env{'environment.canrequest.'.$tool};                  return $env{'environment.canrequest.'.$tool};
             } elsif ($context eq 'requestauthor') {              } elsif ($context eq 'requestauthor') {
                 return $env{'environment.canrequest.author'};                  return $env{'environment.canrequest.author'};
             } elsif ($context eq 'authordefaults') {  
                 if ($tool eq 'webdav') {  
                     return $env{'environment.availabletools.'.$tool};  
                 }  
             } else {              } else {
                 return $env{'environment.availabletools.'.$tool};                  return $env{'environment.availabletools.'.$tool};
             }              }
Line 8050  sub usertools_access { Line 7634  sub usertools_access {
     my ($toolstatus,$inststatus,$envkey);      my ($toolstatus,$inststatus,$envkey);
     if ($context eq 'requestauthor') {      if ($context eq 'requestauthor') {
         $envkey = $context;          $envkey = $context;
     } elsif ($context eq 'authordefaults') {  
         if ($tool eq 'webdav') {  
             $envkey = 'tools.'.$tool;  
         }  
     } else {      } else {
         $envkey = $context.'.'.$tool;          $envkey = $context.'.'.$tool;
     }      }
Line 8215  sub is_advanced_user { Line 7795  sub is_advanced_user {
 }  }
   
 sub check_can_request {  sub check_can_request {
     my ($dom,$can_request,$request_domains,$uname,$udom) = @_;      my ($dom,$can_request,$request_domains) = @_;
     my $canreq = 0;      my $canreq = 0;
     if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) {  
         $uname = $env{'user.name'};  
         $udom = $env{'user.domain'};  
     }  
     my ($types,$typename) = &Apache::loncommon::course_types();      my ($types,$typename) = &Apache::loncommon::course_types();
     my @options = ('approval','validate','autolimit');      my @options = ('approval','validate','autolimit');
     my $optregex = join('|',@options);      my $optregex = join('|',@options);
     if ((ref($can_request) eq 'HASH') && (ref($types) eq 'ARRAY')) {      if ((ref($can_request) eq 'HASH') && (ref($types) eq 'ARRAY')) {
         foreach my $type (@{$types}) {          foreach my $type (@{$types}) {
             if (&usertools_access($uname,$udom,$type,undef,              if (&usertools_access($env{'user.name'},
                                   'requestcourses')) {                                    $env{'user.domain'},
                                     $type,undef,'requestcourses')) {
                 $canreq ++;                  $canreq ++;
                 if (ref($request_domains) eq 'HASH') {                  if (ref($request_domains) eq 'HASH') {
                     push(@{$request_domains->{$type}},$udom);                      push(@{$request_domains->{$type}},$env{'user.domain'});
                 }                  }
                 if ($dom eq $udom) {                  if ($dom eq $env{'user.domain'}) {
                     $can_request->{$type} = 1;                      $can_request->{$type} = 1;
                 }                  }
             }              }
             if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '') &&              if ($env{'environment.reqcrsotherdom.'.$type} ne '') {
                 ($env{'environment.reqcrsotherdom.'.$type} ne '')) {  
                 my @curr = split(',',$env{'environment.reqcrsotherdom.'.$type});                  my @curr = split(',',$env{'environment.reqcrsotherdom.'.$type});
                 if (@curr > 0) {                  if (@curr > 0) {
                     foreach my $item (@curr) {                      foreach my $item (@curr) {
Line 8254  sub check_can_request { Line 7830  sub check_can_request {
                             }                              }
                         }                          }
                     }                      }
                     unless ($dom eq $env{'user.domain'}) {                      unless($dom eq $env{'user.domain'}) {
                         $canreq ++;                          $canreq ++;
                         if (grep(/^\Q$dom\E:($optregex)(=?\d*)$/,@curr)) {                          if (grep(/^\Q$dom\E:($optregex)(=?\d*)$/,@curr)) {
                             $can_request->{$type} = 1;                              $can_request->{$type} = 1;
Line 8319  sub customaccess { Line 7895  sub customaccess {
 # ------------------------------------------------- Check for a user privilege  # ------------------------------------------------- Check for a user privilege
   
 sub allowed {  sub allowed {
     my ($priv,$uri,$symb,$role,$clientip,$noblockcheck,$ignorecache,$nodeeplinkcheck,$nodeeplinkout)=@_;      my ($priv,$uri,$symb,$role,$clientip,$noblockcheck,$ignorecache)=@_;
     my $ver_orguri=$uri;      my $ver_orguri=$uri;
     $uri=&deversion($uri);      $uri=&deversion($uri);
     my $orguri=$uri;      my $orguri=$uri;
     $uri=&declutter($uri);      $uri=&declutter($uri);
   
     if ($priv eq 'evb') {      if ($priv eq 'evb') {
 # Evade communication block restrictions for specified role in a course or domain  # Evade communication block restrictions for specified role in a course
         if ($env{'user.priv.'.$role} =~/evb\&([^\:]*)/) {          if ($env{'user.priv.'.$role} =~/evb\&([^\:]*)/) {
             return $1;              return $1;
         } else {          } else {
Line 8336  sub allowed { Line 7912  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|viewclasslist|aboutme|ext\.tool)$}))       if (((($uri=~/^adm\//) && ($uri !~ m{/(?:smppg|bulletinboard|viewclasslist|aboutme)$})) 
  || (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) ))    || (($uri=~/\.meta$/) && ($uri!~m|^uploaded/|) )) 
  && ($priv eq 'bre')) {   && ($priv eq 'bre')) {
  return 'F';   return 'F';
Line 8384  sub allowed { Line 7960  sub allowed {
 # Free bre to public access  # Free bre to public access
   
     if ($priv eq 'bre') {      if ($priv eq 'bre') {
         my $copyright;          my $copyright=&metadata($uri,'copyright');
         unless ($uri =~ /ext\.tool/) {  
             $copyright=&metadata($uri,'copyright');  
         }  
  if (($copyright eq 'public') && (!$env{'request.course.id'})) {    if (($copyright eq 'public') && (!$env{'request.course.id'})) { 
            return 'F';              return 'F'; 
         }          }
Line 8544  sub allowed { Line 8117  sub allowed {
             if ($env{'user.priv.'.$env{'request.role'}.'./'}              if ($env{'user.priv.'.$env{'request.role'}.'./'}
                   =~/\Q$priv\E\&([^\:]*)/) {                    =~/\Q$priv\E\&([^\:]*)/) {
                 my $value = $1;                  my $value = $1;
                 my $deeplinkblock;                  if ($noblockcheck) {
                 unless ($nodeeplinkcheck) {  
                     $deeplinkblock = &deeplink_check($priv,$symb,$uri);  
                 }  
                 if ($deeplinkblock) {  
                     $thisallowed='D';  
                 } elsif ($noblockcheck) {  
                     $thisallowed.=$value;                      $thisallowed.=$value;
                 } else {                  } else {
                     my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache);                      my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache);
Line 8570  sub allowed { Line 8137  sub allowed {
                     $refuri=&declutter($refuri);                      $refuri=&declutter($refuri);
                     my ($match) = &is_on_map($refuri);                      my ($match) = &is_on_map($refuri);
                     if ($match) {                      if ($match) {
                         my $deeplinkblock;                          if ($noblockcheck) {
                         unless ($nodeeplinkcheck) {  
                             $deeplinkblock = &deeplink_check($priv,$symb,$refuri);  
                         }  
                         if ($deeplinkblock) {  
                             $thisallowed='D';  
                         } elsif ($noblockcheck) {  
                             $thisallowed='F';                              $thisallowed='F';
                         } else {                          } else {
                             my @blockers = &has_comm_blocking($priv,'',$refuri,'',1);                              my @blockers = &has_comm_blocking($priv,'',$refuri,'',1);
Line 8626  sub allowed { Line 8187  sub allowed {
   
     if ($env{'request.course.id'}) {      if ($env{'request.course.id'}) {
   
         if ($priv eq 'bre') {  
             if (&is_coursetool_logo($uri)) {  
                 return 'F';  
             }  
         }  
   
 # If this is modifying password (internal auth) domains must match for user and user's role.  # If this is modifying password (internal auth) domains must match for user and user's role.
   
         if ($priv eq 'mip') {          if ($priv eq 'mip') {
Line 8655  sub allowed { Line 8210  sub allowed {
                =~/\Q$priv\E\&([^\:]*)/) {                 =~/\Q$priv\E\&([^\:]*)/) {
                my $value = $1;                 my $value = $1;
                if ($priv eq 'bre') {                 if ($priv eq 'bre') {
                    my $deeplinkblock;                     if ($noblockcheck) {
                    unless ($nodeeplinkcheck) {  
                        $deeplinkblock = &deeplink_check($priv,$symb,$uri);  
                    }  
                    if ($deeplinkblock) {  
                        $thisallowed = 'D';  
                    } elsif ($noblockcheck) {  
                        $thisallowed.=$value;                         $thisallowed.=$value;
                    } else {                     } else {
                        my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache);                         my @blockers = &has_comm_blocking($priv,$symb,$uri,$ignorecache);
Line 8703  sub allowed { Line 8252  sub allowed {
                   =~/\Q$priv\E\&([^\:]*)/) {                    =~/\Q$priv\E\&([^\:]*)/) {
                   my $value = $1;                    my $value = $1;
                   if ($priv eq 'bre') {                    if ($priv eq 'bre') {
                       my $deeplinkblock;                        if ($noblockcheck) {
                       unless ($nodeeplinkcheck) {  
                           $deeplinkblock = &deeplink_check($priv,$symb,$refuri);  
                       }  
                       if ($deeplinkblock) {  
                           $thisallowed = 'D';  
                       } elsif ($noblockcheck) {  
                           $thisallowed.=$value;                            $thisallowed.=$value;
                       } else {                        } else {
                           my @blockers = &has_comm_blocking($priv,'',$refuri,'',1);                            my @blockers = &has_comm_blocking($priv,'',$refuri,'',1);
Line 8889  sub allowed { Line 8432  sub allowed {
        }         }
    }     }
   
 # Restricted for deeplinked session?  
   
     if ($env{'request.deeplink.login'}) {  
         if ($env{'acc.deeplinkout'} && !$nodeeplinkout) {  
             if (!$symb) { $symb=&symbread($uri,1); }  
             if (($symb) && ($env{'acc.deeplinkout'}=~/\&\Q$symb\E\&/)) {  
                 return '';  
             }  
         }  
     }  
   
 # Restricted by state or randomout?  # Restricted by state or randomout?
   
    if ($thisallowed=~/X/) {     if ($thisallowed=~/X/) {
Line 8920  sub allowed { Line 8452  sub allowed {
  return 'A';   return 'A';
     } elsif ($thisallowed eq 'B') {      } elsif ($thisallowed eq 'B') {
         return 'B';          return 'B';
     } elsif ($thisallowed eq 'D') {  
         return 'D';  
     }      }
    return 'F';     return 'F';
 }  }
Line 8938  sub constructaccess { Line 8468  sub constructaccess {
     my ($ownername,$ownerdomain,$ownerhome);      my ($ownername,$ownerdomain,$ownerhome);
   
     ($ownerdomain,$ownername) =      ($ownerdomain,$ownername) =
         ($url=~ m{^(?:\Q$perlvar{'lonDocRoot'}\E|)(?:/daxepage|/daxeopen)?/priv/($match_domain)/($match_username)(?:/|$)});          ($url=~ m{^(?:\Q$perlvar{'lonDocRoot'}\E|)/priv/($match_domain)/($match_username)(?:/|$)});
   
 # The URL does not really point to any authorspace, forget it  # The URL does not really point to any authorspace, forget it
     unless (($ownername) && ($ownerdomain)) { return ''; }      unless (($ownername) && ($ownerdomain)) { return ''; }
Line 9103  sub get_commblock_resources { Line 8633  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 9114  sub get_commblock_resources { Line 8643  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;
                                 if ($type eq 'resource') {                                  if ($type eq 'resource') {
Line 9239  sub has_comm_blocking { Line 8768  sub has_comm_blocking {
 }  }
 }  }
   
 sub deeplink_check {  
     my ($priv,$symb,$uri) = @_;  
     return unless ($env{'request.course.id'});  
     return unless ($priv eq 'bre');  
     return if ($env{'request.state'} eq 'construct');  
     return if ($env{'request.role.adv'});  
     my $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};  
     my $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};  
     my (%possibles,@symbs);  
     if (!$symb) {  
         $symb = &symbread($uri,1,1,1,\%possibles);  
     }  
     if ($symb) {  
         @symbs = ($symb);  
     } elsif (keys(%possibles)) {  
         @symbs = keys(%possibles);  
     }  
   
     my ($deeplink_symb,$allow);  
     if ($env{'request.deeplink.login'}) {  
         $deeplink_symb = &Apache::loncommon::deeplink_login_symb($cnum,$cdom);  
     }  
     foreach my $symb (@symbs) {  
         last if ($allow);  
         my $deeplink = &EXT("resource.0.deeplink",$symb);  
         if ($deeplink eq '') {  
             $allow = 1;  
         } else {  
             my ($state,$others,$listed,$scope,$protect) = split(/,/,$deeplink);  
             if ($state ne 'only') {  
                 $allow = 1;  
             } else {  
                 my $check_deeplink_entry;  
                 if ($protect ne 'none') {  
                     my ($acctype,$item) = split(/:/,$protect);  
                     if (($acctype eq 'ltic') && ($env{'user.linkprotector'})) {  
                         if (grep(/^\Q$item\Ec$/,split(/,/,$env{'user.linkprotector'}))) {  
                             $check_deeplink_entry = 1  
                         }  
                     } elsif (($acctype eq 'ltid') && ($env{'user.linkprotector'})) {  
                         if (grep(/^\Q$item\Ed$/,split(/,/,$env{'user.linkprotector'}))) {  
                             $check_deeplink_entry = 1;  
                         }  
                     } elsif (($acctype eq 'key') && ($env{'user.deeplinkkey'})) {  
                         if (grep(/^\Q$item\E$/,split(/,/,$env{'user.deeplinkkey'}))) {  
                             $check_deeplink_entry = 1;  
                         }  
                     }  
                 }  
                 if (($protect eq 'none') || ($check_deeplink_entry)) {  
                     if ($scope eq 'res') {  
                         if ($symb eq $deeplink_symb) {  
                             $allow = 1;  
                         }  
                     } elsif (($scope eq 'map') || ($scope eq 'rec')) {  
                         my ($map_from_symb,$map_from_login);  
                         $map_from_symb = &deversion((&decode_symb($symb))[0]);  
                         if ($deeplink_symb =~ /\.(page|sequence)$/) {  
                             $map_from_login = &deversion((&decode_symb($deeplink_symb))[2]);  
                         } else {  
                             $map_from_login = &deversion((&decode_symb($deeplink_symb))[0]);  
                         }  
                         if (($map_from_symb) && ($map_from_login)) {  
                             if ($map_from_symb eq $map_from_login) {  
                                 $allow = 1;  
                             } elsif ($scope eq 'rec') {  
                                 my @recurseup = &get_map_hierarchy($map_from_symb,$env{'request.course.id'});  
                                 if (grep(/^\Q$map_from_login\E$/,@recurseup)) {  
                                     $allow = 1;  
                                 }  
                             }  
                         }  
                     }  
                 }  
             }  
         }  
     }  
     return if ($allow);  
     return 1;  
 }  
   
 # -------------------------------- Deversion and split uri into path an filename  # -------------------------------- Deversion and split uri into path an filename
   
 #  #
Line 10440  sub assignrole { Line 9888  sub assignrole {
                             }                              }
                         }                          }
                     }                      }
                 } elsif (($selfenroll == 1) && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {                  } elsif (($selfenroll == 1) && ($role eq 'st') && ($udom eq $env{'user.domain'}) && ($uname eq $env{'user.name'})) {
                     if ($role eq 'st') {                      $refused = '';
                         $refused = '';  
                     } elsif (($context eq 'ltienroll') && ($env{'request.lti.login'})) {  
                         $refused = '';  
                     }  
                 } elsif ($context eq 'requestcourses') {                  } elsif ($context eq 'requestcourses') {
                     my @possroles = ('st','ta','ep','in','cc','co');                      my @possroles = ('st','ta','ep','in','cc','co');
                     if ((grep(/^\Q$role\E$/,@possroles)) && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) {                      if ((grep(/^\Q$role\E$/,@possroles)) && ($env{'user.name'} ne '' && $env{'user.domain'} ne '')) {
Line 10737  sub modifyuser { Line 10181  sub modifyuser {
     my $newuser;      my $newuser;
     if ($uhome eq 'no_host') {      if ($uhome eq 'no_host') {
         $newuser = 1;          $newuser = 1;
         unless (($umode && ($upass ne '')) || ($umode eq 'localauth') ||  
                 ($umode eq 'lti')) {  
             return 'error: more information needed to create new user';  
         }  
     }      }
 # ----------------------------------------------------------------- Create User  # ----------------------------------------------------------------- Create User
     if (($uhome eq 'no_host') &&       if (($uhome eq 'no_host') && 
  (($umode && $upass) || ($umode eq 'localauth') || ($umode eq 'lti'))) {   (($umode && $upass) || ($umode eq 'localauth'))) {
         my $unhome='';          my $unhome='';
         if (defined($desiredhome) && &host_domain($desiredhome) eq $udom) {           if (defined($desiredhome) && &host_domain($desiredhome) eq $udom) { 
             $unhome = $desiredhome;              $unhome = $desiredhome;
Line 11032  sub writecoursepref { Line 10472  sub writecoursepref {
   
 sub createcourse {  sub createcourse {
     my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,      my ($udom,$description,$url,$course_server,$nonstandard,$inst_code,
         $course_owner,$crstype,$cnum,$context,$category,$callercontext)=@_;          $course_owner,$crstype,$cnum,$context,$category)=@_;
     $url=&declutter($url);      $url=&declutter($url);
     my $cid='';      my $cid='';
     if ($context eq 'requestcourses') {      if ($context eq 'requestcourses') {
         my $can_create = 0;          my $can_create = 0;
         my ($ownername,$ownerdom) = split(':',$course_owner);          my ($ownername,$ownerdom) = split(':',$course_owner);
         if ($udom eq $ownerdom) {          if ($udom eq $ownerdom) {
             my $reload;              if (&usertools_access($ownername,$ownerdom,$category,undef,
             if (($callercontext eq 'auto') &&  
                ($ownerdom eq $env{'user.domain'}) && ($ownername eq $env{'user.name'})) {  
                 $reload = 'reload';  
             }  
             if (&usertools_access($ownername,$ownerdom,$category,$reload,  
                                   $context)) {                                    $context)) {
                 $can_create = 1;                  $can_create = 1;
             }              }
Line 12079  sub resdata { Line 11514  sub resdata {
     return undef;      return undef;
 }  }
   
 sub get_domain_lti {  sub get_numsuppfiles {
     my ($cdom,$context) = @_;      my ($cnum,$cdom,$ignorecache)=@_;
     my ($name,$cachename,%lti);  
     if ($context eq 'consumer') {  
         $name = 'ltitools';  
     } elsif ($context eq 'provider') {  
         $name = 'lti';  
     } elsif ($context eq 'linkprot') {  
         $name = 'ltisec';  
     } else {  
         return %lti;  
     }  
     if ($context eq 'linkprot') {  
         $cachename = $context;  
     } else {  
         $cachename = $name;  
     }  
     my ($result,$cached)=&is_cached_new($cachename,$cdom);  
     if (defined($cached)) {  
         if (ref($result) eq 'HASH') {  
             %lti = %{$result};  
         }  
     } else {  
         my %domconfig = &get_dom('configuration',[$name],$cdom);  
         if (ref($domconfig{$name}) eq 'HASH') {  
             if ($context eq 'linkprot') {  
                 if (ref($domconfig{$name}{'linkprot'}) eq 'HASH') {  
                     %lti = %{$domconfig{$name}{'linkprot'}};  
                 }  
             } else {  
                 %lti = %{$domconfig{$name}};  
             }  
         }  
         my $cachetime = 24*60*60;  
         &do_cache_new($cachename,$cdom,\%lti,$cachetime);  
     }  
     return %lti;  
 }  
   
 sub get_course_lti {  
     my ($cnum,$cdom,$context) = @_;  
     my ($name,$cachename,%lti);  
     if ($context eq 'consumer') {  
         $name = 'ltitools';  
         $cachename = 'courseltitools';  
     } elsif ($context eq 'provider') {  
         $name = 'lti';  
         $cachename = 'courselti';  
     } else {  
         return %lti;  
     }  
     my $hashid=$cdom.'_'.$cnum;  
     my ($result,$cached)=&is_cached_new($cachename,$hashid);  
     if (defined($cached)) {  
         if (ref($result) eq 'HASH') {  
             %lti = %{$result};  
         }  
     } else {  
         %lti = &dump($name,$cdom,$cnum,undef,undef,undef,1);  
         my $cachetime = 24*60*60;  
         &do_cache_new($cachename,$hashid,\%lti,$cachetime);  
     }  
     return %lti;  
 }  
   
 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 $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 $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_ltitools_id {  
     my ($context,$cdom,$cnum,$title) = @_;  
     my ($lockhash,$tries,$gotlock,$id,$error);  
   
     # get lock on ltitools db  
     $lockhash = {  
                    lock => $env{'user.name'}.  
                            ':'.$env{'user.domain'},  
                 };  
     $tries = 0;  
     if ($context eq 'domain') {  
         $gotlock = &newput_dom('ltitools',$lockhash,$cdom);  
     } else {  
         $gotlock = &newput('ltitools',$lockhash,$cdom,$cnum);  
     }  
     while (($gotlock ne 'ok') && ($tries<10)) {  
         $tries ++;  
         sleep (0.1);  
         if ($context eq 'domain') {  
             $gotlock = &newput_dom('ltitools',$lockhash,$cdom);  
         } else {  
             $gotlock = &newput('ltitools',$lockhash,$cdom,$cnum);  
         }  
     }  
     if ($gotlock eq 'ok') {  
         my %currids;  
         if ($context eq 'domain') {  
             %currids = &dump_dom('ltitools',$cdom);  
         } else {  
             %currids = &dump('ltitools',$cdom,$cnum);  
         }  
         if ($currids{'lock'}) {  
             delete($currids{'lock'});  
             if (keys(%currids)) {  
                 my @curr = sort { $a <=> $b } keys(%currids);  
                 if ($curr[-1] =~ /^\d+$/) {  
                     $id = 1 + $curr[-1];  
                 }  
             } else {  
                 $id = 1;  
             }  
             if ($id) {  
                 if ($context eq 'domain') {  
                     unless (&newput_dom('ltitools',{ $id => $title },$cdom) eq 'ok') {  
                         $error = 'nostore';  
                     }  
                 } else {  
                     unless (&newput('ltitools',{ $id => $title },$cdom,$cnum) eq 'ok') {  
                         $error = 'nostore';  
                     }  
                 }  
             } else {  
                 $error = 'nonumber';  
             }  
         }  
         my $dellockoutcome;  
         if ($context eq 'domain') {  
             $dellockoutcome = &del_dom('ltitools',['lock'],$cdom);  
         } else {  
             $dellockoutcome = &del('ltitools',['lock'],$cdom,$cnum);  
         }  
     } else {  
         $error = 'nolock';  
     }  
     return ($id,$error);  
 }  
   
 sub count_supptools {  
     my ($cnum,$cdom,$ignorecache,$reload)=@_;  
     my $hashid=$cnum.':'.$cdom;  
     my ($numexttools,$cached);  
     unless ($ignorecache) {  
         ($numexttools,$cached) = &is_cached_new('supptools',$hashid);  
     }  
     unless (defined($cached)) {  
         my $chome=&homeserver($cnum,$cdom);  
         $numexttools = 0;  
         unless ($chome eq 'no_host') {  
             my ($supplemental) = &Apache::loncommon::get_supplemental($cnum,$cdom,$reload);  
             if (ref($supplemental) eq 'HASH') {  
                 if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {  
                     foreach my $key (keys(%{$supplemental->{'ids'}})) {  
                         if ($key =~ m{^/adm/$cdom/$cnum/\d+/ext\.tool$}) {  
                             $numexttools ++;  
                         }  
                     }  
                 }  
             }  
         }  
         &do_cache_new('supptools',$hashid,$numexttools,600);  
     }  
     return $numexttools;  
 }  
   
 sub has_unhidden_suppfiles {  
     my ($cnum,$cdom,$ignorecache,$possdel)=@_;  
     my $hashid=$cnum.':'.$cdom;      my $hashid=$cnum.':'.$cdom;
     my ($showsupp,$cached);      my ($suppcount,$cached);
     unless ($ignorecache) {      unless ($ignorecache) {
         ($showsupp,$cached) = &is_cached_new('showsupp',$hashid);          ($suppcount,$cached) = &is_cached_new('suppcount',$hashid);
     }      }
     unless (defined($cached)) {      unless (defined($cached)) {
         my $chome=&homeserver($cnum,$cdom);          my $chome=&homeserver($cnum,$cdom);
         unless ($chome eq 'no_host') {          unless ($chome eq 'no_host') {
             my ($supplemental) = &Apache::loncommon::get_supplemental($cnum,$cdom,$ignorecache,$possdel);              ($suppcount,my $errors) = (0,0);
             if (ref($supplemental) eq 'HASH') {              my $suppmap = 'supplemental.sequence';
                 if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {              ($suppcount,$errors) =
                     foreach my $key (keys(%{$supplemental->{'ids'}})) {                  &Apache::loncommon::recurse_supplemental($cnum,$cdom,$suppmap,$suppcount,$errors);
                         next if ($key =~ /\.sequence$/);  
                         if (ref($supplemental->{'ids'}->{$key}) eq 'ARRAY') {  
                             foreach my $id (@{$supplemental->{'ids'}->{$key}}) {  
                                 unless ($supplemental->{'hidden'}->{$id}) {  
                                     $showsupp = 1;  
                                     last;  
                                 }  
                             }  
                         }  
                         last if ($showsupp);  
                     }  
                 }  
             }  
         }          }
         &do_cache_new('showsupp',$hashid,$showsupp,600);          &do_cache_new('suppcount',$hashid,$suppcount,600);
     }      }
     return $showsupp;      return $suppcount;
 }  }
   
 #  #
 # EXT resource caching routines  # EXT resource caching routines
 #  #
   
 {  
 # Cache (5 seconds) of map hierarchy for speedup of navmaps display  
 #  
 # The course for which we cache  
 my $cachedmapkey='';  
 # The cached recursive maps for this course  
 my %cachedmaps=();  
 # When this was last done  
 my $cachedmaptime='';  
   
 sub clear_EXT_cache_status {  sub clear_EXT_cache_status {
     &delenv('cache.EXT.');      &delenv('cache.EXT.');
 }  }
Line 12586  sub EXT { Line 11792  sub EXT {
  }   }
 # ------------------------------------------ fourth, look in resource metadata  # ------------------------------------------ fourth, look in resource metadata
   
         my $what = $spacequalifierrest;   $spacequalifierrest=~s/\./\_/;
         $what=~s/\./\_/;   my $filename;
         my $filename;  
  if (!$symbparm) { $symbparm=&symbread(); }   if (!$symbparm) { $symbparm=&symbread(); }
  if ($symbparm) {   if ($symbparm) {
     $filename=(&decode_symb($symbparm))[2];      $filename=(&decode_symb($symbparm))[2];
  } else {   } else {
     $filename=$env{'request.filename'};      $filename=$env{'request.filename'};
  }   }
         my $toolsymb;   my $metadata=&metadata($filename,$spacequalifierrest);
         if (($filename =~ /ext\.tool$/) && ($what ne '0_gradable')) {  
             $toolsymb = $symbparm;  
         }  
  my $metadata=&metadata($filename,$what,$toolsymb);  
  if (defined($metadata)) { return &get_reply([$metadata,'resource']); }   if (defined($metadata)) { return &get_reply([$metadata,'resource']); }
  $metadata=&metadata($filename,'parameter_'.$what,$toolsymb);   $metadata=&metadata($filename,'parameter_'.$spacequalifierrest);
  if (defined($metadata)) { return &get_reply([$metadata,'resource']); }   if (defined($metadata)) { return &get_reply([$metadata,'resource']); }
   
 # ----------------------------------------------- fifth, look in rest of course  # ---------------------------------------------- fourth, look in rest of course
  if ($symbparm && defined($courseid) &&    if ($symbparm && defined($courseid) && 
     $courseid eq $env{'request.course.id'}) {      $courseid eq $env{'request.course.id'}) {
     my $coursereply=&resdata($env{'course.'.$courseid.'.num'},      my $coursereply=&resdata($env{'course.'.$courseid.'.num'},
Line 12625  sub EXT { Line 11826  sub EXT {
     if (defined($partgeneral[0])) { return &get_reply(\@partgeneral); }      if (defined($partgeneral[0])) { return &get_reply(\@partgeneral); }
  }   }
  if ($recurse) { return undef; }   if ($recurse) { return undef; }
  my $pack_def=&packages_tab_default($filename,$varname,$toolsymb);   my $pack_def=&packages_tab_default($filename,$varname);
  if (defined($pack_def)) { return &get_reply([$pack_def,'resource']); }   if (defined($pack_def)) { return &get_reply([$pack_def,'resource']); }
 # ---------------------------------------------------- Any other user namespace  # ---------------------------------------------------- Any other user namespace
     } elsif ($realm eq 'environment') {      } elsif ($realm eq 'environment') {
Line 12650  sub EXT { Line 11851  sub EXT {
  if ($space eq 'name') {   if ($space eq 'name') {
     return $ENV{'SERVER_NAME'};      return $ENV{'SERVER_NAME'};
         }          }
     } elsif ($realm eq 'client') {  
         if ($space eq 'remote_addr') {  
             return &get_requestor_ip();  
         }  
     }      }
     return '';      return '';
 }  }
Line 12687  sub check_group_parms { Line 11884  sub check_group_parms {
     return $coursereply;      return $coursereply;
 }  }
   
 sub get_map_hierarchy {  
     my ($mapname,$courseid) = @_;  
     my @recurseup = ();  
     if ($mapname) {  
         if (($cachedmapkey eq $courseid) &&  
             (abs($cachedmaptime-time)<5)) {  
             if (ref($cachedmaps{$mapname}) eq 'ARRAY') {  
                 return @{$cachedmaps{$mapname}};  
             }  
         }  
         my $navmap = Apache::lonnavmaps::navmap->new();  
         if (ref($navmap)) {  
             @recurseup = $navmap->recurseup_maps($mapname);  
             undef($navmap);  
             $cachedmaps{$mapname} = \@recurseup;  
             $cachedmaptime=time;  
             $cachedmapkey=$courseid;  
         }  
     }  
     return @recurseup;  
 }  
   
 }  
   
 sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().  sub sort_course_groups { # Sort groups based on defined rankings. Default is sort().
     my ($courseid,@groups) = @_;      my ($courseid,@groups) = @_;
     @groups = sort(@groups);      @groups = sort(@groups);
Line 12718  sub sort_course_groups { # Sort groups b Line 11891  sub sort_course_groups { # Sort groups b
 }  }
   
 sub packages_tab_default {  sub packages_tab_default {
     my ($uri,$varname,$toolsymb)=@_;      my ($uri,$varname)=@_;
     my (undef,$part,$name)=split(/\./,$varname);      my (undef,$part,$name)=split(/\./,$varname);
   
     my (@extension,@specifics,$do_default);      my (@extension,@specifics,$do_default);
     foreach my $package (split(/,/,&metadata($uri,'packages',$toolsymb))) {      foreach my $package (split(/,/,&metadata($uri,'packages'))) {
  my ($pack_type,$pack_part)=split(/_/,$package,2);   my ($pack_type,$pack_part)=split(/_/,$package,2);
  if ($pack_type eq 'default') {   if ($pack_type eq 'default') {
     $do_default=1;      $do_default=1;
Line 12791  my %metaentry; Line 11964  my %metaentry;
 my %importedpartids;  my %importedpartids;
 my %importedrespids;  my %importedrespids;
 sub metadata {  sub metadata {
     my ($uri,$what,$toolsymb,$liburi,$prefix,$depthcount)=@_;      my ($uri,$what,$liburi,$prefix,$depthcount)=@_;
     $uri=&declutter($uri);      $uri=&declutter($uri);
     # 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 12815  sub metadata { Line 11988  sub metadata {
  my ($result,$cached)=&is_cached_new('meta',$uri);   my ($result,$cached)=&is_cached_new('meta',$uri);
  if (defined($cached)) { return $result->{':'.$what}; }   if (defined($cached)) { return $result->{':'.$what}; }
     }      }
   
 #  
 # If the uri is for an external tool the file from  
 # which metadata should be retrieved depends on whether  
 # the tool had been configured to be gradable (set in the Course  
 # Editor or Resource Editor).  
 #  
 # If a valid symb has been included as the third arg in the call  
 # to &metadata() that can be used to retrieve the value of  
 # parameter_0_gradable set for the resource, and included in the  
 # uploaded map containing the tool. The value is retrieved via  
 # &EXT(), if a valid symb is available.  Otherwise the value of  
 # gradable in the exttool_$marker.db file for the tool instance  
 # is retrieved via &get().  
 #  
 # When lonuserstate::traceroute() calls lonnet::EXT() for  
 # hiddenresource and encrypturl (during course initialization)  
 # the map-level parameter for resource.0.gradable included in the  
 # uploaded map containing the tool will not yet have been stored  
 # in the user_course_parms.db file for the user's session, so in  
 # this case fall back to retrieving gradable status from the  
 # exttool_$marker.db file.  
 #  
 # In order to avoid an infinite loop, &metadata() will return  
 # before a call to &EXT(), if the uri is for an external tool  
 # and the $what for which metadata is being requested is  
 # parameter_0_gradable or 0_gradable.  
 #  
   
     if ($uri =~ /ext\.tool$/) {  
         if (($what eq 'parameter_0_gradable') || ($what eq '0_gradable')) {  
             return;  
         } else {  
             my ($checked,$use_passback);  
             if ($toolsymb ne '') {  
                 (undef,undef,my $tooluri) = &decode_symb($toolsymb);  
                 if (($tooluri eq $uri) && (&EXT('resource.0.gradable',$toolsymb))) {  
                     $checked = 1;  
                     if (&EXT('resource.0.gradable',$toolsymb) =~ /^yes$/i) {  
                         $use_passback = 1;  
                     }  
                 }  
             }  
             unless ($checked) {  
                 my ($ignore,$cdom,$cnum,$marker) = split(m{/},$uri);  
                 $marker=~s/\D//g;  
                 if ($marker) {  
                     my %toolsettings=&get('exttool_'.$marker,['gradable'],$cdom,$cnum);  
                     $use_passback = $toolsettings{'gradable'};  
                 }  
             }  
             if ($use_passback) {  
                 $filename = '/home/httpd/html/res/lib/templates/LTIpassback.tool';  
             } else {  
                 $filename = '/home/httpd/html/res/lib/templates/LTIstandard.tool';  
             }  
         }  
     }  
   
     {      {
 # Imported parts would go here  # Imported parts would go here
         my @origfiletagids=();          my @origfiletagids=();
Line 13047  sub metadata { Line 12161  sub metadata {
   
  if ($depthcount<20) {   if ($depthcount<20) {
     my $metadata =       my $metadata = 
  &metadata($uri,'keys',$toolsymb,$location,$unikey,   &metadata($uri,'keys', $location,$unikey,
   $depthcount+1);    $depthcount+1);
     foreach my $meta (split(',',$metadata)) {      foreach my $meta (split(',',$metadata)) {
  $metaentry{':'.$meta}=$metaentry{':'.$meta};   $metaentry{':'.$meta}=$metaentry{':'.$meta};
Line 13122  sub metadata { Line 12236  sub metadata {
  $dir=~s|[^/]*$||;   $dir=~s|[^/]*$||;
  $location=&filelocation($dir,$location);   $location=&filelocation($dir,$location);
  my $rights_metadata =   my $rights_metadata =
     &metadata($uri,'keys',$toolsymb,$location,'_rights',      &metadata($uri,'keys',$location,'_rights',
       $depthcount+1);        $depthcount+1);
  foreach my $rights (split(',',$rights_metadata)) {   foreach my $rights (split(',',$rights_metadata)) {
     #$metaentry{':'.$rights}=$metacache{$uri}->{':'.$rights};      #$metaentry{':'.$rights}=$metacache{$uri}->{':'.$rights};
Line 13391  sub get_coursechange { Line 12505  sub get_coursechange {
 }  }
   
 sub devalidate_coursechange_cache {  sub devalidate_coursechange_cache {
     my ($cdom,$cnum)=@_;      my ($cnum,$cdom)=@_;
     my $hashid=$cdom.'_'.$cnum;      my $hashid=$cnum.':'.$cdom;
     &devalidate_cache_new('crschange',$hashid);      &devalidate_cache_new('crschange',$hashid);
 }  }
   
 sub get_suppchange {  
     my ($cdom,$cnum) = @_;  
     if ($cdom eq '' || $cnum eq '') {  
         return unless ($env{'request.course.id'});  
         $cnum = $env{'course.'.$env{'request.course.id'}.'.num'};  
         $cdom = $env{'course.'.$env{'request.course.id'}.'.domain'};  
     }  
     my $hashid=$cdom.'_'.$cnum;  
     my ($change,$cached)=&is_cached_new('suppchange',$hashid);  
     if ((defined($cached)) && ($change ne '')) {  
         return $change;  
     } else {  
         my %crshash = &get('environment',['internal.supplementalchange'],$cdom,$cnum);  
         if ($crshash{'internal.supplementalchange'} eq '') {  
             $change = $env{'course.'.$cdom.'_'.$cnum.'.internal.created'};  
             if ($change eq '') {  
                 %crshash = &get('environment',['internal.created'],$cdom,$cnum);  
                 $change = $crshash{'internal.created'};  
             }  
         } else {  
             $change = $crshash{'internal.supplementalchange'};  
         }  
         my $cachetime = 600;  
         &do_cache_new('suppchange',$hashid,$change,$cachetime);  
     }  
     return $change;  
 }  
   
 sub devalidate_suppchange_cache {  
     my ($cdom,$cnum)=@_;  
     my $hashid=$cdom.'_'.$cnum;  
     &devalidate_cache_new('suppchange',$hashid);  
 }  
   
 sub update_supp_caches {  
     my ($cdom,$cnum) = @_;  
     my %servers = &internet_dom_servers($cdom);  
     my @ids=&current_machine_ids();  
     foreach my $server (keys(%servers)) {  
         next if (grep(/^\Q$server\E$/,@ids));  
         my $hashid=$cnum.':'.$cdom;  
         my $cachekey = &escape('showsupp').':'.&escape($hashid);  
         &remote_devalidate_cache($server,[$cachekey]);  
     }  
     &has_unhidden_suppfiles($cnum,$cdom,1,1);  
     &count_supptools($cnum,$cdom,1);  
     my $now = time;  
     if ($env{'request.course.id'} eq $cdom.'_'.$cnum) {  
         &Apache::lonnet::appenv({'request.course.suppupdated' => $now});  
     }  
     &put('environment',{'internal.supplementalchange' => $now},  
          $cdom,$cnum);  
     &Apache::lonnet::appenv(  
         {'course.'.$cdom.'_'.$cnum.'.internal.supplementalchange' => $now});  
     &do_cache_new('suppchange',$cdom.'_'.$cnum,$now,600);  
 }  
   
 # ------------------------------------------------- Update symbolic store links  # ------------------------------------------------- Update symbolic store links
   
 sub symblist {  sub symblist {
Line 13639  sub symbread { Line 12696  sub symbread {
     my %bighash;      my %bighash;
     my $syval='';      my $syval='';
     if (($env{'request.course.fn'}) && ($thisfn)) {      if (($env{'request.course.fn'}) && ($thisfn)) {
           my $targetfn = $thisfn;
           if ( ($thisfn =~ m/^(uploaded|editupload)\//) && ($thisfn !~ m/\.(page|sequence)$/) ) {
               $targetfn = 'adm/wrapper/'.$thisfn;
           }
    if ($targetfn =~ m|^adm/wrapper/(ext/.*)|) {
       $targetfn=$1;
    }
         unless ($ignoresymbdb) {          unless ($ignoresymbdb) {
             if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',              if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
                           &GDBM_READER(),0640)) {                            &GDBM_READER(),0640)) {
         $syval=$hash{$thisfn};          $syval=$hash{$targetfn};
                 untie(%hash);                  untie(%hash);
             }              }
             if ($syval && $checkforblock) {              if ($syval && $checkforblock) {
Line 14814  sub clutter { Line 13878  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 15887  prevents recursive calls to &allowed. Line 14949  prevents recursive calls to &allowed.
  2: browse allowed   2: browse allowed
  A: passphrase authentication needed   A: passphrase authentication needed
  B: access temporarily blocked because of a blocking event in a course.   B: access temporarily blocked because of a blocking event in a course.
  D: access blocked because access is required via session initiated via deep-link  
   
 =item *  =item *
   
Line 16180  data base, returning a hash that is keye Line 15241  data base, returning a hash that is keye
 values that are the resource value.  I believe that the timestamps and  values that are the resource value.  I believe that the timestamps and
 versions are also returned.  versions are also returned.
   
   get_numsuppfiles($cnum,$cdom) : retrieve number of files in a course's
   supplemental content area. This routine caches the number of files for
   10 minutes.
   
 =back  =back
   
 =head2 Course Modification  =head2 Course Modification
Line 16347  condval($condidx) : value of condition i Line 15412  condval($condidx) : value of condition i
   
 =item *  =item *
   
 metadata($uri,$what,$toolsymb,$liburi,$prefix,$depthcount) : request a  metadata($uri,$what,$liburi,$prefix,$depthcount) : request a
 resource's metadata, $what should be either a specific key, or either  resource's metadata, $what should be either a specific key, or either
 'keys' (to get a list of possible keys) or 'packages' to get a list of  'keys' (to get a list of possible keys) or 'packages' to get a list of
 packages that this resource currently uses, the last 3 arguments are  packages that this resource currently uses, the last 3 arguments are only used internally for recursive metadata.
 only used internally for recursive metadata.  
   
 the toolsymb is only used where the uri is for an external tool (for which  
 the uri as well as the symb are guaranteed to be unique).  
   
 this function automatically caches all requests  this function automatically caches all requests
   
Removed from v.1.1172.2.146.2.20  
changed lines
  Added in v.1.1172.2.147

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