[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.49 and 1.53

version 1.49, 2000/10/25 20:52:31 version 1.53, 2000/10/28 19:26:07
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,10/23,10/25 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 498  sub coursedescription { Line 499  sub coursedescription {
     if ($chome ne 'no_host') {      if ($chome ne 'no_host') {
        my $rep=reply("dump:$cdomain:$cnum:environment",$chome);         my $rep=reply("dump:$cdomain:$cnum:environment",$chome);
        if ($rep ne 'con_lost') {         if ($rep ne 'con_lost') {
    my %cachehash=();             my %envhash=();
            my %returnhash=('home'   => $chome,              my %returnhash=('home'   => $chome, 
                            'domain' => $cdomain,                             'domain' => $cdomain,
                            'num'    => $cnum);                             'num'    => $cnum);
Line 507  sub coursedescription { Line 508  sub coursedescription {
                $name=&unescape($name);                 $name=&unescape($name);
                $value=&unescape($value);                 $value=&unescape($value);
                $returnhash{$name}=$value;                 $returnhash{$name}=$value;
                if ($name eq 'description') {                 my $normalid=$courseid;
    $cachehash{$courseid}=$value;                 $normalid=~s/\//\_/g;
                }                 $envhash{'course.'.$normalid.'.'.$name}=$value;
            } split(/\&/,$rep);             } split(/\&/,$rep);
            $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);             &appenv(%envhash);
            return %returnhash;             return %returnhash;
        }         }
     }      }
Line 552  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 563  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 707  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 716  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;
       my $courseprivid='';
   
   # Course
   
       if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'}=~/$priv\&([^\:]*)/) {
          $thisallowed.=$1;
       }
   
   # Domain
   
       if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.(split(/\//,$uri))[0].'/'}
          =~/$priv\&([^\:]*)/) {
        $thisallowed.=$1;         $thisallowed.=$1;
     }      }
     if ($ENV{'user.priv./'.(split(/\//,$uri))[0].'/'}=~/$priv\&([^\:]*)/) {  
   # Course: uri itself is a course
   
       if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$uri}
          =~/$priv\&([^\:]*)/) {
        $thisallowed.=$1;         $thisallowed.=$1;
     }      }
   
 # Full access at system or domain level? Exit.  # Full access at system, domain or course-wide level? Exit.
   
     if ($thisallowed=~/F/) {      if ($thisallowed=~/F/) {
  return 'F';   return 'F';
     }      }
   
 # The user does not have full access at system or domain level  # If this is generating or modifying users, exit with special codes
 # Course level access control  
   
 # uri itself refering to a course?      if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:'=~/\:$priv\:/) {
        return $thisallowed;
     if ($uri=~/\.course$/) {      }
        if ($ENV{'user.priv./'.$uri}=~/$priv\&([^\:]*)/) {  #
           $thisallowed.=$1;  # 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{'request.course.id'}) {
          $courseprivid=$ENV{'request.course.id'};
          if ($ENV{'request.course.sec'}) {
             $courseprivid.='/'.$ENV{'request.course.sec'};
          }
          $courseprivid=~s/\_/\//;
          my $checkreferer=1;
          my @uriparts=split(/\//,$uri);
          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;
                  $checkreferer=0;
              }
        }         }
 # Full access on course level? Exit.         if (($ENV{'HTTP_REFERER'}) && ($checkreferer)) {
        if ($thisallowed=~/F/) {    my $refuri=&declutter($ENV{'HTTP_REFERER'});
   return 'F';            my @uriparts=split(/\//,$refuri);
             my $filename=$uriparts[$#uriparts];
             my $pathname=$refuri;
             $pathname=~s/\/$filename$//;
             my @filenameparts=split(/\./,$filename);
             if (&fileembstyle($filenameparts[$#filenameparts]) ne 'ssi') {
               if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$pathname}=~
                 /\&$filename\:(\d+)\&/) {
                 my $refstatecond=$1;
                 if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
                     =~/$priv\&([^\:]*)/) {
                     $thisallowed.=$1;
                     $uri=$refuri;
                     $statecond=$refstatecond;
                 }
               }
             }
        }         }
      }
   
 # uri is refering to an individual resource; user needs to be in a course  #
   # Gathered now: all priviledges that could apply, and condition number
   # 
   #
   # Full or no access?
   #
   
    } else {      if ($thisallowed=~/F/) {
    return 'F';
       }
   
        unless(defined($ENV{'request.course.id'})) {      unless ($thisallowed) {
    return '1';          return '';
       }
   
   # Restrictions exist, deal with them
   #
   #   C:according to course preferences
   #   R:according to resource settings
   #   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 '';
                      }
                  }
      }
        }         }
       }
      
   #
   # Rest of the restrictions depend on selected course
   #
   
 # Get access priviledges for course      unless ($ENV{'request.course.id'}) {
          return '1';
       }
   
        if ($ENV{'user.priv./'.$ENV{'request.course.id'}}=~/$priv\&([^\:]*)/) {  #
           $thisallowed.=$1;  # Now user is definitely in a course
        }  #
   
 # See if resource or referer is part of this course  
             
        my @uriparts=split(/\//,$uri);  
        my $urifile=$uriparts[$#uriparts];  
        $urifile=~/\.(\w+)$/;  
        my $uritype=$1;  
        $#uriparts--;  
        my $uripath=join('/',@uriparts);  
        my $uricond=-1;  
        if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$uripath}=~  
    /\&$urifile\:(\d+)\&/) {  
    $uricond=$1;  
        } elsif (($fe{$uritype} eq 'emb') || ($fe{$uritype} eq 'img')) {  
   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 ($uricond>=0) {  # Course preferences
   
 # The resource is part of the course     if ($thisallowed=~/C/) {
 # If user had full access on course level, go ahead  #
   # Registered course preferences from environment
   #
      }
   
            if ($thisallowed=~/F/) {  # Resource preferences
        return 'F';  
            }     if ($thisallowed=~/R/) {
   #
   # Resource Metadata
   #
      }
   
 # Restricted by state?  # Restricted by state?
   
            if ($thisallowed=~/X/) {     if ($thisallowed=~/X/) {
       if (&condval($uricond)) {        if (&condval($statecond)) {
          return '2';   return '2';
               } else {        } else {
                  return '';           return '';
               }        }
    }     }
        }  
     }     return 'F';
     return $thisallowed;  
 }  }
   
 # ---------------------------------------------------------- Refresh State Info  # ---------------------------------------------------------- Refresh State Info
Removed from v.1.49  
changed lines
  Added in v.1.53

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