--- loncom/lonnet/perl/lonnet.pm 2002/05/08 15:21:04 1.215 +++ loncom/lonnet/perl/lonnet.pm 2002/05/11 20:42:00 1.217 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.215 2002/05/08 15:21:04 www Exp $ +# $Id: lonnet.pm,v 1.217 2002/05/11 20:42:00 harris41 Exp $ # # Copyright Michigan State University Board of Trustees # @@ -2524,23 +2524,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; } -# FIXME: done for now - 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; @@ -2769,13 +2779,26 @@ 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;