--- loncom/lonnet/perl/lonnet.pm	2023/06/20 14:03:57	1.1512
+++ loncom/lonnet/perl/lonnet.pm	2023/11/18 14:33:07	1.1519
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1512 2023/06/20 14:03:57 raeburn Exp $
+# $Id: lonnet.pm,v 1.1519 2023/11/18 14:33:07 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -2753,9 +2753,10 @@ sub get_domain_defaults {
          &get_dom('configuration',['defaults','quotas',
                                   'requestcourses','inststatus',
                                   'coursedefaults','usersessions',
-                                  'requestauthor','selfenrollment',
-                                  'coursecategories','ssl','autoenroll',
-                                  'trust','helpsettings','wafproxy',
+                                  'requestauthor','authordefaults',
+                                  'selfenrollment','coursecategories',
+                                  'ssl','autoenroll','trust',
+                                  'helpsettings','wafproxy',
                                   'ltisec','toolsec','domexttool',
                                   'exttool','privacy'],$domain);
     my @coursetypes = ('official','unofficial','community','textbook','placement');
@@ -2801,6 +2802,17 @@ sub get_domain_defaults {
     if (ref($domconfig{'requestauthor'}) eq 'HASH') {
         $domdefaults{'requestauthor'} = $domconfig{'requestauthor'};
     }
+    if (ref($domconfig{'authordefaults'}) eq 'HASH') {
+        foreach my $item ('nocodemirror','copyright','sourceavail','domcoordacc','editors') {
+            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{'inststatus'}) eq 'HASH') {
         foreach my $item ('inststatustypes','inststatusorder','inststatusguest') {
             $domdefaults{$item} = $domconfig{'inststatus'}{$item};
@@ -2823,6 +2835,9 @@ sub get_domain_defaults {
             if (ref($domconfig{'coursedefaults'}{'uploadquota'}) eq 'HASH') {
                 $domdefaults{$type.'quota'} = $domconfig{'coursedefaults'}{'uploadquota'}{$type};
             }
+            if (ref($domconfig{'coursedefaults'}{'coursequota'}) eq 'HASH') {
+                $domdefaults{$type.'coursequota'} = $domconfig{'coursedefaults'}{'coursequota'}{$type};
+            }
             if ($domdefaults{'postsubmit'} eq 'on') {
                 if (ref($domconfig{'coursedefaults'}{'postsubmit'}{'timeout'}) eq 'HASH') {
                     $domdefaults{$type.'postsubtimeout'} = 
@@ -3918,6 +3933,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 = &allowed('mdc',$env{'request.course.id'});
         if ($group ne '') {
@@ -5468,6 +5506,36 @@ sub courserolelog {
             $storehash{'group'} = $sec;
         } else {
             $storehash{'section'} = $sec;
+            my ($curruserdomstr,$newuserdomstr);
+            if (exists($env{'course.'.$cdom.'_'.$cnum.'.internal.userdomains'})) {
+                $curruserdomstr = $env{'course.'.$env{'request.course.id'}.'.internal.userdomains'};
+            } else {
+                my %courseinfo = &coursedescription($cdom.'/'.$cnum);
+                $curruserdomstr = $courseinfo{'internal.userdomains'};
+            }
+            if ($curruserdomstr ne '') {
+                my @udoms = split(/,/,$curruserdomstr);
+                unless (grep(/^\Q$domain\E/,@udoms)) {
+                    push(@udoms,$domain);
+                    $newuserdomstr = join(',',sort(@udoms));
+                }
+            } else {
+                $newuserdomstr = $domain;
+            }
+            if ($newuserdomstr ne '') {
+                my $putresult = &put('environment',{ 'internal.userdomains' => $newuserdomstr },
+                                     $cdom,$cnum);
+                if ($putresult eq 'ok') {
+                    unless (($selfenroll) || ($context eq 'selfenroll')) { 
+                        if (($context eq 'createcourse') || ($context eq 'requestcourses') ||
+                            ($context eq 'automated') || ($context eq 'domain')) {
+                            $env{'course.'.$cdom.'_'.$cnum.'.internal.userdomains'} = $newuserdomstr;
+                        } elsif ($env{'request.course.id'} eq $cdom.'_'.$cnum) {
+                            &appenv({'course.'.$cdom.'_'.$cnum.'.internal.userdomains' => $newuserdomstr});
+                        }
+                    }
+                }
+            }
         }
         &write_log('course',$namespace,\%storehash,$delflag,$username,
                    $domain,$cnum,$cdom);
@@ -6911,7 +6979,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);
@@ -6925,6 +6993,7 @@ sub rolesinit {
 
     my %allroles=();
     my %allgroups=();
+    my %gotcoauconfig=();
 
     for my $area (grep { ! /^rolesdef_/ } keys(%rolesdump)) {
         my $role = $rolesdump{$area};
@@ -6976,6 +7045,23 @@ 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';
+                            }
+                            $coauthorenv{"environment.internal.$name.$area"} = $info{$item};
+                        }
+                    }
+                }
+            }
         }
 
         my $cid = $tdomain.'_'.$trest;
@@ -7004,7 +7090,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 {
@@ -8155,12 +8241,16 @@ 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,
                  );
     }
@@ -8177,6 +8267,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};
             }
@@ -8185,7 +8279,11 @@ sub usertools_access {
 
     my ($toolstatus,$inststatus,$envkey);
     if ($context eq 'requestauthor') {
-        $envkey = $context; 
+        $envkey = $context;
+    } elsif ($context eq 'authordefaults') {
+        if ($tool eq 'webdav') {
+            $envkey = 'tools.'.$tool;
+        }
     } else {
         $envkey = $context.'.'.$tool;
     }
@@ -8759,7 +8857,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
@@ -8768,6 +8866,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;
     }
@@ -10537,7 +10642,7 @@ sub plaintext {
 sub assignrole {
     my ($udom,$uname,$url,$role,$end,$start,$deleteflag,$selfenroll,
         $context,$othdomby,$requester,$reqsec,$reqrole)=@_;
-    my $mrole;
+    my ($mrole,$rolelogcontext);
     if ($role =~ /^cr\//) {
         my $cwosec=$url;
         $cwosec=~s/^\/($match_domain)\/($match_courseid)\/.*/$1\/$2/;
@@ -10734,6 +10839,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.
@@ -10801,8 +10915,11 @@ sub assignrole {
             &domainrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
                            $context,$othdomby,$requester);
         } elsif (($role eq 'ca') || ($role eq 'aa')) {
+            if ($rolelogcontext eq '') {
+                $rolelogcontext = $context;
+            }
             &coauthorrolelog($role,$uname,$udom,$url,$origstart,$origend,$delflag,
-                             $context,$othdomby,$requester); 
+                             $rolelogcontext,$othdomby,$requester); 
         }
         if ($role eq 'cc') {
             &autoupdate_coowners($url,$end,$start,$uname,$udom);
@@ -12787,6 +12904,73 @@ sub domainlti_itemid {
     return $itemid;
 }
 
+sub get_ltitools_id {
+    my ($context,$cdom,$cnum,$title) = @_;
+    my ($lockhash,$tries,$gotlock,$id,$error);
+
+    # get lock on ltitools db
+    $lockhash = {
+                   lock => $env{'user.name'}.
+                           ':'.$env{'user.domain'},
+                };
+    $tries = 0;
+    if ($context eq 'domain') {
+        $gotlock = &newput_dom('ltitools',$lockhash,$cdom);
+    } else {
+        $gotlock = &newput('ltitools',$lockhash,$cdom,$cnum);
+    }
+    while (($gotlock ne 'ok') && ($tries<10)) {
+        $tries ++;
+        sleep (0.1);
+        if ($context eq 'domain') {
+            $gotlock = &newput_dom('ltitools',$lockhash,$cdom);
+        } else {
+            $gotlock = &newput('ltitools',$lockhash,$cdom,$cnum);
+        }
+    }
+    if ($gotlock eq 'ok') {
+        my %currids;
+        if ($context eq 'domain') {
+            %currids = &dump_dom('ltitools',$cdom);
+        } else {
+            %currids = &dump('ltitools',$cdom,$cnum);
+        }
+        if ($currids{'lock'}) {
+            delete($currids{'lock'});
+            if (keys(%currids)) {
+                my @curr = sort { $a <=> $b } keys(%currids);
+                if ($curr[-1] =~ /^\d+$/) {
+                    $id = 1 + $curr[-1];
+                }
+            } else {
+                $id = 1;
+            }
+            if ($id) {
+                if ($context eq 'domain') {
+                    unless (&newput_dom('ltitools',{ $id => $title },$cdom) eq 'ok') {
+                        $error = 'nostore';
+                    }
+                } else {
+                    unless (&newput('ltitools',{ $id => $title },$cdom,$cnum) eq 'ok') {
+                        $error = 'nostore';
+                    }
+                }
+            } else {
+                $error = 'nonumber';
+            }
+        }
+        my $dellockoutcome;
+        if ($context eq 'domain') {
+            $dellockoutcome = &del_dom('ltitools',['lock'],$cdom);
+        } else {
+            $dellockoutcome = &del('ltitools',['lock'],$cdom,$cnum);
+        }
+    } else {
+        $error = 'nolock';
+    }
+    return ($id,$error);
+}
+
 sub count_supptools {
     my ($cnum,$cdom,$ignorecache,$reload)=@_;
     my $hashid=$cnum.':'.$cdom;