--- loncom/lonnet/perl/lonnet.pm 2024/02/28 05:40:11 1.1172.2.146.2.19
+++ loncom/lonnet/perl/lonnet.pm 2025/02/07 22:54:30 1.1172.2.146.2.28
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.1172.2.146.2.19 2024/02/28 05:40:11 raeburn Exp $
+# $Id: lonnet.pm,v 1.1172.2.146.2.28 2025/02/07 22:54:30 raeburn Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -221,7 +221,7 @@ sub get_server_distarch {
}
}
my $rep = &reply('serverdistarch',$lonhost);
- unless ($rep eq 'unknown_command' || $rep eq 'no_such_host' ||
+ unless ($rep eq 'unknown_cmd' || $rep eq 'no_such_host' ||
$rep eq 'con_lost' || $rep eq 'rejected' || $rep eq 'refused' ||
$rep eq '') {
return &do_cache_new('serverdistarch',$lonhost,$rep,$cachetime);
@@ -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};
@@ -2556,7 +2556,7 @@ sub get_domain_defaults {
}
}
if (ref($domconfig{'authordefaults'}) eq 'HASH') {
- foreach my $item ('nocodemirror','copyright','sourceavail','domcoordacc','editors') {
+ 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'}});
@@ -2581,6 +2581,9 @@ sub get_domain_defaults {
if (ref($domconfig{'coursedefaults'}{'postsubmit'}) eq 'HASH') {
$domdefaults{'postsubmit'} = $domconfig{'coursedefaults'}{'postsubmit'}{'client'};
}
+ if (ref($domconfig{'coursedefaults'}{'crseditors'}) eq 'ARRAY') {
+ $domdefaults{'crseditors'}=join(',',@{$domconfig{'coursedefaults'}{'crseditors'}});
+ }
foreach my $type (@coursetypes) {
if (ref($domconfig{'coursedefaults'}{'coursecredits'}) eq 'HASH') {
unless ($type eq 'community') {
@@ -3666,6 +3669,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 '') {
@@ -3700,10 +3726,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;
+ }
}
}
}
@@ -5277,6 +5308,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));
@@ -5784,7 +5848,7 @@ sub courselastaccess {
sub extract_lastaccess {
my ($returnhash,$rep) = @_;
if (ref($returnhash) eq 'HASH') {
- unless ($rep eq 'unknown_command' || $rep eq 'no_such_host' ||
+ unless ($rep eq 'unknown_cmd' || $rep eq 'no_such_host' ||
$rep eq 'con_lost' || $rep eq 'rejected' || $rep eq 'refused' ||
$rep eq '') {
my @pairs=split(/\&/,$rep);
@@ -6458,13 +6522,17 @@ sub cstore {
if ($stuname) { $home=&homeserver($stuname,$domain); }
- $symb=&symbclean($symb);
+ unless (($symb eq '_feedback') || ($symb eq '_discussion')) {
+ $symb=&symbclean($symb);
+ }
if (!$symb) { unless ($symb=&symbread()) { return ''; } }
if (!$domain) { $domain=$env{'user.domain'}; }
if (!$stuname) { $stuname=$env{'user.name'}; }
- &devalidate($symb,$stuname,$domain);
+ unless (($symb eq '_feedback') || ($symb eq '_discussion')) {
+ &devalidate($symb,$stuname,$domain);
+ }
$symb=escape($symb);
if (!$namespace) {
@@ -6474,7 +6542,7 @@ sub cstore {
}
if (!$home) { $home=$env{'user.home'}; }
- $$storehash{'ip'}=&get_requestor_ip();
+ $$storehash{'ip'} = &get_requestor_ip();
$$storehash{'host'}=$perlvar{'lonHostID'};
my $namevalue='';
@@ -6753,6 +6821,7 @@ sub rolesinit {
my %allroles=();
my %allgroups=();
my %gotcoauconfig=();
+ my %domdefaults=();
for my $area (grep { ! /^rolesdef_/ } keys(%rolesdump)) {
my $role = $rolesdump{$area};
@@ -6807,7 +6876,7 @@ sub rolesinit {
if (($trole eq 'ca') || ($trole eq 'aa')) {
(undef,my ($audom,$auname)) = split(/\//,$area);
unless ($gotcoauconfig{$area}) {
- my @ca_settings = ('authoreditors');
+ my @ca_settings = ('authoreditors','coauthorlist','coauthoroptin');
my %info = &userenvironment($audom,$auname,@ca_settings);
$gotcoauconfig{$area} = 1;
foreach my $item (@ca_settings) {
@@ -6815,6 +6884,20 @@ sub rolesinit {
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};
}
@@ -7209,6 +7292,27 @@ sub set_adhoc_privileges {
if (&allowed('adv') eq 'F') { $tadv=1; }
&appenv({'request.role.adv' => $tadv});
}
+ if ($role eq 'ca') {
+ my @ca_settings = ('authoreditors','coauthorlist');
+ my %info = &userenvironment($dcdom,$pickedcourse,@ca_settings);
+ foreach my $item (@ca_settings) {
+ if (exists($info{$item})) {
+ my $name = $item;
+ if ($item eq 'authoreditors') {
+ $name = 'editors';
+ unless ($info{'authoreditors'}) {
+ my %domdefs = &get_domain_defaults($dcdom);
+ if ($domdefs{$name} ne '') {
+ $info{'authoreditors'} = $domdefs{$name};
+ } else {
+ $info{'authoreditors'} = 'edit,xml';
+ }
+ }
+ }
+ &appenv({"environment.internal.$name./$dcdom/$pickedcourse" => $info{$item}});
+ }
+ }
+ }
}
# --------------------------------------------------------------- get interface
@@ -7741,7 +7845,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);
@@ -7750,11 +7854,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;
}
@@ -7776,6 +7888,8 @@ sub get_portfolio_access {
push(@groups,$key);
} elsif ($scope eq 'ip') {
push(@ips,$key);
+ } elsif ($scope eq 'userip') {
+ push(@userips,$key);
}
}
if ($public) {
@@ -7793,6 +7907,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) {
@@ -8005,7 +8132,9 @@ sub usertools_access {
%tools = (
aboutme => 1,
blog => 1,
+ webdav => 1,
portfolio => 1,
+ portaccess => 1,
timezone => 1,
);
}
@@ -8591,7 +8720,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
@@ -8600,6 +8729,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;
}
@@ -10010,7 +10146,7 @@ sub auto_instsec_reformat {
my $info = &freeze_escape($instsecref);
my $response=&reply('autoinstsecreformat:'.$cdom.':'.
$action.':'.$info,$server);
- next if ($response =~ /(con_lost|error|no_such_host|refused|unknown_command)/);
+ next if ($response =~ /(con_lost|error|no_such_host|refused|unknown_cmd)/);
my @items = split(/&/,$response);
foreach my $item (@items) {
my ($key,$value) = split(/=/,$item);
@@ -10091,7 +10227,7 @@ sub auto_export_grades {
my $grades = &freeze_escape($gradesref);
my $response=&reply('encrypt:autoexportgrades:'.$cdom.':'.$cnum.':'.
$info.':'.$grades,$homeserver);
- unless ($response =~ /(con_lost|error|no_such_host|refused|unknown_command)/) {
+ unless ($response =~ /(con_lost|error|no_such_host|refused|unknown_cmd)/) {
my @items = split(/&/,$response);
foreach my $item (@items) {
my ($key,$value) = split('=',$item);
@@ -10353,7 +10489,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/;
@@ -10483,6 +10619,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.
@@ -10550,8 +10695,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);
@@ -11201,7 +11349,7 @@ sub is_course {
}
sub store_userdata {
- my ($storehash,$datakey,$namespace,$udom,$uname) = @_;
+ my ($storehash,$datakey,$namespace,$udom,$uname,$ip) = @_;
my $result;
if ($datakey ne '') {
if (ref($storehash) eq 'HASH') {
@@ -11213,7 +11361,11 @@ sub store_userdata {
if (($uhome eq '') || ($uhome eq 'no_host')) {
$result = 'error: no_host';
} else {
- $storehash->{'ip'} = &get_requestor_ip();
+ if ($ip ne '') {
+ $storehash->{'ip'} = $ip;
+ } else {
+ $storehash->{'ip'} = &get_requestor_ip();
+ }
$storehash->{'host'} = $perlvar{'lonHostID'};
my $namevalue='';