--- loncom/lonnet/perl/lonnet.pm 2002/05/07 19:16:15 1.213 +++ loncom/lonnet/perl/lonnet.pm 2002/05/16 17:21:05 1.220 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.213 2002/05/07 19:16:15 www Exp $ +# $Id: lonnet.pm,v 1.220 2002/05/16 17:21:05 harris41 Exp $ # # Copyright Michigan State University Board of Trustees # @@ -627,6 +627,7 @@ sub subscribe { sub repcopy { my $filename=shift; $filename=~s/\/+/\//g; + if ($filename=~/^\/home\/httpd\/html\/adm\//) { return OK; } my $transname="$filename.in.transfer"; if ((-e $filename) || (-e $transname)) { return OK; } my $remoteurl=subscribe($filename); @@ -716,7 +717,6 @@ sub flushcourselogs { &logthis('Flushing course log buffers'); foreach (keys %courselogs) { my $crsid=$_; - &logthis(":$crsid:$coursehombuf{$crsid}"); if (&reply('log:'.$coursedombuf{$crsid}.':'. &escape($courselogs{$crsid}), $coursehombuf{$crsid}) eq 'ok') { @@ -2196,8 +2196,19 @@ sub courseresdata { # --------------------------------------------------------- Value of a Variable sub EXT { - my ($varname,$symbparm)=@_; + my ($varname,$symbparm,$udom,$uname)=@_; + unless ($varname) { return ''; } + + #get real user name/domain, courseid and symb + my $courseid; + if (!($uname && $udom)) { + (my $cursymb,$courseid,$udom,$uname)=&Apache::lonxml::whichuser(); + if (!$symbparm) { $symbparm=$cursymb; } + } else { + $courseid=$ENV{'request.course.id'}; + } + my ($realm,$space,$qualifier,@therest)=split(/\./,$varname); my $rest; if ($therest[0]) { @@ -2212,19 +2223,28 @@ sub EXT { if ($realm eq 'user') { # --------------------------------------------------------------- user.resource if ($space eq 'resource') { - my %restored=&restore(); + my %restored=&restore(undef,undef,$udom,$uname); return $restored{$qualifierrest}; # ----------------------------------------------------------------- user.access } elsif ($space eq 'access') { + # FIXME - not supporting calls for a specific user return &allowed($qualifier,$rest); # ------------------------------------------ user.preferences, user.environment } elsif (($space eq 'preferences') || ($space eq 'environment')) { - return $ENV{join('.',('environment',$qualifierrest))}; + if (($uname eq $ENV{'user.name'}) && + ($udom eq $ENV{'user.domain'})) { + return $ENV{join('.',('environment',$qualifierrest))}; + } else { + my %returnhash=&userenvironment($udom,$uname,$qualifierrest); + return $returnhash{$qualifierrest}; + } # ----------------------------------------------------------------- user.course } elsif ($space eq 'course') { + # FIXME - not supporting calls for a specific user return $ENV{join('.',('request.course',$qualifier))}; # ------------------------------------------------------------------- user.role } elsif ($space eq 'role') { + # FIXME - not supporting calls for a specific user my ($role,$where)=split(/\./,$ENV{'request.role'}); if ($qualifier eq 'value') { return $role; @@ -2233,10 +2253,10 @@ sub EXT { } # ----------------------------------------------------------------- user.domain } elsif ($space eq 'domain') { - return $ENV{'user.domain'}; + return $udom; # ------------------------------------------------------------------- user.name } elsif ($space eq 'name') { - return $ENV{'user.name'}; + return $uname; # ---------------------------------------------------- Any other user namespace } else { my $item=($rest)?$qualifier.'.'.$rest:$qualifier; @@ -2253,112 +2273,112 @@ sub EXT { } } elsif ($realm eq 'course') { # ---------------------------------------------------------- course.description - return $ENV{'course.'.$ENV{'request.course.id'}.'.'. - $spacequalifierrest}; + return $ENV{'course.'.$courseid.'.'.$spacequalifierrest}; } elsif ($realm eq 'resource') { - if ($ENV{'request.course.id'}) { -# print '
'.$space.' - '.$qualifier.' - '.$spacequalifierrest; + if ($courseid eq $ENV{'request.course.id'}) { + #print '
'.$space.' - '.$qualifier.' - '.$spacequalifierrest; # ----------------------------------------------------- Cascading lookup scheme - my $symbp; - if ($symbparm) { - $symbp=$symbparm; - } else { - $symbp=&symbread(); - } - my $mapp=(split(/\_\_\_/,$symbp))[0]; - - my $symbparm=$symbp.'.'.$spacequalifierrest; - my $mapparm=$mapp.'___(all).'.$spacequalifierrest; - - my $seclevel= - $ENV{'request.course.id'}.'.['. - $ENV{'request.course.sec'}.'].'.$spacequalifierrest; - my $seclevelr= - $ENV{'request.course.id'}.'.['. - $ENV{'request.course.sec'}.'].'.$symbparm; - my $seclevelm= - $ENV{'request.course.id'}.'.['. - $ENV{'request.course.sec'}.'].'.$mapparm; - - my $courselevel= - $ENV{'request.course.id'}.'.'.$spacequalifierrest; - my $courselevelr= - $ENV{'request.course.id'}.'.'.$symbparm; - my $courselevelm= - $ENV{'request.course.id'}.'.'.$mapparm; + if (!$symbparm) { $symbparm=&symbread(); } + my $symbp=$symbparm; + my $mapp=(split(/\_\_\_/,$symbp))[0]; + + my $symbparm=$symbp.'.'.$spacequalifierrest; + my $mapparm=$mapp.'___(all).'.$spacequalifierrest; + + my $section; + if (($ENV{'user.name'} eq $uname) && + ($ENV{'user.domain'} eq $udom)) { + $section={'request.course.sec'}; + } else { + $section=&usection($udom,$uname,$courseid); + } -# ----------------------------------------------------------- first, check user - my %resourcedata=get('resourcedata', - [$courselevelr,$courselevelm,$courselevel]); - if (($resourcedata{$courselevelr}!~/^error\:/) && - ($resourcedata{$courselevelr}!~/^con_lost/)) { - - if ($resourcedata{$courselevelr}) { - return $resourcedata{$courselevelr}; } - if ($resourcedata{$courselevelm}) { - return $resourcedata{$courselevelm}; } - if ($resourcedata{$courselevel}) { return $resourcedata{$courselevel}; } + my $seclevel=$courseid.'.['.$section.'].'.$spacequalifierrest; + my $seclevelr=$courseid.'.['.$section.'].'.$symbparm; + my $seclevelm=$courseid.'.['.$section.'].'.$mapparm; + + my $courselevel=$courseid.'.'.$spacequalifierrest; + my $courselevelr=$courseid.'.'.$symbparm; + my $courselevelm=$courseid.'.'.$mapparm; - } else { - if ($resourcedata{$courselevelr}!~/No such file/) { - &logthis("WARNING:". - " Trying to get resource data for ".$ENV{'user.name'}." at " - .$ENV{'user.domain'}.": ".$resourcedata{$courselevelr}. - ""); - } - } +# ----------------------------------------------------------- first, check user + my %resourcedata=&get('resourcedata', + [$courselevelr,$courselevelm,$courselevel], + $udom,$uname); + if (($resourcedata{$courselevelr}!~/^error\:/) && + ($resourcedata{$courselevelr}!~/^con_lost/)) { + + if ($resourcedata{$courselevelr}) { + return $resourcedata{$courselevelr}; } + if ($resourcedata{$courselevelm}) { + return $resourcedata{$courselevelm}; } + if ($resourcedata{$courselevel}) { + return $resourcedata{$courselevel}; } + } else { + if ($resourcedata{$courselevelr}!~/No such file/) { + &logthis("WARNING:". + " Trying to get resource data for ". + $uname." at ".$udom.": ". + $resourcedata{$courselevelr}.""); + } + } # -------------------------------------------------------- second, check course - my $coursereply=&courseresdata( - $ENV{'course.'.$ENV{'request.course.id'}.'.num'}, - $ENV{'course.'.$ENV{'request.course.id'}.'.domain'}, - ($seclevelr,$seclevelm,$seclevel, - $courselevelr,$courselevelm,$courselevel)); - if ($coursereply) { return $coursereply; } + my $coursereply=&courseresdata($ENV{'course.'.$courseid.'.num'}, + $ENV{'course.'.$courseid.'.domain'}, + ($seclevelr,$seclevelm,$seclevel, + $courselevelr,$courselevelm, + $courselevel)); + if ($coursereply) { return $coursereply; } # ------------------------------------------------------ third, check map parms - my %parmhash=(); - my $thisparm=''; - if (tie(%parmhash,'GDBM_File', - $ENV{'request.course.fn'}.'_parms.db',&GDBM_READER,0640)) { - $thisparm=$parmhash{$symbparm}; - untie(%parmhash); - } - if ($thisparm) { return $thisparm; } - } - + my %parmhash=(); + my $thisparm=''; + if (tie(%parmhash,'GDBM_File', + $ENV{'request.course.fn'}.'_parms.db', + &GDBM_READER,0640)) { + $thisparm=$parmhash{$symbparm}; + untie(%parmhash); + } + if ($thisparm) { return $thisparm; } + } # --------------------------------------------- last, look in resource metadata - $spacequalifierrest=~s/\./\_/; - my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest); - if ($metadata) { return $metadata; } - $metadata=&metadata($ENV{'request.filename'}, - 'parameter_'.$spacequalifierrest); - if ($metadata) { return $metadata; } + $spacequalifierrest=~s/\./\_/; + my $metadata=&metadata($ENV{'request.filename'},$spacequalifierrest); + if ($metadata) { return $metadata; } + $metadata=&metadata($ENV{'request.filename'}, + 'parameter_'.$spacequalifierrest); + if ($metadata) { return $metadata; } # ------------------------------------------------------------------ Cascade up - - unless ($space eq '0') { - my ($part,$id)=split(/\_/,$space); - if ($id) { - my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest, - $symbparm); - if ($partgeneral) { return $partgeneral; } - } else { - my $resourcegeneral=&EXT('resource.0.'.$qualifierrest, - $symbparm); - if ($resourcegeneral) { return $resourcegeneral; } - } - } + unless ($space eq '0') { + my ($part,$id)=split(/\_/,$space); + if ($id) { + my $partgeneral=&EXT('resource.'.$part.'.'.$qualifierrest, + $symbparm,$udom,$uname); + if ($partgeneral) { return $partgeneral; } + } else { + my $resourcegeneral=&EXT('resource.0.'.$qualifierrest, + $symbparm,$udom,$uname); + if ($resourcegeneral) { return $resourcegeneral; } + } + } # ---------------------------------------------------- Any other user namespace } elsif ($realm eq 'environment') { # ----------------------------------------------------------------- environment - return $ENV{'environment.'.$spacequalifierrest}; + if (($uname eq $ENV{'user.name'})&&($udom eq $ENV{'user.domain'})) { + return $ENV{'environment.'.$spacequalifierrest}; + } else { + my %returnhash=&userenvironment($udom,$uname, + $spacequalifierrest); + return $returnhash{$spacequalifierrest}; + } } elsif ($realm eq 'system') { # ----------------------------------------------------------------- system.time if ($space eq 'time') { @@ -2524,19 +2544,33 @@ sub symblist { sub symbverify { my ($symb,$thisfn)=@_; $thisfn=&declutter($thisfn); - -# &logthis("Symb verify: $symb $thisfn"); - +# direct jump to resource in page or to a sequence - will construct own symbs + if ($thisfn=~/\.(page|sequence)$/) { return 1; } +# check URL part my ($map,$resid,$url)=split(/\_\_\_/,$symb); unless (&symbclean($url) eq &symbclean($thisfn)) { return 0; } - return 1; + $symb=&symbclean($symb); my %bighash; my $okay=0; if (tie(%bighash,'GDBM_File',$ENV{'request.course.fn'}.'.db', &GDBM_READER,0640)) { - + my $ids=$bighash{'ids_/res/'.$thisfn}; + unless ($ids) { + $ids=$bighash{'ids_/'.$thisfn}; + } + if ($ids) { +# ------------------------------------------------------------------- Has ID(s) + foreach (split(/\,/,$ids)) { + my ($mapid,$resid)=split(/\./,$_); + if ( + &symbclean(&declutter($bighash{'map_id_'.$mapid}).'___'.$resid.'___'.$thisfn) + eq $symb) { + $okay=1; + } + } + } untie(%bighash); } return $okay; @@ -2547,15 +2581,12 @@ sub symbverify { sub symbclean { my $symb=shift; -# &logthis("Symb in: $symb"); - # remove version from map $symb=~s/\.(\d+)\.(\w+)\_\_\_/\.$2\_\_\_/; + # remove version from URL $symb=~s/\.(\d+)\.(\w+)$/\.$2/; -# &logthis("Symb out: $symb"); - return $symb; } @@ -2768,13 +2799,37 @@ sub goodbye { } BEGIN { -# ------------------------------------------------------------ Read access.conf +# ------------------------------------------- Read access.conf and loncapa.conf +# (eventually access.conf will become deprecated) unless ($readit) { + { my $config=Apache::File->new("/etc/httpd/conf/access.conf"); while (my $configline=<$config>) { - if ($configline =~ /PerlSetVar/) { + if ($configline =~ /^[^\#]*PerlSetVar/) { + my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); + chomp($varvalue); + $perlvar{$varname}=$varvalue; + } + } +} +{ + my $config=Apache::File->new("/etc/httpd/conf/loncapa.conf"); + + while (my $configline=<$config>) { + if ($configline =~ /^[^\#]*PerlSetVar/) { + my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); + chomp($varvalue); + $perlvar{$varname}=$varvalue; + } + } +} +{ + my $config=Apache::File->new("/etc/httpd/conf/loncapa_apache.conf"); + + while (my $configline=<$config>) { + if ($configline =~ /^[^\#]*PerlSetVar/) { my ($dummy,$varname,$varvalue)=split(/\s+/,$configline); chomp($varvalue); $perlvar{$varname}=$varvalue;