[LON-CAPA-cvs] cvs: loncom /lonnet/perl lonnet.pm /publisher lonrights.pm /xml londefdef.pm

albertel lon-capa-cvs-allow@mail.lon-capa.org
Fri, 13 Jul 2007 18:35:40 -0000


albertel		Fri Jul 13 14:35:40 2007 EDT

  Modified files:              
    /loncom/xml	londefdef.pm 
    /loncom/publisher	lonrights.pm 
    /loncom/lonnet/perl	lonnet.pm 
  Log:
  - BUG#5307, can allow deny users with _ in their username
  
  
Index: loncom/xml/londefdef.pm
diff -u loncom/xml/londefdef.pm:1.372 loncom/xml/londefdef.pm:1.373
--- loncom/xml/londefdef.pm:1.372	Wed Jul  4 10:02:14 2007
+++ loncom/xml/londefdef.pm	Fri Jul 13 14:35:20 2007
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Tags Default Definition Module 
 #
-# $Id: londefdef.pm,v 1.372 2007/07/04 14:02:14 foxr Exp $
+# $Id: londefdef.pm,v 1.373 2007/07/13 18:35:20 albertel Exp $
 # 
 #
 # Copyright Michigan State University Board of Trustees
@@ -475,25 +475,27 @@
 sub start_accessrule {
     my ($target,$token,$tagstack,$parstack,$parser,$safeeval,$style) = @_;
     my $currentstring = '';
-    my $eff=&Apache::lonxml::get_param
-	('effect',$parstack,$safeeval,undef,1);
-    my $realm=&Apache::lonxml::get_param
-	('realm',$parstack,$safeeval,undef,1);
-    my $role=&Apache::lonxml::get_param
-	('role',$parstack,$safeeval,undef,1);
-    my ($dom,$crs,$sec)=split(/\_/,$realm);
-    $dom = &LONCAPA::clean_domain($dom);
-    my $type=&Apache::lonxml::get_param
-	('type',$parstack,$safeeval,undef,1);
+    my $eff  =&Apache::lonxml::get_param('effect',$parstack,$safeeval,undef,1);
+    my $realm=&Apache::lonxml::get_param('realm', $parstack,$safeeval,undef,1);
+    my $role =&Apache::lonxml::get_param('role',  $parstack,$safeeval,undef,1);
+    my $type =&Apache::lonxml::get_param('type',  $parstack,$safeeval,undef,1);
+
+    my ($dom,$crs,$sec,$separator);
     if ($type eq 'user') {
+	($dom,$crs,$sec)=split(m{/},$realm);
 	$crs = &LONCAPA::clean_username($crs);
+	$separator = '/';
     } else {
+	($dom,$crs,$sec)=split(/\_/,$realm);
 	$crs = &LONCAPA::clean_courseid($crs);
+	$separator = '_';
     }
+    $dom = &LONCAPA::clean_domain($dom);
+
     $sec =~s/\W//;
     $realm = $dom;
-    if ($crs =~ /\S/) { $realm .= '_'.$crs; }
-    if ($sec =~ /\S/) { $realm .= '_'.$sec; }
+    if ($crs =~ /\S/) { $realm .= $separator.$crs; }
+    if ($sec =~ /\S/) { $realm .= $separator.$sec; }
     $role=~s/\W//g;
 
     if ($target eq 'web') {
Index: loncom/publisher/lonrights.pm
diff -u loncom/publisher/lonrights.pm:1.23 loncom/publisher/lonrights.pm:1.24
--- loncom/publisher/lonrights.pm:1.23	Thu Jun 21 20:11:22 2007
+++ loncom/publisher/lonrights.pm	Fri Jul 13 14:35:28 2007
@@ -1,7 +1,7 @@
 # The LearningOnline Network with CAPA
 # Handler to show and edit custom distribution rights
 #
-# $Id: lonrights.pm,v 1.23 2007/06/22 00:11:22 albertel Exp $
+# $Id: lonrights.pm,v 1.24 2007/07/13 18:35:28 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -110,13 +110,14 @@
 	      $rulehash{'domain'}=$env{'user.domain'}; 
 	  }
 	  my $realm='';
+	  my $separator = ($rulehash{'type'} eq 'course') ? '_' : '/';
 	  if ($number) {
 	      $realm=$rulehash{'domain'};
 	      if ($rulehash{'course'}) {
-		  $realm.='_'.$rulehash{'course'};
+		  $realm.=$separator.$rulehash{'course'};
 	      }
 	      if ($rulehash{'section'}) {
-		  $realm.='_'.$rulehash{'section'};
+		  $realm.=$separator.$rulehash{'section'};
 	      }
 	  }
 	  $newrules[$number]=$rulehash{'effect'}.':'.
@@ -126,28 +127,18 @@
       foreach my $key (keys(%env)) {
 	  next if ($key!~/^form\.action\_(\d+)$/);
 	  my $number=$1;
-	  if ($env{$key} eq 'delete') { $newrules[$number]=''; }
+	  if ($env{$key} eq 'delete') { splice(@newrules,$number,1); }
 	  if (($env{$key} eq 'moveup') && ($number>1)) {
-	      my $buffer=$newrules[$number];
-	      $newrules[$number]=$newrules[$number-1];
-	      $newrules[$number-1]=$buffer;
+	      @newrules[$number-1,$number] = @newrules[$number,$number-1];
 	  }
 	  if (($env{$key} eq 'movedown') && ($number<$#newrules)) {
-	      my $buffer=$newrules[$number];
-	      $newrules[$number]=$newrules[$number+1];
-	      $newrules[$number+1]=$buffer;
+	      @newrules[$number+1,$number] = @newrules[$number,$number+1];
 	  }
 	  if ($env{$key} eq 'insertabove') {
-	      for (my $i=$#newrules;$i>=$number;$i--) {
-		  $newrules[$i+1]=$newrules[$i];
-	      }
-	      $newrules[$number]='deny';
+	      splice(@newrules,$number,0,'deny');
 	  }
 	  if ($env{$key} eq 'insertbelow') {
-	      for (my $i=$#newrules;$i>$number;$i--) {
-		  $newrules[$i+1]=$newrules[$i];
-	      }
-	      $newrules[$number+1]='deny';
+	      splice(@newrules,$number+1,0,'deny');
 	  }
       }
       
@@ -185,7 +176,7 @@
   my $colzero=&mt($constructmode?'Edit action':'Rule');
   my %lt=&Apache::lonlocal::texthash('ef' => 'Effect',
 				     'do' => 'Domain',
-				     'co' => 'Course',
+				     'co' => 'Course / User',
 				     'se' => 'Section',
 				     'ro' => 'Role');
 # ---------------------------------------------------------- Start table output
@@ -268,15 +259,14 @@
 
 # ---- realm
           my $realm=$token->[2]->{'realm'};
-          my ($rdom,$rcourse,$rsec)=split(/[\/\_]/,$realm);
-	  $rdom = &LONCAPA::clean_domain($rdom);
+          my ($rdom,$rcourse,$rsec);
 	  if ($type eq 'course') {
+	      ($rdom,$rcourse,$rsec) = split(m{[/_]},$realm,3);
 	      $rcourse = &LONCAPA::clean_courseid($rcourse);
 	  } else {
+	      ($rdom,$rcourse,$rsec) = split(m{/},$realm,3);
 	      $rcourse = &LONCAPA::clean_username($rcourse);
 	  }
-
-
           $r->print('</td><td>');
 # realm domain
           if ($constructmode) {
Index: loncom/lonnet/perl/lonnet.pm
diff -u loncom/lonnet/perl/lonnet.pm:1.895 loncom/lonnet/perl/lonnet.pm:1.896
--- loncom/lonnet/perl/lonnet.pm:1.895	Mon Jun 25 19:08:55 2007
+++ loncom/lonnet/perl/lonnet.pm	Fri Jul 13 14:35:39 2007
@@ -1,7 +1,7 @@
 # The LearningOnline Network
 # TCP networking package
 #
-# $Id: lonnet.pm,v 1.895 2007/06/25 23:08:55 albertel Exp $
+# $Id: lonnet.pm,v 1.896 2007/07/13 18:35:39 albertel Exp $
 #
 # Copyright Michigan State University Board of Trustees
 #
@@ -3807,12 +3807,12 @@
 	my ($effect,$realm,$role,$type)=split(/\:/,$right);
 	if ($type eq 'user') {
 	    foreach my $scope (split(/\s*\,\s*/,$realm)) {
-		my ($tdom,$tcrs)=split(/\_/,$scope);
+		my ($tdom,$tuname)=split(m{/},$scope);
 		if ($tdom) {
 		    if ($tdom ne $env{'user.domain'}) { next; }
 		}
-		if ($tcrs) {
-		    if ($tcrs ne $env{'user.name'}) { next; }
+		if ($tuname) {
+		    if ($tuname ne $env{'user.name'}) { next; }
 		}
 		$access=($effect eq 'allow');
 		last;
@@ -7098,7 +7098,7 @@
 sub rndseed {
     my ($symb,$courseid,$domain,$username)=@_;
     my ($wsymb,$wcourseid,$wdomain,$wusername)=&whichuser();
-    if (!$symb) {
+    if (!defined($symb)) {
 	unless ($symb=$wsymb) { return time; }
     }
     if (!$courseid) { $courseid=$wcourseid; }