[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.48 and 1.52

version 1.48, 2000/10/25 10:55: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,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 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 1076  sub varval { Line 1155  sub varval {
     } elsif ($realm eq 'course') {      } elsif ($realm eq 'course') {
 # ---------------------------------------------------------- course.description  # ---------------------------------------------------------- course.description
         if ($space eq 'description') {          if ($space eq 'description') {
     return &coursedescription($ENV{'request.course.id'});              my %reply=&coursedescription($ENV{'request.course.id'});
               return $reply{'description'};
 # ------------------------------------------------------------------- course.id  # ------------------------------------------------------------------- course.id
         } elsif ($space eq 'id') {          } elsif ($space eq 'id') {
             return $ENV{'request.course.id'};              return $ENV{'request.course.id'};
Removed from v.1.48  
changed lines
  Added in v.1.52

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