[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm
albertel
lon-capa-cvs@mail.lon-capa.org
Fri, 19 Mar 2004 16:45:25 -0000
This is a MIME encoded message
--albertel1079714725
Content-Type: text/plain
albertel Fri Mar 19 11:45:25 2004 EDT
Modified files:
/loncom/lonnet/perl lonnet.pm
Log:
- Need to quote variables in regexps that you just want to be strings. Sigh
- BUG#2849 fixe
--albertel1079714725
Content-Type: text/plain
Content-Disposition: attachment; filename="albertel-20040319114525.txt"
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.478 loncom/lonnet/perl/lonnet.pm:1.479
--- loncom/lonnet/perl/lonnet.pm:1.478 Tue Mar 16 16:29:31 2004
+++ loncom/lonnet/perl/lonnet.pm Fri Mar 19 11:45:25 2004
@@ -1,7 +1,7 @@
# The LearningOnline Network
# TCP networking package
#
-# $Id: lonnet.pm,v 1.478 2004/03/16 21:29:31 albertel Exp $
+# $Id: lonnet.pm,v 1.479 2004/03/19 16:45:25 albertel Exp $
#
# Copyright Michigan State University Board of Trustees
#
@@ -649,7 +649,7 @@
$uname=$ENV{'user.domain'} unless (defined($uname));
my %existing=&get('accesskeys',[$ckey],$cdom,$cnum);
if (($existing{$ckey}=~/^\#(.*)$/) || # - new key
- ($existing{$ckey}=~/^$uname\:$udom\#(.*)$/)) {
+ ($existing{$ckey}=~/^\Q$uname\E\:\Q$udom\E\#(.*)$/)) {
# assigned to this person
# - this should not happen,
# unless something went wrong
@@ -756,7 +756,7 @@
$udom=$ENV{'user.name'} unless (defined($udom));
$uname=$ENV{'user.domain'} unless (defined($uname));
my %existing=&get('accesskeys',[$ckey],$cdom,$cnum);
- return ($existing{$ckey}=~/^$uname\:$udom\#/);
+ return ($existing{$ckey}=~/^\Q$uname\E\:\Q$udom\E\#/);
}
# ------------------------------------- Find the section of student in a course
@@ -784,7 +784,7 @@
&homeserver($unam,$udom)))) {
my ($key,$value)=split(/\=/,$_);
$key=&unescape($key);
- next if ($key !~/^$courseid(?:\/)*(\w+)*\_st$/);
+ next if ($key !~/^\Q$courseid\E(?:\/)*(\w+)*\_st$/);
my $section=$1;
if ($key eq $courseid.'_st') { $section=''; }
my ($dummy,$end,$start)=split(/\_/,&unescape($value));
@@ -963,7 +963,7 @@
&homeserver($unam,$udom)))) {
my ($key,$value)=split(/\=/,$_);
$key=&unescape($key);
- if ($key=~/^$courseid(?:\/)*(\w+)*\_st$/) {
+ if ($key=~/^\Q$courseid\E(?:\/)*(\w+)*\_st$/) {
my $section=$1;
if ($key eq $courseid.'_st') { $section=''; }
my ($dummy,$end,$start)=split(/\_/,&unescape($value));
@@ -2629,14 +2629,14 @@
# Course
- if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'}=~/$priv\&([^\:]*)/) {
+ if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'}=~/\Q$priv\E\&([^\:]*)/) {
$thisallowed.=$1;
}
# Domain
if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.(split(/\//,$uri))[0].'/'}
- =~/$priv\&([^\:]*)/) {
+ =~/\Q$priv\E\&([^\:]*)/) {
$thisallowed.=$1;
}
@@ -2646,7 +2646,7 @@
$courseuri=~s/^([^\/])/\/$1/;
if ($ENV{'user.priv.'.$ENV{'request.role'}.'.'.$courseuri}
- =~/$priv\&([^\:]*)/) {
+ =~/\Q$priv\E\&([^\:]*)/) {
$thisallowed.=$1;
}
@@ -2664,7 +2664,7 @@
# If this is generating or modifying users, exit with special codes
- if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:'=~/\:$priv\:/) {
+ if (':csu:cdc:ccc:cin:cta:cep:ccr:cst:cad:cli:cau:cdg:cca:'=~/\:\Q$priv\E\:/) {
return $thisallowed;
}
#
@@ -2685,7 +2685,7 @@
if ($match) {
$statecond=$cond;
if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
- =~/$priv\&([^\:]*)/) {
+ =~/\Q$priv\E\&([^\:]*)/) {
$thisallowed.=$1;
$checkreferer=0;
}
@@ -2713,7 +2713,7 @@
if ($match) {
my $refstatecond=$cond;
if ($ENV{'user.priv.'.$ENV{'request.role'}.'./'.$courseprivid}
- =~/$priv\&([^\:]*)/) {
+ =~/\Q$priv\E\&([^\:]*)/) {
$thisallowed.=$1;
$uri=$refuri;
$statecond=$refstatecond;
@@ -2766,7 +2766,7 @@
if ((time-$ENV{$prefix.'last_cache'})>$expiretime) {
&coursedescription($courseid);
}
- if (($ENV{$prefix.'res.'.$uri.'.lock.sections'}=~/\,$csec\,/)
+ if (($ENV{$prefix.'res.'.$uri.'.lock.sections'}=~/\,\Q$csec\E\,/)
|| ($ENV{$prefix.'res.'.$uri.'.lock.sections'} eq 'all')) {
if ($ENV{$prefix.'res.'.$uri.'.lock.expire'}>time) {
&log($ENV{'user.domain'},$ENV{'user.name'},
@@ -2777,7 +2777,7 @@
return '';
}
}
- if (($ENV{$prefix.'priv.'.$priv.'.lock.sections'}=~/\,$csec\,/)
+ if (($ENV{$prefix.'priv.'.$priv.'.lock.sections'}=~/\,\Q$csec\E\,/)
|| ($ENV{$prefix.'priv.'.$priv.'.lock.sections'} eq 'all')) {
if ($ENV{'priv.'.$priv.'.lock.expire'}>time) {
&log($ENV{'user.domain'},$ENV{'user.name'},
@@ -2811,7 +2811,7 @@
my $rolecode=(split(/\./,$ENV{'request.role'}))[0];
my $unamedom=$ENV{'user.name'}.':'.$ENV{'user.domain'};
if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.roles.denied'}
- =~/$rolecode/) {
+ =~/\Q$rolecode\E/) {
&log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode.' in '.
$ENV{'request.course.id'});
@@ -2819,7 +2819,7 @@
}
if ($ENV{'course.'.$ENV{'request.course.id'}.'.'.$priv.'.users.denied'}
- =~/$unamedom/) {
+ =~/\Q$unamedom\E/) {
&log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
'Denied by user: '.$priv.' for '.$uri.' as '.$unamedom.' in '.
$ENV{'request.course.id'});
@@ -2831,7 +2831,7 @@
if ($thisallowed=~/R/) {
my $rolecode=(split(/\./,$ENV{'request.role'}))[0];
- if (&metadata($uri,'roledeny')=~/$rolecode/) {
+ if (&metadata($uri,'roledeny')=~/\Q$rolecode\E/) {
&log($ENV{'user.domain'},$ENV{'user.name'},$ENV{'user.host'},
'Denied by role: '.$priv.' for '.$uri.' as '.$rolecode);
return '';
@@ -2843,7 +2843,7 @@
if ($thisallowed=~/X/) {
if ($ENV{'acc.randomout'}) {
my $symb=&symbread($uri,1);
- if (($symb) && ($ENV{'acc.randomout'}=~/\&$symb\&/)) {
+ if (($symb) && ($ENV{'acc.randomout'}=~/\&\Q$symb\E\&/)) {
return '';
}
}
@@ -2907,27 +2907,27 @@
my ($rolename,$sysrole,$domrole,$courole)=@_;
foreach (split(':',$sysrole)) {
my ($crole,$cqual)=split(/\&/,$_);
- if ($pr{'cr:s'}!~/$crole/) { return "refused:s:$crole"; }
- if ($pr{'cr:s'}=~/$crole\&/) {
- if ($pr{'cr:s'}!~/$crole\&\w*$cqual/) {
+ if ($pr{'cr:s'}!~/\Q$crole\E/) { return "refused:s:$crole"; }
+ if ($pr{'cr:s'}=~/\Q$crole\E\&/) {
+ if ($pr{'cr:s'}!~/\Q$crole\E\&\w*\Q$cqual\E/) {
return "refused:s:$crole&$cqual";
}
}
}
foreach (split(':',$domrole)) {
my ($crole,$cqual)=split(/\&/,$_);
- if ($pr{'cr:d'}!~/$crole/) { return "refused:d:$crole"; }
- if ($pr{'cr:d'}=~/$crole\&/) {
- if ($pr{'cr:d'}!~/$crole\&\w*$cqual/) {
+ if ($pr{'cr:d'}!~/\Q$crole\E/) { return "refused:d:$crole"; }
+ if ($pr{'cr:d'}=~/\Q$crole\E\&/) {
+ if ($pr{'cr:d'}!~/\Q$crole\W\&\w*\Q$cqual\E/) {
return "refused:d:$crole&$cqual";
}
}
}
foreach (split(':',$courole)) {
my ($crole,$cqual)=split(/\&/,$_);
- if ($pr{'cr:c'}!~/$crole/) { return "refused:c:$crole"; }
- if ($pr{'cr:c'}=~/$crole\&/) {
- if ($pr{'cr:c'}!~/$crole\&\w*$cqual/) {
+ if ($pr{'cr:c'}!~/\Q$crole\E/) { return "refused:c:$crole"; }
+ if ($pr{'cr:c'}=~/\Q$crole\E\&/) {
+ if ($pr{'cr:c'}!~/\Q$crole\E\&\w*\Q$cqual\E/) {
return "refused:c:$crole&$cqual";
}
}
@@ -2974,7 +2974,7 @@
my $command=&escape(join(':',map{$_.'='.$filters{$_}} keys %filters));
my $queryid=&reply("querysend:".$query.':'.$udom.':'.$uname.':'.$command,
$uhome);
- unless ($queryid=~/^$uhost\_/) { return 'error: '.$queryid; }
+ unless ($queryid=~/^\Q$uhost\E\_/) { return 'error: '.$queryid; }
return get_query_reply($queryid);
}
@@ -4098,7 +4098,7 @@
my $olddis=$$metacache{':parameter_'.$allnames{$name}.'_'.$name.
'.display'};
my $expr='\\[Part: '.$allnames{$name}.'\\]';
- $olddis=~s/$expr/\[Part: 0\]/;
+ $olddis=~s/\Q$expr\E/\[Part: 0\]/;
$$metacache{"$key.display"}=$olddis;
}
}
@@ -4545,7 +4545,7 @@
} elsif ($file=~/^\/*uploaded/) { # is an uploaded file
$location=$file;
} else {
- $file=~s/^$perlvar{'lonDocRoot'}//;
+ $file=~s/^\Q$perlvar{'lonDocRoot'}\E//;
$file=~s:^/res/:/:;
if ( !( $file =~ m:^/:) ) {
$location = $dir. '/'.$file;
@@ -4602,7 +4602,7 @@
sub declutter {
my $thisfn=shift;
- $thisfn=~s/^$perlvar{'lonDocRoot'}//;
+ $thisfn=~s/^\Q$perlvar{'lonDocRoot'}\E//;
$thisfn=~s/^\///;
$thisfn=~s/^res\///;
$thisfn=~s/\?.+$//;
--albertel1079714725--