--- loncom/lonnet/perl/lonnet.pm 2024/02/25 05:55:09 1.1172.2.146.2.17 +++ loncom/lonnet/perl/lonnet.pm 2025/01/16 22:22:40 1.1172.2.146.2.27 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.1172.2.146.2.17 2024/02/25 05:55:09 raeburn Exp $ +# $Id: lonnet.pm,v 1.1172.2.146.2.27 2025/01/16 22:22:40 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); @@ -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'}; } @@ -2570,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') { @@ -3655,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 '') { @@ -3689,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; + } } } } @@ -5266,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)); @@ -5773,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); @@ -6447,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) { @@ -6463,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=''; @@ -6727,7 +6806,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); @@ -6741,6 +6820,8 @@ sub rolesinit { my %allroles=(); my %allgroups=(); + my %gotcoauconfig=(); + my %domdefaults=(); for my $area (grep { ! /^rolesdef_/ } keys(%rolesdump)) { my $role = $rolesdump{$area}; @@ -6792,6 +6873,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; @@ -6820,7 +6932,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 { @@ -7712,7 +7824,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); @@ -7721,11 +7833,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; } @@ -7747,6 +7867,8 @@ sub get_portfolio_access { push(@groups,$key); } elsif ($scope eq 'ip') { push(@ips,$key); + } elsif ($scope eq 'userip') { + push(@userips,$key); } } if ($public) { @@ -7764,6 +7886,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) { @@ -7968,12 +8103,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, ); } @@ -7990,6 +8130,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}; } @@ -7999,6 +8143,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; } @@ -8551,7 +8699,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 @@ -8560,6 +8708,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; } @@ -8883,7 +9038,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 ''; } @@ -9970,7 +10125,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); @@ -10051,7 +10206,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); @@ -10313,7 +10468,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/; @@ -10443,6 +10598,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. @@ -10510,8 +10674,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); @@ -11161,7 +11328,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') { @@ -11173,7 +11340,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='';