--- loncom/lonnet/perl/lonnet.pm 2022/02/01 23:13:20 1.1479
+++ loncom/lonnet/perl/lonnet.pm 2022/10/07 14:31:28 1.1494
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1479 2022/02/01 23:13:20 raeburn Exp $
+# $Id: lonnet.pm,v 1.1494 2022/10/07 14:31:28 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);
@@ -1323,7 +1323,7 @@ sub changepass {
sub queryauthenticate {
my ($uname,$udom)=@_;
my $uhome=&homeserver($uname,$udom);
- if (!$uhome) {
+ if ((!$uhome) || ($uhome eq 'no_host')) {
&logthis("User $uname at $udom is unknown when looking for authentication mechanism");
return 'no_host';
}
@@ -1372,16 +1372,39 @@ sub authenticate {
}
if ($answer eq 'non_authorized') {
&logthis("User $uname at $udom rejected by $uhome");
- return 'no_host';
+ return 'no_host';
}
&logthis("User $uname at $udom threw error $answer when checking authentication mechanism");
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)) {
@@ -2262,6 +2285,57 @@ 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
sub get_domainconfiguser {
my ($udom) = @_;
@@ -2271,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'});
@@ -2542,6 +2616,10 @@ sub inst_rulecheck {
$response=&unescape(&reply('instselfcreatecheck:'.
&escape($udom).':'.&escape($uname).
':'.$rulestr,$homeserver));
+ } elsif ($item eq 'unamemap') {
+ $response=&unescape(&reply('instunamemapcheck:'.
+ &escape($udom).':'.&escape($uname).
+ ':'.$rulestr,$homeserver));
}
if ($response ne 'refused') {
my @pairs=split(/\&/,$response);
@@ -2571,6 +2649,9 @@ sub inst_userrules {
} elsif ($check eq 'email') {
$response=&reply('instemailrules:'.&escape($udom),
$homeserver);
+ } elsif ($check eq 'unamemap') {
+ $response=&reply('unamemaprules:'.&escape($udom),
+ $homeserver);
} else {
$response=&reply('instuserrules:'.&escape($udom),
$homeserver);
@@ -2612,12 +2693,12 @@ 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'],$domain);
+ 'trust','helpsettings','wafproxy','ltisec'],$domain);
my @coursetypes = ('official','unofficial','community','textbook','placement');
if (ref($domconfig{'defaults'}) eq 'HASH') {
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};
@@ -2626,9 +2707,12 @@ 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'};
+ $domdefaults{'unamemap_rule'} = $domconfig{'defaults'}{'unamemap_rule'};
} else {
$domdefaults{'lang_def'} = &domain($domain,'lang_def');
$domdefaults{'auth_def'} = &domain($domain,'auth_def');
@@ -2699,7 +2783,10 @@ sub get_domain_defaults {
}
if ($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'}{'remote'}) eq 'HASH') {
@@ -2788,7 +2875,19 @@ sub get_domain_defaults {
$domdefaults{'waf_'.$item} = $domconfig{'wafproxy'}{$item};
}
}
- }
+ }
+ if (ref($domconfig{'ltisec'}) eq 'HASH') {
+ if (ref($domconfig{'ltisec'}{'encrypt'}) eq 'HASH') {
+ $domdefaults{'linkprotenc_crs'} = $domconfig{'ltisec'}{'encrypt'}{'crs'};
+ $domdefaults{'linkprotenc_dom'} = $domconfig{'ltisec'}{'encrypt'}{'dom'};
+ $domdefaults{'ltienc_consumers'} = $domconfig{'ltisec'}{'encrypt'}{'consumers'};
+ }
+ if (ref($domconfig{'ltisec'}{'private'}) eq 'HASH') {
+ if (ref($domconfig{'ltisec'}{'private'}{'keys'}) eq 'ARRAY') {
+ $domdefaults{'privhosts'} = $domconfig{'ltisec'}{'private'}{'keys'};
+ }
+ }
+ }
&do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);
return %domdefaults;
}
@@ -2808,7 +2907,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;
}
@@ -2863,13 +2962,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 {
@@ -3041,7 +3160,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'}";
}
@@ -3239,14 +3358,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));
@@ -3256,7 +3375,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));
@@ -3268,14 +3387,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') {
@@ -3552,8 +3671,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,
@@ -3704,7 +3823,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;
@@ -3733,7 +3852,7 @@ 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) {
@@ -4844,6 +4963,7 @@ sub get_scantronformat_file {
close($fh);
}
}
+ chomp(@lines);
}
return @lines;
}
@@ -5014,7 +5134,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};
@@ -5213,7 +5333,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,
@@ -5444,8 +5564,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'};
@@ -5772,7 +5892,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;
@@ -6774,31 +6894,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 {
@@ -7365,7 +7485,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
@@ -7515,16 +7635,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') {
@@ -7545,7 +7665,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);
@@ -7859,6 +7979,7 @@ sub usertools_access {
blog => 1,
webdav => 1,
portfolio => 1,
+ timezone => 1,
);
}
return if (!defined($tools{$tool}));
@@ -7983,7 +8104,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;
}
@@ -8054,6 +8175,7 @@ sub check_can_request {
my @options = ('approval','validate','autolimit');
my $optregex = join('|',@options);
if ((ref($can_request) eq 'HASH') && (ref($types) eq 'ARRAY')) {
+ my %willtrust;
foreach my $type (@{$types}) {
if (&usertools_access($uname,$udom,$type,undef,
'requestcourses')) {
@@ -8073,12 +8195,17 @@ sub check_can_request {
if (ref($request_domains) eq 'HASH') {
my ($otherdom) = ($item =~ /^($match_domain):($optregex)(=?\d*)$/);
if ($otherdom ne '') {
- if (ref($request_domains->{$type}) eq 'ARRAY') {
- unless (grep(/^\Q$otherdom\E$/,@{$request_domains->{$type}})) {
+ unless (exists($willtrust{$otherdom})) {
+ $willtrust{$otherdom} = &will_trust('reqcrs',$env{'user.domain'},$otherdom);
+ }
+ if ($willtrust{$otherdom}) {
+ if (ref($request_domains->{$type}) eq 'ARRAY') {
+ unless (grep(/^\Q$otherdom\E$/,@{$request_domains->{$type}})) {
+ push(@{$request_domains->{$type}},$otherdom);
+ }
+ } else {
push(@{$request_domains->{$type}},$otherdom);
}
- } else {
- push(@{$request_domains->{$type}},$otherdom);
}
}
}
@@ -8869,7 +8996,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);
}
@@ -10495,10 +10622,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');
}
}
}
@@ -10716,7 +10843,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);
@@ -10796,7 +10923,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) },
@@ -10930,7 +11057,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;
}
@@ -12215,15 +12342,24 @@ sub resdata {
sub get_domain_lti {
my ($cdom,$context) = @_;
- my ($name,%lti);
+ 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;
}
- my ($result,$cached)=&is_cached_new($name,$cdom);
+
+ if ($context eq 'linkprot') {
+ $cachename = $context;
+ } else {
+ $cachename = $name;
+ }
+
+ my ($result,$cached)=&is_cached_new($cachename,$cdom);
if (defined($cached)) {
if (ref($result) eq 'HASH') {
%lti = %{$result};
@@ -12231,20 +12367,28 @@ sub get_domain_lti {
} else {
my %domconfig = &get_dom('configuration',[$name],$cdom);
if (ref($domconfig{$name}) eq 'HASH') {
- %lti = %{$domconfig{$name}};
- my %encdomconfig = &get_dom('encconfig',[$name],$cdom,undef,1);
- if (ref($encdomconfig{$name}) eq 'HASH') {
- foreach my $id (keys(%lti)) {
- if (ref($encdomconfig{$name}{$id}) eq 'HASH') {
- foreach my $item ('key','secret') {
- $lti{$id}{$item} = $encdomconfig{$name}{$id}{$item};
+ if ($context eq 'linkprot') {
+ if (ref($domconfig{$name}{'linkprot'}) eq 'HASH') {
+ %lti = %{$domconfig{$name}{'linkprot'}};
+ }
+ } else {
+ %lti = %{$domconfig{$name}};
+ }
+ if (($context eq 'consumer') && (keys(%lti))) {
+ my %encdomconfig = &get_dom('encconfig',[$name],$cdom,undef,1);
+ if (ref($encdomconfig{$name}) eq 'HASH') {
+ foreach my $id (keys(%lti)) {
+ if (ref($encdomconfig{$name}{$id}) eq 'HASH') {
+ foreach my $item ('key','secret') {
+ $lti{$id}{$item} = $encdomconfig{$name}{$id}{$item};
+ }
}
}
}
}
}
my $cachetime = 24*60*60;
- &do_cache_new($name,$cdom,\%lti,$cachetime);
+ &do_cache_new($cachename,$cdom,\%lti,$cachetime);
}
return %lti;
}
@@ -12272,7 +12416,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'});
@@ -12296,7 +12439,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'});
@@ -13409,13 +13551,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);
@@ -13652,17 +13794,10 @@ sub symbread {
my %bighash;
my $syval='';
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) {
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) {
@@ -14636,7 +14771,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'},
@@ -14669,11 +14804,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};
@@ -14720,11 +14855,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};
@@ -14752,7 +14887,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 {
@@ -14765,11 +14900,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') {
@@ -14899,7 +15034,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;
@@ -14978,7 +15113,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';
@@ -15022,7 +15157,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,
@@ -15410,7 +15545,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]};
@@ -15422,7 +15557,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');
+ &s_cached_new('iphost','iphost');
if ($cached) {
%old_name_to_ip = %{$ip_info->[1]};
}
@@ -15489,7 +15624,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;
}