[BACK]Return to Lond.pm CVS log [TXT] [DIR] Up to [LON-CAPA] / loncom

Diff for /loncom/Lond.pm between versions 1.24 and 1.25

version 1.24, 2023/06/20 13:27:42 version 1.25, 2023/12/28 18:14:08
Line 65  sub dump_with_regexp { Line 65  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       my $hashref = &tie_user_hash($udom, $uname, $namespace, &GDBM_READER()) or 
         return "error: ".($!+0)." tie(GDBM) Failed while attempting dump";          return "error: ".($!+0)." tie(GDBM) Failed while attempting dump";
   
Line 78  sub dump_with_regexp { Line 102  sub dump_with_regexp {
 #   # 
     my $skipcheck;      my $skipcheck;
     my @ids = &Apache::lonnet::current_machine_ids();      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     # If dump is for roles.db from a pre-2.10 server, determine the LON-CAPA   
 # version on the server which requested the data.   # version on the server which requested the data. 
Line 116  sub dump_with_regexp { Line 140  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 '.') {          if ($regexp eq '.') {
             $count++;              $count++;
             if (defined($range) && $count >= $end)   { last; }              if (defined($range) && $count >= $end)   { last; }
Line 131  sub dump_with_regexp { Line 175  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       &untie_user_hash($hashref) or 
         return "error: ".($!+0)." untie(GDBM) Failed while attempting dump";          return "error: ".($!+0)." untie(GDBM) Failed while attempting dump";
 #  #
Line 334  sub get_courseinfo_hash { Line 400  sub get_courseinfo_hash {
     return;      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 {  sub dump_course_id_handler {
     my ($tail) = @_;      my ($tail) = @_;
   
Removed from v.1.24  
changed lines
  Added in v.1.25

FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>