[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.44 and 1.58

version 1.44, 2000/10/11 21:12:32 version 1.58, 2000/11/02 17:42:09
Line 24 Line 24
 # revokerole (udom,uname,url,role) : Revoke a role for url  # revokerole (udom,uname,url,role) : Revoke a role for url
 # revokecustomrole (udom,uname,url,rdom,rnam,rolename) : Revoke a custom role  # revokecustomrole (udom,uname,url,rdom,rnam,rolename) : Revoke a custom role
 # appenv(hash)       : adds hash to session environment  # appenv(hash)       : adds hash to session environment
   # delenv(varname)    : deletes all environment entries starting with varname
 # store(hash)        : stores hash permanently for this url  # store(hash)        : stores hash permanently for this url
   # cstore(hash)       : critical store
 # restore            : returns hash for this url  # restore            : returns hash for this url
 # eget(namesp,array) : returns hash with keys from array filled in from namesp  # eget(namesp,array) : returns hash with keys from array filled in from namesp
 # get(namesp,array)  : returns hash with keys from array filled in from namesp  # get(namesp,array)  : returns hash with keys from array filled in from namesp
 # del(namesp,array)  : deletes keys out of array from namesp  # del(namesp,array)  : deletes keys out of array from namesp
 # put(namesp,hash)   : stores hash in namesp  # put(namesp,hash)   : stores hash in namesp
   # cput(namesp,hash)  : critical put
 # dump(namesp)       : dumps the complete namespace into a hash  # dump(namesp)       : dumps the complete namespace into a hash
 # ssi(url,hash)      : does a complete request cycle on url to localhost, posts  # ssi(url,hash)      : does a complete request cycle on url to localhost, posts
 #                      hash  #                      hash
Line 39 Line 42
 # directcondval(index) : reading condition value of single condition from   # directcondval(index) : reading condition value of single condition from 
 #                        state string  #                        state string
 # condval(index)     : value of condition index based on state  # condval(index)     : value of condition index based on state
 # varval(name)       : value of a variable  # EXT(name)          : value of a variable
 # refreshstate()     : refresh the state information string  # refreshstate()     : refresh the state information string
 # symblist(map,hash) : Updates symbolic storage links  # symblist(map,hash) : Updates symbolic storage links
 # symbread([filename]) : returns the data handle (filename optional)  # symbread([filename]) : returns the data handle (filename optional)
Line 48 Line 51
 #                      be found, replicates and subscribes to the file  #                      be found, replicates and subscribes to the file
 # filelocation(dir,file) : returns a farily clean absolute reference to file   # filelocation(dir,file) : returns a farily clean absolute reference to file 
 #                          from the directory dir  #                          from the directory dir
   # hreflocation(dir,file) : same as filelocation, but for hrefs
   # log(domain,user,home,msg) : write to permanent log for user
 #  #
 # 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,  # 6/1/99,6/2,6/10,6/11,6/12,6/14,6/26,6/28,6/29,6/30,
 # 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,  # 7/1,7/2,7/9,7/10,7/12,7/14,7/15,7/19,
Line 62 Line 67
 # 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 Gerd Kortemeyer  # 10/06,10/09,10/10,10/11,10/14,10/20,10/23,10/25,10/26,10/27,10/28,10/29, 
   # 10/30,10/31,11/2 Gerd Kortemeyer
   
 package Apache::lonnet;  package Apache::lonnet;
   
Line 245  sub appenv { Line 251  sub appenv {
     }      }
     return 'ok';      return 'ok';
 }  }
   # ----------------------------------------------------- Delete from Environment
   
   sub delenv {
       my $delthis=shift;
       my %newenv=();
       if (($delthis=~/user\.role/) || ($delthis=~/user\.priv/)) {
           &logthis("<font color=blue>WARNING: ".
                   "Attempt to delete from environment ".$delthis);
           return 'error';
       }
       my @oldenv;
       {
        my $fh;
        unless ($fh=Apache::File->new("$ENV{'user.environment'}")) {
    return 'error';
        }
        @oldenv=<$fh>;
       }
       {
        my $fh;
        unless ($fh=Apache::File->new(">$ENV{'user.environment'}")) {
    return 'error';
        }
        map {
    unless ($_=~/^$delthis/) { print $fh $_; }
        } @oldenv;
       }
       return 'ok';
   }
   
 # ------------------------------ Find server with least workload from spare.tab  # ------------------------------ Find server with least workload from spare.tab
   
Line 423  sub ssi { Line 458  sub ssi {
   
 sub log {  sub log {
     my ($dom,$nam,$hom,$what)=@_;      my ($dom,$nam,$hom,$what)=@_;
     return reply("log:$dom:$nam:$what",$hom);      return critical("log:$dom:$nam:$what",$hom);
 }  }
   
 # ----------------------------------------------------------------------- Store  # ----------------------------------------------------------------------- Store
Line 444  sub store { Line 479  sub store {
  "$ENV{'user.home'}");   "$ENV{'user.home'}");
 }  }
   
   # -------------------------------------------------------------- Critical Store
   
   sub cstore {
       my %storehash=@_;
       my $symb;
       unless ($symb=escape(&symbread())) { return ''; }
       my $namespace;
       unless ($namespace=$ENV{'request.course.id'}) { return ''; }
       my $namevalue='';
       map {
           $namevalue.=escape($_).'='.escape($storehash{$_}).'&';
       } keys %storehash;
       $namevalue=~s/\&$//;
       return critical(
        "store:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$symb:$namevalue",
    "$ENV{'user.home'}");
   }
   
 # --------------------------------------------------------------------- Restore  # --------------------------------------------------------------------- Restore
   
 sub restore {  sub restore {
Line 470  sub restore { Line 523  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') {
        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 $normalid=$courseid;
              $normalid=~s/\//\_/g;
              my %envhash=();
            my %returnhash=('home'   => $chome,              my %returnhash=('home'   => $chome, 
                            'domain' => $cdomain,                             'domain' => $cdomain,
                            'num'    => $cnum);                             'num'    => $cnum);
Line 484  sub coursedescription { Line 540  sub coursedescription {
                $name=&unescape($name);                 $name=&unescape($name);
                $value=&unescape($value);                 $value=&unescape($value);
                $returnhash{$name}=$value;                 $returnhash{$name}=$value;
                if ($name eq 'description') {                 $envhash{'course.'.$normalid.'.'.$name}=$value;
    $cachehash{$courseid}=$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);             $envhash{'course.'.$normalid.'.last_cache'}=time;
              &appenv(%envhash);
            return %returnhash;             return %returnhash;
        }         }
     }      }
Line 529  sub rolesinit { Line 584  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 540  sub rolesinit { Line 596  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 645  sub put { Line 707  sub put {
                  $ENV{'user.home'});                   $ENV{'user.home'});
 }  }
   
   # ------------------------------------------------------ critical put interface
   
   sub cput {
      my ($namespace,%storehash)=@_;
      my $items='';
      map {
          $items.=escape($_).'='.escape($storehash{$_}).'&';
      } keys %storehash;
      $items=~s/\&$//;
      return critical
              ("put:$ENV{'user.domain'}:$ENV{'user.name'}:$namespace:$items",
                    $ENV{'user.home'});
   }
   
 # -------------------------------------------------------------- eget interface  # -------------------------------------------------------------- eget interface
   
 sub eget {  sub eget {
Line 670  sub eget { Line 746  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 and meta resources
   
     if (($uri=~/^adm\//) && ($priv eq 'bre')) {      if ((($uri=~/^adm\//) || ($uri=~/\.meta$/)) && ($priv eq 'bre')) {
  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 ($thisallowed=~/F/) {         if (($ENV{'HTTP_REFERER'}) && ($checkreferer)) {
   return 'F';    my $refuri=$ENV{'HTTP_REFERER'};
             $refuri=~s/^http\:\/\/$ENV{'request.host'}//i;
             $refuri=&declutter($refuri);
             my @uriparts=split(/\//,$refuri);
             my $filename=$uriparts[$#uriparts];
             my $pathname=$refuri;
             $pathname=~s/\/$filename$//;
             my @filenameparts=split(/\./,$uri);
             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 '';
        }      }
   
 # Get access priviledges for course  # Restrictions exist, deal with them
   #
   #   C:according to course preferences
   #   R:according to resource settings
   #   L:unless locked
   #   X:according to user session state
   #
   
        if ($ENV{'user.priv./'.$ENV{'request.course.id'}}=~/$priv\&([^\:]*)/) {  # Possibly locked functionality, check all courses
           $thisallowed.=$1;  # Locks might take effect only after 10 minutes cache expiration for other
   # courses, and 2 minutes for current course
   
       my $envkey;
       if ($thisallowed=~/L/) {
           foreach $envkey (keys %ENV) {
              if ($envkey=~/^user\.role\.(st|ta)\.([^\.]*)/) {
                  my $courseid=$2;
                  my $roleid=$1.'.'.$2;
                  my $expiretime=600;
                  if ($ENV{'request.role'} eq $roleid) {
     $expiretime=120;
                  }
          my ($cdom,$cnum,$csec)=split(/\//,$courseid);
                  my $prefix='course.'.$cdom.'_'.$cnum.'.';
                  if ((time-$ENV{$prefix.'last_cache'})>$expiretime) {
      &coursedescription($courseid);
                  }
                  if (($ENV{$prefix.'res.'.$uri.'.lock.sections'}=~/\,$csec\,/)
                   || ($ENV{$prefix.'res.'.$uri.'.lock.sections'} eq 'all')) {
      if ($ENV{$prefix.'res.'.$uri.'.lock.expire'}>time) {
                          &log($ENV{'user.domain'},$ENV{'user.name'},
                               $ENV{'user.host'},
                               'Locked by res: '.$priv.' for '.$uri.' due to '.
                               $cdom.'/'.$cnum.'/'.$csec.' expire '.
                               $ENV{$prefix.'priv.'.$priv.'.lock.expire'});
          return '';
                      }
                  }
                  if (($ENV{$prefix.'priv.'.$priv.'.lock.sections'}=~/\,$csec\,/)
                   || ($ENV{$prefix.'priv.'.$priv.'.lock.sections'} eq 'all')) {
      if ($ENV{'priv.'.$priv.'.lock.expire'}>time) {
                          &log($ENV{'user.domain'},$ENV{'user.name'},
                               $ENV{'user.host'},
                               'Locked by priv: '.$priv.' for '.$uri.' due to '.
                               $cdom.'/'.$cnum.'/'.$csec.' expire '.
                               $ENV{$prefix.'priv.'.$priv.'.lock.expire'});
          return '';
                      }
                  }
      }
        }         }
       }
      
   #
   # Rest of the restrictions depend on selected course
   #
   
 # See if resource or referer is part of this course      unless ($ENV{'request.course.id'}) {
                    return '1';
        my @uriparts=split(/\//,$uri);      }
        my $urifile=$uriparts[$#uriparts];  
        $urifile=~/\.(\w+)$/;  #
        my $uritype=$1;  # Now user is definitely in a course
        $#uriparts--;  #
        my $uripath=join('/',@uriparts);  
        my $uricond=-1;  
        if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$uripath}=~  # Course preferences
    /\&$urifile\:(\d+)\&/) {  
    $uricond=$1;     if ($thisallowed=~/C/) {
        } elsif (($fe{$uritype} eq 'emb') || ($fe{$uritype} eq 'img')) {         my $rolecode=(split(/\./,$ENV{'request.role'}))[0];
   my $refuri=$ENV{'HTTP_REFERER'};         if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.roles.denied'}
           $refuri=~s/^\/res//;     =~/\,$rolecode\,/) {
           $refuri=~s/^\///;             &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
           @uriparts=split(/\//,$refuri);                  'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
           $urifile=$uriparts[$#uriparts];                  $ENV{'request.course.id'});
           $#uriparts--;             return '';
           $uripath=join('/',@uriparts);  
           if ($ENV{'acc.res.'.$ENV{'request.course.id'}.'.'.$uripath}=~  
      /\&$urifile\:(\d+)\&/) {  
      $uricond=$1;  
   }  
        }         }
      }
   
        if ($uricond>=0) {  # Resource preferences
   
 # The resource is part of the course     if ($thisallowed=~/R/) {
 # If user had full access on course level, go ahead         my $rolecode=(split(/\./,$ENV{'request.role'}))[0];
          my $filename=$perlvar{'lonDocRoot'}.'/res/'.$uri.'.meta';
          if (-e $filename) {
              my @content;
              {
        my $fh=Apache::File->new($filename);
                @content=<$fh>;
      }
              if (join('',@content)=~
                       /\<roledeny[^\>]*\>[^\<]*$rolecode[^\<]*\<\/roledeny\>/) {
          &log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
                       'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
              return '';
   
            if ($thisallowed=~/F/) {  
        return 'F';  
            }             }
          }
      }
   
 # 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
Line 956  sub directcondval { Line 1152  sub directcondval {
 sub condval {  sub condval {
     my $condidx=shift;      my $condidx=shift;
     my $result=0;      my $result=0;
       my $allpathcond='';
       map {
          if (defined($ENV{'acc.cond.'.$ENV{'request.course.id'}.'.'.$_})) {
      $allpathcond.=
                  '('.$ENV{'acc.cond.'.$ENV{'request.course.id'}.'.'.$_}.')|';
          }
       } split(/\|/,$condidx);
       $allpathcond=~s/\|$//;
     if ($ENV{'request.course.id'}) {      if ($ENV{'request.course.id'}) {
        if (defined($ENV{'acc.cond.'.$ENV{'request.course.id'}.'.'.$condidx})) {         if ($allpathcond) {
           my $operand='|';            my $operand='|';
   my @stack;    my @stack;
           map {            map {
Line 980  sub condval { Line 1184  sub condval {
                      $result=$result>$new?$result:$new;                       $result=$result>$new?$result:$new;
                   }                                      }                  
               }                }
           } ($ENV{'acc.cond.'.$ENV{'request.course.id'}.'.'.$condidx}=~            } ($allpathcond=~/(\d+|\(|\)|\&|\|)/g);
              /(\d+|\(|\)|\&|\|)/g);  
        }         }
     }      }
     return $result;      return $result;
Line 989  sub condval { Line 1192  sub condval {
   
 # --------------------------------------------------------- Value of a Variable  # --------------------------------------------------------- Value of a Variable
   
 sub varval {  sub EXT {
     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='';
       }
       my $qualifierrest=$qualifier;
       if ($rest) { $qualifierrest.='.'.$rest; }
       my $spacequalifierrest=$space;
       if ($qualifierrest) { $spacequalifierrest.='.'.$qualifierrest; }
     if ($realm eq 'user') {      if ($realm eq 'user') {
  if ($space=~/^resource/) {  # --------------------------------------------------------------- user.resource
     $space=~s/^resource\[//;   if ($space eq 'resource') {
             $space=~s/\]$//;      my %restored=&restore;
               return $restored{$qualifierrest};
   # ----------------------------------------------------------------- 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',$qualifierrest))};
   # ----------------------------------------------------------------- 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 {
               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};
   # ------------------------------------------------------------ request.filename
         } else {          } else {
               return $ENV{'request.'.$spacequalifierrest};
         }          }
     } elsif ($realm eq 'course') {      } elsif ($realm eq 'course') {
     } elsif ($realm eq 'session') {  # ---------------------------------------------------------- course.description
           my $section='';
           if ($ENV{'request.course.sec'}) {
       $section='_'.$ENV{'request.course.sec'};
           }
           return $ENV{'course.'.$ENV{'request.course.id'}.$section.'.'.
                                 $spacequalifierrest};
       } elsif ($realm eq 'resource') {
   # ----------------------------------------------------------- resource metadata
    my $uri=&declutter($ENV{'request.filename'});
           my $filename=$perlvar{'lonDocRoot'}.'/res/'.$ENV.'.meta';
           if (-e $filename) {
               my @content;
               {
                my $fh=Apache::File->new($filename);
                @content=<$fh>;
               }
               if (join('',@content)=~
                    /\<$space[^\>]*\>([^\<]*)\<\/$space\>/) {
           return $1;
               } else {
                   return '';
               }
            }
       } elsif ($realm eq 'userdata') {
           my $uhome=&homeserver($qualifier,$space);
   # ----------------------------------------------- userdata.domain.name.resource
   # ---------------------------------------------------- Any other user namespace
       } elsif ($realm eq 'environment') {
   # ----------------------------------------------------------------- environment
           return $ENV{$spacequalifierrest};
     } 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
Line 1037  sub symbread { Line 1319  sub symbread {
     my %hash;      my %hash;
     my %bighash;      my %bighash;
     my $syval='';      my $syval='';
     if (($ENV{'request.course.fn'}) && ($ENV{'request.filename'})) {      if (($ENV{'request.course.fn'}) && ($thisfn)) {
         if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',          if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db',
                       &GDBM_READER,0640)) {                        &GDBM_READER,0640)) {
     $syval=$hash{$thisfn};      $syval=$hash{$thisfn};
Line 1144  sub filelocation { Line 1426  sub filelocation {
     $location = '/home/httpd/html/res'.$file;      $location = '/home/httpd/html/res'.$file;
   }    }
   $location=~s://+:/:g; # remove duplicate /    $location=~s://+:/:g; # remove duplicate /
   while ($location=~m:/../:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/..    while ($location=~m:/\.\./:) {$location=~ s:/[^/]+/\.\./:/:g;} #remove dir/..
   
   return $location;    return $location;
 }  }
   
   sub hreflocation {
       my ($dir,$file)=@_;
       unless (($_=~/^http:\/\//i) || ($_=~/^\//)) {
          my $finalpath=filelocation($dir,$file);
          $finalpath=~s/^\/home\/httpd\/html//;
          return $finalpath;
       } else {
          return $file;
       }
   }
   
 # ------------------------------------------------------------- Declutters URLs  # ------------------------------------------------------------- Declutters URLs
   
 sub declutter {  sub declutter {
Removed from v.1.44  
changed lines
  Added in v.1.58

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