--- loncom/lonnet/perl/lonnet.pm 2023/10/06 02:48:36 1.1172.2.146.2.16
+++ loncom/lonnet/perl/lonnet.pm 2024/09/03 09:34:26 1.1172.2.146.2.24
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1172.2.146.2.16 2023/10/06 02:48:36 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.146.2.24 2024/09/03 09:34:26 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -2510,11 +2510,11 @@ sub get_domain_defaults {
&Apache::lonnet::get_dom('configuration',['defaults','quotas',
'requestcourses','inststatus',
'coursedefaults','usersessions',
- 'requestauthor','selfenrollment',
- 'coursecategories','autoenroll',
- 'helpsettings','wafproxy','ltisec',
- 'toolsec','domexttool','exttool'],
- $domain);
+ 'requestauthor','authordefaults',
+ 'selfenrollment','coursecategories',
+ 'autoenroll','helpsettings',
+ 'wafproxy','ltisec','toolsec',
+ 'domexttool','exttool'],$domain);
my @coursetypes = ('official','unofficial','community','textbook');
if (ref($domconfig{'defaults'}) eq 'HASH') {
$domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'};
@@ -2540,7 +2540,7 @@ sub get_domain_defaults {
} else {
$domdefaults{'defaultquota'} = $domconfig{'quotas'};
}
- my @usertools = ('aboutme','blog','webdav','portfolio');
+ my @usertools = ('aboutme','blog','webdav','portfolio','portaccess');
foreach my $item (@usertools) {
if (ref($domconfig{'quotas'}{$item}) eq 'HASH') {
$domdefaults{$item} = $domconfig{'quotas'}{$item};
@@ -2555,6 +2555,17 @@ sub get_domain_defaults {
$domdefaults{$item} = $domconfig{'requestcourses'}{$item};
}
}
+ if (ref($domconfig{'authordefaults'}) eq 'HASH') {
+ foreach my $item ('nocodemirror','copyright','sourceavail','domcoordacc','editors','archive') {
+ if ($item eq 'editors') {
+ if (ref($domconfig{'authordefaults'}{'editors'}) eq 'ARRAY') {
+ $domdefaults{$item} = join(',',@{$domconfig{'authordefaults'}{'editors'}});
+ }
+ } else {
+ $domdefaults{$item} = $domconfig{'authordefaults'}{$item};
+ }
+ }
+ }
if (ref($domconfig{'requestauthor'}) eq 'HASH') {
$domdefaults{'requestauthor'} = $domconfig{'requestauthor'};
}
@@ -2696,6 +2707,17 @@ sub get_domain_defaults {
$domdefaults{'ltiprivhosts'} = $domconfig{'ltisec'}{'private'}{'keys'};
}
}
+ if (ref($domconfig{'ltisec'}{'suggested'}) eq 'HASH') {
+ my %suggestions = %{$domconfig{'ltisec'}{'suggested'}};
+ foreach my $item (keys(%{$domconfig{'ltisec'}{'suggested'}})) {
+ unless (ref($domconfig{'ltisec'}{'suggested'}{$item}) eq 'HASH') {
+ delete($suggestions{$item});
+ }
+ }
+ if (keys(%suggestions)) {
+ $domdefaults{'linkprotsuggested'} = \%suggestions;
+ }
+ }
}
if (ref($domconfig{'toolsec'}) eq 'HASH') {
if (ref($domconfig{'toolsec'}{'encrypt'}) eq 'HASH') {
@@ -3644,6 +3666,29 @@ sub can_edit_resource {
}
}
+#
+# For /adm/viewcoauthors can only edit if author or co-author who is manager.
+#
+
+ if (($resurl eq '/adm/viewcoauthors') && ($cnum ne '') && ($cdom ne '')) {
+ if (((&allowed('cca',"$cdom/$cnum")) ||
+ (&allowed('caa',"$cdom/$cnum"))) ||
+ ((&allowed('vca',"$cdom/$cnum") ||
+ &allowed('vaa',"$cdom/$cnum")) &&
+ ($env{"environment.internal.manager./$cdom/$cnum"}))) {
+ $home = $env{'user.home'};
+ $cfile = $resurl;
+ if ($env{'form.forceedit'}) {
+ $forceview = 1;
+ } else {
+ $forceedit = 1;
+ }
+ return ($cfile,$home,$switchserver,$forceedit,$forceview);
+ } else {
+ return;
+ }
+ }
+
if ($env{'request.course.id'}) {
my $crsedit = &Apache::lonnet::allowed('mdc',$env{'request.course.id'});
if ($group ne '') {
@@ -3678,10 +3723,15 @@ sub can_edit_resource {
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;
+ }
}
}
}
@@ -5255,6 +5305,39 @@ sub coauthorrolelog {
return;
}
+sub authorarchivelog {
+ my ($hashref,$size,$filesdest,$action) = @_;
+ my $lonprtdir = $Apache::lonnet::perlvar{'lonPrtDir'};
+ my $londocroot = $Apache::lonnet::perlvar{'lonDocRoot'};
+ $filesdest =~ s{^\Q$lonprtdir/\E}{};
+ if ($filesdest =~ m{^($match_username)_($match_domain)_archive_(\d+_\d+_\d+(|[.\w]+))$}) {
+ my ($auname,$audom,$id) = ($1,$2,$3);
+ if (ref($hashref) eq 'HASH') {
+ my $namespace = 'archivelog';
+ my $dir;
+ if ($hashref->{dir} =~ m{^\Q$londocroot/priv/$audom/$auname\E(.*)$}) {
+ $dir = $1;
+ }
+ my $delflag = 0;
+ my %storehash = (
+ id => $id,
+ dir => $dir,
+ files => $hashref->{numfiles},
+ subdirs => $hashref->{numdirs},
+ bytes => $hashref->{bytes},
+ size => $size,
+ action => $action,
+ );
+ if ($action eq 'delete') {
+ $delflag = 1;
+ }
+ &write_log('author',$namespace,\%storehash,$delflag,$auname,
+ $audom,$auname,$audom);
+ }
+ }
+ return;
+}
+
sub get_course_adv_roles {
my ($cid,$codes) = @_;
$cid=$env{'request.course.id'} unless (defined($cid));
@@ -6716,7 +6799,7 @@ sub rolesinit {
my %firstaccess = &dump('firstaccesstimes', $domain, $username);
my %timerinterval = &dump('timerinterval', $domain, $username);
my (%coursetimerstarts, %firstaccchk, %firstaccenv, %coursetimerintervals,
- %timerintchk, %timerintenv);
+ %timerintchk, %timerintenv,%coauthorenv);
foreach my $key (keys(%firstaccess)) {
my ($cid, $rest) = split(/\0/, $key);
@@ -6730,6 +6813,8 @@ sub rolesinit {
my %allroles=();
my %allgroups=();
+ my %gotcoauconfig=();
+ my %domdefaults=();
for my $area (grep { ! /^rolesdef_/ } keys(%rolesdump)) {
my $role = $rolesdump{$area};
@@ -6781,6 +6866,37 @@ sub rolesinit {
} else {
# Normal role, defined in roles.tab
&standard_roleprivs(\%allroles,$trole,$tdomain,$spec,$trest,$area);
+ if (($trole eq 'ca') || ($trole eq 'aa')) {
+ (undef,my ($audom,$auname)) = split(/\//,$area);
+ unless ($gotcoauconfig{$area}) {
+ my @ca_settings = ('authoreditors','coauthorlist','coauthoroptin');
+ my %info = &userenvironment($audom,$auname,@ca_settings);
+ $gotcoauconfig{$area} = 1;
+ foreach my $item (@ca_settings) {
+ if (exists($info{$item})) {
+ my $name = $item;
+ if ($item eq 'authoreditors') {
+ $name = 'editors';
+ unless ($info{'authoreditors'}) {
+ my %domdefs;
+ if (ref($domdefaults{$audom}) eq 'HASH') {
+ %domdefs = %{$domdefaults{$audom}};
+ } else {
+ %domdefs = &get_domain_defaults($audom);
+ $domdefaults{$audom} = \%domdefs;
+ }
+ if ($domdefs{$name} ne '') {
+ $info{'authoreditors'} = $domdefs{$name};
+ } else {
+ $info{'authoreditors'} = 'edit,xml';
+ }
+ }
+ }
+ $coauthorenv{"environment.internal.$name.$area"} = $info{$item};
+ }
+ }
+ }
+ }
}
my $cid = $tdomain.'_'.$trest;
@@ -6809,7 +6925,7 @@ sub rolesinit {
$env{'user.adv'} = $userroles{'user.adv'};
$env{'user.rar'} = $userroles{'user.rar'};
- return (\%userroles,\%firstaccenv,\%timerintenv);
+ return (\%userroles,\%firstaccenv,\%timerintenv,\%coauthorenv);
}
sub set_arearole {
@@ -7701,7 +7817,7 @@ sub portfolio_access {
}
sub get_portfolio_access {
- my ($udom,$unum,$file_name,$group,$clientip,$access_hash) = @_;
+ my ($udom,$unum,$file_name,$group,$clientip,$access_hash,$portaccessref) = @_;
if (!ref($access_hash)) {
my $current_perms = &get_portfile_permissions($udom,$unum);
@@ -7710,11 +7826,19 @@ sub get_portfolio_access {
$access_hash = $access_controls{$file_name};
}
- my ($public,$guest,@domains,@users,@courses,@groups,@ips);
+ my $portaccess;
+ if (ref($portaccess) eq 'SCALAR') {
+ $portaccess = $$portaccessref;
+ } else {
+ $portaccess = &usertools_access($unum,$udom,'portaccess',undef,'tools');
+ }
+
+ my ($public,$guest,@domains,@users,@courses,@groups,@ips,@userips);
my $now = time;
if (ref($access_hash) eq 'HASH') {
foreach my $key (keys(%{$access_hash})) {
my ($num,$scope,$end,$start) = ($key =~ /^([^:]+):([a-z]+)_(\d*)_?(\d*)$/);
+ next if (($scope ne 'ip') && ($portaccess == 0));
if ($start > $now) {
next;
}
@@ -7736,6 +7860,8 @@ sub get_portfolio_access {
push(@groups,$key);
} elsif ($scope eq 'ip') {
push(@ips,$key);
+ } elsif ($scope eq 'userip') {
+ push(@userips,$key);
}
}
if ($public) {
@@ -7753,6 +7879,19 @@ sub get_portfolio_access {
if ($allowed) {
return 'ok';
}
+ } elsif (@userips > 0) {
+ my $allowed;
+ foreach my $useripkey (@userips) {
+ if (ref($access_hash->{$useripkey}{'ip'}) eq 'ARRAY') {
+ if (&Apache::loncommon::check_ip_acc(join(',',@{$access_hash->{$useripkey}{'ip'}}),$clientip)) {
+ $allowed = 1;
+ last;
+ }
+ }
+ }
+ if ($allowed) {
+ return 'ok';
+ }
}
if ($env{'user.name'} eq 'public' && $env{'user.domain'} eq 'public') {
if ($guest) {
@@ -7957,12 +8096,17 @@ sub usertools_access {
%tools = (
requestauthor => 1,
);
+ } elsif ($context eq 'authordefaults') {
+ %tools = (
+ webdav => 1,
+ );
} else {
%tools = (
aboutme => 1,
blog => 1,
webdav => 1,
portfolio => 1,
+ portaccess => 1,
timezone => 1,
);
}
@@ -7979,6 +8123,10 @@ sub usertools_access {
return $env{'environment.canrequest.'.$tool};
} elsif ($context eq 'requestauthor') {
return $env{'environment.canrequest.author'};
+ } elsif ($context eq 'authordefaults') {
+ if ($tool eq 'webdav') {
+ return $env{'environment.availabletools.'.$tool};
+ }
} else {
return $env{'environment.availabletools.'.$tool};
}
@@ -7988,6 +8136,10 @@ sub usertools_access {
my ($toolstatus,$inststatus,$envkey);
if ($context eq 'requestauthor') {
$envkey = $context;
+ } elsif ($context eq 'authordefaults') {
+ if ($tool eq 'webdav') {
+ $envkey = 'tools.'.$tool;
+ }
} else {
$envkey = $context.'.'.$tool;
}
@@ -8540,7 +8692,7 @@ sub allowed {
# If this is generating or modifying users, exit with special codes
- if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:caa:'=~/\:\Q$priv\E\:/) {
+ if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:caa::vca:vaa:'=~/\:\Q$priv\E\:/) {
if (($priv eq 'cca') || ($priv eq 'caa')) {
my ($audom,$auname)=split('/',$uri);
# no author name given, so this just checks on the general right to make a co-author in this domain
@@ -8549,6 +8701,13 @@ sub allowed {
if (($auname ne $env{'user.name'} && $env{'request.role'} !~ /^dc\./) ||
(($audom ne $env{'user.domain'} && $env{'request.role'} !~ /^dc\./) &&
($audom ne $env{'request.role.domain'}))) { return ''; }
+ } elsif (($priv eq 'vca') || ($priv eq 'vaa')) {
+ my ($audom,$auname)=split('/',$uri);
+ unless ($auname) { return $thisallowed; }
+ unless (($env{'request.role'} eq "dc./$audom") ||
+ ($env{'request.role'} eq "ca./$uri")) {
+ return '';
+ }
}
return $thisallowed;
}
@@ -8872,7 +9031,7 @@ sub constructaccess {
my ($ownername,$ownerdomain,$ownerhome);
($ownerdomain,$ownername) =
- ($url=~ m{^(?:\Q$perlvar{'lonDocRoot'}\E|)/priv/($match_domain)/($match_username)(?:/|$)});
+ ($url=~ m{^(?:\Q$perlvar{'lonDocRoot'}\E|)(?:/daxepage|/daxeopen)?/priv/($match_domain)/($match_username)(?:/|$)});
# The URL does not really point to any authorspace, forget it
unless (($ownername) && ($ownerdomain)) { return ''; }
@@ -10302,7 +10461,7 @@ sub plaintext {
sub assignrole {
my ($udom,$uname,$url,$role,$end,$start,$deleteflag,$selfenroll,
$context)=@_;
- my $mrole;
+ my ($mrole,$rolelogcontext);
if ($role =~ /^cr\//) {
my $cwosec=$url;
$cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/;
@@ -10432,6 +10591,15 @@ sub assignrole {
}
}
}
+ } elsif (($context eq 'author') && (($role eq 'ca' || $role eq 'aa'))) {
+ if ($url =~ m{^/($match_domain)/($match_username)$}) {
+ my ($audom,$auname) = ($1,$2);
+ if ((&Apache::lonnet::allowed('v'.$role,"$audom/$auname")) &&
+ ($env{"environment.internal.manager.$url"})) {
+ $refused = '';
+ $rolelogcontext = 'coauthor';
+ }
+ }
}
if ($refused) {
&logthis('Refused assignrole: '.$udom.' '.$uname.' '.$url.
@@ -10499,8 +10667,11 @@ sub assignrole {
&domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
$context);
} elsif (($role eq 'ca') || ($role eq 'aa')) {
+ if ($rolelogcontext eq '') {
+ $rolelogcontext = $context;
+ }
&coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
- $context);
+ $rolelogcontext);
}
if ($role eq 'cc') {
&autoupdate_coowners($url,$end,$start,$uname,$udom);