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

Diff for /loncom/lonnet/perl/lonnet.pm between versions 1.47 and 1.52

version 1.47, 2000/10/20 10:57:46 version 1.52, 2000/10/28 17:26:35
Line 66 Line 66
 # 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30 Gerd Kortemeyer  # 08/22,08/28,08/31,09/01,09/02,09/04,09/05,09/25,09/28,09/30 Gerd Kortemeyer
 # 10/04 Gerd Kortemeyer  # 10/04 Gerd Kortemeyer
 # 10/04 Guy Albertelli  # 10/04 Guy Albertelli
 # 10/06,10/09,10/10,10/11,10/14,10/20 Gerd Kortemeyer  # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28 
   # Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 492  sub restore { Line 493  sub restore {
 sub coursedescription {  sub coursedescription {
     my $courseid=shift;      my $courseid=shift;
     $courseid=~s/^\///;      $courseid=~s/^\///;
       $courseid=~s/\_/\//g;
     my ($cdomain,$cnum)=split(/\//,$courseid);      my ($cdomain,$cnum)=split(/\//,$courseid);
     my $chome=homeserver($cnum,$cdomain);      my $chome=homeserver($cnum,$cdomain);
     if ($chome ne 'no_host') {      if ($chome ne 'no_host') {
Line 513  sub coursedescription { Line 515  sub coursedescription {
            $returnhash{'url'}='/res/'.declutter($returnhash{'url'});             $returnhash{'url'}='/res/'.declutter($returnhash{'url'});
            $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.             $returnhash{'fn'}=$perlvar{'lonDaemons'}.'/tmp/'.
        $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;         $ENV{'user.name'}.'_'.$cdomain.'_'.$cnum;
    put ('coursedescriptions',%cachehash);     put ('nohist_coursedescriptions',%cachehash);
            return %returnhash;             return %returnhash;
        }         }
     }      }
Line 551  sub rolesinit { Line 553  sub rolesinit {
                 }                  }
             }              }
             if (($area ne '') && ($trole ne '')) {              if (($area ne '') && ($trole ne '')) {
          my $spec=$trole.'.'.$area;
                my ($tdummy,$tdomain,$trest)=split(/\//,$area);                 my ($tdummy,$tdomain,$trest)=split(/\//,$area);
                if ($trole =~ /^cr\//) {                 if ($trole =~ /^cr\//) {
    my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);     my ($rdummy,$rdomain,$rauthor,$rrole)=split(/\//,$trole);
Line 562  sub rolesinit { Line 565  sub rolesinit {
                       if (($roledef ne 'con_lost') && ($roledef ne '')) {                        if (($roledef ne 'con_lost') && ($roledef ne '')) {
                          my ($syspriv,$dompriv,$coursepriv)=                           my ($syspriv,$dompriv,$coursepriv)=
      split(/\_/,unescape($roledef));       split(/\_/,unescape($roledef));
                   $allroles{'/'}.=':'.$syspriv;                    $allroles{'cm./'}.=':'.$syspriv;
                            $allroles{$spec.'./'}.=':'.$syspriv;
                          if ($tdomain ne '') {                           if ($tdomain ne '') {
                              $allroles{'/'.$tdomain.'/'}.=':'.$dompriv;                               $allroles{'cm./'.$tdomain.'/'}.=':'.$dompriv;
                                $allroles{$spec.'./'.$tdomain.'/'}.=':'.$dompriv;
                              if ($trest ne '') {                               if ($trest ne '') {
                 $allroles{$area}.=':'.$coursepriv;                  $allroles{'cm.'.$area}.=':'.$coursepriv;
                   $allroles{$spec.'.'.$area}.=':'.$coursepriv;
                              }                               }
                  }                   }
                       }                        }
                    }                     }
                } else {                 } else {
            $allroles{'/'}.=':'.$pr{$trole.':s'};             $allroles{'cm./'}.=':'.$pr{$trole.':s'};
              $allroles{$spec.'./'}.=':'.$pr{$trole.':s'};
                    if ($tdomain ne '') {                     if ($tdomain ne '') {
                       $allroles{'/'.$tdomain.'/'}.=':'.$pr{$trole.':d'};                       $allroles{'cm./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
                        $allroles{$spec.'./'.$tdomain.'/'}.=':'.$pr{$trole.':d'};
                       if ($trest ne '') {                        if ($trest ne '') {
           $allroles{$area}.=':'.$pr{$trole.':c'};            $allroles{'cm.'.$area}.=':'.$pr{$trole.':c'};
             $allroles{$spec.'.'.$area}.=':'.$pr{$trole.':c'};
                       }                        }
            }             }
        }         }
Line 706  sub eget { Line 715  sub eget {
   
 sub allowed {  sub allowed {
     my ($priv,$uri)=@_;      my ($priv,$uri)=@_;
     $uri=~s/^\/res//;      $uri=&declutter($uri);
     $uri=~s/^\///;  
   
 # Free bre access to adm resources  # Free bre access to adm resources
   
Line 715  sub allowed { Line 723  sub allowed {
  return 'F';   return 'F';
     }      }
   
 # Gather priviledges over system and domain  
   
     my $thisallowed='';      my $thisallowed='';
     if ($ENV{'user.priv./'}=~/$priv\&([^\:]*)/) {      my $statecond=0;
        $thisallowed.=$1;      my $courseprivid='';
     }  
     if ($ENV{'user.priv./'.(split(/\//,$uri))[0].'/'}=~/$priv\&([^\:]*)/) {  # Course
   
       if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'}=~/$priv\&([^\:]*)/) {
        $thisallowed.=$1;         $thisallowed.=$1;
     }      }
   
 # Full access at system or domain level? Exit.  # Domain
   
     if ($thisallowed=~/F/) {      if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.(split(/\//,$uri))[0].'/'}
  return 'F';         =~/$priv\&([^\:]*)/) {
          $thisallowed.=$1;
     }      }
   
 # The user does not have full access at system or domain level  # Course: uri itself is a course
 # Course level access control  
   
 # uri itself refering to a course?      if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$uri}
              =~/$priv\&([^\:]*)/) {
     if ($uri=~/\.course$/) {         $thisallowed.=$1;
        if ($ENV{'user.priv./'.$uri}=~/$priv\&([^\:]*)/) {      }
           $thisallowed.=$1;  
        }  
 # Full access on course level? Exit.  
        if ($thisallowed=~/F/) {  
   return 'F';  
        }  
   
 # uri is refering to an individual resource; user needs to be in a course  # Full access at system, domain or course-wide level? Exit.
   
    } else {      if ($thisallowed=~/F/) {
    return 'F';
       }
   
        unless(defined($ENV{'request.course.id'})) {  # If this is generating or modifying users, exit with special codes
    return '1';  
        }  
   
 # Get access priviledges for course      if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:'=~/\:$priv\:/) {
    return $thisallowed;
       }
   #
   # Gathered so far: system, domain and course wide priviledges
   #
   # Course: See if uri or referer is an individual resource that is part of 
   # the course
   
        if ($ENV{'user.priv./'.$ENV{'request.course.id'}}=~/$priv\&([^\:]*)/) {      if ($ENV{'request.course.id'}) {
           $thisallowed.=$1;         $courseprivid=$ENV{'request.course.id'};
          if ($ENV{'request.course.sec'}) {
             $courseprivid.='/'.$ENV{'request.course.sec'};
        }         }
          $courseprivid=~s/\_/\//;
 # See if resource or referer is part of this course         my $checkreferer=1;
             
        my @uriparts=split(/\//,$uri);         my @uriparts=split(/\//,$uri);
        my $urifile=$uriparts[$#uriparts];         my $filename=$uriparts[$#uriparts];
        $urifile=~/\.(\w+)$/;         my $pathname=$uri;
        my $uritype=$1;         $pathname=~s/\/$filename$//;
        $#uriparts--;         if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
        my $uripath=join('/',@uriparts);             /\&$filename\:(\d+)\&/) {
        my $uricond=-1;             $statecond=$1;
        if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$uripath}=~             if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
    /\&$urifile\:(\d+)\&/) {                 =~/$priv\&([^\:]*)/) {
    $uricond=$1;                 $thisallowed.=$1;
        } elsif (($fe{$uritype} eq 'emb') || ($fe{$uritype} eq 'img')) {                 $checkreferer=0;
   my $refuri=$ENV{'HTTP_REFERER'};             }
           $refuri=~s/^\/res//;  
           $refuri=~s/^\///;  
           @uriparts=split(/\//,$refuri);  
           $urifile=$uriparts[$#uriparts];  
           $#uriparts--;  
           $uripath=join('/',@uriparts);  
           if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$uripath}=~  
      /\&$urifile\:(\d+)\&/) {  
      $uricond=$1;  
   }  
        }         }
          if (($ENV{'HTTP_REFERER'}) && ($checkreferer)) {
             my @uriparts=split(/\//,&declutter($ENV{'HTTP_REFERER'}));
             my $filename=$uriparts[$#uriparts];
             my $pathname=$uri;
             $pathname=~s/\/$filename$//;
             if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
                 /\&$filename\:(\d+)\&/) {
                 $statecond=$1;
                 if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
                     =~/$priv\&([^\:]*)/) {
                     $thisallowed.=$1;
                 }
             }
          }
      }
   
        if ($uricond>=0) {  #
   # Gathered now: all priviledges that could apply, and condition number
 # The resource is part of the course  # 
 # If user had full access on course level, go ahead  #
   # Full or no access?
   #
   
            if ($thisallowed=~/F/) {      if ($thisallowed=~/F/) {
        return 'F';   return 'F';
            }      }
   
 # Restricted by state?      unless ($thisallowed) {
           return '';
       }
   
            if ($thisallowed=~/X/) {  # Restrictions exist, deal with them
       if (&condval($uricond)) {  #
          return '2';  #   C:according to course preferences
               } else {  #   R:according to resource settings
                  return '';  #   L:unless locked
               }  #   X:according to user session state
   #
   
   # Possibly locked functionality, check all courses
   
       my $envkey;
       if ($thisallowed=~/L/) {
           foreach $envkey (keys %ENV) {
              if ($envkey=~/^user\.role\.st\.([^\.]*)/) {
          my ($cdom,$cnum,$csec)=split(/\//,$1);
                  my %locks=();
                  map {
                      my ($name,$value)=split(/\=/,$_);
                      $locks{&unescape($name)}=&unescape($value);
                  } split(/\&/,&reply('get:'.$cdom.':'.$cnum.
                    ':environment:'.&escape('priv.'.$priv.'.lock.sections').
                                ':'.&escape('priv.'.$priv.'.lock.expire').
                                ':'.&escape('res.'.$uri.'.lock.sections').
        ':'.&escape('res.'.$uri.'.lock.expire'),
                     &homeserver($cnum,$cdom)));
                  if (($locks{'res.'.$uri.'.lock.sections'}=~/\,$csec\,/) ||
                      ($locks{'res.'.$uri.'.lock.sections'} eq 'all')) {
      if ($locks{'res.'.$uri.'.lock.expire'}>time) {
                          &log('Locked by res: '.$priv.' for '.$uri.' due to '.
                               $cdom.'/'.$cnum.'/'.$csec.' expire '.
                               $locks{'priv.'.$priv.'.lock.expire'});
          return '';
                      }
                  }
                  if (($locks{'priv.'.$priv.'.lock.sections'}=~/\,$csec\,/) ||
                      ($locks{'priv.'.$priv.'.lock.sections'} eq 'all')) {
      if ($locks{'priv.'.$priv.'.lock.expire'}>time) {
                          &log('Locked by priv: '.$priv.' for '.$uri.' due to '.
                               $cdom.'/'.$cnum.'/'.$csec.' expire '.
                               $locks{'priv.'.$priv.'.lock.expire'});
          return '';
                      }
                  }
    }     }
        }         }
     }      }
     return $thisallowed;     
   #
   # Rest of the restrictions depend on selected course
   #
   
       unless ($ENV{'request.course.id'}) {
          return '1';
       }
   
   #
   # Now user is definitely in a course
   #
   
   # Restricted by state?
   
      if ($thisallowed=~/X/) {
         if (&condval($statecond)) {
    return '2';
         } else {
            return '';
         }
      }
   
      return 'F';
 }  }
   
 # ---------------------------------------------------------- Refresh State Info  # ---------------------------------------------------------- Refresh State Info
Line 1026  sub condval { Line 1105  sub condval {
 # --------------------------------------------------------- Value of a Variable  # --------------------------------------------------------- Value of a Variable
   
 sub varval {  sub varval {
     my ($realm,$space,@components)=split(/\./,shift);      my $varname=shift;
     my $value='';      my ($realm,$space,$qualifier,@therest)=split(/\./,$varname);
       my $rest;
       if ($therest[0]) {
          $rest=join('.',@therest);
       } else {
          $rest='';
       }
     if ($realm eq 'user') {      if ($realm eq 'user') {
  if ($space=~/^resource/) {  # --------------------------------------------------------------- user.resource
     $space=~s/^resource\[//;   if ($space eq 'resource') {
             $space=~s/\]$//;  # ----------------------------------------------------------------- user.access
           } elsif ($space eq 'access') {
               return &allowed($qualifier,$rest);
   # ------------------------------------------ user.preferences, user.environment
           } elsif (($space eq 'preferences') || ($space eq 'environment')) {
               return $ENV{join('.',('environment',$qualifier,$rest))};
   # ----------------------------------------------------------------- user.course
           } elsif ($space eq 'course') {
               return $ENV{join('.',('request.course',$qualifier))};
   # ------------------------------------------------------------------- user.role
           } elsif ($space eq 'role') {
               my ($role,$where)=split(/\./,$ENV{'request.role'});
               if ($qualifier eq 'value') {
    return $role;
               } elsif ($qualifier eq 'extent') {
                   return $where;
               }
   # ----------------------------------------------------------------- user.domain
           } elsif ($space eq 'domain') {
               return $ENV{'user.domain'};
   # ------------------------------------------------------------------- user.name
           } elsif ($space eq 'name') {
               return $ENV{'user.name'};
   # ---------------------------------------------------- Any other user namespace
         } else {          } else {
               my $item=($rest)?$qualifier.'.'.$rest:$qualifier;
               my %reply=&get($space,$item);
               return $reply{$item};
           }
       } elsif ($realm eq 'request') {
   # ------------------------------------------------------------- request.browser
           if ($space eq 'browser') {
       return $ENV{'browser.'.$qualifier};
           } elsif ($space eq 'filename') {
               return $ENV{'request.filename'};
         }          }
     } elsif ($realm eq 'course') {      } elsif ($realm eq 'course') {
     } elsif ($realm eq 'session') {  # ---------------------------------------------------------- course.description
           if ($space eq 'description') {
               my %reply=&coursedescription($ENV{'request.course.id'});
               return $reply{'description'};
   # ------------------------------------------------------------------- course.id
           } elsif ($space eq 'id') {
               return $ENV{'request.course.id'};
   # -------------------------------------------------- Any other course namespace
           } else {
       my ($cdom,$cnam)=split(/\_/,$ENV{'request.course.id'});
       my $chome=&homeserver($cnam,$cdom);
               my $item=join('.',($qualifier,$rest));
               return &unescape
                      (&reply('get:'.$cdom.':'.$cnam.':'.&escape($space).':'.
      &escape($item),$chome));
           }
       } elsif ($realm eq 'userdata') {
           my $uhome=&homeserver($qualifier,$space);
   # ----------------------------------------------- userdata.domain.name.resource
   # ---------------------------------------------------- Any other user namespace
       } elsif ($realm eq 'environment') {
   # ----------------------------------------------------------------- environment
           return $ENV{join('.',($space,$qualifier,$rest))};
     } elsif ($realm eq 'system') {      } elsif ($realm eq 'system') {
   # ----------------------------------------------------------------- system.time
    if ($space eq 'time') {
       return time;
           }
     }      }
     return $value;      return '';
 }  }
   
 # ------------------------------------------------- Update symbolic store links  # ------------------------------------------------- Update symbolic store links
Removed from v.1.47  
changed lines
  Added in v.1.52

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