--- loncom/lonnet/perl/lonnet.pm	2023/11/18 14:33:07	1.1519
+++ loncom/lonnet/perl/lonnet.pm	2025/02/07 02:06:07	1.1535
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.1519 2023/11/18 14:33:07 raeburn Exp $
+# $Id: lonnet.pm,v 1.1535 2025/02/07 02:06:07 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -188,7 +188,11 @@ sub create_connection {
 				     Type    => SOCK_STREAM,
 				     Timeout => 10);
     return 0 if (!$client);
-    print $client (join(':',$hostname,$lonid,&machine_ids($hostname),$loncaparevs{$lonid})."\n");
+    if ($loncaparevs{$lonid} =~ /^(\d+\.\d+\.[\w.]+)-\d+$/) {
+        print $client (join(':',$hostname,$lonid,$1,&machine_ids($hostname))."\n");
+    } else {
+        print $client (join(':',$hostname,$lonid,&machine_ids($hostname))."\n");
+    }
     my $result = <$client>;
     chomp($result);
     return 1 if ($result eq 'done');
@@ -224,7 +228,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);
@@ -2757,8 +2761,7 @@ sub get_domain_defaults {
                                   'selfenrollment','coursecategories',
                                   'ssl','autoenroll','trust',
                                   'helpsettings','wafproxy',
-                                  'ltisec','toolsec','domexttool',
-                                  'exttool','privacy'],$domain);
+                                  'ltisec','toolsec','privacy'],$domain);
     my @coursetypes = ('official','unofficial','community','textbook','placement');
     if (ref($domconfig{'defaults'}) eq 'HASH') {
         $domdefaults{'lang_def'} = $domconfig{'defaults'}{'lang_def'}; 
@@ -2784,7 +2787,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};
@@ -2803,7 +2806,7 @@ sub get_domain_defaults {
         $domdefaults{'requestauthor'} = $domconfig{'requestauthor'};
     }
     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'}});
@@ -2826,6 +2829,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') {
@@ -2854,6 +2860,11 @@ sub get_domain_defaults {
             } else {
                 $domdefaults{$type.'exttool'} = 0;
             }
+            if (ref($domconfig{'coursedefaults'}{'crsauthor'}) eq 'HASH') {
+                $domdefaults{$type.'crsauthor'} = $domconfig{'coursedefaults'}{'crsauthor'}{$type};
+            } else {
+                $domdefaults{$type.'crsauthor'} = 1;
+            }
         }
         if (ref($domconfig{'coursedefaults'}{'canclone'}) eq 'HASH') {
             if (ref($domconfig{'coursedefaults'}{'canclone'}{'instcode'}) eq 'ARRAY') {
@@ -2971,6 +2982,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') {
@@ -2997,6 +3019,9 @@ sub get_domain_defaults {
                 last if ($domdefaults{'userapprovals'});
             }
         }
+        if (ref($domconfig{'privacy'}{'othdom'}) eq 'HASH') {
+            $domdefaults{'privacyothdom'} = $domconfig{'privacy'}{'othdom'};
+        }
     }
     &do_cache_new('domdefaults',$domain,\%domdefaults,$cachetime);
     return %domdefaults;
@@ -5605,6 +5630,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));
@@ -6112,7 +6170,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);
@@ -6699,13 +6757,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) { 
@@ -6715,7 +6777,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='';
@@ -6994,6 +7056,7 @@ sub rolesinit {
     my %allroles=();
     my %allgroups=();
     my %gotcoauconfig=();
+    my %domdefaults=();
 
     for my $area (grep { ! /^rolesdef_/ } keys(%rolesdump)) {
         my $role = $rolesdump{$area};
@@ -7056,6 +7119,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};
                         }
@@ -7450,6 +7527,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
@@ -7984,7 +8082,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);
@@ -7993,11 +8091,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;
             }
@@ -8019,6 +8125,8 @@ sub get_portfolio_access {
                 push(@groups,$key);
             } elsif ($scope eq 'ip') {
                 push(@ips,$key);
+            } elsif ($scope eq 'userip') {
+                push(@userips,$key);
             }
         }
         if ($public) {
@@ -8036,6 +8144,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) {
@@ -8249,6 +8370,7 @@ sub usertools_access {
         %tools = (
                       aboutme   => 1,
                       blog      => 1,
+                      webdav    => 1,
                       portfolio => 1,
                       portaccess => 1,
                       timezone  => 1,
@@ -9216,6 +9338,22 @@ sub constructaccess {
             if (($ownername eq $env{'course.'.$env{'request.course.id'}.'.num'}) &&
                 ($ownerdomain eq $env{'course.'.$env{'request.course.id'}.'.domain'})) {
                 if (&allowed('mdc',$env{'request.course.id'})) {
+                    return if ($env{'course.'.$env{'request.course.id'}.'.internal.crsauthor'} eq '0');
+                    unless ($env{'course.'.$env{'request.course.id'}.'.internal.crsauthor'}) {
+                        my %domdefs = &get_domain_defaults($ownerdomain);
+                        my $type = lc($env{'course.'.$env{'request.course.id'}.'.type'});
+                        unless (($type eq 'community') || ($type eq 'placement')) {
+                            $type = 'unofficial';
+                            if ($env{'course.'.$env{'request.course.id'}.'internal.coursecode'} ne '') {
+                                $type = 'official';
+                            } elsif ($env{'course.'.$env{'request.course.id'}.'internal.textbook'} ne '') {
+                                $type = 'textbook';
+                            } else {
+                                $type = 'unofficial';
+                            }
+                        }
+                        return if ($domdefs{$type.'crsauthor'} eq '0');
+                    }
                     $ownerhome = $env{'course.'.$env{'request.course.id'}.'.home'};
                     return ($ownername,$ownerdomain,$ownerhome);
                 }
@@ -10295,7 +10433,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);
@@ -10377,7 +10515,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);
@@ -11570,7 +11708,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') {
@@ -11582,7 +11720,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='';
@@ -12437,6 +12579,8 @@ sub stat_file {
 # $relpath - Current path (relative to top level).
 # $dirhashref - reference to hash to populate with URLs of directories (Required)
 # $filehashref - reference to hash to populate with URLs of files (Optional)
+# $getlastmod - if true, will set value for each key in innerhash in $filehashref
+#               to last modification time of file; value set to 1 otherwise.
 #
 # Returns: nothing
 #
@@ -12449,7 +12593,8 @@ sub stat_file {
 #
 
 sub recursedirs {
-    my ($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$relpath,$dirhashref,$filehashref) = @_;
+    my ($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,
+        $relpath,$dirhashref,$filehashref,$getlastmod) = @_;
     return unless (ref($dirhashref) eq 'HASH');
     my $docroot = $perlvar{'lonDocRoot'};
     my $currpath = $docroot.$toppath;
@@ -12457,7 +12602,7 @@ sub recursedirs {
         $currpath .= "/$relpath";
     }
     my ($savefile,$checkinc,$checkexc);
-    if (ref($filehashref)) {
+    if (ref($filehashref) eq 'HASH') {
         $savefile = 1;
     }
     if (ref($include) eq 'HASH') {
@@ -12480,7 +12625,8 @@ sub recursedirs {
                     }
                     $dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1;
                     if ($recurse) {
-                        &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$newpath,$dirhashref,$filehashref);
+                        &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,
+                                     $toppath,$newpath,$dirhashref,$filehashref,$getlastmod);
                     }
                 } elsif (($savefile) || ($relpath eq '')) {
                     next if ($nonemptydir && $filecount);
@@ -12497,10 +12643,16 @@ sub recursedirs {
                         $dirhashref->{'/'} = 1;
                     }
                     if ($savefile) {
+                        my $value;
+                        if ($getlastmod) {
+                            ($value) = (stat("$currpath/$item"))[9];
+                        } else {
+                            $value = 1;
+                        }
                         if ($relpath eq '') {
-                            $filehashref->{'/'}{$item} = 1;
+                            $filehashref->{'/'}{$item} = $value
                         } else {
-                            $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1;
+                            $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = $value;
                         }
                     }
                     $filecount ++;
@@ -12509,8 +12661,11 @@ sub recursedirs {
             closedir($dirh);
         }
     } else {
-        my ($dirlistref,$listerror) =
-            &dirlist($toppath.$relpath);
+        my $url = $toppath;
+        if ($relpath ne '') {
+            $url = $toppath.'/'.$relpath;
+        }
+        my ($dirlistref,$listerror) = &dirlist($url);
         my @dir_lines;
         my $dirptr=16384;
         if (ref($dirlistref) eq 'ARRAY') {
@@ -12534,12 +12689,13 @@ sub recursedirs {
                     }
                     $dirhashref->{&Apache::lonlocal::js_escape($newpath)} = 1;
                     if ($recurse) {
-                        &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,$toppath,$newpath,$dirhashref,$filehashref);
+                        &recursedirs($is_home,$recurse,$include,$exclude,$nonemptydir,$addtopdir,
+                                     $toppath,$newpath,$dirhashref,$filehashref,$getlastmod);
                     }
                 } elsif (($savefile) || ($relpath eq '')) {
                     next if ($nonemptydir && $filecount);
                     if ($checkinc || $checkexc) {
-                        my $extension;
+                        my ($extension) = ($item =~ /\.(\w+)$/);
                         if ($checkinc) {
                             next unless ($extension && $include->{$extension});
                         }
@@ -12551,10 +12707,16 @@ sub recursedirs {
                         $dirhashref->{'/'} = 1;
                     }
                     if ($savefile) {
+                        my $value;
+                        if ($getlastmod) {
+                            $value = $mtime;
+                        } else {
+                            $value = 1;
+                        }
                         if ($relpath eq '') {
-                            $filehashref->{'/'}{$item} = 1;
+                            $filehashref->{'/'}{$item} = $value;
                         } else {
-                            $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = 1;
+                            $filehashref->{&Apache::lonlocal::js_escape($relpath)}{$item} = $value;
                         }
                     }
                     $filecount ++; 
@@ -12581,6 +12743,14 @@ sub priv_exclude {
            };
 }
 
+sub res_exclude {
+    return {
+             meta => 1,
+             subscription => 1,
+             rights => 1,
+           };
+}
+
 # -------------------------------------------------------- Value of a Condition
 
 # gets the value of a specific preevaluated condition
@@ -15050,6 +15220,49 @@ sub repcopy_userfile {
     return 'ok';
 }
 
+sub repcopy_crsprivfile {
+    my ($src,$dest) = @_;
+    my $result;
+    if ($src =~ m{^/priv/($match_domain)/($match_courseid)/(.+)$}) {
+        my ($cdom,$cnum,$filepath) = ($1,$2,$3);
+        $filepath =~ s/\.{2,}//g;
+        my $chome = &homeserver($cnum,$cdom);
+        unless ($chome eq 'no_host') {
+            my @ids=&current_machine_ids();
+            unless (grep(/^\Q$chome\E$/,@ids)) {
+                if (&is_course($cdom,$cnum)) {
+                    my $londocroot = $perlvar{'lonDocRoot'};
+                    if ($dest =~ m{^\Q$londocroot/priv/\E$match_domain/$match_username/.*\Q$filepath\E$}) {
+                        my $cmd = 'crsfilefrompriv:'.&escape($filepath).':'.&escape($cnum).':'.&escape($cdom);
+                        $result = &reply($cmd,$chome);
+                        unless (($result eq 'unknown_cmd') || ($result =~ /^error:/)) {
+                            my $url = &unescape($result);
+                            if ($url =~ m{^https?://[^/]+\Q/userfiles/$cdom/$cnum/priv/$filepath\E$}) {
+                                my $request=new HTTP::Request('GET',$url);
+                                my $response=&LONCAPA::LWPReq::makerequest($chome,$request,'',\%perlvar,1200,1);
+                                if ($response->is_error()) {
+                                    $result = 'error: '.$response->status_line;
+                                } else {
+                                    if (open(my $fh,'>',$dest)) {
+                                        print $fh $response->content;
+                                        close($fh);
+                                        $result = 'ok';
+                                    } else {
+                                        $result = 'error: nowrite';
+                                    }
+                                }
+                            } else {
+                                $result = 'error: invalidurl';
+                            }
+                        }
+                    }
+                }
+            }
+        }
+    }
+    return $result;
+}
+
 sub tokenwrapper {
     my $uri=shift;
     $uri=~s|^https?\://([^/]+)||;