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