--- loncom/lonnet/perl/lonnet.pm 2002/05/05 01:59:42 1.210 +++ loncom/lonnet/perl/lonnet.pm 2002/05/08 17:40:03 1.216 @@ -1,7 +1,7 @@ # The LearningOnline Network # TCP networking package # -# $Id: lonnet.pm,v 1.210 2002/05/05 01:59:42 www Exp $ +# $Id: lonnet.pm,v 1.216 2002/05/08 17:40:03 www 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') { @@ -1139,6 +1139,7 @@ sub store { if ($stuname) { $home=&homeserver($stuname,$domain); } + $symb=&symbclean($symb); if (!$symb) { unless ($symb=&symbread()) { return ''; } } &devalidate($symb); @@ -1169,6 +1170,7 @@ sub cstore { if ($stuname) { $home=&homeserver($stuname,$domain); } + $symb=&symbclean($symb); if (!$symb) { unless ($symb=&symbread()) { return ''; } } &devalidate($symb); @@ -1204,7 +1206,7 @@ sub restore { if (!$symb) { unless ($symb=escape(&symbread())) { return ''; } } else { - $symb=&escape($symb); + $symb=&escape(&symbclean($symb)); } if (!$namespace) { unless ($namespace=$ENV{'request.course.id'}) { @@ -2507,7 +2509,7 @@ sub symblist { if (tie(%hash,'GDBM_File',$ENV{'request.course.fn'}.'_symb.db', &GDBM_WRCREAT,0640)) { foreach (keys %newhash) { - $hash{declutter($_)}=&symbclean($mapname.'___'.$newhash{$_}); + $hash{declutter($_)}=$mapname.'___'.$newhash{$_}; } if (untie(%hash)) { return 'ok'; @@ -2517,14 +2519,54 @@ sub symblist { return 'error'; } +# --------------------------------------------------------------- Verify a symb + +sub symbverify { + my ($symb,$thisfn)=@_; + $thisfn=&declutter($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; } + + $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; +} + # --------------------------------------------------------------- Clean-up symb sub symbclean { my $symb=shift; + # remove version from map $symb=~s/\.(\d+)\.(\w+)\_\_\_/\.$2\_\_\_/; + # remove version from URL $symb=~s/\.(\d+)\.(\w+)$/\.$2/; + return $symb; }