--- loncom/Lond.pm	2023/06/20 13:27:42	1.24
+++ loncom/Lond.pm	2023/12/28 18:14:08	1.25
@@ -1,6 +1,6 @@
 # The LearningOnline Network
 #
-# $Id: Lond.pm,v 1.24 2023/06/20 13:27:42 raeburn Exp $
+# $Id: Lond.pm,v 1.25 2023/12/28 18:14:08 raeburn Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -65,6 +65,30 @@ sub dump_with_regexp {
         }
     }
 
+#
+# If dump is for file_permissions.db from a pre-2.12 server and
+# $uname:$udom is not a course, determine if value of portaccess
+# in effect for $uname:$udom allows portfolio files to be shared.
+# If sharing is not allowed, records returned for accesscontrol
+# are restricted to those based on ip (i.e., for externalresponse).
+#
+# Note: for 2.12 or later session-hosting server, determination
+# of portaccess value in effect occurs client-side.
+#
+    my ($check_portaccess,$access,$now,$major,$minor,%by_ip);
+    if ($namespace eq 'file_permissions') {
+        if ($clientversion =~ /^\'?(\d+)\.(\d+)\.[\w.\-]+\'?/) {
+            $major = $1;
+            $minor = $2;
+        }
+        unless ((($major > 2) || (($major == 2) && ($minor > 11))) ||
+                &is_course($udom,$uname)) {
+            $check_portaccess = 1;
+            $access = &portfolio_is_shareable($udom,$uname);
+        }
+        $now = time;
+    }
+
     my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER()) or 
         return "error: ".($!+0)." tie(GDBM) Failed while attempting dump";
 
@@ -78,7 +102,7 @@ sub dump_with_regexp {
 # 
     my $skipcheck;
     my @ids = &Apache::lonnet::current_machine_ids();
-    my (%homecourses, $major, $minor, $now);
+    my %homecourses;
 # 
 # If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA   
 # version on the server which requested the data. 
@@ -116,6 +140,26 @@ sub dump_with_regexp {
                     }
                 }
             }
+            if ($namespace eq 'file_permissions') {
+                if ($check_portaccess) {
+                    unless ($access) {
+                        my $unesckey = &unescape($key);
+                        if ($unesckey =~ m{\0((\d+)_\d+_\d+:([a-z]+)_(\d+)_(\d+))$}) {
+                            my ($acl,$timestamp,$scope,$end,$start) = ($1,$2,$3,$4);
+                            if ($scope eq 'ip') {
+                                unless (($start > $now) &&
+                                        ($end && $end<$now)) {
+                                    my ($path) = split(/\0/,$unesckey);
+                                    push(@{$by_ip{$path}},{$acl => $timestamp});
+                                }
+                            }
+                            next;
+                        } elsif ($unesckey =~ m{\0accesscontrol$}) {
+                            next;
+                        }
+                    }
+                }
+            }
         if ($regexp eq '.') {
             $count++;
             if (defined($range) && $count >= $end)   { last; }
@@ -131,7 +175,29 @@ sub dump_with_regexp {
             }
         }
     }
-
+    if (($namespace eq 'file_permissions') && ($check_portaccess) && (!$access)) {
+        if (keys(%by_ip)) {
+            my %accesscontrol;
+            foreach my $path (keys(%by_ip)) {
+                if (ref($by_ip{$path}) eq 'ARRAY') {
+                    foreach my $item (@{$by_ip{$path}}) {
+                        if (ref($item) eq 'HASH') {
+                            my ($acl,$timestamp) = each(%$item);
+                            my $key = &escape("$path\0$acl");
+                            my $value = $hashref->{$key};
+                            $qresult.= "$key=$value&";
+                            $accesscontrol{"$path\0accesscontrol"}{$acl} = $timestamp;
+                        }
+                    }
+                }
+            }
+            if (keys(%accesscontrol)) {
+                while (my ($key,$value) = each(%accesscontrol)) {
+                    $qresult.= &escape($key).'='.&Apache::lonnet::freeze_escape($value).'&';
+                }
+            }
+        }
+    }
     &untie_user_hash($hashref) or 
         return "error: ".($!+0)." untie(GDBM) Failed while attempting dump";
 #
@@ -334,6 +400,63 @@ sub get_courseinfo_hash {
     return;
 }
 
+sub portfolio_is_shareable {
+    my ($udom,$uname) = @_;
+    my $check_portaccess = 1;
+    my ($userportaccess,$inststatus,$access);
+    my $hashref = &tie_user_hash($udom, $uname, 'environment', &GDBM_READER());
+    if (ref($hashref) eq 'HASH') {
+        my $accesskey = &escape('tools.portaccess');
+        $userportaccess = $hashref->{$accesskey};
+        $inststatus = $hashref->{'inststatus'};
+        &untie_user_hash($hashref);
+    }
+    if ($userportaccess ne '') {
+        $access = $userportaccess;
+    } else {
+        my %domdefs = &Apache::lonnet::get_domain_defaults($udom);
+        if (ref($domdefs{'portaccess'}) eq 'HASH') {
+            if (($domdefs{'portaccess'}{'_LC_adv'} ne '') &&
+                (&Apache::lonnet::is_advanced_user($udom,$uname))) {
+                if ($domdefs{'portaccess'}{'_LC_adv'}) {
+                    $access = 1;
+                } else {
+                    $access = 0;
+                }
+            } elsif ($inststatus ne '') {
+                my ($hasaccess,$hasnoaccess);
+                foreach my $affiliation (split(/:/,$inststatus)) {
+                    if ($domdefs{'portaccess'}{$affiliation} ne '') {
+                        if ($domdefs{'portaccess'}{$affiliation}) {
+                            $hasaccess = 1;
+                        } else {
+                            $hasnoaccess = 1;
+                        }
+                    }
+                }
+                if ($hasaccess || $hasnoaccess) {
+                    if ($hasaccess) {
+                        $access = 1;
+                    } elsif ($hasnoaccess) {
+                        $access = 0;
+                    }
+                }
+            } else {
+                if ($domdefs{'portaccess'}{'default'} ne '') {
+                    if ($domdefs{'portaccess'}{'default'}) {
+                        $access = 1;
+                    } elsif ($domdefs{'portaccess'}{'default'} == 0) {
+                        $access = 0;
+                    }
+                }
+            }
+        } else {
+            $access = 1;
+        }
+    }
+    return $access;
+}
+
 sub dump_course_id_handler {
     my ($tail) = @_;