--- loncom/lonnet/perl/lonnet.pm 2022/06/08 01:42:20 1.1486
+++ loncom/lonnet/perl/lonnet.pm 2023/04/11 20:35:19 1.1508
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1486 2022/06/08 01:42:20 raeburn Exp $
+# $Id: lonnet.pm,v 1.1508 2023/04/11 20:35:19 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -985,9 +985,9 @@ sub spareserver {
: $userloadpercent;
my ($uint_dom,$remotesessions);
if (($udom ne '') && (&domain($udom) ne '')) {
- my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
- $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
- my %udomdefaults = &Apache::lonnet::get_domain_defaults($udom);
+ my $uprimary_id = &domain($udom,'primary');
+ $uint_dom = &internet_dom($uprimary_id);
+ my %udomdefaults = &get_domain_defaults($udom);
$remotesessions = $udomdefaults{'remotesessions'};
}
my $spareshash = &this_host_spares($udom);
@@ -1023,7 +1023,7 @@ sub spareserver {
if ($protocol{$spare_server} eq 'https') {
$protocol = $protocol{$spare_server};
}
- my $alias = &Apache::lonnet::use_proxy_alias($r,$spare_server);
+ my $alias = &use_proxy_alias($r,$spare_server);
$hostname = $alias if ($alias ne '');
$spare_server = $protocol.'://'.$hostname;
}
@@ -1211,7 +1211,7 @@ sub choose_server {
unless (defined($cached)) {
my $cachetime = 60*60*24;
my %domconfig =
- &Apache::lonnet::get_dom('configuration',['loadbalancing'],$udom);
+ &get_dom('configuration',['loadbalancing'],$udom);
if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
$balancers = &do_cache_new('loadbalancing',$udom,$domconfig{'loadbalancing'},
$cachetime);
@@ -1378,10 +1378,33 @@ sub authenticate {
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 {
my ($udom,$lonhost,$remoterev,$remotesessions,$hostedsessions) = @_;
my $canhost = 1;
- my $host_idn = &Apache::lonnet::internet_dom($lonhost);
+ my $host_idn = &internet_dom($lonhost);
if (ref($remotesessions) eq 'HASH') {
if (ref($remotesessions->{'excludedomain'}) eq 'ARRAY') {
if (grep(/^\Q$host_idn\E$/,@{$remotesessions->{'excludedomain'}})) {
@@ -1417,8 +1440,8 @@ sub can_host_session {
}
if ($canhost) {
if (ref($hostedsessions) eq 'HASH') {
- my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
- my $uint_dom = &Apache::lonnet::internet_dom($uprimary_id);
+ my $uprimary_id = &domain($udom,'primary');
+ my $uint_dom = &internet_dom($uprimary_id);
if (ref($hostedsessions->{'excludedomain'}) eq 'ARRAY') {
if (($uint_dom ne '') &&
(grep(/^\Q$uint_dom\E$/,@{$hostedsessions->{'excludedomain'}}))) {
@@ -1510,7 +1533,7 @@ sub spares_for_offload {
} else {
my $cachetime = 60*60*24;
my %domconfig =
- &Apache::lonnet::get_dom('configuration',['usersessions'],$dom_in_use);
+ &get_dom('configuration',['usersessions'],$dom_in_use);
if (ref($domconfig{'usersessions'}) eq 'HASH') {
if (ref($domconfig{'usersessions'}{'spares'}) eq 'HASH') {
if (ref($domconfig{'usersessions'}{'spares'}{$lonhost_in_use}) eq 'HASH') {
@@ -1562,9 +1585,9 @@ sub check_loadbalancing {
$rule_in_effect,$offloadto,$otherserver,$setcookie,$dom_balancers);
my $lonhost = $perlvar{'lonHostID'};
my @hosts = ¤t_machine_ids();
- my $uprimary_id = &Apache::lonnet::domain($udom,'primary');
- my $uintdom = &Apache::lonnet::internet_dom($uprimary_id);
- my $intdom = &Apache::lonnet::internet_dom($lonhost);
+ my $uprimary_id = &domain($udom,'primary');
+ my $uintdom = &internet_dom($uprimary_id);
+ my $intdom = &internet_dom($lonhost);
my $serverhomedom = &host_domain($lonhost);
my $domneedscache;
my $cachetime = 60*60*24;
@@ -1578,7 +1601,7 @@ sub check_loadbalancing {
my ($result,$cached)=&is_cached_new('loadbalancing',$dom_in_use);
unless (defined($cached)) {
my %domconfig =
- &Apache::lonnet::get_dom('configuration',['loadbalancing'],$dom_in_use);
+ &get_dom('configuration',['loadbalancing'],$dom_in_use);
if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
$result = &do_cache_new('loadbalancing',$dom_in_use,$domconfig{'loadbalancing'},$cachetime);
} else {
@@ -1639,7 +1662,7 @@ sub check_loadbalancing {
($result,$cached)=&is_cached_new('loadbalancing',$serverhomedom);
unless (defined($cached)) {
my %domconfig =
- &Apache::lonnet::get_dom('configuration',['loadbalancing'],$serverhomedom);
+ &get_dom('configuration',['loadbalancing'],$serverhomedom);
if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
$result = &do_cache_new('loadbalancing',$serverhomedom,$domconfig{'loadbalancing'},$cachetime);
} else {
@@ -1772,7 +1795,7 @@ sub get_loadbalancer_targets {
}
} elsif ($rule_in_effect eq 'externalbalancer') {
my %domconfig =
- &Apache::lonnet::get_dom('configuration',['loadbalancing'],$udom);
+ &get_dom('configuration',['loadbalancing'],$udom);
if (ref($domconfig{'loadbalancing'}) eq 'HASH') {
if ($domconfig{'loadbalancing'}{'lonhost'} ne '') {
if (&hostname($domconfig{'loadbalancing'}{'lonhost'}) ne '') {
@@ -1836,15 +1859,15 @@ sub trusted_domains {
return ($trusted,$untrusted);
}
my $callprimary = &domain($calldom,'primary');
- my $intcalldom = &Apache::lonnet::internet_dom($callprimary);
+ my $intcalldom = &internet_dom($callprimary);
if ($intcalldom eq '') {
return ($trusted,$untrusted);
}
- my ($trustconfig,$cached)=&Apache::lonnet::is_cached_new('trust',$calldom);
+ my ($trustconfig,$cached)=&is_cached_new('trust',$calldom);
unless (defined($cached)) {
- my %domconfig = &Apache::lonnet::get_dom('configuration',['trust'],$calldom);
- &Apache::lonnet::do_cache_new('trust',$calldom,$domconfig{'trust'},3600);
+ my %domconfig = &get_dom('configuration',['trust'],$calldom);
+ &do_cache_new('trust',$calldom,$domconfig{'trust'},3600);
$trustconfig = $domconfig{'trust'};
}
if (ref($trustconfig)) {
@@ -2322,7 +2345,7 @@ sub get_domainconfiguser {
sub retrieve_inst_usertypes {
my ($udom) = @_;
my (%returnhash,@order);
- my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
+ my %domdefs = &get_domain_defaults($udom);
if ((ref($domdefs{'inststatustypes'}) eq 'HASH') &&
(ref($domdefs{'inststatusorder'}) eq 'ARRAY')) {
return ($domdefs{'inststatustypes'},$domdefs{'inststatusorder'});
@@ -2670,12 +2693,14 @@ sub get_domain_defaults {
}
my %domdefaults;
my %domconfig =
- &Apache::lonnet::get_dom('configuration',['defaults','quotas',
+ &get_dom('configuration',['defaults','quotas',
'requestcourses','inststatus',
'coursedefaults','usersessions',
'requestauthor','selfenrollment',
'coursecategories','ssl','autoenroll',
- 'trust','helpsettings','wafproxy','ltisec'],$domain);
+ 'trust','helpsettings','wafproxy',
+ 'ltisec','toolsec','domexttool',
+ 'exttool',],$domain);
my @coursetypes = ('official','unofficial','community','textbook','placement');
if (ref($domconfig{'defaults'}) eq 'HASH') {
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};
@@ -2684,6 +2709,8 @@ sub get_domain_defaults {
$domdefaults{'timezone_def'} = $domconfig{'defaults'}{'timezone_def'};
$domdefaults{'datelocale_def'} = $domconfig{'defaults'}{'datelocale_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_switch'} = $domconfig{'defaults'}{'intauth_switch'};
$domdefaults{'intauth_check'} = $domconfig{'defaults'}{'intauth_check'};
@@ -2745,6 +2772,16 @@ sub get_domain_defaults {
$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'}{'instcode'}) eq 'ARRAY') {
@@ -2859,7 +2896,18 @@ sub get_domain_defaults {
}
if (ref($domconfig{'ltisec'}{'private'}) eq 'HASH') {
if (ref($domconfig{'ltisec'}{'private'}{'keys'}) eq 'ARRAY') {
- $domdefaults{'privhosts'} = $domconfig{'ltisec'}{'private'}{'keys'};
+ $domdefaults{'ltiprivhosts'} = $domconfig{'ltisec'}{'private'}{'keys'};
+ }
+ }
+ }
+ 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'};
}
}
}
@@ -2882,7 +2930,7 @@ sub get_dom_cats {
} else {
$cats = {};
}
- &Apache::lonnet::do_cache_new('cats',$dom,$cats,3600);
+ &do_cache_new('cats',$dom,$cats,3600);
}
return $cats;
}
@@ -2899,6 +2947,7 @@ sub get_dom_instcats {
if (&auto_instcode_format($caller,$dom,\%coursecodes,\%codes,
\@codetitles,\%cat_titles,\%cat_order) eq 'ok') {
$instcats = {
+ totcodes => $totcodes,
codes => \%codes,
codetitles => \@codetitles,
cat_titles => \%cat_titles,
@@ -2937,13 +2986,33 @@ sub course_portal_url {
if ($domdefaults{'portal_def'}) {
$firsturl = $domdefaults{'portal_def'};
} else {
- my $alias = &Apache::lonnet::use_proxy_alias($r,$chome);
+ my $alias = &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;
+}
+
# --------------------------------------------- Get domain config for passwords
sub get_passwdconf {
@@ -3115,7 +3184,7 @@ sub courseid_to_courseurl {
return "/$cdom/$cnum";
}
- my %courseinfo=&Apache::lonnet::coursedescription($courseid);
+ my %courseinfo=&coursedescription($courseid);
if (exists($courseinfo{'num'})) {
return "/$courseinfo{'domain'}/$courseinfo{'num'}";
}
@@ -3313,14 +3382,14 @@ sub userenvironment {
# ---------------------------------------------------------- Get a studentphoto
sub studentphoto {
my ($udom,$unam,$ext) = @_;
- my $home=&Apache::lonnet::homeserver($unam,$udom);
+ my $home=&homeserver($unam,$udom);
if (defined($env{'request.course.id'})) {
if ($env{'course.'.$env{'request.course.id'}.'.internal.showphoto'}) {
if ($udom eq $env{'course.'.$env{'request.course.id'}.'.domain'}) {
return(&retrievestudentphoto($udom,$unam,$ext));
} else {
my ($result,$perm_reqd)=
- &Apache::lonnet::auto_photo_permission($unam,$udom);
+ &auto_photo_permission($unam,$udom);
if ($result eq 'ok') {
if (!($perm_reqd eq 'yes')) {
return(&retrievestudentphoto($udom,$unam,$ext));
@@ -3330,7 +3399,7 @@ sub studentphoto {
}
} else {
my ($result,$perm_reqd) =
- &Apache::lonnet::auto_photo_permission($unam,$udom);
+ &auto_photo_permission($unam,$udom);
if ($result eq 'ok') {
if (!($perm_reqd eq 'yes')) {
return(&retrievestudentphoto($udom,$unam,$ext));
@@ -3342,14 +3411,14 @@ sub studentphoto {
sub retrievestudentphoto {
my ($udom,$unam,$ext,$type) = @_;
- my $home=&Apache::lonnet::homeserver($unam,$udom);
- my $ret=&Apache::lonnet::reply("studentphoto:$udom:$unam:$ext:$type",$home);
+ my $home=&homeserver($unam,$udom);
+ my $ret=&reply("studentphoto:$udom:$unam:$ext:$type",$home);
if ($ret eq 'ok') {
my $url="/uploaded/$udom/$unam/internal/studentphoto.$ext";
if ($type eq 'thumbnail') {
$url="/uploaded/$udom/$unam/internal/studentphoto_tn.$ext";
}
- my $tokenurl=&Apache::lonnet::tokenwrapper($url);
+ my $tokenurl=&tokenwrapper($url);
return $tokenurl;
} else {
if ($type eq 'thumbnail') {
@@ -3626,8 +3695,8 @@ sub ssi {
($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'}:'')))) {
+ (&allowed('mgr',$env{'request.course.id'}.
+ ($env{'request.course.sec'}?'/'.$env{'request.course.sec'}:'')))) {
$islocal = 1;
}
$response= &LONCAPA::LWPReq::makerequest($lonhost,$request,'',\%perlvar,
@@ -3778,7 +3847,7 @@ sub can_edit_resource {
}
if ($env{'request.course.id'}) {
- my $crsedit = &Apache::lonnet::allowed('mdc',$env{'request.course.id'});
+ my $crsedit = &allowed('mdc',$env{'request.course.id'});
if ($group ne '') {
# if this is a group homepage or group bulletin board, check group privs
my $allowed = 0;
@@ -3807,14 +3876,19 @@ sub can_edit_resource {
}
} else {
if ($resurl =~ m{^/?adm/viewclasslist$}) {
- unless (&Apache::lonnet::allowed('opa',$env{'request.course.id'})) {
+ unless (&allowed('opa',$env{'request.course.id'})) {
return;
}
} elsif (!$crsedit) {
+ if ($env{'request.role'} =~ m{^st\./$cdom/$cnum}) {
#
# No edit allowed where CC has switched to student role.
#
- return;
+ return;
+ } elsif (($resurl !~ m{^/res/$match_domain/$match_username/}) ||
+ ($resurl =~ m{^/res/lib/templates/})) {
+ return;
+ }
}
}
}
@@ -3840,7 +3914,7 @@ sub can_edit_resource {
$forceedit = 1;
}
$cfile = $resurl;
- } elsif (($resurl ne '') && (&is_on_map($resurl))) {
+ } elsif (($resurl ne '') && (&is_on_map($resurl))) {
if ($resurl =~ m{^/adm/$match_domain/$match_username/\d+/smppg|bulletinboard$}) {
$incourse = 1;
if ($env{'form.forceedit'}) {
@@ -4223,7 +4297,7 @@ sub resizeImage {
# input: $formname - the contents of the file are in $env{"form.$formname"}
# the desired filename is in $env{"form.$formname.filename"}
# $context - possible values: coursedoc, existingfile, overwrite,
-# canceloverwrite, scantron or ''.
+# canceloverwrite, scantron, toollogo or ''.
# if 'coursedoc': upload to the current course
# if 'existingfile': write file to tmp/overwrites directory
# if 'canceloverwrite': delete file written to tmp/overwrites directory
@@ -4235,8 +4309,8 @@ sub resizeImage {
# Section => 4, CODE => 5, FirstQuestion => 9 }).
# $allfiles - reference to hash for embedded objects
# $codebase - reference to hash for codebase of java objects
-# $desuname - username for permanent storage of uploaded file
-# $dsetudom - domain for permanaent storage of uploaded file
+# $destuname - username for permanent storage of uploaded file
+# $destudom - domain for permanaent storage of uploaded file
# $thumbwidth - width (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
@@ -4446,11 +4520,24 @@ sub finishuserfileupload {
if (($thumbwidth =~ /^\d+$/) && ($thumbheight =~ /^\d+$/)) {
my $input = $filepath.'/'.$file;
my $output = $filepath.'/'.'tn-'.$file;
+ my $makethumb;
my $thumbsize = $thumbwidth.'x'.$thumbheight;
- my @args = ('convert','-sample',$thumbsize,$input,$output);
- system({$args[0]} @args);
- if (-e $filepath.'/'.'tn-'.$file) {
- $fetchthumb = 1;
+ if ($context eq 'toollogo') {
+ my ($fullwidth,$fullheight) = &check_dimensions($input);
+ if ($fullwidth ne '' && $fullheight ne '') {
+ if ($fullwidth > $thumbwidth && $fullheight > $thumbheight) {
+ $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;
+ }
}
}
@@ -4682,6 +4769,30 @@ sub embedded_dependency {
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 {
my ($cdom,$fullpath,$config,$format) = @_;
if ((&domain($cdom) ne '') &&
@@ -4918,6 +5029,7 @@ sub get_scantronformat_file {
close($fh);
}
}
+ chomp(@lines);
}
return @lines;
}
@@ -5088,7 +5200,7 @@ sub flushcourselogs {
foreach my $entry (keys(%userrolehash)) {
my ($role,$uname,$udom,$runame,$rudom,$rsec)=
split(/\:/,$entry);
- if (&Apache::lonnet::put('nohist_userroles',
+ if (&put('nohist_userroles',
{ $role.':'.$uname.':'.$udom.':'.$rsec => $userrolehash{$entry} },
$rudom,$runame) eq 'ok') {
delete $userrolehash{$entry};
@@ -5287,7 +5399,7 @@ sub domainrolelog {
my ($trole,$username,$domain,$area,$tstart,$tend,$delflag,$context)=@_;
if ($area =~ m{^/($match_domain)/$}) {
my $cdom = $1;
- my $domconfiguser = &Apache::lonnet::get_domainconfiguser($cdom);
+ my $domconfiguser = &get_domainconfiguser($cdom);
my $namespace = 'rolelog';
my %storehash = (
role => $trole,
@@ -5518,8 +5630,8 @@ sub get_my_adhocroles {
} elsif ($cid =~ /^($match_domain)_($match_courseid)$/) {
$cdom = $1;
$cnum = $2;
- %info = &Apache::lonnet::get('environment',['internal.coursecode'],
- $cdom,$cnum);
+ %info = &get('environment',['internal.coursecode'],
+ $cdom,$cnum);
}
if (($info{'internal.coursecode'} ne '') && ($checkreg)) {
my $user = $env{'user.name'}.':'.$env{'user.domain'};
@@ -5846,7 +5958,7 @@ sub extract_lastaccess {
sub dcmailput {
my ($domain,$msgid,$message,$server)=@_;
- my $status = &Apache::lonnet::critical(
+ my $status = &critical(
'dcmailput:'.$domain.':'.&escape($msgid).'='.
&escape($message),$server);
return $status;
@@ -6848,31 +6960,31 @@ sub course_adhocrole_privs {
$full{$priv} = $restrict;
}
foreach my $item (split(/,/,$overrides{"internal.adhocpriv.$rolename"})) {
- next if ($item eq '');
- my ($rule,$rest) = split(/=/,$item);
- next unless (($rule eq 'off') || ($rule eq 'on'));
- foreach my $priv (split(/:/,$rest)) {
- if ($priv ne '') {
- if ($rule eq 'off') {
- $possremove{$priv} = 1;
- } else {
- $possadd{$priv} = 1;
- }
- }
- }
- }
- foreach my $priv (sort(keys(%full))) {
- if (exists($currprivs{$priv})) {
- unless (exists($possremove{$priv})) {
- $storeprivs{$priv} = $currprivs{$priv};
- }
- } elsif (exists($possadd{$priv})) {
- $storeprivs{$priv} = $full{$priv};
- }
- }
- $coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs)));
- }
- return $coursepriv;
+ next if ($item eq '');
+ my ($rule,$rest) = split(/=/,$item);
+ next unless (($rule eq 'off') || ($rule eq 'on'));
+ foreach my $priv (split(/:/,$rest)) {
+ if ($priv ne '') {
+ if ($rule eq 'off') {
+ $possremove{$priv} = 1;
+ } else {
+ $possadd{$priv} = 1;
+ }
+ }
+ }
+ }
+ foreach my $priv (sort(keys(%full))) {
+ if (exists($currprivs{$priv})) {
+ unless (exists($possremove{$priv})) {
+ $storeprivs{$priv} = $currprivs{$priv};
+ }
+ } elsif (exists($possadd{$priv})) {
+ $storeprivs{$priv} = $full{$priv};
+ }
+ }
+ $coursepriv = ':'.join(':',map { $_.'&'.$storeprivs{$_}; } sort(keys(%storeprivs)));
+ }
+ return $coursepriv;
}
sub group_roleprivs {
@@ -7439,7 +7551,7 @@ sub putstore {
'&host='.&escape($perlvar{'lonHostID'}).
'&version='.$esc_v.
'&by='.&escape($env{'user.name'}.':'.$env{'user.domain'});
- &Apache::lonnet::courselog($symb.':'.$uname.':'.$udomain.':PUTSTORE:'.$namevalue);
+ &courselog($symb.':'.$uname.':'.$udomain.':PUTSTORE:'.$namevalue);
}
if ($reply eq 'unknown_cmd') {
# gfall back to way things use to be done
@@ -7589,16 +7701,16 @@ sub get_timebased_id {
my $tries = 0;
# attempt to get lock on nohist_$namespace file
- my $gotlock = &Apache::lonnet::newput('nohist_'.$namespace,$lockhash,$cdom,$cnum);
+ my $gotlock = &newput('nohist_'.$namespace,$lockhash,$cdom,$cnum);
while (($gotlock ne 'ok') && $tries <$locktries) {
$tries ++;
sleep 1;
- $gotlock = &Apache::lonnet::newput('nohist_'.$namespace,$lockhash,$cdom,$cnum);
+ $gotlock = &newput('nohist_'.$namespace,$lockhash,$cdom,$cnum);
}
# attempt to get unique identifier, based on current timestamp
if ($gotlock eq 'ok') {
- my %inuse = &Apache::lonnet::dump('nohist_'.$namespace,$cdom,$cnum,$prefix);
+ my %inuse = &dump('nohist_'.$namespace,$cdom,$cnum,$prefix);
my $id = time;
$newid = $id;
if ($idtype eq 'addcode') {
@@ -7619,7 +7731,7 @@ sub get_timebased_id {
my %new_item = (
$prefix."\0".$newid => $who,
);
- my $putresult = &Apache::lonnet::put('nohist_'.$namespace,\%new_item,
+ my $putresult = &put('nohist_'.$namespace,\%new_item,
$cdom,$cnum);
if ($putresult ne 'ok') {
undef($newid);
@@ -7908,6 +8020,17 @@ sub is_portfolio_file {
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 {
my ($uname,$udom,$tool,$action,$context,$userenvref,$domdefref,$is_advref)=@_;
my ($access,%tools);
@@ -7933,6 +8056,7 @@ sub usertools_access {
blog => 1,
webdav => 1,
portfolio => 1,
+ timezone => 1,
);
}
return if (!defined($tools{$tool}));
@@ -8057,7 +8181,7 @@ sub is_course_owner {
if ($env{'course.'.$cdom.'_'.$cnum.'.internal.courseowner'} eq $uname.':'.$udom) {
return 1;
} else {
- my %courseinfo = &Apache::lonnet::coursedescription($cdom.'/'.$cnum);
+ my %courseinfo = &coursedescription($cdom.'/'.$cnum);
if ($courseinfo{'internal.courseowner'} eq $uname.':'.$udom) {
return 1;
}
@@ -8535,6 +8659,12 @@ sub allowed {
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 ($priv eq 'mip') {
@@ -8855,13 +8985,8 @@ sub constructaccess {
if (exists($env{'user.priv.au./'.$ownerdomain.'/./'})) {
return ($ownername,$ownerdomain,$ownerhome);
}
- } else {
-# Co-author for this?
- if (exists($env{'user.priv.ca./'.$ownerdomain.'/'.$ownername.'./'}) ||
- exists($env{'user.priv.aa./'.$ownerdomain.'/'.$ownername.'./'}) ) {
- $ownerhome = &homeserver($ownername,$ownerdomain);
- return ($ownername,$ownerdomain,$ownerhome);
- }
+ } elsif (&is_course($ownerdomain,$ownername)) {
+# Course Authoring Space?
if ($env{'request.course.id'}) {
if (($ownername eq $env{'course.'.$env{'request.course.id'}.'.num'}) &&
($ownerdomain eq $env{'course.'.$env{'request.course.id'}.'.domain'})) {
@@ -8871,6 +8996,14 @@ sub constructaccess {
}
}
}
+ return '';
+ } else {
+# Co-author for this?
+ if (exists($env{'user.priv.ca./'.$ownerdomain.'/'.$ownername.'./'}) ||
+ exists($env{'user.priv.aa./'.$ownerdomain.'/'.$ownername.'./'}) ) {
+ $ownerhome = &homeserver($ownername,$ownerdomain);
+ return ($ownername,$ownerdomain,$ownerhome);
+ }
}
# We don't have any access right now. If we are not possibly going to do anything about this,
@@ -8949,7 +9082,7 @@ sub get_comm_blocks {
if ((defined($cached)) && (ref($blocksref) eq 'HASH')) {
%commblocks = %{$blocksref};
} else {
- %commblocks = &Apache::lonnet::dump('comm_block',$cdom,$cnum);
+ %commblocks = &dump('comm_block',$cdom,$cnum);
my $cachetime = 600;
&do_cache_new('comm_block',$hashid,\%commblocks,$cachetime);
}
@@ -10286,7 +10419,7 @@ sub assignrole {
if ($role =~ /^cr\//) {
my $cwosec=$url;
$cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/;
- unless (&allowed('ccr',$cwosec)) {
+ if ((!&allowed('ccr',$cwosec)) && (!&allowed('ccr',$udom))) {
my $refused = 1;
if ($context eq 'requestcourses') {
if (($env{'user.name'} ne '') && ($env{'user.domain'} ne '')) {
@@ -10575,10 +10708,10 @@ sub store_coowners {
}
if (($putresult eq 'ok') || ($delresult eq 'ok')) {
my %crsinfo =
- &Apache::lonnet::courseiddump($cdom,'.',1,'.','.',$cnum,undef,undef,'.');
+ &courseiddump($cdom,'.',1,'.','.',$cnum,undef,undef,'.');
if (ref($crsinfo{$cid}) eq 'HASH') {
$crsinfo{$cid}{'co-owners'} = \@newcoowners;
- my $cidput = &Apache::lonnet::courseidput($cdom,\%crsinfo,$chome,'notime');
+ my $cidput = &courseidput($cdom,\%crsinfo,$chome,'notime');
}
}
}
@@ -10796,7 +10929,7 @@ sub modifyuser {
return 'error: '.$reply;
}
if ($names{'permanentemail'} ne $oldnames{'permanentemail'}) {
- &Apache::lonnet::devalidate_cache_new('emailscache',$uname.':'.$udom);
+ &devalidate_cache_new('emailscache',$uname.':'.$udom);
}
my $sqlresult = &update_allusers_table($uname,$udom,\%names);
&devalidate_cache_new('namescache',$uname.':'.$udom);
@@ -10876,7 +11009,7 @@ sub modify_student_enrollment {
}
my $fullname = &format_name($first,$middle,$last,$gene,'lastname');
my $user = "$uname:$udom";
- my %old_entry = &Apache::lonnet::get('classlist',[$user],$cdom,$cnum);
+ my %old_entry = &get('classlist',[$user],$cdom,$cnum);
my $reply=cput('classlist',
{$user =>
join(':',$end,$start,$uid,$usec,$fullname,$type,$locktype,$credits,$instsec) },
@@ -11010,7 +11143,7 @@ sub createcourse {
}
}
my %host_servers =
- &Apache::lonnet::get_servers($udom,'library');
+ &get_servers($udom,'library');
unless ($host_servers{$course_server}) {
return 'error: invalid home server for course: '.$course_server;
}
@@ -11978,14 +12111,20 @@ sub stat_file {
# or corresponding Published Resource Space, and populate the hash ref:
# $dirhashref with URLs of all directories, and if $filehashref hash
# ref arg is provided, the URLs of any files, excluding versioned, .meta,
-# or .rights files in resource space, and .meta, .save, .log, and .bak
-# files in Authoring Space.
+# or .rights files in resource space, and .meta, .save, .log, .bak and
+# .rights files in Authoring Space.
#
# Inputs:
#
# $is_home - true if current server is home server for user's space
-# $context - either: priv, or res respectively for Authoring or Resource Space.
-# $docroot - Document root (i.e., /home/httpd/html
+# $recurse - if true will also traverse subdirectories recursively
+# $include - reference to hash containing allowed file extensions. If provided,
+# files which do not have a matching extension will be ignored.
+# $exclude - reference to hash containing excluded file extensions. If provided,
+# files which have a matching extension will be ignored.
+# $nonemptydir - if true, will only populate $fileshashref hash entry for a particular
+# directory with first file found (with acceptable extension).
+# $addtopdir - if true, set $dirhashref->{'/'} = 1
# $toppath - Top level directory (i.e., /res/$dom/$uname or /priv/$dom/$uname
# $relpath - Current path (relative to top level).
# $dirhashref - reference to hash to populate with URLs of directories (Required)
@@ -12002,39 +12141,61 @@ sub stat_file {
#
sub recursedirs {
- my ($is_home,$context,$docroot,$toppath,$relpath,$dirhashref,$filehashref) = @_;
+ my ($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$relpath,$dirhashref,$filehashref) = @_;
return unless (ref($dirhashref) eq 'HASH');
+ my $docroot = $perlvar{'lonDocRoot'};
my $currpath = $docroot.$toppath;
- if ($relpath) {
+ if ($relpath ne '') {
$currpath .= "/$relpath";
}
- my $savefile;
+ my ($savefile,$checkinc,$checkexc);
if (ref($filehashref)) {
$savefile = 1;
}
+ if (ref($include) eq 'HASH') {
+ $checkinc = 1;
+ }
+ if (ref($exclude) eq 'HASH') {
+ $checkexc = 1;
+ }
if ($is_home) {
- if (opendir(my $dirh,$currpath)) {
+ if ((-e $currpath) && (opendir(my $dirh,$currpath))) {
+ my $filecount = 0;
foreach my $item (sort { lc($a) cmp lc($b) } grep(!/^\.+$/,readdir($dirh))) {
next if ($item eq '');
if (-d "$currpath/$item") {
my $newpath;
- if ($relpath) {
+ if ($relpath ne '') {
$newpath = "$relpath/$item";
} else {
$newpath = $item;
}
$dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1;
- &recursedirs($is_home,$context,$docroot,$toppath,$newpath,$dirhashref,$filehashref);
- } elsif ($savefile) {
- if ($context eq 'priv') {
- unless ($item =~ /\.(meta|save|log|bak|DS_Store)$/) {
- $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1;
+ if ($recurse) {
+ &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$newpath,$dirhashref,$filehashref);
+ }
+ } elsif (($savefile) || ($relpath eq '')) {
+ next if ($nonemptydir && $filecount);
+ if ($checkinc || $checkexc) {
+ my ($extension) = ($item =~ /\.(\w+)$/);
+ if ($checkinc) {
+ next unless ($extension && $include->{$extension});
}
- } else {
- unless (($item =~ /\.meta$/) || ($item =~ /\.\d+\.\w+$/) || ($item =~ /\.rights$/)) {
+ if ($checkexc) {
+ next if ($extension && $exclude->{$extension});
+ }
+ }
+ if (($relpath eq '') && (!exists($dirhashref->{'/'}))) {
+ $dirhashref->{'/'} = 1;
+ }
+ if ($savefile) {
+ if ($relpath eq '') {
+ $filehashref->{'/'}{$item} = 1;
+ } else {
$filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1;
}
}
+ $filecount ++;
}
}
closedir($dirh);
@@ -12045,6 +12206,7 @@ sub recursedirs {
my @dir_lines;
my $dirptr=16384;
if (ref($dirlistref) eq 'ARRAY') {
+ my $filecount = 0;
foreach my $dir_line (sort
{
my ($afile)=split('&',$a,2);
@@ -12060,28 +12222,57 @@ sub recursedirs {
if ($relpath) {
$newpath = "$relpath/$item";
} else {
- $relpath = '/';
$newpath = $item;
}
$dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1;
- &recursedirs($is_home,$context,$docroot,$toppath,$newpath,$dirhashref,$filehashref);
- } elsif ($savefile) {
- if ($context eq 'priv') {
- unless ($item =~ /\.(meta|save|log|bak|DS_Store)$/) {
- $filehashref->{$relpath}{$item} = 1;
+ if ($recurse) {
+ &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$newpath,$dirhashref,$filehashref);
+ }
+ } elsif (($savefile) || ($relpath eq '')) {
+ next if ($nonemptydir && $filecount);
+ if ($checkinc || $checkexc) {
+ my $extension;
+ if ($checkinc) {
+ next unless ($extension && $include->{$extension});
}
- } else {
- unless (($item =~ /\.meta$/) || ($item =~ /\.\d+\.\w+$/)) {
- $filehashref->{$relpath}{$item} = 1;
+ if ($checkexc) {
+ next if ($extension && $exclude->{$extension});
+ }
+ }
+ if (($relpath eq '') && (!exists($dirhashref->{'/'}))) {
+ $dirhashref->{'/'} = 1;
+ }
+ if ($savefile) {
+ if ($relpath eq '') {
+ $filehashref->{'/'}{$item} = 1;
+ } else {
+ $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1;
}
}
+ $filecount ++;
}
}
}
}
+ if ($addtopdir) {
+ if (($relpath eq '') && (!exists($dirhashref->{'/'}))) {
+ $dirhashref->{'/'} = 1;
+ }
+ }
return;
}
+sub priv_exclude {
+ return {
+ meta => 1,
+ save => 1,
+ log => 1,
+ bak => 1,
+ rights => 1,
+ DS_Store => 1,
+ };
+}
+
# -------------------------------------------------------- Value of a Condition
# gets the value of a specific preevaluated condition
@@ -12369,7 +12560,6 @@ sub courselti_itemid {
$chome = &homeserver($cnum,$cdom);
return if ($chome eq 'no_host');
if (ref($params) eq 'HASH') {
- my $items = &freeze_escape($params);
my $rep;
if (grep { $_ eq $chome } current_machine_ids()) {
$rep = LONCAPA::Lond::crslti_itemid($cdom,$cnum,$url,$method,$params,$perlvar{'lonVersion'});
@@ -12393,7 +12583,6 @@ sub domainlti_itemid {
$primary_id = &domain($cdom,'primary');
return if ($primary_id eq '');
if (ref($params) eq 'HASH') {
- my $items = &freeze_escape($params);
my $rep;
if (grep { $_ eq $primary_id } current_machine_ids()) {
$rep = LONCAPA::Lond::domlti_itemid($cdom,$context,$url,$method,$params,$perlvar{'lonVersion'});
@@ -12412,25 +12601,64 @@ sub domainlti_itemid {
return $itemid;
}
-sub get_numsuppfiles {
- my ($cnum,$cdom,$ignorecache)=@_;
+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 ($suppcount,$cached);
+ my ($showsupp,$cached);
unless ($ignorecache) {
- ($suppcount,$cached) = &is_cached_new('suppcount',$hashid);
+ ($showsupp,$cached) = &is_cached_new('showsupp',$hashid);
}
unless (defined($cached)) {
my $chome=&homeserver($cnum,$cdom);
unless ($chome eq 'no_host') {
- ($suppcount,my $supptools,my $errors) = (0,0,0);
- my $suppmap = 'supplemental.sequence';
- ($suppcount,$supptools,$errors) =
- &Apache::loncommon::recurse_supplemental($cnum,$cdom,$suppmap,$suppcount,
- $supptools,$errors);
+ my ($supplemental) = &Apache::loncommon::get_supplemental($cnum,$cdom,$ignorecache,$possdel);
+ if (ref($supplemental) eq 'HASH') {
+ if ((ref($supplemental->{'ids'}) eq 'HASH') && (ref($supplemental->{'hidden'}) eq 'HASH')) {
+ foreach my $key (keys(%{$supplemental->{'ids'}})) {
+ 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('suppcount',$hashid,$suppcount,600);
+ &do_cache_new('showsupp',$hashid,$showsupp,600);
}
- return $suppcount;
+ return $showsupp;
}
#
@@ -13506,13 +13734,13 @@ sub get_reservable_slots {
sub get_course_slots {
my ($cnum,$cdom) = @_;
my $hashid=$cnum.':'.$cdom;
- my ($result,$cached) = &Apache::lonnet::is_cached_new('allslots',$hashid);
+ my ($result,$cached) = &is_cached_new('allslots',$hashid);
if (defined($cached)) {
if (ref($result) eq 'HASH') {
return %{$result};
}
} else {
- my %slots=&Apache::lonnet::dump('slots',$cdom,$cnum);
+ my %slots=&dump('slots',$cdom,$cnum);
my ($tmp) = keys(%slots);
if ($tmp !~ /^(con_lost|error|no_such_host)/i) {
&do_cache_new('allslots',$hashid,\%slots,600);
@@ -13558,11 +13786,68 @@ sub get_coursechange {
}
sub devalidate_coursechange_cache {
- my ($cnum,$cdom)=@_;
- my $hashid=$cnum.':'.$cdom;
+ my ($cdom,$cnum)=@_;
+ my $hashid=$cdom.'_'.$cnum;
&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=¤t_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
sub symblist {
@@ -13749,14 +14034,10 @@ sub symbread {
my %bighash;
my $syval='';
if (($env{'request.course.fn'}) && ($thisfn)) {
- my $targetfn = $thisfn;
- if ($targetfn =~ m|^adm/wrapper/(ext/.*)|) {
- $targetfn=$1;
- }
unless ($ignoresymbdb) {
if (tie(%hash,'GDBM_File',$env{'request.course.fn'}.'_symb.db',
&GDBM_READER(),0640)) {
- $syval=$hash{$targetfn};
+ $syval=$hash{$thisfn};
untie(%hash);
}
if ($syval && $checkforblock) {
@@ -14730,7 +15011,7 @@ sub get_requestor_ip {
sub get_proxy_settings {
my ($dom_in_use) = @_;
- my %domdefaults = &Apache::lonnet::get_domain_defaults($dom_in_use);
+ my %domdefaults = &get_domain_defaults($dom_in_use);
my $proxyinfo = {
ipheader => $domdefaults{'waf_ipheader'},
trusted => $domdefaults{'waf_trusted'},
@@ -14763,11 +15044,11 @@ sub get_proxy_alias {
if ($cached) {
return $alias;
}
- my $dom = &Apache::lonnet::host_domain($lonid);
+ my $dom = &host_domain($lonid);
if ($dom ne '') {
my $cachetime = 60*60*24;
my %domconfig =
- &Apache::lonnet::get_dom('configuration',['wafproxy'],$dom);
+ &get_dom('configuration',['wafproxy'],$dom);
if (ref($domconfig{'wafproxy'}) eq 'HASH') {
if (ref($domconfig{'wafproxy'}{'alias'}) eq 'HASH') {
$alias = $domconfig{'wafproxy'}{'alias'}{$lonid};
@@ -14814,11 +15095,11 @@ sub alias_sso {
if ($cached) {
return $use_alias;
}
- my $dom = &Apache::lonnet::host_domain($lonid);
+ my $dom = &host_domain($lonid);
if ($dom ne '') {
my $cachetime = 60*60*24;
my %domconfig =
- &Apache::lonnet::get_dom('configuration',['wafproxy'],$dom);
+ &get_dom('configuration',['wafproxy'],$dom);
if (ref($domconfig{'wafproxy'}) eq 'HASH') {
if (ref($domconfig{'wafproxy'}{'saml'}) eq 'HASH') {
$use_alias = $domconfig{'wafproxy'}{'saml'}{$lonid};
@@ -14846,7 +15127,7 @@ sub get_saml_landing {
$lonid = $perlvar{'lonHostID'};
}
if ($lonid) {
- unless (&Apache::lonnet::host_domain($lonid) eq $defdom) {
+ unless (&host_domain($lonid) eq $defdom) {
return;
}
} else {
@@ -14859,11 +15140,11 @@ sub get_saml_landing {
if ($cached) {
return $landing;
}
- my $dom = &Apache::lonnet::host_domain($lonid);
+ my $dom = &host_domain($lonid);
if ($dom ne '') {
my $cachetime = 60*60*24;
my %domconfig =
- &Apache::lonnet::get_dom('configuration',['login'],$dom);
+ &get_dom('configuration',['login'],$dom);
if (ref($domconfig{'login'}) eq 'HASH') {
if (ref($domconfig{'login'}{'saml'}) eq 'HASH') {
if (ref($domconfig{'login'}{'saml'}{$lonid}) eq 'HASH') {
@@ -14993,7 +15274,7 @@ sub get_dns {
my ($url,$func,$ignore_cache,$nocache,$hashref) = @_;
if (!$ignore_cache) {
my ($content,$cached)=
- &Apache::lonnet::is_cached_new('dns',$url);
+ &is_cached_new('dns',$url);
if ($cached) {
&$func($content,$hashref);
return;
@@ -15072,7 +15353,7 @@ sub get_dns {
sub parse_dns_checksums_tab {
my ($lines,$hashref) = @_;
my $lonhost = $perlvar{'lonHostID'};
- my $machine_dom = &Apache::lonnet::host_domain($lonhost);
+ my $machine_dom = &host_domain($lonhost);
my $loncaparev = &get_server_loncaparev($machine_dom);
my $distro = (split(/\:/,&get_server_distarch($lonhost)))[0];
my $webconfdir = '/etc/httpd/conf';
@@ -15116,7 +15397,7 @@ sub parse_dns_checksums_tab {
sub fetch_dns_checksums {
my %checksums;
- my $machine_dom = &Apache::lonnet::host_domain($perlvar{'lonHostID'});
+ my $machine_dom = &host_domain($perlvar{'lonHostID'});
my $loncaparev = &get_server_loncaparev($machine_dom,$perlvar{'lonHostID'});
my ($release,$timestamp) = split(/\-/,$loncaparev);
&get_dns("/adm/dns/checksums/$release",\&parse_dns_checksums_tab,1,1,
@@ -15504,7 +15785,7 @@ sub parse_getdns_url {
return %iphost;
}
my ($ip_info,$cached)=
- &Apache::lonnet::is_cached_new('iphost','iphost');
+ &is_cached_new('iphost','iphost');
if ($cached) {
%iphost = %{$ip_info->[0]};
%name_to_ip = %{$ip_info->[1]};
@@ -15516,7 +15797,7 @@ sub parse_getdns_url {
# get yesterday's info for fallback
my %old_name_to_ip;
my ($ip_info,$cached)=
- &Apache::lonnet::is_cached_new('iphost','iphost');
+ &is_cached_new('iphost','iphost');
if ($cached) {
%old_name_to_ip = %{$ip_info->[1]};
}
@@ -15583,7 +15864,7 @@ sub parse_getdns_url {
my ($lonid) = @_;
return if ($lonid eq '');
my ($idnref,$cached)=
- &Apache::lonnet::is_cached_new('internetnames',$lonid);
+ &is_cached_new('internetnames',$lonid);
if ($cached) {
return $idnref;
}
@@ -16423,10 +16704,6 @@ data base, returning a hash that is keye
values that are the resource value. I believe that the timestamps and
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
=head2 Course Modification